{-|
  Copyright   :  (C) 2015-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2021,      QBayLogic B.V.,
                     2022,      Google Inc.,
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
-}

{-# LANGUAGE CPP #-}

module Clash.GHC.ClashFlags
  ( parseClashFlags
  , flagsClash
  )
where

#if MIN_VERSION_ghc(9,0,0)
import           GHC.Driver.CmdLine
import           GHC.Utils.Panic
import           GHC.Types.SrcLoc
#else
import           CmdLineParser
import           Panic
import           SrcLoc
#endif

import           Control.Monad
import           Data.Char                      (isSpace)
import           Data.IORef
import           Data.List                      (dropWhileEnd)
import           Data.List.Split                (splitOn)
import qualified Data.Set                       as Set
import qualified Data.Text                      as Text
import           Text.Read                      (readMaybe)

import           Clash.Backend.Verilog.Time     (parsePeriod)
import           Clash.Driver.Types
import           Clash.Netlist.BlackBox.Types   (HdlSyn (..))
import           Clash.Netlist.Types            (PreserveCase (ToLower))

parseClashFlags :: IORef ClashOpts -> [Located String]
                -> IO ([Located String],[Warn])
parseClashFlags :: IORef ClashOpts
-> [Located String] -> IO ([Located String], [Warn])
parseClashFlags IORef ClashOpts
r = [Flag IO] -> [Located String] -> IO ([Located String], [Warn])
parseClashFlagsFull (IORef ClashOpts -> [Flag IO]
flagsClash IORef ClashOpts
r)

parseClashFlagsFull :: [Flag IO] -> [Located String]
                    -> IO ([Located String],[Warn])
parseClashFlagsFull :: [Flag IO] -> [Located String] -> IO ([Located String], [Warn])
parseClashFlagsFull [Flag IO]
flagsAvialable [Located String]
args = do
  ([Located String]
leftovers,[Err]
errs,[Warn]
warns) <- [Flag IO]
-> [Located String] -> IO ([Located String], [Err], [Warn])
forall (m :: Type -> Type).
Monad m =>
[Flag m] -> [Located String] -> m ([Located String], [Err], [Warn])
processArgs [Flag IO]
flagsAvialable [Located String]
args
#if MIN_VERSION_ghc(9,4,0)
                              parseResponseFile
#endif

  Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ([Err] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Err]
errs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcException -> IO ()
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO ()) -> GhcException -> IO ()
forall a b. (a -> b) -> a -> b
$
    [(String, String)] -> GhcException
errorsToGhcException ([(String, String)] -> GhcException)
-> ([Err] -> [(String, String)]) -> [Err] -> GhcException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> (String, String)) -> [Err] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"on the commandline", ) (String -> (String, String))
-> (Err -> String) -> Err -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Located String -> String
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located String -> String)
-> (Err -> Located String) -> Err -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Located String
errMsg)
                         ([Err] -> GhcException) -> [Err] -> GhcException
forall a b. (a -> b) -> a -> b
$ [Err]
errs

  ([Located String], [Warn]) -> IO ([Located String], [Warn])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Located String]
leftovers, [Warn]
warns)

flagsClash :: IORef ClashOpts -> [Flag IO]
flagsClash :: IORef ClashOpts -> [Flag IO]
flagsClash IORef ClashOpts
r = [
    String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug"                       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setDebugLevel IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-info"                  (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setDebugInfo IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-invariants"            (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setDebugInvariants IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-count-transformations" (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setDebugCountTransformations IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-transformations"       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setDebugTransformations IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-transformations-from"  (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IORef ClashOpts -> Int -> EwM IO ()
setDebugTransformationsFrom IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-transformations-limit" (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IORef ClashOpts -> Int -> EwM IO ()
setDebugTransformationsLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-debug-history"               (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
AnySuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (String -> IO ()) -> String -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef ClashOpts -> String -> IO ()
setRewriteHistoryFile IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-hdldir"                      (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setHdlDir IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-hdlsyn"                      (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setHdlSyn IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-nocache"                     (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (String
-> String
-> (IORef ClashOpts -> IO ())
-> IORef ClashOpts
-> EwM IO ()
forall a. String -> String -> (a -> IO ()) -> a -> EwM IO ()
deprecated String
"nocache" String
"no-cache" IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-no-cache"                    (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-no-check-inaccessible-idirs" (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoIDirCheck IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-no-clean"                    (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IORef ClashOpts -> EwM IO ()
forall a. a -> EwM IO ()
setNoClean IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-clear"                       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setClear IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-no-prim-warn"                (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoPrimWarn IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-spec-limit"                  (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (Int -> IO ()) -> Int -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> Int -> IO ()
setSpecLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-inline-limit"                (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (Int -> IO ()) -> Int -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> Int -> IO ()
setInlineLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-inline-function-limit"       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (Int -> IO ()) -> Int -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> Int -> IO ()
setInlineFunctionLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-inline-constant-limit"       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (Int -> IO ()) -> Int -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> Int -> IO ()
setInlineConstantLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-evaluator-fuel-limit"        (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (Int -> IO ()) -> Int -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> Int -> IO ()
setEvaluatorFuelLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-intwidth"                    (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IORef ClashOpts -> Int -> EwM IO ()
setIntWidth IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-error-extra"                 (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setErrorExtra IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-float-support"               (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IORef ClashOpts -> EwM IO ()
setFloatSupport IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-component-prefix"            (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (String -> IO ()) -> String -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> String -> IO ()
setComponentPrefix IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-old-inline-strategy"         (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setOldInlineStrategy IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-no-escaped-identifiers"      (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoEscapedIds IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-lower-case-basic-identifiers"(OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setLowerCaseBasicIds IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-compile-ultra"               (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setUltra IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-force-undefined"             (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Maybe Int -> EwM m ()) -> OptKind m
OptIntSuffix (IORef ClashOpts -> Maybe Int -> EwM IO ()
setUndefined IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-aggressive-x-optimization"   (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setAggressiveXOpt IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-aggressive-x-optimization-blackboxes" (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setAggressiveXOptBB IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-inline-workfree-limit"       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> (Int -> IO ()) -> Int -> EwM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ClashOpts -> Int -> IO ()
setInlineWFLimit IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-edalize"                     (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setEdalize IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-no-render-enums"             (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoRenderEnums IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-timescale-precision"         (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setTimescalePrecision IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: Type -> Type). String -> OptKind m -> Flag m
defFlag String
"fclash-ignore-broken-ghcs"          (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: Type -> Type). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setIgnoreBrokenGhcs IORef ClashOpts
r))
  ]

-- | Print deprecated flag warning
deprecated
  :: String
  -- ^ Deprecated flag
  -> String
  -- ^ Use X instead
  -> (a -> IO ())
  -> a
  -> EwM IO ()
deprecated :: String -> String -> (a -> IO ()) -> a -> EwM IO ()
deprecated String
wrong String
right a -> IO ()
f a
a = do
  String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (String
"Using '-fclash-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wrong
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is deprecated. Use '-fclash-"
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
right
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' instead.")
  IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (a -> IO ()
f a
a)

setInlineLimit :: IORef ClashOpts
               -> Int
               -> IO ()
setInlineLimit :: IORef ClashOpts -> Int -> IO ()
setInlineLimit IORef ClashOpts
r Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_inlineLimit :: Int
opt_inlineLimit = Int
n})

setInlineFunctionLimit
  :: IORef ClashOpts
  -> Int
  -> IO ()
setInlineFunctionLimit :: IORef ClashOpts -> Int -> IO ()
setInlineFunctionLimit IORef ClashOpts
r Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_inlineFunctionLimit :: Word
opt_inlineFunctionLimit = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
n})

setInlineConstantLimit
  :: IORef ClashOpts
  -> Int
  -> IO ()
setInlineConstantLimit :: IORef ClashOpts -> Int -> IO ()
setInlineConstantLimit IORef ClashOpts
r Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_inlineConstantLimit :: Word
opt_inlineConstantLimit = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
n})

setEvaluatorFuelLimit
  :: IORef ClashOpts
  -> Int
  -> IO ()
setEvaluatorFuelLimit :: IORef ClashOpts -> Int -> IO ()
setEvaluatorFuelLimit IORef ClashOpts
r Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_evaluatorFuelLimit :: Word
opt_evaluatorFuelLimit = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
n})

setInlineWFLimit
  :: IORef ClashOpts
  -> Int
  -> IO ()
setInlineWFLimit :: IORef ClashOpts -> Int -> IO ()
setInlineWFLimit IORef ClashOpts
r Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_inlineWFCacheLimit :: Word
opt_inlineWFCacheLimit = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
n})

setSpecLimit :: IORef ClashOpts
             -> Int
             -> IO ()
setSpecLimit :: IORef ClashOpts -> Int -> IO ()
setSpecLimit IORef ClashOpts
r Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_specLimit :: Int
opt_specLimit = Int
n})

setDebugInvariants :: IORef ClashOpts -> IO ()
setDebugInvariants :: IORef ClashOpts -> IO ()
setDebugInvariants IORef ClashOpts
r =
  IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r ((ClashOpts -> ClashOpts) -> IO ())
-> (ClashOpts -> ClashOpts) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClashOpts
c ->
    ClashOpts
c { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
c) { dbg_invariants :: Bool
dbg_invariants = Bool
True } }

setDebugCountTransformations :: IORef ClashOpts -> IO ()
setDebugCountTransformations :: IORef ClashOpts -> IO ()
setDebugCountTransformations IORef ClashOpts
r =
  IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r ((ClashOpts -> ClashOpts) -> IO ())
-> (ClashOpts -> ClashOpts) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClashOpts
c ->
    ClashOpts
c { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
c) { dbg_countTransformations :: Bool
dbg_countTransformations = Bool
True } }

setDebugTransformations :: IORef ClashOpts -> String -> EwM IO ()
setDebugTransformations :: IORef ClashOpts -> String -> EwM IO ()
setDebugTransformations IORef ClashOpts
r String
s =
  IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (Set String -> ClashOpts -> ClashOpts
setTransformations Set String
transformations))
 where
  transformations :: Set String
transformations = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
trim (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"," String
s)))
  trim :: String -> String
trim = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

  setTransformations :: Set String -> ClashOpts -> ClashOpts
setTransformations Set String
xs ClashOpts
opts =
    ClashOpts
opts { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
opts) { dbg_transformations :: Set String
dbg_transformations = Set String
xs } }

setDebugTransformationsFrom :: IORef ClashOpts -> Int -> EwM IO ()
setDebugTransformationsFrom :: IORef ClashOpts -> Int -> EwM IO ()
setDebugTransformationsFrom IORef ClashOpts
r Int
n =
  IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (Word -> ClashOpts -> ClashOpts
setFrom (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)))
 where
  setFrom :: Word -> ClashOpts -> ClashOpts
setFrom Word
from ClashOpts
opts =
    ClashOpts
opts { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
opts) { dbg_transformationsFrom :: Maybe Word
dbg_transformationsFrom = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
from } }

setDebugTransformationsLimit :: IORef ClashOpts -> Int -> EwM IO ()
setDebugTransformationsLimit :: IORef ClashOpts -> Int -> EwM IO ()
setDebugTransformationsLimit IORef ClashOpts
r Int
n =
  IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (Word -> ClashOpts -> ClashOpts
setLimit (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)))
 where
  setLimit :: Word -> ClashOpts -> ClashOpts
setLimit Word
limit ClashOpts
opts =
    ClashOpts
opts { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
opts) { dbg_transformationsLimit :: Maybe Word
dbg_transformationsLimit = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
limit } }

setDebugLevel :: IORef ClashOpts -> String -> EwM IO ()
setDebugLevel :: IORef ClashOpts -> String -> EwM IO ()
setDebugLevel IORef ClashOpts
r String
s =
  case String
s of
    String
"DebugNone" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugNone)
    String
"DebugSilent" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugSilent)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
"DebugFinal" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugFinal)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
"DebugCount" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugCount)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
"DebugName" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugName)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
"DebugTry" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugTry)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
"DebugApplied" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugApplied)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
"DebugAll" ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
debugAll)
        IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r
    String
_ ->
      String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is an invalid debug level")
 where
  setLevel :: DebugOpts -> ClashOpts -> ClashOpts
setLevel DebugOpts
lvl ClashOpts
opts =
    ClashOpts
opts { opt_debug :: DebugOpts
opt_debug = DebugOpts
lvl }

setDebugInfo :: IORef ClashOpts -> String -> EwM IO ()
setDebugInfo :: IORef ClashOpts -> String -> EwM IO ()
setDebugInfo IORef ClashOpts
r String
s =
  case String -> Maybe TransformationInfo
forall a. Read a => String -> Maybe a
readMaybe String
s of
    Just TransformationInfo
info ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (TransformationInfo -> ClashOpts -> ClashOpts
setInfo TransformationInfo
info)
        Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (TransformationInfo
info TransformationInfo -> TransformationInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= TransformationInfo
None) (IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r)

    Maybe TransformationInfo
Nothing ->
      String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is an invalid debug info")
 where
  setInfo :: TransformationInfo -> ClashOpts -> ClashOpts
setInfo TransformationInfo
info ClashOpts
opts =
    ClashOpts
opts { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
opts) { dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
info } }

setNoCache :: IORef ClashOpts -> IO ()
setNoCache :: IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_cachehdl :: Bool
opt_cachehdl = Bool
False})

setNoIDirCheck :: IORef ClashOpts -> IO ()
setNoIDirCheck :: IORef ClashOpts -> IO ()
setNoIDirCheck IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_checkIDir :: Bool
opt_checkIDir = Bool
False})

setNoClean :: a -> EwM IO ()
setNoClean :: a -> EwM IO ()
setNoClean a
_ = String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn String
"-fclash-no-clean has been removed"

setClear :: IORef ClashOpts -> IO ()
setClear :: IORef ClashOpts -> IO ()
setClear IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_clear :: Bool
opt_clear = Bool
True})

setNoPrimWarn :: IORef ClashOpts -> IO ()
setNoPrimWarn :: IORef ClashOpts -> IO ()
setNoPrimWarn IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_primWarn :: Bool
opt_primWarn = Bool
False})

setIntWidth :: IORef ClashOpts
            -> Int
            -> EwM IO ()
setIntWidth :: IORef ClashOpts -> Int -> EwM IO ()
setIntWidth IORef ClashOpts
r Int
n =
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64
     then IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_intWidth :: Int
opt_intWidth = Int
n})
     else String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is an invalid Int/Word/Integer bit-width. Allowed widths: 32, 64.")

setHdlDir :: IORef ClashOpts
          -> String
          -> EwM IO ()
setHdlDir :: IORef ClashOpts -> String -> EwM IO ()
setHdlDir IORef ClashOpts
r String
s = IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_hdlDir :: Maybe String
opt_hdlDir = String -> Maybe String
forall a. a -> Maybe a
Just String
s})

setHdlSyn :: IORef ClashOpts
          -> String
          -> EwM IO ()
setHdlSyn :: IORef ClashOpts -> String -> EwM IO ()
setHdlSyn IORef ClashOpts
r String
s = case String -> Maybe HdlSyn
forall a. Read a => String -> Maybe a
readMaybe String
s of
  Just HdlSyn
hdlSyn -> IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
hdlSyn})
  Maybe HdlSyn
Nothing -> case String
s of
    String
"Xilinx"  -> IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Vivado})
    String
"ISE"     -> IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Vivado})
    String
"Altera"  -> IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Quartus})
    String
"Intel"   -> IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Quartus})
    String
_         -> String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is an unknown hdl synthesis tool")

setErrorExtra :: IORef ClashOpts -> IO ()
setErrorExtra :: IORef ClashOpts -> IO ()
setErrorExtra IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_errorExtra :: Bool
opt_errorExtra = Bool
True})

setFloatSupport :: IORef ClashOpts -> EwM IO ()
setFloatSupport :: IORef ClashOpts -> EwM IO ()
setFloatSupport IORef ClashOpts
_ =
  String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn String
"Deprecated flag: -fclash-float-support is always enabled from Clash 1.6 and onwards"

setComponentPrefix
  :: IORef ClashOpts
  -> String
  -> IO ()
setComponentPrefix :: IORef ClashOpts -> String -> IO ()
setComponentPrefix IORef ClashOpts
r String
s =
  IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_componentPrefix :: Maybe Text
opt_componentPrefix = Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Text.pack String
s)})

setTimescalePrecision
  :: IORef ClashOpts
  -> String
  -> EwM IO ()
setTimescalePrecision :: IORef ClashOpts -> String -> EwM IO ()
setTimescalePrecision IORef ClashOpts
r String
s =
  case String -> Maybe Period
parsePeriod String
s of
    Just Period
period ->
      IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IO () -> EwM IO ()) -> IO () -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r ((ClashOpts -> ClashOpts) -> IO ())
-> (ClashOpts -> ClashOpts) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClashOpts
c ->
        ClashOpts
c{opt_timescalePrecision :: Period
opt_timescalePrecision = Period
period}
    Maybe Period
Nothing ->
      String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (String -> EwM IO ()) -> String -> EwM IO ()
forall a b. (a -> b) -> a -> b
$ String
"Could not parse " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as a period."

setOldInlineStrategy :: IORef ClashOpts -> IO ()
setOldInlineStrategy :: IORef ClashOpts -> IO ()
setOldInlineStrategy IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_newInlineStrat :: Bool
opt_newInlineStrat = Bool
False})

setNoEscapedIds :: IORef ClashOpts -> IO ()
setNoEscapedIds :: IORef ClashOpts -> IO ()
setNoEscapedIds IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_escapedIds :: Bool
opt_escapedIds = Bool
False})

setLowerCaseBasicIds :: IORef ClashOpts -> IO ()
setLowerCaseBasicIds :: IORef ClashOpts -> IO ()
setLowerCaseBasicIds IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_lowerCaseBasicIds :: PreserveCase
opt_lowerCaseBasicIds = PreserveCase
ToLower})

setIgnoreBrokenGhcs :: IORef ClashOpts -> IO ()
setIgnoreBrokenGhcs :: IORef ClashOpts -> IO ()
setIgnoreBrokenGhcs IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_ignoreBrokenGhcs :: Bool
opt_ignoreBrokenGhcs = Bool
True})

setUltra :: IORef ClashOpts -> IO ()
setUltra :: IORef ClashOpts -> IO ()
setUltra IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_ultra :: Bool
opt_ultra = Bool
True})

setUndefined :: IORef ClashOpts -> Maybe Int -> EwM IO ()
setUndefined :: IORef ClashOpts -> Maybe Int -> EwM IO ()
setUndefined IORef ClashOpts
_ (Just Int
x) | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
  String -> EwM IO ()
forall (m :: Type -> Type). Monad m => String -> EwM m ()
addWarn (String
"-fclash-force-undefined=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ignored, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
" not in range [0,1]")
setUndefined IORef ClashOpts
r Maybe Int
iM =
  IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_forceUndefined :: Maybe (Maybe Int)
opt_forceUndefined = Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
iM}))

setAggressiveXOpt :: IORef ClashOpts -> IO ()
setAggressiveXOpt :: IORef ClashOpts -> IO ()
setAggressiveXOpt IORef ClashOpts
r = do
  IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c { opt_aggressiveXOpt :: Bool
opt_aggressiveXOpt = Bool
True })
  IORef ClashOpts -> IO ()
setAggressiveXOptBB IORef ClashOpts
r


setAggressiveXOptBB :: IORef ClashOpts -> IO ()
setAggressiveXOptBB :: IORef ClashOpts -> IO ()
setAggressiveXOptBB IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c { opt_aggressiveXOptBB :: Bool
opt_aggressiveXOptBB = Bool
True })

setEdalize :: IORef ClashOpts -> IO ()
setEdalize :: IORef ClashOpts -> IO ()
setEdalize IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c { opt_edalize :: Bool
opt_edalize = Bool
True })

setRewriteHistoryFile :: IORef ClashOpts -> String -> IO ()
setRewriteHistoryFile :: IORef ClashOpts -> String -> IO ()
setRewriteHistoryFile IORef ClashOpts
r String
arg = do
  let fileNm :: String
fileNm = case Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
"-fclash-debug-history=") String
arg of
                [] -> String
"history.dat"
                String
str -> String
str
  IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (String -> ClashOpts -> ClashOpts
setFile String
fileNm)
 where
  setFile :: String -> ClashOpts -> ClashOpts
setFile String
file ClashOpts
opts =
    ClashOpts
opts { opt_debug :: DebugOpts
opt_debug = (ClashOpts -> DebugOpts
opt_debug ClashOpts
opts) { dbg_historyFile :: Maybe String
dbg_historyFile = String -> Maybe String
forall a. a -> Maybe a
Just String
file } }

setNoRenderEnums :: IORef ClashOpts -> IO ()
setNoRenderEnums :: IORef ClashOpts -> IO ()
setNoRenderEnums IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c { opt_renderEnums :: Bool
opt_renderEnums = Bool
False })