Improved -fclash-debug-* flags

Clash.hs

@@ -63,7 +63,7 @@ doHDL b src = do
 
   generateHDL (buildCustomReprs reprs) domainConfs bindingsMap (Just b) primMap tcm tupTcm
     (ghcTypeToHWType WORD_SIZE_IN_BITS True) evaluator topEntities Nothing
-    defClashOpts{opt_cachehdl = False, opt_dbgLevel = DebugSilent, opt_clear = True}
+    defClashOpts{opt_cachehdl = False, opt_debug = debugSilent, opt_clear = True}
     (startTime,prepTime)
 
 main :: IO ()

changelog/2021-06-08T16_16_05+02_00_improved_debug_options.md

@@ -0,0 +1,10 @@
+CHANGED: Clash now supports more expressive debug options at the command line [#1800](https://github.com/clash-lang/clash-compiler/issues/1800).
+
+With the old `DebugLevel` type for setting debug options, it was not possible to set certain debug options without implying others, i.e. counting transformations was not possible without also printing at least the final normalized core for a term. It is now possible to set options individually with new flags:
+
+  * -fclash-debug-invariants to check invariants and print warnings / errors
+  * -fclash-debug-info to choose how much information to show about individual transformations
+  * -fclash-debug-count-transformations to print a tally of each transformation applied
+
+The old -fclash-debug flag is still available for backwards compatibility, and each `DebugLevel` is now a synonym for setting these options together.
+

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

@@ -1,8 +1,9 @@
 {-|
   Copyright   :  (C) 2015-2016, University of Twente,
-                     2016-2017, Myrtle Software Ltd
+                     2016-2017, Myrtle Software Ltd,
+                     2021,      QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
-  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
 
 {-# LANGUAGE CPP #-}
@@ -54,9 +55,12 @@ parseClashFlagsFull flagsAvialable args = do
 flagsClash :: IORef ClashOpts -> [Flag IO]
 flagsClash r = [
     defFlag "fclash-debug"                       $ SepArg (setDebugLevel r)
+  , defFlag "fclash-debug-info"                  $ SepArg (setDebugInfo r)
+  , defFlag "fclash-debug-invariants"            $ NoArg (liftEwM (setDebugInvariants r))
+  , defFlag "fclash-debug-count-transformations" $ NoArg (liftEwM (setDebugCountTransformations r))
   , defFlag "fclash-debug-transformations"       $ SepArg (setDebugTransformations r)
-  , defFlag "fclash-debug-transformations-from"  $ OptIntSuffix (setDebugTransformationsFrom r)
-  , defFlag "fclash-debug-transformations-limit" $ OptIntSuffix (setDebugTransformationsLimit r)
+  , defFlag "fclash-debug-transformations-from"  $ IntSuffix (setDebugTransformationsFrom r)
+  , defFlag "fclash-debug-transformations-limit" $ IntSuffix (setDebugTransformationsLimit r)
   , defFlag "fclash-debug-history"               $ AnySuffix (liftEwM . (setRewriteHistoryFile r))
   , defFlag "fclash-hdldir"                      $ SepArg (setHdlDir r)
   , defFlag "fclash-hdlsyn"                      $ SepArg (setHdlSyn r)
@@ -136,31 +140,92 @@ setSpecLimit :: IORef ClashOpts
              -> IO ()
 setSpecLimit r n = modifyIORef r (\c -> c {opt_specLimit = n})
 
+setDebugInvariants :: IORef ClashOpts -> IO ()
+setDebugInvariants r =
+  modifyIORef r $ \c ->
+    c { opt_debug = (opt_debug c) { dbg_invariants = True } }
+
+setDebugCountTransformations :: IORef ClashOpts -> IO ()
+setDebugCountTransformations r =
+  modifyIORef r $ \c ->
+    c { opt_debug = (opt_debug c) { dbg_countTransformations = True } }
+
 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
 
-setDebugTransformationsFrom :: IORef ClashOpts -> Maybe Int -> EwM IO ()
-setDebugTransformationsFrom r (Just n) =
-  liftEwM (modifyIORef r (\c -> c {opt_dbgTransformationsFrom = n}))
-setDebugTransformationsFrom _r Nothing = pure ()
-
-setDebugTransformationsLimit :: IORef ClashOpts -> Maybe Int -> EwM IO ()
-setDebugTransformationsLimit r (Just n) =
-  liftEwM (modifyIORef r (\c -> c {opt_dbgTransformationsLimit = n}))
-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})
-                   when (dbgLvl > DebugNone) $ setNoCache r -- when debugging disable cache
-  Nothing     -> addWarn (s ++ " is an invalid debug level")
+  setTransformations xs opts =
+    opts { opt_debug = (opt_debug opts) { dbg_transformations = xs } }
+
+setDebugTransformationsFrom :: IORef ClashOpts -> Int -> EwM IO ()
+setDebugTransformationsFrom r n =
+  liftEwM (modifyIORef r (setFrom (fromIntegral n)))
+ where
+  setFrom from opts =
+    opts { opt_debug = (opt_debug opts) { dbg_transformationsFrom = Just from } }
+
+setDebugTransformationsLimit :: IORef ClashOpts -> Int -> EwM IO ()
+setDebugTransformationsLimit r n =
+  liftEwM (modifyIORef r (setLimit (fromIntegral n)))
+ where
+  setLimit limit opts =
+    opts { opt_debug = (opt_debug opts) { dbg_transformationsLimit = Just limit } }
+
+setDebugLevel :: IORef ClashOpts -> String -> EwM IO ()
+setDebugLevel r s =
+  case s of
+    "DebugNone" ->
+      liftEwM $ modifyIORef r (setLevel debugNone)
+    "DebugSilent" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugSilent)
+        setNoCache r
+    "DebugFinal" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugFinal)
+        setNoCache r
+    "DebugCount" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugCount)
+        setNoCache r
+    "DebugName" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugName)
+        setNoCache r
+    "DebugTry" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugTry)
+        setNoCache r
+    "DebugApplied" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugApplied)
+        setNoCache r
+    "DebugAll" ->
+      liftEwM $ do
+        modifyIORef r (setLevel debugAll)
+        setNoCache r
+    _ ->
+      addWarn (s ++ " is an invalid debug level")
+ where
+  setLevel lvl opts =
+    opts { opt_debug = lvl }
+
+setDebugInfo :: IORef ClashOpts -> String -> EwM IO ()
+setDebugInfo r s =
+  case readMaybe s of
+    Just info ->
+      liftEwM $ do
+        modifyIORef r (setInfo info)
+        when (info /= None) (setNoCache r)
+
+    Nothing ->
+      addWarn (s ++ " is an invalid debug info")
+ where
+  setInfo info opts =
+    opts { opt_debug = (opt_debug opts) { dbg_transformationInfo = info } }
 
 setNoCache :: IORef ClashOpts -> IO ()
 setNoCache r = modifyIORef r (\c -> c {opt_cachehdl = False})
@@ -251,4 +316,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) { dbg_historyFile = 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 dbg_historyFile (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
+        { dbg_invariants = False
+        , dbg_transformations = Set.empty
+        , dbg_historyFile = Nothing
+        }
 
       -- 2. Caching
     , opt_cachehdl = True