diff --git a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs index 4bcd395eab62d14f84cda014523a50676c7d8764..f2810b38b9fb7dd3a88abbc5e04e0b02fc0970b3 100644 --- a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs @@ -483,7 +483,7 @@ isOffsetImm off w -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. -getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) +getFloatReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) getFloatReg expr = do r <- getRegister expr case r of diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs b/compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs index 59b958ce1ff3da6eb0713f07d2a48f57f4cbbdb3..cc7f2c993e0ea2645fd9aa66157e43513a7329bc 100644 --- a/compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs +++ b/compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs @@ -8,11 +8,11 @@ import GHC.Platform.Reg import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Platform import Data.Word -import GHC.Stack -- AArch64 has 32 64bit general purpose register r0..r30, and zr/sp -- AArch64 has 32 128bit floating point registers v0..v31 as part of the NEON -- extension in Armv8-A. @@ -65,7 +65,7 @@ showBits :: Word32 -> String showBits w = map (\i -> if testBit w i then '1' else '0') [0..31] -- FR instance implementation (See Linear.FreeRegs) -allocateReg :: HasCallStack => RealReg -> FreeRegs -> FreeRegs +allocateReg :: HasDebugCallStack => RealReg -> FreeRegs -> FreeRegs allocateReg (RealRegSingle r) (FreeRegs g f) | r > 31 && testBit f (r - 32) = FreeRegs g (clearBit f (r - 32)) | r < 32 && testBit g r = FreeRegs (clearBit g r) f @@ -127,7 +127,7 @@ getFreeRegs cls (FreeRegs g f) initFreeRegs :: Platform -> FreeRegs initFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform) -releaseReg :: HasCallStack => RealReg -> FreeRegs -> FreeRegs +releaseReg :: HasDebugCallStack => RealReg -> FreeRegs -> FreeRegs releaseReg (RealRegSingle r) (FreeRegs g f) | r > 31 && testBit f (r - 32) = pprPanic "Linear.AArch64.releaseReg" (text "can't release non-allocated reg v" <> int (r - 32)) | r < 32 && testBit g r = pprPanic "Linear.AArch64.releaseReg" (text "can't release non-allocated reg x" <> int r) diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs index 614bd69bb633b4d0914ce264788525dc81b8418f..35ce07fba695b449663b36fa3a697591678858ce 100644 --- a/compiler/GHC/Core/Opt/DmdAnal.hs +++ b/compiler/GHC/Core/Opt/DmdAnal.hs @@ -2360,7 +2360,7 @@ addWeakFVs dmd_ty weak_fvs -- L demand doesn't get both'd with the Bot coming up from the inner -- call to f. So we just get an L demand for x for g. -setBndrsDemandInfo :: HasCallStack => [Var] -> [Demand] -> [Var] +setBndrsDemandInfo :: HasDebugCallStack => [Var] -> [Demand] -> [Var] setBndrsDemandInfo (b:bs) ds | isTyVar b = b : setBndrsDemandInfo bs ds setBndrsDemandInfo (b:bs) (d:ds) = diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index cad74a6ba9c9c1e643bc1bd9963b9ad6395b60ba..4223a73d5b907b0817f3e9aab530661293f2543a 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -235,7 +235,7 @@ simple_opt_clo :: HasCallStack simple_opt_clo in_scope (e_env, e) = simple_opt_expr (soeSetInScope in_scope e_env) e -simple_opt_expr :: HasCallStack => SimpleOptEnv -> InExpr -> OutExpr +simple_opt_expr :: HasDebugCallStack => SimpleOptEnv -> InExpr -> OutExpr simple_opt_expr env expr = go expr where diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 7c21e2ee9666489365e5dc902b3bcc1ff30dc027..8f8d9d554e5a598272019c39281f66b83ae8ca26 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -1636,7 +1636,7 @@ tyConAppArgs_maybe ty = case splitTyConApp_maybe ty of Just (_, tys) -> Just tys Nothing -> Nothing -tyConAppArgs :: HasCallStack => Type -> [Type] +tyConAppArgs :: HasDebugCallStack => Type -> [Type] tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty) -- | Attempts to tease a type apart into a type constructor and the application @@ -1676,7 +1676,7 @@ splitTyConAppNoView_maybe ty -- -- Consequently, you may need to zonk your type before -- using this function. -tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type]) +tcSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) -- Defined here to avoid module loops between Unify and TcType. tcSplitTyConApp_maybe ty = case coreFullView ty of diff --git a/compiler/GHC/Data/Maybe.hs b/compiler/GHC/Data/Maybe.hs index 1e8424c0a46f6a3d9c4143e602bbc22012a0bd52..4004c1e3203277275961bdc8450a6cffb94abf3d 100644 --- a/compiler/GHC/Data/Maybe.hs +++ b/compiler/GHC/Data/Maybe.hs @@ -33,7 +33,7 @@ import Control.Monad.Trans.Maybe import Control.Exception (SomeException(..)) import Data.Maybe import Data.Foldable ( foldlM, for_ ) -import GHC.Utils.Misc (HasCallStack) +import GHC.Utils.Misc (HasDebugCallStack) import Data.List.NonEmpty ( NonEmpty ) import Control.Applicative( Alternative( (<|>) ) ) @@ -66,7 +66,7 @@ firstJustsM = foldlM go Nothing where go Nothing action = action go result@(Just _) _action = return result -expectJust :: HasCallStack => String -> Maybe a -> a +expectJust :: HasDebugCallStack => String -> Maybe a -> a {-# INLINE expectJust #-} expectJust _ (Just x) = x expectJust err Nothing = error ("expectJust " ++ err) diff --git a/compiler/GHC/Stg/Subst.hs b/compiler/GHC/Stg/Subst.hs index e98f445b2ffb3c2387560d6b58d0e15813682e97..009225cf04c02ea9fbd7a5468251553442b78fec 100644 --- a/compiler/GHC/Stg/Subst.hs +++ b/compiler/GHC/Stg/Subst.hs @@ -55,7 +55,7 @@ substBndrs = runState . traverse (state . substBndr) -- | Substitutes an occurrence of an identifier for its counterpart recorded -- in the 'Subst'. -lookupIdSubst :: HasCallStack => Id -> Subst -> Id +lookupIdSubst :: HasDebugCallStack => Id -> Subst -> Id lookupIdSubst id (Subst in_scope env) | not (isLocalId id) = id | Just id' <- lookupVarEnv env id = id' @@ -65,7 +65,7 @@ lookupIdSubst id (Subst in_scope env) -- | Substitutes an occurrence of an identifier for its counterpart recorded -- in the 'Subst'. Does not generate a debug warning if the identifier to -- to substitute wasn't in scope. -noWarnLookupIdSubst :: HasCallStack => Id -> Subst -> Id +noWarnLookupIdSubst :: HasDebugCallStack => Id -> Subst -> Id noWarnLookupIdSubst id (Subst in_scope env) | not (isLocalId id) = id | Just id' <- lookupVarEnv env id = id' diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs index 1d10414ad38e18b3e7a421d1306fd5af7f313c64..1840866aa1519ceff078fab999dc6396046cf0ae 100644 --- a/compiler/GHC/Tc/Deriv/Generate.hs +++ b/compiler/GHC/Tc/Deriv/Generate.hs @@ -2445,7 +2445,7 @@ postfixModTbl ] -- | Lookup `Type` in an association list. -assoc_ty_id :: HasCallStack => String -- The class involved +assoc_ty_id :: HasDebugCallStack => String -- The class involved -> [(Type,a)] -- The table -> Type -- The type -> a -- The result of the lookup diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs index e2f179b4ff093a34064f84e691f828138e21ee03..67e7d59bc1d5b7cd24a82aa062e7c45e86bd5d06 100644 --- a/compiler/GHC/Tc/Deriv/Utils.hs +++ b/compiler/GHC/Tc/Deriv/Utils.hs @@ -649,7 +649,7 @@ mkDirectThetaSpec origin t_or_k = , sps_type_or_kind = t_or_k }) -substPredSpec :: HasCallStack => Subst -> PredSpec -> PredSpec +substPredSpec :: HasDebugCallStack => Subst -> PredSpec -> PredSpec substPredSpec subst ps = case ps of SimplePredSpec { sps_pred = pred diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 9e1fcc40171906487a5fc4ded2e2b77f60b74773..69684d63f1cbb6ce54c137e775d2eec4ed5019fc 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -3589,7 +3589,7 @@ data SkolemModeDetails | SMDSkolemTv SkolemInfo -smVanilla :: HasCallStack => SkolemMode +smVanilla :: HasDebugCallStack => SkolemMode smVanilla = SM { sm_clone = panic "sm_clone" -- We always override this , sm_parent = False , sm_tvtv = pprPanic "sm_tvtv" callStackDoc -- We always override this diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs index aea97da224eb0468134d31b2c0befd55a138c7a7..fdbe5e3a54a7c2600b8fc8ff1b58cc70cd68e974 100644 --- a/compiler/GHC/Tc/Types/Origin.hs +++ b/compiler/GHC/Tc/Types/Origin.hs @@ -77,6 +77,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Stack import GHC.Utils.Monad +import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Types.Unique import GHC.Types.Unique.Supply @@ -327,10 +328,10 @@ data SkolemInfoAnon -- -- We're hoping to be able to get rid of this entirely, but for the moment -- it's still needed. -unkSkol :: HasCallStack => SkolemInfo +unkSkol :: HasDebugCallStack => SkolemInfo unkSkol = SkolemInfo (mkUniqueGrimily 0) unkSkolAnon -unkSkolAnon :: HasCallStack => SkolemInfoAnon +unkSkolAnon :: HasDebugCallStack => SkolemInfoAnon unkSkolAnon = UnkSkol callStack -- | Wrap up the origin of a skolem type variable with a new 'Unique', @@ -895,7 +896,7 @@ pprCtOrigin simple_origin = ctoHerald <+> pprCtO simple_origin -- | Short one-liners -pprCtO :: HasCallStack => CtOrigin -> SDoc +pprCtO :: HasDebugCallStack => CtOrigin -> SDoc pprCtO (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)] pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] pprCtO AppOrigin = text "an application" @@ -960,7 +961,7 @@ pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check" pprCtO (ImpedanceMatching {}) = text "combining required constraints" pprCtO (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)] -pprNonLinearPatternReason :: HasCallStack => NonLinearPatternReason -> SDoc +pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc pprNonLinearPatternReason LazyPatternReason = parens (text "non-variable lazy pattern aren't linear") pprNonLinearPatternReason GeneralisedPatternReason = parens (text "non-variable pattern bindings that have been generalised aren't linear") pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms aren't linear") diff --git a/compiler/GHC/Tc/Types/Origin.hs-boot b/compiler/GHC/Tc/Types/Origin.hs-boot index ff7ab933f10060e2dd910401728e8e2330de30a2..faf7bb7a9387b7e2fb9fddb929fca21dab397fff 100644 --- a/compiler/GHC/Tc/Types/Origin.hs-boot +++ b/compiler/GHC/Tc/Types/Origin.hs-boot @@ -1,7 +1,7 @@ module GHC.Tc.Types.Origin where import GHC.Prelude.Basic ( Int, Maybe ) -import GHC.Stack ( HasCallStack ) +import GHC.Utils.Misc ( HasDebugCallStack ) import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type ) data SkolemInfoAnon @@ -16,4 +16,4 @@ data FixedRuntimeRepOrigin mkFRRUnboxedTuple :: Int -> FixedRuntimeRepContext mkFRRUnboxedSum :: Maybe Int -> FixedRuntimeRepContext -unkSkol :: HasCallStack => SkolemInfo +unkSkol :: HasDebugCallStack => SkolemInfo diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 9c2ce8904d01d9e4c1cc623f1103889bb0edb20f..f805929255d93716d5ca4069999aef409ed0d620 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -609,7 +609,7 @@ data TcTyVarDetails , mtv_ref :: IORef MetaDetails , mtv_tclvl :: TcLevel } -- See Note [TcLevel invariants] -vanillaSkolemTvUnk :: HasCallStack => TcTyVarDetails +vanillaSkolemTvUnk :: HasDebugCallStack => TcTyVarDetails vanillaSkolemTvUnk = SkolemTv unkSkol topTcLevel False instance Outputable TcTyVarDetails where diff --git a/compiler/GHC/Tc/Utils/TcType.hs-boot b/compiler/GHC/Tc/Utils/TcType.hs-boot index b011f93f7570253751142395b128189fdb0e64d9..cdb7c3ddfd061fd3da700d5aa30263d2ed18d768 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs-boot +++ b/compiler/GHC/Tc/Utils/TcType.hs-boot @@ -1,16 +1,16 @@ module GHC.Tc.Utils.TcType where import GHC.Utils.Outputable( SDoc ) +import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Prelude ( Bool ) import {-# SOURCE #-} GHC.Types.Var ( TcTyVar ) import {-# SOURCE #-} GHC.Tc.Types.Origin ( FixedRuntimeRepOrigin ) import GHC.Types.Name.Env ( NameEnv ) -import GHC.Stack data MetaDetails data TcTyVarDetails pprTcTyVarDetails :: TcTyVarDetails -> SDoc -vanillaSkolemTvUnk :: HasCallStack => TcTyVarDetails +vanillaSkolemTvUnk :: HasDebugCallStack => TcTyVarDetails isMetaTyVar :: TcTyVar -> Bool isTyConableTyVar :: TcTyVar -> Bool diff --git a/compiler/GHC/Utils/Misc.hs b/compiler/GHC/Utils/Misc.hs index 1410bdebdfda571e5fbd951ad1105d67e7ec6c0a..718f81a6ce1afd4d04617fa8a3871de4780789fe 100644 --- a/compiler/GHC/Utils/Misc.hs +++ b/compiler/GHC/Utils/Misc.hs @@ -488,7 +488,7 @@ only _ = panic "Util: only" -- | Extract the single element of a list and panic with the given message if -- there are more elements or the list was empty. -- Like 'expectJust', but for lists. -expectOnly :: HasCallStack => String -> [a] -> a +expectOnly :: HasDebugCallStack => String -> [a] -> a {-# INLINE expectOnly #-} #if defined(DEBUG) expectOnly _ [a] = a @@ -511,7 +511,7 @@ changeLast [_] x = [x] changeLast (x:xs) x' = x : changeLast xs x' -- | Like @expectJust msg . nonEmpty@; a better alternative to 'NE.fromList'. -expectNonEmpty :: HasCallStack => String -> [a] -> NonEmpty a +expectNonEmpty :: HasDebugCallStack => String -> [a] -> NonEmpty a {-# INLINE expectNonEmpty #-} expectNonEmpty _ (x:xs) = x:|xs expectNonEmpty msg [] = expectNonEmptyPanic msg diff --git a/compiler/GHC/Utils/Word64.hs b/compiler/GHC/Utils/Word64.hs index f8b0ab0c2664248b9f0aa20fe425d2c444a384dc..871e2e7cf100e4923c21c629373a25ff944af64f 100644 --- a/compiler/GHC/Utils/Word64.hs +++ b/compiler/GHC/Utils/Word64.hs @@ -6,15 +6,15 @@ module GHC.Utils.Word64 ( import GHC.Prelude import GHC.Utils.Panic.Plain (assert) +import GHC.Utils.Misc (HasDebugCallStack) import Data.Word -import GHC.Stack -intToWord64 :: HasCallStack => Int -> Word64 +intToWord64 :: HasDebugCallStack => Int -> Word64 intToWord64 x = assert (0 <= x) (fromIntegral x) -word64ToInt :: HasCallStack => Word64 -> Int +word64ToInt :: HasDebugCallStack => Word64 -> Int word64ToInt x = assert (x <= fromIntegral (maxBound :: Int)) (fromIntegral x) truncateWord64ToWord32 :: Word64 -> Word32 -truncateWord64ToWord32 = fromIntegral \ No newline at end of file +truncateWord64ToWord32 = fromIntegral