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

4 files changed, 28 insertions, 24 deletions

diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index d7314eaa5b..5048d59e30 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -31,11 +31,12 @@ import GHC.Cmm.Dataflow.Label
 
 import GHC.Platform
 import GHC.Types.Unique.FM
-import GHC.Utils.Misc
 
 import GHC.Data.Graph.Directed
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Misc
 import GHC.Data.Maybe
 
 -- DEBUGGING ONLY
@@ -312,7 +313,7 @@ instance Eq BlockChain where
 -- in the chain.
 instance Ord (BlockChain) where
    (BlockChain lbls1) `compare` (BlockChain lbls2)
-       = ASSERT(toList lbls1 /= toList lbls2 || lbls1 `strictlyEqOL` lbls2)
+       = assert (toList lbls1 /= toList lbls2 || lbls1 `strictlyEqOL` lbls2) $
          strictlyOrdOL lbls1 lbls2
 
 instance Outputable (BlockChain) where
@@ -719,7 +720,7 @@ sequenceChain  info weights     blocks@((BasicBlock entry _):_) =
             directEdges
 
         (neighbourChains, combined)
-            = ASSERT(noDups $ mapElems builtChains)
+            = assert (noDups $ mapElems builtChains) $
               {-# SCC "groupNeighbourChains" #-}
             --   pprTraceIt "NeighbourChains" $
               combineNeighbourhood rankedEdges (mapElems builtChains)
@@ -759,7 +760,7 @@ sequenceChain  info weights     blocks@((BasicBlock entry _):_) =
 #endif
 
         blockList
-            = ASSERT(noDups [masterChain])
+            = assert (noDups [masterChain])
               (concatMap fromOL $ map chainBlocks prepedChains)
 
         --chainPlaced = setFromList $ map blockId blockList :: LabelSet
@@ -773,14 +774,14 @@ sequenceChain  info weights     blocks@((BasicBlock entry _):_) =
             -- We want debug builds to catch this as it's a good indicator for
             -- issues with CFG invariants. But we don't want to blow up production
             -- builds if something slips through.
-            ASSERT(null unplaced)
+            assert (null unplaced) $
             --pprTraceIt "placedBlocks" $
             -- ++ [] is stil kinda expensive
             if null unplaced then blockList else blockList ++ unplaced
         getBlock bid = expectJust "Block placement" $ mapLookup bid blockMap
     in
         --Assert we placed all blocks given as input
-        ASSERT(all (\bid -> mapMember bid blockMap) placedBlocks)
+        assert (all (\bid -> mapMember bid blockMap) placedBlocks) $
         dropJumps info $ map getBlock placedBlocks
 
 {-# SCC dropJumps #-}
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index 870897cceb..17631c989d 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -74,6 +74,7 @@ import Data.Bifunctor
 
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 -- DEBUGGING ONLY
 --import GHC.Cmm.DebugBlock
 --import GHC.Data.OrdList
@@ -212,7 +213,7 @@ getCfgNodes m =
 hasNode :: CFG -> BlockId -> Bool
 hasNode m node =
   -- Check the invariant that each node must exist in the first map or not at all.
-  ASSERT( found || not (any (mapMember node) m))
+  assert (found || not (any (mapMember node) m))
   found
     where
       found = mapMember node m
@@ -645,8 +646,8 @@ getCfg platform weights graph =
         (CmmCall { cml_cont = Nothing })   -> []
         other ->
             panic "Foo" $
-            ASSERT2(False, ppr "Unknown successor cause:" <>
-              (pdoc platform branch <+> text "=>" <> pdoc platform (G.successors other)))
+            assertPpr False (ppr "Unknown successor cause:" <>
+              (pdoc platform branch <+> text "=>" <> pdoc platform (G.successors other))) $
             map (\x -> ((bid,x),mkEdgeInfo 0)) $ G.successors other
       where
         bid = G.entryLabel block
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 953cb85ba9..7e2daf76f8 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -64,13 +64,13 @@ import GHC.Types.SrcLoc      ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 import GHC.Data.OrdList
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 
 import Control.Monad    ( mapAndUnzipM, when )
 import Data.Word
 
 import GHC.Types.Basic
 import GHC.Data.FastString
-import GHC.Utils.Misc
 
 -- -----------------------------------------------------------------------------
 -- Top-level of the instruction selector
@@ -468,7 +468,7 @@ getRegister' _ platform (CmmMachOp (MO_SS_Conv W64 W32) [x])
 getRegister' _ platform (CmmLoad mem pk)
  | not (isWord64 pk) = do
         Amode addr addr_code <- getAmode D mem
-        let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)
+        let code dst = assert ((targetClassOfReg platform dst == RcDouble) == isFloatType pk) $
                        addr_code `snocOL` LD format dst addr
         return (Any format code)
  | not (target32Bit platform) = do
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 97dcda5a5b..210bea0af2 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -79,7 +79,9 @@ import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 import GHC.Types.ForeignCall ( CCallConv(..) )
 import GHC.Data.OrdList
 import GHC.Utils.Outputable
+import GHC.Utils.Constants (debugIsOn)
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Data.FastString
 import GHC.Driver.Session
 import GHC.Utils.Misc
@@ -1268,7 +1270,7 @@ getAmode e = do
       -- what mangleIndexTree has just done.
       CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)]
          | is32BitLit is32Bit lit
-         -- ASSERT(rep == II32)???
+         -- assert (rep == II32)???
          -> do
             (x_reg, x_code) <- getSomeReg x
             let off = ImmInt (-(fromInteger i))
@@ -1276,7 +1278,7 @@ getAmode e = do
 
       CmmMachOp (MO_Add _rep) [x, CmmLit lit]
          | is32BitLit is32Bit lit
-         -- ASSERT(rep == II32)???
+         -- assert (rep == II32)???
          -> do
             (x_reg, x_code) <- getSomeReg x
             let off = litToImm lit
@@ -1474,7 +1476,7 @@ addAlignmentCheck align reg =
   where
     check :: Format -> Reg -> InstrBlock
     check fmt reg =
-        ASSERT(not $ isFloatFormat fmt)
+        assert (not $ isFloatFormat fmt) $
         toOL [ TEST fmt (OpImm $ ImmInt $ align-1) (OpReg reg)
              , JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel
              ]
@@ -1941,10 +1943,10 @@ genCondBranch' _ bid id false bool = do
                   -- Use ASSERT so we don't break releases if
                   -- LTT/LE creep in somehow.
                   LTT ->
-                    ASSERT2(False, ppr "Should have been turned into >")
+                    assertPpr False (ppr "Should have been turned into >")
                     and_ordered
                   LE  ->
-                    ASSERT2(False, ppr "Should have been turned into >=")
+                    assertPpr False (ppr "Should have been turned into >=")
                     and_ordered
                   _   -> and_ordered
 
@@ -2885,7 +2887,7 @@ evalArgs bid actuals
         lreg <- newLocalReg $ cmmExprType platform actual
         (instrs, bid1) <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual
         -- The above assignment shouldn't change the current block
-        MASSERT(isNothing bid1)
+        massert (isNothing bid1)
         return (instrs, CmmReg $ CmmLocal lreg)
 
     newLocalReg :: CmmType -> NatM LocalReg
@@ -2961,7 +2963,7 @@ genCCall32' target dest_regs args = do
                 -- Arguments can be smaller than 32-bit, but we still use @PUSH
                 -- II32@ - the usual calling conventions expect integers to be
                 -- 4-byte aligned.
-                ASSERT((typeWidth arg_ty) <= W32) return ()
+                massert ((typeWidth arg_ty) <= W32)
                 (operand, code) <- getOperand arg
                 delta <- getDeltaNat
                 setDeltaNat (delta-size)
@@ -2988,7 +2990,7 @@ genCCall32' target dest_regs args = do
 
         push_codes <- mapM push_arg (reverse prom_args)
         delta <- getDeltaNat
-        MASSERT(delta == delta0 - tot_arg_size)
+        massert (delta == delta0 - tot_arg_size)
 
         -- deal with static vs dynamic call targets
         (callinsns,cconv) <-
@@ -2999,8 +3001,8 @@ genCCall32' target dest_regs args = do
                where fn_imm = ImmCLbl lbl
             ForeignTarget expr conv
                -> do { (dyn_r, dyn_c) <- getSomeReg expr
-                     ; ASSERT( isWord32 (cmmExprType platform expr) )
-                       return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
+                     ; massert (isWord32 (cmmExprType platform expr))
+                     ; return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
             PrimTarget _
                 -> panic $ "genCCall: Can't handle PrimTarget call type here, error "
                             ++ "probably because too many return values."
@@ -3186,7 +3188,7 @@ genCCall64' target dest_regs args = do
              -- Arguments can be smaller than 64-bit, but we still use @PUSH
              -- II64@ - the usual calling conventions expect integers to be
              -- 8-byte aligned.
-             ASSERT(width <= W64) return ()
+             massert (width <= W64)
              (arg_op, arg_code) <- getOperand arg
              delta <- getDeltaNat
              setDeltaNat (delta-arg_size)
@@ -3620,9 +3622,9 @@ condFltReg is32Bit cond x y = condFltReg_sse2
                 GU  -> plain_test   dst
                 GEU -> plain_test   dst
                 -- Use ASSERT so we don't break releases if these creep in.
-                LTT -> ASSERT2(False, ppr "Should have been turned into >")
+                LTT -> assertPpr False (ppr "Should have been turned into >") $
                        and_ordered  dst
-                LE  -> ASSERT2(False, ppr "Should have been turned into >=")
+                LE  -> assertPpr False (ppr "Should have been turned into >=") $
                        and_ordered  dst
                 _   -> and_ordered  dst)