diff --git a/Clash.hs b/Clash.hs index 17496b2ff1..6abb6de150 100644 --- a/Clash.hs +++ b/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 () diff --git a/changelog/2021-06-08T16_16_05+02_00_improved_debug_options.md b/changelog/2021-06-08T16_16_05+02_00_improved_debug_options.md new file mode 100644 index 0000000000..314ca45319 --- /dev/null +++ b/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. + diff --git a/clash-ghc/src-ghc/Clash/GHC/ClashFlags.hs b/clash-ghc/src-ghc/Clash/GHC/ClashFlags.hs index bdd92cc77b..7a8860b8e2 100644 --- a/clash-ghc/src-ghc/Clash/GHC/ClashFlags.hs +++ b/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 + Maintainer : QBayLogic B.V. -} {-# 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 } } diff --git a/clash-lib/src/Clash/Driver.hs b/clash-lib/src/Clash/Driver.hs index 12c66907c7..2008857654 100644 --- a/clash-lib/src/Clash/Driver.hs +++ b/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 diff --git a/clash-lib/src/Clash/Driver/Manifest.hs b/clash-lib/src/Clash/Driver/Manifest.hs index 46d954b006..221d758260 100644 --- a/clash-lib/src/Clash/Driver/Manifest.hs +++ b/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 diff --git a/clash-lib/src/Clash/Driver/Types.hs b/clash-lib/src/Clash/Driver/Types.hs index c8f0288259..9105338a33 100644 --- a/clash-lib/src/Clash/Driver/Types.hs +++ b/clash-lib/src/Clash/Driver/Types.hs @@ -2,7 +2,7 @@ Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , QBayLogic, Google Inc. - 2020 , QBayLogic + 2020-2021, QBayLogic License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -24,6 +24,8 @@ import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.Fixed import Data.Hashable +import Data.Maybe (isJust) +import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import Data.Text.Prettyprint.Doc @@ -78,25 +80,172 @@ data Binding a = Binding -- Global functions cannot be mutually recursive, only self-recursive. type BindingMap = VarEnv (Binding Term) --- | Debug Message Verbosity -data DebugLevel - = DebugNone - -- ^ Don't show debug messages - | DebugSilent - -- ^ Run invariant checks and err if violated (enabled by any debug flag) - | DebugFinal - -- ^ Show completely normalized expressions - | DebugCount - -- ^ Count transformations - | DebugName - -- ^ Show names of applied transformations - | DebugTry - -- ^ Show names of tried AND applied transformations - | DebugApplied - -- ^ Show sub-expressions after a successful rewrite - | DebugAll - -- ^ Show all sub-expressions on which a rewrite is attempted - deriving (Eq,Ord,Read,Enum,Generic,Hashable) +-- | Information to show about transformations during compilation. +-- +-- __NB__: The @Ord@ instance compares by amount of information. +data TransformationInfo + = None + -- ^ Show no information about transformations. + | FinalTerm + -- ^ Show the final term after all applied transformations. + | AppliedName + -- ^ Show the name of every transformation that is applied. + | AppliedTerm + -- ^ Show the name and result of every transformation that is applied. + | TryName + -- ^ Show the name of every transformation that is attempted, and the result + -- of every transformation that is applied. + | TryTerm + -- ^ Show the name and input to every transformation that is applied, and + -- the result of every transformation that is applied. + deriving (Eq, Generic, Hashable, Ord, Read, Show) + +-- | Options related to debugging. See 'ClashOpts' +data DebugOpts = DebugOpts + { dbg_invariants :: Bool + -- ^ Check that the results of applied transformations do not violate the + -- invariants for rewriting (e.g. no accidental shadowing, or type changes). + -- + -- Command line flag: -fclash-debug-invariants + , dbg_transformationInfo :: TransformationInfo + -- ^ The information to show when debugging a transformation. See the + -- 'TransformationInfo' type for different configurations. + -- + -- Command line flag: -fclash-debug-info (None|FinalTerm|AppliedName|AppliedTerm|TryName|TryTerm) + , dbg_transformations :: Set String + -- ^ List the transformations that are being debugged. When the set is empty, + -- all transformations are debugged. + -- + -- Command line flag: -fclash-debug-transformations t1[,t2...] + , dbg_countTransformations :: Bool + -- ^ Count how many times transformations are applied and provide a summary + -- at the end of normalization. This includes all transformations, not just + -- those in 'dbg_transformations'. + -- + -- Command line flag: -fclash-debug-count-transformations + , dbg_transformationsFrom :: Maybe Word + -- ^ Debug transformations applied after the nth transformation applied. This + -- includes all transformations, not just those in 'dbg_transformations'. + -- + -- Command line flag: -fclash-debug-transformations-from=N + , dbg_transformationsLimit :: Maybe Word + -- ^ Debug up to the nth applied transformation. If this limit is exceeded + -- then Clash will error. This includes all transformations, not just those + -- in 'dbg_transformations'. + -- + -- Command line flag: -fclash-debug-transformations-limit=N + , dbg_historyFile :: Maybe FilePath + -- ^ Save information about all applied transformations to a history file + -- for use with @clash-term@. + -- + -- Command line flag: -fclash-debug-history[=FILE] + } deriving (Show) + +instance Hashable DebugOpts where + hashWithSalt s DebugOpts{..} = + s `hashWithSalt` + dbg_invariants `hashWithSalt` + dbg_transformationInfo `hashSet` + dbg_transformations `hashWithSalt` + dbg_countTransformations `hashWithSalt` + dbg_transformationsFrom `hashWithSalt` + dbg_transformationsLimit `hashWithSalt` + dbg_historyFile + where + hashSet = Set.foldl' hashWithSalt + infixl 0 `hashSet` + +-- | Check whether the debugging options mean the compiler is debugging. This +-- is true only if at least one debugging feature is enabled, namely one of +-- +-- * checking for invariants +-- * showing info for transformations +-- * counting applied transformations +-- * limiting the number of transformations +-- +-- Other flags, such as writing to a history file or offsetting which applied +-- transformation to show information from do not affect the result, as it is +-- possible to enable these but still not perform any debugging checks in +-- functions like 'applyDebug'. If this is no longer the case, this function +-- will need to be changed. +isDebugging :: DebugOpts -> Bool +isDebugging opts = or + [ dbg_invariants opts + , dbg_transformationInfo opts > None + , dbg_countTransformations opts + , isJust (dbg_transformationsLimit opts) + ] + +-- | Check whether the requested information is available to the specified +-- transformation according to the options. e.g. +-- +-- @ +-- traceIf (hasDebugInfo AppliedName name opts) ("Trace something using: " <> show name) +-- @ +-- +-- This accounts for the set of transformations which are being debugged. For a +-- check which is agnostic to the a transformation, see 'hasTransformationInfo'. +hasDebugInfo :: TransformationInfo -> String -> DebugOpts -> Bool +hasDebugInfo info name opts = + isDebugged name && hasTransformationInfo info opts + where + isDebugged n = + let set = dbg_transformations opts + in Set.null set || Set.member n set + +-- | Check that the transformation info shown supports the requested info. +-- If the call-site is in the context of a particular transformation, +-- 'hasDebugInfo' should be used instead. +hasTransformationInfo :: TransformationInfo -> DebugOpts -> Bool +hasTransformationInfo info opts = + info <= dbg_transformationInfo opts + +-- NOTE [debugging options] +-- +-- The preset debugging options here provide backwards compatibility with the +-- old style DebugLevel enum. However it is also possible to have finer-grained +-- control over debugging by using individual flags which did not previously +-- exist, e.g. -fclash-debug-invariants. + +-- | -fclash-debug DebugNone +debugNone :: DebugOpts +debugNone = DebugOpts + { dbg_invariants = False + , dbg_transformationInfo = None + , dbg_transformations = Set.empty + , dbg_countTransformations = False + , dbg_transformationsFrom = Nothing + , dbg_transformationsLimit = Nothing + , dbg_historyFile = Nothing + } + +-- | -fclash-debug DebugSilent +debugSilent :: DebugOpts +debugSilent = debugNone { dbg_invariants = True } + +-- | -fclash-debug DebugFinal +debugFinal :: DebugOpts +debugFinal = debugSilent { dbg_transformationInfo = FinalTerm } + +-- | -fclash-debug DebugCount +debugCount :: DebugOpts +debugCount = debugFinal { dbg_countTransformations = True } + +-- | -fclash-debug DebugName +debugName :: DebugOpts +debugName = debugCount { dbg_transformationInfo = AppliedName } + +-- | -fclash-debug DebugTry +debugTry :: DebugOpts +debugTry = debugName { dbg_transformationInfo = TryName } + +-- | -fclash-debug DebugApplied +debugApplied :: DebugOpts +debugApplied = debugTry { dbg_transformationInfo = AppliedTerm } + +-- | -fclash-debug DebugAll +debugAll :: DebugOpts +debugAll = debugApplied { dbg_transformationInfo = TryTerm } -- | Options passed to Clash compiler data ClashOpts = ClashOpts @@ -124,30 +273,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 :: Int - -- ^ Only output debug information from (applied) transformation n - -- - -- Command line flag: -fclash-debug-transformations-from - , opt_dbgTransformationsLimit :: Int - -- ^ 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 +358,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 +386,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 = debugNone , opt_cachehdl = True , opt_clear = False , opt_primWarn = True diff --git a/clash-lib/src/Clash/Normalize.hs b/clash-lib/src/Clash/Normalize.hs index fc38d5fd9a..64cb4c9470 100644 --- a/clash-lib/src/Clash/Normalize.hs +++ b/clash-lib/src/Clash/Normalize.hs @@ -1,9 +1,10 @@ {-| Copyright : (C) 2012-2016, University of Twente, 2016 , Myrtle Software Ltd, - 2017 , Google Inc. + 2017 , Google Inc., + 2021 , QBayLogic B.V. License : BSD2 (see the file LICENSE) - Maintainer : Christiaan Baaij + Maintainer : QBayLogic B.V. Turn CoreHW terms into normalized CoreHW Terms -} @@ -65,7 +66,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 (..), DebugOpts(..)) import Clash.Netlist.Types (HWMap, FilteredHWType(..)) import Clash.Netlist.Util @@ -77,7 +78,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 +124,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,8 +235,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 - traceIf (lvl > DebugNone) + opts <- Lens.view debugOpts + traceIf (dbg_invariants opts) (concat [$(curLoc), "Expr belonging to bndr: ", nmS, " (:: " , showPpr (varType nm') , ") has a non-representable return type." @@ -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 = dbg_historyFile opts when (Maybe.isJust rewriteHistFile) $ let !_ = unsafePerformIO $ BS.appendFile (Maybe.fromJust rewriteHistFile) diff --git a/clash-lib/src/Clash/Normalize/Transformations/Case.hs b/clash-lib/src/Clash/Normalize/Transformations/Case.hs index 63dbe6473f..07fafc8578 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/Case.hs +++ b/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 (DebugOpts(dbg_invariants)) 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 @@ -283,19 +283,15 @@ caseCon' ctx@(TransformContext is0 _) e@(Case subj ty alts) = do -- that. -> caseCon ctx1 (Case (Literal (IntegerLiteral 0)) 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 - if lvl > DebugNone then do - let subjIsConst = isConstant subj - -- In debug mode we always report missing evaluation rules for the - -- primitive evaluator - traceIf (lvl > DebugNone && subjIsConst) - ("Unmatchable constant as case subject: " ++ showPpr subj ++ - "\nWHNF is: " ++ showPpr subj1) ret - else - ret + opts <- Lens.view debugOpts + -- When invariants are being checked, report missing evaluation + -- rules for the primitive evaluator. + traceIf (dbg_invariants opts && isConstant subj) + ("Unmatchable constant as case subject: " ++ showPpr subj ++ + "\nWHNF is: " ++ showPpr subj1) + -- Otherwise check whether the entire case-expression has a + -- single alternative, and pick that one. + (caseOneAlt e) -- The subject is a variable (Var v, [], _) | isNum0 (varType v) -> diff --git a/clash-lib/src/Clash/Normalize/Transformations/Inline.hs b/clash-lib/src/Clash/Normalize/Transformations/Inline.hs index b757109721..d441d6da01 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/Inline.hs +++ b/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(..), DebugOpts(dbg_invariants)) 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,8 +392,8 @@ inlineHO _ e@(App _ _) limit <- Lens.use (extra.inlineLimit) if (Maybe.fromMaybe 0 isInlined) > limit then do - lvl <- Lens.view dbgLevel - traceIf (lvl > DebugNone) ($(curLoc) ++ "InlineHO: " ++ show f ++ " already inlined " ++ show limit ++ " times in:" ++ show cf) (return e) + opts <- Lens.view debugOpts + traceIf (dbg_invariants opts) ($(curLoc) ++ "InlineHO: " ++ show f ++ " already inlined " ++ show limit ++ " times in:" ++ show cf) (return e) else do bodyMaybe <- lookupVarEnv f <$> Lens.use bindings case bodyMaybe of diff --git a/clash-lib/src/Clash/Normalize/Util.hs b/clash-lib/src/Clash/Normalize/Util.hs index 6f28d2c2d6..892d58e86f 100644 --- a/clash-lib/src/Clash/Normalize/Util.hs +++ b/clash-lib/src/Clash/Normalize/Util.hs @@ -77,13 +77,14 @@ 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(..), TransformationInfo(FinalTerm), hasTransformationInfo) 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,14 +512,14 @@ 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 before = showPpr expr - let expr' = traceIf (lvl >= DebugFinal) + let expr' = traceIf (hasTransformationInfo FinalTerm opts) (bndrS ++ " before " ++ nrwS ++ ":\n\n" ++ before ++ "\n") expr rewritten <- runRewrite nrwS emptyInScopeSet nrw expr' let after = showPpr rewritten - traceIf (lvl >= DebugFinal) + traceIf (hasTransformationInfo FinalTerm opts) (bndrS ++ " after " ++ nrwS ++ ":\n\n" ++ after ++ "\n") $ return rewritten diff --git a/clash-lib/src/Clash/Rewrite/Types.hs b/clash-lib/src/Clash/Rewrite/Types.hs index 5760bed3b9..53446f90d1 100644 --- a/clash-lib/src/Clash/Rewrite/Types.hs +++ b/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 @@ -79,7 +78,7 @@ data RewriteState extra = RewriteState -- TODO Given we now keep transformCounters, this should just be 'fold' -- over that map, otherwise the two counts could fall out of sync. - { _transformCounter :: {-# UNPACK #-} !Int + { _transformCounter :: {-# UNPACK #-} !Word -- ^ Total number of applied transformations , _transformCounters :: HashMap Text Word -- ^ Map that tracks how many times each transformation is applied @@ -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 :: Int - -- ^ See ClashOpts.opt_dbgTransformationsFrom - , _dbgTransformationsLimit :: Int - -- ^ 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 diff --git a/clash-lib/src/Clash/Rewrite/Util.hs b/clash-lib/src/Clash/Rewrite/Util.hs index 1bee94bcf3..681c86e893 100644 --- a/clash-lib/src/Clash/Rewrite/Util.hs +++ b/clash-lib/src/Clash/Rewrite/Util.hs @@ -37,7 +37,6 @@ import Control.Monad.Fail (MonadFail) #endif import qualified Control.Monad.State.Strict as State import qualified Control.Monad.Writer as Writer -import Data.Bool (bool) import Data.Bifunctor (bimap, second) import Data.Coerce (coerce) import Data.Functor.Const (Const (..)) @@ -94,7 +93,8 @@ import Clash.Core.VarEnv mkVarEnv, eltsVarSet, elemVarEnv, lookupVarEnv, extendVarEnv) import Clash.Debug import Clash.Driver.Types - (DebugLevel (..), BindingMap, Binding(..), IsPrim(..)) + (TransformationInfo(..), DebugOpts(..), BindingMap, Binding(..), IsPrim(..), + hasDebugInfo, hasTransformationInfo, isDebugging) import Clash.Netlist.Util (representableType) import Clash.Pretty (clashPretty, showDoc) import Clash.Rewrite.Types @@ -156,18 +156,15 @@ apply -- ^ Transformation to be applied -> Rewrite extra apply = \s rewrite ctx expr0 -> do - lvl <- Lens.view dbgLevel - dbgTranss <- Lens.view dbgTransformations - let isTryLvl = lvl == DebugTry || lvl >= DebugAll - isRelevantTrans = s `Set.member` dbgTranss || Set.null dbgTranss - traceIf (isTryLvl && isRelevantTrans) ("Trying: " ++ s) (pure ()) + opts <- Lens.view debugOpts + traceIf (hasDebugInfo TryName s opts) ("Trying: " <> s) (pure ()) (!expr1,anyChanged) <- Writer.listen (rewrite ctx expr0) let hasChanged = Monoid.getAny anyChanged Monad.when hasChanged (transformCounter += 1) -- NB: When -fclash-debug-history is on, emit binary data holding the recorded rewrite steps - rewriteHistFile <- Lens.view dbgRewriteHistoryFile + let rewriteHistFile = dbg_historyFile opts Monad.when (isJust rewriteHistFile && hasChanged) $ do (curBndr, _) <- Lens.use curFun let !_ = unsafePerformIO @@ -182,28 +179,13 @@ apply = \s rewrite ctx expr0 -> do } return () - dbgFrom <- Lens.view dbgTransformationsFrom - dbgLimit <- Lens.view dbgTransformationsLimit - let fromLimit = - if (dbgFrom, dbgLimit) == (0, maxBound) - then Nothing - else Just (dbgFrom, dbgLimit) - - if lvl == DebugNone - then return expr1 - else applyDebug lvl dbgTranss fromLimit s expr0 hasChanged expr1 + if isDebugging opts + then applyDebug s expr0 hasChanged expr1 + else return expr1 {-# INLINE apply #-} applyDebug - :: DebugLevel - -- ^ The current debugging level - -> Set.Set String - -- ^ Transformations to debug - -> Maybe (Int, Int) - -- ^ Only print debug information for transformations [n, n+limit]. See flag - -- documentation of "-fclash-debug-transformations-from" and - -- "-fclash-debug-transformations-limit" - -> String + :: String -- ^ Name of the transformation -> Term -- ^ Original expression @@ -212,82 +194,87 @@ applyDebug -> Term -- ^ New expression -> RewriteMonad extra Term -applyDebug lvl transformations fromLimit name exprOld hasChanged exprNew - | Just (from, limit) <- fromLimit = do - nTrans <- Lens.use transformCounter - if | nTrans - from > limit -> - error "-fclash-debug-transformations-limit exceeded" - | nTrans > from -> - applyDebug lvl transformations Nothing name exprOld hasChanged exprNew - | otherwise -> - pure exprNew - -applyDebug lvl transformations fromLimit name exprOld hasChanged exprNew - | not (Set.null transformations) = - let newLvl = bool DebugNone lvl (name `Set.member` transformations) in - applyDebug newLvl Set.empty fromLimit name exprOld hasChanged exprNew - -applyDebug lvl _transformations _fromLimit name exprOld hasChanged exprNew = - traceIf (lvl >= DebugAll) ("Tried: " ++ name ++ " on:\n" ++ before) $ do - nTrans <- pred <$> Lens.use transformCounter - - Monad.when (lvl >= DebugCount && hasChanged) $ - transformCounters %= HashMap.insertWith (const succ) (Text.pack name) 1 - - Monad.when (lvl > DebugNone && hasChanged) $ do - tcm <- Lens.view tcCache - let beforeTy = termType tcm exprOld - beforeFV = Lens.setOf freeLocalVars exprOld - afterTy = termType tcm exprNew - afterFV = Lens.setOf freeLocalVars exprNew - newFV = not (afterFV `Set.isSubsetOf` beforeFV) - accidentalShadows = findAccidentialShadows exprNew - - Monad.when newFV $ - error ( concat [ $(curLoc) - , "Error when applying rewrite ", name - , " to:\n" , before - , "\nResult:\n" ++ after ++ "\n" - , "It introduces free variables." - , "\nBefore: " ++ showPpr (Set.toList beforeFV) - , "\nAfter: " ++ showPpr (Set.toList afterFV) - ] - ) - Monad.when (not (null accidentalShadows)) $ - error ( concat [ $(curLoc) - , "Error when applying rewrite ", name - , " to:\n" , before - , "\nResult:\n" ++ after ++ "\n" - , "It accidentally creates shadowing let/case-bindings:\n" - , " ", showPpr accidentalShadows, "\n" - , "This usually means that a transformation did not extend " - , "or incorrectly extended its InScopeSet before applying a " - , "substitution." - ]) - - traceIf (lvl >= DebugApplied && (not (normalizeType tcm beforeTy `aeqType` normalizeType tcm afterTy))) - ( concat [ $(curLoc) - , "Error when applying rewrite ", name - , " to:\n" , before - , "\nResult:\n" ++ after ++ "\n" - , "Changes type from:\n", showPpr beforeTy - , "\nto:\n", showPpr afterTy - ] - ) (return ()) - - Monad.when (lvl >= DebugSilent && not hasChanged && not (exprOld `aeqTerm` exprNew)) $ - error $ $(curLoc) ++ "Expression changed without notice(" ++ name ++ "): before" - ++ before ++ "\nafter:\n" ++ after - - traceIf (lvl >= DebugName && hasChanged) (name <> " {" <> show nTrans <> "}") $ - traceIf (lvl >= DebugApplied && hasChanged) ("Changes when applying rewrite to:\n" - ++ before ++ "\nResult:\n" ++ after ++ "\n") $ - traceIf (lvl >= DebugAll && not hasChanged) ("No changes when applying rewrite " - ++ name ++ " to:\n" ++ after ++ "\n") $ - return exprNew +applyDebug name exprOld hasChanged exprNew = do + nTrans <- Lens.use transformCounter + opts <- Lens.view debugOpts + + let from = fromMaybe 0 (dbg_transformationsFrom opts) + let limit = fromMaybe maxBound (dbg_transformationsLimit opts) + + if | nTrans - from > limit -> + error "-fclash-debug-transformations-limit exceeded" + | nTrans <= from -> + pure exprNew + | otherwise -> + go opts where - before = showPpr exprOld - after = showPpr exprNew + go opts = traceIf (hasDebugInfo TryTerm name opts) ("Tried: " ++ name ++ " on:\n" ++ before) $ do + nTrans <- pred <$> Lens.use transformCounter + + Monad.when (dbg_countTransformations opts && hasChanged) $ do + transformCounters %= HashMap.insertWith (const succ) (Text.pack name) 1 + + Monad.when (dbg_invariants opts && hasChanged) $ do + tcm <- Lens.view tcCache + let beforeTy = termType tcm exprOld + beforeFV = Lens.setOf freeLocalVars exprOld + afterTy = termType tcm exprNew + afterFV = Lens.setOf freeLocalVars exprNew + newFV = not (afterFV `Set.isSubsetOf` beforeFV) + accidentalShadows = findAccidentialShadows exprNew + + Monad.when newFV $ + error ( concat [ $(curLoc) + , "Error when applying rewrite ", name + , " to:\n" , before + , "\nResult:\n" ++ after ++ "\n" + , "It introduces free variables." + , "\nBefore: " ++ showPpr (Set.toList beforeFV) + , "\nAfter: " ++ showPpr (Set.toList afterFV) + ] + ) + Monad.when (not (null accidentalShadows)) $ + error ( concat [ $(curLoc) + , "Error when applying rewrite ", name + , " to:\n" , before + , "\nResult:\n" ++ after ++ "\n" + , "It accidentally creates shadowing let/case-bindings:\n" + , " ", showPpr accidentalShadows, "\n" + , "This usually means that a transformation did not extend " + , "or incorrectly extended its InScopeSet before applying a " + , "substitution." + ]) + + -- TODO This check should not have the `hasDebugInfo` call in it, as + -- setting dbg_invariants should be all that is necessary to check this. + -- However, currently this error is very fragile, as Clash currently does + -- not keep casts, so "illegally" changing between `Signal dom a` and `a` + -- will trigger this error for many designs. + -- + -- This should be changed when #1064 (PR to keep casts in core) is merged. + Monad.when (hasDebugInfo AppliedTerm name opts && not (normalizeType tcm beforeTy `aeqType` normalizeType tcm afterTy)) $ + error ( concat [ $(curLoc) + , "Error when applying rewrite ", name + , " to:\n" , before + , "\nResult:\n" ++ after ++ "\n" + , "Changes type from:\n", showPpr beforeTy + , "\nto:\n", showPpr afterTy + ] + ) + + Monad.when (dbg_invariants opts && not hasChanged && not (exprOld `aeqTerm` exprNew)) $ + error $ $(curLoc) ++ "Expression changed without notice(" ++ name ++ "): before" + ++ before ++ "\nafter:\n" ++ after + + traceIf (hasDebugInfo AppliedName name opts && hasChanged) (name <> " {" <> show nTrans <> "}") $ + traceIf (hasDebugInfo AppliedTerm name opts && hasChanged) ("Changes when applying rewrite to:\n" + ++ before ++ "\nResult:\n" ++ after ++ "\n") $ + traceIf (hasDebugInfo TryTerm name opts && not hasChanged) ("No changes when applying rewrite " + ++ name ++ " to:\n" ++ after ++ "\n") $ + return exprNew + where + before = showPpr exprOld + after = showPpr exprNew -- | Perform a transformation on a Term runRewrite @@ -307,9 +294,9 @@ runRewriteSession :: RewriteEnv -> RewriteMonad extra a -> a runRewriteSession r s m = - traceIf (_dbgLevel r >= DebugCount) + traceIf (dbg_countTransformations (_debugOpts r)) ("Clash: Transformations:\n" ++ Text.unpack (showCounters (s' ^. transformCounters))) $ - traceIf (_dbgLevel r > DebugSilent) + traceIf (None < dbg_transformationInfo (_debugOpts r)) ("Clash: Applied " ++ show (s' ^. transformCounter) ++ " transformations") a where @@ -745,7 +732,7 @@ specialise' :: Lens' extra (Map.Map (Id, Int, Either Term Type) Id) -- ^ Lens in -> Either Term Type -- ^ Argument to specialize on -> RewriteMonad extra Term specialise' specMapLbl specHistLbl specLimitLbl (TransformContext is0 _) e (Var f, args, ticks) specArgIn = do - lvl <- Lens.view dbgLevel + opts <- Lens.view debugOpts tcm <- Lens.view tcCache -- Don't specialise TopEntities @@ -753,8 +740,11 @@ specialise' specMapLbl specHistLbl specLimitLbl (TransformContext is0 _) e (Var if f `elemVarSet` topEnts then do case specArgIn of - Left _ -> traceIf (lvl >= DebugNone) ("Not specializing TopEntity: " ++ showPpr (varName f)) (return e) - Right tyArg -> traceIf (lvl >= DebugApplied) ("Dropping type application on TopEntity: " ++ showPpr (varName f) ++ "\ntype:\n" ++ showPpr tyArg) $ + Left _ -> do + traceM ("Not specializing TopEntity: " ++ showPpr (varName f)) + return e + Right tyArg -> + traceIf (hasTransformationInfo AppliedTerm opts) ("Dropping type application on TopEntity: " ++ showPpr (varName f) ++ "\ntype:\n" ++ showPpr tyArg) $ -- TopEntities aren't allowed to be semantically polymorphic. -- But using type equality constraints they may be syntactically polymorphic. -- > topEntity :: forall dom . (dom ~ "System") => Signal dom Bool -> Signal dom Bool @@ -778,7 +768,7 @@ specialise' specMapLbl specHistLbl specLimitLbl (TransformContext is0 _) e (Var case specM of -- Use previously specialized function Just f' -> - traceIf (lvl >= DebugApplied) + traceIf (hasTransformationInfo AppliedTerm opts) ("Using previous specialization of " ++ showPpr (varName f) ++ " on " ++ (either showPpr showPpr) specAbs ++ ": " ++ showPpr (varName f')) $ changed $ mkApps (mkTicks (Var f') ticks) (args ++ specVars) diff --git a/clash-lib/tests/Test/Clash/Rewrite.hs b/clash-lib/tests/Test/Clash/Rewrite.hs index 5090d3f663..dd8d02d715 100644 --- a/clash-lib/tests/Test/Clash/Rewrite.hs +++ b/clash-lib/tests/Test/Clash/Rewrite.hs @@ -22,7 +22,7 @@ import qualified Clash.Core.Literal as C import qualified Clash.Core.Type as C import qualified Clash.Core.Var as C import Clash.Core.VarEnv (InScopeSet, emptyVarSet, emptyVarEnv, emptyInScopeSet) -import Clash.Driver.Types (DebugLevel(DebugSilent)) +import Clash.Driver.Types (debugSilent) import Clash.Rewrite.Types import Clash.Rewrite.Util (runRewrite) import Clash.Normalize.Types @@ -44,7 +44,6 @@ import qualified Language.Haskell.TH.Quote as TH import qualified Data.List as List import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map -import qualified Data.Set as Set import qualified Data.IntMap as IntMap import qualified Data.Text as Text @@ -61,11 +60,7 @@ lookupTM u tm = case HashMap.lookup u tm of instance Default RewriteEnv where def = RewriteEnv - { _dbgLevel=DebugSilent - , _dbgTransformations=Set.empty - , _dbgTransformationsFrom=0 - , _dbgTransformationsLimit=maxBound - , _dbgRewriteHistoryFile=Nothing + { _debugOpts=debugSilent , _aggressiveXOpt=False , _typeTranslator=error "_typeTranslator: NYI" , _tcCache=emptyUniqMap diff --git a/docs/developing-hardware/flags.rst b/docs/developing-hardware/flags.rst index d956ed88b3..910cc53ff4 100644 --- a/docs/developing-hardware/flags.rst +++ b/docs/developing-hardware/flags.rst @@ -33,6 +33,34 @@ Clash Compiler Flags **Default:** ``DebugNone`` + .. info:: This flag exists for backwards compatibility. It is now possible to + set debugging flags individually with `-fclash-debug-invariants`, + `-fclash-debug-info` and `-fclash-debug-count-transformations`. + +-fclash-debug-invariants + Check invariants while debugging and print warnings / errors which may be + useful, such as alterting when unexpected changes occur or when a + transformation introduces free variables / shadowing. + +-fclash-debug-info + Specify the information to show about individual transformations while + debugging. From least to most information, these are + + - ``None`` to show no information + - ``FinalTerm`` to show the final result of normalization + - ``AppliedName`` to show the names of applied transformations + - ``AppliedTerm`` to show the result of applied transformations + - ``TryName`` to show the names of attempted transforamtions, as well as the + result of any transformations which are applied + - ``TryTerm`` to show the names and results of all transformations attempted + whether they were applied or not + + **Default:** ``None`` + +-fclash-debug-count-transformations + Count the transformations that are applied and print a summary at the end + of the normalization phase. + -fclash-debug-history[=FILENAME] Saves all applied rewrites into ``FILENAME``, for later analysis with the clash-term tool. @@ -48,8 +76,8 @@ Clash Compiler Flags **Default:** [] --fclash-debug-transformations-from - Only print debug output from applied transformation ``n`` and onwards. +-fclash-debug-transformations-from=N + Only print debug output from applied transformation ``N`` and onwards. .. code-block:: bash @@ -57,8 +85,8 @@ Clash Compiler Flags **Default:** 0 --fclash-debug-transformations-limit - Only print debug output for ``n`` applied transformations. +-fclash-debug-transformations-limit=N + Only print debug output for ``N`` applied transformations. .. code-block:: bash