More granular debug options

The old DebugLevel style debug options are replaced with a more
granular style, where different options can be set independently.
This allows things not previously possible, such as counting
transformations without having to print any normalized core.

The old -fclash-debug flag still works for backwards compatibility.
Additional command line flags are now available to directly set
options from the new type:

  -fclash-debug-invariants checks for invariants and displays
  warnings / errors. Setting this alone is equivalent to DebugSilent.

  -fclash-debug-info sets the amount of information to display
  when applying transformations. This overlaps a lot with the old
  DebugLevel type, but is named more consistently.

  -fclash-debug-count-transformations counts the number of
  transformations applied (without showing any normalized core
  like DebugCount did)

Author: Alex McKenna

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,6 +140,16 @@ 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) { opt_invariants = True } }
+
+setDebugCountTransformations :: IORef ClashOpts -> IO ()
+setDebugCountTransformations r =
+  modifyIORef r $ \c ->
+    c { opt_debug = (opt_debug c) { opt_countTransformations = True } }
+
 setDebugTransformations :: IORef ClashOpts -> String -> EwM IO ()
 setDebugTransformations r s =
   liftEwM (modifyIORef r (setTransformations transformations))
@@ -146,35 +160,72 @@ setDebugTransformations r s =
   setTransformations xs opts =
     opts { opt_debug = (opt_debug opts) { opt_transformations = xs } }
 
-setDebugTransformationsFrom :: IORef ClashOpts -> Maybe Int -> EwM IO ()
-setDebugTransformationsFrom r (Just n) =
+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) { opt_transformationsFrom = from } }
+    opts { opt_debug = (opt_debug opts) { opt_transformationsFrom = Just from } }
 
-setDebugTransformationsFrom _r Nothing = pure ()
-
-setDebugTransformationsLimit :: IORef ClashOpts -> Maybe Int -> EwM IO ()
-setDebugTransformationsLimit r (Just n) =
+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) { 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 (setLevel dbgLvl)
-                   when (dbgLvl > DebugNone) $ setNoCache r -- when debugging disable cache
-  Nothing     -> addWarn (s ++ " is an invalid debug level")
+    opts { opt_debug = (opt_debug opts) { opt_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 = (opt_debug opts) { opt_level = lvl } }
+    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) { opt_transformationInfo = info } }
 
 setNoCache :: IORef ClashOpts -> IO ()
 setNoCache r = modifyIORef r (\c -> c {opt_cachehdl = False})
@@ -268,4 +319,4 @@ setRewriteHistoryFile r arg = do
   modifyIORef r (setFile fileNm)
  where
   setFile file opts =
-    opts { opt_debug = (opt_debug opts) { opt_rewriteHistoryFile = Just file } }
+    opts { opt_debug = (opt_debug opts) { opt_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_rewriteHistoryFile (opt_debug opts) of
+    case opt_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

@@ -372,9 +372,9 @@ readFreshManifest tops (bindingsMap, topId) primMap opts@(ClashOpts{..}) clashMo
 
       -- 1. Debug
       opt_debug = opt_debug
-        { opt_level = DebugNone
+        { opt_invariants = False
         , opt_transformations = Set.empty
-        , opt_rewriteHistoryFile = Nothing
+        , opt_historyFile = Nothing
         }
 
       -- 2. Caching