DynFlags: refactor GHC.CmmToAsm (#17957, #10143)

This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr

To do that I've had to make some refactoring:

* X86' and PPC's `Instr` are no longer `Outputable` as they require a
  `Platform` argument

* `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc`

* as a consequence, I've refactored some modules to avoid .hs-boot files

* added (derived) functor instances for some datatypes parametric in the
  instruction type. It's useful for pretty-printing as we just have to
  map `pprInstr` before pretty-printing the container datatype.

32 files changed, 644 insertions, 503 deletions

diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 6f69525dc7..d93b885e9e 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module GHC.Cmm (
      -- * Cmm top-level datatypes
@@ -96,6 +97,8 @@ data GenCmmDecl d h g
         Section
         d
 
+  deriving (Functor)
+
 type CmmDecl     = GenCmmDecl CmmStatics    CmmTopInfo CmmGraph
 type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 
@@ -246,14 +249,19 @@ type RawCmmStatics = GenCmmStatics 'True
 -- These are used by the LLVM and NCG backends, when populating Cmm
 -- with lists of instructions.
 
-data GenBasicBlock i = BasicBlock BlockId [i]
+data GenBasicBlock i
+   = BasicBlock BlockId [i]
+   deriving (Functor)
+
 
 -- | The branch block id is that of the first block in
 -- the branch, which is that branch's entry point
 blockId :: GenBasicBlock i -> BlockId
 blockId (BasicBlock blk_id _ ) = blk_id
 
-newtype ListGraph i = ListGraph [GenBasicBlock i]
+newtype ListGraph i
+   = ListGraph [GenBasicBlock i]
+   deriving (Functor)
 
 instance Outputable instr => Outputable (ListGraph instr) where
     ppr (ListGraph blocks) = vcat (map ppr blocks)
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index b37f8e9549..2cd982288d 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -2,7 +2,6 @@
 --
 -- (c) The University of Glasgow 1993-2004
 --
--- This is the top-level module in the native code generator.
 --
 -- -----------------------------------------------------------------------------
 
@@ -15,40 +14,74 @@
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
-module GHC.CmmToAsm (
-                    -- * Module entry point
-                    nativeCodeGen
-
-                    -- * Test-only exports: see trac #12744
-                    -- used by testGraphNoSpills, which needs to access
-                    -- the register allocator intermediate data structures
-                    -- cmmNativeGen emits
-                  , cmmNativeGen
-                  , NcgImpl(..)
-                  , x86NcgImpl
-                  ) where
+-- | Native code generator
+--
+-- The native-code generator has machine-independent and
+-- machine-dependent modules.
+--
+-- This module ("GHC.CmmToAsm") is the top-level machine-independent
+-- module.  Before entering machine-dependent land, we do some
+-- machine-independent optimisations (defined below) on the
+-- 'CmmStmts's.
+--
+-- We convert to the machine-specific 'Instr' datatype with
+-- 'cmmCodeGen', assuming an infinite supply of registers.  We then use
+-- a machine-independent register allocator ('regAlloc') to rejoin
+-- reality.  Obviously, 'regAlloc' has machine-specific helper
+-- functions (see about "RegAllocInfo" below).
+--
+-- Finally, we order the basic blocks of the function so as to minimise
+-- the number of jumps between blocks, by utilising fallthrough wherever
+-- possible.
+--
+-- The machine-dependent bits break down as follows:
+--
+--   * ["MachRegs"]  Everything about the target platform's machine
+--     registers (and immediate operands, and addresses, which tend to
+--     intermingle/interact with registers).
+--
+--   * ["MachInstrs"]  Includes the 'Instr' datatype (possibly should
+--     have a module of its own), plus a miscellany of other things
+--     (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
+--
+--   * ["MachCodeGen"]  is where 'Cmm' stuff turns into
+--     machine instructions.
+--
+--   * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
+--     a 'SDoc').
+--
+--   * ["RegAllocInfo"] In the register allocator, we manipulate
+--     'MRegsState's, which are 'BitSet's, one bit per machine register.
+--     When we want to say something about a specific machine register
+--     (e.g., ``it gets clobbered by this instruction''), we set/unset
+--     its bit.  Obviously, we do this 'BitSet' thing for efficiency
+--     reasons.
+--
+--     The 'RegAllocInfo' module collects together the machine-specific
+--     info needed to do register allocation.
+--
+--    * ["RegisterAlloc"] The (machine-independent) register allocator.
+-- -}
+--
+module GHC.CmmToAsm
+   ( nativeCodeGen
+
+   -- * Test-only exports: see trac #12744
+   -- used by testGraphNoSpills, which needs to access
+   -- the register allocator intermediate data structures
+   -- cmmNativeGen emits
+   , cmmNativeGen
+   , NcgImpl(..)
+   )
+where
 
 #include "HsVersions.h"
 
 import GHC.Prelude
 
-import qualified GHC.CmmToAsm.X86.CodeGen as X86.CodeGen
-import qualified GHC.CmmToAsm.X86.Regs    as X86.Regs
-import qualified GHC.CmmToAsm.X86.Instr   as X86.Instr
-import qualified GHC.CmmToAsm.X86.Ppr     as X86.Ppr
-
-import qualified GHC.CmmToAsm.SPARC.CodeGen as SPARC.CodeGen
-import qualified GHC.CmmToAsm.SPARC.Regs    as SPARC.Regs
-import qualified GHC.CmmToAsm.SPARC.Instr   as SPARC.Instr
-import qualified GHC.CmmToAsm.SPARC.Ppr     as SPARC.Ppr
-import qualified GHC.CmmToAsm.SPARC.ShortcutJump   as SPARC.ShortcutJump
-import qualified GHC.CmmToAsm.SPARC.CodeGen.Expand as SPARC.CodeGen.Expand
-
-import qualified GHC.CmmToAsm.PPC.CodeGen as PPC.CodeGen
-import qualified GHC.CmmToAsm.PPC.Regs    as PPC.Regs
-import qualified GHC.CmmToAsm.PPC.RegInfo as PPC.RegInfo
-import qualified GHC.CmmToAsm.PPC.Instr   as PPC.Instr
-import qualified GHC.CmmToAsm.PPC.Ppr     as PPC.Ppr
+import qualified GHC.CmmToAsm.X86   as X86
+import qualified GHC.CmmToAsm.PPC   as PPC
+import qualified GHC.CmmToAsm.SPARC as SPARC
 
 import GHC.CmmToAsm.Reg.Liveness
 import qualified GHC.CmmToAsm.Reg.Linear                as Linear
@@ -71,6 +104,7 @@ import GHC.CmmToAsm.Monad
 import GHC.CmmToAsm.CFG
 import GHC.CmmToAsm.Dwarf
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
 import GHC.Cmm.DebugBlock
 
 import GHC.Cmm.BlockId
@@ -90,7 +124,6 @@ import GHC.Driver.Session
 import GHC.Driver.Ppr
 import GHC.Utils.Misc
 
-import GHC.Types.Basic       ( Alignment )
 import qualified GHC.Utils.Ppr as Pretty
 import GHC.Utils.BufHandle
 import GHC.Utils.Outputable as Outputable
@@ -102,9 +135,6 @@ import GHC.Unit
 import GHC.Data.Stream (Stream)
 import qualified GHC.Data.Stream as Stream
 
--- DEBUGGING ONLY
---import GHC.Data.OrdList
-
 import Data.List
 import Data.Maybe
 import Data.Ord         ( comparing )
@@ -112,54 +142,6 @@ import Control.Exception
 import Control.Monad
 import System.IO
 
-{-
-The native-code generator has machine-independent and
-machine-dependent modules.
-
-This module ("AsmCodeGen") is the top-level machine-independent
-module.  Before entering machine-dependent land, we do some
-machine-independent optimisations (defined below) on the
-'CmmStmts's.
-
-We convert to the machine-specific 'Instr' datatype with
-'cmmCodeGen', assuming an infinite supply of registers.  We then use
-a machine-independent register allocator ('regAlloc') to rejoin
-reality.  Obviously, 'regAlloc' has machine-specific helper
-functions (see about "RegAllocInfo" below).
-
-Finally, we order the basic blocks of the function so as to minimise
-the number of jumps between blocks, by utilising fallthrough wherever
-possible.
-
-The machine-dependent bits break down as follows:
-
-  * ["MachRegs"]  Everything about the target platform's machine
-    registers (and immediate operands, and addresses, which tend to
-    intermingle/interact with registers).
-
-  * ["MachInstrs"]  Includes the 'Instr' datatype (possibly should
-    have a module of its own), plus a miscellany of other things
-    (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
-
-  * ["MachCodeGen"]  is where 'Cmm' stuff turns into
-    machine instructions.
-
-  * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
-    a 'SDoc').
-
-  * ["RegAllocInfo"] In the register allocator, we manipulate
-    'MRegsState's, which are 'BitSet's, one bit per machine register.
-    When we want to say something about a specific machine register
-    (e.g., ``it gets clobbered by this instruction''), we set/unset
-    its bit.  Obviously, we do this 'BitSet' thing for efficiency
-    reasons.
-
-    The 'RegAllocInfo' module collects together the machine-specific
-    info needed to do register allocation.
-
-   * ["RegisterAlloc"] The (machine-independent) register allocator.
--}
-
 --------------------
 nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
               -> Stream IO RawCmmGroup a
@@ -167,114 +149,25 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
 nativeCodeGen dflags this_mod modLoc h us cmms
  = let config   = initConfig dflags
        platform = ncgPlatform config
-       nCG' :: ( Outputable statics, Outputable instr
-               , Outputable jumpDest, Instruction instr)
+       nCG' :: ( Outputable statics, Outputable jumpDest, Instruction instr)
             => NcgImpl statics instr jumpDest -> IO a
        nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
    in case platformArch platform of
-      ArchX86       -> nCG' (x86NcgImpl    config)
-      ArchX86_64    -> nCG' (x86_64NcgImpl config)
-      ArchPPC       -> nCG' (ppcNcgImpl    config)
-      ArchS390X     -> panic "nativeCodeGen: No NCG for S390X"
-      ArchSPARC     -> nCG' (sparcNcgImpl  config)
+      ArchX86       -> nCG' (X86.ncgX86     config)
+      ArchX86_64    -> nCG' (X86.ncgX86_64  config)
+      ArchPPC       -> nCG' (PPC.ncgPPC     config)
+      ArchPPC_64 _  -> nCG' (PPC.ncgPPC     config)
+      ArchSPARC     -> nCG' (SPARC.ncgSPARC config)
       ArchSPARC64   -> panic "nativeCodeGen: No NCG for SPARC64"
+      ArchS390X     -> panic "nativeCodeGen: No NCG for S390X"
       ArchARM {}    -> panic "nativeCodeGen: No NCG for ARM"
       ArchARM64     -> panic "nativeCodeGen: No NCG for ARM64"
-      ArchPPC_64 _  -> nCG' (ppcNcgImpl    config)
       ArchAlpha     -> panic "nativeCodeGen: No NCG for Alpha"
       ArchMipseb    -> panic "nativeCodeGen: No NCG for mipseb"
       ArchMipsel    -> panic "nativeCodeGen: No NCG for mipsel"
       ArchUnknown   -> panic "nativeCodeGen: No NCG for unknown arch"
       ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
 
-x86NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
-                                  X86.Instr.Instr X86.Instr.JumpDest
-x86NcgImpl config
- = (x86_64NcgImpl config)
-
-x86_64NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
-                                  X86.Instr.Instr X86.Instr.JumpDest
-x86_64NcgImpl config
- = NcgImpl {
-        ncgConfig                 = config
-       ,cmmTopCodeGen             = X86.CodeGen.cmmTopCodeGen
-       ,generateJumpTableForInstr = X86.CodeGen.generateJumpTableForInstr config
-       ,getJumpDestBlockId        = X86.Instr.getJumpDestBlockId
-       ,canShortcut               = X86.Instr.canShortcut
-       ,shortcutStatics           = X86.Instr.shortcutStatics
-       ,shortcutJump              = X86.Instr.shortcutJump
-       ,pprNatCmmDecl             = X86.Ppr.pprNatCmmDecl config
-       ,maxSpillSlots             = X86.Instr.maxSpillSlots config
-       ,allocatableRegs           = X86.Regs.allocatableRegs platform
-       ,ncgAllocMoreStack         = X86.Instr.allocMoreStack platform
-       ,ncgExpandTop              = id
-       ,ncgMakeFarBranches        = const id
-       ,extractUnwindPoints       = X86.CodeGen.extractUnwindPoints
-       ,invertCondBranches        = X86.CodeGen.invertCondBranches
-   }
-    where
-      platform = ncgPlatform config
-
-ppcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
-ppcNcgImpl config
- = NcgImpl {
-        ncgConfig                 = config
-       ,cmmTopCodeGen             = PPC.CodeGen.cmmTopCodeGen
-       ,generateJumpTableForInstr = PPC.CodeGen.generateJumpTableForInstr config
-       ,getJumpDestBlockId        = PPC.RegInfo.getJumpDestBlockId
-       ,canShortcut               = PPC.RegInfo.canShortcut
-       ,shortcutStatics           = PPC.RegInfo.shortcutStatics
-       ,shortcutJump              = PPC.RegInfo.shortcutJump
-       ,pprNatCmmDecl             = PPC.Ppr.pprNatCmmDecl config
-       ,maxSpillSlots             = PPC.Instr.maxSpillSlots config
-       ,allocatableRegs           = PPC.Regs.allocatableRegs platform
-       ,ncgAllocMoreStack         = PPC.Instr.allocMoreStack platform
-       ,ncgExpandTop              = id
-       ,ncgMakeFarBranches        = PPC.Instr.makeFarBranches
-       ,extractUnwindPoints       = const []
-       ,invertCondBranches        = \_ _ -> id
-   }
-    where
-      platform = ncgPlatform config
-
-sparcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest
-sparcNcgImpl config
- = NcgImpl {
-        ncgConfig                 = config
-       ,cmmTopCodeGen             = SPARC.CodeGen.cmmTopCodeGen
-       ,generateJumpTableForInstr = SPARC.CodeGen.generateJumpTableForInstr platform
-       ,getJumpDestBlockId        = SPARC.ShortcutJump.getJumpDestBlockId
-       ,canShortcut               = SPARC.ShortcutJump.canShortcut
-       ,shortcutStatics           = SPARC.ShortcutJump.shortcutStatics
-       ,shortcutJump              = SPARC.ShortcutJump.shortcutJump
-       ,pprNatCmmDecl             = SPARC.Ppr.pprNatCmmDecl config
-       ,maxSpillSlots             = SPARC.Instr.maxSpillSlots config
-       ,allocatableRegs           = SPARC.Regs.allocatableRegs
-       ,ncgAllocMoreStack         = noAllocMoreStack
-       ,ncgExpandTop              = map SPARC.CodeGen.Expand.expandTop
-       ,ncgMakeFarBranches        = const id
-       ,extractUnwindPoints       = const []
-       ,invertCondBranches        = \_ _ -> id
-   }
-    where
-      platform = ncgPlatform config
-
---
--- Allocating more stack space for spilling is currently only
--- supported for the linear register allocator on x86/x86_64, the rest
--- default to the panic below.  To support allocating extra stack on
--- more platforms provide a definition of ncgAllocMoreStack.
---
-noAllocMoreStack :: Int -> NatCmmDecl statics instr
-                 -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)])
-noAllocMoreStack amount _
-  = panic $   "Register allocator: out of stack slots (need " ++ show amount ++ ")\n"
-        ++  "   If you are trying to compile SHA1.hs from the crypto library then this\n"
-        ++  "   is a known limitation in the linear allocator.\n"
-        ++  "\n"
-        ++  "   Try enabling the graph colouring allocator with -fregs-graph instead."
-        ++  "   You can still file a bug report if you like.\n"
-
 
 -- | Data accumulated during code generation. Mostly about statistics,
 -- but also collects debug data for DWARF generation.
@@ -320,8 +213,7 @@ unwinding table).
 See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
 -}
 
-nativeCodeGen' :: (Outputable statics, Outputable instr,Outputable jumpDest,
-                   Instruction instr)
+nativeCodeGen' :: (Outputable statics, Outputable jumpDest, Instruction instr)
                => DynFlags
                -> Module -> ModLocation
                -> NcgImpl statics instr jumpDest
@@ -397,8 +289,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
                    (dumpOptionsFromFlag Opt_D_dump_asm_stats) "NCG stats"
                    FormatText
 
-cmmNativeGenStream :: (Outputable statics, Outputable instr
-                      ,Outputable jumpDest, Instruction instr)
+cmmNativeGenStream :: (Outputable statics, Outputable jumpDest, Instruction instr)
               => DynFlags
               -> Module -> ModLocation
               -> NcgImpl statics instr jumpDest
@@ -453,8 +344,7 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
 -- | Do native code generation on all these cmms.
 --
 cmmNativeGens :: forall statics instr jumpDest.
-                 (Outputable statics, Outputable instr
-                 ,Outputable jumpDest, Instruction instr)
+                 (Outputable statics, Outputable jumpDest, Instruction instr)
               => DynFlags
               -> Module -> ModLocation
               -> NcgImpl statics instr jumpDest
@@ -530,8 +420,7 @@ emitNativeCode dflags h sdoc = do
 --      Dumping the output of each stage along the way.
 --      Global conflict graph and NGC stats
 cmmNativeGen
-    :: forall statics instr jumpDest. (Instruction instr,
-        Outputable statics, Outputable instr, Outputable jumpDest)
+    :: forall statics instr jumpDest. (Instruction instr, Outputable statics, Outputable jumpDest)
     => DynFlags
     -> Module -> ModLocation
     -> NcgImpl statics instr jumpDest
@@ -602,7 +491,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_liveness "Liveness annotations added"
                 FormatCMM
-                (vcat $ map ppr withLiveness)
+                (vcat $ map (pprLiveCmmDecl platform) withLiveness)
 
         -- allocate registers
         (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear, raStats, stack_updt_blks) <-
@@ -650,7 +539,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
                         (vcat   $ map (\(stage, stats)
                                         -> text "# --------------------------"
                                         $$ text "#  cmm " <> int count <> text " Stage " <> int stage
-                                        $$ ppr stats)
+                                        $$ ppr (fmap (pprInstr platform) stats))
                                 $ zip [0..] regAllocStats)
 
                 let mPprStats =
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index d93b84887e..21b6865699 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -22,6 +22,7 @@ import GHC.Driver.Ppr     (pprTrace)
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Monad
 import GHC.CmmToAsm.CFG
+import GHC.CmmToAsm.Types
 
 import GHC.Cmm.BlockId
 import GHC.Cmm
@@ -668,7 +669,7 @@ buildChains edges blocks
 
 -- | Place basic blocks based on the given CFG.
 -- See Note [Chain based CFG serialization]
-sequenceChain :: forall a i. (Instruction i, Outputable i)
+sequenceChain :: forall a i. Instruction i
               => LabelMap a -- ^ Keys indicate an info table on the block.
               -> CFG -- ^ Control flow graph and some meta data.
               -> [GenBasicBlock i] -- ^ List of basic blocks to be placed.
@@ -815,7 +816,7 @@ dropJumps info ((BasicBlock lbl ins):todo)
 -- fallthroughs.
 
 sequenceTop
-    :: (Instruction instr, Outputable instr)
+    :: Instruction instr
     => DynFlags -- Determine which layout algo to use
     -> NcgImpl statics instr jumpDest
     -> Maybe CFG -- ^ CFG if we have one.
diff --git a/compiler/GHC/CmmToAsm/Instr.hs b/compiler/GHC/CmmToAsm/Instr.hs
index 869c5eb238..0a62c1d3bb 100644
--- a/compiler/GHC/CmmToAsm/Instr.hs
+++ b/compiler/GHC/CmmToAsm/Instr.hs
@@ -1,28 +1,18 @@
 
-module GHC.CmmToAsm.Instr (
-        RegUsage(..),
-        noUsage,
-        GenBasicBlock(..), blockId,
-        ListGraph(..),
-        NatCmm,
-        NatCmmDecl,
-        NatBasicBlock,
-        topInfoTable,
-        entryBlocks,
-        Instruction(..)
-)
-
+module GHC.CmmToAsm.Instr
+   ( Instruction(..)
+   , RegUsage(..)
+   , noUsage
+   )
 where
 
 import GHC.Prelude
 
 import GHC.Platform
 import GHC.Platform.Reg
+import GHC.Utils.Outputable (SDoc)
 
 import GHC.Cmm.BlockId
-import GHC.Cmm.Dataflow.Collections
-import GHC.Cmm.Dataflow.Label
-import GHC.Cmm hiding (topInfoTable)
 
 import GHC.CmmToAsm.Config
 
@@ -46,51 +36,11 @@ data RegUsage
 noUsage :: RegUsage
 noUsage  = RU [] []
 
--- Our flavours of the Cmm types
--- Type synonyms for Cmm populated with native code
-type NatCmm instr
-        = GenCmmGroup
-                RawCmmStatics
-                (LabelMap RawCmmStatics)
-                (ListGraph instr)
-
-type NatCmmDecl statics instr
-        = GenCmmDecl
-                statics
-                (LabelMap RawCmmStatics)
-                (ListGraph instr)
-
-
-type NatBasicBlock instr
-        = GenBasicBlock instr
-
-
--- | Returns the info table associated with the CmmDecl's entry point,
--- if any.
-topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
-topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
-  = mapLookup (blockId b) infos
-topInfoTable _
-  = Nothing
-
--- | Return the list of BlockIds in a CmmDecl that are entry points
--- for this proc (i.e. they may be jumped to from outside this proc).
-entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
-entryBlocks (CmmProc info _ _ (ListGraph code)) = entries
-  where
-        infos = mapKeys info
-        entries = case code of
-                    [] -> infos
-                    BasicBlock entry _ : _ -- first block is the entry point
-                       | entry `elem` infos -> infos
-                       | otherwise          -> entry : infos
-entryBlocks _ = []
-
 -- | Common things that we can do with instructions, on all architectures.
 --      These are used by the shared parts of the native code generator,
 --      specifically the register allocators.
 --
-class   Instruction instr where
+class Instruction instr where
 
         -- | Get the registers that are being used by this instruction.
         --      regUsage doesn't need to do any trickery for jumps and such.
@@ -204,3 +154,6 @@ class   Instruction instr where
                 :: Platform
                 -> Int
                 -> [instr]
+
+        -- | Pretty-print an instruction
+        pprInstr :: Platform -> instr -> SDoc
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 04921f7022..5a77e051cc 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -53,6 +53,7 @@ import GHC.Platform.Reg
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Reg.Target
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
@@ -68,10 +69,8 @@ import GHC.Unit.Module
 
 import Control.Monad    ( ap )
 
-import GHC.CmmToAsm.Instr
 import GHC.Utils.Outputable (SDoc, ppr)
 import GHC.Utils.Panic      (pprPanic)
-import GHC.Cmm (RawCmmDecl, RawCmmStatics)
 import GHC.CmmToAsm.CFG
 
 data NcgImpl statics instr jumpDest = NcgImpl {
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 419f8eb9d8..d776b1addb 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -54,10 +54,10 @@ import qualified GHC.CmmToAsm.PPC.Regs  as PPC
 import qualified GHC.CmmToAsm.X86.Instr as X86
 
 import GHC.Platform
-import GHC.CmmToAsm.Instr
 import GHC.Platform.Reg
 import GHC.CmmToAsm.Monad
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
 
 
 import GHC.Cmm.Dataflow.Collections
diff --git a/compiler/GHC/CmmToAsm/PPC.hs b/compiler/GHC/CmmToAsm/PPC.hs
new file mode 100644
index 0000000000..148fd1b4b2
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/PPC.hs
@@ -0,0 +1,61 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | Native code generator for PPC architectures
+module GHC.CmmToAsm.PPC
+   ( ncgPPC
+   )
+where
+
+import GHC.Prelude
+
+import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Monad
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+
+import qualified GHC.CmmToAsm.PPC.Instr   as PPC
+import qualified GHC.CmmToAsm.PPC.Ppr     as PPC
+import qualified GHC.CmmToAsm.PPC.CodeGen as PPC
+import qualified GHC.CmmToAsm.PPC.Regs    as PPC
+import qualified GHC.CmmToAsm.PPC.RegInfo as PPC
+
+ncgPPC :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr PPC.JumpDest
+ncgPPC config = NcgImpl
+   { ncgConfig                 = config
+   , cmmTopCodeGen             = PPC.cmmTopCodeGen
+   , generateJumpTableForInstr = PPC.generateJumpTableForInstr config
+   , getJumpDestBlockId        = PPC.getJumpDestBlockId
+   , canShortcut               = PPC.canShortcut
+   , shortcutStatics           = PPC.shortcutStatics
+   , shortcutJump              = PPC.shortcutJump
+   , pprNatCmmDecl             = PPC.pprNatCmmDecl config
+   , maxSpillSlots             = PPC.maxSpillSlots config
+   , allocatableRegs           = PPC.allocatableRegs platform
+   , ncgAllocMoreStack         = PPC.allocMoreStack platform
+   , ncgExpandTop              = id
+   , ncgMakeFarBranches        = PPC.makeFarBranches
+   , extractUnwindPoints       = const []
+   , invertCondBranches        = \_ _ -> id
+   }
+    where
+      platform = ncgPlatform config
+
+-- | Instruction instance for powerpc
+instance Instruction PPC.Instr where
+   regUsageOfInstr     = PPC.regUsageOfInstr
+   patchRegsOfInstr    = PPC.patchRegsOfInstr
+   isJumpishInstr      = PPC.isJumpishInstr
+   jumpDestsOfInstr    = PPC.jumpDestsOfInstr
+   patchJumpInstr      = PPC.patchJumpInstr
+   mkSpillInstr        = PPC.mkSpillInstr
+   mkLoadInstr         = PPC.mkLoadInstr
+   takeDeltaInstr      = PPC.takeDeltaInstr
+   isMetaInstr         = PPC.isMetaInstr
+   mkRegRegMoveInstr _ = PPC.mkRegRegMoveInstr
+   takeRegRegMoveInstr = PPC.takeRegRegMoveInstr
+   mkJumpInstr         = PPC.mkJumpInstr
+   mkStackAllocInstr   = PPC.mkStackAllocInstr
+   mkStackDeallocInstr = PPC.mkStackDeallocInstr
+   pprInstr            = PPC.pprInstr
+
+
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index e704beb61f..b25e6187b9 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -30,6 +30,7 @@ import GHC.CmmToAsm.PPC.Instr
 import GHC.CmmToAsm.PPC.Cond
 import GHC.CmmToAsm.PPC.Regs
 import GHC.CmmToAsm.CPrim
+import GHC.CmmToAsm.Types
 import GHC.Cmm.DebugBlock
    ( DebugBlock(..) )
 import GHC.CmmToAsm.Monad
@@ -38,7 +39,6 @@ import GHC.CmmToAsm.Monad
    , getPicBaseMaybeNat, getPlatform, getConfig
    , getDebugBlock, getFileId
    )
-import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.PIC
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Config
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index 29655647fa..46c5afb04c 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
@@ -12,23 +12,37 @@
 
 #include "HsVersions.h"
 
-module GHC.CmmToAsm.PPC.Instr (
-    archWordFormat,
-    RI(..),
-    Instr(..),
-    stackFrameHeaderSize,
-    maxSpillSlots,
-    allocMoreStack,
-    makeFarBranches
-)
-
+module GHC.CmmToAsm.PPC.Instr
+   ( Instr(..)
+   , RI(..)
+   , archWordFormat
+   , stackFrameHeaderSize
+   , maxSpillSlots
+   , allocMoreStack
+   , makeFarBranches
+   , mkJumpInstr
+   , mkLoadInstr
+   , mkSpillInstr
+   , patchJumpInstr
+   , patchRegsOfInstr
+   , jumpDestsOfInstr
+   , takeRegRegMoveInstr
+   , takeDeltaInstr
+   , mkRegRegMoveInstr
+   , mkStackAllocInstr
+   , mkStackDeallocInstr
+   , regUsageOfInstr
+   , isJumpishInstr
+   , isMetaInstr
+   )
 where
 
 import GHC.Prelude
 
 import GHC.CmmToAsm.PPC.Regs
 import GHC.CmmToAsm.PPC.Cond
-import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Reg.Target
 import GHC.CmmToAsm.Config
@@ -60,34 +74,16 @@ archWordFormat is32Bit
  | otherwise = II64
 
 
--- | Instruction instance for powerpc
-instance Instruction Instr where
-        regUsageOfInstr         = ppc_regUsageOfInstr
-        patchRegsOfInstr        = ppc_patchRegsOfInstr
-        isJumpishInstr          = ppc_isJumpishInstr
-        jumpDestsOfInstr        = ppc_jumpDestsOfInstr
-        patchJumpInstr          = ppc_patchJumpInstr
-        mkSpillInstr            = ppc_mkSpillInstr
-        mkLoadInstr             = ppc_mkLoadInstr
-        takeDeltaInstr          = ppc_takeDeltaInstr
-        isMetaInstr             = ppc_isMetaInstr
-        mkRegRegMoveInstr _     = ppc_mkRegRegMoveInstr
-        takeRegRegMoveInstr     = ppc_takeRegRegMoveInstr
-        mkJumpInstr             = ppc_mkJumpInstr
-        mkStackAllocInstr       = ppc_mkStackAllocInstr
-        mkStackDeallocInstr     = ppc_mkStackDeallocInstr
-
-
-ppc_mkStackAllocInstr :: Platform -> Int -> [Instr]
-ppc_mkStackAllocInstr platform amount
-  = ppc_mkStackAllocInstr' platform (-amount)
-
-ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]
-ppc_mkStackDeallocInstr platform amount
-  = ppc_mkStackAllocInstr' platform amount
-
-ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
-ppc_mkStackAllocInstr' platform amount
+mkStackAllocInstr :: Platform -> Int -> [Instr]
+mkStackAllocInstr platform amount
+  = mkStackAllocInstr' platform (-amount)
+
+mkStackDeallocInstr :: Platform -> Int -> [Instr]
+mkStackDeallocInstr platform amount
+  = mkStackAllocInstr' platform amount
+
+mkStackAllocInstr' :: Platform -> Int -> [Instr]
+mkStackAllocInstr' platform amount
   | fits16Bits amount
   = [ LD fmt r0 (AddrRegImm sp zero)
     , STU fmt r0 (AddrRegImm sp immAmount)
@@ -313,8 +309,8 @@ data Instr
 -- The consequences of control flow transfers, as far as register
 -- allocation goes, are taken care of by the register allocator.
 --
-ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
-ppc_regUsageOfInstr platform instr
+regUsageOfInstr :: Platform -> Instr -> RegUsage
+regUsageOfInstr platform instr
  = case instr of
     LD      _ reg addr       -> usage (regAddr addr, [reg])
     LDFAR   _ reg addr       -> usage (regAddr addr, [reg])
@@ -406,8 +402,8 @@ interesting _        (RegReal (RealRegPair{}))
 
 -- | Apply a given mapping to all the register references in this
 -- instruction.
-ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
-ppc_patchRegsOfInstr instr env
+patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
+patchRegsOfInstr instr env
  = case instr of
     LD      fmt reg addr    -> LD fmt (env reg) (fixAddr addr)
     LDFAR   fmt reg addr    -> LDFAR fmt (env reg) (fixAddr addr)
@@ -497,8 +493,8 @@ ppc_patchRegsOfInstr instr env
 -- | Checks whether this instruction is a jump/branch instruction.
 -- One that can change the flow of control in a way that the
 -- register allocator needs to worry about.
-ppc_isJumpishInstr :: Instr -> Bool
-ppc_isJumpishInstr instr
+isJumpishInstr :: Instr -> Bool
+isJumpishInstr instr
  = case instr of
     BCC{}       -> True
     BCCFAR{}    -> True
@@ -512,8 +508,8 @@ ppc_isJumpishInstr instr
 -- | Checks whether this instruction is a jump/branch instruction.
 -- One that can change the flow of control in a way that the
 -- register allocator needs to worry about.
-ppc_jumpDestsOfInstr :: Instr -> [BlockId]
-ppc_jumpDestsOfInstr insn
+jumpDestsOfInstr :: Instr -> [BlockId]
+jumpDestsOfInstr insn
   = case insn of
         BCC _ id _       -> [id]
         BCCFAR _ id _    -> [id]
@@ -524,8 +520,8 @@ ppc_jumpDestsOfInstr insn
 -- | Change the destination of this jump instruction.
 -- Used in the linear allocator when adding fixup blocks for join
 -- points.
-ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
-ppc_patchJumpInstr insn patchF
+patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
+patchJumpInstr insn patchF
   = case insn of
         BCC cc id p     -> BCC cc (patchF id) p
         BCCFAR cc id p  -> BCCFAR cc (patchF id) p
@@ -536,14 +532,14 @@ ppc_patchJumpInstr insn patchF
 -- -----------------------------------------------------------------------------
 
 -- | An instruction to spill a register into a spill slot.
-ppc_mkSpillInstr
+mkSpillInstr
    :: NCGConfig
    -> Reg       -- register to spill
    -> Int       -- current stack delta
    -> Int       -- spill slot to use
    -> Instr
 
-ppc_mkSpillInstr config reg delta slot
+mkSpillInstr config reg delta slot
   = let platform = ncgPlatform config
         off      = spillSlotToOffset platform slot
         arch     = platformArch platform
@@ -561,14 +557,14 @@ ppc_mkSpillInstr config reg delta slot
     in instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))
 
 
-ppc_mkLoadInstr
+mkLoadInstr
    :: NCGConfig
    -> Reg       -- register to load
    -> Int       -- current stack delta
    -> Int       -- spill slot to use
    -> Instr
 
-ppc_mkLoadInstr config reg delta slot
+mkLoadInstr config reg delta slot
   = let platform = ncgPlatform config
         off      = spillSlotToOffset platform slot
         arch     = platformArch platform
@@ -629,21 +625,21 @@ spillSlotToOffset platform slot
 
 --------------------------------------------------------------------------------
 -- | See if this instruction is telling us the current C stack delta
-ppc_takeDeltaInstr
+takeDeltaInstr
     :: Instr
     -> Maybe Int
 
-ppc_takeDeltaInstr instr
+takeDeltaInstr instr
  = case instr of
      DELTA i  -> Just i
      _        -> Nothing
 
 
-ppc_isMetaInstr
+isMetaInstr
     :: Instr
     -> Bool
 
-ppc_isMetaInstr instr
+isMetaInstr instr
  = case instr of
     COMMENT{}   -> True
     LOCATION{}  -> True
@@ -655,29 +651,29 @@ ppc_isMetaInstr instr
 
 -- | Copy the value in a register to another one.
 -- Must work for all register classes.
-ppc_mkRegRegMoveInstr
+mkRegRegMoveInstr
     :: Reg
     -> Reg
     -> Instr
 
-ppc_mkRegRegMoveInstr src dst
+mkRegRegMoveInstr src dst
     = MR dst src
 
 
 -- | Make an unconditional jump instruction.
-ppc_mkJumpInstr
+mkJumpInstr
     :: BlockId
     -> [Instr]
 
-ppc_mkJumpInstr id
+mkJumpInstr id
     = [BCC ALWAYS id Nothing]
 
 
 -- | Take the source and destination from this reg -> reg move instruction
 -- or Nothing if it's not one
-ppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
-ppc_takeRegRegMoveInstr (MR dst src) = Just (src,dst)
-ppc_takeRegRegMoveInstr _  = Nothing
+takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
+takeRegRegMoveInstr (MR dst src) = Just (src,dst)
+takeRegRegMoveInstr _  = Nothing
 
 -- -----------------------------------------------------------------------------
 -- Making far branches
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 99cb22ba28..3622121e6c 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -6,8 +6,11 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module GHC.CmmToAsm.PPC.Ppr (pprNatCmmDecl) where
+module GHC.CmmToAsm.PPC.Ppr
+   ( pprNatCmmDecl
+   , pprInstr
+   )
+where
 
 import GHC.Prelude
 
@@ -15,12 +18,13 @@ import GHC.CmmToAsm.PPC.Regs
 import GHC.CmmToAsm.PPC.Instr
 import GHC.CmmToAsm.PPC.Cond
 import GHC.CmmToAsm.Ppr
-import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Format
 import GHC.Platform.Reg
 import GHC.Platform.Reg.Class
 import GHC.CmmToAsm.Reg.Target
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Utils
 
 import GHC.Cmm hiding (topInfoTable)
 import GHC.Cmm.Dataflow.Collections
@@ -35,7 +39,6 @@ import GHC.Platform
 import GHC.Data.FastString
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
-import GHC.Driver.Session (targetPlatform)
 
 import Data.Word
 import Data.Int
@@ -185,11 +188,6 @@ pprLabel platform lbl =
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance Outputable Instr where
-    ppr instr = sdocWithDynFlags $ \dflags ->
-                  pprInstr (targetPlatform dflags) instr
-
-
 pprReg :: Reg -> SDoc
 
 pprReg r
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs
index c544d9ff8a..f31e84a5ff 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs
@@ -17,6 +17,7 @@ import GHC.CmmToAsm.Reg.Graph.TrivColorable
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Reg.Target
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 
@@ -45,7 +46,7 @@ maxSpinCount    = 10
 
 -- | The top level of the graph coloring register allocator.
 regAlloc
-        :: (Outputable statics, Outputable instr, Instruction instr)
+        :: (Outputable statics, Instruction instr)
         => NCGConfig
         -> UniqFM RegClass (UniqSet RealReg)     -- ^ registers we can use for allocation
         -> UniqSet Int                  -- ^ set of available spill slots.
@@ -90,7 +91,6 @@ regAlloc config regsFree slotsFree slotsCount code cfg
 regAlloc_spin
         :: forall instr statics.
            (Instruction instr,
-            Outputable instr,
             Outputable statics)
         => NCGConfig
         -> Int  -- ^ Number of solver iterations we've already performed.
@@ -388,7 +388,7 @@ graphAddCoalesce (r1, r2) graph
 
 -- | Patch registers in code using the reg -> reg mapping in this graph.
 patchRegsFromGraph
-        :: (Outputable statics, Outputable instr, Instruction instr)
+        :: (Outputable statics, Instruction instr)
         => Platform -> Color.Graph VirtualReg RegClass RealReg
         -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
 
@@ -413,7 +413,7 @@ patchRegsFromGraph platform graph code
                 = pprPanic "patchRegsFromGraph: register mapping failed."
                         (  text "There is no node in the graph for register "
                                 <> ppr reg
-                        $$ ppr code
+                        $$ pprLiveCmmDecl platform code
                         $$ Color.dotGraph
                                 (\_ -> text "white")
                                 (trivColorable platform
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
index a5d09d5eea..872b01c11a 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
@@ -76,7 +76,7 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
 --   For each vreg, the number of times it was written to, read from,
 --   and the number of instructions it was live on entry to (lifetime)
 --
-slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)
+slurpSpillCostInfo :: forall instr statics. Instruction instr
                    => Platform
                    -> Maybe CFG
                    -> LiveCmmDecl statics instr
@@ -116,7 +116,7 @@ slurpSpillCostInfo platform cfg cmm
 
                 | otherwise
                 = pprPanic "RegSpillCost.slurpSpillCostInfo"
-                $ text "no liveness information on instruction " <> ppr instr
+                $ text "no liveness information on instruction " <> pprInstr platform instr
 
         countLIs scale rsLiveEntry (LiveInstr instr (Just live) : lis)
          = do
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
index a0b1519a93..4e325e8778 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns, CPP, DeriveFunctor #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -23,15 +23,17 @@ import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Reg.Graph.Spill
 import GHC.CmmToAsm.Reg.Graph.SpillCost
 import GHC.CmmToAsm.Reg.Graph.TrivColorable
-import GHC.CmmToAsm.Instr
-import GHC.Platform.Reg.Class
-import GHC.Platform.Reg
 import GHC.CmmToAsm.Reg.Target
+import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Types
+
 import GHC.Platform
+import GHC.Platform.Reg
+import GHC.Platform.Reg.Class
 
-import GHC.Utils.Outputable
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
+import GHC.Utils.Outputable
 import GHC.Utils.Monad.State
 
 -- | Holds interesting statistics from the register allocator.
@@ -108,6 +110,7 @@ data RegAllocStats statics instr
           -- | Target platform
         , raPlatform    :: !Platform
         }
+        deriving (Functor)
 
 
 instance (Outputable statics, Outputable instr)
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs
index 4d666bc557..8d4da4bd2e 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs
@@ -122,6 +122,7 @@ import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Reg.Utils
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
 import GHC.Platform.Reg
 
 import GHC.Cmm.BlockId
@@ -147,7 +148,7 @@ import Control.Applicative
 
 -- Allocate registers
 regAlloc
-        :: (Outputable instr, Instruction instr)
+        :: Instruction instr
         => NCGConfig
         -> LiveCmmDecl statics instr
         -> UniqSM ( NatCmmDecl statics instr
@@ -204,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _)
 --   an entry in the block map or it is the first block.
 --
 linearRegAlloc
-        :: (Outputable instr, Instruction instr)
+        :: Instruction instr
         => NCGConfig
         -> [BlockId] -- ^ entry points
         -> BlockMap RegSet
@@ -236,7 +237,7 @@ linearRegAlloc config entry_ids block_live sccs
 -- | Constraints on the instruction instances used by the
 -- linear allocator.
 type OutputableRegConstraint freeRegs instr =
-        (FR freeRegs, Outputable freeRegs, Outputable instr, Instruction instr)
+        (FR freeRegs, Outputable freeRegs, Instruction instr)
 
 linearRegAlloc'
         :: OutputableRegConstraint freeRegs instr
@@ -468,7 +469,10 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
                         -- See Note [Unique Determinism and code generation]
 
 raInsn _ _ _ instr
-        = pprPanic "raInsn" (text "no match for:" <> ppr instr)
+        = do
+            platform <- getPlatform
+            let instr' = fmap (pprInstr platform) instr
+            pprPanic "raInsn" (text "no match for:" <> ppr instr')
 
 -- ToDo: what can we do about
 --
@@ -764,7 +768,7 @@ data SpillLoc = ReadMem StackSlot  -- reading from register only in memory
 --   the list of free registers and free stack slots.
 
 allocateRegsAndSpill
-        :: forall freeRegs instr. (FR freeRegs, Outputable instr, Instruction instr)
+        :: forall freeRegs instr. (FR freeRegs, Instruction instr)
         => Bool                 -- True <=> reading (load up spilled regs)
         -> [VirtualReg]         -- don't push these out
         -> [instr]              -- spill insns
@@ -830,7 +834,7 @@ findPrefRealReg vreg = do
 
 -- reading is redundant with reason, but we keep it around because it's
 -- convenient and it maintains the recursive structure of the allocator. -- EZY
-allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
+allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr)
                         => Bool
                         -> [VirtualReg]
                         -> [instr]
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index de489b342b..d0330a4f6a 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -18,12 +18,13 @@ import GHC.CmmToAsm.Reg.Linear.FreeRegs
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+
 import GHC.Platform.Reg
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
 import GHC.Data.Graph.Directed
-import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
@@ -33,7 +34,7 @@ import GHC.Types.Unique.Set
 --      vregs are in the correct regs for its destination.
 --
 joinToTargets
-        :: (FR freeRegs, Instruction instr, Outputable instr)
+        :: (FR freeRegs, Instruction instr)
         => BlockMap RegSet              -- ^ maps the unique of the blockid to the set of vregs
                                         --      that are known to be live on the entry to each block.
 
@@ -57,7 +58,7 @@ joinToTargets block_live id instr
 
 -----
 joinToTargets'
-        :: (FR freeRegs, Instruction instr, Outputable instr)
+        :: (FR freeRegs, Instruction instr)
         => BlockMap RegSet              -- ^ maps the unique of the blockid to the set of vregs
                                         --      that are known to be live on the entry to each block.
 
@@ -111,7 +112,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
 
 
 -- this is the first time we jumped to this block.
-joinToTargets_first :: (FR freeRegs, Instruction instr, Outputable instr)
+joinToTargets_first :: (FR freeRegs, Instruction instr)
                     => BlockMap RegSet
                     -> [NatBasicBlock instr]
                     -> BlockId
@@ -140,7 +141,7 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
 
 
 -- we've jumped to this block before
-joinToTargets_again :: (Instruction instr, FR freeRegs, Outputable instr)
+joinToTargets_again :: (Instruction instr, FR freeRegs)
                     => BlockMap RegSet
                     -> [NatBasicBlock instr]
                     -> BlockId
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
index 6411e5285d..4d44b43492 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
@@ -12,10 +12,11 @@ import GHC.CmmToAsm.Reg.Linear.Base
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
 import GHC.Types.Unique (Unique)
+import GHC.CmmToAsm.Types
 
 import GHC.Types.Unique.FM
-import GHC.Utils.Outputable
 
+import GHC.Utils.Outputable
 import GHC.Utils.Monad.State
 
 -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index 00adf1cc34..09db54fa76 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -26,6 +27,7 @@ module GHC.CmmToAsm.Reg.Liveness (
 
         mapBlockTop,    mapBlockTopM,   mapSCCM,
         mapGenBlockTop, mapGenBlockTopM,
+        mapLiveCmmDecl, pprLiveCmmDecl,
         stripLive,
         stripLiveBlock,
         slurpConflicts,
@@ -43,6 +45,8 @@ import GHC.Platform.Reg
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.CFG
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Utils
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
@@ -106,6 +110,8 @@ data InstrSR instr
         -- | reload this reg from a stack slot
         | RELOAD Int Reg
 
+        deriving (Functor)
+
 instance Instruction instr => Instruction (InstrSR instr) where
         regUsageOfInstr platform i
          = case i of
@@ -163,10 +169,13 @@ instance Instruction instr => Instruction (InstrSR instr) where
         mkStackDeallocInstr platform amount =
              Instr <$> mkStackDeallocInstr platform amount
 
+        pprInstr platform i = ppr (fmap (pprInstr platform) i)
+
 
 -- | An instruction with liveness information.
 data LiveInstr instr
         = LiveInstr (InstrSR instr) (Maybe Liveness)
+        deriving (Functor)
 
 -- | Liveness information.
 --   The regs which die are ones which are no longer live in the *next* instruction
@@ -494,7 +503,7 @@ slurpReloadCoalesce live
 
 -- | Strip away liveness information, yielding NatCmmDecl
 stripLive
-        :: (Outputable statics, Outputable instr, Instruction instr)
+        :: (Outputable statics, Instruction instr)
         => NCGConfig
         -> LiveCmmDecl statics instr
         -> NatCmmDecl statics instr
@@ -502,7 +511,7 @@ stripLive
 stripLive config live
         = stripCmm live
 
- where  stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
+ where  stripCmm :: (Outputable statics, Instruction instr)
                  => LiveCmmDecl statics instr -> NatCmmDecl statics instr
         stripCmm (CmmData sec ds)       = CmmData sec ds
         stripCmm (CmmProc (LiveInfo info (first_id:_) _ _) label live sccs)
@@ -519,7 +528,21 @@ stripLive config live
 
         -- If the proc has blocks but we don't know what the first one was, then we're dead.
         stripCmm proc
-                 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
+                 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (pprLiveCmmDecl (ncgPlatform config) proc)
+
+
+-- | Pretty-print a `LiveCmmDecl`
+pprLiveCmmDecl :: (Outputable statics, Instruction instr) => Platform -> LiveCmmDecl statics instr -> SDoc
+pprLiveCmmDecl platform d = ppr (mapLiveCmmDecl (pprInstr platform) d)
+
+
+-- | Map over instruction type in `LiveCmmDecl`
+mapLiveCmmDecl
+   :: Outputable statics
+   => (instr -> b)
+   -> LiveCmmDecl statics instr
+   -> LiveCmmDecl statics b
+mapLiveCmmDecl f proc = fmap (fmap (fmap (fmap (fmap f)))) proc
 
 -- | Strip away liveness information from a basic block,
 --   and make real spill instructions out of SPILL, RELOAD pseudos along the way.
@@ -653,15 +676,16 @@ patchRegsLiveInstr patchF li
 -- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information
 
 cmmTopLiveness
-        :: (Outputable instr, Instruction instr)
-        => Maybe CFG -> Platform
+        :: Instruction instr
+        => Maybe CFG
+        -> Platform
         -> NatCmmDecl statics instr
         -> UniqSM (LiveCmmDecl statics instr)
 cmmTopLiveness cfg platform cmm
         = regLiveness platform $ natCmmTopToLive cfg cmm
 
 natCmmTopToLive
-        :: (Instruction instr, Outputable instr)
+        :: Instruction instr
         => Maybe CFG -> NatCmmDecl statics instr
         -> LiveCmmDecl statics instr
 
@@ -747,7 +771,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
 --
 
 regLiveness
-        :: (Outputable instr, Instruction instr)
+        :: Instruction instr
         => Platform
         -> LiveCmmDecl statics instr
         -> UniqSM (LiveCmmDecl statics instr)
@@ -830,7 +854,7 @@ reverseBlocksInTops top
 --  want for the next pass.
 --
 computeLiveness
-        :: (Outputable instr, Instruction instr)
+        :: Instruction instr
         => Platform
         -> [SCC (LiveBasicBlock instr)]
         -> ([SCC (LiveBasicBlock instr)],       -- instructions annotated with list of registers
@@ -841,10 +865,11 @@ computeLiveness
 computeLiveness platform sccs
  = case checkIsReverseDependent sccs of
         Nothing         -> livenessSCCs platform mapEmpty [] sccs
-        Just bad        -> pprPanic "RegAlloc.Liveness.computeLiveness"
+        Just bad        -> let sccs' = fmap (fmap (fmap (fmap (pprInstr platform)))) sccs
+                           in pprPanic "RegAlloc.Liveness.computeLiveness"
                                 (vcat   [ text "SCCs aren't in reverse dependent order"
                                         , text "bad blockId" <+> ppr bad
-                                        , ppr sccs])
+                                        , ppr sccs'])
 
 livenessSCCs
        :: Instruction instr
diff --git a/compiler/GHC/CmmToAsm/SPARC.hs b/compiler/GHC/CmmToAsm/SPARC.hs
new file mode 100644
index 0000000000..fe6c824a09
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/SPARC.hs
@@ -0,0 +1,75 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | Native code generator for SPARC architectures
+module GHC.CmmToAsm.SPARC
+   ( ncgSPARC
+   )
+where
+
+import GHC.Prelude
+import GHC.Utils.Panic
+
+import GHC.CmmToAsm.Monad
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Instr
+
+import qualified GHC.CmmToAsm.SPARC.Instr          as SPARC
+import qualified GHC.CmmToAsm.SPARC.Ppr            as SPARC
+import qualified GHC.CmmToAsm.SPARC.CodeGen        as SPARC
+import qualified GHC.CmmToAsm.SPARC.CodeGen.Expand as SPARC
+import qualified GHC.CmmToAsm.SPARC.Regs           as SPARC
+import qualified GHC.CmmToAsm.SPARC.ShortcutJump   as SPARC
+
+
+ncgSPARC :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr SPARC.JumpDest
+ncgSPARC config = NcgImpl
+   { ncgConfig                 = config
+   , cmmTopCodeGen             = SPARC.cmmTopCodeGen
+   , generateJumpTableForInstr = SPARC.generateJumpTableForInstr platform
+   , getJumpDestBlockId        = SPARC.getJumpDestBlockId
+   , canShortcut               = SPARC.canShortcut
+   , shortcutStatics           = SPARC.shortcutStatics
+   , shortcutJump              = SPARC.shortcutJump
+   , pprNatCmmDecl             = SPARC.pprNatCmmDecl config
+   , maxSpillSlots             = SPARC.maxSpillSlots config
+   , allocatableRegs           = SPARC.allocatableRegs
+   , ncgExpandTop              = map SPARC.expandTop
+   , ncgMakeFarBranches        = const id
+   , extractUnwindPoints       = const []
+   , invertCondBranches        = \_ _ -> id
+   -- Allocating more stack space for spilling isn't currently supported for the
+   -- linear register allocator on SPARC, hence the panic below.
+   , ncgAllocMoreStack         = noAllocMoreStack
+   }
+    where
+      platform = ncgPlatform config
+
+      noAllocMoreStack amount _
+        = panic $   "Register allocator: out of stack slots (need " ++ show amount ++ ")\n"
+              ++  "   If you are trying to compile SHA1.hs from the crypto library then this\n"
+              ++  "   is a known limitation in the linear allocator.\n"
+              ++  "\n"
+              ++  "   Try enabling the graph colouring allocator with -fregs-graph instead."
+              ++  "   You can still file a bug report if you like.\n"
+
+
+-- | instance for sparc instruction set
+instance Instruction SPARC.Instr where
+   regUsageOfInstr         = SPARC.regUsageOfInstr
+   patchRegsOfInstr        = SPARC.patchRegsOfInstr
+   isJumpishInstr          = SPARC.isJumpishInstr
+   jumpDestsOfInstr        = SPARC.jumpDestsOfInstr
+   patchJumpInstr          = SPARC.patchJumpInstr
+   mkSpillInstr            = SPARC.mkSpillInstr
+   mkLoadInstr             = SPARC.mkLoadInstr
+   takeDeltaInstr          = SPARC.takeDeltaInstr
+   isMetaInstr             = SPARC.isMetaInstr
+   mkRegRegMoveInstr       = SPARC.mkRegRegMoveInstr
+   takeRegRegMoveInstr     = SPARC.takeRegRegMoveInstr
+   mkJumpInstr             = SPARC.mkJumpInstr
+   pprInstr                = const SPARC.pprInstr
+   mkStackAllocInstr       = panic "no sparc_mkStackAllocInstr"
+   mkStackDeallocInstr     = panic "no sparc_mkStackDeallocInstr"
+
+
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index fcebf9c487..82da39d893 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -34,7 +34,7 @@ import GHC.CmmToAsm.SPARC.Imm
 import GHC.CmmToAsm.SPARC.AddrMode
 import GHC.CmmToAsm.SPARC.Regs
 import GHC.CmmToAsm.SPARC.Stack
-import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Types
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Monad   ( NatM, getNewRegNat, getNewLabelNat, getPlatform, getConfig )
 import GHC.CmmToAsm.Config
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs
index c1660f989b..a36f893ce3 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs
@@ -13,11 +13,12 @@ import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Imm
 import GHC.CmmToAsm.SPARC.AddrMode
 import GHC.CmmToAsm.SPARC.Regs
-import GHC.CmmToAsm.Instr
-import GHC.Platform.Reg
 import GHC.CmmToAsm.Format
+import GHC.CmmToAsm.Types
 import GHC.Cmm
 
+import GHC.Platform.Reg
+
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Data.OrdList
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs
index 52d4f125b5..ac5ff79579 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs
@@ -16,9 +16,7 @@ import GHC.CmmToAsm.SPARC.Regs
 import GHC.CmmToAsm.SPARC.AddrMode
 import GHC.CmmToAsm.SPARC.Imm
 import GHC.CmmToAsm.SPARC.Instr
--- GHC.CmmToAsm.SPARC.Ppr()
 import GHC.CmmToAsm.Monad
-import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Format
 import GHC.Platform.Reg
 
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs
index a1060e5cf2..4bbb3e3823 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs
@@ -10,7 +10,7 @@ import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Ppr        () -- For Outputable instances
-import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Types
 
 import GHC.Cmm
 
diff --git a/compiler/GHC/CmmToAsm/SPARC/Instr.hs b/compiler/GHC/CmmToAsm/SPARC/Instr.hs
index 7f0db3c18d..64b9276ac1 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Instr.hs
@@ -9,22 +9,31 @@
 -----------------------------------------------------------------------------
 #include "HsVersions.h"
 
-module GHC.CmmToAsm.SPARC.Instr (
-        RI(..),
-        riZero,
-
-        fpRelEA,
-        moveSp,
-
-        isUnconditionalJump,
-
-        Instr(..),
-        maxSpillSlots
-)
-
+module GHC.CmmToAsm.SPARC.Instr
+   ( Instr(..)
+   , RI(..)
+   , riZero
+   , fpRelEA
+   , moveSp
+   , isUnconditionalJump
+   , maxSpillSlots
+   , patchRegsOfInstr
+   , patchJumpInstr
+   , mkRegRegMoveInstr
+   , mkLoadInstr
+   , mkSpillInstr
+   , mkJumpInstr
+   , takeDeltaInstr
+   , isMetaInstr
+   , isJumpishInstr
+   , jumpDestsOfInstr
+   , takeRegRegMoveInstr
+   , regUsageOfInstr
+   )
 where
 
 import GHC.Prelude
+import GHC.Platform
 
 import GHC.CmmToAsm.SPARC.Stack
 import GHC.CmmToAsm.SPARC.Imm
@@ -33,19 +42,19 @@ import GHC.CmmToAsm.SPARC.Cond
 import GHC.CmmToAsm.SPARC.Regs
 import GHC.CmmToAsm.SPARC.Base
 import GHC.CmmToAsm.Reg.Target
-import GHC.CmmToAsm.Instr
-import GHC.Platform.Reg.Class
-import GHC.Platform.Reg
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
 
-import GHC.Cmm.CLabel
+import GHC.Platform.Reg.Class
+import GHC.Platform.Reg
 import GHC.Platform.Regs
+
+import GHC.Cmm.CLabel
 import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Data.FastString
 import GHC.Utils.Panic
-import GHC.Platform
 
 
 -- | Register or immediate
@@ -88,24 +97,6 @@ isUnconditionalJump ii
         _               -> False
 
 
--- | instance for sparc instruction set
-instance Instruction Instr where
-        regUsageOfInstr         = sparc_regUsageOfInstr
-        patchRegsOfInstr        = sparc_patchRegsOfInstr
-        isJumpishInstr          = sparc_isJumpishInstr
-        jumpDestsOfInstr        = sparc_jumpDestsOfInstr
-        patchJumpInstr          = sparc_patchJumpInstr
-        mkSpillInstr            = sparc_mkSpillInstr
-        mkLoadInstr             = sparc_mkLoadInstr
-        takeDeltaInstr          = sparc_takeDeltaInstr
-        isMetaInstr             = sparc_isMetaInstr
-        mkRegRegMoveInstr       = sparc_mkRegRegMoveInstr
-        takeRegRegMoveInstr     = sparc_takeRegRegMoveInstr
-        mkJumpInstr             = sparc_mkJumpInstr
-        mkStackAllocInstr       = panic "no sparc_mkStackAllocInstr"
-        mkStackDeallocInstr     = panic "no sparc_mkStackDeallocInstr"
-
-
 -- | SPARC instruction set.
 --      Not complete. This is only the ones we need.
 --
@@ -218,8 +209,8 @@ data Instr
 --      consequences of control flow transfers, as far as register
 --      allocation goes, are taken care of by the register allocator.
 --
-sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
-sparc_regUsageOfInstr platform instr
+regUsageOfInstr :: Platform -> Instr -> RegUsage
+regUsageOfInstr platform instr
  = case instr of
     LD    _ addr reg            -> usage (regAddr addr,         [reg])
     ST    _ reg addr            -> usage (reg : regAddr addr,   [])
@@ -285,8 +276,8 @@ interesting platform reg
 
 
 -- | Apply a given mapping to tall the register references in this instruction.
-sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
-sparc_patchRegsOfInstr instr env = case instr of
+patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
+patchRegsOfInstr instr env = case instr of
     LD    fmt addr reg          -> LD fmt (fixAddr addr) (env reg)
     ST    fmt reg addr          -> ST fmt (env reg) (fixAddr addr)
 
@@ -337,8 +328,8 @@ sparc_patchRegsOfInstr instr env = case instr of
 
 
 --------------------------------------------------------------------------------
-sparc_isJumpishInstr :: Instr -> Bool
-sparc_isJumpishInstr instr
+isJumpishInstr :: Instr -> Bool
+isJumpishInstr instr
  = case instr of
         BI{}            -> True
         BF{}            -> True
@@ -347,8 +338,8 @@ sparc_isJumpishInstr instr
         CALL{}          -> True
         _               -> False
 
-sparc_jumpDestsOfInstr :: Instr -> [BlockId]
-sparc_jumpDestsOfInstr insn
+jumpDestsOfInstr :: Instr -> [BlockId]
+jumpDestsOfInstr insn
   = case insn of
         BI   _ _ id     -> [id]
         BF   _ _ id     -> [id]
@@ -356,8 +347,8 @@ sparc_jumpDestsOfInstr insn
         _               -> []
 
 
-sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
-sparc_patchJumpInstr insn patchF
+patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
+patchJumpInstr insn patchF
   = case insn of
         BI cc annul id  -> BI cc annul (patchF id)
         BF cc annul id  -> BF cc annul (patchF id)
@@ -368,14 +359,14 @@ sparc_patchJumpInstr insn patchF
 --------------------------------------------------------------------------------
 -- | Make a spill instruction.
 --      On SPARC we spill below frame pointer leaving 2 words/spill
-sparc_mkSpillInstr
+mkSpillInstr
     :: NCGConfig
     -> Reg      -- ^ register to spill
     -> Int      -- ^ current stack delta
     -> Int      -- ^ spill slot to use
     -> Instr
 
-sparc_mkSpillInstr config reg _ slot
+mkSpillInstr config reg _ slot
  = let  platform = ncgPlatform config
         off      = spillSlotToOffset config slot
         off_w    = 1 + (off `div` 4)
@@ -388,14 +379,14 @@ sparc_mkSpillInstr config reg _ slot
 
 
 -- | Make a spill reload instruction.
-sparc_mkLoadInstr
+mkLoadInstr
     :: NCGConfig
     -> Reg      -- ^ register to load into
     -> Int      -- ^ current stack delta
     -> Int      -- ^ spill slot to use
     -> Instr
 
-sparc_mkLoadInstr config reg _ slot
+mkLoadInstr config reg _ slot
   = let platform = ncgPlatform config
         off      = spillSlotToOffset config slot
         off_w    = 1 + (off `div` 4)
@@ -409,21 +400,21 @@ sparc_mkLoadInstr config reg _ slot
 
 --------------------------------------------------------------------------------
 -- | See if this instruction is telling us the current C stack delta
-sparc_takeDeltaInstr
+takeDeltaInstr
         :: Instr
         -> Maybe Int
 
-sparc_takeDeltaInstr instr
+takeDeltaInstr instr
  = case instr of
         DELTA i         -> Just i
         _               -> Nothing
 
 
-sparc_isMetaInstr
+isMetaInstr
         :: Instr
         -> Bool
 
-sparc_isMetaInstr instr
+isMetaInstr instr
  = case instr of
         COMMENT{}       -> True
         LDATA{}         -> True
@@ -437,13 +428,13 @@ sparc_isMetaInstr instr
 --      floating point and integer regs. If we need to do that then we
 --      have to go via memory.
 --
-sparc_mkRegRegMoveInstr
+mkRegRegMoveInstr
     :: Platform
     -> Reg
     -> Reg
     -> Instr
 
-sparc_mkRegRegMoveInstr platform src dst
+mkRegRegMoveInstr platform src dst
         | srcClass      <- targetClassOfReg platform src
         , dstClass      <- targetClassOfReg platform dst
         , srcClass == dstClass
@@ -460,8 +451,8 @@ sparc_mkRegRegMoveInstr platform src dst
 --      The register allocator attempts to eliminate reg->reg moves whenever it can,
 --      by assigning the src and dest temporaries to the same real register.
 --
-sparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
-sparc_takeRegRegMoveInstr instr
+takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
+takeRegRegMoveInstr instr
  = case instr of
         ADD False False src (RIReg src2) dst
          | g0 == src2           -> Just (src, dst)
@@ -472,10 +463,10 @@ sparc_takeRegRegMoveInstr instr
 
 
 -- | Make an unconditional branch instruction.
-sparc_mkJumpInstr
+mkJumpInstr
         :: BlockId
         -> [Instr]
 
-sparc_mkJumpInstr id
+mkJumpInstr id
  =       [BI ALWAYS False id
         , NOP]                  -- fill the branch delay slot.
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 98f6096ac1..9d6acd16f8 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -9,7 +9,6 @@
 -----------------------------------------------------------------------------
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-
 module GHC.CmmToAsm.SPARC.Ppr (
         pprNatCmmDecl,
         pprBasicBlock,
@@ -32,11 +31,12 @@ import GHC.CmmToAsm.SPARC.Cond
 import GHC.CmmToAsm.SPARC.Imm
 import GHC.CmmToAsm.SPARC.AddrMode
 import GHC.CmmToAsm.SPARC.Base
-import GHC.CmmToAsm.Instr
 import GHC.Platform.Reg
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Ppr
 import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Utils
 
 import GHC.Cmm hiding (topInfoTable)
 import GHC.Cmm.Ppr() -- For Outputable instances
diff --git a/compiler/GHC/CmmToAsm/Types.hs b/compiler/GHC/CmmToAsm/Types.hs
new file mode 100644
index 0000000000..2c76b89e16
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Types.hs
@@ -0,0 +1,32 @@
+module GHC.CmmToAsm.Types
+   ( NatCmm
+   , NatCmmDecl
+   , NatBasicBlock
+   , GenBasicBlock(..)
+   , blockId
+   , ListGraph(..)
+   , RawCmmStatics
+   , RawCmmDecl
+   )
+where
+
+import GHC.Cmm.Dataflow.Label
+import GHC.Cmm
+
+
+-- Our flavours of the Cmm types
+-- Type synonyms for Cmm populated with native code
+type NatCmm instr
+        = GenCmmGroup
+                RawCmmStatics
+                (LabelMap RawCmmStatics)
+                (ListGraph instr)
+
+type NatCmmDecl statics instr
+        = GenCmmDecl
+                statics
+                (LabelMap RawCmmStatics)
+                (ListGraph instr)
+
+type NatBasicBlock instr
+        = GenBasicBlock instr
diff --git a/compiler/GHC/CmmToAsm/Utils.hs b/compiler/GHC/CmmToAsm/Utils.hs
new file mode 100644
index 0000000000..648805f210
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Utils.hs
@@ -0,0 +1,33 @@
+module GHC.CmmToAsm.Utils
+   ( topInfoTable
+   , entryBlocks
+   )
+where
+
+import GHC.Prelude
+
+import GHC.Cmm.BlockId
+import GHC.Cmm.Dataflow.Collections
+import GHC.Cmm.Dataflow.Label
+import GHC.Cmm hiding (topInfoTable)
+
+-- | Returns the info table associated with the CmmDecl's entry point,
+-- if any.
+topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
+topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
+  = mapLookup (blockId b) infos
+topInfoTable _
+  = Nothing
+
+-- | Return the list of BlockIds in a CmmDecl that are entry points
+-- for this proc (i.e. they may be jumped to from outside this proc).
+entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
+entryBlocks (CmmProc info _ _ (ListGraph code)) = entries
+  where
+        infos = mapKeys info
+        entries = case code of
+                    [] -> infos
+                    BasicBlock entry _ : _ -- first block is the entry point
+                       | entry `elem` infos -> infos
+                       | otherwise          -> entry : infos
+entryBlocks _ = []
diff --git a/compiler/GHC/CmmToAsm/X86.hs b/compiler/GHC/CmmToAsm/X86.hs
new file mode 100644
index 0000000000..dbeeddc184
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/X86.hs
@@ -0,0 +1,65 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | Native code generator for x86 and x86-64 architectures
+module GHC.CmmToAsm.X86
+   ( ncgX86_64
+   , ncgX86
+   )
+where
+
+import GHC.Prelude
+
+import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Monad
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Types
+import GHC.Types.Basic (Alignment)
+
+import qualified GHC.CmmToAsm.X86.Instr   as X86
+import qualified GHC.CmmToAsm.X86.Ppr     as X86
+import qualified GHC.CmmToAsm.X86.CodeGen as X86
+import qualified GHC.CmmToAsm.X86.Regs    as X86
+
+ncgX86 :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr X86.JumpDest
+ncgX86 = ncgX86_64
+
+
+ncgX86_64 :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr X86.JumpDest
+ncgX86_64 config = NcgImpl
+   { ncgConfig                 = config
+   , cmmTopCodeGen             = X86.cmmTopCodeGen
+   , generateJumpTableForInstr = X86.generateJumpTableForInstr config
+   , getJumpDestBlockId        = X86.getJumpDestBlockId
+   , canShortcut               = X86.canShortcut
+   , shortcutStatics           = X86.shortcutStatics
+   , shortcutJump              = X86.shortcutJump
+   , pprNatCmmDecl             = X86.pprNatCmmDecl config
+   , maxSpillSlots             = X86.maxSpillSlots config
+   , allocatableRegs           = X86.allocatableRegs platform
+   , ncgAllocMoreStack         = X86.allocMoreStack platform
+   , ncgExpandTop              = id
+   , ncgMakeFarBranches        = const id
+   , extractUnwindPoints       = X86.extractUnwindPoints
+   , invertCondBranches        = X86.invertCondBranches
+   }
+    where
+      platform = ncgPlatform config
+
+-- | Instruction instance for x86 instruction set.
+instance Instruction X86.Instr where
+   regUsageOfInstr         = X86.regUsageOfInstr
+   patchRegsOfInstr        = X86.patchRegsOfInstr
+   isJumpishInstr          = X86.isJumpishInstr
+   jumpDestsOfInstr        = X86.jumpDestsOfInstr
+   patchJumpInstr          = X86.patchJumpInstr
+   mkSpillInstr            = X86.mkSpillInstr
+   mkLoadInstr             = X86.mkLoadInstr
+   takeDeltaInstr          = X86.takeDeltaInstr
+   isMetaInstr             = X86.isMetaInstr
+   mkRegRegMoveInstr       = X86.mkRegRegMoveInstr
+   takeRegRegMoveInstr     = X86.takeRegRegMoveInstr
+   mkJumpInstr             = X86.mkJumpInstr
+   mkStackAllocInstr       = X86.mkStackAllocInstr
+   mkStackDeallocInstr     = X86.mkStackDeallocInstr
+   pprInstr                = X86.pprInstr
+
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 85343f0666..51ee9ffce9 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -46,11 +46,11 @@ import GHC.CmmToAsm.X86.RegInfo
 
 import GHC.Platform.Regs
 import GHC.CmmToAsm.CPrim
+import GHC.CmmToAsm.Types
 import GHC.Cmm.DebugBlock
    ( DebugBlock(..), UnwindPoint(..), UnwindTable
    , UnwindExpr(UwReg), toUnwindExpr
    )
-import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.PIC
 import GHC.CmmToAsm.Monad
    ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index ae9d45462e..caf50ce2fc 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -9,10 +9,31 @@
 -----------------------------------------------------------------------------
 
 module GHC.CmmToAsm.X86.Instr
-   ( Instr(..), Operand(..), PrefetchVariant(..), JumpDest(..)
-   , getJumpDestBlockId, canShortcut, shortcutStatics
-   , shortcutJump, allocMoreStack
-   , maxSpillSlots, archWordFormat
+   ( Instr(..)
+   , Operand(..)
+   , PrefetchVariant(..)
+   , JumpDest(..)
+   , getJumpDestBlockId
+   , canShortcut
+   , shortcutStatics
+   , shortcutJump
+   , allocMoreStack
+   , maxSpillSlots
+   , archWordFormat
+   , takeRegRegMoveInstr
+   , regUsageOfInstr
+   , takeDeltaInstr
+   , mkLoadInstr
+   , mkJumpInstr
+   , mkStackAllocInstr
+   , mkStackDeallocInstr
+   , mkSpillInstr
+   , mkRegRegMoveInstr
+   , jumpDestsOfInstr
+   , patchRegsOfInstr
+   , patchJumpInstr
+   , isMetaInstr
+   , isJumpishInstr
    )
 where
 
@@ -22,8 +43,10 @@ import GHC.Prelude
 
 import GHC.CmmToAsm.X86.Cond
 import GHC.CmmToAsm.X86.Regs
-import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Format
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Utils
+import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 import GHC.CmmToAsm.Reg.Target
@@ -39,11 +62,11 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Platform
 
-import GHC.Types.Basic (Alignment)
 import GHC.Cmm.CLabel
 import GHC.Types.Unique.Set
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
+import GHC.Types.Basic (Alignment)
 import GHC.Cmm.DebugBlock (UnwindTable)
 
 import Control.Monad
@@ -56,24 +79,6 @@ archWordFormat is32Bit
  | is32Bit   = II32
  | otherwise = II64
 
--- | Instruction instance for x86 instruction set.
-instance Instruction Instr where
-        regUsageOfInstr         = x86_regUsageOfInstr
-        patchRegsOfInstr        = x86_patchRegsOfInstr
-        isJumpishInstr          = x86_isJumpishInstr
-        jumpDestsOfInstr        = x86_jumpDestsOfInstr
-        patchJumpInstr          = x86_patchJumpInstr
-        mkSpillInstr            = x86_mkSpillInstr
-        mkLoadInstr             = x86_mkLoadInstr
-        takeDeltaInstr          = x86_takeDeltaInstr
-        isMetaInstr             = x86_isMetaInstr
-        mkRegRegMoveInstr       = x86_mkRegRegMoveInstr
-        takeRegRegMoveInstr     = x86_takeRegRegMoveInstr
-        mkJumpInstr             = x86_mkJumpInstr
-        mkStackAllocInstr       = x86_mkStackAllocInstr
-        mkStackDeallocInstr     = x86_mkStackDeallocInstr
-
-
 -- -----------------------------------------------------------------------------
 -- Intel x86 instructions
 
@@ -345,8 +350,8 @@ data Operand
 
 -- | Returns which registers are read and written as a (read, written)
 -- pair.
-x86_regUsageOfInstr :: Platform -> Instr -> RegUsage
-x86_regUsageOfInstr platform instr
+regUsageOfInstr :: Platform -> Instr -> RegUsage
+regUsageOfInstr platform instr
  = case instr of
     MOV    _ src dst    -> usageRW src dst
     CMOV _ _ src dst    -> mkRU (use_R src [dst]) [dst]
@@ -430,7 +435,7 @@ x86_regUsageOfInstr platform instr
 
     -- note: might be a better way to do this
     PREFETCH _  _ src -> mkRU (use_R src []) []
-    LOCK i              -> x86_regUsageOfInstr platform i
+    LOCK i              -> regUsageOfInstr platform i
     XADD _ src dst      -> usageMM src dst
     CMPXCHG _ src dst   -> usageRMM src dst (OpReg eax)
     XCHG _ src dst      -> usageMM src (OpReg dst)
@@ -514,8 +519,8 @@ interesting _        (RegReal (RealRegPair{}))   = panic "X86.interesting: no re
 
 -- | Applies the supplied function to all registers in instructions.
 -- Typically used to change virtual registers to real registers.
-x86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
-x86_patchRegsOfInstr instr env
+patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
+patchRegsOfInstr instr env
  = case instr of
     MOV  fmt src dst     -> patch2 (MOV  fmt) src dst
     CMOV cc fmt src dst  -> CMOV cc fmt (patchOp src) (env dst)
@@ -590,7 +595,7 @@ x86_patchRegsOfInstr instr env
 
     PREFETCH lvl format src -> PREFETCH lvl format (patchOp src)
 
-    LOCK i               -> LOCK (x86_patchRegsOfInstr i env)
+    LOCK i               -> LOCK (patchRegsOfInstr i env)
     XADD fmt src dst     -> patch2 (XADD fmt) src dst
     CMPXCHG fmt src dst  -> patch2 (CMPXCHG fmt) src dst
     XCHG fmt src dst     -> XCHG fmt (patchOp src) (env dst)
@@ -621,10 +626,10 @@ x86_patchRegsOfInstr instr env
 
 
 --------------------------------------------------------------------------------
-x86_isJumpishInstr
+isJumpishInstr
         :: Instr -> Bool
 
-x86_isJumpishInstr instr
+isJumpishInstr instr
  = case instr of
         JMP{}           -> True
         JXX{}           -> True
@@ -634,21 +639,21 @@ x86_isJumpishInstr instr
         _               -> False
 
 
-x86_jumpDestsOfInstr
+jumpDestsOfInstr
         :: Instr
         -> [BlockId]
 
-x86_jumpDestsOfInstr insn
+jumpDestsOfInstr insn
   = case insn of
         JXX _ id        -> [id]
         JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]
         _               -> []
 
 
-x86_patchJumpInstr
+patchJumpInstr
         :: Instr -> (BlockId -> BlockId) -> Instr
 
-x86_patchJumpInstr insn patchF
+patchJumpInstr insn patchF
   = case insn of
         JXX cc id       -> JXX cc (patchF id)
         JMP_TBL op ids section lbl
@@ -664,14 +669,14 @@ x86_patchJumpInstr insn patchF
 
 -- -----------------------------------------------------------------------------
 -- | Make a spill instruction.
-x86_mkSpillInstr
+mkSpillInstr
     :: NCGConfig
     -> Reg      -- register to spill
     -> Int      -- current stack delta
     -> Int      -- spill slot to use
     -> Instr
 
-x86_mkSpillInstr config reg delta slot
+mkSpillInstr config reg delta slot
   = let off     = spillSlotToOffset platform slot - delta
     in
     case targetClassOfReg platform reg of
@@ -683,21 +688,21 @@ x86_mkSpillInstr config reg delta slot
           is32Bit = target32Bit platform
 
 -- | Make a spill reload instruction.
-x86_mkLoadInstr
+mkLoadInstr
     :: NCGConfig
     -> Reg      -- register to load
     -> Int      -- current stack delta
     -> Int      -- spill slot to use
     -> Instr
 
-x86_mkLoadInstr config reg delta slot
+mkLoadInstr config reg delta slot
   = let off     = spillSlotToOffset platform slot - delta
     in
         case targetClassOfReg platform reg of
               RcInteger -> MOV (archWordFormat is32Bit)
                                (OpAddr (spRel platform off)) (OpReg reg)
               RcDouble  -> MOV FF64 (OpAddr (spRel platform off)) (OpReg reg)
-              _           -> panic "X86.x86_mkLoadInstr"
+              _           -> panic "X86.mkLoadInstr"
     where platform = ncgPlatform config
           is32Bit = target32Bit platform
 
@@ -725,21 +730,21 @@ spillSlotToOffset platform slot
 --------------------------------------------------------------------------------
 
 -- | See if this instruction is telling us the current C stack delta
-x86_takeDeltaInstr
+takeDeltaInstr
         :: Instr
         -> Maybe Int
 
-x86_takeDeltaInstr instr
+takeDeltaInstr instr
  = case instr of
         DELTA i         -> Just i
         _               -> Nothing
 
 
-x86_isMetaInstr
+isMetaInstr
         :: Instr
         -> Bool
 
-x86_isMetaInstr instr
+isMetaInstr instr
  = case instr of
         COMMENT{}       -> True
         LOCATION{}      -> True
@@ -757,18 +762,18 @@ x86_isMetaInstr instr
 --      floating point and integer regs. If we need to do that then we
 --      have to go via memory.
 --
-x86_mkRegRegMoveInstr
+mkRegRegMoveInstr
     :: Platform
     -> Reg
     -> Reg
     -> Instr
 
-x86_mkRegRegMoveInstr platform src dst
+mkRegRegMoveInstr platform src dst
  = case targetClassOfReg platform src of
         RcInteger -> case platformArch platform of
                      ArchX86    -> MOV II32 (OpReg src) (OpReg dst)
                      ArchX86_64 -> MOV II64 (OpReg src) (OpReg dst)
-                     _          -> panic "x86_mkRegRegMoveInstr: Bad arch"
+                     _          -> panic "X86.mkRegRegMoveInstr: Bad arch"
         RcDouble    ->  MOV FF64 (OpReg src) (OpReg dst)
         -- this code is the lie we tell ourselves because both float and double
         -- use the same register class.on x86_64 and x86 32bit with SSE2,
@@ -779,22 +784,22 @@ x86_mkRegRegMoveInstr platform src dst
 --      The register allocator attempts to eliminate reg->reg moves whenever it can,
 --      by assigning the src and dest temporaries to the same real register.
 --
-x86_takeRegRegMoveInstr
+takeRegRegMoveInstr
         :: Instr
         -> Maybe (Reg,Reg)
 
-x86_takeRegRegMoveInstr (MOV _ (OpReg r1) (OpReg r2))
+takeRegRegMoveInstr (MOV _ (OpReg r1) (OpReg r2))
         = Just (r1,r2)
 
-x86_takeRegRegMoveInstr _  = Nothing
+takeRegRegMoveInstr _  = Nothing
 
 
 -- | Make an unconditional branch instruction.
-x86_mkJumpInstr
+mkJumpInstr
         :: BlockId
         -> [Instr]
 
-x86_mkJumpInstr id
+mkJumpInstr id
         = [JXX ALWAYS id]
 
 -- Note [Windows stack layout]
@@ -837,11 +842,11 @@ needs_probe_call platform amount
                     _          -> False
      _         -> False
 
-x86_mkStackAllocInstr
+mkStackAllocInstr
         :: Platform
         -> Int
         -> [Instr]
-x86_mkStackAllocInstr platform amount
+mkStackAllocInstr platform amount
   = case platformOS platform of
       OSMinGW32 ->
         -- These will clobber AX but this should be ok because
@@ -880,22 +885,22 @@ x86_mkStackAllocInstr platform amount
                            [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp)
                            , TEST II64 (OpReg rsp) (OpReg rsp)
                            ]
-            _ -> panic "x86_mkStackAllocInstr"
+            _ -> panic "X86.mkStackAllocInstr"
       _       ->
         case platformArch platform of
           ArchX86    -> [ SUB II32 (OpImm (ImmInt amount)) (OpReg esp) ]
           ArchX86_64 -> [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp) ]
-          _ -> panic "x86_mkStackAllocInstr"
+          _ -> panic "X86.mkStackAllocInstr"
 
-x86_mkStackDeallocInstr
+mkStackDeallocInstr
         :: Platform
         -> Int
         -> [Instr]
-x86_mkStackDeallocInstr platform amount
+mkStackDeallocInstr platform amount
   = case platformArch platform of
       ArchX86    -> [ADD II32 (OpImm (ImmInt amount)) (OpReg esp)]
       ArchX86_64 -> [ADD II64 (OpImm (ImmInt amount)) (OpReg rsp)]
-      _ -> panic "x86_mkStackDeallocInstr"
+      _ -> panic "X86.mkStackDeallocInstr"
 
 
 --
@@ -976,7 +981,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
       insert_dealloc insn r = case insn of
          JMP _ _     -> dealloc ++ (insn : r)
          JXX_GBL _ _ -> panic "insert_dealloc: cannot handle JXX_GBL"
-         _other      -> x86_patchJumpInstr insn retarget : r
+         _other      -> patchJumpInstr insn retarget : r
            where retarget b = fromMaybe b (mapLookup b new_blockmap)
 
       new_code = concatMap insert_stack_insns code
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index a733290733..410eddbf85 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -8,7 +8,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 module GHC.CmmToAsm.X86.Ppr (
         pprNatCmmDecl,
         pprData,
@@ -24,25 +23,27 @@ where
 
 import GHC.Prelude
 
+import GHC.Platform
+import GHC.Platform.Reg
+
 import GHC.CmmToAsm.X86.Regs
 import GHC.CmmToAsm.X86.Instr
 import GHC.CmmToAsm.X86.Cond
-import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Config
 import GHC.CmmToAsm.Format
-import GHC.Platform.Reg
+import GHC.CmmToAsm.Types
+import GHC.CmmToAsm.Utils
 import GHC.CmmToAsm.Ppr
 
-
+import GHC.Cmm              hiding (topInfoTable)
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
-import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
-import GHC.Driver.Session
-import GHC.Cmm              hiding (topInfoTable)
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
+
+import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
 import GHC.Types.Unique ( pprUniqueAlways )
-import GHC.Platform
+
 import GHC.Data.FastString
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
@@ -270,11 +271,6 @@ pprAlign platform alignment
         log2 8 = 3
         log2 n = 1 + log2 (n `quot` 2)
 
-instance Outputable Instr where
-    ppr instr = sdocWithDynFlags $ \dflags ->
-                  pprInstr (targetPlatform dflags) instr
-
-
 pprReg :: Platform -> Format -> Reg -> SDoc
 pprReg platform f r
   = case r of
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 2c2d2f4e26..9a12e16d53 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -587,18 +587,23 @@ Library
             GHC.Platform.Reg.Class
             GHC.CmmToAsm.PIC
             GHC.CmmToAsm.CPrim
+            GHC.CmmToAsm.Types
+            GHC.CmmToAsm.Utils
+            GHC.CmmToAsm.X86
             GHC.CmmToAsm.X86.Regs
             GHC.CmmToAsm.X86.RegInfo
             GHC.CmmToAsm.X86.Instr
             GHC.CmmToAsm.X86.Cond
             GHC.CmmToAsm.X86.Ppr
             GHC.CmmToAsm.X86.CodeGen
+            GHC.CmmToAsm.PPC
             GHC.CmmToAsm.PPC.Regs
             GHC.CmmToAsm.PPC.RegInfo
             GHC.CmmToAsm.PPC.Instr
             GHC.CmmToAsm.PPC.Cond
             GHC.CmmToAsm.PPC.Ppr
             GHC.CmmToAsm.PPC.CodeGen
+            GHC.CmmToAsm.SPARC
             GHC.CmmToAsm.SPARC.Base
             GHC.CmmToAsm.SPARC.Regs
             GHC.CmmToAsm.SPARC.Imm
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index b4495f5d34..05ce9147d9 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -23,6 +23,7 @@ module Main where
 import qualified GHC.CmmToAsm.Reg.Graph.Stats as Color
 import qualified GHC.CmmToAsm.Reg.Linear.Base as Linear
 import qualified GHC.CmmToAsm.X86.Instr as X86.Instr
+import qualified GHC.CmmToAsm.X86 as X86
 import GHC.Driver.Main
 import GHC.StgToCmm.CgUtils
 import GHC.CmmToAsm
@@ -175,7 +176,7 @@ runTests dflags us = testGraphNoSpills dflags noSpillsCmmFile us >>= \res ->
 testGraphNoSpills :: DynFlags -> FilePath -> UniqSupply -> IO Bool
 testGraphNoSpills dflags' path us = do
         colorStats <- fst . concatTupledMaybes <$>
-                        compileCmmForRegAllocStats dflags path x86NcgImpl us
+                        compileCmmForRegAllocStats dflags path X86.ncgX86 us
 
         assertIO "testGraphNoSpills: color stats should not be empty"
                         $ not (null colorStats)