Remove OldCmm, convert backends to consume new Cmm

This removes the OldCmm data type and the CmmCvt pass that converts
new Cmm to OldCmm.  The backends (NCGs, LLVM and C) have all been
converted to consume new Cmm.

The main difference between the two data types is that conditional
branches in new Cmm have both true/false successors, whereas in OldCmm
the false case was a fallthrough.  To generate slightly better code we
occasionally need to invert a conditional to ensure that the
branch-not-taken becomes a fallthrough; this was previously done in
CmmCvt, and it is now done in CmmContFlowOpt.

We could go further and use the Hoopl Block representation for native
code, which would mean that we could use Hoopl's postorderDfs and
analyses for native code, but for now I've left it as is, using the
old ListGraph representation for native code.

35 files changed, 277 insertions, 257 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 23aca9293c..7710691457 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -7,6 +7,7 @@
 -- -----------------------------------------------------------------------------
 
 \begin{code}
+{-# LANGUAGE GADTs #-}
 module AsmCodeGen ( nativeCodeGen ) where
 
 #include "HsVersions.h"
@@ -50,9 +51,11 @@ import NCGMonad
 
 import BlockId
 import CgUtils          ( fixStgRegisters )
-import OldCmm
+import Cmm
+import CmmUtils
+import Hoopl
 import CmmOpt           ( cmmMachOpFold )
-import OldPprCmm
+import PprCmm
 import CLabel
 
 import UniqFM
@@ -290,8 +293,8 @@ nativeCodeGen' dflags ncgImpl h us cmms
                 | gopt Opt_SplitObjs dflags = split_marker : tops
                 | otherwise                 = tops
 
-        split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] (ListGraph [])
-
+        split_marker = CmmProc mapEmpty mkSplitMarkerLabel []
+                               (ofBlockList (panic "split_marker_entry") [])
 
 cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
               => DynFlags
@@ -878,9 +881,9 @@ Ideas for other things we could do (put these in Hoopl please!):
 
 cmmToCmm :: DynFlags -> RawCmmDecl -> (RawCmmDecl, [CLabel])
 cmmToCmm _ top@(CmmData _ _) = (top, [])
-cmmToCmm dflags (CmmProc info lbl live (ListGraph blocks)) = runCmmOpt dflags $ do
-  blocks' <- mapM cmmBlockConFold blocks
-  return $ CmmProc info lbl live (ListGraph blocks')
+cmmToCmm dflags (CmmProc info lbl live graph) = runCmmOpt dflags $ do
+  blocks' <- mapM cmmBlockConFold (toBlockList graph)
+  return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks')
 
 newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #))
 
@@ -903,10 +906,13 @@ runCmmOpt :: DynFlags -> CmmOptM a -> (a, [CLabel])
 runCmmOpt dflags (CmmOptM f) = case f ([], dflags) of
                         (# result, imports #) -> (result, imports)
 
-cmmBlockConFold :: CmmBasicBlock -> CmmOptM CmmBasicBlock
-cmmBlockConFold (BasicBlock id stmts) = do
+cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock
+cmmBlockConFold block = do
+  let (entry, middle, last) = blockSplit block
+      stmts = blockToList middle
   stmts' <- mapM cmmStmtConFold stmts
-  return $ BasicBlock id stmts'
+  last' <- cmmStmtConFold last
+  return $ blockJoin entry (blockFromList stmts') last'
 
 -- This does three optimizations, but they're very quick to check, so we don't
 -- bother turning them off even when the Hoopl code is active.  Since
@@ -917,13 +923,13 @@ cmmBlockConFold (BasicBlock id stmts) = do
 -- We might be tempted to skip this step entirely of not Opt_PIC, but
 -- there is some PowerPC code for the non-PIC case, which would also
 -- have to be separated.
-cmmStmtConFold :: CmmStmt -> CmmOptM CmmStmt
+cmmStmtConFold :: CmmNode e x -> CmmOptM (CmmNode e x)
 cmmStmtConFold stmt
    = case stmt of
         CmmAssign reg src
            -> do src' <- cmmExprConFold DataReference src
                  return $ case src' of
-                   CmmReg reg' | reg == reg' -> CmmNop
+                   CmmReg reg' | reg == reg' -> CmmComment (fsLit "nop")
                    new_src -> CmmAssign reg new_src
 
         CmmStore addr src
@@ -931,35 +937,27 @@ cmmStmtConFold stmt
                  src'  <- cmmExprConFold DataReference src
                  return $ CmmStore addr' src'
 
-        CmmJump addr live
+        CmmCall { cml_target = addr }
            -> do addr' <- cmmExprConFold JumpReference addr
-                 return $ CmmJump addr' live
+                 return $ stmt { cml_target = addr' }
 
-        CmmCall target regs args returns
+        CmmUnsafeForeignCall target regs args
            -> do target' <- case target of
-                              CmmCallee e conv -> do
+                              ForeignTarget e conv -> do
                                 e' <- cmmExprConFold CallReference e
-                                return $ CmmCallee e' conv
-                              op@(CmmPrim _ Nothing) ->
-                                return op
-                              CmmPrim op (Just stmts) ->
-                                do stmts' <- mapM cmmStmtConFold stmts
-                                   return $ CmmPrim op (Just stmts')
-                 args' <- mapM (\(CmmHinted arg hint) -> do
-                                  arg' <- cmmExprConFold DataReference arg
-                                  return (CmmHinted arg' hint)) args
-                 return $ CmmCall target' regs args' returns
-
-        CmmCondBranch test dest
+                                return $ ForeignTarget e' conv
+                              PrimTarget _ ->
+                                return target
+                 args' <- mapM (cmmExprConFold DataReference) args
+                 return $ CmmUnsafeForeignCall target' regs args'
+
+        CmmCondBranch test true false
            -> do test' <- cmmExprConFold DataReference test
                  dflags <- getDynFlags
                  return $ case test' of
-                   CmmLit (CmmInt 0 _) ->
-                     CmmComment (mkFastString ("deleted: " ++
-                                        showSDoc dflags (pprStmt stmt)))
-
-                   CmmLit (CmmInt _ _) -> CmmBranch dest
-                   _other -> CmmCondBranch test' dest
+                   CmmLit (CmmInt 0 _) -> CmmBranch false
+                   CmmLit (CmmInt _ _) -> CmmBranch true
+                   _other -> CmmCondBranch test' true false
 
         CmmSwitch expr ids
            -> do expr' <- cmmExprConFold DataReference expr
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index 86f5ae435d..48d6a33d79 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -2,9 +2,12 @@
 module Instruction (
         RegUsage(..),
         noUsage,
+        GenBasicBlock(..), blockId,
+        ListGraph(..),
         NatCmm,
         NatCmmDecl,
         NatBasicBlock,
+        topInfoTable,
         Instruction(..)
 )
 
@@ -14,8 +17,9 @@ import Reg
 
 import BlockId
 import DynFlags
-import OldCmm
+import Cmm hiding (topInfoTable)
 import Platform
+import Outputable
 
 -- | Holds a list of source and destination registers used by a
 --      particular instruction.
@@ -34,7 +38,6 @@ data RegUsage
 noUsage :: RegUsage
 noUsage  = RU [] []
 
-
 -- Our flavours of the Cmm types
 -- Type synonyms for Cmm populated with native code
 type NatCmm instr
@@ -54,6 +57,13 @@ type NatBasicBlock instr
         = GenBasicBlock instr
 
 
+-- | Returns the info table associated with the CmmDecl's entry point,
+-- if any.
+topInfoTable :: GenCmmDecl a (BlockEnv i) (ListGraph b) -> Maybe i
+topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
+  = mapLookup (blockId b) infos
+topInfoTable _
+  = Nothing
 
 
 -- | Common things that we can do with instructions, on all architectures.
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 69f3e29add..e346e7b365 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -59,7 +59,7 @@ import NCGMonad
 
 
 import Hoopl
-import OldCmm
+import Cmm
 import CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
                           mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
                           dynamicLinkerLabelInfo, mkPicBaseLabel,
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 848c7f933c..5e05047f34 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -12,6 +12,7 @@
 -- (c) the #if blah_TARGET_ARCH} things, the
 -- structure should not be too overwhelming.
 
+{-# LANGUAGE GADTs #-}
 module PPC.CodeGen (
         cmmTopCodeGen,
         generateJumpTableForInstr,
@@ -42,8 +43,10 @@ import Platform
 -- Our intermediate code:
 import BlockId
 import PprCmm           ( pprExpr )
-import OldCmm
+import Cmm
+import CmmUtils
 import CLabel
+import Hoopl
 
 -- The rest:
 import OrdList
@@ -71,7 +74,8 @@ cmmTopCodeGen
         :: RawCmmDecl
         -> NatM [NatCmmDecl CmmStatics Instr]
 
-cmmTopCodeGen (CmmProc info lab live (ListGraph blocks)) = do
+cmmTopCodeGen (CmmProc info lab live graph) = do
+  let blocks = toBlockListEntryFirst graph
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
   dflags <- getDynFlags
@@ -86,12 +90,16 @@ cmmTopCodeGen (CmmData sec dat) = do
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
 
 basicBlockCodeGen
-        :: CmmBasicBlock
+        :: Block CmmNode C C
         -> NatM ( [NatBasicBlock Instr]
                 , [NatCmmDecl CmmStatics Instr])
 
-basicBlockCodeGen (BasicBlock id stmts) = do
-  instrs <- stmtsToInstrs stmts
+basicBlockCodeGen block = do
+  let (CmmEntry id, nodes, tail)  = blockSplit block
+      stmts = blockToList nodes
+  mid_instrs <- stmtsToInstrs stmts
+  tail_instrs <- stmtToInstrs tail
+  let instrs = mid_instrs `appOL` tail_instrs
   -- code generation may introduce new basic block boundaries, which
   -- are indicated by the NEWBLOCK instruction.  We must split up the
   -- instruction stream into basic blocks again.  Also, we extract
@@ -107,16 +115,15 @@ basicBlockCodeGen (BasicBlock id stmts) = do
           = (instr:instrs, blocks, statics)
   return (BasicBlock id top : other_blocks, statics)
 
-stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
+stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
 stmtsToInstrs stmts
    = do instrss <- mapM stmtToInstrs stmts
         return (concatOL instrss)
 
-stmtToInstrs :: CmmStmt -> NatM InstrBlock
+stmtToInstrs :: CmmNode e x -> NatM InstrBlock
 stmtToInstrs stmt = do
   dflags <- getDynFlags
   case stmt of
-    CmmNop         -> return nilOL
     CmmComment s   -> return (unitOL (COMMENT s))
 
     CmmAssign reg src
@@ -135,16 +142,18 @@ stmtToInstrs stmt = do
         where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
-    CmmCall target result_regs args _
+    CmmUnsafeForeignCall target result_regs args
        -> genCCall target result_regs args
 
     CmmBranch id          -> genBranch id
-    CmmCondBranch arg id  -> genCondJump id arg
+    CmmCondBranch arg true false -> do b1 <- genCondJump true arg
+                                       b2 <- genBranch false
+                                       return (b1 `appOL` b2)
     CmmSwitch arg ids     -> do dflags <- getDynFlags
                                 genSwitch dflags arg ids
-    CmmJump arg _         -> genJump arg
-    CmmReturn             ->
-      panic "stmtToInstrs: return statement should have been cps'd away"
+    CmmCall { cml_target = arg } -> genJump arg
+    _ ->
+      panic "stmtToInstrs: statement should have been cps'd away"
 
 
 --------------------------------------------------------------------------------
@@ -837,9 +846,9 @@ genCondJump id bool = do
 -- (If applicable) Do not fill the delay slots here; you will confuse the
 -- register allocator.
 
-genCCall :: CmmCallTarget            -- function to call
-         -> [HintedCmmFormal]        -- where to put the result
-         -> [HintedCmmActual]        -- arguments (of mixed type)
+genCCall :: ForeignTarget            -- function to call
+         -> [CmmFormal]        -- where to put the result
+         -> [CmmActual]        -- arguments (of mixed type)
          -> NatM InstrBlock
 genCCall target dest_regs argsAndHints
  = do dflags <- getDynFlags
@@ -854,9 +863,9 @@ data GenCCallPlatform = GCPLinux | GCPDarwin
 genCCall'
     :: DynFlags
     -> GenCCallPlatform
-    -> CmmCallTarget            -- function to call
-    -> [HintedCmmFormal]        -- where to put the result
-    -> [HintedCmmActual]        -- arguments (of mixed type)
+    -> ForeignTarget            -- function to call
+    -> [CmmFormal]        -- where to put the result
+    -> [CmmActual]        -- arguments (of mixed type)
     -> NatM InstrBlock
 
 {-
@@ -897,13 +906,13 @@ genCCall'
 -}
 
 
-genCCall' _ _ (CmmPrim MO_WriteBarrier _) _ _
+genCCall' _ _ (PrimTarget MO_WriteBarrier) _ _
  = return $ unitOL LWSYNC
 
-genCCall' _ _ (CmmPrim _ (Just stmts)) _ _
-    = stmtsToInstrs stmts
+genCCall' _ _ (PrimTarget MO_Touch) _ _
+ = return $ nilOL
 
-genCCall' dflags gcp target dest_regs argsAndHints
+genCCall' dflags gcp target dest_regs args0
   = ASSERT (not $ any (`elem` [II16]) $ map cmmTypeSize argReps)
         -- we rely on argument promotion in the codeGen
     do
@@ -915,9 +924,9 @@ genCCall' dflags gcp target dest_regs argsAndHints
                                                         (toOL []) []
 
         (labelOrExpr, reduceToFF32) <- case target of
-            CmmCallee (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False)
-            CmmCallee expr _ -> return  (Right expr, False)
-            CmmPrim mop _ -> outOfLineMachOp mop
+            ForeignTarget (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False)
+            ForeignTarget expr _ -> return  (Right expr, False)
+            PrimTarget mop -> outOfLineMachOp mop
 
         let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
             codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
@@ -948,17 +957,16 @@ genCCall' dflags gcp target dest_regs argsAndHints
                                 GCPLinux -> roundTo 16 finalStack
 
         -- need to remove alignment information
-        argsAndHints' | CmmPrim mop _ <- target,
+        args | PrimTarget mop <- target,
                         (mop == MO_Memcpy ||
                          mop == MO_Memset ||
                          mop == MO_Memmove)
-                      = init argsAndHints
+                      = init args0
 
                       | otherwise
-                      = argsAndHints
+                      = args0
 
-        args = map hintlessCmm argsAndHints'
-        argReps = map (cmmExprType dflags) args
+        argReps = map (cmmExprType dflags) args0
 
         roundTo a x | x `mod` a == 0 = x
                     | otherwise = x + a - (x `mod` a)
@@ -1086,7 +1094,7 @@ genCCall' dflags gcp target dest_regs argsAndHints
         moveResult reduceToFF32 =
             case dest_regs of
                 [] -> nilOL
-                [CmmHinted dest _hint]
+                [dest]
                     | reduceToFF32 && isFloat32 rep   -> unitOL (FRSP r_dest f1)
                     | isFloat32 rep || isFloat64 rep -> unitOL (MR r_dest f1)
                     | isWord64 rep -> toOL [MR (getHiVRegFromLo r_dest) r3,
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 1f5e809abb..40827d4a6f 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -36,7 +36,7 @@ import Reg
 import CodeGen.Platform
 import BlockId
 import DynFlags
-import OldCmm
+import Cmm
 import FastString
 import CLabel
 import Outputable
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 045ce8d48e..cbeabdd8a9 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -30,7 +30,7 @@ import Reg
 import RegClass
 import TargetReg
 
-import OldCmm
+import Cmm hiding (topInfoTable)
 import BlockId
 
 import CLabel
diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs
index 2b74d1daea..0fd93e17d0 100644
--- a/compiler/nativeGen/PPC/RegInfo.hs
+++ b/compiler/nativeGen/PPC/RegInfo.hs
@@ -29,7 +29,7 @@ where
 import PPC.Instr
 
 import BlockId
-import OldCmm
+import Cmm
 import CLabel
 
 import Unique
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index d4123aca84..f92351bd22 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -50,7 +50,7 @@ import Reg
 import RegClass
 import Size
 
-import OldCmm
+import Cmm
 import CLabel           ( CLabel )
 import Unique
 
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
index c4fb7ac378..8a0d2165bb 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
@@ -19,7 +19,7 @@ import RegAlloc.Liveness
 import Instruction
 import Reg
 
-import OldCmm
+import Cmm
 import Bag
 import Digraph
 import UniqFM
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 25bd313826..dbfde5c25b 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -11,7 +11,7 @@ where
 import RegAlloc.Liveness
 import Instruction
 import Reg
-import OldCmm hiding (RegSet)
+import Cmm hiding (RegSet)
 import BlockId
 
 import State
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 7f86b9a884..a216d975dc 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -39,7 +39,7 @@ import Instruction
 import Reg
 
 import BlockId
-import OldCmm
+import Cmm
 import UniqSet
 import UniqFM
 import Unique
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 879597fd88..a2d9e1a91a 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -31,7 +31,7 @@ import Reg
 import GraphBase
 
 import BlockId
-import OldCmm
+import Cmm
 import UniqFM
 import UniqSet
 import Digraph		(flattenSCCs)
diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index f85cdb7eff..61a8400faa 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -27,8 +27,7 @@ import RegClass
 import Reg
 import TargetReg
 
-import OldCmm
-import OldPprCmm()
+import PprCmm()
 import Outputable
 import UniqFM
 import UniqSet
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 6294743c48..768ddab788 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -17,7 +17,6 @@ import Instruction
 import Reg
 
 import BlockId
-import OldCmm  hiding (RegSet)
 import Digraph
 import DynFlags
 import Outputable
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index fc5b992603..fa71457808 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -116,7 +116,7 @@ import Instruction
 import Reg
 
 import BlockId
-import OldCmm hiding (RegSet)
+import Cmm hiding (RegSet)
 
 import Digraph
 import DynFlags
@@ -743,12 +743,13 @@ allocateRegsAndSpill reading keep spills alloc (r:rs)
                 Just (InMem slot) | reading   -> doSpill (ReadMem slot)
                                   | otherwise -> doSpill WriteMem
                 Nothing | reading   ->
-                   -- pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr r)
-                   -- ToDo: This case should be a panic, but we
-                   -- sometimes see an unreachable basic block which
-                   -- triggers this because the register allocator
-                   -- will start with an empty assignment.
-                   doSpill WriteNew
+                   pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr r)
+                   -- NOTE: if the input to the NCG contains some
+                   -- unreachable blocks with junk code, this panic
+                   -- might be triggered.  Make sure you only feed
+                   -- sensible code into the NCG.  In CmmPipeline we
+                   -- call removeUnreachableBlocks at the end for this
+                   -- reason.
 
                         | otherwise -> doSpill WriteNew
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/Stats.hs b/compiler/nativeGen/RegAlloc/Linear/Stats.hs
index bfd196ac05..d8ca77537d 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Stats.hs
@@ -17,8 +17,6 @@ import RegAlloc.Linear.Base
 import RegAlloc.Liveness
 import Instruction
 
-import OldCmm  (GenBasicBlock(..))
-
 import UniqFM
 import Outputable
 
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 12c138897c..f49155e827 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -33,8 +33,8 @@ import Reg
 import Instruction
 
 import BlockId
-import OldCmm hiding (RegSet)
-import OldPprCmm()
+import Cmm hiding (RegSet)
+import PprCmm()
 
 import Digraph
 import DynFlags
@@ -690,10 +690,11 @@ regLiveness platform (CmmProc info lbl live sccs)
 
 -- -----------------------------------------------------------------------------
 -- | Check ordering of Blocks
---   The computeLiveness function requires SCCs to be in reverse dependent order.
---   If they're not the liveness information will be wrong, and we'll get a bad allocation.
---   Better to check for this precondition explicitly or some other poor sucker will
---   waste a day staring at bad assembly code..
+--   The computeLiveness function requires SCCs to be in reverse
+--   dependent order.  If they're not the liveness information will be
+--   wrong, and we'll get a bad allocation.  Better to check for this
+--   precondition explicitly or some other poor sucker will waste a
+--   day staring at bad assembly code..
 --
 checkIsReverseDependent
         :: Instruction instr
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index c4efdf677e..f3b70e7e61 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -6,6 +6,7 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE GADTs #-}
 module SPARC.CodeGen (
         cmmTopCodeGen,
         generateJumpTableForInstr,
@@ -38,7 +39,9 @@ import NCGMonad
 
 -- Our intermediate code:
 import BlockId
-import OldCmm
+import Cmm
+import CmmUtils
+import Hoopl
 import PIC
 import Reg
 import CLabel
@@ -59,8 +62,9 @@ import Control.Monad    ( mapAndUnzipM )
 cmmTopCodeGen :: RawCmmDecl
               -> NatM [NatCmmDecl CmmStatics Instr]
 
-cmmTopCodeGen (CmmProc info lab live (ListGraph blocks))
- = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
+cmmTopCodeGen (CmmProc info lab live graph)
+ = do let blocks = toBlockListEntryFirst graph
+      (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
 
       let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
       let tops = proc : concat statics
@@ -76,12 +80,16 @@ cmmTopCodeGen (CmmData sec dat) = do
 --      are indicated by the NEWBLOCK instruction.  We must split up the
 --      instruction stream into basic blocks again.  Also, we extract
 --      LDATAs here too.
-basicBlockCodeGen :: CmmBasicBlock
+basicBlockCodeGen :: CmmBlock
                   -> NatM ( [NatBasicBlock Instr]
                           , [NatCmmDecl CmmStatics Instr])
 
-basicBlockCodeGen cmm@(BasicBlock id stmts) = do
-  instrs <- stmtsToInstrs stmts
+basicBlockCodeGen block = do
+  let (CmmEntry id, nodes, tail)  = blockSplit block
+      stmts = blockToList nodes
+  mid_instrs <- stmtsToInstrs stmts
+  tail_instrs <- stmtToInstrs tail
+  let instrs = mid_instrs `appOL` tail_instrs
   let
         (top,other_blocks,statics)
                 = foldrOL mkBlocks ([],[],[]) instrs
@@ -97,24 +105,23 @@ basicBlockCodeGen cmm@(BasicBlock id stmts) = do
 
         -- do intra-block sanity checking
         blocksChecked
-                = map (checkBlock cmm)
+                = map (checkBlock block)
                 $ BasicBlock id top : other_blocks
 
   return (blocksChecked, statics)
 
 
 -- | Convert some Cmm statements to SPARC instructions.
-stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
+stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
 stmtsToInstrs stmts
    = do instrss <- mapM stmtToInstrs stmts
         return (concatOL instrss)
 
 
-stmtToInstrs :: CmmStmt -> NatM InstrBlock
+stmtToInstrs :: CmmNode e x -> NatM InstrBlock
 stmtToInstrs stmt = do
   dflags <- getDynFlags
   case stmt of
-    CmmNop         -> return nilOL
     CmmComment s   -> return (unitOL (COMMENT s))
 
     CmmAssign reg src
@@ -131,17 +138,19 @@ stmtToInstrs stmt = do
         where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
-    CmmCall target result_regs args _
+    CmmUnsafeForeignCall target result_regs args
        -> genCCall target result_regs args
 
     CmmBranch   id              -> genBranch id
-    CmmCondBranch arg id        -> genCondJump id arg
+    CmmCondBranch arg true false -> do b1 <- genCondJump true arg
+                                       b2 <- genBranch false
+                                       return (b1 `appOL` b2)
     CmmSwitch   arg ids         -> do dflags <- getDynFlags
                                       genSwitch dflags arg ids
-    CmmJump     arg _           -> genJump arg
+    CmmCall { cml_target = arg } -> genJump arg
 
-    CmmReturn
-     -> panic "stmtToInstrs: return statement should have been cps'd away"
+    _
+     -> panic "stmtToInstrs: statement should have been cps'd away"
 
 
 {-
@@ -369,9 +378,9 @@ generateJumpTableForInstr _ _ = Nothing
 -}
 
 genCCall
-    :: CmmCallTarget            -- function to call
-    -> [HintedCmmFormal]        -- where to put the result
-    -> [HintedCmmActual]        -- arguments (of mixed type)
+    :: ForeignTarget            -- function to call
+    -> [CmmFormal]        -- where to put the result
+    -> [CmmActual]        -- arguments (of mixed type)
     -> NatM InstrBlock
 
 
@@ -382,28 +391,20 @@ genCCall
 --
 -- In the SPARC case we don't need a barrier.
 --
-genCCall (CmmPrim (MO_WriteBarrier) _) _ _
+genCCall (PrimTarget MO_WriteBarrier) _ _
  = do   return nilOL
 
-genCCall (CmmPrim _ (Just stmts)) _ _
-    = stmtsToInstrs stmts
-
-genCCall target dest_regs argsAndHints
+genCCall target dest_regs args0
  = do
         -- need to remove alignment information
-        let argsAndHints' | CmmPrim mop _ <- target,
+        let args | PrimTarget mop <- target,
                             (mop == MO_Memcpy ||
                              mop == MO_Memset ||
                              mop == MO_Memmove)
-                          = init argsAndHints
+                          = init args0
 
                           | otherwise
-                          = argsAndHints
-
-        -- strip hints from the arg regs
-        let args :: [CmmExpr]
-            args  = map hintlessCmm argsAndHints'
-
+                          = args0
 
         -- work out the arguments, and assign them to integer regs
         argcode_and_vregs       <- mapM arg_to_int_vregs args
@@ -416,14 +417,14 @@ genCCall target dest_regs argsAndHints
 
         -- deal with static vs dynamic call targets
         callinsns <- case target of
-                CmmCallee (CmmLit (CmmLabel lbl)) _ ->
+                ForeignTarget (CmmLit (CmmLabel lbl)) _ ->
                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 
-                CmmCallee expr _
+                ForeignTarget expr _
                  -> do  (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 
-                CmmPrim mop _
+                PrimTarget mop
                  -> do  res     <- outOfLineMachOp mop
                         lblOrMopExpr <- case res of
                                 Left lbl -> do
@@ -539,11 +540,11 @@ move_final (v:vs) (a:az) offset
 -- | Assign results returned from the call into their
 --      desination regs.
 --
-assign_code :: Platform -> [CmmHinted LocalReg] -> OrdList Instr
+assign_code :: Platform -> [LocalReg] -> OrdList Instr
 
 assign_code _ [] = nilOL
 
-assign_code platform [CmmHinted dest _hint]
+assign_code platform [dest]
  = let  rep     = localRegType dest
         width   = typeWidth rep
         r_dest  = getRegisterReg platform (CmmLocal dest)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
index 139064ccbd..7871569dba 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
@@ -22,7 +22,7 @@ import SPARC.Base
 import NCGMonad
 import Size
 
-import OldCmm
+import Cmm
 
 import OrdList
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs
index 367d9230ba..16384f102a 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Base.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs
@@ -30,8 +30,7 @@ import Reg
 
 import CodeGen.Platform
 import DynFlags
-import OldCmm
-import OldPprCmm ()
+import Cmm
 import Platform
 
 import Outputable
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index d459d98212..0e94d67a24 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -24,7 +24,7 @@ import SPARC.Base
 import NCGMonad
 import Size
 
-import OldCmm
+import Cmm
 
 import OrdList
 import Outputable
diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
index fa397771d7..16b9b42fcd 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
@@ -21,7 +21,7 @@ import SPARC.Ppr	()
 import Instruction
 import Reg
 import Size
-import OldCmm
+import Cmm
 
 
 import Outputable
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
index f7c7419e15..3e255365b9 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
@@ -29,7 +29,7 @@ import NCGMonad
 import Size
 import Reg
 
-import OldCmm
+import Cmm
 
 import Control.Monad (liftM)
 import DynFlags
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
index 7de92cb659..43632c676d 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
@@ -10,7 +10,7 @@ import SPARC.CodeGen.Base
 import NCGMonad
 import Reg
 
-import OldCmm
+import Cmm
 
 getSomeReg  :: CmmExpr -> NatM (Reg, InstrBlock)
 getRegister :: CmmExpr -> NatM Register
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
index 654875c497..7b39a371d7 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
@@ -28,7 +28,7 @@ import Instruction
 import Size
 import Reg
 
-import OldCmm
+import Cmm
 
 import DynFlags
 import OrdList
diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
index 7eb8bb4a53..ac8b175802 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
@@ -19,14 +19,14 @@ import SPARC.Instr
 import SPARC.Ppr	()
 import Instruction
 
-import OldCmm
+import Cmm
 
 import Outputable
 
 
 -- | Enforce intra-block invariants.
 --
-checkBlock :: CmmBasicBlock
+checkBlock :: CmmBlock
            -> NatBasicBlock Instr
            -> NatBasicBlock Instr
 
diff --git a/compiler/nativeGen/SPARC/Imm.hs b/compiler/nativeGen/SPARC/Imm.hs
index fe64738f7b..77761fcf35 100644
--- a/compiler/nativeGen/SPARC/Imm.hs
+++ b/compiler/nativeGen/SPARC/Imm.hs
@@ -15,7 +15,7 @@ module SPARC.Imm (
 
 where
 
-import OldCmm
+import Cmm
 import CLabel
 
 import Outputable
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index f55c660118..4896d414a2 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -47,7 +47,7 @@ import CLabel
 import CodeGen.Platform
 import BlockId
 import DynFlags
-import OldCmm
+import Cmm
 import FastString
 import FastBool
 import Outputable
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 9bfa3141cc..601b5288a0 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -35,8 +35,8 @@ import Reg
 import Size
 import PprBase
 
-import OldCmm
-import OldPprCmm()
+import Cmm hiding (topInfoTable)
+import PprCmm()
 import CLabel
 import BlockId
 
diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs
index 5d63fd73a1..bd66d04fa1 100644
--- a/compiler/nativeGen/SPARC/ShortcutJump.hs
+++ b/compiler/nativeGen/SPARC/ShortcutJump.hs
@@ -21,7 +21,7 @@ import SPARC.Imm
 
 import CLabel
 import BlockId
-import OldCmm
+import Cmm
 
 import Panic
 import Unique
diff --git a/compiler/nativeGen/Size.hs b/compiler/nativeGen/Size.hs
index 99e5de679b..66f7422c31 100644
--- a/compiler/nativeGen/Size.hs
+++ b/compiler/nativeGen/Size.hs
@@ -30,7 +30,7 @@ module Size (
 
 where
 
-import OldCmm
+import Cmm
 import Outputable
 
 -- It looks very like the old MachRep, but it's now of purely local
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index b3160ed2ca..36f9e2d231 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -10,6 +10,7 @@
 -- (a) the sectioning, and (b) the type signatures, the
 -- structure should not be too overwhelming.
 
+{-# LANGUAGE GADTs #-}
 module X86.CodeGen (
         cmmTopCodeGen,
         generateJumpTableForInstr,
@@ -41,8 +42,9 @@ import BasicTypes
 import BlockId
 import Module           ( primPackageId )
 import PprCmm           ()
-import OldCmm
-import OldPprCmm        ()
+import CmmUtils
+import Cmm
+import Hoopl
 import CLabel
 
 -- The rest:
@@ -93,7 +95,8 @@ cmmTopCodeGen
         :: RawCmmDecl
         -> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]
 
-cmmTopCodeGen (CmmProc info lab live (ListGraph blocks)) = do
+cmmTopCodeGen (CmmProc info lab live graph) = do
+  let blocks = toBlockListEntryFirst graph
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
   dflags <- getDynFlags
@@ -110,12 +113,16 @@ cmmTopCodeGen (CmmData sec dat) = do
 
 
 basicBlockCodeGen
-        :: CmmBasicBlock
+        :: CmmBlock
         -> NatM ( [NatBasicBlock Instr]
                 , [NatCmmDecl (Alignment, CmmStatics) Instr])
 
-basicBlockCodeGen (BasicBlock id stmts) = do
-  instrs <- stmtsToInstrs stmts
+basicBlockCodeGen block = do
+  let (CmmEntry id, nodes, tail)  = blockSplit block
+      stmts = blockToList nodes
+  mid_instrs <- stmtsToInstrs stmts
+  tail_instrs <- stmtToInstrs tail
+  let instrs = mid_instrs `appOL` tail_instrs
   -- code generation may introduce new basic block boundaries, which
   -- are indicated by the NEWBLOCK instruction.  We must split up the
   -- instruction stream into basic blocks again.  Also, we extract
@@ -132,18 +139,17 @@ basicBlockCodeGen (BasicBlock id stmts) = do
   return (BasicBlock id top : other_blocks, statics)
 
 
-stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
+stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
 stmtsToInstrs stmts
    = do instrss <- mapM stmtToInstrs stmts
         return (concatOL instrss)
 
 
-stmtToInstrs :: CmmStmt -> NatM InstrBlock
+stmtToInstrs :: CmmNode e x -> NatM InstrBlock
 stmtToInstrs stmt = do
   dflags <- getDynFlags
   is32Bit <- is32BitPlatform
   case stmt of
-    CmmNop         -> return nilOL
     CmmComment s   -> return (unitOL (COMMENT s))
 
     CmmAssign reg src
@@ -160,17 +166,21 @@ stmtToInstrs stmt = do
         where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
-    CmmCall target result_regs args _
+    CmmUnsafeForeignCall target result_regs args
        -> genCCall is32Bit target result_regs args
 
     CmmBranch id          -> genBranch id
-    CmmCondBranch arg id  -> genCondJump id arg
+    CmmCondBranch arg true false -> do b1 <- genCondJump true arg
+                                       b2 <- genBranch false
+                                       return (b1 `appOL` b2)
     CmmSwitch arg ids     -> do dflags <- getDynFlags
                                 genSwitch dflags arg ids
-    CmmJump arg gregs     -> do dflags <- getDynFlags
+    CmmCall { cml_target = arg
+            , cml_args_regs = gregs } -> do
+                                dflags <- getDynFlags
                                 genJump arg (jumpRegs dflags gregs)
-    CmmReturn             ->
-      panic "stmtToInstrs: return statement should have been cps'd away"
+    _ ->
+      panic "stmtToInstrs: statement should have been cps'd away"
 
 
 jumpRegs :: DynFlags -> [GlobalReg] -> [Reg]
@@ -1523,9 +1533,9 @@ genCondJump id bool = do
 
 genCCall
     :: Bool                     -- 32 bit platform?
-    -> CmmCallTarget            -- function to call
-    -> [HintedCmmFormal]        -- where to put the result
-    -> [HintedCmmActual]        -- arguments (of mixed type)
+    -> ForeignTarget            -- function to call
+    -> [CmmFormal]        -- where to put the result
+    -> [CmmActual]        -- arguments (of mixed type)
     -> NatM InstrBlock
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1533,10 +1543,10 @@ genCCall
 -- Unroll memcpy calls if the source and destination pointers are at
 -- least DWORD aligned and the number of bytes to copy isn't too
 -- large.  Otherwise, call C's memcpy.
-genCCall is32Bit (CmmPrim MO_Memcpy _) _
-         [CmmHinted dst _, CmmHinted src _,
-          CmmHinted (CmmLit (CmmInt n _)) _,
-          CmmHinted (CmmLit (CmmInt align _)) _]
+genCCall is32Bit (PrimTarget MO_Memcpy) _
+         [dst, src,
+          (CmmLit (CmmInt n _)),
+          (CmmLit (CmmInt align _))]
     | n <= maxInlineSizeThreshold && align .&. 3 == 0 = do
         code_dst <- getAnyReg dst
         dst_r <- getNewRegNat size
@@ -1576,11 +1586,11 @@ genCCall is32Bit (CmmPrim MO_Memcpy _) _
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
                    (ImmInteger (n - i))
 
-genCCall _ (CmmPrim MO_Memset _) _
-         [CmmHinted dst _,
-          CmmHinted (CmmLit (CmmInt c _)) _,
-          CmmHinted (CmmLit (CmmInt n _)) _,
-          CmmHinted (CmmLit (CmmInt align _)) _]
+genCCall _ (PrimTarget MO_Memset) _
+         [dst,
+          CmmLit (CmmInt c _),
+          CmmLit (CmmInt n _),
+          CmmLit (CmmInt align _)]
     | n <= maxInlineSizeThreshold && align .&. 3 == 0 = do
         code_dst <- getAnyReg dst
         dst_r <- getNewRegNat size
@@ -1615,12 +1625,14 @@ genCCall _ (CmmPrim MO_Memset _) _
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
                    (ImmInteger (n - i))
 
-genCCall _ (CmmPrim MO_WriteBarrier _) _ _ = return nilOL
+genCCall _ (PrimTarget MO_WriteBarrier) _ _ = return nilOL
         -- write barrier compiles to no code on x86/x86-64;
         -- we keep it this long in order to prevent earlier optimisations.
 
-genCCall is32Bit (CmmPrim (MO_PopCnt width) _) dest_regs@[CmmHinted dst _]
-         args@[CmmHinted src _] = do
+genCCall _ (PrimTarget MO_Touch) _ _ = return nilOL
+
+genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
+         args@[src] = do
     sse4_2 <- sse4_2Enabled
     dflags <- getDynFlags
     let platform = targetPlatform dflags
@@ -1639,7 +1651,9 @@ genCCall is32Bit (CmmPrim (MO_PopCnt width) _) dest_regs@[CmmHinted dst _]
         else do
             targetExpr <- cmmMakeDynamicReference dflags addImportNat
                           CallReference lbl
-            let target = CmmCallee targetExpr CCallConv
+            let target = ForeignTarget targetExpr (ForeignConvention CCallConv
+                                                           [NoHint] [NoHint]
+                                                           CmmMayReturn)
             genCCall is32Bit target dest_regs args
   where
     size = intSize width
@@ -1649,25 +1663,25 @@ genCCall is32Bit target dest_regs args
  | is32Bit   = genCCall32 target dest_regs args
  | otherwise = genCCall64 target dest_regs args
 
-genCCall32 :: CmmCallTarget            -- function to call
-           -> [HintedCmmFormal]        -- where to put the result
-           -> [HintedCmmActual]        -- arguments (of mixed type)
+genCCall32 :: ForeignTarget            -- function to call
+           -> [CmmFormal]        -- where to put the result
+           -> [CmmActual]        -- arguments (of mixed type)
            -> NatM InstrBlock
 genCCall32 target dest_regs args = do
   dflags <- getDynFlags
   let platform = targetPlatform dflags
   case (target, dest_regs) of
     -- void return type prim op
-    (CmmPrim op _, []) ->
+    (PrimTarget op, []) ->
         outOfLineCmmOp op Nothing args
     -- we only cope with a single result for foreign calls
-    (CmmPrim op _, [r_hinted@(CmmHinted r _)]) -> do
+    (PrimTarget op, [r]) -> do
         l1 <- getNewLabelNat
         l2 <- getNewLabelNat
         sse2 <- sse2Enabled
         if sse2
           then
-            outOfLineCmmOp op (Just r_hinted) args
+            outOfLineCmmOp op (Just r) args
           else case op of
               MO_F32_Sqrt -> actuallyInlineFloatOp GSQRT FF32 args
               MO_F64_Sqrt -> actuallyInlineFloatOp GSQRT FF64 args
@@ -1681,10 +1695,10 @@ genCCall32 target dest_regs args = do
               MO_F32_Tan  -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF32 args
               MO_F64_Tan  -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF64 args
 
-              _other_op   -> outOfLineCmmOp op (Just r_hinted) args
+              _other_op   -> outOfLineCmmOp op (Just r) args
 
        where
-        actuallyInlineFloatOp instr size [CmmHinted x _]
+        actuallyInlineFloatOp instr size [x]
               = do res <- trivialUFCode size (instr size) x
                    any <- anyReg res
                    return (any (getRegisterReg platform False (CmmLocal r)))
@@ -1693,12 +1707,12 @@ genCCall32 target dest_regs args = do
               = panic $ "genCCall32.actuallyInlineFloatOp: bad number of arguments! ("
                       ++ show (length args) ++ ")"
 
-    (CmmPrim (MO_S_QuotRem  width) _, _) -> divOp1 platform True  width dest_regs args
-    (CmmPrim (MO_U_QuotRem  width) _, _) -> divOp1 platform False width dest_regs args
-    (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 platform False width dest_regs args
-    (CmmPrim (MO_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
+    (PrimTarget (MO_S_QuotRem  width), _) -> divOp1 platform True  width dest_regs args
+    (PrimTarget (MO_U_QuotRem  width), _) -> divOp1 platform False width dest_regs args
+    (PrimTarget (MO_U_QuotRem2 width), _) -> divOp2 platform False width dest_regs args
+    (PrimTarget (MO_Add2 width), [res_h, res_l]) ->
         case args of
-        [CmmHinted arg_x _, CmmHinted arg_y _] ->
+        [arg_x, arg_y] ->
             do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
                lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
                let size = intSize width
@@ -1709,9 +1723,9 @@ genCCall32 target dest_regs args = do
                           ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
                return code
         _ -> panic "genCCall32: Wrong number of arguments/results for add2"
-    (CmmPrim (MO_U_Mul2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
+    (PrimTarget (MO_U_Mul2 width), [res_h, res_l]) ->
         case args of
-        [CmmHinted arg_x _, CmmHinted arg_y _] ->
+        [arg_x, arg_y] ->
             do (y_reg, y_code) <- getRegOrMem arg_y
                x_code <- getAnyReg arg_x
                let size = intSize width
@@ -1725,22 +1739,17 @@ genCCall32 target dest_regs args = do
                return code
         _ -> panic "genCCall32: Wrong number of arguments/results for add2"
 
-    (CmmPrim _ (Just stmts), _) ->
-        stmtsToInstrs stmts
-
     _ -> genCCall32' dflags target dest_regs args
 
-  where divOp1 platform signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
+  where divOp1 platform signed width results [arg_x, arg_y]
             = divOp platform signed width results Nothing arg_x arg_y
         divOp1 _ _ _ _ _
             = panic "genCCall32: Wrong number of arguments for divOp1"
-        divOp2 platform signed width results [CmmHinted arg_x_high _,
-                                              CmmHinted arg_x_low _,
-                                              CmmHinted arg_y _]
+        divOp2 platform signed width results [arg_x_high, arg_x_low, arg_y]
             = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y
         divOp2 _ _ _ _ _
             = panic "genCCall64: Wrong number of arguments for divOp2"
-        divOp platform signed width [CmmHinted res_q _, CmmHinted res_r _]
+        divOp platform signed width [res_q, res_r]
               m_arg_x_high arg_x_low arg_y
             = do let size = intSize width
                      reg_q = getRegisterReg platform True (CmmLocal res_q)
@@ -1766,16 +1775,16 @@ genCCall32 target dest_regs args = do
             = panic "genCCall32: Wrong number of results for divOp"
 
 genCCall32' :: DynFlags
-            -> CmmCallTarget            -- function to call
-            -> [HintedCmmFormal]        -- where to put the result
-            -> [HintedCmmActual]        -- arguments (of mixed type)
+            -> ForeignTarget            -- function to call
+            -> [CmmFormal]        -- where to put the result
+            -> [CmmActual]        -- arguments (of mixed type)
             -> NatM InstrBlock
 genCCall32' dflags target dest_regs args = do
         let
             -- Align stack to 16n for calls, assuming a starting stack
             -- alignment of 16n - word_size on procedure entry. Which we
-            -- maintain. See Note [rts/StgCRun.c : Stack Alignment on X86]
-            sizes               = map (arg_size . cmmExprType dflags . hintlessCmm) (reverse args)
+            -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
+            sizes               = map (arg_size . cmmExprType dflags) (reverse args)
             raw_arg_size        = sum sizes + wORD_SIZE dflags
             arg_pad_size        = (roundTo 16 $ raw_arg_size) - raw_arg_size
             tot_arg_size        = raw_arg_size + arg_pad_size - wORD_SIZE dflags
@@ -1790,16 +1799,16 @@ genCCall32' dflags target dest_regs args = do
         -- deal with static vs dynamic call targets
         (callinsns,cconv) <-
           case target of
-            CmmCallee (CmmLit (CmmLabel lbl)) conv
+            ForeignTarget (CmmLit (CmmLabel lbl)) conv
                -> -- ToDo: stdcall arg sizes
                   return (unitOL (CALL (Left fn_imm) []), conv)
                where fn_imm = ImmCLbl lbl
-            CmmCallee expr conv
+            ForeignTarget expr conv
                -> do { (dyn_r, dyn_c) <- getSomeReg expr
                      ; ASSERT( isWord32 (cmmExprType dflags expr) )
                        return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
-            CmmPrim _ _
-                -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
+            PrimTarget _
+                -> panic $ "genCCall: Can't handle PrimTarget call type here, error "
                             ++ "probably because too many return values."
 
         let push_code
@@ -1815,8 +1824,9 @@ genCCall32' dflags target dest_regs args = do
               --
               -- We have to pop any stack padding we added
               -- even if we are doing stdcall, though (#5052)
-            pop_size | cconv /= StdCallConv = tot_arg_size
-                     | otherwise = arg_pad_size
+            pop_size
+               | ForeignConvention StdCallConv _ _ _ <- cconv = arg_pad_size
+               | otherwise = tot_arg_size
 
             call = callinsns `appOL`
                    toOL (
@@ -1833,7 +1843,7 @@ genCCall32' dflags target dest_regs args = do
         let
             -- assign the results, if necessary
             assign_code []     = nilOL
-            assign_code [CmmHinted dest _hint]
+            assign_code [dest]
               | isFloatType ty =
                  if use_sse2
                     then let tmp_amode = AddrBaseIndex (EABaseReg esp)
@@ -1869,10 +1879,10 @@ genCCall32' dflags target dest_regs args = do
         roundTo a x | x `mod` a == 0 = x
                     | otherwise = x + a - (x `mod` a)
 
-        push_arg :: Bool -> HintedCmmActual {-current argument-}
+        push_arg :: Bool -> CmmActual {-current argument-}
                         -> NatM InstrBlock  -- code
 
-        push_arg use_sse2 (CmmHinted arg _hint) -- we don't need the hints on x86
+        push_arg use_sse2 arg -- we don't need the hints on x86
           | isWord64 arg_ty = do
             ChildCode64 code r_lo <- iselExpr64 arg
             delta <- getDeltaNat
@@ -1915,29 +1925,29 @@ genCCall32' dflags target dest_regs args = do
              arg_ty = cmmExprType dflags arg
              size = arg_size arg_ty -- Byte size
 
-genCCall64 :: CmmCallTarget            -- function to call
-           -> [HintedCmmFormal]        -- where to put the result
-           -> [HintedCmmActual]        -- arguments (of mixed type)
+genCCall64 :: ForeignTarget            -- function to call
+           -> [CmmFormal]        -- where to put the result
+           -> [CmmActual]        -- arguments (of mixed type)
            -> NatM InstrBlock
 genCCall64 target dest_regs args = do
   dflags <- getDynFlags
   let platform = targetPlatform dflags
   case (target, dest_regs) of
 
-    (CmmPrim op _, []) ->
+    (PrimTarget op, []) ->
         -- void return type prim op
         outOfLineCmmOp op Nothing args
 
-    (CmmPrim op _, [res]) ->
+    (PrimTarget op, [res]) ->
         -- we only cope with a single result for foreign calls
         outOfLineCmmOp op (Just res) args
 
-    (CmmPrim (MO_S_QuotRem  width) _, _) -> divOp1 platform True  width dest_regs args
-    (CmmPrim (MO_U_QuotRem  width) _, _) -> divOp1 platform False width dest_regs args
-    (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 platform False width dest_regs args
-    (CmmPrim (MO_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
+    (PrimTarget (MO_S_QuotRem  width), _) -> divOp1 platform True  width dest_regs args
+    (PrimTarget (MO_U_QuotRem  width), _) -> divOp1 platform False width dest_regs args
+    (PrimTarget (MO_U_QuotRem2 width), _) -> divOp2 platform False width dest_regs args
+    (PrimTarget (MO_Add2 width), [res_h, res_l]) ->
         case args of
-        [CmmHinted arg_x _, CmmHinted arg_y _] ->
+        [arg_x, arg_y] ->
             do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
                lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
                let size = intSize width
@@ -1948,9 +1958,9 @@ genCCall64 target dest_regs args = do
                           ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
                return code
         _ -> panic "genCCall64: Wrong number of arguments/results for add2"
-    (CmmPrim (MO_U_Mul2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
+    (PrimTarget (MO_U_Mul2 width), [res_h, res_l]) ->
         case args of
-        [CmmHinted arg_x _, CmmHinted arg_y _] ->
+        [arg_x, arg_y] ->
             do (y_reg, y_code) <- getRegOrMem arg_y
                x_code <- getAnyReg arg_x
                let size = intSize width
@@ -1964,24 +1974,19 @@ genCCall64 target dest_regs args = do
                return code
         _ -> panic "genCCall64: Wrong number of arguments/results for add2"
 
-    (CmmPrim _ (Just stmts), _) ->
-        stmtsToInstrs stmts
-
     _ ->
         do dflags <- getDynFlags
            genCCall64' dflags target dest_regs args
 
-  where divOp1 platform signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
+  where divOp1 platform signed width results [arg_x, arg_y]
             = divOp platform signed width results Nothing arg_x arg_y
         divOp1 _ _ _ _ _
             = panic "genCCall64: Wrong number of arguments for divOp1"
-        divOp2 platform signed width results [CmmHinted arg_x_high _,
-                                              CmmHinted arg_x_low _,
-                                              CmmHinted arg_y _]
+        divOp2 platform signed width results [arg_x_high, arg_x_low, arg_y]
             = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y
         divOp2 _ _ _ _ _
             = panic "genCCall64: Wrong number of arguments for divOp2"
-        divOp platform signed width [CmmHinted res_q _, CmmHinted res_r _]
+        divOp platform signed width [res_q, res_r]
               m_arg_x_high arg_x_low arg_y
             = do let size = intSize width
                      reg_q = getRegisterReg platform True (CmmLocal res_q)
@@ -2005,9 +2010,9 @@ genCCall64 target dest_regs args = do
             = panic "genCCall64: Wrong number of results for divOp"
 
 genCCall64' :: DynFlags
-            -> CmmCallTarget            -- function to call
-            -> [HintedCmmFormal]        -- where to put the result
-            -> [HintedCmmActual]        -- arguments (of mixed type)
+            -> ForeignTarget            -- function to call
+            -> [CmmFormal]        -- where to put the result
+            -> [CmmActual]        -- arguments (of mixed type)
             -> NatM InstrBlock
 genCCall64' dflags target dest_regs args = do
     -- load up the register arguments
@@ -2057,15 +2062,15 @@ genCCall64' dflags target dest_regs args = do
     -- deal with static vs dynamic call targets
     (callinsns,_cconv) <-
       case target of
-        CmmCallee (CmmLit (CmmLabel lbl)) conv
+        ForeignTarget (CmmLit (CmmLabel lbl)) conv
            -> -- ToDo: stdcall arg sizes
               return (unitOL (CALL (Left fn_imm) arg_regs), conv)
            where fn_imm = ImmCLbl lbl
-        CmmCallee expr conv
+        ForeignTarget expr conv
            -> do (dyn_r, dyn_c) <- getSomeReg expr
                  return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
-        CmmPrim _ _
-            -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
+        PrimTarget _
+            -> panic $ "genCCall: Can't handle PrimTarget call type here, error "
                         ++ "probably because too many return values."
 
     let
@@ -2094,7 +2099,7 @@ genCCall64' dflags target dest_regs args = do
     let
         -- assign the results, if necessary
         assign_code []     = nilOL
-        assign_code [CmmHinted dest _hint] =
+        assign_code [dest] =
           case typeWidth rep of
                 W32 | isFloatType rep -> unitOL (MOV (floatSize W32) (OpReg xmm0) (OpReg r_dest))
                 W64 | isFloatType rep -> unitOL (MOV (floatSize W64) (OpReg xmm0) (OpReg r_dest))
@@ -2115,16 +2120,16 @@ genCCall64' dflags target dest_regs args = do
   where platform = targetPlatform dflags
         arg_size = 8 -- always, at the mo
 
-        load_args :: [CmmHinted CmmExpr]
+        load_args :: [CmmExpr]
                   -> [Reg]                  -- int regs avail for args
                   -> [Reg]                  -- FP regs avail for args
                   -> InstrBlock
-                  -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock)
+                  -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock)
         load_args args [] [] code     =  return (args, [], [], code)
             -- no more regs to use
         load_args [] aregs fregs code =  return ([], aregs, fregs, code)
             -- no more args to push
-        load_args ((CmmHinted arg hint) : rest) aregs fregs code
+        load_args (arg : rest) aregs fregs code
             | isFloatType arg_rep =
             case fregs of
               [] -> push_this_arg
@@ -2142,21 +2147,21 @@ genCCall64' dflags target dest_regs args = do
 
               push_this_arg = do
                 (args',ars,frs,code') <- load_args rest aregs fregs code
-                return ((CmmHinted arg hint):args', ars, frs, code')
+                return (arg:args', ars, frs, code')
 
-        load_args_win :: [CmmHinted CmmExpr]
+        load_args_win :: [CmmExpr]
                       -> [Reg]        -- used int regs
                       -> [Reg]        -- used FP regs
                       -> [(Reg, Reg)] -- (int, FP) regs avail for args
                       -> InstrBlock
-                      -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock)
+                      -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock)
         load_args_win args usedInt usedFP [] code
             = return (args, usedInt, usedFP, code)
             -- no more regs to use
         load_args_win [] usedInt usedFP _ code
             = return ([], usedInt, usedFP, code)
             -- no more args to push
-        load_args_win ((CmmHinted arg _) : rest) usedInt usedFP
+        load_args_win (arg : rest) usedInt usedFP
                       ((ireg, freg) : regs) code
             | isFloatType arg_rep = do
                  arg_code <- getAnyReg arg
@@ -2175,7 +2180,7 @@ genCCall64' dflags target dest_regs args = do
               arg_rep = cmmExprType dflags arg
 
         push_args [] code = return code
-        push_args ((CmmHinted arg _):rest) code
+        push_args (arg:rest) code
            | isFloatType arg_rep = do
              (arg_reg, arg_code) <- getSomeReg arg
              delta <- getDeltaNat
@@ -2215,14 +2220,15 @@ genCCall64' dflags target dest_regs args = do
 maxInlineSizeThreshold :: Integer
 maxInlineSizeThreshold = 128
 
-outOfLineCmmOp :: CallishMachOp -> Maybe HintedCmmFormal -> [HintedCmmActual] -> NatM InstrBlock
+outOfLineCmmOp :: CallishMachOp -> Maybe CmmFormal -> [CmmActual] -> NatM InstrBlock
 outOfLineCmmOp mop res args
   = do
       dflags <- getDynFlags
       targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
-      let target = CmmCallee targetExpr CCallConv
+      let target = ForeignTarget targetExpr
+                           (ForeignConvention CCallConv [] [] CmmMayReturn)
 
-      stmtToInstrs (CmmCall target (catMaybes [res]) args' CmmMayReturn)
+      stmtToInstrs (CmmUnsafeForeignCall target (catMaybes [res]) args')
   where
         -- Assume we can call these functions directly, and that they're not in a dynamic library.
         -- TODO: Why is this ok? Under linux this code will be in libm.so
@@ -2282,7 +2288,7 @@ outOfLineCmmOp mop res args
               MO_WriteBarrier  -> unsupported
               MO_Touch         -> unsupported
         unsupported = panic ("outOfLineCmmOp: " ++ show mop
-                          ++ "not supported here")
+                          ++ " not supported here")
 
 -- -----------------------------------------------------------------------------
 -- Generating a table-branch
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index d089fc3ec2..7d7e85c441 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -25,7 +25,7 @@ import TargetReg
 
 import BlockId
 import CodeGen.Platform
-import OldCmm
+import Cmm
 import FastString
 import FastBool
 import Outputable
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 76715f1996..75d18a1ff4 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -35,7 +35,7 @@ import PprBase
 import BlockId
 import BasicTypes       (Alignment)
 import DynFlags
-import OldCmm
+import Cmm              hiding (topInfoTable)
 import CLabel
 import Unique           ( pprUnique, Uniquable(..) )
 import Platform
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
index 6b2fe16855..bd60fb0281 100644
--- a/compiler/nativeGen/X86/Regs.hs
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -51,7 +51,7 @@ import CodeGen.Platform
 import Reg
 import RegClass
 
-import OldCmm
+import Cmm
 import CmmCallConv
 import CLabel           ( CLabel )
 import DynFlags