diff --git a/LinearScan/Hoopl.hs b/LinearScan/Hoopl.hs
--- a/LinearScan/Hoopl.hs
+++ b/LinearScan/Hoopl.hs
@@ -9,38 +9,63 @@
 
 import           Compiler.Hoopl as Hoopl hiding ((<*>))
 import           Control.Applicative
-import           Control.Monad.Trans.State (State, get, put)
+import           Control.Arrow
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.State (State, get, put, modify)
 import qualified Data.Map as M
 import           Data.Monoid
+import           Debug.Trace
 import           LinearScan
+import           LinearScan.Hoopl.DSL
 
-class HooplNode n1
-      => NodeAlloc s n1 n2 | n1 -> n2, n2 -> n1, n1 -> s, n2 -> s where
-    isCall   :: n1 O O -> Bool
-    isBranch :: n1 O C -> Bool
+class HooplNode (n v) => NodeAlloc n v r | n -> v, n -> r where
+    fromVar :: v -> Either PhysReg VarId
+    fromReg :: r -> PhysReg
 
-    getReferences :: n1 e x -> [VarInfo]
-    setRegisters  :: [(Int, PhysReg)] -> n1 e x -> n2 e x
+    isCall   :: n v O O -> Bool
+    isBranch :: n v O C -> Bool
 
-    mkMoveOps    :: PhysReg     -> PhysReg     -> State s [n2 O O]
-    mkSwapOps    :: PhysReg     -> PhysReg     -> State s [n2 O O]
-    mkSaveOps    :: PhysReg     -> Maybe VarId -> State s [n2 O O]
-    mkRestoreOps :: Maybe VarId -> PhysReg     -> State s [n2 O O]
+    retargetBranch :: n v O C -> Label -> Label -> n v O C
 
-    op1ToString  :: n1 e x -> String
+    mkLabelOp :: Label -> n v C O
+    mkJumpOp  :: Label -> n v O C
 
+    getReferences :: n v e x -> [VarInfo]
+    setRegisters  :: [(Int, PhysReg)] -> n v e x -> Env (n r e x)
+
+    mkMoveOps    :: PhysReg -> PhysReg -> Env [n r O O]
+    mkSwapOps    :: PhysReg -> PhysReg -> Env [n r O O]
+    mkSaveOps    :: PhysReg -> Maybe VarId -> Env [n r O O]
+    mkRestoreOps :: Maybe VarId -> PhysReg -> Env [n r O O]
+
+    op1ToString  :: n v e x -> String
+
 data NodeV n = NodeCO { getNodeCO :: n C O }
              | NodeOO { getNodeOO :: n O O }
              | NodeOC { getNodeOC :: n O C }
 
-blockInfo :: NonLocal n1
-          => (Label -> Int)
-          -> BlockInfo (Block n1 C C) (Block n2 C C) (NodeV n1) (NodeV n2)
+blockInfo :: (NodeAlloc n v r, NonLocal (n v))
+          => (Label -> Env Int)
+          -> BlockInfo Env (Block (n v) C C) (Block (n r) C C)
+                           (NodeV (n v)) (NodeV (n r))
 blockInfo getBlockId = BlockInfo
     { blockId = getBlockId . entryLabel
 
-    , blockSuccessors = Prelude.map getBlockId . successors
+    , blockSuccessors = Prelude.mapM getBlockId . successors
 
+    , splitCriticalEdge = \(BlockCC b m e)
+                           (BlockCC next _ _) -> do
+        let lab = entryLabel next
+        lab' <- lift freshLabel
+        modify $ \st ->
+            st { envLabels   = M.insert (show lab ++ "'") lab' (envLabels st)
+               , envBlockIds = let m = envBlockIds st in
+                               M.insert lab' (M.size m + 1) m
+               }
+        let e' = retargetBranch e lab lab'
+        return (BlockCC b m e',
+                BlockCC (mkLabelOp lab') BNil (mkJumpOp lab))
+
     , blockOps = \(BlockCC a b z) ->
         ([NodeCO a], Prelude.map NodeOO (blockToList b), [NodeOC z])
 
@@ -51,7 +76,7 @@
             (getNodeOC z)
     }
 
-opInfo :: forall s n1 n2. NodeAlloc s n1 n2 => OpInfo s (NodeV n1) (NodeV n2)
+opInfo :: NodeAlloc n v r => OpInfo Env (NodeV (n v)) (NodeV (n r))
 opInfo = OpInfo
     { opKind = \node -> case node of
            NodeOO n | isCall n  -> IsCall
@@ -70,41 +95,14 @@
     , saveOp    = \x y -> fmap NodeOO <$> mkSaveOps x y
     , restoreOp = \x y -> fmap NodeOO <$> mkRestoreOps x y
 
-    , applyAllocs = \node m -> case node of
-           NodeCO n -> [NodeCO (setRegisters m n)]
-           NodeOO n -> [NodeOO (setRegisters m n)]
-           NodeOC n -> [NodeOC (setRegisters m n)]
+    , applyAllocs = \node m ->
+        case node of
+           NodeCO n -> setRegisters m n >>= \alloc -> return [NodeCO alloc]
+           NodeOO n -> setRegisters m n >>= \alloc -> return [NodeOO alloc]
+           NodeOC n -> setRegisters m n >>= \alloc -> return [NodeOC alloc]
 
     , showOp1 = \node -> case node of
            NodeCO n -> op1ToString n
            NodeOO n -> op1ToString n
            NodeOC n -> op1ToString n
     }
-
-data SpillStack = SpillStack
-    { stackPtr      :: Int
-    , stackSlotSize :: Int
-    , stackSlots    :: M.Map (Maybe Int) Int
-    }
-    deriving (Eq, Show)
-
-newSpillStack :: Int -> Int -> SpillStack
-newSpillStack offset slotSize = SpillStack
-    { stackPtr      = offset
-    , stackSlotSize = slotSize
-    , stackSlots    = mempty
-    }
-
-getStackSlot :: Maybe VarId -> State SpillStack Int
-getStackSlot vid = do
-    stack <- get
-    case M.lookup vid (stackSlots stack) of
-        Just off -> return off
-        Nothing -> do
-            let off = stackPtr stack
-            put stack
-                 { stackPtr   = off + stackSlotSize stack
-                 , stackSlots =
-                     M.insert vid off (stackSlots stack)
-                 }
-            return off
diff --git a/LinearScan/Hoopl/DSL.hs b/LinearScan/Hoopl/DSL.hs
--- a/LinearScan/Hoopl/DSL.hs
+++ b/LinearScan/Hoopl/DSL.hs
@@ -2,16 +2,66 @@
 
 import           Compiler.Hoopl as Hoopl hiding ((<*>))
 import           Control.Applicative
+import           Control.Arrow (first)
 import           Control.Monad.Free
 import           Control.Monad.Trans.Class
 import qualified Control.Monad.Trans.Free as TF
 import           Control.Monad.Trans.Free hiding (FreeF(..), Free)
-import           Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
+import           Control.Monad.Trans.State (StateT, evalStateT,
+                                            gets, modify, get, put)
 import qualified Data.Map as M
 import           Data.Monoid
+import           LinearScan
 
 type Labels = M.Map String Label
+type BlockIds = M.Map Label Int
 
+data SpillStack = SpillStack
+    { stackPtr      :: Int
+    , stackSlotSize :: Int
+    , stackSlots    :: M.Map (Maybe Int) Int
+    }
+    deriving (Eq, Show)
+
+data EnvState = EnvState
+    { envLabels      :: Labels
+    , envBlockIds    :: BlockIds
+    , envSpillStack  :: SpillStack
+    , envAssignments :: M.Map PhysReg VarId
+    }
+
+type Env = StateT EnvState SimpleUniqueMonad
+
+newSpillStack :: Int -> Int -> SpillStack
+newSpillStack offset slotSize = SpillStack
+    { stackPtr      = offset
+    , stackSlotSize = slotSize
+    , stackSlots    = mempty
+    }
+
+newEnvState :: EnvState
+newEnvState = EnvState
+    { envLabels      = mempty
+    , envBlockIds    = mempty
+    , envSpillStack  = newSpillStack 0 8
+    , envAssignments = mempty
+    }
+
+getStackSlot :: Maybe VarId -> Env Int
+getStackSlot vid = do
+    st <- get
+    let stack = envSpillStack st
+    case M.lookup vid (stackSlots stack) of
+        Just off -> return off
+        Nothing -> do
+            let off = stackPtr stack
+            put st { envSpillStack = stack
+                 { stackPtr   = off + stackSlotSize stack
+                 , stackSlots =
+                     M.insert vid off (stackSlots stack)
+                 }}
+            return off
+
 -- | The 'Asm' monad lets us create labels by name and refer to them later.
 type Asm = StateT Labels SimpleUniqueMonad
 
@@ -25,6 +75,18 @@
             modify (M.insert str lbl)
             return lbl
 
+setAssignment :: PhysReg -> VarId -> Env ()
+setAssignment reg vid =
+    modify $ \env ->
+        env { envAssignments = M.insert reg vid (envAssignments env) }
+
+getAssignment :: PhysReg -> Env VarId
+getAssignment reg = do
+    l <- gets (M.lookup reg . envAssignments)
+    case l of
+        Just vid -> return vid
+        Nothing  -> error $ "No assignment for register: " ++ show reg
+
 -- | A series of 'Nodes' is a set of assembly instructions that ends with some
 --   kind of closing operation, such as a jump, branch or return.
 type Nodes n a = Free ((,) (n O O)) a
@@ -63,10 +125,9 @@
 -- | When we compile a program, the result is a closed Hoopl Graph and the
 --   label corresponding to the requested entry label name.
 compile :: (NonLocal n, HooplNode n)
-        => String -> Program n -> (Graph n C C, Label)
+        => String -> Program n -> SimpleUniqueMonad (Graph n C C, Label)
 compile name prog
-    = runSimpleUniqueMonad
-    $ flip evalStateT (mempty :: Labels)
+    = flip evalStateT (mempty :: Labels)
     $ do body  <- go prog
          entry <- gets (M.lookup name)
          case entry of
diff --git a/linearscan-hoopl.cabal b/linearscan-hoopl.cabal
--- a/linearscan-hoopl.cabal
+++ b/linearscan-hoopl.cabal
@@ -1,5 +1,5 @@
 name:          linearscan-hoopl
-version:       0.4.0.1
+version:       0.5.0.0
 synopsis:      Makes it easy to use the linearscan register allocator with Hoopl
 homepage:      http://github.com/jwiegley/linearscan-hoopl
 license:       BSD3
@@ -24,7 +24,7 @@
   exposed-modules:
     LinearScan.Hoopl
     LinearScan.Hoopl.DSL
-  build-depends:    base >=4.7 && <4.8
+  build-depends:    base >=4.7 && <5
                   , hoopl >= 3.10.0.1
                   , linearscan >= 0.3.0.1
                   , containers
@@ -34,11 +34,12 @@
 test-suite test
   default-language: Haskell2010
   type:             exitcode-stdio-1.0
-  ghc-options:      -Wall -Werror -fno-warn-deprecated-flags
+  ghc-options:      -Wall -fno-warn-deprecated-flags
   hs-source-dirs:   test
   main-is:          Main.hs
   other-modules:    AsmTest
                     Assembly
+                    Normal
   build-depends: 
         base >=3
       , linearscan
@@ -50,3 +51,4 @@
       , containers         >= 0.5.5
       , transformers       >= 0.3.0.0
       , lens-family-core
+      , deepseq
diff --git a/test/AsmTest.hs b/test/AsmTest.hs
--- a/test/AsmTest.hs
+++ b/test/AsmTest.hs
@@ -1,44 +1,66 @@
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module AsmTest where
 
 import           Assembly
 import           Compiler.Hoopl as Hoopl hiding ((<*>))
+import           Control.DeepSeq
 import           Control.Exception
-import           Control.Monad.Trans.State (evalState)
+import           Control.Monad.Trans.State (evalStateT, gets)
 import           Data.Foldable
 import qualified Data.Map as M
 import           Data.Maybe (fromMaybe)
 import           LinearScan
 import           LinearScan.Hoopl
 import           LinearScan.Hoopl.DSL
+import           Normal ()
 import           Test.Hspec
 
-asmTest :: Int -> Program (Node IRVar) -> Program (Node PhysReg) -> Expectation
-asmTest regs (compile "entry" -> (prog, entry))
-             (compile "entry" -> (result, _)) =
-    go $ M.fromList $ zip (Prelude.map entryLabel blocks) [(0 :: Int)..]
-  where
-    GMany NothingO body NothingO = prog
-    blocks = postorder_dfs_from body entry
-
-    alloc blockIds = allocate regs (blockInfo getBlockId) opInfo blocks
-      where
-        getBlockId :: Hoopl.Label -> Int
-        getBlockId lbl = fromMaybe (error "The impossible happened")
-                                   (M.lookup lbl blockIds)
-
-    go blockIds = case evalState (alloc blockIds) (newSpillStack 0 8) of
+asmTestLiteral :: Int -> Program (Node IRVar) -> String -> Expectation
+asmTestLiteral regs program expected = do
+    let eres = runSimpleUniqueMonad $ do
+            x <- compile "entry" program
+            uncurry runTest x
+    case eres of
         Left err -> error $ "Allocation failed: " ++ err
         Right blks -> do
-            let graph' = newGraph blks
-            catch (showGraph show graph' `shouldBe`
-                   showGraph show result) $ \e -> do
-                putStrLn $ "---- Expecting ----\n" ++ showGraph show result
-                putStrLn $ "---- Compiled  ----\n" ++ showGraph show graph'
+            let graph' = newGraph $!! blks
+            let g = showGraph show graph'
+            catch (g `shouldBe` expected) $ \e -> do
+                let input = runSimpleUniqueMonad $ compile "entry" program
+                putStrLn $ "---- Parsed ----\n" ++ showGraph show (fst input)
+                putStrLn $ "---- Expecting ----\n" ++ expected
+                putStrLn $ "---- Compiled  ----\n" ++ g
                 putStrLn "-------------------"
                 throwIO (e :: SomeException)
+  where
+    runTest prog entry =
+        go $ M.fromList $ zip (Prelude.map entryLabel blocks) [(0 :: Int)..]
       where
-        newBody = Data.Foldable.foldl' (flip addBlock) emptyBody
-        newGraph xs = GMany NothingO (newBody xs) NothingO
+        GMany NothingO body NothingO = prog
+        blocks = postorder_dfs_from body entry
+
+        alloc = allocate regs (blockInfo getBlockId) opInfo $!! blocks
+          where
+            getBlockId :: Hoopl.Label -> Env Int
+            getBlockId lbl = do
+                bids <- gets envBlockIds
+                return $ fromMaybe
+                    (error $ "Unable to find block at label " ++ show lbl)
+                    (M.lookup lbl bids)
+
+        go blockIds = evalStateT alloc (newEnvState { envBlockIds = blockIds })
+
+    newBody = Data.Foldable.foldl' (flip addBlock) emptyBody
+    newGraph xs = GMany NothingO (newBody xs) NothingO
+
+asmTest :: Int
+        -> Program (Node IRVar)
+        -> Program (Node (Assign VarId PhysReg))
+        -> Expectation
+asmTest regs program expected
+    = asmTestLiteral regs program
+    $ showGraph show
+    $ fst
+    $ runSimpleUniqueMonad
+    $ compile "entry" expected
diff --git a/test/Assembly.hs b/test/Assembly.hs
--- a/test/Assembly.hs
+++ b/test/Assembly.hs
@@ -25,10 +25,15 @@
 default (Int)
 
 -- | The basic instructions that have nothing to do with control flow.
-data Instruction reg = Add reg reg reg
-                     | Nop
-    deriving (Eq, Show, Functor, Foldable, Traversable)
+data Instruction reg
+    = Add reg reg reg
+    | Nop
+    deriving (Eq, Functor, Foldable, Traversable)
 
+instance Show r => Show (Instruction r) where
+    show (Add x1 x2 x3) = "add " ++ show x1 ++ " " ++ show x2 ++ " " ++ show x3
+    show Nop = "nop"
+
 -- | Tests used for branching (correspond to branching instructions)
 data Test = Zero                -- ^ beq
           | NonZero             -- ^ bne
@@ -79,8 +84,8 @@
     show (LoadConst _c v)  = "\t@lc " ++ show v -- ++ " " ++ show c
     show (Move x1 x2)      = "\t@mvrr " ++ show x1 ++ " " ++ show x2
     show (Copy x1 x2)      = "\t@cprr " ++ show x1 ++ " " ++ show x2
-    show (Save src dst)    = "\t@save " ++ " " ++ show src ++ " " ++ show dst
-    show (Restore src dst) = "\t@restore " ++ " " ++ show src ++ " " ++ show dst
+    show (Save src dst)    = "\t@save " ++ show src ++ " " ++ show dst
+    show (Restore src dst) = "\t@restore " ++ show src ++ " " ++ show dst
     show (Trace str)       = "\tTRACE " ++ " " ++ show str
     show (Jump l)          = "\t@jmp " ++ show l
     show (Branch c v t f)  = "\t@b" ++ show c ++ " " ++ show v
@@ -131,10 +136,10 @@
 lc :: v -> BodyNode (Node v)
 lc x0 = bodyNode $ LoadConst 0 x0
 
-save :: PhysReg -> Dst PhysReg -> BodyNode (Node PhysReg)
+save :: v -> Dst PhysReg -> BodyNode (Node v)
 save r dst = bodyNode $ Save r dst
 
-restore :: Src PhysReg -> PhysReg -> BodyNode (Node PhysReg)
+restore :: Src PhysReg -> v -> BodyNode (Node v)
 restore src r = bodyNode $ Restore src r
 
 trace :: String -> BodyNode (Node v)
@@ -147,13 +152,25 @@
 return_ :: EndNode (Node v)
 return_ = endNode $ return $ ReturnInstr [] Nop
 
+data Assign a b = Assign a b
+
+instance Show a => Show (Assign a PhysReg) where
+    show (Assign v (-1)) = "<<v" ++ show v ++ ">>"
+    -- show (Assign v r)    = "r" ++ show r ++ "|v" ++ show v
+    show (Assign v r)    = show r
+
 data IRVar = PhysicalIV PhysReg | VirtualIV Int deriving Eq
 
 instance Show IRVar where
     show (PhysicalIV r) = "r" ++ show r
     show (VirtualIV n)  = "v" ++ show n
 
-instance NodeAlloc SpillStack (Node IRVar) (Node PhysReg) where
+instance NodeAlloc Node IRVar (Assign VarId PhysReg) where
+    fromVar (PhysicalIV r) = Left r
+    fromVar (VirtualIV n)  = Right n
+
+    fromReg (Assign _ r) = r
+
     isCall (Call {}) = True
     isCall _ = False
 
@@ -161,6 +178,15 @@
     isBranch (Branch {}) = True
     isBranch _ = False
 
+    retargetBranch (Jump _) _ lab = Jump lab
+    retargetBranch (Branch b v x y) old lab
+        | x == old  = Branch b v lab y
+        | otherwise = Branch b v x lab
+    retargetBranch x _ _ = error $ "Cannot retarget " ++ show x
+
+    mkLabelOp = Label
+    mkJumpOp  = Jump
+
     getReferences = go
       where
         go :: Node IRVar e x -> [VarInfo]
@@ -190,23 +216,29 @@
             , regRequired = True
             }
 
-    setRegisters = over variables . go
+    setRegisters m g = do
+        for_ m $ \(v, r) -> setAssignment r v
+        return $ over variables go g
       where
-        go :: [(Int, PhysReg)] -> IRVar -> PhysReg
-        go _ (PhysicalIV r) = r
-        go m (VirtualIV n)  =
-            fromMaybe
-                (-1) -- (error $ "Allocation failed for variable " ++ show n)
-                (Data.List.lookup n m)
+        go :: IRVar -> Assign VarId PhysReg
+        go (PhysicalIV r) = Assign (-1) r
+        go (VirtualIV n)  = Assign n (fromMaybe (-1) (Data.List.lookup n m))
 
-    mkMoveOps src dst = return [Move src dst]
-    mkSwapOps src dst = liftA2 (++) (mkRestoreOps Nothing dst)
-                                    (mkSaveOps src Nothing)
+    mkMoveOps src dst = do
+        vid <- getAssignment src
+        return [Move (Assign vid src) (Assign vid dst)]
+    mkSwapOps src dst =
+        liftA2 (++) (mkRestoreOps Nothing dst)
+                    (mkSaveOps src Nothing)
 
-    mkSaveOps    src dst = do off <- getStackSlot dst
-                              return [Save src off]
-    mkRestoreOps src dst = do off <- getStackSlot src
-                              return [Restore off dst]
+    mkSaveOps src dst = do
+        off <- getStackSlot dst
+        vid <- getAssignment src
+        return [Save (Assign vid src) off]
+    mkRestoreOps src dst = do
+        off <- getStackSlot src
+        vid <- getAssignment dst
+        return [Restore off (Assign vid dst)]
 
     op1ToString = show
 
@@ -255,8 +287,9 @@
 v39 = var 39
 v40 = var 40
 
-reg :: PhysReg -> PhysReg
-reg r = r
+reg :: PhysReg -> IRVar -> Assign VarId PhysReg
+reg _ (PhysicalIV _) = error "Don't use reg to reference a literal register"
+reg r (VirtualIV v) = Assign v r
 
 r0  = reg 0
 r1  = reg 1
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -12,6 +12,7 @@
 main :: IO ()
 main = hspec $ do
   describe "Sanity tests" sanityTests
+  describe "Spill tests" spillTests
   describe "Block tests" blockTests
   describe "Call tests" callTests
   describe "Loop tests" loopTests
@@ -24,7 +25,7 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 0
+        add (r0 v0) (r1 v1) (r0 v2)
         return_
 
   it "Single, repeated instruction" $ asmTest 32
@@ -35,9 +36,9 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 2
-        add 0 1 2
-        add 0 1 2
+        add (r0 v0) (r1 v0) (r2 v0)
+        add (r0 v0) (r1 v0) (r2 v0)
+        add (r0 v0) (r1 v0) (r2 v0)
         return_
 
   it "Multiple instructions" $ asmTest 32
@@ -48,9 +49,9 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 2
-        add 0 1 3
-        add 0 1 2
+        add (r0 v0) (r1 v0) (r2 v0)
+        add (r0 v0) (r1 v0) (r3 v0)
+        add (r0 v0) (r1 v0) (r2 v0)
         return_
 
   it "More variables used than registers" $ asmTest 6
@@ -73,31 +74,31 @@
         return_) $
 
     label "entry" $ do
-	lc 0
-	lc 1
-	lc 2
-	lc 3
-	lc 4
-	lc 5
-	save  4 0
-	lc 4
-	save  4 8
-	lc 4
-	save  4 16
-	lc 4
-	save  4 24
-	lc 4
-	add 0 1 0
-	add 2 3 1
-	restore  0 3
-	add 3 5 2
-	save  0 32
-	restore  8 5
-	restore  16 0
-	add 5 0 3
-	restore  24 5
-	add 5 4 0
-	return_
+        lc (r0 v0)
+        lc (r1 v0)
+        lc (r2 v0)
+        lc (r3 v0)
+        lc (r4 v0)
+        lc (r5 v0)
+        save (r4 v0) 0
+        lc (r4 v0)
+        save (r4 v0) 8
+        lc (r4 v0)
+        save (r4 v0) 16
+        lc (r4 v0)
+        save (r4 v0) 24
+        lc (r4 v0)
+        add (r0 v0) (r1 v0) (r0 v0)
+        add (r2 v0) (r3 v0) (r1 v0)
+        restore 0 (r3 v0)
+        add (r3 v0) (r5 v0) (r2 v0)
+        save (r0 v0) 32
+        restore 8 (r5 v0)
+        restore 16 (r0 v0)
+        add (r5 v0) (r0 v0) (r3 v0)
+        restore 24 (r5 v0)
+        add (r5 v0) (r4 v0) (r0 v0)
+        return_
 
   it "Single long-lived variable" $ asmTest 32
     (label "entry" $ do
@@ -108,10 +109,10 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 1
-        add 0 2 2
-        add 0 3 3
-        add 0 4 0
+        add (r0 v0) (r1 v0) (r1 v0)
+        add (r0 v0) (r2 v0) (r2 v0)
+        add (r0 v0) (r3 v0) (r3 v0)
+        add (r0 v0) (r4 v0) (r0 v0)
         return_
 
   it "Two long-lived variables" $ asmTest 32
@@ -123,10 +124,10 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 1
-        add 0 2 3
-        add 0 2 4
-        add 0 2 0
+        add (r0 v0) (r1 v0) (r1 v0)
+        add (r0 v0) (r2 v0) (r3 v0)
+        add (r0 v0) (r2 v0) (r4 v0)
+        add (r0 v0) (r2 v0) (r0 v0)
         return_
 
   it "One variable with a long interval" $ asmTest 32
@@ -146,18 +147,18 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 1
-        add 2 3 2
-        add 4 5 3
-        add 6 7 4
-        add 8 9 5
-        add 10 11 6
-        add 12 13 7
-        add 14 15 8
-        add 16 17 9
-        add 18 19 10
-        add 20 21 11
-        add 0 22 0
+        add (r0 v0) (r1 v0) (r1 v0)
+        add (r2 v0) (r3 v0) (r2 v0)
+        add (r4 v0) (r5 v0) (r3 v0)
+        add (r6 v0) (r7 v0) (r4 v0)
+        add (r8 v0) (r9 v0) (r5 v0)
+        add (r10 v0) (r11 v0) (r6 v0)
+        add (r12 v0) (r13 v0) (r7 v0)
+        add (r14 v0) (r15 v0) (r8 v0)
+        add (r16 v0) (r17 v0) (r9 v0)
+        add (r18 v0) (r19 v0) (r10 v0)
+        add (r20 v0) (r21 v0) (r11 v0)
+        add (r0 v0) (r22 v0) (r0 v0)
         return_
 
   it "Many variables with long intervals" $ asmTest 32
@@ -185,28 +186,30 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 20
-        add 2 3 21
-        add 4 5 22
-        add 6 7 23
-        add 8 9 24
-        add 10 11 25
-        add 12 13 26
-        add 14 15 27
-        add 16 17 28
-        add 18 19 29
-        add 0 1 20
-        add 2 3 21
-        add 4 5 22
-        add 6 7 23
-        add 8 9 24
-        add 10 11 25
-        add 12 13 26
-        add 14 15 27
-        add 16 17 28
-        add 18 19 29
+        add (r0 v0) (r1 v0) (r20 v0)
+        add (r2 v0) (r3 v0) (r21 v0)
+        add (r4 v0) (r5 v0) (r22 v0)
+        add (r6 v0) (r7 v0) (r23 v0)
+        add (r8 v0) (r9 v0) (r24 v0)
+        add (r10 v0) (r11 v0) (r25 v0)
+        add (r12 v0) (r13 v0) (r26 v0)
+        add (r14 v0) (r15 v0) (r27 v0)
+        add (r16 v0) (r17 v0) (r28 v0)
+        add (r18 v0) (r19 v0) (r29 v0)
+        add (r0 v0) (r1 v0) (r20 v0)
+        add (r2 v0) (r3 v0) (r21 v0)
+        add (r4 v0) (r5 v0) (r22 v0)
+        add (r6 v0) (r7 v0) (r23 v0)
+        add (r8 v0) (r9 v0) (r24 v0)
+        add (r10 v0) (r11 v0) (r25 v0)
+        add (r12 v0) (r13 v0) (r26 v0)
+        add (r14 v0) (r15 v0) (r27 v0)
+        add (r16 v0) (r17 v0) (r28 v0)
+        add (r18 v0) (r19 v0) (r29 v0)
         return_
 
+spillTests :: SpecWith ()
+spillTests = do
   it "Spilling one variable" $ asmTest 32
     (label "entry" $ do
         add v0   v1  v2
@@ -234,40 +237,40 @@
         return_) $
 
     label "entry" $ do
-        add 0 1 22
-        add 2 3 23
-        add 4 5 24
-        add 6 7 25
-        add 8 9 26
-        add 10 11 27
-        add 12 13 28
-        add 14 15 29
-        add 16 17 30
-        add 18 19 31
+        add (r0 v0) (r1 v0) (r22 v0)
+        add (r2 v0) (r3 v0) (r23 v0)
+        add (r4 v0) (r5 v0) (r24 v0)
+        add (r6 v0) (r7 v0) (r25 v0)
+        add (r8 v0) (r9 v0) (r26 v0)
+        add (r10 v0) (r11 v0) (r27 v0)
+        add (r12 v0) (r13 v0) (r28 v0)
+        add (r14 v0) (r15 v0) (r29 v0)
+        add (r16 v0) (r17 v0) (r30 v0)
+        add (r18 v0) (r19 v0) (r31 v0)
 
         -- When we reach the 32nd variable considered (which happens to be
         -- v30), we must spill a register because there are not 32 registers.
         -- So we pick the first register, counting from 0, whose next use
         -- position is the furthest from this position.  That happens to be
         -- 18, which is next used at position 41.
-        save 18 0
-        add 20 21 18
-        add 0 1 22
-        add 2 3 23
-        add 4 5 24
-        add 6 7 25
-        add 8 9 26
-        add 10 11 27
-        add 12 13 28
-        add 14 15 29
-        add 16 17 30
+        save (r18 v0) 0
+        add (r20 v0) (r21 v0) (r18 v0)
+        add (r0 v0) (r1 v0) (r22 v0)
+        add (r2 v0) (r3 v0) (r23 v0)
+        add (r4 v0) (r5 v0) (r24 v0)
+        add (r6 v0) (r7 v0) (r25 v0)
+        add (r8 v0) (r9 v0) (r26 v0)
+        add (r10 v0) (r11 v0) (r27 v0)
+        add (r12 v0) (r13 v0) (r28 v0)
+        add (r14 v0) (r15 v0) (r29 v0)
+        add (r16 v0) (r17 v0) (r30 v0)
 
         -- When it comes time to reload v29 (which had been allocated to 18),
         -- we pick the first available register which happens to be 0 in this
         -- case.
-        restore 0 0
-        add 0 19 31
-        add 20 21 18
+        restore 0 (r0 v0)
+        add (r0 v0) (r19 v0) (r31 v0)
+        add (r20 v0) (r21 v0) (r18 v0)
         return_
 
   it "Higher register pressure" $ asmTest 3
@@ -285,25 +288,25 @@
         return_) $
 
     label "entry" $ do
-	lc 0
-	lc 1
-	add 0 1 2
-	add 2 1 0
-	save  1 0
-	add 0 2 1
-	save  2 8
-	add 1 0 2
-	save  1 16
-	restore  8 1
-	add 1 0 0
-	save  0 24
-	restore  16 0
-	add 0 2 1
-	restore  24 2
-	add 2 1 0
-	restore  0 1
-	add 0 1 0
-	return_
+        lc (r0 v0)
+        lc (r1 v0)
+        add (r0 v0) (r1 v0) (r2 v0)
+        add (r2 v0) (r1 v0) (r0 v0)
+        save (r1 v0) 0
+        add (r0 v0) (r2 v0) (r1 v0)
+        save (r2 v0) 8
+        add (r1 v0) (r0 v0) (r2 v0)
+        save (r1 v0) 16
+        restore 8 (r1 v0)
+        add (r1 v0) (r0 v0) (r0 v0)
+        save (r0 v0) 24
+        restore 16 (r0 v0)
+        add (r0 v0) (r2 v0) (r1 v0)
+        restore 24 (r2 v0)
+        add (r2 v0) (r1 v0) (r0 v0)
+        restore 0 (r1 v0)
+        add (r0 v0) (r1 v0) (r0 v0)
+        return_
 
   it "Inserts necessary saves and restores" $ asmTest 4
     (label "entry" $ do
@@ -320,18 +323,18 @@
         return_) $
 
     label "entry" $ do
-        lc 0
-        lc 1
-        add 0 1 2
-        add 2 1 3
-        add 3 2 0
-        save 1 0
-        add 0 3 1
-        add 2 3 2
-        add 0 1 0
-        add 2 0 0
-        restore 0 1
-        add 0 1 0
+        lc (r0 v0)
+        lc (r1 v0)
+        add (r0 v0) (r1 v0) (r2 v0)
+        add (r2 v0) (r1 v0) (r3 v0)
+        add (r3 v0) (r2 v0) (r0 v0)
+        save (r1 v0) 0
+        add (r0 v0) (r3 v0) (r1 v0)
+        add (r2 v0) (r3 v0) (r2 v0)
+        add (r0 v0) (r1 v0) (r0 v0)
+        add (r2 v0) (r0 v0) (r0 v0)
+        restore 0 (r1 v0)
+        add (r0 v0) (r1 v0) (r0 v0)
         return_
 
 blockTests :: SpecWith ()
@@ -353,18 +356,18 @@
             return_) $
 
     do label "entry" $ do
-           add 0 1 0
+           add (r0 v0) (r1 v0) (r0 v0)
            jump "L2"
 
        label "L2" $ do
-           add 0 2 1
-           add 0 1 1
+           add (r0 v0) (r2 v0) (r1 v0)
+           add (r0 v0) (r1 v0) (r1 v0)
            jump "L3"
 
        label "L3" $ do
-           add 0 1 1
-           add 0 1 1
-           add 0 1 0
+           add (r0 v0) (r1 v0) (r1 v0)
+           add (r0 v0) (r1 v0) (r1 v0)
+           add (r0 v0) (r1 v0) (r0 v0)
            return_
 
   it "Inserts resolving moves" $ asmTest 3
@@ -391,30 +394,30 @@
             return_) $
 
     do label "entry" $ do
-           lc 0
-           lc 1
-           add 0 1 2
-           branch Zero 2 "B2" "B3"
+           lc (r0 v0)
+           lc (r1 v0)
+           add (r0 v0) (r1 v0) (r2 v0)
+           branch Zero (r2 v0) "B2" "B3"
 
        label "B2" $ do
-           add 1 2 0
-           move 0 1
+           move (r1 v0) (r0 v0)
+           add (r0 v0) (r2 v0) (r1 v0)
            jump "B4"
 
        label "B3" $ do
-           save 0 0
-           add 1 2 0
-           restore 0 2
-           add 2 0 1
-           save 0 8
-           add 2 1 0
-           add 1 0 0
-           restore 8 1
-           add 0 1 0
+           save (r0 v0) 0
+           add (r1 v0) (r2 v0) (r0 v0)
+           restore 0 (r2 v0)
+           add (r2 v0) (r0 v0) (r1 v0)
+           save (r0 v0) 8
+           add (r2 v0) (r1 v0) (r0 v0)
+           add (r1 v0) (r0 v0) (r0 v0)
+           restore 8 (r1 v0)
+           add (r0 v0) (r1 v0) (r0 v0)
            jump "B4"
 
        label "B4" $ do
-           add 1 1 2
+           add (r1 v0) (r1 v0) (r0 v0)
            return_
 
   it "When resolving moves are not needed" $ asmTest 4
@@ -439,82 +442,104 @@
             return_) $
 
     do label "entry" $ do
-           add 0 1 2
-           branch Zero 2 "B2" "B3"
+           add (r0 v0) (r1 v0) (r2 v0)
+           branch Zero (r2 v0) "B2" "B3"
 
        label "B2" $ do
-           add 1 2 3
-           add 0 0 1
-           add 0 0 2
-           add 0 1 1
-           add 0 2 1
+           add (r1 v0) (r2 v0) (r3 v0)
+           add (r0 v0) (r0 v0) (r1 v0)
+           add (r0 v0) (r0 v0) (r2 v0)
+           add (r0 v0) (r1 v0) (r1 v0)
+           add (r0 v0) (r2 v0) (r1 v0)
            jump "B4"
 
        label "B3" $ do
-           add 1 2 3
+           add (r1 v0) (r2 v0) (r3 v0)
            jump "B4"
 
        label "B4" $ do
-           add 3 3 0
+           add (r3 v0) (r3 v0) (r0 v0)
            return_
 
-  -- it "Another resolution case" $ asmTest 4
-  --   (do label "entry" $ do
-  --           lc v3
-  --           lc v4
-  --           lc v15
-  --           lc v20
-  --           jump "L3"
+  it "Another resolution case" $ asmTest 4
+    (do label "entry" $ do
+            lc v3
+            lc v4
+            lc v15
+            lc v20
+            jump "L3"
 
-  --       label "L3" $ do
-  --           move v3 v9
-  --           move v9 v11
-  --           move v11 v10
-  --           move v10 v12
-  --           move v12 v13
-  --           lc v14
-  --           move v15 v5
-  --           jump "L6"
+        label "L3" $ do
+            move v3 v9
+            move v9 v11
+            move v11 v10
+            move v10 v12
+            move v12 v13
+            lc v14
+            move v15 v5
+            jump "L6"
 
-  --       label "L6" $
-  --           branch Zero v4 "L3" "L2"
+        label "L6" $
+            branch Zero v4 "L3" "L2"
 
-  --       label "L2" $ do
-  --           lc v21
-  --           move v21 v18
-  --           move v5 v4
-  --           lc v19
-  --           move v20 v17
-  --           jump "L6") $
+        label "L2" $ do
+            lc v21
+            move v21 v18
+            move v5 v4
+            lc v19
+            move v20 v17
+            jump "L6") $
 
-  --   do label "entry" $ do
-  --          lc 0
-  --          lc 1
-  --          lc 2
-  --          lc 3
-  --          jump "L3"
+    do label "entry" $ do
+           lc (r0 v0)
+           lc (r1 v0)
+           lc (r2 v0)
+           lc (r3 v0)
+           save (r3 v0) 0
+           jump "L3"
 
-  --      label "L3" $ do
-  --          move 0 3
-  --          move 3 0
-  --          move 0 3
-  --          move 3 0
-  --          move 0 3
-  --          lc 0
-  --          move 2 0
-  --          jump "L6"
+       label "L3" $ do
+           move (r0 v0) (r3 v0)
+           move (r3 v0) (r3 v0)
+           move (r3 v0) (r3 v0)
+           move (r3 v0) (r3 v0)
+           move (r3 v0) (r3 v0)
+           save (r0 v0) 8
+           lc (r0 v0)
+           save (r0 v0) 16
+           move (r2 v0) (r0 v0)
+           jump "L6"
 
-  --      label "L6" $
-  --          branch Zero 1 "L3" "L2"
+       label "L2" $ do
+           lc (r3 v0)
+           save (r2 v0) 24
+           move (r3 v0) (r2 v0)
+           move (r0 v0) (r1 v0)
+           save (r0 v0) 32
+           lc (r0 v0)
+           save (r1 v0) 48
+           save (r0 v0) 40
+           restore 0 (r1 v0)
+           move (r1 v0) (r0 v0)
+           save (r1 v0) 0
+           restore 24 (r2 v0)
+           restore 32 (r0 v0)
+           restore 48 (r1 v0)
+           jump "L6"
 
-  --      label "L2" $ do
-  --          lc 3
-  --          move 3 2
-  --          move 0 1
-  --          lc 3
-  --          move 1 0
-  --          jump "L6"
+       label "L6" $
+           branch Zero (r1 v0) "L5" "L2"
 
+       label "L5" $ do
+           save (r1 v0) 48
+           restore 0 (r1 v0)
+           save (r2 v0) 24
+           save (r1 v0) 0
+           restore 24 (r2 v0)
+           restore 48 (r1 v0)
+           restore 8 (r0 v0)
+           jump "L3"
+
 callTests :: SpecWith ()
 callTests = do
   it "Spills all registers at call" $ asmTest 4
@@ -533,32 +558,32 @@
         return_) $
 
     label "entry" $ do
-        lc 0
-        lc 1
-        add 0 1 2
-        add 2 1 3
-        add 3 2 0
-        save 1 0
-        add 0 3 1
-        save 2 32
-        save 3 24
-        save 0 16
-        save 1 8
+        lc (r0 v0)
+        lc (r1 v1)
+        add (r0 v0) (r1 v1) (r2 v2)
+        add (r2 v2) (r1 v1) (r3 v3)
+        add (r3 v3) (r2 v2) (r0 v4)
+        save (r1 v1) 0
+        add (r0 v4) (r3 v3) (r1 v5)
+        save (r2 v2) 32
+        save (r3 v3) 24
+        save (r0 v4) 16
+        save (r1 v5) 8
         call 1000
-        restore 32 1
-        restore 24 2
-        add 1 2 0
-        restore 16 2
-        restore 8 3
-        add 2 3 1
-        add 0 1 0
-        restore 0 1
-        add 0 1 0
+        restore 32 (r1 v2)
+        restore 24 (r2 v3)
+        add (r1 v2) (r2 v3) (r0 v6)
+        restore 16 (r2 v4)
+        restore 8 (r3 v5)
+        add (r2 v4) (r3 v5) (r1 v7)
+        add (r0 v6) (r1 v7) (r0 v8)
+        restore 0 (r1 v1)
+        add (r0 v8) (r1 v1) (r0 v0)
         return_
 
 loopTests :: SpecWith ()
 loopTests = do
-  it "Correctly orders loop blocks" $ asmTest 4
+  it "Correctly orders loop blocks" $ asmTestLiteral 4
     (do label "entry" $ do
             trace "B0"
             jump "B1"
@@ -591,34 +616,29 @@
             trace "B7"
             jump "B1") $
 
-    do label "entry" $ do
-           trace "B0"
-           jump "B1"
-
-       label "B1" $ do
-           trace "B1"
-           branch Zero 0 "B3" "B2"
-
-       label "B2" $ do
-           trace "B2"
-           branch Zero 0 "B5" "B4"
-
-       label "B3" $ do
-           trace "B3"
-           jump "B1"
-
-       label "B4" $ do
-           trace "B4"
-           branch Zero 0 "B7" "B6"
-
-       label "B5" $ do
-           trace "B5"
-           return_
-
-       label "B6" $ do
-           trace "B6"
-           jump "B4"
-
-       label "B7" $ do
-           trace "B7"
-           jump "B1"
+    "L1:\n\
+\\tTRACE  \"B0\"\n\
+\\t@jmp L2\n\
+\L2:\n\
+\\tTRACE  \"B1\"\n\
+\\t@bZero 0 L3; @jmp L4\n\
+\L3:\n\
+\\tTRACE  \"B3\"\n\
+\\t@jmp L2\n\
+\L4:\n\
+\\tTRACE  \"B2\"\n\
+\\t@bZero 0 L5; @jmp L9\n\
+\L5:\n\
+\\tTRACE  \"B5\"\n\
+\\t@return [] nop\n\
+\L6:\n\
+\\tTRACE  \"B4\"\n\
+\\t@bZero 0 L7; @jmp L8\n\
+\L7:\n\
+\\tTRACE  \"B7\"\n\
+\\t@jmp L2\n\
+\L8:\n\
+\\tTRACE  \"B6\"\n\
+\\t@jmp L6\n\
+\L9:\n\
+\\t@jmp L6\n"
diff --git a/test/Normal.hs b/test/Normal.hs
new file mode 100644
--- /dev/null
+++ b/test/Normal.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ViewPatterns #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Normal where
+
+import Assembly
+import Compiler.Hoopl as Hoopl hiding ((<*>))
+import Control.DeepSeq
+
+instance (NFData a, NFData b) => NFData (Assign a b) where
+    rnf (Assign a b) = a `deepseq` b `deepseq` ()
+
+instance NFData IRVar where
+    rnf (PhysicalIV r) = r `deepseq` ()
+    rnf (VirtualIV r) = r `deepseq` ()
+
+instance NFData v => NFData (Instruction v) where
+    rnf (Add x y z) = x `deepseq` y `deepseq` z `deepseq` ()
+    rnf Nop = ()
+
+instance NFData CConv where
+    rnf InlineC = ()
+    rnf (CConvC args results _) = args `deepseq` results `deepseq` ()
+
+instance NFData Label where rnf _ = ()
+
+instance NFData Test where rnf _ = ()
+
+instance NFData v => NFData (Node v e x) where
+    rnf (Alloc msrc dst)           = msrc `deepseq` dst `deepseq` ()
+    rnf (Reclaim src)              = src `deepseq` ()
+    rnf (Instr i)                  = i `deepseq` ()
+    rnf (LoadConst c dst)          = c `deepseq` dst `deepseq` ()
+    rnf (Move src dst)             = src `deepseq` dst `deepseq` ()
+    rnf (Copy src dst)             = src `deepseq` dst `deepseq` ()
+    rnf (Save src x)               = src `deepseq` x `deepseq` ()
+    rnf (Restore x src)            = x `deepseq` src `deepseq` ()
+    rnf (Trace str)                = str `deepseq` ()
+    rnf (Branch x1 cond x2 x3)     = x1 `deepseq` cond `deepseq`
+                                     x2 `deepseq` x3 `deepseq` ()
+    rnf (Call cc i)                = cc `deepseq` i `deepseq` ()
+    rnf (ReturnInstr liveInRegs i) = liveInRegs `deepseq` i `deepseq` ()
+    rnf (Label x)                  = x `deepseq` ()
+    rnf (Jump x)                   = x `deepseq` ()
+
+instance NFData v => NFData (Block (Node v) e x) where
+    rnf (BlockCO i b)   = i `deepseq` b `deepseq` ()
+    rnf (BlockCC i b o) = i `deepseq` b `deepseq` o `deepseq` ()
+    rnf (BlockOC b o)   = b `deepseq` o `deepseq` ()
+    rnf BNil            = ()
+    rnf (BMiddle n)     = n `deepseq` ()
+    rnf (BCat n1 n2)    = n1 `deepseq` n2 `deepseq` ()
+    rnf (BSnoc b n)     = b `deepseq` n `deepseq` ()
+    rnf (BCons n b)     = n `deepseq` b `deepseq` ()