{-|
  Copyright   :  (C) 2015-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}

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

import           CmdLineParser
import           Panic
import           SrcLoc

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           Text.Read                      (readMaybe)

import           Clash.Driver.Types
import           Clash.Netlist.BlackBox.Types   (HdlSyn (..))

parseClashFlags :: IORef ClashOpts -> [Located String]
                -> IO ([Located String]
#if MIN_VERSION_ghc(8,4,1)
                      ,[Warn])
#else
                      ,[Located String])
#endif
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]
#if MIN_VERSION_ghc(8,4,1)
                          ,[Warn])
#else
                          ,[Located String])
#endif
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

  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
.
#if MIN_VERSION_ghc(8,4,1)
                               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)
#else
                               unLoc)
#endif
                         ([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-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
$ (Maybe Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Maybe Int -> EwM m ()) -> OptKind m
OptIntSuffix (IORef ClashOpts -> Maybe 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
$ (Maybe Int -> EwM IO ()) -> OptKind IO
forall (m :: Type -> Type). (Maybe Int -> EwM m ()) -> OptKind m
OptIntSuffix (IORef ClashOpts -> Maybe Int -> EwM IO ()
setDebugTransformationsLimit 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-noclean"                     (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
"noclean" String
"no-clean" IORef ClashOpts -> IO ()
setNoClean 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 (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoClean 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-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 (IO () -> EwM IO ()
forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> 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-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-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)
  ]

-- | 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})

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})

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 (\ClashOpts
c -> ClashOpts
c {opt_dbgTransformations :: Set String
opt_dbgTransformations = 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

setDebugTransformationsFrom :: IORef ClashOpts -> Maybe Int -> EwM IO ()
setDebugTransformationsFrom :: IORef ClashOpts -> Maybe Int -> EwM IO ()
setDebugTransformationsFrom IORef ClashOpts
r (Just 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 (\ClashOpts
c -> ClashOpts
c {opt_dbgTransformationsFrom :: Int
opt_dbgTransformationsFrom = Int
n}))
setDebugTransformationsFrom IORef ClashOpts
_r Maybe Int
Nothing = () -> EwM IO ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

setDebugTransformationsLimit :: IORef ClashOpts -> Maybe Int -> EwM IO ()
setDebugTransformationsLimit :: IORef ClashOpts -> Maybe Int -> EwM IO ()
setDebugTransformationsLimit IORef ClashOpts
r (Just 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 (\ClashOpts
c -> ClashOpts
c {opt_dbgTransformationsLimit :: Int
opt_dbgTransformationsLimit = Int
n}))
setDebugTransformationsLimit IORef ClashOpts
_r Maybe Int
Nothing = () -> EwM IO ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

setDebugLevel :: IORef ClashOpts
              -> String
              -> EwM IO ()
setDebugLevel :: IORef ClashOpts -> String -> EwM IO ()
setDebugLevel IORef ClashOpts
r String
s = case String -> Maybe DebugLevel
forall a. Read a => String -> Maybe a
readMaybe String
s of
  Just DebugLevel
dbgLvl -> 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 (\ClashOpts
c -> ClashOpts
c {opt_dbgLevel :: DebugLevel
opt_dbgLevel = DebugLevel
dbgLvl})
                   Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DebugLevel
dbgLvl DebugLevel -> DebugLevel -> Bool
forall a. Ord a => a -> a -> Bool
> DebugLevel
DebugNone) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r -- when debugging disable cache
  Maybe DebugLevel
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 level")

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 :: IORef ClashOpts -> IO ()
setNoClean :: IORef ClashOpts -> IO ()
setNoClean IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_cleanhdl :: Bool
opt_cleanhdl = Bool
False})

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 -> IO ()
setFloatSupport :: IORef ClashOpts -> IO ()
setFloatSupport IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\ClashOpts
c -> ClashOpts
c {opt_floatSupport :: Bool
opt_floatSupport = Bool
True})

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 String
opt_componentPrefix = String -> Maybe String
forall a. a -> Maybe a
Just String
s})

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})

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 = 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 })