diff --git a/clash-lib/src/Clash/Core/Util.hs b/clash-lib/src/Clash/Core/Util.hs index 6c0f64f879..87fa6b5874 100644 --- a/clash-lib/src/Clash/Core/Util.hs +++ b/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 diff --git a/clash-lib/src/Clash/Normalize/Primitives.hs-boot b/clash-lib/src/Clash/Normalize/Primitives.hs-boot new file mode 100644 index 0000000000..cb48b22ea8 --- /dev/null +++ b/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 diff --git a/clash-lib/src/Clash/Normalize/Transformations/Case.hs b/clash-lib/src/Clash/Normalize/Transformations/Case.hs index f7a905e9d8..b23e8ca615 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/Case.hs +++ b/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,