Move debug options to new DebugOpts type

The debugging options for the compiler are often used together,
yet are passed individually to the rewrite system. Keeping debugging
options together helps expose less unnecessary detail.

Author: Alex McKenna

clash-ghc/src-ghc/Clash/GHC/ClashFlags.hs

@@ -138,29 +138,43 @@ setSpecLimit r n = modifyIORef r (\c -> c {opt_specLimit = n})
 
 setDebugTransformations :: IORef ClashOpts -> String -> EwM IO ()
 setDebugTransformations r s =
-  liftEwM (modifyIORef r (\c -> c {opt_dbgTransformations = transformations}))
+  liftEwM (modifyIORef r (setTransformations transformations))
  where
   transformations = Set.fromList (filter (not . null) (map trim (splitOn "," s)))
   trim = dropWhileEnd isSpace . dropWhile isSpace
 
+  setTransformations xs opts =
+    opts { opt_debug = (opt_debug opts) { opt_transformations = xs } }
+
 setDebugTransformationsFrom :: IORef ClashOpts -> Maybe Int -> EwM IO ()
 setDebugTransformationsFrom r (Just n) =
-  liftEwM (modifyIORef r (\c -> c {opt_dbgTransformationsFrom = n}))
+  liftEwM (modifyIORef r (setFrom (fromIntegral n)))
+ where
+  setFrom from opts =
+    opts { opt_debug = (opt_debug opts) { opt_transformationsFrom = from } }
+
 setDebugTransformationsFrom _r Nothing = pure ()
 
 setDebugTransformationsLimit :: IORef ClashOpts -> Maybe Int -> EwM IO ()
 setDebugTransformationsLimit r (Just n) =
-  liftEwM (modifyIORef r (\c -> c {opt_dbgTransformationsLimit = n}))
+  liftEwM (modifyIORef r (setLimit (fromIntegral n)))
+ where
+  setLimit limit opts =
+    opts { opt_debug = (opt_debug opts) { opt_transformationsLimit = limit } }
+
 setDebugTransformationsLimit _r Nothing = pure ()
 
 setDebugLevel :: IORef ClashOpts
               -> String
               -> EwM IO ()
 setDebugLevel r s = case readMaybe s of
   Just dbgLvl -> liftEwM $ do
-                   modifyIORef r (\c -> c {opt_dbgLevel = dbgLvl})
+                   modifyIORef r (setLevel dbgLvl)
                    when (dbgLvl > DebugNone) $ setNoCache r -- when debugging disable cache
   Nothing     -> addWarn (s ++ " is an invalid debug level")
+ where
+  setLevel lvl opts =
+    opts { opt_debug = (opt_debug opts) { opt_level = lvl } }
 
 setNoCache :: IORef ClashOpts -> IO ()
 setNoCache r = modifyIORef r (\c -> c {opt_cachehdl = False})
@@ -251,4 +265,7 @@ setRewriteHistoryFile r arg = do
   let fileNm = case drop (length "-fclash-debug-history=") arg of
                 [] -> "history.dat"
                 str -> str
-  modifyIORef r (\c -> c {opt_dbgRewriteHistoryFile = Just fileNm})
+  modifyIORef r (setFile fileNm)
+ where
+  setFile file opts =
+    opts { opt_debug = (opt_debug opts) { opt_rewriteHistoryFile = Just file } }

clash-lib/src/Clash/Driver.hs

@@ -292,7 +292,7 @@ generateHDL
   -> IO ()
 generateHDL reprs domainConfs bindingsMap hdlState primMap tcm tupTcm typeTrans eval
   topEntities0 mainTopEntity opts (startTime,prepTime) = do
-    case opt_dbgRewriteHistoryFile opts of
+    case opt_rewriteHistoryFile (opt_debug opts) of
       Nothing -> pure ()
       Just histFile -> whenM (Directory.doesFileExist histFile) (Directory.removeFile histFile)
     let (tes, deps) = sortTop bindingsMap topEntities1

clash-lib/src/Clash/Driver/Manifest.hs

@@ -371,9 +371,11 @@ readFreshManifest tops (bindingsMap, topId) primMap opts@(ClashOpts{..}) clashMo
       -- Ignore the following settings, they don't affect the generated HDL:
 
       -- 1. Debug
-      opt_dbgLevel = DebugNone
-    , opt_dbgTransformations = Set.empty
-    , opt_dbgRewriteHistoryFile = Nothing
+      opt_debug = opt_debug
+        { opt_level = DebugNone
+        , opt_transformations = Set.empty
+        , opt_rewriteHistoryFile = Nothing
+        }
 
       -- 2. Caching
     , opt_cachehdl = True

clash-lib/src/Clash/Driver/Types.hs

@@ -98,6 +98,53 @@ data DebugLevel
   -- ^ Show all sub-expressions on which a rewrite is attempted
   deriving (Eq,Ord,Read,Enum,Generic,Hashable)
 
+-- | Options related to debugging. See 'ClashOpts'
+data DebugOpts = DebugOpts
+  { opt_level :: DebugLevel
+  -- ^ Set the debugging mode for the compiler, exposing additional output. See
+  -- "DebugLevel" for the available options.
+  --
+  -- Command line flag: -fclash-debug
+  , opt_transformations :: Set.Set String
+  -- ^ List the transformations that are to be debugged.
+  --
+  -- Command line flag: -fclash-debug-transformations
+  , opt_transformationsFrom :: Word
+  -- ^ Only output debug information from (applied) transformation n
+  --
+  -- Command line flag: -fclash-debug-transformations-from
+  , opt_transformationsLimit :: Word
+  -- ^ Only output debug information for n (applied) transformations. If this
+  -- limit is exceeded, Clash will stop normalizing.
+  --
+  -- Command line flag: -fclash-debug-transformations-limit
+  , opt_rewriteHistoryFile :: Maybe FilePath
+  -- ^ Save all applied rewrites to a file
+  --
+  -- Command line flag: -fclash-debug-history
+  }
+
+instance Hashable DebugOpts where
+  hashWithSalt s DebugOpts{..} =
+    s `hashWithSalt`
+    opt_level `hashSet`
+    opt_transformations `hashWithSalt`
+    opt_transformationsFrom `hashWithSalt`
+    opt_transformationsLimit `hashWithSalt`
+    opt_rewriteHistoryFile
+   where
+    hashSet = Set.foldl' hashWithSalt
+    infixl 0 `hashSet`
+
+defDebugOpts :: DebugOpts
+defDebugOpts = DebugOpts
+  { opt_level = DebugNone
+  , opt_transformations = Set.empty
+  , opt_transformationsFrom = 0
+  , opt_transformationsLimit = maxBound
+  , opt_rewriteHistoryFile = Nothing
+  }
+
 -- | Options passed to Clash compiler
 data ClashOpts = ClashOpts
   { opt_inlineLimit :: Int
@@ -124,30 +171,8 @@ data ClashOpts = ClashOpts
   -- of zero means no potentially non-terminating binding is unfolded.
   --
   -- Command line flag: -fclash-evaluator-fuel-limit
-  , opt_dbgLevel :: DebugLevel
-  -- ^ Set the debugging mode for the compiler, exposing additional output. See
-  -- "DebugLevel" for the available options.
-  --
-  -- Command line flag: -fclash-debug
-  , opt_dbgTransformations :: Set.Set String
-  -- ^ List the transformations that are to be debugged.
-  --
-  -- Command line flag: -fclash-debug-transformations
-  , opt_dbgTransformationsFrom :: Word
-  -- ^ Only output debug information from (applied) transformation n
-  --
-  -- Command line flag: -fclash-debug-transformations-from
-  , opt_dbgTransformationsLimit :: Word
-  -- ^ Only output debug information for n (applied) transformations. If this
-  -- limit is exceeded, Clash will stop normalizing.
-  --
-  -- Command line flag: -fclash-debug-transformations-limit
-
-  , opt_dbgRewriteHistoryFile :: Maybe FilePath
-  -- ^ Save all applied rewrites to a file
-  --
-  -- Command line flag: -fclash-debug-history
-
+  , opt_debug :: DebugOpts
+  -- ^ Options which control debugging. See 'DebugOpts'.
   , opt_cachehdl :: Bool
   -- ^ Reuse previously generated output from Clash. Only caches topentities.
   --
@@ -231,11 +256,6 @@ instance Hashable ClashOpts where
     opt_inlineFunctionLimit `hashWithSalt`
     opt_inlineConstantLimit `hashWithSalt`
     opt_evaluatorFuelLimit `hashWithSalt`
-    opt_dbgLevel `hashSet`
-    opt_dbgTransformations `hashWithSalt`
-    opt_dbgTransformationsFrom `hashWithSalt`
-    opt_dbgTransformationsLimit `hashWithSalt`
-    opt_dbgRewriteHistoryFile `hashWithSalt`
     opt_cachehdl `hashWithSalt`
     opt_clear `hashWithSalt`
     opt_primWarn `hashOverridingBool`
@@ -264,23 +284,15 @@ instance Hashable ClashOpts where
     hashOverridingBool s1 Never = hashWithSalt s1 (2 :: Int)
     infixl 0 `hashOverridingBool`
 
-    hashSet :: Hashable a => Int -> Set.Set a -> Int
-    hashSet = Set.foldl' hashWithSalt
-    infixl 0 `hashSet`
-
 defClashOpts :: ClashOpts
 defClashOpts
   = ClashOpts
-  { opt_dbgLevel            = DebugNone
-  , opt_dbgRewriteHistoryFile = Nothing
-  , opt_dbgTransformations  = Set.empty
-  , opt_dbgTransformationsFrom = 0
-  , opt_dbgTransformationsLimit = maxBound
-  , opt_inlineLimit         = 20
+  { opt_inlineLimit         = 20
   , opt_specLimit           = 20
   , opt_inlineFunctionLimit = 15
   , opt_inlineConstantLimit = 0
   , opt_evaluatorFuelLimit  = 20
+  , opt_debug               = defDebugOpts
   , opt_cachehdl            = True
   , opt_clear               = False
   , opt_primWarn            = True

clash-lib/src/Clash/Normalize.hs

@@ -65,7 +65,7 @@ import           Clash.Core.VarEnv
    mkVarEnv, mkVarSet, notElemVarEnv, notElemVarSet, nullVarEnv, unionVarEnv)
 import           Clash.Debug                      (traceIf)
 import           Clash.Driver.Types
-  (BindingMap, Binding(..), ClashOpts (..), DebugLevel (..))
+  (BindingMap, Binding(..), ClashOpts (..), DebugLevel (..), DebugOpts(..))
 import           Clash.Netlist.Types
   (HWMap, FilteredHWType(..))
 import           Clash.Netlist.Util
@@ -77,7 +77,7 @@ import           Clash.Normalize.Util
 import           Clash.Primitives.Types           (CompiledPrimMap)
 import           Clash.Rewrite.Combinators        ((>->),(!->),repeatR,topdownR)
 import           Clash.Rewrite.Types
-  (RewriteEnv (..), RewriteState (..), bindings, dbgLevel, dbgRewriteHistoryFile, extra,
+  (RewriteEnv (..), RewriteState (..), bindings, debugOpts, extra,
    tcCache, topEntities)
 import           Clash.Rewrite.Util
   (apply, isUntranslatableType, runRewriteSession)
@@ -123,11 +123,7 @@ runNormalization opts supply globals typeTrans reprs tcm tupTcm eval primMap rcs
   = runRewriteSession rwEnv rwState
   where
     rwEnv     = RewriteEnv
-                  (opt_dbgLevel opts)
-                  (opt_dbgTransformations opts)
-                  (opt_dbgTransformationsFrom opts)
-                  (opt_dbgTransformationsLimit opts)
-                  (opt_dbgRewriteHistoryFile opts)
+                  (opt_debug opts)
                   (opt_aggressiveXOpt opts)
                   typeTrans
                   tcm
@@ -238,7 +234,8 @@ normalize' nm = do
             -- for the ByteArray# inside of a Natural constant.
             -- (GHC-8.4 does this with tests/shouldwork/Numbers/Exp.hs)
             -- It will later be inlined by flattenCallTree.
-            lvl <- Lens.view dbgLevel
+            opts <- Lens.view debugOpts
+            let lvl = opt_level opts
             traceIf (lvl > DebugNone)
                     (concat [$(curLoc), "Expr belonging to bndr: ", nmS, " (:: "
                             , showPpr (varType nm')
@@ -377,7 +374,8 @@ flattenCallTree (CBranch (nm,(Binding nm' sp inl pr tm)) used) = do
       let tm1 = substTm "flattenCallTree.flattenExpr" subst tm
 
       -- NB: When -fclash-debug-history is on, emit binary data holding the recorded rewrite steps
-      rewriteHistFile <- Lens.view dbgRewriteHistoryFile
+      opts <- Lens.view debugOpts
+      let rewriteHistFile = opt_rewriteHistoryFile opts
       when (Maybe.isJust rewriteHistFile) $
         let !_ = unsafePerformIO
              $ BS.appendFile (Maybe.fromJust rewriteHistFile)

clash-lib/src/Clash/Normalize/Transformations/Case.hs

@@ -67,14 +67,14 @@ import Clash.Core.VarEnv
   ( InScopeSet, elemVarSet, extendInScopeSet, extendInScopeSetList, mkVarSet
   , unitVarSet, uniqAway)
 import Clash.Debug (traceIf)
-import Clash.Driver.Types (DebugLevel(..))
+import Clash.Driver.Types (DebugLevel(..), DebugOpts(opt_level))
 import Clash.Netlist.Types (FilteredHWType(..), HWType(..))
 import Clash.Netlist.Util (coreTypeToHWType, representableType)
 import qualified Clash.Normalize.Primitives as NP (undefined)
 import Clash.Normalize.Types (NormRewrite, NormalizeSession)
 import Clash.Rewrite.Combinators ((>-!))
 import Clash.Rewrite.Types
-  ( TransformContext(..), bindings, customReprs, dbgLevel, tcCache
+  ( TransformContext(..), bindings, customReprs, debugOpts, tcCache
   , typeTranslator, workFreeBinders)
 import Clash.Rewrite.Util (apply, changed, isFromInt, whnfRW)
 import Clash.Rewrite.WorkFree
@@ -286,7 +286,8 @@ caseCon' ctx@(TransformContext is0 _) e@(Case subj ty alts) = do
             let ret = caseOneAlt e
             -- Otherwise check whether the entire case-expression has a single
             -- alternative, and pick that one.
-            lvl <- Lens.view dbgLevel
+            opts <- Lens.view debugOpts
+            let lvl = opt_level opts
             if lvl > DebugNone then do
               let subjIsConst = isConstant subj
               -- In debug mode we always report missing evaluation rules for the

clash-lib/src/Clash/Normalize/Transformations/Inline.hs

@@ -73,13 +73,13 @@ import Clash.Core.VarEnv
   , foldlWithUniqueVarEnv', lookupVarEnv, lookupVarEnvDirectly, mkVarEnv
   , notElemVarSet, unionVarEnv, unionVarEnvWith, unitVarSet)
 import Clash.Debug (trace, traceIf)
-import Clash.Driver.Types (Binding(..), DebugLevel(..))
+import Clash.Driver.Types (Binding(..), DebugLevel(..), DebugOpts(opt_level))
 import Clash.Netlist.Util (representableType)
 import Clash.Primitives.Types
   (CompiledPrimMap, Primitive(..), TemplateKind(..))
 import Clash.Rewrite.Combinators (allR)
 import Clash.Rewrite.Types
-  ( TransformContext(..), bindings, curFun, customReprs, dbgLevel, extra
+  ( TransformContext(..), bindings, curFun, customReprs, debugOpts, extra
   , tcCache, topEntities, typeTranslator)
 import Clash.Rewrite.Util
   ( changed, inlineBinders, inlineOrLiftBinders, isJoinPointIn
@@ -392,7 +392,8 @@ inlineHO _ e@(App _ _)
               limit     <- Lens.use (extra.inlineLimit)
               if (Maybe.fromMaybe 0 isInlined) > limit
                 then do
-                  lvl <- Lens.view dbgLevel
+                  opts <- Lens.view debugOpts
+                  let lvl = opt_level opts
                   traceIf (lvl > DebugNone) ($(curLoc) ++ "InlineHO: " ++ show f ++ " already inlined " ++ show limit ++ " times in:" ++ show cf) (return e)
                 else do
                   bodyMaybe <- lookupVarEnv f <$> Lens.use bindings

clash-lib/src/Clash/Normalize/Util.hs

@@ -77,13 +77,13 @@ import           Clash.Core.VarEnv
   (VarEnv, emptyInScopeSet, emptyVarEnv, extendVarEnv, extendVarEnvWith,
    lookupVarEnv, unionVarEnvWith, unitVarEnv, extendInScopeSetList)
 import           Clash.Debug             (traceIf)
-import           Clash.Driver.Types      (BindingMap, Binding(..), DebugLevel (..))
+import           Clash.Driver.Types      (BindingMap, Binding(..), DebugLevel (..), DebugOpts(..))
 import           Clash.Normalize.Primitives (removedArg)
 import {-# SOURCE #-} Clash.Normalize.Strategy (normalization)
 import           Clash.Normalize.Types
 import           Clash.Primitives.Util   (constantArgs)
 import           Clash.Rewrite.Types
-  (RewriteMonad, TransformContext(..), bindings, curFun, dbgLevel, extra,
+  (RewriteMonad, TransformContext(..), bindings, curFun, debugOpts, extra,
    tcCache)
 import           Clash.Rewrite.Util
   (runRewrite, specialise, mkTmBinderFor, mkDerivedName)
@@ -511,7 +511,8 @@ rewriteExpr :: (String,NormRewrite) -- ^ Transformation to apply
             -> NormalizeSession Term
 rewriteExpr (nrwS,nrw) (bndrS,expr) (nm, sp) = do
   curFun .= (nm, sp)
-  lvl <- Lens.view dbgLevel
+  opts <- Lens.view debugOpts
+  let lvl = opt_level opts
   let before = showPpr expr
   let expr' = traceIf (lvl >= DebugFinal)
                 (bndrS ++ " before " ++ nrwS ++ ":\n\n" ++ before ++ "\n")

clash-lib/src/Clash/Rewrite/Types.hs

@@ -36,7 +36,6 @@ import Data.Hashable                         (Hashable)
 import Data.HashMap.Strict                   (HashMap)
 import Data.IntMap.Strict                    (IntMap)
 import Data.Monoid                           (Any)
-import qualified Data.Set                    as Set
 import Data.Text                             (Text)
 import GHC.Generics
 
@@ -52,7 +51,7 @@ import Clash.Core.Type           (Type)
 import Clash.Core.TyCon          (TyConName, TyConMap)
 import Clash.Core.Var            (Id)
 import Clash.Core.VarEnv         (InScopeSet, VarSet, VarEnv)
-import Clash.Driver.Types        (BindingMap, DebugLevel)
+import Clash.Driver.Types        (BindingMap, DebugOpts)
 import Clash.Netlist.Types       (FilteredHWType, HWMap)
 import Clash.Rewrite.WorkFree    (isWorkFree)
 import Clash.Util
@@ -111,16 +110,8 @@ Lens.makeLenses ''RewriteState
 -- | Read-only environment of a rewriting session
 data RewriteEnv
   = RewriteEnv
-  { _dbgLevel       :: DebugLevel
-  -- ^ Level at which we print debugging messages
-  , _dbgTransformations :: Set.Set String
-  -- ^ See ClashOpts.dbgTransformations
-  , _dbgTransformationsFrom :: Word
-  -- ^ See ClashOpts.opt_dbgTransformationsFrom
-  , _dbgTransformationsLimit :: Word
-  -- ^ See ClashOpts.opt_dbgTransformationsLimit
-  , _dbgRewriteHistoryFile :: Maybe FilePath
-  -- ^ See ClashOpts.opt_dbgRewriteHistory
+  { _debugOpts      :: DebugOpts
+  -- ^ Options for debugging during rewriting
   , _aggressiveXOpt :: Bool
   -- ^ Transformations to print debugging info for
   , _typeTranslator :: CustomReprs