summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Utils
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc/Utils')
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs6
-rw-r--r--compiler/GHC/Tc/Utils/Instantiate.hs5
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs1
-rw-r--r--compiler/GHC/Tc/Utils/TcMType.hs36
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs25
-rw-r--r--compiler/GHC/Tc/Utils/Unify.hs21
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs22
7 files changed, 61 insertions, 55 deletions
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index a27c4de082..592b3a64ac 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -76,10 +76,10 @@ import GHC.Tc.Utils.Env
import GHC.Tc.Errors
import GHC.Tc.Utils.Unify
-import GHC.Utils.Misc
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Data.Maybe
@@ -1060,8 +1060,8 @@ instantiateSignature = do
-- TODO: setup the local RdrEnv so the error messages look a little better.
-- But this information isn't stored anywhere. Should we RETYPECHECK
-- the local one just to get the information? Hmm...
- MASSERT( isHomeModule home_unit outer_mod )
- MASSERT( isHomeUnitInstantiating home_unit)
+ massert (isHomeModule home_unit outer_mod )
+ massert (isHomeUnitInstantiating home_unit)
let uid = Indefinite (homeUnitInstanceOf home_unit)
inner_mod `checkImplements`
Module
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 601cd0a8ea..7edaab0e42 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -85,6 +85,7 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Utils.Outputable
import GHC.Unit.State
@@ -124,7 +125,7 @@ newMethodFromName origin name ty_args
; let ty = piResultTys (idType id) ty_args
(theta, _caller_knows_this) = tcSplitPhiTy ty
- ; wrap <- ASSERT( not (isForAllTy ty) && isSingleton theta )
+ ; wrap <- assert (not (isForAllTy ty) && isSingleton theta) $
instCall origin ty_args theta
; return (mkHsWrap wrap (HsVar noExtField (noLocA id))) }
@@ -397,7 +398,7 @@ tcInstInvisibleTyBinder subst (Anon af ty)
| Just (mk, k1, k2) <- get_eq_tys_maybe (substTy subst (scaledThing ty))
-- Equality is the *only* constraint currently handled in types.
-- See Note [Constraints in kinds] in GHC.Core.TyCo.Rep
- = ASSERT( af == InvisArg )
+ = assert (af == InvisArg) $
do { co <- unifyKind Nothing k1 k2
; arg' <- mk co
; return (subst, arg') }
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 3243be77de..aea13efbc0 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -188,6 +188,7 @@ import GHC.Data.Maybe
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Error
import GHC.Utils.Panic
+import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Misc
import GHC.Utils.Logger
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index 8070b4d513..00b16f8380 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -127,6 +127,8 @@ import GHC.Types.Name.Env
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Constants (debugIsOn)
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Data.Pair
@@ -374,10 +376,10 @@ checkCoercionHole cv co
= do { cv_ty <- zonkTcType (varType cv)
-- co is already zonked, but cv might not be
; return $
- ASSERT2( ok cv_ty
- , (text "Bad coercion hole" <+>
- ppr cv <> colon <+> vcat [ ppr t1, ppr t2, ppr role
- , ppr cv_ty ]) )
+ assertPpr (ok cv_ty)
+ (text "Bad coercion hole" <+>
+ ppr cv <> colon <+> vcat [ ppr t1, ppr t2, ppr role
+ , ppr cv_ty ])
co }
| otherwise
= return co
@@ -906,7 +908,7 @@ newTauTvDetailsAtLevel tclvl
cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
cloneMetaTyVar tv
- = ASSERT( isTcTyVar tv )
+ = assert (isTcTyVar tv) $
do { ref <- newMutVar Flexi
; name' <- cloneMetaTyVarName (tyVarName tv)
; let details' = case tcTyVarDetails tv of
@@ -918,7 +920,7 @@ cloneMetaTyVar tv
-- Works for both type and kind variables
readMetaTyVar :: TyVar -> TcM MetaDetails
-readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
+readMetaTyVar tyvar = assertPpr (isMetaTyVar tyvar) (ppr tyvar) $
readMutVar (metaTyVarRef tyvar)
isFilledMetaTyVar_maybe :: TcTyVar -> TcM (Maybe Type)
@@ -955,15 +957,13 @@ writeMetaTyVar tyvar ty
-- Everything from here on only happens if DEBUG is on
| not (isTcTyVar tyvar)
- = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar )
- return ()
+ = massertPpr False (text "Writing to non-tc tyvar" <+> ppr tyvar)
| MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar
= writeMetaTyVarRef tyvar ref ty
| otherwise
- = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar )
- return ()
+ = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar)
--------------------
writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
@@ -1000,13 +1000,13 @@ writeMetaTyVarRef tyvar ref ty
; traceTc "writeMetaTyVar" (ppr tyvar <+> text ":=" <+> ppr ty)
-- Check for double updates
- ; MASSERT2( isFlexi meta_details, double_upd_msg meta_details )
+ ; massertPpr (isFlexi meta_details) (double_upd_msg meta_details)
-- Check for level OK
- ; MASSERT2( level_check_ok, level_check_msg )
+ ; massertPpr level_check_ok level_check_msg
-- Check Kinds ok
- ; MASSERT2( kind_check_ok, kind_msg )
+ ; massertPpr kind_check_ok kind_msg
-- Do the write
; writeMutVar ref (Indirect ty) }
@@ -1714,7 +1714,7 @@ quantifyTyVars dvs
-- We should never quantify over coercion variables; check this
; let co_vars = filter isCoVar final_qtvs
- ; MASSERT2( null co_vars, ppr co_vars )
+ ; massertPpr (null co_vars) (ppr co_vars)
; return final_qtvs }
where
@@ -1757,7 +1757,7 @@ zonkAndSkolemise tyvar
; skolemiseQuantifiedTyVar zonked_tyvar }
| otherwise
- = ASSERT2( isImmutableTyVar tyvar || isCoVar tyvar, pprTyVar tyvar )
+ = assertPpr (isImmutableTyVar tyvar || isCoVar tyvar) (pprTyVar tyvar) $
zonkTyCoVarKind tyvar
skolemiseQuantifiedTyVar :: TcTyVar -> TcM TcTyVar
@@ -1869,7 +1869,7 @@ skolemiseUnboundMetaTyVar :: TcTyVar -> TcM TyVar
-- We create a skolem TcTyVar, not a regular TyVar
-- See Note [Zonking to Skolem]
skolemiseUnboundMetaTyVar tv
- = ASSERT2( isMetaTyVar tv, ppr tv )
+ = assertPpr (isMetaTyVar tv) (ppr tv) $
do { when debugIsOn (check_empty tv)
; here <- getSrcSpanM -- Get the location from "here"
-- ie where we are generalising
@@ -2199,7 +2199,7 @@ promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool
-- Also returns either the original tyvar (no promotion) or the new one
-- See Note [Promoting unification variables]
promoteMetaTyVarTo tclvl tv
- | ASSERT2( isMetaTyVar tv, ppr tv )
+ | assertPpr (isMetaTyVar tv) (ppr tv) $
tcTyVarLevel tv `strictlyDeeperThan` tclvl
= do { cloned_tv <- cloneMetaTyVar tv
; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl
@@ -2240,7 +2240,7 @@ zonkTyCoVar :: TyCoVar -> TcM TcType
-- Works on TyVars and TcTyVars
zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv
| isTyVar tv = mkTyVarTy <$> zonkTyCoVarKind tv
- | otherwise = ASSERT2( isCoVar tv, ppr tv )
+ | otherwise = assertPpr (isCoVar tv) (ppr tv) $
mkCoercionTy . mkCoVarCo <$> zonkTyCoVarKind tv
-- Hackily, when typechecking type and class decls
-- we have TyVars in scope added (only) in
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 886d120661..bebc370d39 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -229,6 +229,7 @@ import GHC.Data.Maybe
import GHC.Data.List.SetOps ( getNth, findDupsEq )
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Utils.Error( Validity(..), isValid )
import qualified GHC.LanguageExtensions as LangExt
@@ -698,7 +699,7 @@ instance Outputable TcLevel where
promoteSkolem :: TcLevel -> TcTyVar -> TcTyVar
promoteSkolem tclvl skol
| tclvl < tcTyVarLevel skol
- = ASSERT( isTcTyVar skol && isSkolemTyVar skol )
+ = assert (isTcTyVar skol && isSkolemTyVar skol )
setTcTyVarDetails skol (SkolemTv tclvl (isOverlappableTyVar skol))
| otherwise
@@ -707,7 +708,7 @@ promoteSkolem tclvl skol
-- | Change the TcLevel in a skolem, extending a substitution
promoteSkolemX :: TcLevel -> TCvSubst -> TcTyVar -> (TCvSubst, TcTyVar)
promoteSkolemX tclvl subst skol
- = ASSERT( isTcTyVar skol && isSkolemTyVar skol )
+ = assert (isTcTyVar skol && isSkolemTyVar skol )
(new_subst, new_skol)
where
new_skol
@@ -1005,8 +1006,8 @@ isTouchableMetaTyVar ctxt_tclvl tv
| isTyVar tv -- See Note [Coercion variables in free variable lists]
, MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info } <- tcTyVarDetails tv
, isTouchableInfo info
- = ASSERT2( checkTcLevelInvariant ctxt_tclvl tv_tclvl,
- ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl )
+ = assertPpr (checkTcLevelInvariant ctxt_tclvl tv_tclvl)
+ (ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl) $
tv_tclvl `sameDepthAs` ctxt_tclvl
| otherwise = False
@@ -1028,7 +1029,7 @@ isTyConableTyVar tv
| otherwise = True
isSkolemTyVar tv
- = ASSERT2( tcIsTcTyVar tv, ppr tv )
+ = assertPpr (tcIsTcTyVar tv) (ppr tv) $
case tcTyVarDetails tv of
MetaTv {} -> False
_other -> True
@@ -1220,13 +1221,13 @@ variables. It's up to you to make sure this doesn't matter.
-- Always succeeds, even if it returns an empty list.
tcSplitPiTys :: Type -> ([TyBinder], Type)
tcSplitPiTys ty
- = ASSERT( all isTyBinder (fst sty) ) sty
+ = assert (all isTyBinder (fst sty) ) sty
where sty = splitPiTys ty
-- | Splits a type into a TyBinder and a body, if possible. Panics otherwise
tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
tcSplitPiTy_maybe ty
- = ASSERT( isMaybeTyBinder sty ) sty
+ = assert (isMaybeTyBinder sty ) sty
where
sty = splitPiTy_maybe ty
isMaybeTyBinder (Just (t,_)) = isTyBinder t
@@ -1234,14 +1235,14 @@ tcSplitPiTy_maybe ty
tcSplitForAllTyVarBinder_maybe :: Type -> Maybe (TyVarBinder, Type)
tcSplitForAllTyVarBinder_maybe ty | Just ty' <- tcView ty = tcSplitForAllTyVarBinder_maybe ty'
-tcSplitForAllTyVarBinder_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty)
+tcSplitForAllTyVarBinder_maybe (ForAllTy tv ty) = assert (isTyVarBinder tv ) Just (tv, ty)
tcSplitForAllTyVarBinder_maybe _ = Nothing
-- | Like 'tcSplitPiTys', but splits off only named binders,
-- returning just the tyvars.
tcSplitForAllTyVars :: Type -> ([TyVar], Type)
tcSplitForAllTyVars ty
- = ASSERT( all isTyVar (fst sty) ) sty
+ = assert (all isTyVar (fst sty) ) sty
where sty = splitForAllTyCoVars ty
-- | Like 'tcSplitForAllTyVars', but only splits 'ForAllTy's with 'Invisible'
@@ -1265,18 +1266,18 @@ tcSplitSomeForAllTyVars argf_pred ty
-- | Like 'tcSplitForAllTyVars', but only splits 'ForAllTy's with 'Required' type
-- variable binders. All split tyvars are annotated with '()'.
tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type)
-tcSplitForAllReqTVBinders ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty
+tcSplitForAllReqTVBinders ty = assert (all (isTyVar . binderVar) (fst sty) ) sty
where sty = splitForAllReqTVBinders ty
-- | Like 'tcSplitForAllTyVars', but only splits 'ForAllTy's with 'Invisible' type
-- variable binders. All split tyvars are annotated with their 'Specificity'.
tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type)
-tcSplitForAllInvisTVBinders ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty
+tcSplitForAllInvisTVBinders ty = assert (all (isTyVar . binderVar) (fst sty) ) sty
where sty = splitForAllInvisTVBinders ty
-- | Like 'tcSplitForAllTyVars', but splits off only named binders.
tcSplitForAllTyVarBinders :: Type -> ([TyVarBinder], Type)
-tcSplitForAllTyVarBinders ty = ASSERT( all isTyVarBinder (fst sty)) sty
+tcSplitForAllTyVarBinders ty = assert (all isTyVarBinder (fst sty)) sty
where sty = splitForAllTyCoVarBinders ty
-- | Is this a ForAllTy with a named binder?
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index eee4e1844c..76d0418eef 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -73,6 +73,7 @@ import GHC.Data.Bag
import GHC.Utils.Misc
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Exts ( inline )
import Control.Monad
@@ -107,7 +108,7 @@ matchActualFunTySigma
-- and NB: res_ty is an (uninstantiated) SigmaType
matchActualFunTySigma herald mb_thing err_info fun_ty
- = ASSERT2( isRhoTy fun_ty, ppr fun_ty )
+ = assertPpr (isRhoTy fun_ty) (ppr fun_ty) $
go fun_ty
where
-- Does not allocate unnecessary meta variables: if the input already is
@@ -122,7 +123,7 @@ matchActualFunTySigma herald mb_thing err_info fun_ty
go ty | Just ty' <- tcView ty = go ty'
go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg_ty, ft_res = res_ty })
- = ASSERT( af == VisArg )
+ = assert (af == VisArg) $
return (idHsWrapper, Scaled w arg_ty, res_ty)
go ty@(TyVarTy tv)
@@ -323,7 +324,7 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside
| Just ty' <- tcView ty = go acc_arg_tys n ty'
go acc_arg_tys n (FunTy { ft_mult = mult, ft_af = af, ft_arg = arg_ty, ft_res = res_ty })
- = ASSERT( af == VisArg )
+ = assert (af == VisArg) $
do { (wrap_res, result) <- go ((Scaled mult $ mkCheckExpType arg_ty) : acc_arg_tys)
(n-1) res_ty
; let fun_wrap = mkWpFun idHsWrapper wrap_res (Scaled mult arg_ty) res_ty doc
@@ -419,7 +420,7 @@ matchExpectedTyConApp :: TyCon -- T :: forall kv1 ... kvm. k1 ->
-- Postcondition: (T k1 k2 k3 a b c) is well-kinded
matchExpectedTyConApp tc orig_ty
- = ASSERT(not $ isFunTyCon tc) go orig_ty
+ = assert (not $ isFunTyCon tc) $ go orig_ty
where
go ty
| Just ty' <- tcView ty
@@ -542,7 +543,7 @@ tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc
-- rho-type, so nothing to instantiate; just go straight to unify.
-- It means we don't need to pass in a CtOrigin
tcWrapResultMono rn_expr expr act_ty res_ty
- = ASSERT2( isRhoTy act_ty, ppr act_ty $$ ppr rn_expr )
+ = assertPpr (isRhoTy act_ty) (ppr act_ty $$ ppr rn_expr) $
do { co <- unifyExpectedType rn_expr act_ty res_ty
; return (mkHsWrapCo co expr) }
@@ -1014,7 +1015,7 @@ buildImplicationFor tclvl skol_info skol_tvs given wanted
= return (emptyBag, emptyTcEvBinds)
| otherwise
- = ASSERT2( all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs, ppr skol_tvs )
+ = assertPpr (all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs) (ppr skol_tvs) $
-- Why allow TyVarTvs? Because implicitly declared kind variables in
-- non-CUSK type declarations are TyVarTvs, and we need to bring them
-- into scope as a skolem in an implication. This is OK, though,
@@ -1225,7 +1226,7 @@ uType t_or_k origin orig_ty1 orig_ty2
go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
-- See Note [Mismatched type lists and application decomposition]
| tc1 == tc2, equalLength tys1 tys2
- = ASSERT2( isGenerativeTyCon tc1 Nominal, ppr tc1 )
+ = assertPpr (isGenerativeTyCon tc1 Nominal) (ppr tc1) $
do { cos <- zipWith3M (uType t_or_k) origins' tys1 tys2
; return $ mkTyConAppCo Nominal tc1 cos }
where
@@ -1244,12 +1245,12 @@ uType t_or_k origin orig_ty1 orig_ty2
go (AppTy s1 t1) (TyConApp tc2 ts2)
| Just (ts2', t2') <- snocView ts2
- = ASSERT( not (mustBeSaturated tc2) )
+ = assert (not (mustBeSaturated tc2)) $
go_app (isNextTyConArgVisible tc2 ts2') s1 t1 (TyConApp tc2 ts2') t2'
go (TyConApp tc1 ts1) (AppTy s2 t2)
| Just (ts1', t1') <- snocView ts1
- = ASSERT( not (mustBeSaturated tc1) )
+ = assert (not (mustBeSaturated tc1)) $
go_app (isNextTyConArgVisible tc1 ts1') (TyConApp tc1 ts1') t1' s2 t2
go (CoercionTy co1) (CoercionTy co2)
@@ -1523,7 +1524,7 @@ lhsPriority :: TcTyVar -> Int
-- => more likely to be eliminated
-- See Note [TyVar/TyVar orientation]
lhsPriority tv
- = ASSERT2( isTyVar tv, ppr tv)
+ = assertPpr (isTyVar tv) (ppr tv) $
case tcTyVarDetails tv of
RuntimeUnk -> 0
SkolemTv {} -> 0
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index bca87fb293..e2fe09991f 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -73,6 +73,8 @@ import GHC.Core.DataCon
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Constants (debugIsOn)
import GHC.Core.Multiplicity
import GHC.Core
@@ -506,7 +508,7 @@ zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
-- as the old one. This important when zonking the
-- TyVarBndrs of a TyCon, whose Names may scope.
zonkTyBndrX env tv
- = ASSERT2( isImmutableTyVar tv, ppr tv <+> dcolon <+> ppr (tyVarKind tv) )
+ = assertPpr (isImmutableTyVar tv) (ppr tv <+> dcolon <+> ppr (tyVarKind tv)) $
do { ki <- zonkTcTypeToTypeX env (tyVarKind tv)
-- Internal names tidy up better, for iface files.
; let tv' = mkTyVar (tyVarName tv) ki
@@ -628,7 +630,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
, abs_exports = exports
, abs_binds = val_binds
, abs_sig = has_sig })
- = ASSERT( all isImmutableTyVar tyvars )
+ = assert (all isImmutableTyVar tyvars) $
do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
; (env1, new_evs) <- zonkEvBndrsX env0 evs
; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds
@@ -792,7 +794,7 @@ zonkLExprs env exprs = mapM (zonkLExpr env) exprs
zonkLExpr env expr = wrapLocMA (zonkExpr env) expr
zonkExpr env (HsVar x (L l id))
- = ASSERT2( isNothing (isDataConId_maybe id), ppr id )
+ = assertPpr (isNothing (isDataConId_maybe id)) (ppr id) $
return (HsVar x (L l (zonkIdOcc env id)))
zonkExpr env (HsUnboundVar her occ)
@@ -1125,7 +1127,7 @@ zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd)
new_ty <- zonkTcTypeToTypeX env ty
new_ids <- mapSndM (zonkExpr env) ids
- MASSERT( isLiftedTypeKind (tcTypeKind new_stack_tys) )
+ massert (isLiftedTypeKind (tcTypeKind new_stack_tys))
-- desugarer assumes that this is not levity polymorphic...
-- but indeed it should always be lifted due to the typing
-- rules for arrows
@@ -1148,7 +1150,7 @@ zonkCoFn env (WpEvLam ev) = do { (env', ev') <- zonkEvBndrX env ev
; return (env', WpEvLam ev') }
zonkCoFn env (WpEvApp arg) = do { arg' <- zonkEvTerm env arg
; return (env, WpEvApp arg') }
-zonkCoFn env (WpTyLam tv) = ASSERT( isImmutableTyVar tv )
+zonkCoFn env (WpTyLam tv) = assert (isImmutableTyVar tv) $
do { (env', tv') <- zonkTyBndrX env tv
; return (env', WpTyLam tv') }
zonkCoFn env (WpTyApp ty) = do { ty' <- zonkTcTypeToTypeX env ty
@@ -1479,7 +1481,7 @@ zonk_pat env p@(ConPat { pat_con = L _ con
, cpt_arg_tys = tys
})
})
- = ASSERT( all isImmutableTyVar tyvars )
+ = assert (all isImmutableTyVar tyvars) $
do { new_tys <- mapM (zonkTcTypeToTypeX env) tys
-- an unboxed tuple pattern (but only an unboxed tuple pattern)
@@ -1626,7 +1628,7 @@ zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-}
zonk_it env v
| isId v = do { v' <- zonkIdBndr env v
; return (extendIdZonkEnvRec env [v'], v') }
- | otherwise = ASSERT( isImmutableTyVar v)
+ | otherwise = assert (isImmutableTyVar v)
zonkTyBndrX env v
-- DV: used to be return (env,v) but that is plain
-- wrong because we may need to go inside the kind
@@ -1960,9 +1962,9 @@ zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
Nothing -> do { traceTc "Zonking unfilled coercion hole" (ppr hole)
; when debugIsOn $
whenNoErrs $
- MASSERT2( False
- , text "Type-correct unfilled coercion hole"
- <+> ppr hole )
+ massertPpr False
+ (text "Type-correct unfilled coercion hole"
+ <+> ppr hole)
; cv' <- zonkCoVar cv
; return $ mkCoVarCo cv' } }
-- This will be an out-of-scope variable, but keeping