cmm: Eliminate orphan Outputable instances

Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and
`OutputableP` instances for the Cmm AST. This makes it significantly
easier to use the Cmm pretty-printers in tracing output without
incurring module import cycles.

31 files changed, 999 insertions, 1134 deletions

diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 4f8bdbd77a..797940c5a2 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -6,13 +6,13 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
-
+{-# LANGUAGE FlexibleContexts #-}
 
 module GHC.Cmm (
      -- * Cmm top-level datatypes
      CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
      CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
-     CmmGraph, GenCmmGraph(..),
+     CmmGraph, GenCmmGraph(..), toBlockMap, revPostorder,
      CmmBlock, RawCmmDecl,
      Section(..), SectionType(..),
      GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
@@ -30,10 +30,14 @@ module GHC.Cmm (
      -- * Statements, expressions and types
      module GHC.Cmm.Node,
      module GHC.Cmm.Expr,
+
+     -- * Pretty-printing
+     pprCmms, pprCmmGroup, pprSection, pprStatic
   ) where
 
 import GHC.Prelude
 
+import GHC.Platform
 import GHC.Types.Id
 import GHC.Types.CostCentre
 import GHC.Cmm.CLabel
@@ -46,7 +50,10 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Utils.Outputable
+
+import Data.List (intersperse)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 
 -----------------------------------------------------------------------------
 --  Cmm, GenCmm
@@ -102,6 +109,10 @@ data GenCmmDecl d h g
 
   deriving (Functor)
 
+instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
+      => OutputableP Platform (GenCmmDecl d info i) where
+    pdoc = pprTop
+
 type CmmDecl     = GenCmmDecl CmmStatics    CmmTopInfo CmmGraph
 type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 
@@ -119,6 +130,26 @@ type CmmGraph = GenCmmGraph CmmNode
 data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
 type CmmBlock = Block CmmNode C C
 
+instance OutputableP Platform CmmGraph where
+    pdoc = pprCmmGraph
+
+toBlockMap :: CmmGraph -> LabelMap CmmBlock
+toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
+
+pprCmmGraph :: Platform -> CmmGraph -> SDoc
+pprCmmGraph platform g
+   = text "{" <> text "offset"
+  $$ nest 2 (vcat $ map (pdoc platform) blocks)
+  $$ text "}"
+  where blocks = revPostorder g
+    -- revPostorder has the side-effect of discarding unreachable code,
+    -- so pretty-printed Cmm will omit any unreachable blocks.  This can
+    -- sometimes be confusing.
+
+revPostorder :: CmmGraph -> [CmmBlock]
+revPostorder g = {-# SCC "revPostorder" #-}
+    revPostorderFrom (toBlockMap g) (g_entry g)
+
 -----------------------------------------------------------------------------
 --     Info Tables
 -----------------------------------------------------------------------------
@@ -128,6 +159,14 @@ type CmmBlock = Block CmmNode C C
 data CmmTopInfo   = TopInfo { info_tbls  :: LabelMap CmmInfoTable
                             , stack_info :: CmmStackInfo }
 
+instance OutputableP Platform CmmTopInfo where
+    pdoc = pprTopInfo
+
+pprTopInfo :: Platform -> CmmTopInfo -> SDoc
+pprTopInfo platform (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
+  vcat [text "info_tbls: " <> pdoc platform info_tbl,
+        text "stack_info: " <> ppr stack_info]
+
 topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
 topInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos)
 topInfoTable _                     = Nothing
@@ -145,6 +184,13 @@ data CmmStackInfo
                -- we want to do the stack manipulation manually.
   }
 
+instance Outputable CmmStackInfo where
+    ppr = pprStackInfo
+
+pprStackInfo :: CmmStackInfo -> SDoc
+pprStackInfo (StackInfo {arg_space=arg_space}) =
+  text "arg_space: " <> ppr arg_space
+
 -- | Info table as a haskell data type
 data CmmInfoTable
   = CmmInfoTable {
@@ -169,6 +215,10 @@ data CmmInfoTable
         -- GHC.Cmm.Info.Build.doSRTs.
     } deriving Eq
 
+instance OutputableP Platform CmmInfoTable where
+    pdoc = pprInfoTable
+
+
 data ProfilingInfo
   = NoProfilingInfo
   | ProfilingInfo ByteString ByteString -- closure_type, closure_desc
@@ -233,6 +283,9 @@ data CmmStatic
   | CmmFileEmbed FilePath
         -- ^ an embedded binary file
 
+instance OutputableP Platform CmmStatic where
+    pdoc = pprStatic
+
 instance Outputable CmmStatic where
   ppr (CmmStaticLit lit) = text "CmmStaticLit" <+> ppr lit
   ppr (CmmUninitialised n) = text "CmmUninitialised" <+> ppr n
@@ -254,6 +307,9 @@ data GenCmmStatics (rawOnly :: Bool) where
       -> [CmmStatic]  -- The static data itself
       -> GenCmmStatics a
 
+instance OutputableP Platform (GenCmmStatics a) where
+    pdoc = pprStatics
+
 type CmmStatics    = GenCmmStatics 'False
 type RawCmmStatics = GenCmmStatics 'True
 
@@ -293,3 +349,122 @@ instance OutputableP env instr => OutputableP env (GenBasicBlock instr) where
 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
 pprBBlock (BasicBlock ident stmts) =
     hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
+
+
+-- --------------------------------------------------------------------------
+-- Pretty-printing Cmm
+-- --------------------------------------------------------------------------
+--
+-- This is where we walk over Cmm emitting an external representation,
+-- suitable for parsing, in a syntax strongly reminiscent of C--. This
+-- is the "External Core" for the Cmm layer.
+--
+-- As such, this should be a well-defined syntax: we want it to look nice.
+-- Thus, we try wherever possible to use syntax defined in [1],
+-- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
+-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
+-- than C--'s bits8 .. bits64.
+--
+-- We try to ensure that all information available in the abstract
+-- syntax is reproduced, or reproducible, in the concrete syntax.
+-- Data that is not in printed out can be reconstructed according to
+-- conventions used in the pretty printer. There are at least two such
+-- cases:
+--      1) if a value has wordRep type, the type is not appended in the
+--      output.
+--      2) MachOps that operate over wordRep type are printed in a
+--      C-style, rather than as their internal MachRep name.
+--
+-- These conventions produce much more readable Cmm output.
+
+pprCmms :: (OutputableP Platform info, OutputableP Platform g)
+        => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
+pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms))
+        where
+          separator = space $$ text "-------------------" $$ space
+
+pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
+            => Platform -> GenCmmGroup d info g -> SDoc
+pprCmmGroup platform tops
+    = vcat $ intersperse blankLine $ map (pprTop platform) tops
+
+-- --------------------------------------------------------------------------
+-- Top level `procedure' blocks.
+--
+
+pprTop :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
+       => Platform -> GenCmmDecl d info i -> SDoc
+
+pprTop platform (CmmProc info lbl live graph)
+
+  = vcat [ pdoc platform lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live
+         , nest 8 $ lbrace <+> pdoc platform info $$ rbrace
+         , nest 4 $ pdoc platform graph
+         , rbrace ]
+
+-- --------------------------------------------------------------------------
+-- We follow [1], 4.5
+--
+--      section "data" { ... }
+--
+
+pprTop platform (CmmData section ds) =
+    (hang (pprSection platform section <+> lbrace) 4 (pdoc platform ds))
+    $$ rbrace
+
+-- --------------------------------------------------------------------------
+-- Pretty-printing info tables
+-- --------------------------------------------------------------------------
+
+pprInfoTable :: Platform -> CmmInfoTable -> SDoc
+pprInfoTable platform (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
+                           , cit_prof = prof_info
+                           , cit_srt = srt })
+  = vcat [ text "label: " <> pdoc platform lbl
+         , text "rep: " <> ppr rep
+         , case prof_info of
+             NoProfilingInfo -> empty
+             ProfilingInfo ct cd ->
+               vcat [ text "type: " <> text (show (BS.unpack ct))
+                    , text "desc: " <> text (show (BS.unpack cd)) ]
+         , text "srt: " <> pdoc platform srt ]
+
+-- --------------------------------------------------------------------------
+-- Static data.
+--      Strings are printed as C strings, and we print them as I8[],
+--      following C--
+--
+
+pprStatics :: Platform -> GenCmmStatics a -> SDoc
+pprStatics platform (CmmStatics lbl itbl ccs payload) =
+  pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload
+pprStatics platform (CmmStaticsRaw lbl ds) = vcat ((pdoc platform lbl <> colon) : map (pprStatic platform) ds)
+
+pprStatic :: Platform -> CmmStatic -> SDoc
+pprStatic platform s = case s of
+    CmmStaticLit lit   -> nest 4 $ text "const" <+> pdoc platform lit <> semi
+    CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
+    CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')
+    CmmFileEmbed path  -> nest 4 $ text "incbin " <+> text (show path)
+
+-- --------------------------------------------------------------------------
+-- data sections
+--
+pprSection :: Platform -> Section -> SDoc
+pprSection platform (Section t suffix) =
+  section <+> doubleQuotes (pprSectionType t <+> char '.' <+> pdoc platform suffix)
+  where
+    section = text "section"
+
+pprSectionType :: SectionType -> SDoc
+pprSectionType s = doubleQuotes $ case s of
+  Text                    -> text "text"
+  Data                    -> text "data"
+  ReadOnlyData            -> text "readonly"
+  ReadOnlyData16          -> text "readonly16"
+  RelocatableReadOnlyData -> text "relreadonly"
+  UninitialisedData       -> text "uninitialised"
+  InitArray               -> text "initarray"
+  FiniArray               -> text "finiarray"
+  CString                 -> text "cstring"
+  OtherSection s'         -> text s'
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 6d0870e281..adb5150f1a 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -827,6 +827,9 @@ data InfoProvEnt = InfoProvEnt
                                -- Position and information about the info table
                                deriving (Eq, Ord)
 
+instance OutputableP Platform InfoProvEnt where
+  pdoc platform (InfoProvEnt clabel _ _ _ _) = pdoc platform clabel
+
 -- Constructing Cost Center Labels
 mkCCLabel  :: CostCentre      -> CLabel
 mkCCSLabel :: CostCentreStack -> CLabel
diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs
index ecee8d902d..a0fee0e5c6 100644
--- a/compiler/GHC/Cmm/CallConv.hs
+++ b/compiler/GHC/Cmm/CallConv.hs
@@ -12,7 +12,6 @@ import Data.List (nub)
 import GHC.Cmm.Expr
 import GHC.Runtime.Heap.Layout
 import GHC.Cmm (Convention(..))
-import GHC.Cmm.Ppr () -- For Outputable instances
 
 import GHC.Platform
 import GHC.Platform.Profile
diff --git a/compiler/GHC/Cmm/Dataflow/Graph.hs b/compiler/GHC/Cmm/Dataflow/Graph.hs
index 953ccdabaa..0beaee7357 100644
--- a/compiler/GHC/Cmm/Dataflow/Graph.hs
+++ b/compiler/GHC/Cmm/Dataflow/Graph.hs
@@ -12,6 +12,7 @@ module GHC.Cmm.Dataflow.Graph
     , NonLocal(..)
     , addBlock
     , bodyList
+    , bodyToBlockList
     , emptyBody
     , labelsDefined
     , mapGraph
@@ -56,6 +57,9 @@ emptyBody = mapEmpty
 bodyList :: Body' block n -> [(Label,block n C C)]
 bodyList body = mapToList body
 
+bodyToBlockList :: Body n -> [Block n C C]
+bodyToBlockList body = mapElems body
+
 addBlock
     :: (NonLocal block, HasDebugCallStack)
     => block C C -> LabelMap (block C C) -> LabelMap (block C C)
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 06c1f9aace..b4528ae301 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -43,7 +43,6 @@ import GHC.Data.FastString ( nilFS, mkFastString )
 import GHC.Unit.Module
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
-import GHC.Cmm.Ppr.Expr ( pprExpr )
 import GHC.Types.SrcLoc
 import GHC.Types.Tickish
 import GHC.Utils.Misc      ( seqList )
@@ -559,6 +558,6 @@ toUnwindExpr platform e@(CmmMachOp op [e1, e2])   =
     (MO_Sub{}, u1,        u2       ) -> UwMinus u1 u2
     (MO_Mul{}, u1,        u2       ) -> UwTimes u1 u2
     _otherwise -> pprPanic "Unsupported operator in unwind expression!"
-                           (pprExpr platform e)
+                           (pdoc platform e)
 toUnwindExpr platform e
   = pprPanic "Unsupported unwind expression!" (pdoc platform e)
diff --git a/compiler/GHC/Cmm/Expr.hs b/compiler/GHC/Cmm/Expr.hs
index f910e65f04..ccc94a8b92 100644
--- a/compiler/GHC/Cmm/Expr.hs
+++ b/compiler/GHC/Cmm/Expr.hs
@@ -10,6 +10,7 @@ module GHC.Cmm.Expr
     , CmmReg(..), cmmRegType, cmmRegWidth
     , CmmLit(..), cmmLitType
     , AlignmentSpec(..)
+      -- TODO: Remove:
     , LocalReg(..), localRegType
     , GlobalReg(..), isArgReg, globalRegType
     , spReg, hpReg, spLimReg, hpLimReg, nodeReg
@@ -26,6 +27,11 @@ module GHC.Cmm.Expr
     , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
     , regSetToList
 
+    , isTrivialCmmExpr
+    , hasNoGlobalRegs
+    , isLit
+    , isComparisonExpr
+
     , Area(..)
     , module GHC.Cmm.MachOp
     , module GHC.Cmm.Type
@@ -39,12 +45,16 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm.MachOp
 import GHC.Cmm.Type
+import GHC.Cmm.Reg
+import GHC.Utils.Trace (pprTrace)
 import GHC.Utils.Panic (panic)
 import GHC.Utils.Outputable
 import GHC.Types.Unique
 
+import Data.Maybe
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Numeric ( fromRat )
 
 import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf)
 
@@ -78,14 +88,12 @@ instance Eq CmmExpr where       -- Equality ignores the types
   CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2
   _e1                == _e2                = False
 
+instance OutputableP Platform CmmExpr where
+    pdoc = pprExpr
+
 data AlignmentSpec = NaturallyAligned | Unaligned
   deriving (Eq, Ord, Show)
 
-data CmmReg
-  = CmmLocal  {-# UNPACK #-} !LocalReg
-  | CmmGlobal GlobalReg
-  deriving( Eq, Ord, Show )
-
 -- | A stack area is either the stack slot where a variable is spilled
 -- or the stack space where function arguments and results are passed.
 data Area
@@ -94,6 +102,14 @@ data Area
                    -- See Note [Continuation BlockIds] in GHC.Cmm.Node.
   deriving (Eq, Ord, Show)
 
+instance Outputable Area where
+    ppr e = pprArea e
+
+pprArea :: Area -> SDoc
+pprArea Old        = text "old"
+pprArea (Young id) = hcat [ text "young<", ppr id, text ">" ]
+
+
 {- Note [Old Area]
 ~~~~~~~~~~~~~~~~~~
 There is a single call area 'Old', allocated at the extreme old
@@ -217,6 +233,9 @@ data CmmLit
                      -- of bytes used
   deriving (Eq, Show)
 
+instance OutputableP Platform CmmLit where
+    pdoc = pprLit
+
 instance Outputable CmmLit where
   ppr (CmmInt n w) = text "CmmInt" <+> ppr n <+> ppr w
   ppr (CmmFloat n w) = text "CmmFloat" <+> text (show n) <+> ppr w
@@ -276,38 +295,34 @@ maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
                                             return (CmmMachOp op' args)
 maybeInvertCmmExpr _ = Nothing
 
------------------------------------------------------------------------------
---              Local registers
------------------------------------------------------------------------------
-
-data LocalReg
-  = LocalReg {-# UNPACK #-} !Unique !CmmType
-    -- ^ Parameters:
-    --   1. Identifier
-    --   2. Type
-  deriving Show
-
-instance Eq LocalReg where
-  (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
+---------------------------------------------------
+--         CmmExpr predicates
+---------------------------------------------------
 
--- This is non-deterministic but we do not currently support deterministic
--- code-generation. See Note [Unique Determinism and code generation]
--- See Note [No Ord for Unique]
-instance Ord LocalReg where
-  compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2
+isTrivialCmmExpr :: CmmExpr -> Bool
+isTrivialCmmExpr (CmmLoad _ _ _)    = False
+isTrivialCmmExpr (CmmMachOp _ _)    = False
+isTrivialCmmExpr (CmmLit _)         = True
+isTrivialCmmExpr (CmmReg _)         = True
+isTrivialCmmExpr (CmmRegOff _ _)    = True
+isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
 
-instance Uniquable LocalReg where
-  getUnique (LocalReg uniq _) = uniq
+hasNoGlobalRegs :: CmmExpr -> Bool
+hasNoGlobalRegs (CmmLoad e _ _)            = hasNoGlobalRegs e
+hasNoGlobalRegs (CmmMachOp _ es)           = all hasNoGlobalRegs es
+hasNoGlobalRegs (CmmLit _)                 = True
+hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
+hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
+hasNoGlobalRegs _                          = False
 
-cmmRegType :: Platform -> CmmReg -> CmmType
-cmmRegType _        (CmmLocal  reg) = localRegType reg
-cmmRegType platform (CmmGlobal reg) = globalRegType platform reg
+isLit :: CmmExpr -> Bool
+isLit (CmmLit _) = True
+isLit _          = False
 
-cmmRegWidth :: Platform -> CmmReg -> Width
-cmmRegWidth platform = typeWidth . cmmRegType platform
+isComparisonExpr :: CmmExpr -> Bool
+isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
+isComparisonExpr _                = False
 
-localRegType :: LocalReg -> CmmType
-localRegType (LocalReg _ rep) = rep
 
 -----------------------------------------------------------------------------
 --    Register-use information for expressions and other types
@@ -404,241 +419,159 @@ instance DefinerOfRegs r a => DefinerOfRegs r [a] where
   foldRegsDefd platform f set as = foldl' (foldRegsDefd platform f) set as
   {-# INLINABLE foldRegsDefd #-}
 
------------------------------------------------------------------------------
---              Global STG registers
------------------------------------------------------------------------------
-
-data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
-
------------------------------------------------------------------------------
---              Global STG registers
------------------------------------------------------------------------------
-{-
-Note [Overlapping global registers]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The backend might not faithfully implement the abstraction of the STG
-machine with independent registers for different values of type
-GlobalReg. Specifically, certain pairs of registers (r1, r2) may
-overlap in the sense that a store to r1 invalidates the value in r2,
-and vice versa.
-
-Currently this occurs only on the x86_64 architecture where FloatReg n
-and DoubleReg n are assigned the same microarchitectural register, in
-order to allow functions to receive more Float# or Double# arguments
-in registers (as opposed to on the stack).
-
-There are no specific rules about which registers might overlap with
-which other registers, but presumably it's safe to assume that nothing
-will overlap with special registers like Sp or BaseReg.
-
-Use GHC.Cmm.Utils.regsOverlap to determine whether two GlobalRegs overlap
-on a particular platform. The instance Eq GlobalReg is syntactic
-equality of STG registers and does not take overlap into
-account. However it is still used in UserOfRegs/DefinerOfRegs and
-there are likely still bugs there, beware!
--}
-
-data GlobalReg
-  -- Argument and return registers
-  = VanillaReg                  -- pointers, unboxed ints and chars
-        {-# UNPACK #-} !Int     -- its number
-        VGcPtr
-
-  | FloatReg            -- single-precision floating-point registers
-        {-# UNPACK #-} !Int     -- its number
-
-  | DoubleReg           -- double-precision floating-point registers
-        {-# UNPACK #-} !Int     -- its number
-
-  | LongReg             -- long int registers (64-bit, really)
-        {-# UNPACK #-} !Int     -- its number
-
-  | XmmReg                      -- 128-bit SIMD vector register
-        {-# UNPACK #-} !Int     -- its number
-
-  | YmmReg                      -- 256-bit SIMD vector register
-        {-# UNPACK #-} !Int     -- its number
-
-  | ZmmReg                      -- 512-bit SIMD vector register
-        {-# UNPACK #-} !Int     -- its number
-
-  -- STG registers
-  | Sp                  -- Stack ptr; points to last occupied stack location.
-  | SpLim               -- Stack limit
-  | Hp                  -- Heap ptr; points to last occupied heap location.
-  | HpLim               -- Heap limit register
-  | CCCS                -- Current cost-centre stack
-  | CurrentTSO          -- pointer to current thread's TSO
-  | CurrentNursery      -- pointer to allocation area
-  | HpAlloc             -- allocation count for heap check failure
-
-                -- We keep the address of some commonly-called
-                -- functions in the register table, to keep code
-                -- size down:
-  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info
-  | GCEnter1            -- stg_gc_enter_1
-  | GCFun               -- stg_gc_fun
-
-  -- Base offset for the register table, used for accessing registers
-  -- which do not have real registers assigned to them.  This register
-  -- will only appear after we have expanded GlobalReg into memory accesses
-  -- (where necessary) in the native code generator.
-  | BaseReg
-
-  -- The register used by the platform for the C stack pointer. This is
-  -- a break in the STG abstraction used exclusively to setup stack unwinding
-  -- information.
-  | MachSp
-
-  -- The is a dummy register used to indicate to the stack unwinder where
-  -- a routine would return to.
-  | UnwindReturnReg
-
-  -- Base Register for PIC (position-independent code) calculations
-  -- Only used inside the native code generator. It's exact meaning differs
-  -- from platform to platform (see module PositionIndependentCode).
-  | PicBaseReg
-
-  deriving( Show )
-
-instance Eq GlobalReg where
-   VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
-   FloatReg i == FloatReg j = i==j
-   DoubleReg i == DoubleReg j = i==j
-   LongReg i == LongReg j = i==j
-   -- NOTE: XMM, YMM, ZMM registers actually are the same registers
-   -- at least with respect to store at YMM i and then read from XMM i
-   -- and similarly for ZMM etc.
-   XmmReg i == XmmReg j = i==j
-   YmmReg i == YmmReg j = i==j
-   ZmmReg i == ZmmReg j = i==j
-   Sp == Sp = True
-   SpLim == SpLim = True
-   Hp == Hp = True
-   HpLim == HpLim = True
-   CCCS == CCCS = True
-   CurrentTSO == CurrentTSO = True
-   CurrentNursery == CurrentNursery = True
-   HpAlloc == HpAlloc = True
-   EagerBlackholeInfo == EagerBlackholeInfo = True
-   GCEnter1 == GCEnter1 = True
-   GCFun == GCFun = True
-   BaseReg == BaseReg = True
-   MachSp == MachSp = True
-   UnwindReturnReg == UnwindReturnReg = True
-   PicBaseReg == PicBaseReg = True
-   _r1 == _r2 = False
-
--- NOTE: this Ord instance affects the tuple layout in GHCi, see
---       Note [GHCi tuple layout]
-instance Ord GlobalReg where
-   compare (VanillaReg i _) (VanillaReg j _) = compare i j
-     -- Ignore type when seeking clashes
-   compare (FloatReg i)  (FloatReg  j) = compare i j
-   compare (DoubleReg i) (DoubleReg j) = compare i j
-   compare (LongReg i)   (LongReg   j) = compare i j
-   compare (XmmReg i)    (XmmReg    j) = compare i j
-   compare (YmmReg i)    (YmmReg    j) = compare i j
-   compare (ZmmReg i)    (ZmmReg    j) = compare i j
-   compare Sp Sp = EQ
-   compare SpLim SpLim = EQ
-   compare Hp Hp = EQ
-   compare HpLim HpLim = EQ
-   compare CCCS CCCS = EQ
-   compare CurrentTSO CurrentTSO = EQ
-   compare CurrentNursery CurrentNursery = EQ
-   compare HpAlloc HpAlloc = EQ
-   compare EagerBlackholeInfo EagerBlackholeInfo = EQ
-   compare GCEnter1 GCEnter1 = EQ
-   compare GCFun GCFun = EQ
-   compare BaseReg BaseReg = EQ
-   compare MachSp MachSp = EQ
-   compare UnwindReturnReg UnwindReturnReg = EQ
-   compare PicBaseReg PicBaseReg = EQ
-   compare (VanillaReg _ _) _ = LT
-   compare _ (VanillaReg _ _) = GT
-   compare (FloatReg _) _     = LT
-   compare _ (FloatReg _)     = GT
-   compare (DoubleReg _) _    = LT
-   compare _ (DoubleReg _)    = GT
-   compare (LongReg _) _      = LT
-   compare _ (LongReg _)      = GT
-   compare (XmmReg _) _       = LT
-   compare _ (XmmReg _)       = GT
-   compare (YmmReg _) _       = LT
-   compare _ (YmmReg _)       = GT
-   compare (ZmmReg _) _       = LT
-   compare _ (ZmmReg _)       = GT
-   compare Sp _ = LT
-   compare _ Sp = GT
-   compare SpLim _ = LT
-   compare _ SpLim = GT
-   compare Hp _ = LT
-   compare _ Hp = GT
-   compare HpLim _ = LT
-   compare _ HpLim = GT
-   compare CCCS _ = LT
-   compare _ CCCS = GT
-   compare CurrentTSO _ = LT
-   compare _ CurrentTSO = GT
-   compare CurrentNursery _ = LT
-   compare _ CurrentNursery = GT
-   compare HpAlloc _ = LT
-   compare _ HpAlloc = GT
-   compare GCEnter1 _ = LT
-   compare _ GCEnter1 = GT
-   compare GCFun _ = LT
-   compare _ GCFun = GT
-   compare BaseReg _ = LT
-   compare _ BaseReg = GT
-   compare MachSp _ = LT
-   compare _ MachSp = GT
-   compare UnwindReturnReg _ = LT
-   compare _ UnwindReturnReg = GT
-   compare EagerBlackholeInfo _ = LT
-   compare _ EagerBlackholeInfo = GT
-
--- convenient aliases
-baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
-  currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg  :: CmmReg
-baseReg = CmmGlobal BaseReg
-spReg = CmmGlobal Sp
-hpReg = CmmGlobal Hp
-hpLimReg = CmmGlobal HpLim
-spLimReg = CmmGlobal SpLim
-nodeReg = CmmGlobal node
-currentTSOReg = CmmGlobal CurrentTSO
-currentNurseryReg = CmmGlobal CurrentNursery
-hpAllocReg = CmmGlobal HpAlloc
-cccsReg = CmmGlobal CCCS
-
-node :: GlobalReg
-node = VanillaReg 1 VGcPtr
-
-globalRegType :: Platform -> GlobalReg -> CmmType
-globalRegType platform = \case
-   (VanillaReg _ VGcPtr)    -> gcWord platform
-   (VanillaReg _ VNonGcPtr) -> bWord platform
-   (FloatReg _)             -> cmmFloat W32
-   (DoubleReg _)            -> cmmFloat W64
-   (LongReg _)              -> cmmBits W64
-   -- TODO: improve the internal model of SIMD/vectorized registers
-   -- the right design SHOULd improve handling of float and double code too.
-   -- see remarks in "NOTE [SIMD Design for the future]"" in GHC.StgToCmm.Prim
-   (XmmReg _) -> cmmVec 4 (cmmBits W32)
-   (YmmReg _) -> cmmVec 8 (cmmBits W32)
-   (ZmmReg _) -> cmmVec 16 (cmmBits W32)
-
-   Hp         -> gcWord platform -- The initialiser for all
-                                 -- dynamically allocated closures
-   _          -> bWord platform
-
-isArgReg :: GlobalReg -> Bool
-isArgReg (VanillaReg {}) = True
-isArgReg (FloatReg {})   = True
-isArgReg (DoubleReg {})  = True
-isArgReg (LongReg {})    = True
-isArgReg (XmmReg {})     = True
-isArgReg (YmmReg {})     = True
-isArgReg (ZmmReg {})     = True
-isArgReg _               = False
+-- --------------------------------------------------------------------------
+-- Pretty-printing expressions
+-- --------------------------------------------------------------------------
+
+pprExpr :: Platform -> CmmExpr -> SDoc
+pprExpr platform e
+    = case e of
+        CmmRegOff reg i ->
+                pprExpr platform (CmmMachOp (MO_Add rep)
+                           [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
+                where rep = typeWidth (cmmRegType platform reg)
+        CmmLit lit -> pprLit platform lit
+        _other     -> pprExpr1 platform e
+
+-- Here's the precedence table from GHC.Cmm.Parser:
+-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
+-- %left '|'
+-- %left '^'
+-- %left '&'
+-- %left '>>' '<<'
+-- %left '-' '+'
+-- %left '/' '*' '%'
+-- %right '~'
+
+-- We just cope with the common operators for now, the rest will get
+-- a default conservative behaviour.
+
+-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
+pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
+pprExpr1 platform (CmmMachOp op [x,y])
+   | Just doc <- infixMachOp1 op
+   = pprExpr7 platform x <+> doc <+> pprExpr7 platform y
+pprExpr1 platform e = pprExpr7 platform e
+
+infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
+
+infixMachOp1 (MO_Eq     _) = Just (text "==")
+infixMachOp1 (MO_Ne     _) = Just (text "!=")
+infixMachOp1 (MO_Shl    _) = Just (text "<<")
+infixMachOp1 (MO_U_Shr  _) = Just (text ">>")
+infixMachOp1 (MO_U_Ge   _) = Just (text ">=")
+infixMachOp1 (MO_U_Le   _) = Just (text "<=")
+infixMachOp1 (MO_U_Gt   _) = Just (char '>')
+infixMachOp1 (MO_U_Lt   _) = Just (char '<')
+infixMachOp1 _             = Nothing
+
+-- %left '-' '+'
+pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
+   = pprExpr7 platform (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
+pprExpr7 platform (CmmMachOp op [x,y])
+   | Just doc <- infixMachOp7 op
+   = pprExpr7 platform x <+> doc <+> pprExpr8 platform y
+pprExpr7 platform e = pprExpr8 platform e
+
+infixMachOp7 (MO_Add _)  = Just (char '+')
+infixMachOp7 (MO_Sub _)  = Just (char '-')
+infixMachOp7 _           = Nothing
+
+-- %left '/' '*' '%'
+pprExpr8 platform (CmmMachOp op [x,y])
+   | Just doc <- infixMachOp8 op
+   = pprExpr8 platform x <+> doc <+> pprExpr9 platform y
+pprExpr8 platform e = pprExpr9 platform e
+
+infixMachOp8 (MO_U_Quot _) = Just (char '/')
+infixMachOp8 (MO_Mul _)    = Just (char '*')
+infixMachOp8 (MO_U_Rem _)  = Just (char '%')
+infixMachOp8 _             = Nothing
+
+pprExpr9 :: Platform -> CmmExpr -> SDoc
+pprExpr9 platform e =
+   case e of
+        CmmLit    lit       -> pprLit1 platform lit
+        CmmLoad   expr rep align
+                            -> let align_mark =
+                                       case align of
+                                         NaturallyAligned -> empty
+                                         Unaligned        -> text "^"
+                                in ppr rep <> align_mark <> brackets (pdoc platform expr)
+        CmmReg    reg       -> ppr reg
+        CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
+        CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
+        CmmMachOp mop args  -> genMachOp platform mop args
+
+genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
+genMachOp platform mop args
+   | Just doc <- infixMachOp mop = case args of
+        -- dyadic
+        [x,y] -> pprExpr9 platform x <+> doc <+> pprExpr9 platform y
+
+        -- unary
+        [x]   -> doc <> pprExpr9 platform x
+
+        _     -> pprTrace "GHC.Cmm.Expr.genMachOp: machop with strange number of args"
+                          (pprMachOp mop <+>
+                            parens (hcat $ punctuate comma (map (pprExpr platform) args)))
+                          empty
+
+   | isJust (infixMachOp1 mop)
+   || isJust (infixMachOp7 mop)
+   || isJust (infixMachOp8 mop)  = parens (pprExpr platform (CmmMachOp mop args))
+
+   | otherwise = char '%' <> ppr_op <> parens (commafy (map (pprExpr platform) args))
+        where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
+                                 (show mop))
+                -- replace spaces in (show mop) with underscores,
+
+--
+-- Unsigned ops on the word size of the machine get nice symbols.
+-- All else get dumped in their ugly format.
+--
+infixMachOp :: MachOp -> Maybe SDoc
+infixMachOp mop
+        = case mop of
+            MO_And    _ -> Just $ char '&'
+            MO_Or     _ -> Just $ char '|'
+            MO_Xor    _ -> Just $ char '^'
+            MO_Not    _ -> Just $ char '~'
+            MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
+            _ -> Nothing
+
+-- --------------------------------------------------------------------------
+-- Pretty-printing literals
+--
+--  To minimise line noise we adopt the convention that if the literal
+--  has the natural machine word size, we do not append the type
+-- --------------------------------------------------------------------------
+
+pprLit :: Platform -> CmmLit -> SDoc
+pprLit platform lit = case lit of
+    CmmInt i rep ->
+        hcat [ (if i < 0 then parens else id)(integer i)
+             , ppUnless (rep == wordWidth platform) $
+               space <> dcolon <+> ppr rep ]
+
+    CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]
+    CmmVec lits        -> char '<' <> commafy (map (pprLit platform) lits) <> char '>'
+    CmmLabel clbl      -> pdoc platform clbl
+    CmmLabelOff clbl i -> pdoc platform clbl <> ppr_offset i
+    CmmLabelDiffOff clbl1 clbl2 i _ -> pdoc platform clbl1 <> char '-'
+                                       <> pdoc platform clbl2 <> ppr_offset i
+    CmmBlock id        -> ppr id
+    CmmHighStackMark -> text "<highSp>"
+
+pprLit1 :: Platform -> CmmLit -> SDoc
+pprLit1 platform lit@(CmmLabelOff {}) = parens (pprLit platform lit)
+pprLit1 platform lit                  = pprLit platform lit
+
+ppr_offset :: Int -> SDoc
+ppr_offset i
+    | i==0      = empty
+    | i>=0      = char '+' <> int i
+    | otherwise = char '-' <> int (-i)
+
+commafy :: [SDoc] -> SDoc
+commafy xs = fsep $ punctuate comma xs
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs
index e76be551f9..f1d60c133b 100644
--- a/compiler/GHC/Cmm/Lint.hs
+++ b/compiler/GHC/Cmm/Lint.hs
@@ -24,7 +24,6 @@ import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Liveness
 import GHC.Cmm.Switch (switchTargetsToList)
-import GHC.Cmm.Ppr () -- For Outputable instances
 import GHC.Utils.Outputable
 
 import Control.Monad (ap, unless)
diff --git a/compiler/GHC/Cmm/Liveness.hs b/compiler/GHC/Cmm/Liveness.hs
index a1526be099..769c701c2b 100644
--- a/compiler/GHC/Cmm/Liveness.hs
+++ b/compiler/GHC/Cmm/Liveness.hs
@@ -20,7 +20,6 @@ import GHC.Prelude
 import GHC.Platform
 import GHC.Cmm.BlockId
 import GHC.Cmm
-import GHC.Cmm.Ppr.Expr () -- For Outputable instances
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index 841c726b14..117ed9747a 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
@@ -28,6 +29,7 @@ module GHC.Cmm.Node (
 import GHC.Prelude hiding (succ)
 
 import GHC.Platform.Regs
+import GHC.Cmm.CLabel
 import GHC.Cmm.Expr
 import GHC.Cmm.Switch
 import GHC.Data.FastString
@@ -36,7 +38,9 @@ import GHC.Utils.Outputable
 import GHC.Runtime.Heap.Layout
 import GHC.Types.Tickish (CmmTickish)
 import qualified GHC.Types.Unique as U
+import GHC.Types.Basic (FunctionOrData(..))
 
+import GHC.Platform
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Collections
@@ -44,6 +48,7 @@ import GHC.Cmm.Dataflow.Label
 import Data.Maybe
 import Data.List (tails,sortBy)
 import GHC.Types.Unique (nonDetCmpUnique)
+import GHC.Utils.Constants (debugIsOn)
 import GHC.Utils.Misc
 
 
@@ -165,6 +170,177 @@ data CmmNode e x where
       intrbl:: Bool             -- whether or not the call is interruptible
   } -> CmmNode O C
 
+instance OutputableP Platform (CmmNode e x) where
+    pdoc = pprNode
+
+pprNode :: Platform -> CmmNode e x -> SDoc
+pprNode platform node = pp_node <+> pp_debug
+  where
+    pp_node :: SDoc
+    pp_node = case node of
+      -- label:
+      CmmEntry id tscope ->
+         (sdocOption sdocSuppressUniques $ \case
+            True  -> text "_lbl_"
+            False -> ppr id
+         )
+         <> colon
+         <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope)
+
+      -- // text
+      CmmComment s -> text "//" <+> ftext s
+
+      -- //tick bla<...>
+      CmmTick t -> ppUnlessOption sdocSuppressTicks
+                     (text "//tick" <+> ppr t)
+
+      -- unwind reg = expr;
+      CmmUnwind regs ->
+          text "unwind "
+          <> commafy (map (\(r,e) -> ppr r <+> char '=' <+> pdoc platform e) regs) <> semi
+
+      -- reg = expr;
+      CmmAssign reg expr -> ppr reg <+> equals <+> pdoc platform expr <> semi
+
+      -- rep[lv] = expr;
+      CmmStore lv expr align -> rep <> align_mark <> brackets (pdoc platform lv) <+> equals <+> pdoc platform expr <> semi
+          where
+            align_mark = case align of
+                           Unaligned -> text "^"
+                           NaturallyAligned -> empty
+            rep = ppr ( cmmExprType platform expr )
+
+      -- call "ccall" foo(x, y)[r1, r2];
+      -- ToDo ppr volatile
+      CmmUnsafeForeignCall target results args ->
+          hsep [ ppUnless (null results) $
+                    parens (commafy $ map ppr results) <+> equals,
+                 text "call",
+                 pdoc platform target <> parens (commafy $ map (pdoc platform) args) <> semi]
+
+      -- goto label;
+      CmmBranch ident -> text "goto" <+> ppr ident <> semi
+
+      -- if (expr) goto t; else goto f;
+      CmmCondBranch expr t f l ->
+          hsep [ text "if"
+               , parens (pdoc platform expr)
+               , case l of
+                   Nothing -> empty
+                   Just b -> parens (text "likely:" <+> ppr b)
+               , text "goto"
+               , ppr t <> semi
+               , text "else goto"
+               , ppr f <> semi
+               ]
+
+      CmmSwitch expr ids ->
+          hang (hsep [ text "switch"
+                     , range
+                     , if isTrivialCmmExpr expr
+                       then pdoc platform expr
+                       else parens (pdoc platform expr)
+                     , text "{"
+                     ])
+             4 (vcat (map ppCase cases) $$ def) $$ rbrace
+          where
+            (cases, mbdef) = switchTargetsFallThrough ids
+            ppCase (is,l) = hsep
+                            [ text "case"
+                            , commafy $ map integer is
+                            , text ": goto"
+                            , ppr l <> semi
+                            ]
+            def | Just l <- mbdef = hsep
+                            [ text "default:"
+                            , braces (text "goto" <+> ppr l <> semi)
+                            ]
+                | otherwise = empty
+
+            range = brackets $ hsep [integer lo, text "..", integer hi]
+              where (lo,hi) = switchTargetsRange ids
+
+      CmmCall tgt k regs out res updfr_off ->
+          hcat [ text "call", space
+               , pprFun tgt, parens (interpp'SP regs), space
+               , returns <+>
+                 text "args: " <> ppr out <> comma <+>
+                 text "res: " <> ppr res <> comma <+>
+                 text "upd: " <> ppr updfr_off
+               , semi ]
+          where pprFun f@(CmmLit _) = pdoc platform f
+                pprFun f = parens (pdoc platform f)
+
+                returns
+                  | Just r <- k = text "returns to" <+> ppr r <> comma
+                  | otherwise   = empty
+
+      CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
+          hcat $ if i then [text "interruptible", space] else [] ++
+               [ text "foreign call", space
+               , pdoc platform t, text "(...)", space
+               , text "returns to" <+> ppr s
+                    <+> text "args:" <+> parens (pdoc platform as)
+                    <+> text "ress:" <+> parens (ppr rs)
+               , text "ret_args:" <+> ppr a
+               , text "ret_off:" <+> ppr u
+               , semi ]
+
+    pp_debug :: SDoc
+    pp_debug =
+      if not debugIsOn then empty
+      else case node of
+             CmmEntry {}             -> empty -- Looks terrible with text "  // CmmEntry"
+             CmmComment {}           -> empty -- Looks also terrible with text "  // CmmComment"
+             CmmTick {}              -> empty
+             CmmUnwind {}            -> text "  // CmmUnwind"
+             CmmAssign {}            -> text "  // CmmAssign"
+             CmmStore {}             -> text "  // CmmStore"
+             CmmUnsafeForeignCall {} -> text "  // CmmUnsafeForeignCall"
+             CmmBranch {}            -> text "  // CmmBranch"
+             CmmCondBranch {}        -> text "  // CmmCondBranch"
+             CmmSwitch {}            -> text "  // CmmSwitch"
+             CmmCall {}              -> text "  // CmmCall"
+             CmmForeignCall {}       -> text "  // CmmForeignCall"
+
+    commafy :: [SDoc] -> SDoc
+    commafy xs = hsep $ punctuate comma xs
+
+instance OutputableP Platform (Block CmmNode C C) where
+    pdoc = pprBlock
+instance OutputableP Platform (Block CmmNode C O) where
+    pdoc = pprBlock
+instance OutputableP Platform (Block CmmNode O C) where
+    pdoc = pprBlock
+instance OutputableP Platform (Block CmmNode O O) where
+    pdoc = pprBlock
+
+instance OutputableP Platform (Graph CmmNode e x) where
+    pdoc = pprGraph
+
+pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
+         => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
+pprBlock platform block
+    = foldBlockNodesB3 ( ($$) . pdoc platform
+                       , ($$) . (nest 4) . pdoc platform
+                       , ($$) . (nest 4) . pdoc platform
+                       )
+                       block
+                       empty
+
+pprGraph :: Platform -> Graph CmmNode e x -> SDoc
+pprGraph platform = \case
+   GNil                  -> empty
+   GUnit block           -> pdoc platform block
+   GMany entry body exit ->
+         text "{"
+      $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pdoc platform) $ bodyToBlockList body) $$ pprMaybeO exit)
+      $$ text "}"
+      where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
+                      => MaybeO ex (Block CmmNode e x) -> SDoc
+            pprMaybeO NothingO = empty
+            pprMaybeO (JustO block) = pdoc platform block
+
 {- Note [Foreign calls]
 ~~~~~~~~~~~~~~~~~~~~~~~
 A CmmUnsafeForeignCall is used for *unsafe* foreign calls;
@@ -291,11 +467,25 @@ data ForeignConvention
         CmmReturnInfo
   deriving Eq
 
+instance Outputable ForeignConvention where
+    ppr = pprForeignConvention
+
+pprForeignConvention :: ForeignConvention -> SDoc
+pprForeignConvention (ForeignConvention c args res ret) =
+    doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res <+> ppr ret
+
 data CmmReturnInfo
   = CmmMayReturn
   | CmmNeverReturns
   deriving ( Eq )
 
+instance Outputable CmmReturnInfo where
+    ppr = pprReturnInfo
+
+pprReturnInfo :: CmmReturnInfo -> SDoc
+pprReturnInfo CmmMayReturn = empty
+pprReturnInfo CmmNeverReturns = text "never returns"
+
 data ForeignTarget        -- The target of a foreign call
   = ForeignTarget                -- A foreign procedure
         CmmExpr                  -- Its address
@@ -304,6 +494,35 @@ data ForeignTarget        -- The target of a foreign call
         CallishMachOp            -- Which one
   deriving Eq
 
+instance OutputableP Platform ForeignTarget where
+    pdoc = pprForeignTarget
+
+pprForeignTarget :: Platform -> ForeignTarget -> SDoc
+pprForeignTarget platform (ForeignTarget fn c) =
+    ppr c <+> ppr_target fn
+  where
+    ppr_target :: CmmExpr -> SDoc
+    ppr_target t@(CmmLit _) = pdoc platform t
+    ppr_target fn'          = parens (pdoc platform fn')
+pprForeignTarget platform (PrimTarget op)
+ -- HACK: We're just using a ForeignLabel to get this printed, the label
+ --       might not really be foreign.
+ = pdoc platform
+               (CmmLabel (mkForeignLabel
+                          (mkFastString (show op))
+                          Nothing ForeignLabelInThisPackage IsFunction))
+
+instance Outputable Convention where
+  ppr = pprConvention
+
+pprConvention :: Convention -> SDoc
+pprConvention (NativeNodeCall   {}) = text "<native-node-call-convention>"
+pprConvention (NativeDirectCall {}) = text "<native-direct-call-convention>"
+pprConvention (NativeReturn {})     = text "<native-ret-convention>"
+pprConvention  Slow                 = text "<slow-convention>"
+pprConvention  GC                   = text "<gc-convention>"
+
+
 foreignTargetHints :: ForeignTarget -> ([ForeignHint], [ForeignHint])
 foreignTargetHints target
   = ( res_hints ++ repeat NoHint
diff --git a/compiler/GHC/Cmm/Ppr.hs b/compiler/GHC/Cmm/Ppr.hs
deleted file mode 100644
index c7a1579962..0000000000
--- a/compiler/GHC/Cmm/Ppr.hs
+++ /dev/null
@@ -1,319 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-----------------------------------------------------------------------------
---
--- Pretty-printing of Cmm as (a superset of) C--
---
--- (c) The University of Glasgow 2004-2006
---
------------------------------------------------------------------------------
---
--- This is where we walk over CmmNode emitting an external representation,
--- suitable for parsing, in a syntax strongly reminiscent of C--. This
--- is the "External Core" for the Cmm layer.
---
--- As such, this should be a well-defined syntax: we want it to look nice.
--- Thus, we try wherever possible to use syntax defined in [1],
--- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
--- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
--- than C--'s bits8 .. bits64.
---
--- We try to ensure that all information available in the abstract
--- syntax is reproduced, or reproducible, in the concrete syntax.
--- Data that is not in printed out can be reconstructed according to
--- conventions used in the pretty printer. There are at least two such
--- cases:
---      1) if a value has wordRep type, the type is not appended in the
---      output.
---      2) MachOps that operate over wordRep type are printed in a
---      C-style, rather than as their internal MachRep name.
---
--- These conventions produce much more readable Cmm output.
---
--- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
-
-module GHC.Cmm.Ppr
-  ( module GHC.Cmm.Ppr.Decl
-  , module GHC.Cmm.Ppr.Expr
-  )
-where
-
-import GHC.Prelude hiding (succ)
-
-import GHC.Platform
-import GHC.Cmm.CLabel
-import GHC.Cmm
-import GHC.Cmm.Utils
-import GHC.Cmm.Switch
-import GHC.Data.FastString
-import GHC.Utils.Outputable
-import GHC.Cmm.Ppr.Decl
-import GHC.Cmm.Ppr.Expr
-import GHC.Utils.Constants (debugIsOn)
-
-import GHC.Types.Basic
-import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Graph
-
--------------------------------------------------
--- Outputable instances
-instance OutputableP Platform InfoProvEnt where
-  pdoc platform (InfoProvEnt clabel _ _ _ _) = pdoc platform clabel
-
-instance Outputable CmmStackInfo where
-    ppr = pprStackInfo
-
-instance OutputableP Platform CmmTopInfo where
-    pdoc = pprTopInfo
-
-
-instance OutputableP Platform (CmmNode e x) where
-    pdoc = pprNode
-
-instance Outputable Convention where
-    ppr = pprConvention
-
-instance Outputable ForeignConvention where
-    ppr = pprForeignConvention
-
-instance OutputableP Platform ForeignTarget where
-    pdoc = pprForeignTarget
-
-instance Outputable CmmReturnInfo where
-    ppr = pprReturnInfo
-
-instance OutputableP Platform (Block CmmNode C C) where
-    pdoc = pprBlock
-instance OutputableP Platform (Block CmmNode C O) where
-    pdoc = pprBlock
-instance OutputableP Platform (Block CmmNode O C) where
-    pdoc = pprBlock
-instance OutputableP Platform (Block CmmNode O O) where
-    pdoc = pprBlock
-
-instance OutputableP Platform (Graph CmmNode e x) where
-    pdoc = pprGraph
-
-instance OutputableP Platform CmmGraph where
-    pdoc = pprCmmGraph
-
-----------------------------------------------------------
--- Outputting types Cmm contains
-
-pprStackInfo :: CmmStackInfo -> SDoc
-pprStackInfo (StackInfo {arg_space=arg_space}) =
-  text "arg_space: " <> ppr arg_space
-
-pprTopInfo :: Platform -> CmmTopInfo -> SDoc
-pprTopInfo platform (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
-  vcat [text "info_tbls: " <> pdoc platform info_tbl,
-        text "stack_info: " <> ppr stack_info]
-
-----------------------------------------------------------
--- Outputting blocks and graphs
-
-pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
-         => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
-pprBlock platform block
-    = foldBlockNodesB3 ( ($$) . pdoc platform
-                       , ($$) . (nest 4) . pdoc platform
-                       , ($$) . (nest 4) . pdoc platform
-                       )
-                       block
-                       empty
-
-pprGraph :: Platform -> Graph CmmNode e x -> SDoc
-pprGraph platform = \case
-   GNil                  -> empty
-   GUnit block           -> pdoc platform block
-   GMany entry body exit ->
-         text "{"
-      $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pdoc platform) $ bodyToBlockList body) $$ pprMaybeO exit)
-      $$ text "}"
-      where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
-                      => MaybeO ex (Block CmmNode e x) -> SDoc
-            pprMaybeO NothingO = empty
-            pprMaybeO (JustO block) = pdoc platform block
-
-pprCmmGraph :: Platform -> CmmGraph -> SDoc
-pprCmmGraph platform g
-   = text "{" <> text "offset"
-  $$ nest 2 (vcat $ map (pdoc platform) blocks)
-  $$ text "}"
-  where blocks = revPostorder g
-    -- revPostorder has the side-effect of discarding unreachable code,
-    -- so pretty-printed Cmm will omit any unreachable blocks.  This can
-    -- sometimes be confusing.
-
----------------------------------------------
--- Outputting CmmNode and types which it contains
-
-pprConvention :: Convention -> SDoc
-pprConvention (NativeNodeCall   {}) = text "<native-node-call-convention>"
-pprConvention (NativeDirectCall {}) = text "<native-direct-call-convention>"
-pprConvention (NativeReturn {})     = text "<native-ret-convention>"
-pprConvention  Slow                 = text "<slow-convention>"
-pprConvention  GC                   = text "<gc-convention>"
-
-pprForeignConvention :: ForeignConvention -> SDoc
-pprForeignConvention (ForeignConvention c args res ret) =
-          doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res <+> ppr ret
-
-pprReturnInfo :: CmmReturnInfo -> SDoc
-pprReturnInfo CmmMayReturn = empty
-pprReturnInfo CmmNeverReturns = text "never returns"
-
-pprForeignTarget :: Platform -> ForeignTarget -> SDoc
-pprForeignTarget platform (ForeignTarget fn c) = ppr c <+> ppr_target fn
-  where
-        ppr_target :: CmmExpr -> SDoc
-        ppr_target t@(CmmLit _) = pdoc platform t
-        ppr_target fn'          = parens (pdoc platform fn')
-
-pprForeignTarget platform (PrimTarget op)
- -- HACK: We're just using a ForeignLabel to get this printed, the label
- --       might not really be foreign.
- = pdoc platform
-               (CmmLabel (mkForeignLabel
-                         (mkFastString (show op))
-                         Nothing ForeignLabelInThisPackage IsFunction))
-
-pprNode :: Platform -> CmmNode e x -> SDoc
-pprNode platform node = pp_node <+> pp_debug
-  where
-    pp_node :: SDoc
-    pp_node = case node of
-      -- label:
-      CmmEntry id tscope ->
-         (sdocOption sdocSuppressUniques $ \case
-            True  -> text "_lbl_"
-            False -> ppr id
-         )
-         <> colon
-         <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope)
-
-      -- // text
-      CmmComment s -> text "//" <+> ftext s
-
-      -- //tick bla<...>
-      CmmTick t -> ppUnlessOption sdocSuppressTicks
-                     (text "//tick" <+> ppr t)
-
-      -- unwind reg = expr;
-      CmmUnwind regs ->
-          text "unwind "
-          <> commafy (map (\(r,e) -> ppr r <+> char '=' <+> pdoc platform e) regs) <> semi
-
-      -- reg = expr;
-      CmmAssign reg expr -> ppr reg <+> equals <+> pdoc platform expr <> semi
-
-      -- rep[lv] = expr;
-      CmmStore lv expr align -> rep <> align_mark <> brackets (pdoc platform lv) <+> equals <+> pdoc platform expr <> semi
-          where
-            align_mark = case align of
-                           Unaligned -> text "^"
-                           NaturallyAligned -> empty
-            rep = ppr ( cmmExprType platform expr )
-
-      -- call "ccall" foo(x, y)[r1, r2];
-      -- ToDo ppr volatile
-      CmmUnsafeForeignCall target results args ->
-          hsep [ ppUnless (null results) $
-                    parens (commafy $ map ppr results) <+> equals,
-                 text "call",
-                 pdoc platform target <> parens (commafy $ map (pdoc platform) args) <> semi]
-
-      -- goto label;
-      CmmBranch ident -> text "goto" <+> ppr ident <> semi
-
-      -- if (expr) goto t; else goto f;
-      CmmCondBranch expr t f l ->
-          hsep [ text "if"
-               , parens (pdoc platform expr)
-               , case l of
-                   Nothing -> empty
-                   Just b -> parens (text "likely:" <+> ppr b)
-               , text "goto"
-               , ppr t <> semi
-               , text "else goto"
-               , ppr f <> semi
-               ]
-
-      CmmSwitch expr ids ->
-          hang (hsep [ text "switch"
-                     , range
-                     , if isTrivialCmmExpr expr
-                       then pdoc platform expr
-                       else parens (pdoc platform expr)
-                     , text "{"
-                     ])
-             4 (vcat (map ppCase cases) $$ def) $$ rbrace
-          where
-            (cases, mbdef) = switchTargetsFallThrough ids
-            ppCase (is,l) = hsep
-                            [ text "case"
-                            , commafy $ map integer is
-                            , text ": goto"
-                            , ppr l <> semi
-                            ]
-            def | Just l <- mbdef = hsep
-                            [ text "default:"
-                            , braces (text "goto" <+> ppr l <> semi)
-                            ]
-                | otherwise = empty
-
-            range = brackets $ hsep [integer lo, text "..", integer hi]
-              where (lo,hi) = switchTargetsRange ids
-
-      CmmCall tgt k regs out res updfr_off ->
-          hcat [ text "call", space
-               , pprFun tgt, parens (interpp'SP regs), space
-               , returns <+>
-                 text "args: " <> ppr out <> comma <+>
-                 text "res: " <> ppr res <> comma <+>
-                 text "upd: " <> ppr updfr_off
-               , semi ]
-          where pprFun f@(CmmLit _) = pdoc platform f
-                pprFun f = parens (pdoc platform f)
-
-                returns
-                  | Just r <- k = text "returns to" <+> ppr r <> comma
-                  | otherwise   = empty
-
-      CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
-          hcat $ if i then [text "interruptible", space] else [] ++
-               [ text "foreign call", space
-               , pdoc platform t, text "(...)", space
-               , text "returns to" <+> ppr s
-                    <+> text "args:" <+> parens (pdoc platform as)
-                    <+> text "ress:" <+> parens (ppr rs)
-               , text "ret_args:" <+> ppr a
-               , text "ret_off:" <+> ppr u
-               , semi ]
-
-    pp_debug :: SDoc
-    pp_debug =
-      if not debugIsOn then empty
-      else case node of
-             CmmEntry {}             -> empty -- Looks terrible with text "  // CmmEntry"
-             CmmComment {}           -> empty -- Looks also terrible with text "  // CmmComment"
-             CmmTick {}              -> empty
-             CmmUnwind {}            -> text "  // CmmUnwind"
-             CmmAssign {}            -> text "  // CmmAssign"
-             CmmStore {}             -> text "  // CmmStore"
-             CmmUnsafeForeignCall {} -> text "  // CmmUnsafeForeignCall"
-             CmmBranch {}            -> text "  // CmmBranch"
-             CmmCondBranch {}        -> text "  // CmmCondBranch"
-             CmmSwitch {}            -> text "  // CmmSwitch"
-             CmmCall {}              -> text "  // CmmCall"
-             CmmForeignCall {}       -> text "  // CmmForeignCall"
-
-    commafy :: [SDoc] -> SDoc
-    commafy xs = hsep $ punctuate comma xs
diff --git a/compiler/GHC/Cmm/Ppr/Decl.hs b/compiler/GHC/Cmm/Ppr/Decl.hs
deleted file mode 100644
index 3b1eff78ff..0000000000
--- a/compiler/GHC/Cmm/Ppr/Decl.hs
+++ /dev/null
@@ -1,172 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-
-
-----------------------------------------------------------------------------
---
--- Pretty-printing of common Cmm types
---
--- (c) The University of Glasgow 2004-2006
---
------------------------------------------------------------------------------
-
---
--- This is where we walk over Cmm emitting an external representation,
--- suitable for parsing, in a syntax strongly reminiscent of C--. This
--- is the "External Core" for the Cmm layer.
---
--- As such, this should be a well-defined syntax: we want it to look nice.
--- Thus, we try wherever possible to use syntax defined in [1],
--- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
--- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
--- than C--'s bits8 .. bits64.
---
--- We try to ensure that all information available in the abstract
--- syntax is reproduced, or reproducible, in the concrete syntax.
--- Data that is not in printed out can be reconstructed according to
--- conventions used in the pretty printer. There are at least two such
--- cases:
---      1) if a value has wordRep type, the type is not appended in the
---      output.
---      2) MachOps that operate over wordRep type are printed in a
---      C-style, rather than as their internal MachRep name.
---
--- These conventions produce much more readable Cmm output.
---
--- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
---
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module GHC.Cmm.Ppr.Decl
-    ( pprCmms, pprCmmGroup, pprSection, pprStatic
-    )
-where
-
-import GHC.Prelude
-
-import GHC.Platform
-import GHC.Cmm.Ppr.Expr
-import GHC.Cmm
-
-import GHC.Utils.Outputable
-
-import Data.List (intersperse)
-
-import qualified Data.ByteString as BS
-
-
-pprCmms :: (OutputableP Platform info, OutputableP Platform g)
-        => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
-pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms))
-        where
-          separator = space $$ text "-------------------" $$ space
-
------------------------------------------------------------------------------
-
-instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
-      => OutputableP Platform (GenCmmDecl d info i) where
-    pdoc = pprTop
-
-instance OutputableP Platform (GenCmmStatics a) where
-    pdoc = pprStatics
-
-instance OutputableP Platform CmmStatic where
-    pdoc = pprStatic
-
-instance OutputableP Platform CmmInfoTable where
-    pdoc = pprInfoTable
-
-
------------------------------------------------------------------------------
-
-pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
-            => Platform -> GenCmmGroup d info g -> SDoc
-pprCmmGroup platform tops
-    = vcat $ intersperse blankLine $ map (pprTop platform) tops
-
--- --------------------------------------------------------------------------
--- Top level `procedure' blocks.
---
-pprTop :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
-       => Platform -> GenCmmDecl d info i -> SDoc
-
-pprTop platform (CmmProc info lbl live graph)
-
-  = vcat [ pdoc platform lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live
-         , nest 8 $ lbrace <+> pdoc platform info $$ rbrace
-         , nest 4 $ pdoc platform graph
-         , rbrace ]
-
--- --------------------------------------------------------------------------
--- We follow [1], 4.5
---
---      section "data" { ... }
---
-pprTop platform (CmmData section ds) =
-    (hang (pprSection platform section <+> lbrace) 4 (pdoc platform ds))
-    $$ rbrace
-
--- --------------------------------------------------------------------------
--- Info tables.
-
-pprInfoTable :: Platform -> CmmInfoTable -> SDoc
-pprInfoTable platform (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
-                           , cit_prof = prof_info
-                           , cit_srt = srt })
-  = vcat [ text "label: " <> pdoc platform lbl
-         , text "rep: " <> ppr rep
-         , case prof_info of
-             NoProfilingInfo -> empty
-             ProfilingInfo ct cd ->
-               vcat [ text "type: " <> text (show (BS.unpack ct))
-                    , text "desc: " <> text (show (BS.unpack cd)) ]
-         , text "srt: " <> pdoc platform srt ]
-
-instance Outputable ForeignHint where
-  ppr NoHint     = empty
-  ppr SignedHint = quotes(text "signed")
---  ppr AddrHint   = quotes(text "address")
--- Temp Jan08
-  ppr AddrHint   = (text "PtrHint")
-
--- --------------------------------------------------------------------------
--- Static data.
---      Strings are printed as C strings, and we print them as I8[],
---      following C--
---
-
-pprStatics :: Platform -> GenCmmStatics a -> SDoc
-pprStatics platform (CmmStatics lbl itbl ccs payload) =
-  pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload
-pprStatics platform (CmmStaticsRaw lbl ds) = vcat ((pdoc platform lbl <> colon) : map (pprStatic platform) ds)
-
-pprStatic :: Platform -> CmmStatic -> SDoc
-pprStatic platform s = case s of
-    CmmStaticLit lit   -> nest 4 $ text "const" <+> pprLit platform lit <> semi
-    CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
-    CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')
-    CmmFileEmbed path  -> nest 4 $ text "incbin " <+> text (show path)
-
--- --------------------------------------------------------------------------
--- data sections
---
-pprSection :: Platform -> Section -> SDoc
-pprSection platform (Section t suffix) =
-  section <+> doubleQuotes (pprSectionType t <+> char '.' <+> pdoc platform suffix)
-  where
-    section = text "section"
-
-pprSectionType :: SectionType -> SDoc
-pprSectionType s = doubleQuotes $ case s of
-  Text                    -> text "text"
-  Data                    -> text "data"
-  ReadOnlyData            -> text "readonly"
-  ReadOnlyData16          -> text "readonly16"
-  RelocatableReadOnlyData -> text "relreadonly"
-  UninitialisedData       -> text "uninitialised"
-  InitArray               -> text "initarray"
-  FiniArray               -> text "finiarray"
-  CString                 -> text "cstring"
-  OtherSection s'         -> text s'
diff --git a/compiler/GHC/Cmm/Ppr/Expr.hs b/compiler/GHC/Cmm/Ppr/Expr.hs
deleted file mode 100644
index 3ef4b07af5..0000000000
--- a/compiler/GHC/Cmm/Ppr/Expr.hs
+++ /dev/null
@@ -1,299 +0,0 @@
-----------------------------------------------------------------------------
---
--- Pretty-printing of common Cmm types
---
--- (c) The University of Glasgow 2004-2006
---
------------------------------------------------------------------------------
-
---
--- This is where we walk over Cmm emitting an external representation,
--- suitable for parsing, in a syntax strongly reminiscent of C--. This
--- is the "External Core" for the Cmm layer.
---
--- As such, this should be a well-defined syntax: we want it to look nice.
--- Thus, we try wherever possible to use syntax defined in [1],
--- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
--- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
--- than C--'s bits8 .. bits64.
---
--- We try to ensure that all information available in the abstract
--- syntax is reproduced, or reproducible, in the concrete syntax.
--- Data that is not in printed out can be reconstructed according to
--- conventions used in the pretty printer. There are at least two such
--- cases:
---      1) if a value has wordRep type, the type is not appended in the
---      output.
---      2) MachOps that operate over wordRep type are printed in a
---      C-style, rather than as their internal MachRep name.
---
--- These conventions produce much more readable Cmm output.
---
--- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
---
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module GHC.Cmm.Ppr.Expr
-    ( pprExpr, pprLit
-    )
-where
-
-import GHC.Prelude
-
-import GHC.Platform
-import GHC.Cmm.Expr
-
-import GHC.Utils.Outputable
-import GHC.Utils.Trace
-
-import Data.Maybe
-import Numeric ( fromRat )
-
------------------------------------------------------------------------------
-
-instance OutputableP Platform CmmExpr where
-    pdoc = pprExpr
-
-instance Outputable CmmReg where
-    ppr e = pprReg e
-
-instance OutputableP Platform CmmLit where
-    pdoc = pprLit
-
-instance Outputable LocalReg where
-    ppr e = pprLocalReg e
-
-instance Outputable Area where
-    ppr e = pprArea e
-
-instance Outputable GlobalReg where
-    ppr e = pprGlobalReg e
-
-instance OutputableP env GlobalReg where
-    pdoc _ = ppr
-
--- --------------------------------------------------------------------------
--- Expressions
---
-
-pprExpr :: Platform -> CmmExpr -> SDoc
-pprExpr platform e
-    = case e of
-        CmmRegOff reg i ->
-                pprExpr platform (CmmMachOp (MO_Add rep)
-                           [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
-                where rep = typeWidth (cmmRegType platform reg)
-        CmmLit lit -> pprLit platform lit
-        _other     -> pprExpr1 platform e
-
--- Here's the precedence table from GHC.Cmm.Parser:
--- %nonassoc '>=' '>' '<=' '<' '!=' '=='
--- %left '|'
--- %left '^'
--- %left '&'
--- %left '>>' '<<'
--- %left '-' '+'
--- %left '/' '*' '%'
--- %right '~'
-
--- We just cope with the common operators for now, the rest will get
--- a default conservative behaviour.
-
--- %nonassoc '>=' '>' '<=' '<' '!=' '=='
-pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
-pprExpr1 platform (CmmMachOp op [x,y])
-   | Just doc <- infixMachOp1 op
-   = pprExpr7 platform x <+> doc <+> pprExpr7 platform y
-pprExpr1 platform e = pprExpr7 platform e
-
-infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
-
-infixMachOp1 (MO_Eq     _) = Just (text "==")
-infixMachOp1 (MO_Ne     _) = Just (text "!=")
-infixMachOp1 (MO_Shl    _) = Just (text "<<")
-infixMachOp1 (MO_U_Shr  _) = Just (text ">>")
-infixMachOp1 (MO_U_Ge   _) = Just (text ">=")
-infixMachOp1 (MO_U_Le   _) = Just (text "<=")
-infixMachOp1 (MO_U_Gt   _) = Just (char '>')
-infixMachOp1 (MO_U_Lt   _) = Just (char '<')
-infixMachOp1 _             = Nothing
-
--- %left '-' '+'
-pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
-   = pprExpr7 platform (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
-pprExpr7 platform (CmmMachOp op [x,y])
-   | Just doc <- infixMachOp7 op
-   = pprExpr7 platform x <+> doc <+> pprExpr8 platform y
-pprExpr7 platform e = pprExpr8 platform e
-
-infixMachOp7 (MO_Add _)  = Just (char '+')
-infixMachOp7 (MO_Sub _)  = Just (char '-')
-infixMachOp7 _           = Nothing
-
--- %left '/' '*' '%'
-pprExpr8 platform (CmmMachOp op [x,y])
-   | Just doc <- infixMachOp8 op
-   = pprExpr8 platform x <+> doc <+> pprExpr9 platform y
-pprExpr8 platform e = pprExpr9 platform e
-
-infixMachOp8 (MO_U_Quot _) = Just (char '/')
-infixMachOp8 (MO_Mul _)    = Just (char '*')
-infixMachOp8 (MO_U_Rem _)  = Just (char '%')
-infixMachOp8 _             = Nothing
-
-pprExpr9 :: Platform -> CmmExpr -> SDoc
-pprExpr9 platform e =
-   case e of
-        CmmLit    lit       -> pprLit1 platform lit
-        CmmLoad   expr rep align
-                            -> let align_mark =
-                                       case align of
-                                         NaturallyAligned -> empty
-                                         Unaligned        -> text "^"
-                                in ppr rep <> align_mark <> brackets (pdoc platform expr)
-        CmmReg    reg       -> ppr reg
-        CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
-        CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
-        CmmMachOp mop args  -> genMachOp platform mop args
-
-genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
-genMachOp platform mop args
-   | Just doc <- infixMachOp mop = case args of
-        -- dyadic
-        [x,y] -> pprExpr9 platform x <+> doc <+> pprExpr9 platform y
-
-        -- unary
-        [x]   -> doc <> pprExpr9 platform x
-
-        _     -> pprTrace "GHC.Cmm.Ppr.Expr.genMachOp: machop with strange number of args"
-                          (pprMachOp mop <+>
-                            parens (hcat $ punctuate comma (map (pprExpr platform) args)))
-                          empty
-
-   | isJust (infixMachOp1 mop)
-   || isJust (infixMachOp7 mop)
-   || isJust (infixMachOp8 mop)  = parens (pprExpr platform (CmmMachOp mop args))
-
-   | otherwise = char '%' <> ppr_op <> parens (commafy (map (pprExpr platform) args))
-        where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
-                                 (show mop))
-                -- replace spaces in (show mop) with underscores,
-
---
--- Unsigned ops on the word size of the machine get nice symbols.
--- All else get dumped in their ugly format.
---
-infixMachOp :: MachOp -> Maybe SDoc
-infixMachOp mop
-        = case mop of
-            MO_And    _ -> Just $ char '&'
-            MO_Or     _ -> Just $ char '|'
-            MO_Xor    _ -> Just $ char '^'
-            MO_Not    _ -> Just $ char '~'
-            MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
-            _ -> Nothing
-
--- --------------------------------------------------------------------------
--- Literals.
---  To minimise line noise we adopt the convention that if the literal
---  has the natural machine word size, we do not append the type
---
-pprLit :: Platform -> CmmLit -> SDoc
-pprLit platform lit = case lit of
-    CmmInt i rep ->
-        hcat [ (if i < 0 then parens else id)(integer i)
-             , ppUnless (rep == wordWidth platform) $
-               space <> dcolon <+> ppr rep ]
-
-    CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]
-    CmmVec lits        -> char '<' <> commafy (map (pprLit platform) lits) <> char '>'
-    CmmLabel clbl      -> pdoc platform clbl
-    CmmLabelOff clbl i -> pdoc platform clbl <> ppr_offset i
-    CmmLabelDiffOff clbl1 clbl2 i _ -> pdoc platform clbl1 <> char '-'
-                                       <> pdoc platform clbl2 <> ppr_offset i
-    CmmBlock id        -> ppr id
-    CmmHighStackMark -> text "<highSp>"
-
-pprLit1 :: Platform -> CmmLit -> SDoc
-pprLit1 platform lit@(CmmLabelOff {}) = parens (pprLit platform lit)
-pprLit1 platform lit                  = pprLit platform lit
-
-ppr_offset :: Int -> SDoc
-ppr_offset i
-    | i==0      = empty
-    | i>=0      = char '+' <> int i
-    | otherwise = char '-' <> int (-i)
-
--- --------------------------------------------------------------------------
--- Registers, whether local (temps) or global
---
-pprReg :: CmmReg -> SDoc
-pprReg r
-    = case r of
-        CmmLocal  local  -> pprLocalReg  local
-        CmmGlobal global -> pprGlobalReg global
-
---
--- We only print the type of the local reg if it isn't wordRep
---
-pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq rep) =
---   = ppr rep <> char '_' <> ppr uniq
--- Temp Jan08
-    char '_' <> pprUnique uniq <>
-       (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh
-                    then dcolon <> ptr <> ppr rep
-                    else dcolon <> ptr <> ppr rep)
-   where
-     pprUnique unique = sdocOption sdocSuppressUniques $ \case
-       True  -> text "_locVar_"
-       False -> ppr unique
-     ptr = empty
-         --if isGcPtrType rep
-         --      then doubleQuotes (text "ptr")
-         --      else empty
-
--- Stack areas
-pprArea :: Area -> SDoc
-pprArea Old        = text "old"
-pprArea (Young id) = hcat [ text "young<", ppr id, text ">" ]
-
--- needs to be kept in syn with 'GHC.Cmm.Expr.GlobalReg'
---
-pprGlobalReg :: GlobalReg -> SDoc
-pprGlobalReg gr
-    = case gr of
-        VanillaReg n _ -> char 'R' <> int n
--- Temp Jan08
---        VanillaReg n VNonGcPtr -> char 'R' <> int n
---        VanillaReg n VGcPtr    -> char 'P' <> int n
-        FloatReg   n   -> char 'F' <> int n
-        DoubleReg  n   -> char 'D' <> int n
-        LongReg    n   -> char 'L' <> int n
-        XmmReg     n   -> text "XMM" <> int n
-        YmmReg     n   -> text "YMM" <> int n
-        ZmmReg     n   -> text "ZMM" <> int n
-        Sp             -> text "Sp"
-        SpLim          -> text "SpLim"
-        Hp             -> text "Hp"
-        HpLim          -> text "HpLim"
-        MachSp         -> text "MachSp"
-        UnwindReturnReg-> text "UnwindReturnReg"
-        CCCS           -> text "CCCS"
-        CurrentTSO     -> text "CurrentTSO"
-        CurrentNursery -> text "CurrentNursery"
-        HpAlloc        -> text "HpAlloc"
-        EagerBlackholeInfo -> text "stg_EAGER_BLACKHOLE_info"
-        GCEnter1       -> text "stg_gc_enter_1"
-        GCFun          -> text "stg_gc_fun"
-        BaseReg        -> text "BaseReg"
-        PicBaseReg     -> text "PicBaseReg"
-
------------------------------------------------------------------------------
-
-commafy :: [SDoc] -> SDoc
-commafy xs = fsep $ punctuate comma xs
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 9297a25378..ccf542aff0 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -17,7 +17,6 @@ import GHC.Prelude hiding (last, unzip, succ, zip)
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm
-import GHC.Cmm.Ppr () -- For Outputable instances
 import GHC.Cmm.Utils
 import GHC.Cmm.Info
 import GHC.Cmm.Liveness
diff --git a/compiler/GHC/Cmm/Reg.hs b/compiler/GHC/Cmm/Reg.hs
new file mode 100644
index 0000000000..a37e5ce6f8
--- /dev/null
+++ b/compiler/GHC/Cmm/Reg.hs
@@ -0,0 +1,372 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module GHC.Cmm.Reg
+    ( -- * Cmm Registers
+      CmmReg(..)
+    , cmmRegType
+    , cmmRegWidth
+      -- * Local registers
+    , LocalReg(..)
+    , localRegType
+      -- * Global registers
+    , GlobalReg(..), isArgReg, globalRegType
+    , spReg, hpReg, spLimReg, hpLimReg, nodeReg
+    , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
+    , node, baseReg
+    , VGcPtr(..)
+    ) where
+
+import GHC.Prelude
+
+import GHC.Platform
+import GHC.Utils.Outputable
+import GHC.Types.Unique
+import GHC.Cmm.Type
+
+-----------------------------------------------------------------------------
+--              Cmm registers
+-----------------------------------------------------------------------------
+
+data CmmReg
+  = CmmLocal  {-# UNPACK #-} !LocalReg
+  | CmmGlobal GlobalReg
+  deriving( Eq, Ord, Show )
+
+instance Outputable CmmReg where
+    ppr e = pprReg e
+
+pprReg :: CmmReg -> SDoc
+pprReg r
+   = case r of
+        CmmLocal  local  -> pprLocalReg  local
+        CmmGlobal global -> pprGlobalReg global
+
+cmmRegType :: Platform -> CmmReg -> CmmType
+cmmRegType _        (CmmLocal  reg) = localRegType reg
+cmmRegType platform (CmmGlobal reg) = globalRegType platform reg
+
+cmmRegWidth :: Platform -> CmmReg -> Width
+cmmRegWidth platform = typeWidth . cmmRegType platform
+
+
+-----------------------------------------------------------------------------
+--              Local registers
+-----------------------------------------------------------------------------
+
+data LocalReg
+  = LocalReg {-# UNPACK #-} !Unique !CmmType
+    -- ^ Parameters:
+    --   1. Identifier
+    --   2. Type
+  deriving Show
+
+instance Eq LocalReg where
+  (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
+
+instance Outputable LocalReg where
+    ppr e = pprLocalReg e
+
+-- This is non-deterministic but we do not currently support deterministic
+-- code-generation. See Note [Unique Determinism and code generation]
+-- See Note [No Ord for Unique]
+instance Ord LocalReg where
+  compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2
+
+instance Uniquable LocalReg where
+  getUnique (LocalReg uniq _) = uniq
+
+localRegType :: LocalReg -> CmmType
+localRegType (LocalReg _ rep) = rep
+
+--
+-- We only print the type of the local reg if it isn't wordRep
+--
+pprLocalReg :: LocalReg -> SDoc
+pprLocalReg (LocalReg uniq rep) =
+--   = ppr rep <> char '_' <> ppr uniq
+-- Temp Jan08
+    char '_' <> pprUnique uniq <>
+       (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh
+                    then dcolon <> ptr <> ppr rep
+                    else dcolon <> ptr <> ppr rep)
+   where
+     pprUnique unique = sdocOption sdocSuppressUniques $ \case
+       True  -> text "_locVar_"
+       False -> ppr unique
+     ptr = empty
+         --if isGcPtrType rep
+         --      then doubleQuotes (text "ptr")
+         --      else empty
+
+-----------------------------------------------------------------------------
+--              Global STG registers
+-----------------------------------------------------------------------------
+{-
+Note [Overlapping global registers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The backend might not faithfully implement the abstraction of the STG
+machine with independent registers for different values of type
+GlobalReg. Specifically, certain pairs of registers (r1, r2) may
+overlap in the sense that a store to r1 invalidates the value in r2,
+and vice versa.
+
+Currently this occurs only on the x86_64 architecture where FloatReg n
+and DoubleReg n are assigned the same microarchitectural register, in
+order to allow functions to receive more Float# or Double# arguments
+in registers (as opposed to on the stack).
+
+There are no specific rules about which registers might overlap with
+which other registers, but presumably it's safe to assume that nothing
+will overlap with special registers like Sp or BaseReg.
+
+Use GHC.Cmm.Utils.regsOverlap to determine whether two GlobalRegs overlap
+on a particular platform. The instance Eq GlobalReg is syntactic
+equality of STG registers and does not take overlap into
+account. However it is still used in UserOfRegs/DefinerOfRegs and
+there are likely still bugs there, beware!
+-}
+
+data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
+
+data GlobalReg
+  -- Argument and return registers
+  = VanillaReg                  -- pointers, unboxed ints and chars
+        {-# UNPACK #-} !Int     -- its number
+        VGcPtr
+
+  | FloatReg            -- single-precision floating-point registers
+        {-# UNPACK #-} !Int     -- its number
+
+  | DoubleReg           -- double-precision floating-point registers
+        {-# UNPACK #-} !Int     -- its number
+
+  | LongReg             -- long int registers (64-bit, really)
+        {-# UNPACK #-} !Int     -- its number
+
+  | XmmReg                      -- 128-bit SIMD vector register
+        {-# UNPACK #-} !Int     -- its number
+
+  | YmmReg                      -- 256-bit SIMD vector register
+        {-# UNPACK #-} !Int     -- its number
+
+  | ZmmReg                      -- 512-bit SIMD vector register
+        {-# UNPACK #-} !Int     -- its number
+
+  -- STG registers
+  | Sp                  -- Stack ptr; points to last occupied stack location.
+  | SpLim               -- Stack limit
+  | Hp                  -- Heap ptr; points to last occupied heap location.
+  | HpLim               -- Heap limit register
+  | CCCS                -- Current cost-centre stack
+  | CurrentTSO          -- pointer to current thread's TSO
+  | CurrentNursery      -- pointer to allocation area
+  | HpAlloc             -- allocation count for heap check failure
+
+                -- We keep the address of some commonly-called
+                -- functions in the register table, to keep code
+                -- size down:
+  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info
+  | GCEnter1            -- stg_gc_enter_1
+  | GCFun               -- stg_gc_fun
+
+  -- Base offset for the register table, used for accessing registers
+  -- which do not have real registers assigned to them.  This register
+  -- will only appear after we have expanded GlobalReg into memory accesses
+  -- (where necessary) in the native code generator.
+  | BaseReg
+
+  -- The register used by the platform for the C stack pointer. This is
+  -- a break in the STG abstraction used exclusively to setup stack unwinding
+  -- information.
+  | MachSp
+
+  -- The is a dummy register used to indicate to the stack unwinder where
+  -- a routine would return to.
+  | UnwindReturnReg
+
+  -- Base Register for PIC (position-independent code) calculations
+  -- Only used inside the native code generator. It's exact meaning differs
+  -- from platform to platform (see module PositionIndependentCode).
+  | PicBaseReg
+
+  deriving( Show )
+
+instance Eq GlobalReg where
+   VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
+   FloatReg i == FloatReg j = i==j
+   DoubleReg i == DoubleReg j = i==j
+   LongReg i == LongReg j = i==j
+   -- NOTE: XMM, YMM, ZMM registers actually are the same registers
+   -- at least with respect to store at YMM i and then read from XMM i
+   -- and similarly for ZMM etc.
+   XmmReg i == XmmReg j = i==j
+   YmmReg i == YmmReg j = i==j
+   ZmmReg i == ZmmReg j = i==j
+   Sp == Sp = True
+   SpLim == SpLim = True
+   Hp == Hp = True
+   HpLim == HpLim = True
+   CCCS == CCCS = True
+   CurrentTSO == CurrentTSO = True
+   CurrentNursery == CurrentNursery = True
+   HpAlloc == HpAlloc = True
+   EagerBlackholeInfo == EagerBlackholeInfo = True
+   GCEnter1 == GCEnter1 = True
+   GCFun == GCFun = True
+   BaseReg == BaseReg = True
+   MachSp == MachSp = True
+   UnwindReturnReg == UnwindReturnReg = True
+   PicBaseReg == PicBaseReg = True
+   _r1 == _r2 = False
+
+-- NOTE: this Ord instance affects the tuple layout in GHCi, see
+--       Note [GHCi tuple layout]
+instance Ord GlobalReg where
+   compare (VanillaReg i _) (VanillaReg j _) = compare i j
+     -- Ignore type when seeking clashes
+   compare (FloatReg i)  (FloatReg  j) = compare i j
+   compare (DoubleReg i) (DoubleReg j) = compare i j
+   compare (LongReg i)   (LongReg   j) = compare i j
+   compare (XmmReg i)    (XmmReg    j) = compare i j
+   compare (YmmReg i)    (YmmReg    j) = compare i j
+   compare (ZmmReg i)    (ZmmReg    j) = compare i j
+   compare Sp Sp = EQ
+   compare SpLim SpLim = EQ
+   compare Hp Hp = EQ
+   compare HpLim HpLim = EQ
+   compare CCCS CCCS = EQ
+   compare CurrentTSO CurrentTSO = EQ
+   compare CurrentNursery CurrentNursery = EQ
+   compare HpAlloc HpAlloc = EQ
+   compare EagerBlackholeInfo EagerBlackholeInfo = EQ
+   compare GCEnter1 GCEnter1 = EQ
+   compare GCFun GCFun = EQ
+   compare BaseReg BaseReg = EQ
+   compare MachSp MachSp = EQ
+   compare UnwindReturnReg UnwindReturnReg = EQ
+   compare PicBaseReg PicBaseReg = EQ
+   compare (VanillaReg _ _) _ = LT
+   compare _ (VanillaReg _ _) = GT
+   compare (FloatReg _) _     = LT
+   compare _ (FloatReg _)     = GT
+   compare (DoubleReg _) _    = LT
+   compare _ (DoubleReg _)    = GT
+   compare (LongReg _) _      = LT
+   compare _ (LongReg _)      = GT
+   compare (XmmReg _) _       = LT
+   compare _ (XmmReg _)       = GT
+   compare (YmmReg _) _       = LT
+   compare _ (YmmReg _)       = GT
+   compare (ZmmReg _) _       = LT
+   compare _ (ZmmReg _)       = GT
+   compare Sp _ = LT
+   compare _ Sp = GT
+   compare SpLim _ = LT
+   compare _ SpLim = GT
+   compare Hp _ = LT
+   compare _ Hp = GT
+   compare HpLim _ = LT
+   compare _ HpLim = GT
+   compare CCCS _ = LT
+   compare _ CCCS = GT
+   compare CurrentTSO _ = LT
+   compare _ CurrentTSO = GT
+   compare CurrentNursery _ = LT
+   compare _ CurrentNursery = GT
+   compare HpAlloc _ = LT
+   compare _ HpAlloc = GT
+   compare GCEnter1 _ = LT
+   compare _ GCEnter1 = GT
+   compare GCFun _ = LT
+   compare _ GCFun = GT
+   compare BaseReg _ = LT
+   compare _ BaseReg = GT
+   compare MachSp _ = LT
+   compare _ MachSp = GT
+   compare UnwindReturnReg _ = LT
+   compare _ UnwindReturnReg = GT
+   compare EagerBlackholeInfo _ = LT
+   compare _ EagerBlackholeInfo = GT
+
+instance Outputable GlobalReg where
+    ppr e = pprGlobalReg e
+
+instance OutputableP env GlobalReg where
+    pdoc _ = ppr
+
+pprGlobalReg :: GlobalReg -> SDoc
+pprGlobalReg gr
+    = case gr of
+        VanillaReg n _ -> char 'R' <> int n
+-- Temp Jan08
+--        VanillaReg n VNonGcPtr -> char 'R' <> int n
+--        VanillaReg n VGcPtr    -> char 'P' <> int n
+        FloatReg   n   -> char 'F' <> int n
+        DoubleReg  n   -> char 'D' <> int n
+        LongReg    n   -> char 'L' <> int n
+        XmmReg     n   -> text "XMM" <> int n
+        YmmReg     n   -> text "YMM" <> int n
+        ZmmReg     n   -> text "ZMM" <> int n
+        Sp             -> text "Sp"
+        SpLim          -> text "SpLim"
+        Hp             -> text "Hp"
+        HpLim          -> text "HpLim"
+        MachSp         -> text "MachSp"
+        UnwindReturnReg-> text "UnwindReturnReg"
+        CCCS           -> text "CCCS"
+        CurrentTSO     -> text "CurrentTSO"
+        CurrentNursery -> text "CurrentNursery"
+        HpAlloc        -> text "HpAlloc"
+        EagerBlackholeInfo -> text "stg_EAGER_BLACKHOLE_info"
+        GCEnter1       -> text "stg_gc_enter_1"
+        GCFun          -> text "stg_gc_fun"
+        BaseReg        -> text "BaseReg"
+        PicBaseReg     -> text "PicBaseReg"
+
+
+-- convenient aliases
+baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
+  currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg  :: CmmReg
+baseReg = CmmGlobal BaseReg
+spReg = CmmGlobal Sp
+hpReg = CmmGlobal Hp
+hpLimReg = CmmGlobal HpLim
+spLimReg = CmmGlobal SpLim
+nodeReg = CmmGlobal node
+currentTSOReg = CmmGlobal CurrentTSO
+currentNurseryReg = CmmGlobal CurrentNursery
+hpAllocReg = CmmGlobal HpAlloc
+cccsReg = CmmGlobal CCCS
+
+node :: GlobalReg
+node = VanillaReg 1 VGcPtr
+
+globalRegType :: Platform -> GlobalReg -> CmmType
+globalRegType platform = \case
+   (VanillaReg _ VGcPtr)    -> gcWord platform
+   (VanillaReg _ VNonGcPtr) -> bWord platform
+   (FloatReg _)             -> cmmFloat W32
+   (DoubleReg _)            -> cmmFloat W64
+   (LongReg _)              -> cmmBits W64
+   -- TODO: improve the internal model of SIMD/vectorized registers
+   -- the right design SHOULd improve handling of float and double code too.
+   -- see remarks in "NOTE [SIMD Design for the future]"" in GHC.StgToCmm.Prim
+   (XmmReg _) -> cmmVec 4 (cmmBits W32)
+   (YmmReg _) -> cmmVec 8 (cmmBits W32)
+   (ZmmReg _) -> cmmVec 16 (cmmBits W32)
+
+   Hp         -> gcWord platform -- The initialiser for all
+                                 -- dynamically allocated closures
+   _          -> bWord platform
+
+isArgReg :: GlobalReg -> Bool
+isArgReg (VanillaReg {}) = True
+isArgReg (FloatReg {})   = True
+isArgReg (DoubleReg {})  = True
+isArgReg (LongReg {})    = True
+isArgReg (XmmReg {})     = True
+isArgReg (YmmReg {})     = True
+isArgReg (ZmmReg {})     = True
+isArgReg _               = False
diff --git a/compiler/GHC/Cmm/Type.hs b/compiler/GHC/Cmm/Type.hs
index ee059caa12..ec000a3c47 100644
--- a/compiler/GHC/Cmm/Type.hs
+++ b/compiler/GHC/Cmm/Type.hs
@@ -364,6 +364,14 @@ data ForeignHint
         -- Used to give extra per-argument or per-result
         -- information needed by foreign calling conventions
 
+instance Outputable ForeignHint where
+  ppr NoHint     = empty
+  ppr SignedHint = quotes(text "signed")
+--  ppr AddrHint   = quotes(text "address")
+-- Temp Jan08
+  ppr AddrHint   = (text "PtrHint")
+
+
 -------------------------------------------------------------------------
 
 -- These don't really belong here, but I don't know where is best to
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 2060be5bda..fda3ee23f6 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -42,8 +42,6 @@ module GHC.Cmm.Utils(
 
         cmmMkAssign,
 
-        isTrivialCmmExpr, hasNoGlobalRegs, isLit, isComparisonExpr,
-
         baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,
         currentTSOExpr, currentNurseryExpr, cccsExpr,
 
@@ -61,9 +59,9 @@ module GHC.Cmm.Utils(
         modifyGraph,
 
         ofBlockMap, toBlockMap,
-        ofBlockList, toBlockList, bodyToBlockList,
+        ofBlockList, toBlockList,
         toBlockListEntryFirst, toBlockListEntryFirstFalseFallthrough,
-        foldlGraphBlocks, mapGraphNodes, revPostorder, mapGraphNodes1,
+        foldlGraphBlocks, mapGraphNodes, mapGraphNodes1,
 
         -- * Ticks
         blockTicks
@@ -400,36 +398,6 @@ cmmMkAssign platform expr uq =
 
 ---------------------------------------------------
 --
---      CmmExpr predicates
---
----------------------------------------------------
-
-isTrivialCmmExpr :: CmmExpr -> Bool
-isTrivialCmmExpr (CmmLoad _ _ _)    = False
-isTrivialCmmExpr (CmmMachOp _ _)    = False
-isTrivialCmmExpr (CmmLit _)         = True
-isTrivialCmmExpr (CmmReg _)         = True
-isTrivialCmmExpr (CmmRegOff _ _)    = True
-isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
-
-hasNoGlobalRegs :: CmmExpr -> Bool
-hasNoGlobalRegs (CmmLoad e _ _)            = hasNoGlobalRegs e
-hasNoGlobalRegs (CmmMachOp _ es)           = all hasNoGlobalRegs es
-hasNoGlobalRegs (CmmLit _)                 = True
-hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
-hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
-hasNoGlobalRegs _ = False
-
-isLit :: CmmExpr -> Bool
-isLit (CmmLit _) = True
-isLit _          = False
-
-isComparisonExpr :: CmmExpr -> Bool
-isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
-isComparisonExpr _                  = False
-
----------------------------------------------------
---
 --      Tagging
 --
 ---------------------------------------------------
@@ -525,9 +493,6 @@ mkLiveness platform (reg:regs)
 modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
 modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
 
-toBlockMap :: CmmGraph -> LabelMap CmmBlock
-toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
-
 ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
 ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}
 
@@ -578,9 +543,6 @@ ofBlockList entry blocks = CmmGraph { g_entry = entry
                                     , g_graph = GMany NothingO body NothingO }
   where body = foldr addBlock emptyBody blocks
 
-bodyToBlockList :: Body CmmNode -> [CmmBlock]
-bodyToBlockList body = mapElems body
-
 mapGraphNodes :: ( CmmNode C O -> CmmNode C O
                  , CmmNode O O -> CmmNode O O
                  , CmmNode O C -> CmmNode O C)
@@ -596,10 +558,6 @@ mapGraphNodes1 f = modifyGraph (mapGraph f)
 foldlGraphBlocks :: (a -> CmmBlock -> a) -> a -> CmmGraph -> a
 foldlGraphBlocks k z g = mapFoldl k z $ toBlockMap g
 
-revPostorder :: CmmGraph -> [CmmBlock]
-revPostorder g = {-# SCC "revPostorder" #-}
-    revPostorderFrom (toBlockMap g) (g_entry g)
-
 -------------------------------------------------
 -- Tick utilities
 
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 29ec7559f6..21b68a8f01 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -116,7 +116,6 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Opt           ( cmmMachOpFold )
-import GHC.Cmm.Ppr
 import GHC.Cmm.CLabel
 
 import GHC.Types.Unique.FM
diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
index b1761a1db2..5190633448 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -22,7 +22,6 @@ import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import GHC.Cmm.Ppr.Expr () -- For Outputable instances
 
 import GHC.Types.Unique ( pprUniqueAlways, getUnique )
 import GHC.Platform
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index e992116117..2d8caefcc5 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -78,7 +78,6 @@ import GHC.Utils.Panic.Plain
 --import GHC.Cmm.DebugBlock
 --import GHC.Data.OrdList
 --import GHC.Cmm.DebugBlock.Trace
-import GHC.Cmm.Ppr () -- For Outputable instances
 
 import Data.List (sort, nub, partition)
 import Data.STRef.Strict
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 844e4744da..099d10920e 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -48,7 +48,6 @@ import GHC.Platform
 
 -- Our intermediate code:
 import GHC.Cmm.BlockId
-import GHC.Cmm.Ppr           ( pprExpr )
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
@@ -395,7 +394,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do
 iselExpr64 expr
    = do
      platform <- getPlatform
-     pprPanic "iselExpr64(powerpc)" (pprExpr platform expr)
+     pprPanic "iselExpr64(powerpc)" (pdoc platform expr)
 
 
 
@@ -689,7 +688,7 @@ getRegister' config platform (CmmLit lit)
             `consOL` (addr_code `snocOL` LD format dst addr)
        return (Any format code)
 
-getRegister' _ platform other = pprPanic "getRegister(ppc)" (pprExpr platform other)
+getRegister' _ platform other = pprPanic "getRegister(ppc)" (pdoc platform other)
 
     -- extend?Rep: wrap integer expression of type `from`
     -- in a conversion to `to`
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index a842eef998..c0b2385b3c 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -34,7 +34,6 @@ import GHC.Cmm.Dataflow.Label
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import GHC.Cmm.Ppr.Expr () -- For Outputable instances
 
 import GHC.Types.Unique ( pprUniqueAlways, getUnique )
 import GHC.Platform
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index c9f86e9afe..1659575459 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -33,8 +33,7 @@ import GHC.CmmToAsm.CPrim
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import GHC.Cmm hiding (pprBBlock)
-import GHC.Cmm.Ppr () -- For Outputable instances
+import GHC.Cmm hiding (pprBBlock, pprStatic)
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Graph
diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs
index 1833ddb74f..80a68e76e7 100644
--- a/compiler/GHC/CmmToLlvm.hs
+++ b/compiler/GHC/CmmToLlvm.hs
@@ -25,7 +25,6 @@ import GHC.CmmToLlvm.Mangler
 import GHC.StgToCmm.CgUtils ( fixStgRegisters )
 import GHC.Cmm
 import GHC.Cmm.Dataflow.Collections
-import GHC.Cmm.Ppr
 
 import GHC.Utils.BufHandle
 import GHC.Driver.Session
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index f72411c4ec..33592092de 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -42,7 +42,6 @@ import GHC.CmmToLlvm.Regs
 import GHC.CmmToLlvm.Config
 
 import GHC.Cmm.CLabel
-import GHC.Cmm.Ppr.Expr ()
 import GHC.Platform.Regs ( activeStgRegs, globalRegMaybe )
 import GHC.Driver.Session
 import GHC.Data.FastString
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index f44fe1af6e..55c6e18883 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Regs
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm
-import GHC.Cmm.Ppr as PprCmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
 import GHC.Cmm.Dataflow.Block
@@ -1204,7 +1203,7 @@ genStore_slow addr val alignment meta = do
 
         other ->
             pprPanic "genStore: ptr not right type!"
-                    (PprCmm.pprExpr platform addr <+> text (
+                    (pdoc platform addr <+> text (
                         "Size of Ptr: "   ++ show (llvmPtrBits platform) ++
                         ", Size of var: " ++ show (llvmWidthInBits platform other) ++
                         ", Var: "         ++ renderWithContext (llvmCgContext cfg) (ppVar cfg vaddr)))
@@ -1725,7 +1724,7 @@ genMachOp_slow opt op [x, y] = case op of
                -> do
                     -- Error. Continue anyway so we can debug the generated ll file.
                     let render   = renderWithContext (llvmCgContext cfg)
-                        cmmToStr = (lines . render . PprCmm.pprExpr platform)
+                        cmmToStr = (lines . render . pdoc platform)
                     statement $ Comment $ map fsLit $ cmmToStr x
                     statement $ Comment $ map fsLit $ cmmToStr y
                     doExprW (ty vx) $ binOp vx vy
@@ -1882,7 +1881,7 @@ genLoad_slow atomic e ty align meta = do
                     doExprW (cmmToLlvmType ty) (MExpr meta $ mkLoad atomic ptr align)
 
         other -> pprPanic "exprToVar: CmmLoad expression is not right type!"
-                     (PprCmm.pprExpr platform e <+> text (
+                     (pdoc platform e <+> text (
                          "Size of Ptr: "   ++ show (llvmPtrBits platform) ++
                          ", Size of var: " ++ show (llvmWidthInBits platform other) ++
                          ", Var: " ++ renderWithContext (llvmCgContext cfg) (ppVar cfg iptr)))
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 7c1b5250e4..d935bb4b99 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -76,7 +76,6 @@ import GHC.Stg.Syntax
 import GHC.Runtime.Heap.Layout
 import GHC.Cmm
 import GHC.Cmm.Utils
-import GHC.Cmm.Ppr.Expr() -- For Outputable instances
 import GHC.StgToCmm.Types
 import GHC.StgToCmm.Sequel
 
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 7992e34417..9494a3c57d 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -38,7 +38,6 @@ import GHC.Cmm.BlockId
 import GHC.Cmm hiding ( succ )
 import GHC.Cmm.Info
 import GHC.Cmm.Utils ( zeroExpr, cmmTagMask, mkWordCLit, mAX_PTR_TAG )
-import GHC.Cmm.Ppr
 import GHC.Core
 import GHC.Core.DataCon
 import GHC.Types.ForeignCall
@@ -1021,7 +1020,7 @@ cgIdApp fun_id args = do
               assertTag = whenCheckTags $ do
                   mod <- getModuleName
                   emitTagAssertion (showPprUnsafe
-                      (text "TagCheck failed on entry in" <+> ppr mod <+> text "- value:" <> ppr fun_id <+> pprExpr platform fun))
+                      (text "TagCheck failed on entry in" <+> ppr mod <+> text "- value:" <> ppr fun_id <+> pdoc platform fun))
                       fun
 
         EnterIt -> assert (null args) $  -- Discarding arguments
diff --git a/compiler/GHC/StgToCmm/Sequel.hs b/compiler/GHC/StgToCmm/Sequel.hs
index ac55c3620f..e799e79678 100644
--- a/compiler/GHC/StgToCmm/Sequel.hs
+++ b/compiler/GHC/StgToCmm/Sequel.hs
@@ -17,7 +17,6 @@ module GHC.StgToCmm.Sequel
 
 import GHC.Cmm.BlockId
 import GHC.Cmm
-import GHC.Cmm.Ppr()
 
 import GHC.Types.Id
 import GHC.Utils.Outputable
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 452b34cce6..dc6de716f7 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -208,10 +208,8 @@ Library
         GHC.Cmm.Parser.Config
         GHC.Cmm.Parser.Monad
         GHC.Cmm.Pipeline
-        GHC.Cmm.Ppr
-        GHC.Cmm.Ppr.Decl
-        GHC.Cmm.Ppr.Expr
         GHC.Cmm.ProcPoint
+        GHC.Cmm.Reg
         GHC.Cmm.Sink
         GHC.Cmm.Switch
         GHC.Cmm.Switch.Implement
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index d471670b49..6a7ec5da95 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -16,6 +16,7 @@ GHC.Cmm.Dataflow.Label
 GHC.Cmm.Expr
 GHC.Cmm.MachOp
 GHC.Cmm.Node
+GHC.Cmm.Reg
 GHC.Cmm.Switch
 GHC.Cmm.Type
 GHC.CmmToAsm.CFG.Weight
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index f1882b5f0f..ef24b93130 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -16,6 +16,7 @@ GHC.Cmm.Dataflow.Label
 GHC.Cmm.Expr
 GHC.Cmm.MachOp
 GHC.Cmm.Node
+GHC.Cmm.Reg
 GHC.Cmm.Switch
 GHC.Cmm.Type
 GHC.CmmToAsm.CFG.Weight