Use TH name to identify bottoming values

This way we can just refer to "'patError" regardless of whether
it lives in:
- Control.Exceptions.Base, or
- GHC.Internal.Control.Exception.Base

Author: christiaanb

clash-lib/src/Clash/Core/Util.hs

@@ -19,6 +19,12 @@
 module Clash.Core.Util where
 
 import           Control.Concurrent.Supply     (Supply, freshId)
+import Control.Exception.Base (patError)
+#if MIN_VERSION_base(4,16,0)
+import GHC.Prim.Panic (absentError)
+#else
+import Control.Exception.Base (absentError)
+#endif
 import Control.Monad.Trans.Except              (Except, throwE, runExcept)
 import Data.Bifunctor                          (first, second)
 import qualified Data.HashSet                  as HashSet
@@ -31,6 +37,9 @@ import Data.Maybe
 import qualified Data.Set                      as Set
 import qualified Data.Set.Lens                 as Lens
 import qualified Data.Text                     as T
+import           Data.Text.Extra               (showt)
+import           GHC.Real
+  (divZeroError, overflowError, ratioZeroDenominatorError, underflowError)
 import           GHC.Stack                     (HasCallStack)
 
 #if MIN_VERSION_ghc(9,0,0)
@@ -59,6 +68,9 @@ import Clash.Debug                       (traceIf)
 import Clash.Unique                      (fromGhcUnique)
 import Clash.Util
 
+import {-# SOURCE #-} qualified Clash.Normalize.Primitives as Primitives
+import Clash.XException (errorX)
+
 -- | Rebuild a let expression / let expressions by taking the SCCs of a list
 -- of bindings and remaking Let (NonRec ...) ... and Let (Rec ...) ...
 --
@@ -479,27 +491,23 @@ primUCo =
                 }
 
 undefinedPrims :: [T.Text]
-undefinedPrims =
-  [ "Clash.Normalize.Primitives.undefined"
-  , "Control.Exception.Base.absentError"
-  , "Control.Exception.Base.patError"
-  , "GHC.Err.error"
-  , "GHC.Err.errorWithoutStackTrace"
-  , "GHC.Err.undefined"
-  , "GHC.Internal.Err.error"
-  , "GHC.Internal.Err.errorWithoutStackTrace"
-  , "GHC.Internal.Err.undefined"
-  , "GHC.Prim.Panic.absentError"
-  , "GHC.Real.divZeroError"
-  , "GHC.Real.overflowError"
-  , "GHC.Real.ratioZeroDenominatorError"
-  , "GHC.Real.underflowError"
+undefinedPrims = fmap showt
+  [ 'Primitives.undefined
+  , 'patError
+  , 'error
+  , 'errorWithoutStackTrace
+  , 'undefined
+  , 'absentError
+  , 'divZeroError
+  , 'overflowError
+  , 'ratioZeroDenominatorError
+  , 'underflowError
   ]
 
 undefinedXPrims :: [T.Text]
-undefinedXPrims =
-  [ "Clash.Normalize.Primitives.undefinedX"
-  , "Clash.XException.errorX"
+undefinedXPrims = fmap showt
+  [ 'Primitives.undefinedX
+  , 'errorX
   ]
 
 substArgTys

clash-lib/src/Clash/Normalize/Primitives.hs-boot

@@ -0,0 +1,6 @@
+module Clash.Normalize.Primitives where
+
+import Clash.Core.Term (PrimInfo)
+
+undefined :: PrimInfo
+undefinedX :: PrimInfo

clash-lib/src/Clash/Normalize/Transformations/Case.hs

@@ -26,6 +26,12 @@ module Clash.Normalize.Transformations.Case
   , elimExistentials
   ) where
 
+import Control.Exception.Base (patError)
+#if MIN_VERSION_base(4,16,0)
+import GHC.Prim.Panic (absentError)
+#else
+import Control.Exception.Base (absentError)
+#endif
 import qualified Control.Lens as Lens
 import Control.Monad.State.Strict (evalState)
 import Data.Bifunctor (second)
@@ -80,6 +86,8 @@ import Clash.Rewrite.Util (changed, isFromInt, whnfRW)
 import Clash.Rewrite.WorkFree
 import Clash.Util (curLoc)
 
+import Clash.XException (errorX)
+
 -- | Move a Case-decomposition from the subject of a Case-decomposition to the
 -- alternatives
 caseCase :: HasCallStack => NormRewrite
@@ -266,27 +274,23 @@ caseCon' ctx@(TransformContext is0 _) e@(Case subj ty alts) = do
       -- WHNF of subject is _|_, in the form of `error`: that means that the
       -- entire case-expression is evaluates to _|_
       (Prim pInfo,repTy:_:callStack:msg:_,ticks)
-        | primName pInfo `elem` ["GHC.Err.error"
-                                ,"GHC.Internal.Err.error"] ->
+        | primName pInfo == Text.showt 'error ->
         let e1 = mkApps (mkTicks (Prim pInfo) ticks)
                         [repTy,Right ty,callStack,msg]
          in changed e1
       -- WHNF of subject is _|_, in the form of `absentError`: that means that
       -- the entire case-expression is evaluates to _|_
       (Prim pInfo,_:msgOrCallStack:_,ticks)
-        | primName pInfo `elem` ["Control.Exception.Base.absentError"
-                                ,"GHC.Prim.Panic.absentError"] ->
+        | primName pInfo == Text.showt 'absentError ->
         let e1 = mkApps (mkTicks (Prim pInfo) ticks)
                         [Right ty,msgOrCallStack]
         in  changed e1
       -- WHNF of subject is _|_, in the form of  `patError`, `undefined`, or
       -- `errorWithoutStackTrace`: that means the entire case-expression is _|_
       (Prim pInfo,repTy:_:msgOrCallStack:_,ticks)
-        | primName pInfo `elem` ["Control.Exception.Base.patError"
-                                ,"GHC.Err.undefined"
-                                ,"GHC.Err.errorWithoutStackTrace"
-                                ,"GHC.Internal.Err.undefined"
-                                ,"GHC.Internal.Err.errorWithoutStackTrace"] ->
+        | primName pInfo `elem` [ Text.showt 'patError
+                                , Text.showt 'undefined
+                                , Text.showt 'errorWithoutStackTrace] ->
         let e1 = mkApps (mkTicks (Prim pInfo) ticks)
                         [repTy,Right ty,msgOrCallStack]
         in  changed e1
@@ -300,7 +304,7 @@ caseCon' ctx@(TransformContext is0 _) e@(Case subj ty alts) = do
       -- WHNF of subject is _|_, in the form of `errorX`: that means that
       -- the entire case-expression is evaluates to _|_
       (Prim pInfo,_:callStack:msg:_,ticks)
-        | primName pInfo == "Clash.XException.errorX"
+        | primName pInfo == Text.showt 'errorX
         -> let e1 = mkApps (mkTicks (Prim pInfo) ticks) [Right ty,callStack,msg]
             in changed e1
       -- WHNF of subject is non of the above, so either a variable reference,