summaryrefslogtreecommitdiff
path: root/compiler/GHC/HsToCore
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/HsToCore')
-rw-r--r--compiler/GHC/HsToCore/Binds.hs8
-rw-r--r--compiler/GHC/HsToCore/Expr.hs25
-rw-r--r--compiler/GHC/HsToCore/Foreign/Call.hs8
-rw-r--r--compiler/GHC/HsToCore/Foreign/Decl.hs8
-rw-r--r--compiler/GHC/HsToCore/GuardedRHSs.hs5
-rw-r--r--compiler/GHC/HsToCore/ListComp.hs8
-rw-r--r--compiler/GHC/HsToCore/Match.hs15
-rw-r--r--compiler/GHC/HsToCore/Match/Constructor.hs11
-rw-r--r--compiler/GHC/HsToCore/Match/Literal.hs3
-rw-r--r--compiler/GHC/HsToCore/Pmc/Desugar.hs4
-rw-r--r--compiler/GHC/HsToCore/Pmc/Ppr.hs6
-rw-r--r--compiler/GHC/HsToCore/Pmc/Solver.hs7
-rw-r--r--compiler/GHC/HsToCore/Pmc/Solver/Types.hs5
-rw-r--r--compiler/GHC/HsToCore/Quote.hs7
-rw-r--r--compiler/GHC/HsToCore/Usage.hs2
-rw-r--r--compiler/GHC/HsToCore/Utils.hs11
16 files changed, 71 insertions, 62 deletions
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 7af84d1d06..760fbe166c 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -62,6 +62,8 @@ import GHC.Types.Var.Env
import GHC.Types.Var( EvVar )
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Constants (debugIsOn)
import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Data.Maybe
@@ -98,7 +100,7 @@ dsTopLHsBinds binds
= do { (force_vars, prs) <- dsLHsBinds binds
; when debugIsOn $
do { xstrict <- xoptM LangExt.Strict
- ; MASSERT2( null force_vars || xstrict, ppr binds $$ ppr force_vars ) }
+ ; massertPpr (null force_vars || xstrict) (ppr binds $$ ppr force_vars) }
-- with -XStrict, even top-level vars are listed as force vars.
; return (toOL prs) }
@@ -1139,7 +1141,7 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1) doc)
; if ok
then return (\e -> (Lam x (w2 (app e arg))))
else return id } -- this return is irrelevant
-dsHsWrapper (WpCast co) = ASSERT(coercionRole co == Representational)
+dsHsWrapper (WpCast co) = assert (coercionRole co == Representational) $
return $ \e -> mkCastDs e co
dsHsWrapper (WpEvApp tm) = do { core_tm <- dsEvTerm tm
; return (\e -> App e core_tm) }
@@ -1150,7 +1152,7 @@ dsHsWrapper (WpMultCoercion co) = do { when (not (isReflexiveCo co)) $
--------------------------------------
dsTcEvBinds_s :: [TcEvBinds] -> DsM [CoreBind]
dsTcEvBinds_s [] = return []
-dsTcEvBinds_s (b:rest) = ASSERT( null rest ) -- Zonker ensures null
+dsTcEvBinds_s (b:rest) = assert (null rest) $ -- Zonker ensures null
dsTcEvBinds b
dsTcEvBinds :: TcEvBinds -> DsM [CoreBind]
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 176aa1bc02..64e799d0e9 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -70,6 +70,7 @@ import GHC.Utils.Misc
import GHC.Data.Bag
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Core.PatSyn
import Control.Monad
import Data.Void( absurd )
@@ -161,19 +162,19 @@ ds_val_bind (NonRecursive, hsbinds) body
ds_val_bind (is_rec, binds) _body
| anyBag (isUnliftedHsBind . unLoc) binds -- see Note [Strict binds checks] in GHC.HsToCore.Binds
- = ASSERT( isRec is_rec )
+ = assert (isRec is_rec )
errDsCoreExpr $
hang (text "Recursive bindings for unlifted types aren't allowed:")
2 (vcat (map ppr (bagToList binds)))
-- Ordinary case for bindings; none should be unlifted
ds_val_bind (is_rec, binds) body
- = do { MASSERT( isRec is_rec || isSingletonBag binds )
+ = do { massert (isRec is_rec || isSingletonBag binds)
-- we should never produce a non-recursive list of multiple binds
; (force_vars,prs) <- dsLHsBinds binds
; let body' = foldr seqVar body force_vars
- ; ASSERT2( not (any (isUnliftedType . idType . fst) prs), ppr is_rec $$ ppr binds )
+ ; assertPpr (not (any (isUnliftedType . idType . fst) prs)) (ppr is_rec $$ ppr binds) $
case prs of
[] -> return body
_ -> return (Let (Rec prs) body') }
@@ -209,8 +210,8 @@ dsUnliftedBind (FunBind { fun_id = L l fun
-- so must be simply unboxed
= do { (args, rhs) <- matchWrapper (mkPrefixFunRhs (L l $ idName fun))
Nothing matches
- ; MASSERT( null args ) -- Functions aren't lifted
- ; MASSERT( isIdHsWrapper co_fn )
+ ; massert (null args) -- Functions aren't lifted
+ ; massert (isIdHsWrapper co_fn)
; let rhs' = mkOptTickBox tick rhs
; return (bindNonRec fun rhs' body) }
@@ -245,9 +246,9 @@ dsUnliftedBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
-- function in GHC.Tc.Utils.Zonk:
-- putSrcSpanDs loc $ do
-- { core_expr <- dsExpr e
--- ; MASSERT2( exprType core_expr `eqType` hsExprType e
--- , ppr e <+> dcolon <+> ppr (hsExprType e) $$
--- ppr core_expr <+> dcolon <+> ppr (exprType core_expr) )
+-- ; massertPpr (exprType core_expr `eqType` hsExprType e)
+-- (ppr e <+> dcolon <+> ppr (hsExprType e) $$
+-- ppr core_expr <+> dcolon <+> ppr (exprType core_expr))
-- ; return core_expr }
dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
dsLExpr (L loc e) =
@@ -484,7 +485,7 @@ dsExpr (RecordCon { rcon_con = L _ con_like
mk_arg (arg_ty, fl)
= case findField (rec_flds rbinds) (flSelector fl) of
- (rhs:rhss) -> ASSERT( null rhss )
+ (rhs:rhss) -> assert (null rhss )
dsLExprNoLP rhs
[] -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (ppr (flLabel fl))
unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty Outputable.empty
@@ -603,7 +604,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields
| null fields
= dsLExpr record_expr
| otherwise
- = ASSERT2( notNull cons_to_upd, ppr expr )
+ = assertPpr (notNull cons_to_upd) (ppr expr) $
do { record_expr' <- dsLExpr record_expr
; field_binds' <- mapM ds_field fields
@@ -771,7 +772,7 @@ dsExpr (HsTick _ tickish e) = do
dsExpr (HsBinTick _ ixT ixF e) = do
e2 <- dsLExpr e
- do { ASSERT(exprType e2 `eqType` boolTy)
+ do { assert (exprType e2 `eqType` boolTy)
mkBinaryTickBox ixT ixF e2
}
@@ -938,7 +939,7 @@ dsDo ctx stmts
goL ((L loc stmt):lstmts) = putSrcSpanDsA loc (go loc stmt lstmts)
go _ (LastStmt _ body _ _) stmts
- = ASSERT( null stmts ) dsLExpr body
+ = assert (null stmts ) dsLExpr body
-- The 'return' op isn't used for 'do' expressions
go _ (BodyStmt _ rhs then_expr _) stmts
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index 5cf906e376..f946a8be25 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -46,8 +46,8 @@ import GHC.Types.Literal
import GHC.Builtin.Names
import GHC.Driver.Session
import GHC.Utils.Outputable
-import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import Data.Maybe
@@ -120,7 +120,7 @@ mkFCall :: DynFlags -> Unique -> ForeignCall
-- (ccallid::(forall a b. StablePtr (a -> b) -> Addr -> Char -> IO Addr))
-- a b s x c
mkFCall dflags uniq the_fcall val_args res_ty
- = ASSERT( all isTyVar tyvars ) -- this must be true because the type is top-level
+ = assert (all isTyVar tyvars) $ -- this must be true because the type is top-level
mkApps (mkVarApps (Var the_fcall_id) tyvars) val_args
where
arg_tys = map exprType val_args
@@ -163,7 +163,7 @@ unboxArg arg
-- Data types with a single constructor, which has a single, primitive-typed arg
-- This deals with Int, Float etc; also Ptr, ForeignPtr
| is_product_type && data_con_arity == 1
- = ASSERT2(isUnliftedType data_con_arg_ty1, pprType arg_ty)
+ = assertPpr (isUnliftedType data_con_arg_ty1) (pprType arg_ty) $
-- Typechecker ensures this
do case_bndr <- newSysLocalDs Many arg_ty
prim_arg <- newSysLocalDs Many data_con_arg_ty1
@@ -289,7 +289,7 @@ mk_alt return_result (Nothing, wrap_result)
mk_alt return_result (Just prim_res_ty, wrap_result)
= -- The ccall returns a non-() value
- ASSERT2( isPrimitiveType prim_res_ty, ppr prim_res_ty )
+ assertPpr (isPrimitiveType prim_res_ty) (ppr prim_res_ty) $
-- True because resultWrapper ensures it is so
do { result_id <- newSysLocalDs Many prim_res_ty
; state_id <- newSysLocalDs Many realWorldStatePrimTy
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index 933e8241e2..ff1fb52eba 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -57,8 +57,8 @@ import GHC.Driver.Session
import GHC.Driver.Config
import GHC.Platform
import GHC.Data.OrdList
-import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Driver.Hooks
import GHC.Utils.Encoding
@@ -174,7 +174,7 @@ dsCImport id co (CLabel cid) cconv _ _ = do
IsFunction
_ -> IsData
(resTy, foRhs) <- resultWrapper ty
- ASSERT(fromJust resTy `eqType` addrPrimTy) -- typechecker ensures this
+ assert (fromJust resTy `eqType` addrPrimTy) $ -- typechecker ensures this
let
rhs = foRhs (Lit (LitLabel cid stdcall_info fod))
rhs' = Cast rhs co
@@ -819,8 +819,8 @@ getPrimTyOf ty
| otherwise =
case splitDataProductType_maybe rep_ty of
Just (_, _, data_con, [Scaled _ prim_ty]) ->
- ASSERT(dataConSourceArity data_con == 1)
- ASSERT2(isUnliftedType prim_ty, ppr prim_ty)
+ assert (dataConSourceArity data_con == 1) $
+ assertPpr (isUnliftedType prim_ty) (ppr prim_ty)
prim_ty
_other -> pprPanic "GHC.HsToCore.Foreign.Decl.getPrimTyOf" (ppr ty)
where
diff --git a/compiler/GHC/HsToCore/GuardedRHSs.hs b/compiler/GHC/HsToCore/GuardedRHSs.hs
index 4ad474ceb7..6469b7b969 100644
--- a/compiler/GHC/HsToCore/GuardedRHSs.hs
+++ b/compiler/GHC/HsToCore/GuardedRHSs.hs
@@ -30,6 +30,7 @@ import GHC.Utils.Misc
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Core.Multiplicity
import Control.Monad ( zipWithM )
import Data.List.NonEmpty ( NonEmpty, toList )
@@ -63,8 +64,8 @@ dsGRHSs :: HsMatchContext GhcRn
-- one for each GRHS.
-> DsM (MatchResult CoreExpr)
dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_nablas
- = ASSERT( notNull grhss )
- do { match_results <- ASSERT( length grhss == length rhss_nablas )
+ = assert (notNull grhss) $
+ do { match_results <- assert (length grhss == length rhss_nablas) $
zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_nablas) grhss
; nablas <- getPmNablas
-- We need to remember the Nablas from the particular match context we
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index e2691de6c0..d96825937b 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -35,9 +35,9 @@ import GHC.Builtin.Names
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Tc.Utils.TcType
import GHC.Data.List.SetOps( getNth )
-import GHC.Utils.Misc
{-
List comprehensions may be desugared in one of two ways: ``ordinary''
@@ -222,7 +222,7 @@ deListComp [] _ = panic "deListComp"
deListComp (LastStmt _ body _ _ : quals) list
= -- Figure 7.4, SLPJ, p 135, rule C above
- ASSERT( null quals )
+ assert (null quals) $
do { core_body <- dsLExpr body
; return (mkConsExpr (exprType core_body) core_body list) }
@@ -329,7 +329,7 @@ dfListComp :: Id -> Id -- 'c' and 'n'
dfListComp _ _ [] = panic "dfListComp"
dfListComp c_id n_id (LastStmt _ body _ _ : quals)
- = ASSERT( null quals )
+ = assert (null quals) $
do { core_body <- dsLExprNoLP body
; return (mkApps (Var c_id) [core_body, Var n_id]) }
@@ -485,7 +485,7 @@ dsMcStmts ((L loc stmt) : lstmts) = putSrcSpanDsA loc (dsMcStmt stmt lstmts)
dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr
dsMcStmt (LastStmt _ body _ ret_op) stmts
- = ASSERT( null stmts )
+ = assert (null stmts) $
do { body' <- dsLExpr body
; dsSyntaxExpr ret_op [body'] }
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index a5960529c5..e80c751cb4 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -61,6 +61,7 @@ import GHC.Utils.Misc
import GHC.Types.Name
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Types.Unique
import GHC.Types.Unique.DFM
@@ -184,15 +185,15 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with
-> DsM (MatchResult CoreExpr) -- ^ Desugared result!
match [] ty eqns
- = ASSERT2( not (null eqns), ppr ty )
+ = assertPpr (not (null eqns)) (ppr ty) $
return (foldr1 combineMatchResults match_results)
where
- match_results = [ ASSERT( null (eqn_pats eqn) )
+ match_results = [ assert (null (eqn_pats eqn)) $
eqn_rhs eqn
| eqn <- eqns ]
match (v:vs) ty eqns -- Eqns *can* be empty
- = ASSERT2( all (isInternalName . idName) vars, ppr vars )
+ = assertPpr (all (isInternalName . idName) vars) (ppr vars) $
do { dflags <- getDynFlags
; let platform = targetPlatform dflags
-- Tidy the first pattern, generating
@@ -574,12 +575,12 @@ push_bang_into_newtype_arg :: SrcSpanAnnA
-- See Note [Bang patterns and newtypes]
-- We are transforming !(N p) into (N !p)
push_bang_into_newtype_arg l _ty (PrefixCon ts (arg:args))
- = ASSERT( null args)
+ = assert (null args) $
PrefixCon ts [L l (BangPat noExtField arg)]
push_bang_into_newtype_arg l _ty (RecCon rf)
| HsRecFields { rec_flds = L lf fld : flds } <- rf
, HsRecField { hsRecFieldArg = arg } <- fld
- = ASSERT( null flds)
+ = assert (null flds) $
RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg
= L l (BangPat noExtField arg) })] })
push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
@@ -873,7 +874,7 @@ matchSinglePatVar :: Id -- See Note [Match Ids]
-> HsMatchContext GhcRn -> LPat GhcTc
-> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr)
matchSinglePatVar var mb_scrut ctx pat ty match_result
- = ASSERT2( isInternalName (idName var), ppr var )
+ = assertPpr (isInternalName (idName var)) (ppr var) $
do { dflags <- getDynFlags
; locn <- getSrcSpanDs
-- Pattern match check warnings
@@ -1171,7 +1172,7 @@ patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) =
(HsFractional f, is_neg)
| is_neg -> PgN $! negateFractionalLit f
| otherwise -> PgN f
- (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
+ (HsIsString _ s, _) -> assert (isNothing mb_neg) $
PgOverS s
patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) =
case oval of
diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs
index 39817044cc..b4acb7fa47 100644
--- a/compiler/GHC/HsToCore/Match/Constructor.hs
+++ b/compiler/GHC/HsToCore/Match/Constructor.hs
@@ -36,6 +36,7 @@ import GHC.Types.FieldLabel ( flSelector )
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import Control.Monad(liftM)
import Data.List (groupBy)
import Data.List.NonEmpty (NonEmpty(..))
@@ -133,10 +134,10 @@ matchOneConLike :: [Id]
-> NonEmpty EquationInfo
-> DsM (CaseAlt ConLike)
matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single constructor
- = do { let inst_tys = ASSERT( all tcIsTcTyVar ex_tvs )
+ = do { let inst_tys = assert (all tcIsTcTyVar ex_tvs) $
-- ex_tvs can only be tyvars as data types in source
-- Haskell cannot mention covar yet (Aug 2018).
- ASSERT( tvs1 `equalLength` ex_tvs )
+ assert (tvs1 `equalLength` ex_tvs) $
arg_tys ++ mkTyVarTys tvs1
val_arg_tys = conLikeInstOrigArgTys con1 inst_tys
@@ -147,7 +148,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct
-> [(ConArgPats, EquationInfo)] -> DsM (MatchResult CoreExpr)
-- All members of the group have compatible ConArgPats
match_group arg_vars arg_eqn_prs
- = ASSERT( notNull arg_eqn_prs )
+ = assert (notNull arg_eqn_prs) $
do { (wraps, eqns') <- liftM unzip (mapM shift arg_eqn_prs)
; let group_arg_vars = select_arg_vars arg_vars arg_eqn_prs
; match_result <- match (group_arg_vars ++ vars) ty eqns'
@@ -216,8 +217,8 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct
| RecCon flds <- arg_pats
, let rpats = rec_flds flds
, not (null rpats) -- Treated specially; cf conArgPats
- = ASSERT2( fields1 `equalLength` arg_vars,
- ppr con1 $$ ppr fields1 $$ ppr arg_vars )
+ = assertPpr (fields1 `equalLength` arg_vars)
+ (ppr con1 $$ ppr fields1 $$ ppr arg_vars) $
map lookup_fld rpats
| otherwise
= arg_vars
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index a3cc8f44af..1a1ce99ead 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -56,6 +56,7 @@ import GHC.Utils.Outputable as Outputable
import GHC.Driver.Session
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import qualified GHC.LanguageExtensions as LangExt
import GHC.Core.FamInstEnv ( FamInstEnvs, normaliseType )
@@ -204,7 +205,7 @@ dsFractionalLitToRational fl@FL{ fl_signi = signi, fl_exp = exp, fl_exp_base = b
!denom = mkIntegerExpr (denominator val)
(ratio_data_con, integer_ty)
= case tcSplitTyConApp ty of
- (tycon, [i_ty]) -> ASSERT(isIntegerTy i_ty && tycon `hasKey` ratioTyConKey)
+ (tycon, [i_ty]) -> assert (isIntegerTy i_ty && tycon `hasKey` ratioTyConKey)
(head (tyConDataCons tycon), i_ty)
x -> pprPanic "dsLit" (ppr x)
in return $! (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index 01b712a102..7d7ea92071 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -33,7 +33,6 @@ import GHC.Builtin.Names (rationalTyConName)
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Panic
-import GHC.Utils.Misc
import GHC.Core.DataCon
import GHC.Types.Var (EvVar)
import GHC.Core.Coercion
@@ -405,7 +404,8 @@ desugarLocalBinds (HsValBinds _ (XValBindsLR (NValBinds binds _))) =
let go_export :: ABExport GhcTc -> Maybe PmGrd
go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap}
| isIdHsWrapper wrap
- = ASSERT2(idType x `eqType` idType y, ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y))
+ = assertPpr (idType x `eqType` idType y)
+ (ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y)) $
Just $ PmLet x (Var y)
| otherwise
= Nothing
diff --git a/compiler/GHC/HsToCore/Pmc/Ppr.hs b/compiler/GHC/HsToCore/Pmc/Ppr.hs
index 3de6a14970..7a15a18528 100644
--- a/compiler/GHC/HsToCore/Pmc/Ppr.hs
+++ b/compiler/GHC/HsToCore/Pmc/Ppr.hs
@@ -21,8 +21,8 @@ import GHC.Core.DataCon
import GHC.Builtin.Types
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import Control.Monad.Trans.RWS.CPS
-import GHC.Utils.Misc
import GHC.Data.Maybe
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
@@ -203,8 +203,8 @@ pmExprAsList nabla = go_con []
go_con rev_pref (PmAltConLike (RealDataCon c)) es
| c == nilDataCon
- = ASSERT( null es ) Just (NilTerminated (reverse rev_pref))
+ = assert (null es) $ Just (NilTerminated (reverse rev_pref))
| c == consDataCon
- = ASSERT( length es == 2 ) go_var (es !! 0 : rev_pref) (es !! 1)
+ = assert (length es == 2) $ go_var (es !! 0 : rev_pref) (es !! 1)
go_con _ _ _
= Nothing
diff --git a/compiler/GHC/HsToCore/Pmc/Solver.hs b/compiler/GHC/HsToCore/Pmc/Solver.hs
index 726652924d..bc663a3184 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver.hs
@@ -47,6 +47,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Monad (allM)
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Data.Bag
import GHC.Types.CompleteMatch
import GHC.Types.Unique.Set
@@ -397,7 +398,7 @@ pmIsClosedType ty
= case splitTyConApp_maybe ty of
Just (tc, ty_args)
| is_algebraic_like tc && not (isFamilyTyCon tc)
- -> ASSERT2( ty_args `lengthIs` tyConArity tc, ppr ty ) True
+ -> assertPpr (ty_args `lengthIs` tyConArity tc) (ppr ty) True
_other -> False
where
-- This returns True for TyCons which /act like/ algebraic types.
@@ -796,7 +797,7 @@ addNotConCt nabla x nalt = do
-- See Note [Completeness checking with required Thetas]
| hasRequiredTheta nalt = neg
| otherwise = extendPmAltConSet neg nalt
- MASSERT( isPmAltConMatchStrict nalt )
+ massert (isPmAltConMatchStrict nalt)
let vi' = vi{ vi_neg = neg', vi_bot = IsNotBot }
-- 3. Make sure there's at least one other possible constructor
mb_rcm' <- lift (markMatched nalt rcm)
@@ -853,7 +854,7 @@ addConCt nabla@MkNabla{ nabla_tm_st = ts@TmSt{ ts_facts=env } } x alt tvs args =
MaybeBot -> pure (nabla_with MaybeBot)
IsBot -> addBotCt (nabla_with MaybeBot) y
IsNotBot -> addNotBotCt (nabla_with MaybeBot) y
- _ -> ASSERT( isPmAltConMatchStrict alt )
+ _ -> assert (isPmAltConMatchStrict alt )
pure (nabla_with IsNotBot) -- strict match ==> not ⊥
equateTys :: [Type] -> [Type] -> [PhiCt]
diff --git a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
index 7516a56995..2961cb7433 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
@@ -36,7 +36,6 @@ module GHC.HsToCore.Pmc.Solver.Types (
import GHC.Prelude
-import GHC.Utils.Misc
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Types.Id
@@ -47,7 +46,7 @@ import GHC.Types.Name
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Utils.Outputable
-import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Data.List.SetOps (unionLists)
import GHC.Data.Maybe
import GHC.Core.Type
@@ -431,7 +430,7 @@ instance Eq PmAltCon where
-- | Type of a 'PmAltCon'
pmAltConType :: PmAltCon -> [Type] -> Type
-pmAltConType (PmAltLit lit) _arg_tys = ASSERT( null _arg_tys ) pmLitType lit
+pmAltConType (PmAltLit lit) _arg_tys = assert (null _arg_tys ) $ pmLitType lit
pmAltConType (PmAltConLike con) arg_tys = conLikeResTy con arg_tys
-- | Is a match on this constructor forcing the match variable?
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index e13f0ceb50..26341017ba 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -65,6 +65,7 @@ import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import GHC.Utils.Monad
@@ -128,7 +129,7 @@ mkMetaWrappers q@(QuoteWrapper quote_var_raw m_var) = do
mkInvisFunTyMany (mkClassPred cls (mkTyVarTys (binderVars tyvars)))
(mkClassPred monad_cls (mkTyVarTys (binderVars tyvars)))
- MASSERT2( idType monad_sel `eqType` expected_ty, ppr monad_sel $$ ppr expected_ty)
+ massertPpr (idType monad_sel `eqType` expected_ty) (ppr monad_sel $$ ppr expected_ty)
let m_ty = Type m_var
-- Construct the contents of MetaWrappers
@@ -1796,7 +1797,7 @@ repSts (stmt@RecStmt{} : ss)
-- Bring all of binders in the recursive group into scope for the
-- whole group.
; (ss1_other,rss) <- addBinds ss1 $ repSts (map unLoc (unLoc $ recS_stmts stmt))
- ; MASSERT(sort ss1 == sort ss1_other)
+ ; massert (sort ss1 == sort ss1_other)
; z <- repRecSt (nonEmptyCoreList rss)
; (ss2,zs) <- addBinds ss1 (repSts ss)
; return (ss1++ss2, z : zs) }
@@ -2172,7 +2173,7 @@ globalVar name
; MkC uni <- coreIntegerLit (toInteger $ getKey (getUnique name))
; rep2_nwDsM mkNameLName [occ,uni] }
where
- mod = ASSERT( isExternalName name) nameModule name
+ mod = assert (isExternalName name) nameModule name
name_mod = moduleNameString (moduleName mod)
name_pkg = unitString (moduleUnit mod)
name_occ = nameOccName name
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index a0fadacb89..4b1e6e4346 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -289,7 +289,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
| isWiredInName name = mv_map -- ignore wired-in names
| otherwise
= case nameModule_maybe name of
- Nothing -> ASSERT2( isSystemName name, ppr name ) mv_map
+ Nothing -> assertPpr (isSystemName name) (ppr name) mv_map
-- See Note [Internal used_names]
Just mod ->
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 002cf8d4b2..32e4e0990d 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -78,6 +78,7 @@ import GHC.Builtin.Names
import GHC.Types.Name( isInternalName )
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Types.SrcLoc
import GHC.Types.Tickish
import GHC.Utils.Misc
@@ -144,7 +145,7 @@ selectMatchVar _w (VarPat _ var) = return (localiseId (unLoc var))
-- multiplicity stored within the variable
-- itself. It's easier to pull it from the
-- variable, so we ignore the multiplicity.
-selectMatchVar _w (AsPat _ var _) = ASSERT( isManyDataConTy _w ) (return (unLoc var))
+selectMatchVar _w (AsPat _ var _) = assert (isManyDataConTy _w ) (return (unLoc var))
selectMatchVar w other_pat = newSysLocalDsNoLP w (hsPatType other_pat)
{- Note [Localise pattern binders]
@@ -198,7 +199,7 @@ worthy of a type synonym and a few handy functions.
-}
firstPat :: EquationInfo -> Pat GhcTc
-firstPat eqn = ASSERT( notNull (eqn_pats eqn) ) head (eqn_pats eqn)
+firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn)
shiftEqns :: Functor f => f EquationInfo -> f EquationInfo
-- Drop the first pattern in each equation
@@ -283,7 +284,7 @@ mkCoPrimCaseMatchResult var ty match_alts
sorted_alts = sortWith fst match_alts -- Right order for a Case
mk_alt fail (lit, mr)
- = ASSERT( not (litIsLifted lit) )
+ = assert (not (litIsLifted lit)) $
do body <- runMatchResult fail mr
return (Alt (LitAlt lit) [] body)
@@ -299,7 +300,7 @@ mkCoAlgCaseMatchResult
-> MatchResult CoreExpr
mkCoAlgCaseMatchResult var ty match_alts
| isNewtype -- Newtype case; use a let
- = ASSERT( null match_alts_tail && null (tail arg_ids1) )
+ = assert (null match_alts_tail && null (tail arg_ids1)) $
mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1
| otherwise
@@ -313,7 +314,7 @@ mkCoAlgCaseMatchResult var ty match_alts
alt1@MkCaseAlt{ alt_bndrs = arg_ids1, alt_result = match_result1 } :| match_alts_tail
= match_alts
-- Stuff for newtype
- arg_id1 = ASSERT( notNull arg_ids1 ) head arg_ids1
+ arg_id1 = assert (notNull arg_ids1) $ head arg_ids1
var_ty = idType var
(tc, ty_args) = tcSplitTyConApp var_ty -- Don't look through newtypes
-- (not that splitTyConApp does, these days)
View Lorry Controller Status