Print Magenta text when printing dubious blackbox warning

clash-lib/clash-lib.cabal

@@ -104,6 +104,7 @@ Library
                       ViewPatterns
 
   Build-depends:      aeson                   >= 0.6.2.0  && < 1.5,
+                      ansi-terminal           >= 0.8.0.0  && < 0.9,
                       ansi-wl-pprint          >= 0.6.8.2  && < 1.0,
                       attoparsec              >= 0.10.4.0 && < 0.14,
                       base                    >= 4.8      && < 5,

clash-lib/src/Clash/Driver.hs

@@ -226,7 +226,7 @@ generateHDL reprs bindingsMap hdlState primMap tcm tupTcm typeTrans eval
 
       -- 2. Generate netlist for topEntity
       (netlist,seen') <-
-        genNetlist opts reprs transformedBindings is0 topEntities primMap
+        genNetlist False opts reprs transformedBindings is0 topEntities primMap
                    tcm typeTrans iw mkId extId seen hdlDir prefixM topEntity
 
       netlistTime <- netlist `deepseq` Clock.getCurrentTime
@@ -262,7 +262,7 @@ generateHDL reprs bindingsMap hdlState primMap tcm tupTcm typeTrans eval
 
       -- 2. Generate netlist for topEntity
       (netlist,seen'') <-
-        genNetlist opts reprs transformedBindings is0 topEntities primMap
+        genNetlist True opts reprs transformedBindings is0 topEntities primMap
                    tcm typeTrans iw mkId extId seen' hdlDir prefixM tb
 
       netlistTime <- netlist `deepseq` Clock.getCurrentTime

clash-lib/src/Clash/Netlist.hs

@@ -73,7 +73,9 @@ import           Clash.Util
 -- | Generate a hierarchical netlist out of a set of global binders with
 -- @topEntity@ at the top.
 genNetlist
-  :: ClashOpts
+  :: Bool
+  -- ^ Whether this we're compiling a testbench (suppresses certain warnings)
+  -> ClashOpts
   -- ^ Options Clash was called with
   -> CustomReprs
   -- ^ Custom bit representations for certain types
@@ -104,9 +106,10 @@ genNetlist
   -> Id
   -- ^ Name of the @topEntity@
   -> IO ([(SrcSpan,[Identifier],Component)],[Identifier])
-genNetlist opts reprs globals is0 tops primMap tcm typeTrans iw mkId extId seen env prefixM topEntity = do
-  (_,s) <- runNetlistMonad opts reprs globals is0 (mkTopEntityMap tops) primMap tcm typeTrans
-             iw mkId extId seen env prefixM $ genComponent topEntity
+genNetlist isTb opts reprs globals is0 tops primMap tcm typeTrans iw mkId extId seen env prefixM topEntity = do
+  (_,s) <- runNetlistMonad isTb opts reprs globals is0 (mkTopEntityMap tops)
+             primMap tcm typeTrans iw mkId extId seen env prefixM $
+             genComponent topEntity
   return ( eltsVarEnv $ _components s
          , _seenComps s
          )
@@ -118,7 +121,9 @@ genNetlist opts reprs globals is0 tops primMap tcm typeTrans iw mkId extId seen
 
 -- | Run a NetlistMonad action in a given environment
 runNetlistMonad
-  :: ClashOpts
+  :: Bool
+  -- ^ Whether this we're compiling a testbench (suppresses certain warnings)
+  -> ClashOpts
   -- ^ Options Clash was called with
   -> CustomReprs
   -- ^ Custom bit representations for certain types
@@ -149,14 +154,14 @@ runNetlistMonad
   -> NetlistMonad a
   -- ^ Action to run
   -> IO (a, NetlistState)
-runNetlistMonad opts reprs s is0 tops p tcm typeTrans iw mkId extId seenIds_ env prefixM
+runNetlistMonad isTb opts reprs s is0 tops p tcm typeTrans iw mkId extId seenIds_ env prefixM
   = flip runStateT s'
   . runNetlist
   where
     s' =
       NetlistState
         s 0 emptyVarEnv p typeTrans tcm (StrictText.empty,noSrcSpan) iw mkId
-        extId [] seenIds' Set.empty names tops env 0 prefixM reprs is0 opts
+        extId [] seenIds' Set.empty names tops env 0 prefixM reprs is0 opts isTb
 
     (seenIds',names) = genNames mkId prefixM seenIds_ emptyVarEnv s
 

clash-lib/src/Clash/Netlist/BlackBox.hs

@@ -32,7 +32,11 @@ import           Data.Text.Lazy                (fromStrict)
 import qualified Data.Text.Lazy                as Text
 import           Data.Text                     (unpack)
 import qualified Data.Text                     as TextS
-import           System.IO                     (hPutStrLn, stderr)
+import qualified System.Console.ANSI           as ANSI
+import           System.Console.ANSI
+  ( hSetSGR, SGR(SetConsoleIntensity, SetColor), Color(Magenta)
+  , ConsoleIntensity(BoldIntensity), ConsoleLayer(Foreground), ColorIntensity(Vivid))
+import           System.IO                     (hPutStrLn, stderr, hFlush)
 
 -- import           Clash.Backend                 as N
 import           Clash.Core.DataCon            as D (dcTag)
@@ -190,14 +194,19 @@ mkPrimitive bbEParen bbEasD dst nm args ty = do
         Just p@(P.BlackBox {outputReg = wr, warning = wn}) -> do
           -- Print blackbox warning if warning is set on this blackbox and
           -- printing warnings is enabled globally
+          isTB <- Lens.use isTestBench
           primWarn <- opt_primWarn <$> Lens.use clashOpts
           seen <- Set.member nm <$> Lens.use seenPrimitives
-          case (wn, primWarn, seen) of
-            (Just msg, True, False) ->
+          case (wn, primWarn, seen, isTB) of
+            (Just msg, True, False, False) -> do
+              liftIO $ hSetSGR stderr [SetConsoleIntensity BoldIntensity]
+              liftIO $ hSetSGR stderr [SetColor Foreground Vivid Magenta]
               liftIO $ hPutStrLn stderr $ "Dubious primitive instantiation "
                                        ++ "warning (disable with "
                                        ++ "-fclash-no-prim-warn): "
                                        ++ unpack msg
+              liftIO $ hSetSGR stderr [ANSI.Reset]
+              liftIO $ hFlush stderr
             _ ->
               return ()
 

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

@@ -102,6 +102,8 @@ data NetlistState
   , _globalInScope  :: InScopeSet
   , _clashOpts      :: ClashOpts
   -- ^ Settings Clash was called with
+  , _isTestBench    :: Bool
+  -- ^ Whether we're compiling a testbench (suppresses some warnings)
   }
 
 -- | Signal reference