diff options
Diffstat (limited to 'compiler/GHC/HsToCore/Expr.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Expr.hs | 25 |
1 files changed, 13 insertions, 12 deletions
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 |