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 ()

5 files changed, 22 insertions, 21 deletions

diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs
index 4e7b66f23d..32e94234b4 100644
--- a/compiler/GHC/Stg/Lift.hs
+++ b/compiler/GHC/Stg/Lift.hs
@@ -28,7 +28,6 @@ import GHC.Stg.Lift.Monad
 import GHC.Stg.Syntax
 import GHC.Utils.Outputable
 import GHC.Types.Unique.Supply
-import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Types.Var.Set
 import Control.Monad ( when )
@@ -200,7 +199,9 @@ liftRhs
   -> LlStgRhs
   -> LiftM OutStgRhs
 liftRhs mb_former_fvs rhs@(StgRhsCon ccs con mn ts args)
-  = ASSERT2(isNothing mb_former_fvs, text "Should never lift a constructor" $$ pprStgRhs panicStgPprOpts rhs)
+  = assertPpr (isNothing mb_former_fvs)
+              (text "Should never lift a constructor"
+               $$ pprStgRhs panicStgPprOpts rhs) $
     StgRhsCon ccs con mn ts <$> traverse liftArgs args
 liftRhs Nothing (StgRhsClosure _ ccs upd infos body) =
   -- This RHS wasn't lifted.
@@ -215,7 +216,7 @@ liftRhs (Just former_fvs) (StgRhsClosure _ ccs upd infos body) =
 liftArgs :: InStgArg -> LiftM OutStgArg
 liftArgs a@(StgLitArg _) = pure a
 liftArgs (StgVarArg occ) = do
-  ASSERTM2( not <$> isLifted occ, text "StgArgs should never be lifted" $$ ppr occ )
+  assertPprM (not <$> isLifted occ) (text "StgArgs should never be lifted" $$ ppr occ)
   StgVarArg <$> substOcc occ
 
 liftExpr :: LlStgExpr -> LiftM OutStgExpr
diff --git a/compiler/GHC/Stg/Lift/Monad.hs b/compiler/GHC/Stg/Lift/Monad.hs
index e43bda363d..c34c74d505 100644
--- a/compiler/GHC/Stg/Lift/Monad.hs
+++ b/compiler/GHC/Stg/Lift/Monad.hs
@@ -36,8 +36,8 @@ import GHC.Stg.Subst
 import GHC.Stg.Syntax
 import GHC.Core.Utils
 import GHC.Types.Unique.Supply
-import GHC.Utils.Misc
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Core.Multiplicity
@@ -183,7 +183,7 @@ collectFloats = go (0 :: Int) []
 
     map_rhss f = uncurry mkStgBinding . second (map (second f)) . decomposeStgBinding
     rm_cccs = map_rhss removeRhsCCCS
-    merge_binds binds = ASSERT( any is_rec binds )
+    merge_binds binds = assert (any is_rec binds) $
                         StgRec (concatMap (snd . decomposeStgBinding . rm_cccs) binds)
     is_rec StgRec{} = True
     is_rec _ = False
diff --git a/compiler/GHC/Stg/Subst.hs b/compiler/GHC/Stg/Subst.hs
index dce2859262..798a1f38bd 100644
--- a/compiler/GHC/Stg/Subst.hs
+++ b/compiler/GHC/Stg/Subst.hs
@@ -80,5 +80,5 @@ extendInScope id (Subst in_scope env) = Subst (in_scope `extendInScopeSet` id) e
 -- holds after extending the substitution like this.
 extendSubst :: Id -> Id -> Subst -> Subst
 extendSubst id new_id (Subst in_scope env)
-  = ASSERT2( new_id `elemInScopeSet` in_scope, ppr id <+> ppr new_id $$ ppr in_scope )
+  = assertPpr (new_id `elemInScopeSet` in_scope) (ppr id <+> ppr new_id $$ ppr in_scope) $
     Subst in_scope (extendVarEnv env id new_id)
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index cd25a36c0d..50fdea3dce 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -90,8 +90,7 @@ import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
 import GHC.Core.TyCon    ( PrimRep(..), TyCon )
 import GHC.Core.Type     ( Type )
 import GHC.Types.RepType ( typePrimRep1 )
-import GHC.Utils.Misc
-import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 
 {-
 ************************************************************************
@@ -503,7 +502,7 @@ type instance XLetNoEscape 'CodeGen = NoExtFieldSilent
 
 stgRhsArity :: StgRhs -> Int
 stgRhsArity (StgRhsClosure _ _ _ bndrs _)
-  = ASSERT( all isId bndrs ) length bndrs
+  = assert (all isId bndrs) $ length bndrs
   -- The arity never includes type parameters, but they should have gone by now
 stgRhsArity (StgRhsCon _ _ _ _ _) = 0
 
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 7790bc382d..4a4fef1402 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -257,6 +257,7 @@ import GHC.Types.Id.Make (voidPrimId, voidArgId)
 import GHC.Utils.Monad (mapAccumLM)
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Types.RepType
 import GHC.Stg.Syntax
 import GHC.Core.Type
@@ -307,10 +308,10 @@ instance Outputable UnariseVal where
 -- | Extend the environment, checking the UnariseEnv invariant.
 extendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv
 extendRho rho x (MultiVal args)
-  = ASSERT(all (isNvUnaryType . stgArgType) args)
+  = assert (all (isNvUnaryType . stgArgType) args)
     extendVarEnv rho x (MultiVal args)
 extendRho rho x (UnaryVal val)
-  = ASSERT(isNvUnaryType (stgArgType val))
+  = assert (isNvUnaryType (stgArgType val))
     extendVarEnv rho x (UnaryVal val)
 
 --------------------------------------------------------------------------------
@@ -336,7 +337,7 @@ unariseRhs rho (StgRhsClosure ext ccs update_flag args expr)
        return (StgRhsClosure ext ccs update_flag args1 expr')
 
 unariseRhs rho (StgRhsCon ccs con mu ts args)
-  = ASSERT(not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con))
+  = assert (not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con))
     return (StgRhsCon ccs con mu ts (unariseConArgs rho args))
 
 --------------------------------------------------------------------------------
@@ -420,7 +421,7 @@ unariseMulti_maybe rho dc args ty_args
   = Just (unariseConArgs rho args)
 
   | isUnboxedSumDataCon dc
-  , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args)
+  , let args1 = assert (isSingleton args) (unariseConArgs rho args)
   = Just (mkUbxSum dc ty_args args1)
 
   | otherwise
@@ -454,7 +455,7 @@ elimCase rho args bndr (MultiValAlt _) [(_, bndrs, rhs)]
              | isUnboxedTupleBndr bndr
              = mapTupleIdBinders bndrs args rho1
              | otherwise
-             = ASSERT(isUnboxedSumBndr bndr)
+             = assert (isUnboxedSumBndr bndr) $
                if null bndrs then rho1
                              else mapSumIdBinders bndrs args rho1
 
@@ -489,7 +490,7 @@ unariseAlts rho (MultiValAlt n) bndr [(DEFAULT, [], e)]
 unariseAlts rho (MultiValAlt n) bndr [(DataAlt _, ys, e)]
   | isUnboxedTupleBndr bndr
   = do (rho', ys1) <- unariseConArgBinders rho ys
-       MASSERT(ys1 `lengthIs` n)
+       massert (ys1 `lengthIs` n)
        let rho'' = extendRho rho' bndr (MultiVal (map StgVarArg ys1))
        e' <- unariseExpr rho'' e
        return [(DataAlt (tupleDataCon Unboxed n), ys1, e')]
@@ -559,7 +560,7 @@ mapTupleIdBinders
   -> UnariseEnv
   -> UnariseEnv
 mapTupleIdBinders ids args0 rho0
-  = ASSERT(not (any (isVoidTy . stgArgType) args0))
+  = assert (not (any (isVoidTy . stgArgType) args0)) $
     let
       ids_unarised :: [(Id, [PrimRep])]
       ids_unarised = map (\id -> (id, typePrimRep (idType id))) ids
@@ -570,12 +571,12 @@ mapTupleIdBinders ids args0 rho0
         let
           x_arity = length x_reps
           (x_args, args') =
-            ASSERT(args `lengthAtLeast` x_arity)
+            assert (args `lengthAtLeast` x_arity)
             splitAt x_arity args
 
           rho'
             | x_arity == 1
-            = ASSERT(x_args `lengthIs` 1)
+            = assert (x_args `lengthIs` 1)
               extendRho rho x (UnaryVal (head x_args))
             | otherwise
             = extendRho rho x (MultiVal x_args)
@@ -593,7 +594,7 @@ mapSumIdBinders
   -> UnariseEnv
 
 mapSumIdBinders [id] args rho0
-  = ASSERT(not (any (isVoidTy . stgArgType) args))
+  = assert (not (any (isVoidTy . stgArgType) args)) $
     let
       arg_slots = map primRepSlot $ concatMap (typePrimRep . stgArgType) args
       id_slots  = map primRepSlot $ typePrimRep (idType id)
@@ -601,7 +602,7 @@ mapSumIdBinders [id] args rho0
     in
       if isMultiValBndr id
         then extendRho rho0 id (MultiVal [ args !! i | i <- layout1 ])
-        else ASSERT(layout1 `lengthIs` 1)
+        else assert (layout1 `lengthIs` 1)
              extendRho rho0 id (UnaryVal (args !! head layout1))
 
 mapSumIdBinders ids sum_args _
@@ -787,7 +788,7 @@ unariseConArg _ arg@(StgLitArg lit)
   | Just as <- unariseRubbish_maybe lit
   = as
   | otherwise
-  = ASSERT(not (isVoidTy (literalType lit))) -- We have no non-rubbish void literals
+  = assert (not (isVoidTy (literalType lit))) -- We have no non-rubbish void literals
     [arg]
 
 unariseConArgs :: UnariseEnv -> [InStgArg] -> [OutStgArg]