{-|
  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    #-}
{-# LANGUAGE TupleSections #-}

module Clash.GHC.ClashFlags
  ( parseClashFlags
  )
where

import CmdLineParser
import Panic
import SrcLoc

import Data.IORef
import Control.Monad
import Clash.Driver.Types
import Clash.Netlist.BlackBox.Types (HdlSyn (..))
import Text.Read (readMaybe)

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 r :: 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 flagsAvialable :: [Flag IO]
flagsAvialable args :: [Located String]
args = do
  (leftovers :: [Located String]
leftovers,errs :: [Err]
errs,warns :: [Warn]
warns) <- [Flag IO]
-> [Located String] -> IO ([Located String], [Err], [Warn])
forall (m :: * -> *).
Monad m =>
[Flag m] -> [Located String] -> m ([Located String], [Err], [Warn])
processArgs [Flag IO]
flagsAvialable [Located String]
args

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Err] -> Bool
forall (t :: * -> *) 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 (("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 :: * -> *) a. Monad m => a -> m a
return ([Located String]
leftovers, [Warn]
warns)

flagsClash :: IORef ClashOpts -> [Flag IO]
flagsClash :: IORef ClashOpts -> [Flag IO]
flagsClash r :: IORef ClashOpts
r = [
    String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-debug"                       (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setDebugLevel IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-hdldir"                      (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setHdlDir IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-hdlsyn"                      (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (String -> EwM IO ()) -> OptKind IO
forall (m :: * -> *). (String -> EwM m ()) -> OptKind m
SepArg (IORef ClashOpts -> String -> EwM IO ()
setHdlSyn IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-nocache"                     (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (String
-> String
-> (IORef ClashOpts -> IO ())
-> IORef ClashOpts
-> EwM IO ()
forall a. String -> String -> (a -> IO ()) -> a -> EwM IO ()
deprecated "nocache" "no-cache" IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-no-cache"                    (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoCache IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoIDirCheck IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-noclean"                     (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (String
-> String
-> (IORef ClashOpts -> IO ())
-> IORef ClashOpts
-> EwM IO ()
forall a. String -> String -> (a -> IO ()) -> a -> EwM IO ()
deprecated "noclean" "no-clean" IORef ClashOpts -> IO ()
setNoClean IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-no-clean"                    (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoClean IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoPrimWarn IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: * -> *) 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 :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: * -> *) 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 :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: * -> *) 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 :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). (Int -> EwM m ()) -> OptKind m
IntSuffix (IO () -> EwM IO ()
forall (m :: * -> *) 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 :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-intwidth"                    (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ (Int -> EwM IO ()) -> OptKind IO
forall (m :: * -> *). (Int -> EwM m ()) -> OptKind m
IntSuffix (IORef ClashOpts -> Int -> EwM IO ()
setIntWidth IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-error-extra"                 (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setErrorExtra IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-float-support"               (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setFloatSupport IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-allow-zero-width"            (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (IORef ClashOpts -> EwM IO ()
setAllowZeroWidth IORef ClashOpts
r)
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). (String -> EwM m ()) -> OptKind m
SepArg (IO () -> EwM IO ()
forall (m :: * -> *) 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 :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setOldInlineStrategy IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setNoEscapedIds IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "fclash-compile-ultra"               (OptKind IO -> Flag IO) -> OptKind IO -> Flag IO
forall a b. (a -> b) -> a -> b
$ EwM IO () -> OptKind IO
forall (m :: * -> *). EwM m () -> OptKind m
NoArg (IO () -> EwM IO ()
forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM (IORef ClashOpts -> IO ()
setUltra IORef ClashOpts
r))
  , String -> OptKind IO -> Flag IO
forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag "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 :: * -> *). (Maybe Int -> EwM m ()) -> OptKind m
OptIntSuffix (IORef ClashOpts -> Maybe Int -> EwM IO ()
setUndefined 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 wrong :: String
wrong right :: String
right f :: a -> IO ()
f a :: a
a = do
  String -> EwM IO ()
forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn ("Using '-fclash-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wrong
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' is deprecated. Use '-fclash-"
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
right
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' instead.")
  IO () -> EwM IO ()
forall (m :: * -> *) 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 r :: IORef ClashOpts
r n :: Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\c :: ClashOpts
c -> ClashOpts
c {opt_inlineLimit :: Int
opt_inlineLimit = Int
n})

setInlineFunctionLimit
  :: IORef ClashOpts
  -> Int
  -> IO ()
setInlineFunctionLimit :: IORef ClashOpts -> Int -> IO ()
setInlineFunctionLimit r :: IORef ClashOpts
r n :: Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\c :: 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 r :: IORef ClashOpts
r n :: Int
n = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\c :: ClashOpts
c -> ClashOpts
c {opt_inlineConstantLimit :: Word
opt_inlineConstantLimit = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
n})

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

setDebugLevel :: IORef ClashOpts
              -> String
              -> EwM IO ()
setDebugLevel :: IORef ClashOpts -> String -> EwM IO ()
setDebugLevel r :: IORef ClashOpts
r s :: String
s = case String -> Maybe DebugLevel
forall a. Read a => String -> Maybe a
readMaybe String
s of
  Just dbgLvl :: DebugLevel
dbgLvl -> IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_dbgLevel :: DebugLevel
opt_dbgLevel = DebugLevel
dbgLvl})
                   Bool -> IO () -> IO ()
forall (f :: * -> *). 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
  Nothing     -> String -> EwM IO ()
forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is an invalid debug level")

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

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

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

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

setIntWidth :: IORef ClashOpts
            -> Int
            -> EwM IO ()
setIntWidth :: IORef ClashOpts -> Int -> EwM IO ()
setIntWidth r :: IORef ClashOpts
r n :: Int
n =
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 32 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 64
     then IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_intWidth :: Int
opt_intWidth = Int
n})
     else String -> EwM IO ()
forall (m :: * -> *). 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]
++ " 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 r :: IORef ClashOpts
r s :: String
s = IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: 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 r :: IORef ClashOpts
r s :: String
s = case String -> Maybe HdlSyn
forall a. Read a => String -> Maybe a
readMaybe String
s of
  Just hdlSyn :: HdlSyn
hdlSyn -> IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
hdlSyn})
  Nothing -> case String
s of
    "Xilinx"  -> IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Vivado})
    "ISE"     -> IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Vivado})
    "Altera"  -> IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Quartus})
    "Intel"   -> IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: ClashOpts
c -> ClashOpts
c {opt_hdlSyn :: HdlSyn
opt_hdlSyn = HdlSyn
Quartus})
    _         -> String -> EwM IO ()
forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is an unknown hdl synthesis tool")

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

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

setAllowZeroWidth :: IORef ClashOpts -> EwM IO ()
setAllowZeroWidth :: IORef ClashOpts -> EwM IO ()
setAllowZeroWidth _ = do
  String -> EwM IO ()
forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn ("-fclash-allow-zero-width is deprecated and will be removed in Clash 1.0")
  -- liftEwM (modifyIORef r (\c -> c {opt_allowZero = True}))

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

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

setUltra :: IORef ClashOpts -> IO ()
setUltra :: IORef ClashOpts -> IO ()
setUltra r :: IORef ClashOpts
r = IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ClashOpts
r (\c :: 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 _ (Just x :: Int
x) | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 =
  String -> EwM IO ()
forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn ("-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]
++ " 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]
++
           " not in range [0,1]")
setUndefined r :: IORef ClashOpts
r iM :: Maybe Int
iM =
  IO () -> EwM IO ()
forall (m :: * -> *) 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 (\c :: 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}))