Replace CPP assertions with Haskell functions

There is no reason to use CPP. __LINE__ and __FILE__ macros are now
better replaced with GHC's CallStack. As a bonus, assert error messages
now contain more information (function name, column).

Here is the mapping table (HasCallStack omitted):

  * ASSERT:   assert     :: Bool -> a -> a
  * MASSERT:  massert    :: Bool -> m ()
  * ASSERTM:  assertM    :: m Bool -> m ()
  * ASSERT2:  assertPpr  :: Bool -> SDoc -> a -> a
  * MASSERT2: massertPpr :: Bool -> SDoc -> m ()
  * ASSERTM2: assertPprM :: m Bool -> SDoc -> m ()

9 files changed, 35 insertions, 27 deletions

diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index f1346d2846..13b07c2dd2 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -285,7 +285,7 @@ mkRhsClosure    profile bndr _cc
   , let offset_into_int = bytesToWordsRoundUp (profilePlatform profile) the_offset
                           - fixedHdrSizeW profile
   , offset_into_int <= pc_MAX_SPEC_SELECTEE_SIZE (profileConstants profile) -- Offset is small enough
-  = -- NOT TRUE: ASSERT(is_single_constructor)
+  = -- NOT TRUE: assert (is_single_constructor)
     -- The simplifier may have statically determined that the single alternative
     -- is the only possible case and eliminated the others, even if there are
     -- other constructors in the datatype.  It's still ok to make a selector
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index d73f09e59d..f3619413a8 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -96,6 +96,7 @@ import GHC.Types.RepType
 import GHC.Types.Basic
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc
 
 import Data.Coerce (coerce)
@@ -158,7 +159,7 @@ nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidTy (idType id))]
 -- non-void; e.g. constructor field binders in case expressions.
 -- See Note [Post-unarisation invariants] in "GHC.Stg.Unarise".
 assertNonVoidIds :: [Id] -> [NonVoid Id]
-assertNonVoidIds ids = ASSERT(not (any (isVoidTy . idType) ids))
+assertNonVoidIds ids = assert (not (any (isVoidTy . idType) ids)) $
                        coerce ids
 
 nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
@@ -168,7 +169,7 @@ nonVoidStgArgs args = [NonVoid arg | arg <- args, not (isVoidTy (stgArgType arg)
 -- non-void; e.g. constructor arguments.
 -- See Note [Post-unarisation invariants] in "GHC.Stg.Unarise".
 assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
-assertNonVoidStgArgs args = ASSERT(not (any (isVoidTy . stgArgType) args))
+assertNonVoidStgArgs args = assert (not (any (isVoidTy . stgArgType) args)) $
                             coerce args
 
 
@@ -233,7 +234,7 @@ mkLFReEntrant top fvs args arg_descr
 -------------
 mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
 mkLFThunk thunk_ty top fvs upd_flag
-  = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) )
+  = assert (not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty)) $
     LFThunk top (null fvs)
             (isUpdatable upd_flag)
             NonStandardThunk
@@ -529,15 +530,15 @@ getCallMethod opts name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc
   | n_args == 0 -- No args at all
   && not (profileIsProfiling (co_profile opts))
      -- See Note [Evaluating functions with profiling] in rts/Apply.cmm
-  = ASSERT( arity /= 0 ) ReturnIt
+  = assert (arity /= 0) ReturnIt
   | n_args < arity = SlowCall        -- Not enough args
   | otherwise      = DirectEntry (enterIdLabel (profilePlatform (co_profile opts)) name (idCafInfo id)) arity
 
 getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info
-  = ASSERT( n_args == 0 ) ReturnIt
+  = assert (n_args == 0) ReturnIt
 
 getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info
-  = ASSERT( n_args == 0 ) ReturnIt
+  = assert (n_args == 0) ReturnIt
     -- n_args=0 because it'd be ill-typed to apply a saturated
     --          constructor application to anything
 
@@ -561,7 +562,7 @@ getCallMethod opts name id (LFThunk _ _ updatable std_form_info is_fun)
   | SelectorThunk{} <- std_form_info
   = EnterIt
 
-    -- We used to have ASSERT( n_args == 0 ), but actually it is
+    -- We used to have assert (n_args == 0 ), but actually it is
     -- possible for the optimiser to generate
     --   let bot :: Int = error Int "urk"
     --   in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
@@ -569,7 +570,7 @@ getCallMethod opts name id (LFThunk _ _ updatable std_form_info is_fun)
     -- So the right thing to do is just to enter the thing
 
   | otherwise        -- Jump direct to code for single-entry thunks
-  = ASSERT( n_args == 0 )
+  = assert (n_args == 0) $
     DirectEntry (thunkEntryLabel (profilePlatform (co_profile opts)) name (idCafInfo id) std_form_info
                 updatable) 0
 
@@ -577,7 +578,7 @@ getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info
   = SlowCall -- might be a function
 
 getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info
-  = ASSERT2( n_args == 0, ppr name <+> ppr n_args )
+  = assertPpr (n_args == 0) (ppr name <+> ppr n_args)
     EnterIt -- Not a function
 
 getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index fbf7a01399..49cbc2b78d 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -49,6 +49,7 @@ import GHC.Types.RepType (countConRepArgs)
 import GHC.Types.Literal
 import GHC.Builtin.Utils
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc
 import GHC.Utils.Monad (mapMaybeM)
 
@@ -93,8 +94,8 @@ cgTopRhsCon dflags id con mn args
         ; this_mod <- getModuleName
         ; when (platformOS platform == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
-              MASSERT( not (isDllConApp dflags this_mod con (map fromNonVoid args)) )
-        ; ASSERT( args `lengthIs` countConRepArgs con ) return ()
+              massert (not (isDllConApp dflags this_mod con (map fromNonVoid args)))
+        ; assert (args `lengthIs` countConRepArgs con ) return ()
 
         -- LAY IT OUT
         ; let
@@ -382,7 +383,7 @@ bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]
 -- binders args, assuming that we have just returned from a 'case' which
 -- found a con
 bindConArgs (DataAlt con) base args
-  = ASSERT(not (isUnboxedTupleDataCon con))
+  = assert (not (isUnboxedTupleDataCon con)) $
     do profile <- getProfile
        platform <- getPlatform
        let (_, _, args_w_offsets) = mkVirtConstrOffsets profile (addIdReps args)
@@ -402,4 +403,4 @@ bindConArgs (DataAlt con) base args
        mapMaybeM bind_arg args_w_offsets
 
 bindConArgs _other_con _base args
-  = ASSERT( null args ) return []
+  = assert (null args ) return []
diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs
index 5f4ef641c4..db97e6176f 100644
--- a/compiler/GHC/StgToCmm/Env.hs
+++ b/compiler/GHC/StgToCmm/Env.hs
@@ -42,9 +42,9 @@ import GHC.Builtin.Types.Prim
 import GHC.Types.Unique.FM
 import GHC.Types.Var.Env
 
-import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 
 import GHC.Driver.Session
 
@@ -137,7 +137,7 @@ getCgIdInfo id
                       | isUnliftedType (idType id)
                           -- An unlifted external Id must refer to a top-level
                           -- string literal. See Note [Bytes label] in "GHC.Cmm.CLabel".
-                      = ASSERT( idType id `eqType` addrPrimTy )
+                      = assert (idType id `eqType` addrPrimTy) $
                         mkBytesLabel name
                       | otherwise
                       = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id))
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index dbc2a9ea06..beadc9af8d 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -53,6 +53,7 @@ import GHC.Utils.Misc
 import GHC.Data.FastString
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 
 import Control.Monad ( unless, void )
 import Control.Arrow ( first )
@@ -555,7 +556,7 @@ chooseReturnBndrs bndr (PrimAlt _) _alts
   = assertNonVoidIds [bndr]
 
 chooseReturnBndrs _bndr (MultiValAlt n) [(_, ids, _)]
-  = ASSERT2(ids `lengthIs` n, ppr n $$ ppr ids $$ ppr _bndr)
+  = assertPpr (ids `lengthIs` n) (ppr n $$ ppr ids $$ ppr _bndr) $
     assertNonVoidIds ids     -- 'bndr' is not assigned!
 
 chooseReturnBndrs bndr (AlgAlt _) _alts
@@ -872,7 +873,8 @@ cgConApp con mn stg_args
        ; emitReturn arg_exprs }
 
   | otherwise   --  Boxed constructors; allocate and return
-  = ASSERT2( stg_args `lengthIs` countConRepArgs con, ppr con <> parens (ppr (countConRepArgs con)) <+> ppr stg_args )
+  = assertPpr (stg_args `lengthIs` countConRepArgs con)
+              (ppr con <> parens (ppr (countConRepArgs con)) <+> ppr stg_args) $
     do  { (idinfo, fcode_init) <- buildDynCon (dataConWorkId con) mn False
                                      currentCCS con (assertNonVoidStgArgs stg_args)
                                      -- con args are always non-void,
@@ -904,7 +906,7 @@ cgIdApp fun_id args = do
           | otherwise                -> emitReturn [fun]
           -- ToDo: does ReturnIt guarantee tagged?
 
-        EnterIt -> ASSERT( null args )  -- Discarding arguments
+        EnterIt -> assert (null args) $  -- Discarding arguments
                    emitEnter fun
 
         SlowCall -> do      -- A slow function call via the RTS apply routines
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index d10d7f6345..c6c24b7862 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -65,6 +65,8 @@ import GHC.Utils.Misc
 import Data.List (mapAccumL, partition)
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Constants (debugIsOn)
 import GHC.Data.FastString
 import Control.Monad
 
@@ -438,7 +440,7 @@ mkVirtHeapOffsetsWithPadding
 -- than the unboxed things
 
 mkVirtHeapOffsetsWithPadding profile header things =
-    ASSERT(not (any (isVoidRep . fst . fromNonVoid) things))
+    assert (not (any (isVoidRep . fst . fromNonVoid) things))
     ( tot_wds
     , bytesToWordsRoundUp platform bytes_of_ptrs
     , concat (ptrs_w_offsets ++ non_ptrs_w_offsets) ++ final_pad
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index c2c3b93125..0eb9dc756d 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -86,7 +86,7 @@ import GHC.Types.Unique.Supply
 import GHC.Data.FastString
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
-import GHC.Utils.Misc
+import GHC.Utils.Constants (debugIsOn)
 import GHC.Exts (oneShot)
 
 import Control.Monad
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index c29da653ba..c6c227f4e6 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -48,6 +48,7 @@ import GHC.Runtime.Heap.Layout
 import GHC.Data.FastString
 import GHC.Utils.Misc
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import Data.Maybe
 
 import Control.Monad (liftM, when, unless)
@@ -1522,7 +1523,7 @@ emitPrimOp dflags primop = case primop of
     --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
     -- That won't work.
     let tycon = tyConAppTyCon res_ty
-    MASSERT(isEnumerationTyCon tycon)
+    massert (isEnumerationTyCon tycon)
     platform <- getPlatform
     pure [tagToClosure platform tycon amode]
 
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 35af67cc54..adbd04b49e 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -76,6 +76,7 @@ import GHC.Driver.Session
 import GHC.Data.FastString
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Types.RepType
 import GHC.Types.CostCentre
 import GHC.Types.IPE
@@ -287,12 +288,12 @@ newUnboxedTupleRegs :: Type -> FCode ([LocalReg], [ForeignHint])
 -- the Sequel.  If the Sequel is a join point, using the
 -- regs it wants will save later assignments.
 newUnboxedTupleRegs res_ty
-  = ASSERT( isUnboxedTupleType res_ty )
+  = assert (isUnboxedTupleType res_ty) $
     do  { platform <- getPlatform
         ; sequel <- getSequel
         ; regs <- choose_regs platform sequel
-        ; ASSERT( regs `equalLength` reps )
-          return (regs, map primRepForeignHint reps) }
+        ; massert (regs `equalLength` reps)
+        ; return (regs, map primRepForeignHint reps) }
   where
     reps = typePrimRep res_ty
     choose_regs _ (AssignTo regs _) = return regs
@@ -323,7 +324,7 @@ emitMultiAssign []    []    = return ()
 emitMultiAssign [reg] [rhs] = emitAssign (CmmLocal reg) rhs
 emitMultiAssign regs rhss   = do
   platform <- getPlatform
-  ASSERT2( equalLength regs rhss, ppr regs $$ pdoc platform rhss )
+  assertPpr (equalLength regs rhss) (ppr regs $$ pdoc platform rhss) $
     unscramble platform ([1..] `zip` (regs `zip` rhss))
 
 unscramble :: Platform -> [Vrtx] -> FCode ()
@@ -411,7 +412,7 @@ mk_discrete_switch :: Bool -- ^ Use signed comparisons
 -- SINGLETON TAG RANGE: no case analysis to do
 mk_discrete_switch _ _tag_expr [(tag, lbl)] _ (lo_tag, hi_tag)
   | lo_tag == hi_tag
-  = ASSERT( tag == lo_tag )
+  = assert (tag == lo_tag) $
     mkBranch lbl
 
 -- SINGLETON BRANCH, NO DEFAULT: no case analysis to do