New: clashCompileError

It is almost identical to the version proposed by @basile-henry in issue #2020: #2020 (comment)
clash-lang · Jan 8, 2023 · 8abfe3d · 8abfe3d
1 parent 53d32a6
commit 8abfe3d
Show file tree

Hide file tree

Showing 6 changed files with 95 additions and 4 deletions.
diff --git a/changelog/2023-01-06T16_16_24+01_00_add_clashCompileError b/changelog/2023-01-06T16_16_24+01_00_add_clashCompileError
@@ -0,0 +1,4 @@
+NEW: `clashCompileError`: make HDL generation error out with a custom error
+message. Simulation in Clash will also error when the function is evaluated,
+including a call stack. HDL generation unfortunately does not include a call
+stack.
diff --git a/clash-lib/clash-lib.cabal b/clash-lib/clash-lib.cabal
@@ -51,7 +51,7 @@ Author:               The Clash Authors
 Maintainer:           QBayLogic B.V. <devops@qbaylogic.com>
 Copyright:            Copyright © 2012-2016, University of Twente,
                                   2016-2019, Myrtle Software Ltd,
-                                  2017-2022, QBayLogic B.V., Google Inc.
+                                  2017-2023, QBayLogic B.V., Google Inc.
 Category:             Hardware
 Build-type:           Simple
 
@@ -273,6 +273,7 @@ Library
                       Clash.Primitives.GHC.Literal
                       Clash.Primitives.GHC.Word
                       Clash.Primitives.Intel.ClockGen
+                      Clash.Primitives.Prelude
                       Clash.Primitives.Sized.ToInteger
                       Clash.Primitives.Sized.Signed
                       Clash.Primitives.Sized.Vector

diff --git a/clash-lib/src/Clash/Driver.hs b/clash-lib/src/Clash/Driver.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2012-2016, University of Twente,
                      2016-2017, Myrtle Software Ltd,
                      2017     , QBayLogic, Google Inc.
-                     2020-2022, QBayLogic,
+                     2020-2023, QBayLogic,
                      2022     , Google Inc.
 
   License     :  BSD2 (see the file LICENSE)
@@ -139,6 +139,7 @@ import qualified Clash.Primitives.Sized.Vector    as P
 import qualified Clash.Primitives.GHC.Int         as P
 import qualified Clash.Primitives.GHC.Word        as P
 import qualified Clash.Primitives.Intel.ClockGen  as P
+import qualified Clash.Primitives.Prelude         as P
 import qualified Clash.Primitives.Verification    as P
 import           Clash.Primitives.Types
 import           Clash.Signal.Internal
@@ -577,6 +578,7 @@ knownBlackBoxFunctions =
     [ ('P.checkBBF, P.checkBBF)
     , ('P.bvToIntegerVHDL, P.bvToIntegerVHDL)
     , ('P.bvToIntegerVerilog, P.bvToIntegerVerilog)
+    , ('P.clashCompileErrorBBF, P.clashCompileErrorBBF)
     , ('P.foldBBF, P.foldBBF)
     , ('P.indexIntVerilog, P.indexIntVerilog)
     , ('P.indexToIntegerVerilog, P.indexToIntegerVerilog)

diff --git a/clash-lib/src/Clash/Primitives/Prelude.hs b/clash-lib/src/Clash/Primitives/Prelude.hs
@@ -0,0 +1,54 @@
+{-|
+  Copyright   :  (C) 2022     , Myrtle.ai,
+                     2023     , QBayLogic B.V.,
+  License     :  BSD2 (see the file LICENSE)
+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
+
+  Blackbox functions for primitives in one of the @Prelude@ modules.
+-}
+
+module Clash.Primitives.Prelude
+  ( clashCompileErrorBBF
+  ) where
+
+import Control.Monad.State (State)
+import GHC.Stack (HasCallStack)
+import Prelude
+
+import Clash.Backend (Backend)
+import Clash.Netlist.BlackBox.Types (BlackBoxFunction, emptyBlackBoxMeta)
+import Clash.Netlist.BlackBox.Util (exprToString)
+import Clash.Netlist.Types
+  (BlackBox(..), BlackBoxContext(..), TemplateFunction(..))
+import Data.Text.Prettyprint.Doc.Extra (Doc)
+
+clashCompileErrorBBF :: HasCallStack => BlackBoxFunction
+clashCompileErrorBBF _isD _primName _args _ty =
+  pure (Right (emptyBlackBoxMeta, bb))
+ where
+  bb = BBFunction (show 'clashCompileErrorBBF) 0 clashCompileErrorTF
+  clashCompileErrorTF
+    | ( _hasCallStack
+      : msg
+      : _ ) <- [0..]
+    = TemplateFunction [msg] (const True) clashCompileErrorTemplate
+    | otherwise = undefined
+
+clashCompileErrorTemplate ::
+  HasCallStack =>
+  Backend s =>
+  BlackBoxContext ->
+  State s Doc
+clashCompileErrorTemplate bbCtx
+  | [ _hasCallStack
+    , (msgE, _, _)
+    ] <- bbInputs bbCtx
+  = case exprToString msgE of
+      Just msg ->
+        errorWithoutStackTrace $ "clashCompileError: " <> msg
+      Nothing ->
+        error $ "Error while processing clashCompileError: 'msg' argument " <>
+          "does not reduce to a string: " <> show msgE
+  | otherwise
+  = error $ "Error while processing clashCompileError: bad bbContext: " <>
+      show bbCtx
diff --git a/clash-prelude/src/Clash/Explicit/Prelude.hs b/clash-prelude/src/Clash/Explicit/Prelude.hs
@@ -2,7 +2,8 @@
 Copyright  :  (C) 2013-2016, University of Twente,
                   2017     , Google Inc.
                   2019     , Myrtle Software Ltd,
-                  2021-2022, QBayLogic B.V.
+                  2021-2023, QBayLogic B.V.,
+                  2022     , Myrtle.ai,
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -11,6 +12,8 @@ defined in "Clash.Prelude".
 -}
 
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 
 {-# LANGUAGE Unsafe #-}
 
@@ -74,6 +77,8 @@ module Clash.Explicit.Prelude
   , isFalling
   , riseEvery
   , oscillate
+    -- * Static assertions
+  , clashCompileError
     -- * Testbench functions
   , assert
   , stimuliGenerator
@@ -146,11 +151,14 @@ where
 import Control.Applicative
 import Data.Bits
 import Data.Default.Class
+import Data.String.Interpolate (__i)
+import GHC.Stack (HasCallStack, withFrozenCallStack)
 import GHC.TypeLits
 import GHC.TypeLits.Extra
 import Language.Haskell.TH.Syntax  (Lift(..))
 import Clash.HaskellPrelude
 
+import Clash.Annotations.Primitive (Primitive(..))
 import Clash.Annotations.TopEntity
 import Clash.Class.AutoReg
 import Clash.Class.BitPack
@@ -276,3 +284,22 @@ windowD clk rst en x =
       next = x +>> prev
   in  prev
 {-# INLINABLE windowD #-}
+
+-- | Same as 'error' but will make HDL generation fail if included in the
+-- final circuit.
+--
+-- This is useful for the error case of static assertions.
+--
+-- Note that the error message needs to be a literal, and during HDL generation
+-- the error message does not include a stack trace, so it had better be
+-- descriptive.
+clashCompileError :: forall a . HasCallStack => String -> a
+clashCompileError msg = withFrozenCallStack $ error msg
+{-# NOINLINE clashCompileError #-}
+{-# ANN clashCompileError (
+  let primName = 'clashCompileError
+  in InlineYamlPrimitive [minBound..] [__i|
+    BlackBoxHaskell:
+      name: #{primName}
+      templateFunction: Clash.Primitives.Prelude.clashCompileErrorBBF
+    |]) #-}
diff --git a/clash-prelude/src/Clash/Prelude.hs b/clash-prelude/src/Clash/Prelude.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2013-2016, University of Twente,
                      2017-2019, Myrtle Software Ltd
                      2017     , Google Inc.,
-                     2021-2022, QBayLogic B.V.
+                     2021-2023, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -102,6 +102,8 @@ module Clash.Prelude
   , isFalling
   , riseEvery
   , oscillate
+    -- * Static assertions
+  , clashCompileError
     -- * Tracing
     -- ** Simple
   , traceSignal1
@@ -188,6 +190,7 @@ import           Clash.Class.Num
 import           Clash.Class.Parity
 import           Clash.Class.Resize
 import qualified Clash.Explicit.Prelude      as E
+import           Clash.Explicit.Prelude (clashCompileError)
 import           Clash.Hidden
 import           Clash.Magic
 import           Clash.NamedTypes