diff --git a/dist/build/HERMIT/Parser.hs b/dist/build/HERMIT/Parser.hs
--- a/dist/build/HERMIT/Parser.hs
+++ b/dist/build/HERMIT/Parser.hs
@@ -17,7 +17,7 @@
 import qualified Data.Array as Happy_Data_Array
 import qualified GHC.Exts as Happy_GHC_Exts
 
--- parser produced by Happy Version 1.19.0
+-- parser produced by Happy Version 1.19.2
 
 newtype HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 = HappyAbsSyn HappyAny
 #if __GLASGOW_HASKELL__ >= 607
@@ -490,6 +490,7 @@
 
 
 
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
 #if __GLASGOW_HASKELL__ > 706
 #define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)
 #define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)
@@ -499,7 +500,7 @@
 #define GTE(n,m) (n Happy_GHC_Exts.>=# m)
 #define EQ(n,m) (n Happy_GHC_Exts.==# m)
 #endif
-{-# LINE 45 "templates/GenericTemplate.hs" #-}
+{-# LINE 46 "templates/GenericTemplate.hs" #-}
 
 
 data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
@@ -508,11 +509,11 @@
 
 
 
-{-# LINE 66 "templates/GenericTemplate.hs" #-}
+{-# LINE 67 "templates/GenericTemplate.hs" #-}
 
-{-# LINE 76 "templates/GenericTemplate.hs" #-}
+{-# LINE 77 "templates/GenericTemplate.hs" #-}
 
-{-# LINE 85 "templates/GenericTemplate.hs" #-}
+{-# LINE 86 "templates/GenericTemplate.hs" #-}
 
 infixr 9 `HappyStk`
 data HappyStk a = HappyStk a (HappyStk a)
@@ -529,9 +530,9 @@
 -- parse (a %partial parser).  We must ignore the saved token on the top of
 -- the stack in this case.
 happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
-	happyReturn1 ans
+        happyReturn1 ans
 happyAccept j tk st sts (HappyStk ans _) = 
-	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+        (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
 
 -----------------------------------------------------------------------------
 -- Arrays only: do the next action
@@ -539,35 +540,35 @@
 
 
 happyDoAction i tk st
-	= {- nothing -}
+        = {- nothing -}
 
 
-	  case action of
-		0#		  -> {- nothing -}
-				     happyFail i tk st
-		-1# 	  -> {- nothing -}
-				     happyAccept i tk st
-		n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+          case action of
+                0#           -> {- nothing -}
+                                     happyFail i tk st
+                -1#          -> {- nothing -}
+                                     happyAccept i tk st
+                n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
 
-				     (happyReduceArr Happy_Data_Array.! rule) i tk st
-				     where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
-		n		  -> {- nothing -}
+                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st
+                                                   where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
+                n                 -> {- nothing -}
 
 
-				     happyShift new_state i tk st
+                                     happyShift new_state i tk st
                                      where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))
    where off    = indexShortOffAddr happyActOffsets st
          off_i  = (off Happy_GHC_Exts.+# i)
-	 check  = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
+         check  = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
                   then EQ(indexShortOffAddr happyCheck off_i, i)
-		  else False
+                  else False
          action
           | check     = indexShortOffAddr happyTable off_i
           | otherwise = indexShortOffAddr happyDefActions st
 
 
 indexShortOffAddr (HappyA# arr) off =
-	Happy_GHC_Exts.narrow16Int# i
+        Happy_GHC_Exts.narrow16Int# i
   where
         i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
         high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
@@ -586,7 +587,7 @@
 -----------------------------------------------------------------------------
 -- HappyState data type (not arrays)
 
-{-# LINE 169 "templates/GenericTemplate.hs" #-}
+{-# LINE 170 "templates/GenericTemplate.hs" #-}
 
 -----------------------------------------------------------------------------
 -- Shifting a token
@@ -628,9 +629,9 @@
      = happyFail 0# tk st sts stk
 happyReduce k nt fn j tk st sts stk
      = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
-	 sts1@((HappyCons (st1@(action)) (_))) ->
-        	let r = fn stk in  -- it doesn't hurt to always seq here...
-       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+         sts1@((HappyCons (st1@(action)) (_))) ->
+                let r = fn stk in  -- it doesn't hurt to always seq here...
+                happyDoSeq r (happyGoto nt j tk st1 sts1 r)
 
 happyMonadReduce k nt fn 0# tk st sts stk
      = happyFail 0# tk st sts stk
@@ -682,7 +683,7 @@
 -- parse error if we are in recovery and we fail again
 happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
      let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
---	trace "failing" $ 
+--      trace "failing" $ 
         happyError_ i tk
 
 {-  We don't need state discarding for our restricted implementation of
@@ -691,16 +692,16 @@
 
 -- discard a state
 happyFail  0# tk old_st (HappyCons ((action)) (sts)) 
-						(saved_tok `HappyStk` _ `HappyStk` stk) =
---	trace ("discarding state, depth " ++ show (length stk))  $
-	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+                                                (saved_tok `HappyStk` _ `HappyStk` stk) =
+--      trace ("discarding state, depth " ++ show (length stk))  $
+        happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
 -}
 
 -- Enter error recovery: generate an error token,
 --                       save the old token and carry on.
 happyFail  i tk (action) sts stk =
 --      trace "entering error recovery" $
-	happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+        happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
 
 -- Internal happy errors:
 
@@ -718,9 +719,9 @@
 
 -----------------------------------------------------------------------------
 -- Seq-ing.  If the --strict flag is given, then Happy emits 
---	happySeq = happyDoSeq
+--      happySeq = happyDoSeq
 -- otherwise it emits
--- 	happySeq = happyDontSeq
+--      happySeq = happyDontSeq
 
 happyDoSeq, happyDontSeq :: a -> b -> b
 happyDoSeq   a b = a `seq` b
diff --git a/dist/build/HERMIT/ParserCore.hs b/dist/build/HERMIT/ParserCore.hs
--- a/dist/build/HERMIT/ParserCore.hs
+++ b/dist/build/HERMIT/ParserCore.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -w #-}
 {-# OPTIONS -fglasgow-exts -cpp #-}
 {-# LANGUAGE CPP #-}
- module HERMIT.ParserCore (parseCore, parseCoreExprT, parse2beforeBiR, parse3beforeBiR) where
+ module HERMIT.ParserCore (parseCore, parseCoreExprT, parse2beforeBiR, parse3beforeBiR, parse4beforeBiR, parse5beforeBiR) where
 
 import Control.Arrow
 import Control.Monad.Reader
@@ -17,12 +17,10 @@
 import HERMIT.Dictionary.Common
 
 import Language.KURE.MonadCatch (prefixFailMsg)
-
-import Language.Haskell.TH as TH
 import qualified Data.Array as Happy_Data_Array
 import qualified GHC.Exts as Happy_GHC_Exts
 
--- parser produced by Happy Version 1.19.0
+-- parser produced by Happy Version 1.19.2
 
 newtype HappyAbsSyn t4 t5 t6 t7 t8 t9 = HappyAbsSyn HappyAny
 #if __GLASGOW_HASKELL__ >= 607
@@ -260,7 +258,7 @@
 lookupName :: String -> (Id -> CoreExpr) -> CoreParseM CoreExpr
 lookupName nm k = do
     c <- ask
-    v <- lift $ prefixFailMsg (nm ++ " lookup: ") $ findId (TH.mkName nm) c
+    v <- lift $ prefixFailMsg (nm ++ " lookup: ") $ findId nm c
     return (k v)
 
 type CoreParseM a = ReaderT HermitC HermitM a
@@ -336,18 +334,28 @@
 
 ---------------------------------------------
 
--- These three should probably go somewhere else.
+-- These should probably go somewhere else.
 
 -- | Parse a 'CoreString' to a 'CoreExpr', using the current context.
 parseCoreExprT :: CoreString -> TranslateH a CoreExpr
 parseCoreExprT = contextonlyT . parseCore
 
-parse2beforeBiR :: (CoreExpr -> CoreExpr -> BiRewriteH a) -> CoreString -> CoreString -> BiRewriteH a
+parse2beforeBiR :: (CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> BiRewriteH a
 parse2beforeBiR f s1 s2 = beforeBiR (parseCoreExprT s1 &&& parseCoreExprT s2) (uncurry f)
 
-parse3beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a) -> CoreString -> CoreString -> CoreString -> BiRewriteH a
+parse3beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> CoreString -> BiRewriteH a
 parse3beforeBiR f s1 s2 s3 = beforeBiR ((parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3) ((uncurry.uncurry) f)
 
+parse4beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> CoreString -> CoreString -> BiRewriteH a
+parse4beforeBiR f s1 s2 s3 s4 = beforeBiR (((parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3) &&& parseCoreExprT s4) ((uncurry.uncurry.uncurry) f)
+
+parse5beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> CoreString -> CoreString -> CoreString -> BiRewriteH a
+parse5beforeBiR f s1 s2 s3 s4 s5 = beforeBiR ((((parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3) &&& parseCoreExprT s4) &&& parseCoreExprT s5) ((uncurry.uncurry.uncurry.uncurry) f)
+
 ---------------------------------------------
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
@@ -362,6 +370,7 @@
 
 
 
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
 #if __GLASGOW_HASKELL__ > 706
 #define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)
 #define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)
@@ -371,7 +380,7 @@
 #define GTE(n,m) (n Happy_GHC_Exts.>=# m)
 #define EQ(n,m) (n Happy_GHC_Exts.==# m)
 #endif
-{-# LINE 45 "templates/GenericTemplate.hs" #-}
+{-# LINE 46 "templates/GenericTemplate.hs" #-}
 
 
 data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
@@ -380,11 +389,11 @@
 
 
 
-{-# LINE 66 "templates/GenericTemplate.hs" #-}
+{-# LINE 67 "templates/GenericTemplate.hs" #-}
 
-{-# LINE 76 "templates/GenericTemplate.hs" #-}
+{-# LINE 77 "templates/GenericTemplate.hs" #-}
 
-{-# LINE 85 "templates/GenericTemplate.hs" #-}
+{-# LINE 86 "templates/GenericTemplate.hs" #-}
 
 infixr 9 `HappyStk`
 data HappyStk a = HappyStk a (HappyStk a)
@@ -401,9 +410,9 @@
 -- parse (a %partial parser).  We must ignore the saved token on the top of
 -- the stack in this case.
 happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
-	happyReturn1 ans
+        happyReturn1 ans
 happyAccept j tk st sts (HappyStk ans _) = 
-	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+        (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
 
 -----------------------------------------------------------------------------
 -- Arrays only: do the next action
@@ -411,35 +420,35 @@
 
 
 happyDoAction i tk st
-	= {- nothing -}
+        = {- nothing -}
 
 
-	  case action of
-		0#		  -> {- nothing -}
-				     happyFail i tk st
-		-1# 	  -> {- nothing -}
-				     happyAccept i tk st
-		n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+          case action of
+                0#           -> {- nothing -}
+                                     happyFail i tk st
+                -1#          -> {- nothing -}
+                                     happyAccept i tk st
+                n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
 
-				     (happyReduceArr Happy_Data_Array.! rule) i tk st
-				     where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
-		n		  -> {- nothing -}
+                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st
+                                                   where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
+                n                 -> {- nothing -}
 
 
-				     happyShift new_state i tk st
+                                     happyShift new_state i tk st
                                      where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))
    where off    = indexShortOffAddr happyActOffsets st
          off_i  = (off Happy_GHC_Exts.+# i)
-	 check  = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
+         check  = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
                   then EQ(indexShortOffAddr happyCheck off_i, i)
-		  else False
+                  else False
          action
           | check     = indexShortOffAddr happyTable off_i
           | otherwise = indexShortOffAddr happyDefActions st
 
 
 indexShortOffAddr (HappyA# arr) off =
-	Happy_GHC_Exts.narrow16Int# i
+        Happy_GHC_Exts.narrow16Int# i
   where
         i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
         high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
@@ -458,7 +467,7 @@
 -----------------------------------------------------------------------------
 -- HappyState data type (not arrays)
 
-{-# LINE 169 "templates/GenericTemplate.hs" #-}
+{-# LINE 170 "templates/GenericTemplate.hs" #-}
 
 -----------------------------------------------------------------------------
 -- Shifting a token
@@ -500,9 +509,9 @@
      = happyFail 0# tk st sts stk
 happyReduce k nt fn j tk st sts stk
      = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
-	 sts1@((HappyCons (st1@(action)) (_))) ->
-        	let r = fn stk in  -- it doesn't hurt to always seq here...
-       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+         sts1@((HappyCons (st1@(action)) (_))) ->
+                let r = fn stk in  -- it doesn't hurt to always seq here...
+                happyDoSeq r (happyGoto nt j tk st1 sts1 r)
 
 happyMonadReduce k nt fn 0# tk st sts stk
      = happyFail 0# tk st sts stk
@@ -554,7 +563,7 @@
 -- parse error if we are in recovery and we fail again
 happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
      let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
---	trace "failing" $ 
+--      trace "failing" $ 
         happyError_ i tk
 
 {-  We don't need state discarding for our restricted implementation of
@@ -563,16 +572,16 @@
 
 -- discard a state
 happyFail  0# tk old_st (HappyCons ((action)) (sts)) 
-						(saved_tok `HappyStk` _ `HappyStk` stk) =
---	trace ("discarding state, depth " ++ show (length stk))  $
-	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+                                                (saved_tok `HappyStk` _ `HappyStk` stk) =
+--      trace ("discarding state, depth " ++ show (length stk))  $
+        happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
 -}
 
 -- Enter error recovery: generate an error token,
 --                       save the old token and carry on.
 happyFail  i tk (action) sts stk =
 --      trace "entering error recovery" $
-	happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+        happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
 
 -- Internal happy errors:
 
@@ -590,9 +599,9 @@
 
 -----------------------------------------------------------------------------
 -- Seq-ing.  If the --strict flag is given, then Happy emits 
---	happySeq = happyDoSeq
+--      happySeq = happyDoSeq
 -- otherwise it emits
--- 	happySeq = happyDontSeq
+--      happySeq = happyDontSeq
 
 happyDoSeq, happyDontSeq :: a -> b -> b
 happyDoSeq   a b = a `seq` b
diff --git a/driver/Main.hs b/driver/Main.hs
--- a/driver/Main.hs
+++ b/driver/Main.hs
@@ -42,15 +42,15 @@
         ]
 
 main :: IO ()
-main = do
-   args <- getArgs
-   main1 args
+main = getArgs >>= main1
 
 main1 :: [String] -> IO ()
 main1 [] = usage
-main1 args@[file_nm,script_nm] = do
+main1 args@(file_nm:script_nm:rest) = do
     e <- doesFileExist script_nm
-    if e then main4 file_nm [] [("*", [script_nm])] [] else main2 args
+    if e && (not (any (isPrefixOf "+") rest)) 
+        then main4 file_nm [] [("*", script_nm:rest)] [] 
+        else main2 args
 main1 other = main2 other
 
 main2 (file_nm:rest) = case span (/= "--") rest of
diff --git a/examples/fib-stream/Fib.hss b/examples/fib-stream/Fib.hss
--- a/examples/fib-stream/Fib.hss
+++ b/examples/fib-stream/Fib.hss
@@ -1,5 +1,5 @@
 flatten-module
-consider 'fib
+binding-of 'fib
 {
   ww-split-unsafe [| wrap Nat |] [| unwrap Nat |]
   {rhs-of 'work
diff --git a/examples/fib-tuple/Fib.hss b/examples/fib-tuple/Fib.hss
--- a/examples/fib-tuple/Fib.hss
+++ b/examples/fib-tuple/Fib.hss
@@ -31,7 +31,7 @@
 -- work (n+1) = (f (wrap work) (n+1), wrap work (n+1) + wrap work n)
 
 [ case-alt 1, alt-rhs ]
-{ app-arg ; any-call (unfold origwork) }
+{ app-arg ; any-call (unfold-remembered origwork) }
 
 -- work 0     = (0, 1)
 -- work (n+1) = (f (wrap work) (n+1), wrap (unwrap (f (wrap work))) (n+1) + wrap (unwrap (f (wrap work))) n)
@@ -56,13 +56,13 @@
 -- work 0     = (0, 1)
 -- work (n+1) = let (x,y) = unwrap (f (wrap work)) n in (y,x+y)
 
-one-td (fold origwork)
+one-td (fold-remembered origwork)
 
 -- work 0     = (0, 1)
 -- work (n+1) = let (x,y) = work n in (y,x+y)
 
 }
 
-any-call (unfold 'wrap)
-simplify
+{ def-rhs ; let-elim }
 
+any-call (unfold 'wrap)
diff --git a/examples/hanoi/Hanoi.hss b/examples/hanoi/Hanoi.hss
--- a/examples/hanoi/Hanoi.hss
+++ b/examples/hanoi/Hanoi.hss
@@ -1,7 +1,7 @@
 flatten-module
 
 -- do the w/w split
-consider 'hanoi
+binding-of 'hanoi
 { ww-split-unsafe [| wrap |] [| unwrap |] }
 
 { binding-of 'work
@@ -17,7 +17,7 @@
   -- establish the one base case
   { [case-alt 1, alt-rhs] ; case-split-inline 'a
     { case-alt 0 ; any-call (unfold 'f) ; simplify
-      any-call (unfold origwork)
+      any-call (unfold-remembered origwork)
       any-call (forward (ww-assumption-A-unsafe [| wrap |] [| unwrap |]))
       any-call (unfold 'f)
       simplify
@@ -26,13 +26,13 @@
     }
     { case-alt 1 ; any-call (unfold 'f) ; simplify
 
-      any-call (unfold origwork)
+      any-call (unfold-remembered origwork)
       any-call (forward (ww-assumption-A-unsafe [| wrap |] [| unwrap |]))
       any-call (unfold 'f)
       innermost let-subst ; simplify
 
       -- recursion decrements by two, so must do this again
-      any-call (unfold origwork)
+      any-call (unfold-remembered origwork)
       any-call (forward (ww-assumption-A-unsafe [| wrap |] [| unwrap |]))
 
       -- time to let intro
@@ -52,7 +52,7 @@
         any-call (fold 'w)
         let-tuple 'uvw
         any-call (fold 'unwrap)
-        any-call (fold origwork)
+        any-call (fold-remembered origwork)
       }
     }
   }
diff --git a/examples/mean/Mean.hss b/examples/mean/Mean.hss
--- a/examples/mean/Mean.hss
+++ b/examples/mean/Mean.hss
@@ -24,5 +24,5 @@
   innermost let-float
   try (reorder-lets ['s,'l])
   let-tuple 'sl
-  { case-expr ; fold sumlen }
+  { case-expr ; fold-remembered sumlen }
 }
diff --git a/hermit.cabal b/hermit.cabal
--- a/hermit.cabal
+++ b/hermit.cabal
@@ -1,5 +1,5 @@
 Name:                hermit
-Version:             0.3.2.0
+Version:             0.4.0.0
 Synopsis:            Haskell Equational Reasoning Model-to-Implementation Tunnel
 Description:
   HERMIT uses Haskell to express semi-formal models,
@@ -30,12 +30,12 @@
   .
   @
    $ hermit Reverse.hs Reverse.hss resume
-   [starting HERMIT v0.3.2.0 on Reverse.hs]
+   [starting HERMIT v0.4.0.0 on Reverse.hs]
    % ghc Reverse.hs -fforce-recomp -O2 -dcore-lint -fexpose-all-unfoldings -fsimple-list-literals -fplugin=HERMIT -fplugin-opt=HERMIT:Main:Reverse.hss -fplugin-opt=HERMIT:Main:resume
    [1 of 2] Compiling HList            ( HList.hs, HList.o )
    Loading package ghc-prim ... linking ... done.
    ...
-   Loading package hermit-0.3.2.0 ... linking ... done.
+   Loading package hermit-0.4.0.0 ... linking ... done.
    [2 of 2] Compiling Main             ( Reverse.hs, Reverse.o )
    Linking Reverse ...
    $ ./Reverse
@@ -46,12 +46,12 @@
   .
   @
    $ hermit Reverse.hs
-   [starting HERMIT v0.3.2.0 on Reverse.hs]
-   % ghc Reverse.hs -fforce-recomp -O2 -dcore-lint -fexpose-all-unfoldings -fsimple-list-literals -fplugin=HERMIT -fplugin-opt=HERMIT:Main:
+   [starting HERMIT v0.4.0.0 on Reverse.hs]
+   % ghc Reverse.hs -fforce-recomp -O2 -dcore-lint -fexpose-all-unfoldings -fsimple-list-literals -fplugin=HERMIT -fplugin-opt=HERMIT:*:
    [1 of 2] Compiling HList            ( HList.hs, HList.o )
    Loading package ghc-prim ... linking ... done.
    ...
-   Loading package hermit-0.3.2.0 ... linking ... done.
+   Loading package hermit-0.4.0.0 ... linking ... done.
    [2 of 2] Compiling Main             ( Reverse.hs, Reverse.o )
    ===================== Welcome to HERMIT =====================
    HERMIT is a toolkit for the interactive transformation of GHC
@@ -66,7 +66,7 @@
    available HERMIT commands.
    .
    To get started, you could try the following:
-   \ \ - type \"consider 'foo\", where \"foo\" is a function
+   \ \ - type \"binding-of 'foo\", where \"foo\" is a function
    \ \ \ \ defined in the module;
    \ \ - type \"set-pp-type Show\" to switch on typing information;
    \ \ - use natural numbers such as \"0\" and \"1\" to descend into
@@ -152,11 +152,12 @@
                  operational >= 0.2.2.1,
                  process >= 1.1.0.2,
                  stm >= 2.4,
-                 template-haskell >= 2.8.0.0,
                  temporary >= 1.1.2.4,
-                 terminfo >= 0.3.2.5,
                  transformers
 
+  if !os(windows)
+    build-depends: terminfo >= 0.3.2.5
+
   default-language: Haskell2010
 
   Exposed-modules:
@@ -175,6 +176,7 @@
        HERMIT.Dictionary.Fold
        HERMIT.Dictionary.Function
        HERMIT.Dictionary.GHC
+       HERMIT.Dictionary.Induction
        HERMIT.Dictionary.Inline
        HERMIT.Dictionary.Kure
        HERMIT.Dictionary.Local
@@ -187,6 +189,7 @@
        HERMIT.Dictionary.New
        HERMIT.Dictionary.Query
        HERMIT.Dictionary.Reasoning
+       HERMIT.Dictionary.Rules
        HERMIT.Dictionary.Undefined
        HERMIT.Dictionary.Unfold
        HERMIT.Dictionary.Unsafe
@@ -196,16 +199,20 @@
 
        HERMIT.External
        HERMIT.GHC
-       HERMIT.Interp
+       HERMIT.GHC.Typechecker
        HERMIT.Kernel
        HERMIT.Kernel.Scoped
        HERMIT.Kure
        HERMIT.Kure.SumTypes
        HERMIT.Monad
-       HERMIT.Optimize
        HERMIT.Parser
        HERMIT.ParserCore
+
        HERMIT.Plugin
+       HERMIT.Plugin.Builder
+       HERMIT.Plugin.Display
+       HERMIT.Plugin.Renderer
+       HERMIT.Plugin.Types
 
        HERMIT.PrettyPrinter.AST
        HERMIT.PrettyPrinter.Clean
@@ -214,14 +221,16 @@
 
        HERMIT.Shell.Command
        HERMIT.Shell.Dictionary
+       HERMIT.Shell.Interpreter
        HERMIT.Shell.Externals
        HERMIT.Shell.ScriptToRewrite
-       HERMIT.Shell.Renderer
+       HERMIT.Shell.Proof
        HERMIT.Shell.Types
 
+       HERMIT.Utilities
+
   Other-modules:
        HERMIT.Syntax
-       HERMIT.Utilities
 
        Paths_hermit
 
diff --git a/src/HERMIT.hs b/src/HERMIT.hs
--- a/src/HERMIT.hs
+++ b/src/HERMIT.hs
@@ -3,9 +3,9 @@
 import Data.Maybe (fromMaybe)
 
 import HERMIT.GHC
-import HERMIT.Optimize
-import HERMIT.Plugin (getPhaseFlag)
+import HERMIT.Plugin.Builder (getPhaseFlag)
+import HERMIT.Plugin
 
 plugin :: Plugin
-plugin = optimize $ \ options -> let (pn,opts) = fromMaybe (0,options) (getPhaseFlag options)
-                                 in phase pn $ interactive [] opts
+plugin = hermitPlugin $ \ options -> let (pn,opts) = fromMaybe (0,options) (getPhaseFlag options)
+                                     in phase pn $ interactive [] opts
diff --git a/src/HERMIT/Context.hs b/src/HERMIT/Context.hs
--- a/src/HERMIT/Context.hs
+++ b/src/HERMIT/Context.hs
@@ -8,6 +8,7 @@
          -- ** The Standard Context
        , HermitC
        , initHermitC
+       , hermitC_modguts -- TODO: for now
          -- ** Bindings
        , HermitBindingSite(..)
        , BindingDepth
@@ -25,7 +26,7 @@
        , addDefBindingsExcept
        , addLambdaBinding
        , addAltBindings
-       , addCaseWildBinding
+       , addCaseBinderBinding
        , addForallBinding
          -- ** Reading bindings from the context
        , BoundVars(..)
@@ -48,8 +49,6 @@
 import Data.Monoid (mempty)
 import Data.Map hiding (map, foldr, filter)
 
-import qualified Language.Haskell.TH as TH
-
 import Language.KURE
 import Language.KURE.ExtendableContext
 
@@ -64,14 +63,14 @@
 
 -- | HERMIT\'s representation of variable bindings.
 --   Bound expressions cannot be inlined without checking for shadowing issues (using the depth information).
-data HermitBindingSite = LAM                               -- ^ A lambda-bound variable.
-                       | NONREC CoreExpr                   -- ^ A non-recursive binding of an expression.
-                       | REC CoreExpr                      -- ^ A recursive binding that does not depend on the current expression (i.e. we're not in the binding group of that binding).
-                       | SELFREC                           -- ^ A recursive binding of a superexpression of the current node (i.e. we're in the RHS of that binding).
-                       | MUTUALREC CoreExpr                -- ^ A recursive binding that is mutually recursive with the binding under consideration (i.e. we're in another definition in the same recursive binding group.).
-                       | CASEALT                           -- ^ A variable bound in a case alternative.
-                       | CASEWILD CoreExpr (AltCon,[Var])  -- ^ A case wildcard binder.  We store both the scrutinised expression, and the case alternative 'AltCon' and variables.
-                       | FORALL                            -- ^ A universally quantified type variable.
+data HermitBindingSite = LAM                                -- ^ A lambda-bound variable.
+                       | NONREC CoreExpr                    -- ^ A non-recursive binding of an expression.
+                       | REC CoreExpr                       -- ^ A recursive binding that does not depend on the current expression (i.e. we're not in the binding group of that binding).
+                       | SELFREC                            -- ^ A recursive binding of a superexpression of the current node (i.e. we're in the RHS of that binding).
+                       | MUTUALREC CoreExpr                 -- ^ A recursive binding that is mutually recursive with the binding under consideration (i.e. we're in another definition in the same recursive binding group.).
+                       | CASEALT                            -- ^ A variable bound in a case alternative.
+                       | CASEBINDER CoreExpr (AltCon,[Var]) -- ^ A case binder.  We store both the scrutinised expression, and the case alternative 'AltCon' and variables.
+                       | FORALL                             -- ^ A universally quantified type variable.
 
 data HermitBinding = HB { hbDepth :: BindingDepth 
                         , hbSite :: HermitBindingSite 
@@ -81,25 +80,25 @@
 -- | Retrieve the expression in a 'HermitBindingSite', if there is one.
 hermitBindingSiteExpr :: HermitBindingSite -> KureM CoreExpr
 hermitBindingSiteExpr b = case b of
-                            LAM          -> fail "variable is lambda-bound, not bound to an expression."
-                            NONREC e     -> return e
-                            REC e        -> return e
-                            MUTUALREC e  -> return e
-                            SELFREC      -> fail "identifier recursively refers to the expression under consideration."
-                            CASEALT      -> fail "variable is bound in a case alternative, not bound to an expression."
-                            CASEWILD e _ -> return e
-                            FORALL       -> fail "variable is a universally quantified type variable."
+                            LAM            -> fail "variable is lambda-bound, not bound to an expression."
+                            NONREC e       -> return e
+                            REC e          -> return e
+                            MUTUALREC e    -> return e
+                            SELFREC        -> fail "identifier recursively refers to the expression under consideration."
+                            CASEALT        -> fail "variable is bound in a case alternative, not bound to an expression."
+                            CASEBINDER e _ -> return e
+                            FORALL         -> fail "variable is a universally quantified type variable."
 
 hermitBindingSummary :: HermitBinding -> String
 hermitBindingSummary b = show (hbDepth b) ++ "$" ++ case hbSite b of
-                            LAM          -> "LAM"
-                            NONREC {}    -> "NONREC"
-                            REC {}       -> "REC"
-                            MUTUALREC {} -> "MUTUALREC"
-                            SELFREC {}   -> "SELFREC"
-                            CASEALT      -> "CASEALT"
-                            CASEWILD {}  -> "CASEWILD"
-                            FORALL       -> "FORALL"
+                            LAM            -> "LAM"
+                            NONREC {}      -> "NONREC"
+                            REC {}         -> "REC"
+                            MUTUALREC {}   -> "MUTUALREC"
+                            SELFREC {}     -> "SELFREC"
+                            CASEALT        -> "CASEALT"
+                            CASEBINDER {}  -> "CASEBINDER"
+                            FORALL         -> "FORALL"
 
 -- | Retrieve the expression in a 'HermitBinding', if there is one.
 hermitBindingExpr :: HermitBinding -> KureM CoreExpr
@@ -148,9 +147,9 @@
 addDefBindingsExcept :: (AddBindings c, ReadPath c Crumb) => Int -> [(Id,CoreExpr)] -> c -> c
 addDefBindingsExcept n ies c = addHermitBindings [ (i, MUTUALREC e, absPath c @@ Rec_Def m) | (m,(i,e)) <- zip [0..] ies, m /= n ] c
 
--- | Add a wildcard binding for a specific case alternative.
-addCaseWildBinding :: (AddBindings c, ReadPath c Crumb) => (Id,CoreExpr,CoreAlt) -> c -> c
-addCaseWildBinding (i,e,(con,vs,_)) c = addHermitBindings [(i,CASEWILD e (con,vs),absPath c @@ Case_Binder)] c
+-- | Add the case binder for a specific case alternative.
+addCaseBinderBinding :: (AddBindings c, ReadPath c Crumb) => (Id,CoreExpr,CoreAlt) -> c -> c
+addCaseBinderBinding (i,e,(con,vs,_)) c = addHermitBindings [(i,CASEBINDER e (con,vs),absPath c @@ Case_Binder)] c
 
 -- | Add a lambda bound variable to a context.
 --   All that is known is the variable, which may shadow something.
@@ -178,9 +177,8 @@
   boundVars = id
 
 -- | List all variables bound in the context that match the given name.
-findBoundVars :: BoundVars c => TH.Name -> c -> VarSet
-findBoundVars nm = filterVarSet (cmpTHName2Var nm) . boundVars
-
+findBoundVars :: BoundVars c => String -> c -> VarSet
+findBoundVars nm = filterVarSet (cmpString2Var nm) . boundVars
 
 -- | A class of contexts from which HERMIT bindings can be retrieved.
 class BoundVars c => ReadBindings c where
@@ -239,6 +237,7 @@
         , hermitC_path           :: AbsolutePathH           -- ^ The 'AbsolutePath' to the current node from the root.
         , hermitC_globalRdrEnv   :: GlobalRdrEnv            -- ^ The top-level lexical environment.
         , hermitC_coreRules      :: [CoreRule]              -- ^ GHC rewrite RULES.
+        , hermitC_modguts        :: ModGuts                 -- ^ Used to run the typechecker/desugarer
         }
 
 ------------------------------------------------------------------------
@@ -251,6 +250,9 @@
                         , hermitC_path          = mempty
                         , hermitC_globalRdrEnv  = mg_rdr_env modGuts
                         , hermitC_coreRules     = mg_rules modGuts ++ other_rules
+                        -- We need this to run the typechecker/desugarer
+                        -- TODO: if this is undesirable, another way?
+                        , hermitC_modguts       = modGuts
                         }
 
     where other_rules :: [CoreRule]
diff --git a/src/HERMIT/Core.hs b/src/HERMIT/Core.hs
--- a/src/HERMIT/Core.hs
+++ b/src/HERMIT/Core.hs
@@ -59,9 +59,11 @@
           , exprKindOrType
           , exprTypeM
           , endoFunType
+          , splitTyConAppM
           , splitFunTypeM
-          , funArgResTypes
-          , funsWithInverseTypes
+          , endoFunExprType
+          , funExprArgResTypes
+          , funExprsWithInverseTypes
           , appCount
           , mapAlts
 
@@ -79,6 +81,7 @@
 import Language.KURE.MonadCatch
 
 import HERMIT.GHC
+import HERMIT.Utilities
 
 import Data.List (intercalate)
 
@@ -373,28 +376,38 @@
 
 -----------------------------------------------------------------------
 
--- | Return the domain/codomain type of an endofunction expression.
-endoFunType :: Monad m => CoreExpr -> m Type
-endoFunType f = do (ty1,ty2) <- funArgResTypes f
-                   guardMsg (eqType ty1 ty2) ("argument and result types differ.")
-                   return ty1
+-- | As 'splitTyConApp', catching failure in a monad.
+splitTyConAppM :: Monad m => Type -> m (TyCon, [Type])
+splitTyConAppM = maybeM "splitTyConApp failed." . splitTyConApp_maybe
 
 -- | Return the domain and codomain types of a function type, if it is a function type.
 splitFunTypeM :: Monad m => Type -> m (Type,Type)
-splitFunTypeM = maybe (fail "not a function type.") return . splitFunTy_maybe
+splitFunTypeM = maybeM "not a function type." . splitFunTy_maybe
 
+-- | Return the domain/codomain type of an endofunction type.
+endoFunType :: Monad m => Type -> m Type
+endoFunType ty =
+  do (ty1,ty2) <- splitFunTypeM ty
+     guardMsg (eqType ty1 ty2) ("argument and result types differ.")
+     return ty1
+
+-- | Return the domain/codomain type of an endofunction expression.
+endoFunExprType :: Monad m => CoreExpr -> m Type
+endoFunExprType = exprTypeM >=> endoFunType
+
 -- | Return the domain and codomain types of a function expression.
-funArgResTypes :: Monad m => CoreExpr -> m (Type,Type)
-funArgResTypes = exprTypeM >=> splitFunTypeM
+funExprArgResTypes :: Monad m => CoreExpr -> m (Type,Type)
+funExprArgResTypes = exprTypeM >=> splitFunTypeM
 
 -- | Check two expressions have types @a -> b@ and @b -> a@, returning @(a,b)@.
-funsWithInverseTypes :: MonadCatch m => CoreExpr -> CoreExpr -> m (Type,Type)
-funsWithInverseTypes f g = do (fdom,fcod) <- funArgResTypes f
-                              (gdom,gcod) <- funArgResTypes g
-                              setFailMsg "functions do not have inverse types." $
-                                do guardM (eqType fdom gcod)
-                                   guardM (eqType gdom fcod)
-                                   return (fdom,fcod)
+funExprsWithInverseTypes :: MonadCatch m => CoreExpr -> CoreExpr -> m (Type,Type)
+funExprsWithInverseTypes f g =
+  do (fdom,fcod) <- funExprArgResTypes f
+     (gdom,gcod) <- funExprArgResTypes g
+     setFailMsg "functions do not have inverse types." $
+       do guardM (eqType fdom gcod)
+          guardM (eqType gdom fcod)
+          return (fdom,fcod)
 
 -----------------------------------------------------------------------
 
diff --git a/src/HERMIT/Dictionary.hs b/src/HERMIT/Dictionary.hs
--- a/src/HERMIT/Dictionary.hs
+++ b/src/HERMIT/Dictionary.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
 module HERMIT.Dictionary
     ( -- * The HERMIT Dictionary
       externals
@@ -12,11 +10,13 @@
     , module HERMIT.Dictionary.Function
     , module HERMIT.Dictionary.GHC
     , module HERMIT.Dictionary.Inline
+    , module HERMIT.Dictionary.Kure
     , module HERMIT.Dictionary.Local
     , module HERMIT.Dictionary.Navigation
     , module HERMIT.Dictionary.New
     , module HERMIT.Dictionary.Query
     , module HERMIT.Dictionary.Reasoning
+    , module HERMIT.Dictionary.Rules
     , module HERMIT.Dictionary.Undefined
     , module HERMIT.Dictionary.Unfold
     , module HERMIT.Dictionary.Unsafe
@@ -44,7 +44,8 @@
 import qualified HERMIT.Dictionary.GHC as GHC
 import           HERMIT.Dictionary.Inline hiding (externals)
 import qualified HERMIT.Dictionary.Inline as Inline
-import qualified HERMIT.Dictionary.Kure as Kure -- This *only* exports externals, so we don't re-export it.
+import           HERMIT.Dictionary.Kure hiding (externals)
+import qualified HERMIT.Dictionary.Kure as Kure
 import           HERMIT.Dictionary.Local hiding (externals)
 import qualified HERMIT.Dictionary.Local as Local
 import           HERMIT.Dictionary.Navigation hiding (externals)
@@ -55,6 +56,8 @@
 import qualified HERMIT.Dictionary.Query as Query
 import           HERMIT.Dictionary.Reasoning hiding (externals)
 import qualified HERMIT.Dictionary.Reasoning as Reasoning
+import           HERMIT.Dictionary.Rules hiding (externals)
+import qualified HERMIT.Dictionary.Rules as Rules
 import           HERMIT.Dictionary.Undefined hiding (externals)
 import qualified HERMIT.Dictionary.Undefined as Undefined
 import           HERMIT.Dictionary.Unfold hiding (externals)
@@ -85,8 +88,11 @@
     ++ New.externals
     ++ Query.externals
     ++ Reasoning.externals
+    ++ Rules.externals
     ++ Undefined.externals
     ++ Unfold.externals
     ++ Unsafe.externals
     ++ WorkerWrapperFix.externals
     ++ WorkerWrapperFixResult.externals
+
+--------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/AlphaConversion.hs b/src/HERMIT/Dictionary/AlphaConversion.hs
--- a/src/HERMIT/Dictionary/AlphaConversion.hs
+++ b/src/HERMIT/Dictionary/AlphaConversion.hs
@@ -14,6 +14,9 @@
        , alphaLetVarsR
        , alphaLetR
        , alphaProgConsWithR
+       , alphaProgConsIdsR
+       , alphaProgConsR
+       , alphaProgR
          -- ** Shadow Detection and Unshadowing
        , unshadowR
        , visibleVarsT
@@ -29,7 +32,6 @@
 import Data.Char (isDigit)
 import Data.List (intersect)
 import Data.Maybe (fromMaybe, listToMaybe)
-import Data.Monoid
 
 import HERMIT.Core
 import HERMIT.Context
@@ -41,8 +43,6 @@
 import HERMIT.Dictionary.GHC hiding (externals)
 import HERMIT.Dictionary.Common
 
-import qualified Language.Haskell.TH as TH
-
 import Prelude hiding (exp)
 
 -----------------------------------------------------------------------
@@ -52,30 +52,30 @@
 externals = map (.+ Deep)
          [  external "alpha" (alphaR :: RewriteH Core)
                [ "Renames the bound variables at the current node."]
-         ,  external "alpha-lam" (promoteExprR . alphaLamR . Just :: TH.Name -> RewriteH Core)
+         ,  external "alpha-lam" (promoteExprR . alphaLamR . Just :: String -> RewriteH Core)
                [ "Renames the bound variable in a Lambda expression to the given name."]
          ,  external "alpha-lam" (promoteExprR  (alphaLamR Nothing) :: RewriteH Core)
                [ "Renames the bound variable in a Lambda expression."]
-         ,  external "alpha-case-binder" (promoteExprR . alphaCaseBinderR . Just :: TH.Name -> RewriteH Core)
+         ,  external "alpha-case-binder" (promoteExprR . alphaCaseBinderR . Just :: String -> RewriteH Core)
                [ "Renames the binder in a Case expression to the given name."]
          ,  external "alpha-case-binder" (promoteExprR (alphaCaseBinderR Nothing) :: RewriteH Core)
                [ "Renames the binder in a Case expression."]
          ,  external "alpha-alt" (promoteAltR alphaAltR :: RewriteH Core)
                [ "Renames all binders in a Case alternative."]
-         ,  external "alpha-alt" (promoteAltR . alphaAltWithR :: [TH.Name] -> RewriteH Core)
+         ,  external "alpha-alt" (promoteAltR . alphaAltWithR :: [String] -> RewriteH Core)
                [ "Renames all binders in a Case alternative using the user-provided list of new names."]
          ,  external "alpha-case" (promoteExprR alphaCaseR :: RewriteH Core)
                [ "Renames all binders in a Case alternative."]
-         ,  external "alpha-let" (promoteExprR . alphaLetWithR :: [TH.Name] -> RewriteH Core)
+         ,  external "alpha-let" (promoteExprR . alphaLetWithR :: [String] -> RewriteH Core)
                [ "Renames the bound variables in a Let expression using a list of suggested names."]
          ,  external "alpha-let" (promoteExprR alphaLetR :: RewriteH Core)
                [ "Renames the bound variables in a Let expression."]
-         ,  external "alpha-top" (promoteProgR . alphaProgConsWithR :: [TH.Name] -> RewriteH Core)
+         ,  external "alpha-top" (promoteProgR . alphaProgConsWithR :: [String] -> RewriteH Core)
                [ "Renames the bound identifiers in the top-level binding group at the head of the program using a list of suggested names."]
-         -- ,  external "alpha-top" (promoteProgR alphaCons)
-         --       [ "Renames the bound identifiers in the top-level binding at the head of the program."]
-         -- ,  external "alpha-program" (promoteProgR alphaProg)
-         --       [ "Renames identifiers bound at the top-level of the program."]
+         ,  external "alpha-top" (promoteProgR alphaProgConsR :: RewriteH Core)
+               [ "Renames the bound identifiers in the top-level binding at the head of the program."]
+         ,  external "alpha-prog" (promoteProgR alphaProgR :: RewriteH Core)
+               [ "Rename all top-level identifiers in the program."]
          ,  external "unshadow" (unshadowR :: RewriteH Core)
                 [ "Rename local variables with manifestly unique names (x, x0, x1, ...)."]
          ]
@@ -93,18 +93,19 @@
 -- 1.  Any free variable name in the active Expr; or
 -- 2.  Any bound variables in context.
 
--- | List all visible identifiers (in the expression or the context).
-visibleVarsT :: (BoundVars c, Monad m) => Translate c m CoreExpr VarSet
-visibleVarsT = liftM2 unionVarSet boundVarsT (arr freeVarsExpr)
+-- | Collect all visible variables (in the expression or the context).
+visibleVarsT :: (BoundVars c, Monad m) => Translate c m CoreTC VarSet
+visibleVarsT = liftM2 unionVarSet boundVarsT (arr freeVarsCoreTC)
 
 -- | If a name is provided replace the string with that,
 --   otherwise modify the string making sure to /not/ clash with any visible variables.
-freshNameGenT :: (BoundVars c, Monad m) => Maybe TH.Name -> Translate c m CoreExpr (String -> String)
+freshNameGenT :: (BoundVars c, Monad m) => Maybe String -> Translate c m CoreTC (String -> String)
 freshNameGenT mn = freshNameGenAvoiding mn `liftM` visibleVarsT
 
 -- | Use the optional argument if given, otherwise generate a new name avoiding clashes with the list of variables.
-freshNameGenAvoiding :: Maybe TH.Name -> VarSet -> (String -> String)
-freshNameGenAvoiding mn vs str = maybe (inventNames vs str) TH.nameBase mn
+freshNameGenAvoiding :: Maybe String -> VarSet -> (String -> String)
+freshNameGenAvoiding mn vs str = maybe (inventNames vs str) ((\(c:cs) -> reverse (c:(takeWhile (/='.') cs))) . reverse) mn
+-- The 'Just' case above gives the unqualified portion of the name (properly handling the compose operator '.')
 
 -- | Invent a new String based on the old one, but avoiding clashing with the given list of identifiers.
 inventNames :: VarSet -> String -> String
@@ -137,11 +138,11 @@
 --   Does not rename top-level definitions.
 unshadowR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Rewrite c HermitM Core
 unshadowR = setFailMsg "No shadows to eliminate." $
-           anytdR (promoteExprR unshadowExpr <+ promoteAltR unshadowAlt)
+           anytdR (promoteExprR unshadowExpr <+ promoteAltR unshadowAlt <+ promoteProgR unshadowProg)
 
   where
     unshadowExpr :: Rewrite c HermitM CoreExpr
-    unshadowExpr = do vs <- shadowedByT (mkVarSet <$> (letVarsT <+ (return <$> (caseWildIdT <+ lamVarT))))
+    unshadowExpr = do vs <- shadowedByT (mkVarSet <$> (letVarsT <+ (return <$> (caseBinderIdT <+ lamVarT))))
                                         (unionVarSet <$> boundVarsT <*> arr freeVarsExpr)
                       alphaLamR Nothing <+ alphaLetVarsR (varSetElems vs) <+ alphaCaseBinderR Nothing
 
@@ -150,6 +151,11 @@
                                        (unionVarSet <$> boundVarsT <*> arr freeVarsAlt)
                      alphaAltVarsR (varSetElems vs)
 
+    unshadowProg :: Rewrite c HermitM CoreProg
+    unshadowProg = do is <- shadowedByT (mkVarSet <$> progConsIdsT)
+                                        (unionVarSet <$> boundVarsT <*> arr freeVarsProg)
+                      alphaProgConsIdsR (varSetElems is)
+
 -----------------------------------------------------------------------
 
 -- Maybe this should be defined elsewhere.
@@ -174,39 +180,47 @@
 -----------------------------------------------------------------------
 
 -- | Alpha rename a lambda binder.  Optionally takes a suggested new name.
-alphaLamR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe TH.Name -> Rewrite c HermitM CoreExpr
+alphaLamR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> Rewrite c HermitM CoreExpr
 alphaLamR mn = setFailMsg (wrongFormForAlpha "Lam v e") $
-              do (v, nameModifier) <- lamT idR (freshNameGenT mn) (,)
+              do (v, nameModifier) <- lamT idR (extractT $ freshNameGenT mn) (,)
                  v' <- constT (cloneVarH nameModifier v)
                  lamAnyR (arr $ replaceVar v v') (replaceVarR v v')
 
 -----------------------------------------------------------------------
 
 -- | Alpha rename a case binder.  Optionally takes a suggested new name.
-alphaCaseBinderR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe TH.Name -> Rewrite c HermitM CoreExpr
+alphaCaseBinderR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> Rewrite c HermitM CoreExpr
 alphaCaseBinderR mn = setFailMsg (wrongFormForAlpha "Case e v ty alts") $
                      do Case _ v _ _ <- idR
-                        nameModifier <- freshNameGenT mn
+                        nameModifier <- extractT (freshNameGenT mn)
                         v' <- constT (cloneVarH nameModifier v)
                         caseAnyR idR (return v') idR (\ _ -> replaceVarR v v')
 
 -----------------------------------------------------------------------
 
 -- | Rename the specified variable in a case alternative.  Optionally takes a suggested new name.
-alphaAltVarR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe TH.Name -> Var -> Rewrite c HermitM CoreAlt
+alphaAltVarR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> Var -> Rewrite c HermitM CoreAlt
 alphaAltVarR mn v = do
-    nameModifier <- liftM (freshNameGenAvoiding mn) $ liftM2 unionVarSet boundVarsT (arr freeVarsAlt)
+    nameModifier <- freshNameGenAvoiding mn <$> liftM2 unionVarSet boundVarsT (arr freeVarsAlt)
     v' <- constT (cloneVarH nameModifier v)
-    -- Must replace the binder first, then substitution will work.
-    altAllR idR (\_ -> arr (replaceVar v v')) idR >>> substAltR v (varToCoreExpr v')
+    (con, vs, rhs) <- idR
+    -- This is a bit of a hack. We include all the binders *after* v in the call to substAltR,
+    -- then put the binders before v, and v', back on the front. The use of substAltR this way,
+    -- handles the case where v is a type binder which substitutes into the types of bs'.
+    -- It's a hack because we depend on substAltR not noticing that the constructor is not applied
+    -- to enough binders.
+    case break (==v) vs of
+        (bs,_:bs') -> let (con',bs'',rhs') = substCoreAlt v (varToCoreExpr v') (con,bs',rhs)
+                       in return (con',bs ++ (v':bs''),rhs')
+        _ -> fail "pattern binder not present."
 
 -- | Rename the specified variables in a case alternative, using the suggested names where provided.
 -- Suggested names *must* be provided in left-to-right order matching the order of the alt binders.
-alphaAltVarsWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [(Maybe TH.Name,Var)] -> Rewrite c HermitM CoreAlt
+alphaAltVarsWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [(Maybe String,Var)] -> Rewrite c HermitM CoreAlt
 alphaAltVarsWithR = andR . map (uncurry alphaAltVarR) . reverse -- note: right-to-left so type subst aren't undone
 
 -- | Rename the variables bound in a case alternative with the given list of suggested names.
-alphaAltWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [TH.Name] -> Rewrite c HermitM CoreAlt
+alphaAltWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [String] -> Rewrite c HermitM CoreAlt
 alphaAltWithR ns =
   do vs <- arr altVars
      alphaAltVarsWithR $ zip (map Just ns) vs
@@ -230,30 +244,34 @@
 -----------------------------------------------------------------------
 
 -- | Alpha rename a non-recursive let binder.  Optionally takes a suggested new name.
-alphaLetNonRecR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe TH.Name -> Rewrite c HermitM CoreExpr
+alphaLetNonRecR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> Rewrite c HermitM CoreExpr
 alphaLetNonRecR mn = setFailMsg (wrongFormForAlpha "Let (NonRec v e1) e2") $
-                    do (v, nameModifier) <- letNonRecT idR mempty (freshNameGenT mn) (\ v () nameMod -> (v, nameMod))
+                    do (v, nameModifier) <- letNonRecT idR successT (extractT $ freshNameGenT mn) (\ v () nameMod -> (v, nameMod))
                        v' <- constT (cloneVarH nameModifier v)
                        letNonRecAnyR (return v') idR (replaceVarR v v')
 
 -- | Alpha rename a non-recursive let binder if the variable appears in the argument list.  Optionally takes a suggested new name.
-alphaLetNonRecVarsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe TH.Name -> [Var] -> Rewrite c HermitM CoreExpr
+alphaLetNonRecVarsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> [Var] -> Rewrite c HermitM CoreExpr
 alphaLetNonRecVarsR mn vs = whenM ((`elem` vs) <$> letNonRecVarT) (alphaLetNonRecR mn)
 
--- | Rename the specified identifier bound in a recursive let.  Optionally takes a suggested new name.
-alphaLetRecIdR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe TH.Name -> Id -> Rewrite c HermitM CoreExpr
-alphaLetRecIdR mn v = setFailMsg (wrongFormForAlpha "Let (Rec bs) e") $
+
+-- TODO: Maybe it would be more efficient to rename all the Ids at once, rather than one by one?
+
+-- | Rename the specified identifiers in a recursive let, using the suggested names where provided.
+alphaLetRecIdsWithR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [(Maybe String,Id)] -> Rewrite c HermitM CoreExpr
+alphaLetRecIdsWithR = andR . map (uncurry alphaLetRecIdR)
+  where
+    -- | Rename the specified identifier bound in a recursive let.  Optionally takes a suggested new name.
+    alphaLetRecIdR :: Maybe String -> Id -> Rewrite c HermitM CoreExpr
+    alphaLetRecIdR mn v = setFailMsg (wrongFormForAlpha "Let (Rec bs) e") $
                      do usedVars <- unionVarSet <$> boundVarsT
                                                 <*> letRecT (\ _ -> defT idR (arr freeVarsExpr) (flip extendVarSet)) (arr freeVarsExpr) (\ bndfvs vs -> unionVarSets (vs:bndfvs))
                         v' <- constT (cloneVarH (freshNameGenAvoiding mn usedVars) v)
                         letRecDefAnyR (\ _ -> (arr (replaceVar v v'), replaceVarR v v')) (replaceVarR v v')
 
--- | Rename the specified identifiers in a recursive let, using the suggested names where provided.
-alphaLetRecIdsWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [(Maybe TH.Name,Id)] -> Rewrite c HermitM CoreExpr
-alphaLetRecIdsWithR = andR . map (uncurry alphaLetRecIdR)
 
 -- | Rename the identifiers bound in a Let with the given list of suggested names.
-alphaLetWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [TH.Name] -> Rewrite c HermitM CoreExpr
+alphaLetWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [String] -> Rewrite c HermitM CoreExpr
 alphaLetWithR ns = alphaLetNonRecR (listToMaybe ns)
                   <+ (letRecIdsT >>= (alphaLetRecIdsWithR . zip (map Just ns)))
 
@@ -271,44 +289,53 @@
 -----------------------------------------------------------------------
 
 -- | Alpha rename a non-recursive top-level binder.  Optionally takes a suggested new name.
-alphaProgConsNonRecR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c) => TH.Name -> Rewrite c HermitM CoreProg
-alphaProgConsNonRecR n = setFailMsg (wrongFormForAlpha "ProgCons (NonRec v e) p") $
-                    do ProgCons (NonRec v _) _ <- idR
-                       v' <- constT (cloneVarH (\ _ -> TH.nameBase n) v)
-                       consNonRecAnyR (return v') idR (replaceVarR v v')
+alphaProgConsNonRecR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> Rewrite c HermitM CoreProg
+alphaProgConsNonRecR mn = setFailMsg (wrongFormForAlpha "ProgCons (NonRec v e) p") $
+                    do (i, nameModifier) <- consNonRecT idR successT (extractT $ freshNameGenT mn) (\ i () nameMod -> (i, nameMod))
+                       guardMsg (not $ isExportedId i) ("Identifier " ++ var2String i ++ " is exported, and thus cannot be alpha-renamed.")
+                       i' <- constT (cloneVarH nameModifier i)
+                       consNonRecAnyR (return i') idR (replaceVarR i i')
 
--- -- | Alpha rename a non-recursive top-level binder if the identifier appears in the argument list.  Optionally takes a suggested new name.
--- alphaConsNonRecIds :: Maybe TH.Name -> [Id] -> Rewrite c m CoreProg
--- alphaConsNonRecIds mn vs = whenM ((`elem` vs) <$> consNonRecIdT) (alphaConsNonRec mn)
+-- | Alpha rename a non-recursive top-level binder if the identifier appears in the argument list.  Optionally takes a suggested new name.
+alphaProgConsNonRecIdsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Maybe String -> [Id] -> Rewrite c HermitM CoreProg
+alphaProgConsNonRecIdsR mn is = whenM ((`elem` is) <$> progConsNonRecIdT) (alphaProgConsNonRecR mn)
 
--- | Rename the specified identifier bound in a recursive top-level binder.  Optionally takes a suggested new name.
-alphaProgConsRecIdR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c) => TH.Name -> Id -> Rewrite c HermitM CoreProg
-alphaProgConsRecIdR n v =  setFailMsg (wrongFormForAlpha "ProgCons (Rec bs) p") $
-                      do v' <- constT (cloneVarH (\ _ -> TH.nameBase n) v)
-                         consRecDefAnyR (\ _ -> (arr (replaceVar v v'), replaceVarR v v')) (replaceVarR v v')
+-- TODO: Maybe it would be more efficient to rename all the Ids at once, rather than one by one?
 
 -- | Rename the specified identifiers in a recursive top-level binding at the head of a program, using the suggested names where provided.
-alphaProgConsRecIdsWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c) => [(TH.Name,Id)] -> Rewrite c HermitM CoreProg
-alphaProgConsRecIdsWithR = andR . map (uncurry alphaProgConsRecIdR)
+alphaProgConsRecIdsWithR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [(Maybe String,Id)] -> Rewrite c HermitM CoreProg
+alphaProgConsRecIdsWithR = andR . map (uncurry alphaProgConsRecIdR) . filter (not . isExportedId . snd)
+  where
+    -- | Rename the specified identifier bound in a recursive top-level binder.  Optionally takes a suggested new name.
+    alphaProgConsRecIdR :: Maybe String -> Id -> Rewrite c HermitM CoreProg
+    alphaProgConsRecIdR mn i =  setFailMsg (wrongFormForAlpha "ProgCons (Rec bs) p") $
+                      do usedVars <- unionVarSet <$> boundVarsT
+                                                 <*> consRecT (\ _ -> defT idR (arr freeVarsExpr) (flip extendVarSet)) (arr freeVarsProg) (\ bndfvs vs -> unionVarSets (vs:bndfvs))
+                         i' <- constT (cloneVarH (freshNameGenAvoiding mn usedVars) i)
+                         consRecDefAnyR (\ _ -> (arr (replaceVar i i'), replaceVarR i i')) (replaceVarR i i')
 
+
 -- | Rename the identifiers bound in the top-level binding at the head of the program with the given list of suggested names.
-alphaProgConsWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c) => [TH.Name] -> Rewrite c HermitM CoreProg
-alphaProgConsWithR []     = fail "At least one new name must be provided."
-alphaProgConsWithR (n:ns) = alphaProgConsNonRecR n <+ (progConsRecIdsT >>= (alphaProgConsRecIdsWithR . zip (n:ns)))
+alphaProgConsWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [String] -> Rewrite c HermitM CoreProg
+alphaProgConsWithR ns = alphaProgConsNonRecR (listToMaybe ns)
+                        <+ (progConsRecIdsT >>= (alphaProgConsRecIdsWithR . zip (map Just ns)))
 
--- -- | Rename the specified variables bound in the top-level binding at the head of the program.
--- alphaConsIds :: [Id] -> Rewrite c m CoreProg
--- alphaConsIds vs = alphaConsNonRecIds Nothing vs <+ alphaConsRecIdsWith (zip (repeat Nothing) vs)
+-- | Rename the specified variables bound in the top-level binding at the head of the program.
+alphaProgConsIdsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => [Id] -> Rewrite c HermitM CoreProg
+alphaProgConsIdsR vs = alphaProgConsNonRecIdsR Nothing vs
+                       <+ (do bs <- progConsT (arr bindVars) successT const
+                              alphaProgConsRecIdsWithR (zip (repeat Nothing) (bs `intersect` vs))
+                          )
 
--- -- | Rename all identifiers bound in the top-level binding at the head of the program.
--- alphaCons :: Rewrite c m CoreProg
--- alphaCons = consIdsT >>= alphaConsIds
+-- | Rename all identifiers bound in the top-level binding at the head of the program.
+alphaProgConsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Rewrite c HermitM CoreProg
+alphaProgConsR = progConsIdsT >>= alphaProgConsIdsR
 
 -----------------------------------------------------------------------
 
--- -- | Rename all identifiers bound at the top-level.
--- alphaProg :: Rewrite c m CoreProg
--- alphaProg = progNilT ProgNil <+ (alphaCons >>> progConsAllR idR alphaProg)
+-- | Rename all identifiers bound at the top-level.
+alphaProgR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Rewrite c HermitM CoreProg
+alphaProgR = alphaProgConsR >+> progConsAllR idR alphaProgR
 
 -----------------------------------------------------------------------
 
@@ -317,6 +344,10 @@
 alphaR = setFailMsg "Cannot alpha-rename here." $
            promoteExprR (alphaLamR Nothing <+ alphaCaseBinderR Nothing <+ alphaLetR)
         <+ promoteAltR alphaAltR
+        <+ promoteProgR alphaProgConsR
+
+-- TODO: Alpha rewrites need better error messages.  Currently the use of (<+) leads to incorrect error reporting.
+--       Though really, we first need to improve KURE to have a version of (<+) that maintains the existing error message in the case of non-matching constructors henceforth.
 
 -----------------------------------------------------------------------
 
diff --git a/src/HERMIT/Dictionary/Common.hs b/src/HERMIT/Dictionary/Common.hs
--- a/src/HERMIT/Dictionary/Common.hs
+++ b/src/HERMIT/Dictionary/Common.hs
@@ -26,7 +26,7 @@
     , letRecIdsT
     , letNonRecVarT
     , caseVarsT
-    , caseWildIdT
+    , caseBinderIdT
     , caseAltVarsT
       -- ** Finding variables bound in the Context
     , boundVarsT
@@ -36,6 +36,8 @@
     , varBindingDepthT
     , varIsOccurrenceOfT
     , exprIsOccurrenceOfT
+    , inScope
+    , withVarsInScope
       -- Miscellaneous
     , wrongExprForm
     )
@@ -46,14 +48,13 @@
 import Data.Monoid
 
 import Control.Arrow
+import Control.Monad
 
 import HERMIT.Kure
 import HERMIT.Core
 import HERMIT.Context
 import HERMIT.GHC
 
-import qualified Language.Haskell.TH as TH
-
 ------------------------------------------------------------------------------
 
 -- | Apply a transformation to a value in the current context.
@@ -79,9 +80,9 @@
 
 -- | Succeeds if we are looking at an application of given function
 --   returning zero or more arguments to which it is applied.
-callNameT :: MonadCatch m => TH.Name -> Translate c m CoreExpr (CoreExpr, [CoreExpr])
-callNameT nm = setFailMsg ("callNameT failed: not a call to '" ++ show nm ++ ".") $
-    callPredT (const . cmpTHName2Var nm)
+callNameT :: MonadCatch m => String -> Translate c m CoreExpr (CoreExpr, [CoreExpr])
+callNameT nm = setFailMsg ("callNameT failed: not a call to '" ++ nm ++ ".") $
+    callPredT (const . cmpString2Var nm)
 
 -- | Succeeds if we are looking at a fully saturated function call.
 callSaturatedT :: Monad m => Translate c m CoreExpr (CoreExpr, [CoreExpr])
@@ -90,7 +91,7 @@
 --       idArity is conservatively set to zero by default.
 
 -- | Succeeds if we are looking at an application of given function
-callNameG :: MonadCatch m => TH.Name -> Translate c m CoreExpr ()
+callNameG :: MonadCatch m => String -> Translate c m CoreExpr ()
 callNameG nm = prefixFailMsg "callNameG failed: " $ callNameT nm >>= \_ -> constT (return ())
 
 -- | Succeeds if we are looking at an application of a data constructor.
@@ -106,19 +107,20 @@
 #endif
 
 -- | Succeeds if we are looking at an application of a named data constructor.
-callDataConNameT :: MonadCatch m => TH.Name -> Translate c m CoreExpr (DataCon, [Type], [CoreExpr])
+callDataConNameT :: MonadCatch m => String -> Translate c m CoreExpr (DataCon, [Type], [CoreExpr])
 callDataConNameT nm = do
     res@(dc,_,_) <- callDataConT
-    guardMsg (cmpTHName2Name nm (dataConName dc)) "wrong datacon."
+    guardMsg (cmpString2Name nm (dataConName dc)) "wrong datacon."
     return res
 
+-- TODO: Both callsR and callsT should be eliminated, now that we have callNameT
 -- | Apply a rewrite to all applications of a given function in a top-down manner, pruning on success.
-callsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => TH.Name -> Rewrite c m CoreExpr -> Rewrite c m Core
+callsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => String -> Rewrite c m CoreExpr -> Rewrite c m Core
 callsR nm rr = prunetdR (promoteExprR $ callNameG nm >> rr)
 
 -- | Apply a translate to all applications of a given function in a top-down manner,
 --   pruning on success, collecting the results.
-callsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => TH.Name -> Translate c m CoreExpr b -> Translate c m Core [b]
+callsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => String -> Translate c m CoreExpr b -> Translate c m Core [b]
 callsT nm t = collectPruneT (promoteExprT $ callNameG nm >> t)
 
 ------------------------------------------------------------------------------
@@ -159,13 +161,13 @@
 letNonRecVarT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, Monad m) => Translate c m CoreExpr Var
 letNonRecVarT = letT nonRecVarT mempty (\ v () -> v)
 
--- | List all variables bound by a case expression (in the alternatives and the wildcard binder).
+-- | List all variables bound by a case expression (in the alternatives and the case binder).
 caseVarsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, Monad m) => Translate c m CoreExpr [Var]
 caseVarsT = caseT mempty idR mempty (\ _ -> arr altVars) (\ () v () vss -> v : nub (concat vss))
 
--- | Return the case wildcard binder.
-caseWildIdT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, Monad m) => Translate c m CoreExpr Id
-caseWildIdT = caseT mempty idR mempty (\ _ -> idR) (\ () i () _ -> i)
+-- | Return the case binder.
+caseBinderIdT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, Monad m) => Translate c m CoreExpr Id
+caseBinderIdT = caseT mempty idR mempty (\ _ -> idR) (\ () i () _ -> i)
 
 -- | List the variables bound by all alternatives in a case expression.
 caseAltVarsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, Monad m) => Translate c m CoreExpr [[Var]]
@@ -192,8 +194,8 @@
 boundVarsT = contextonlyT (return . boundVars)
 
 -- | Find the unique variable bound in the context that matches the given name, failing if it is not unique.
-findBoundVarT :: (BoundVars c, MonadCatch m) => TH.Name -> Translate c m a Var
-findBoundVarT nm = prefixFailMsg ("Cannot resolve name " ++ show nm ++ ", ") $
+findBoundVarT :: (BoundVars c, MonadCatch m) => String -> Translate c m a Var
+findBoundVarT nm = prefixFailMsg ("Cannot resolve name " ++ nm ++ ", ") $
                         do c <- contextT
                            case varSetElems (findBoundVars nm c) of
                              []         -> fail "no matching variables in scope."
@@ -201,26 +203,27 @@
                              _ : _ : _  -> fail "multiple matching variables in scope."
 
 -- | Lookup the name in the context first, then, failing that, in GHC's global reader environment.
-findIdT :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m, MonadCatch m) => TH.Name -> Translate c m a Id
-findIdT nm = prefixFailMsg ("Cannot resolve name " ++ show nm ++ ", ") $
+findIdT :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m, MonadCatch m) => String -> Translate c m a Id
+findIdT nm = prefixFailMsg ("Cannot resolve name " ++ nm ++ ", ") $
              contextonlyT (findId nm)
 
-findId :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m) => TH.Name -> c -> m Id
-findId nm c = case varSetElems (findBoundVars nm c) of
+findId :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m) => String -> c -> m Id
+findId nm c = case {- filter (isValName . idName) $ -} varSetElems (findBoundVars nm c) of
                 []         -> findIdMG nm c
                 [v]        -> return v
                 _ : _ : _  -> fail "multiple matching variables in scope."
 
-findIdMG :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m) => TH.Name -> c -> m Id
+findIdMG :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m) => String -> c -> m Id
 findIdMG nm c =
-    case filter isValName $ findNamesFromTH (hermitGlobalRdrEnv c) nm of
+    case filter isValName $ findNamesFromString (hermitGlobalRdrEnv c) nm of
       []  -> findIdBuiltIn nm
-      [n] -> lookupId n
+      [n] | isVarName n     -> lookupId n 
+          | isDataConName n ->  liftM dataConWrapId $ lookupDataCon n
       ns  -> do dynFlags <- getDynFlags
                 fail $ "multiple matches found:\n" ++ intercalate ", " (map (showPpr dynFlags) ns)
 
-findIdBuiltIn :: forall m. Monad m => TH.Name -> m Id
-findIdBuiltIn = go . show
+findIdBuiltIn :: forall m. Monad m => String -> m Id
+findIdBuiltIn = go 
     where go ":"     = dataConId consDataCon
           go "[]"    = dataConId nilDataCon
 
@@ -240,6 +243,22 @@
 
           dataConId :: DataCon -> m Id
           dataConId = return . dataConWorkId
+
+
+-- TODO: "inScope" was defined elsewhere, but I've moved it here.  Should it be combined with the above functions?
+
+-- | Determine whether a variable is in scope.
+inScope :: ReadBindings c => c -> Var -> Bool
+inScope c v = (v `boundIn` c) ||                 -- defined in this module
+              (isId v &&                         -- idInfo panics on TyVars
+               case unfoldingInfo (idInfo v) of
+                CoreUnfolding {} -> True         -- defined elsewhere
+                DFunUnfolding {} -> True
+                _                -> False)
+
+withVarsInScope :: forall c m b. (ReadPath c Crumb, ExtendPath c Crumb, AddBindings c, MonadCatch m) 
+                => [Var] -> Translate c m CoreExpr b -> Translate c m CoreExpr b
+withVarsInScope vs t = arr (mkCoreLams vs) >>> extractT (pathT (replicate (length vs) Lam_Body) (promoteExprT t :: Translate c m Core b))
 
 ------------------------------------------------------------------------------
 
diff --git a/src/HERMIT/Dictionary/Composite.hs b/src/HERMIT/Dictionary/Composite.hs
--- a/src/HERMIT/Dictionary/Composite.hs
+++ b/src/HERMIT/Dictionary/Composite.hs
@@ -26,8 +26,6 @@
 import HERMIT.Dictionary.Local hiding (externals)
 import HERMIT.Dictionary.Unfold hiding (externals)
 
-import qualified Language.Haskell.TH as TH
-
 ------------------------------------------------------------------------------------------------------
 
 externals ::  [External]
@@ -38,10 +36,16 @@
         [ "innermost (unfold-basic-combinator <+ beta-reduce-plus <+ safe-let-subst <+ case-reduce <+ let-elim)" ]
     , external "bash" (bashR :: RewriteH Core)
         bashHelp .+ Eval .+ Deep .+ Loop
+    , external "smash" (smashR :: RewriteH Core)
+        smashHelp .+ Eval .+ Deep .+ Loop .+ Experiment
     , external "bash-extended-with" (bashExtendedWithR :: [RewriteH Core] -> RewriteH Core)
-        [ "Run \"bash\" extended with an additional rewrite.",
+        [ "Run \"bash\" extended with additional rewrites.",
           "Note: be sure that the new rewrite either fails or makes progress, else this may loop."
         ] .+ Eval .+ Deep .+ Loop
+    , external "smash-extended-with" (smashExtendedWithR :: [RewriteH Core] -> RewriteH Core)
+        [ "Run \"smash\" extended with additional rewrites.",
+          "Note: be sure that the new rewrite either fails or makes progress, else this may loop."
+        ] .+ Eval .+ Deep .+ Loop
     , external "bash-debug" (bashDebugR :: RewriteH Core)
         [ "verbose bash - most useful with set-auto-corelint True" ] .+ Eval .+ Deep .+ Loop
     ]
@@ -55,7 +59,7 @@
 --   This is intended to be used as a component of simplification traversals such as 'simplifyR' or 'bashR'.
 unfoldBasicCombinatorR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
 unfoldBasicCombinatorR = setFailMsg "unfold-basic-combinator failed." $
-     unfoldNamesR (map TH.mkName basicCombinators)
+     unfoldNamesR basicCombinators
 
 simplifyR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM Core
 simplifyR = setFailMsg "Simplify failed: nothing to simplify." $
@@ -63,20 +67,36 @@
                 <+ promoteExprR ( unfoldBasicCombinatorR
                                <+ betaReducePlusR
                                <+ letNonRecSubstSafeR
-                               <+ caseReduceR
+                               <+ caseReduceR False
                                <+ letElimR )
                )
 
 ------------------------------------------------------------------------------------------------------
 
 bashR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM Core
-bashR = bashUsingR (map fst bashComponents)
+bashR = bashExtendedWithR []
 
 bashExtendedWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [Rewrite c HermitM Core] -> Rewrite c HermitM Core
 bashExtendedWithR rs = bashUsingR (rs ++ map fst bashComponents)
 
+
+smashR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM Core
+smashR = smashExtendedWithR []
+
+smashExtendedWithR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [Rewrite c HermitM Core] -> Rewrite c HermitM Core
+smashExtendedWithR rs = smashUsingR (rs ++ map fst smashComponents1) (map fst smashComponents2)
+
+
+-- | Like bashR, but outputs name of each successful sub-rewrite, providing a log.
+-- Also performs core lint on the result of a successful sub-rewrite.
+-- If core lint fails, shows core fragment before and after the sub-rewrite which introduced the problem.
+-- Note: core fragment which fails linting is still returned! Otherwise would behave differently than bashR.
+-- Useful for debugging the bash command itself.
 bashDebugR :: RewriteH Core
-bashDebugR = bashUsingR $ map (\ (r,nm) -> r >>> observeR nm) bashComponents
+bashDebugR = bashUsingR [ idR >>= \e -> r >>> traceR nm >>> (catchM (promoteT lintExprT >> idR)
+                                                                    (\s -> do _ <- return e >>> observeR "[before]"
+                                                                              observeR ("[" ++ nm ++ "]\n" ++ s)))
+                        | (r,nm) <- bashComponents ]
 
 -- bashUsingR :: forall c m. (ExtendPath c Crumb, AddBindings c, MonadCatch m) => [Rewrite c m Core] -> Rewrite c m Core
 -- bashUsingR rs =
@@ -95,6 +115,12 @@
     setFailMsg "bash failed: nothing to do." $
     repeatR (occurAnalyseR >>> onetdR (catchesT rs)) >+> anytdR (promoteExprR dezombifyR) >+> occurAnalyseChangedR
 
+smashUsingR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => [Rewrite c m Core] -> [Rewrite c m Core] -> Rewrite c m Core
+smashUsingR rs1 rs2 =
+    setFailMsg "smash failed: nothing to do." $
+    repeatR (occurAnalyseR >>> (onetdR (catchesT rs1) <+ onetdR (catchesT rs2))) >+> anytdR (promoteExprR dezombifyR) >+> occurAnalyseChangedR
+
+
  --   occurAnalyseChangedR >+> (innermostR (catchesT rs) >>> occurAnalyseR)
 
 {-
@@ -119,8 +145,8 @@
 bashComponents =
   [ -- (promoteExprR occurAnalyseExprChangedR, "occur-analyse-expr")    -- ??
     (promoteExprR betaReduceR, "beta-reduce")                        -- O(1)
-  , (promoteExprR caseReduceR, "case-reduce")                        -- O(n)
-  , (promoteExprR caseReduceIdR, "case-reduce-id")                   -- O(n)
+  , (promoteExprR (caseReduceR True), "case-reduce")                 -- O(n)
+  , (promoteExprR (caseReduceIdR True), "case-reduce-id")            -- O(n)
   , (promoteExprR caseElimSeqR, "case-elim-seq")
   , (promoteExprR unfoldBasicCombinatorR, "unfold-basic-combinator") -- O(n)
   , (promoteExprR inlineCaseAlternativeR, "inline-case-alternative") -- O(n)
@@ -143,6 +169,52 @@
   , (promoteExprR castElimSymR, "cast-elim-sym")                     -- O(1)
 --  , (promoteExprR dezombifyR, "dezombify")                           -- O(1) -- performed at the end
   ]
+
+
+smashHelp :: [String]
+smashHelp = "A more powerful but less efficient version of \"bash\", intended for use while proving lemmas.  Iteratively apply the following rewrites until nothing changes:" : map snd (smashComponents1 ++ smashComponents2
+                                                                                           :: [(RewriteH Core,String)] -- to resolve ambiguity
+                                                                                        )
+
+
+-- | As bash, but with "let-nonrec-subst" instead of "let-nonrec-subst-safe".
+smashComponents1 :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [(Rewrite c HermitM Core, String)]
+smashComponents1 =
+  [ -- (promoteExprR occurAnalyseExprChangedR, "occur-analyse-expr")    -- ??
+    (promoteExprR betaReduceR, "beta-reduce")                        -- O(1)
+  , (promoteExprR (caseReduceR True), "case-reduce")                 -- O(n)
+  , (promoteExprR (caseReduceIdR True), "case-reduce-id")            -- O(n)
+  , (promoteExprR caseElimSeqR, "case-elim-seq")
+  , (promoteExprR unfoldBasicCombinatorR, "unfold-basic-combinator") -- O(n)
+  , (promoteExprR inlineCaseAlternativeR, "inline-case-alternative") -- O(n)
+  , (promoteExprR etaReduceR, "eta-reduce")                          -- O(n)
+--  , (promoteBindR recToNonrecR, "rec-to-nonrec")                     -- O(n) -- subsumed by occurrence analysis
+  , (promoteExprR letNonRecSubstR, "let-nonrec-subst")               -- O(n)
+  , (promoteExprR caseFloatAppR, "case-float-app")                   -- O(n)
+  , (promoteExprR caseFloatCaseR, "case-float-case")                 -- O(n)
+  , (promoteExprR caseFloatLetR, "case-float-let")                   -- O(n) but usually O(1)
+  , (promoteExprR caseFloatCastR, "case-float-cast")                 -- O(1)
+--  , (promoteExprR letElimR, "let-elim")  -- O(n^2) -- Subsumed by occurrence analysis.
+  , (promoteExprR letFloatAppR, "let-float-app")                     -- O(n)
+  , (promoteExprR letFloatArgR, "let-float-arg")                     -- O(n)
+  , (promoteExprR letFloatLamR, "let-float-lam")                     -- O(n)
+  , (promoteExprR letFloatLetR, "let-float-let")                     -- O(n)
+  , (promoteExprR letFloatCaseR, "let-float-case")                   -- O(n)
+  , (promoteExprR letFloatCastR, "let-float-cast")                   -- O(1)
+  , (promoteProgR letFloatTopR, "let-float-top")                     -- O(n)
+  , (promoteExprR castElimReflR, "cast-elim-refl")                   -- O(1)
+  , (promoteExprR castElimSymR, "cast-elim-sym")                     -- O(1)
+--  , (promoteExprR dezombifyR, "dezombify")                           -- O(1) -- performed at the end
+  ]
+
+smashComponents2 :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [(Rewrite c HermitM Core, String)]
+smashComponents2 =
+  [
+    (promoteExprR caseElimMergeAltsR, "case-elim-merge-alts") -- do this last, lest it prevent other simplifications
+  ]
+
+
+-- (beta-reduce <+ case-reduce <+ case-reduce-id <+ case-elim-seq <+ unfold-basic-combinator <+ inline-case-alternative <+ eta-reduce <+ let-subst <+ case-float-app <+ case-float-case <+ case-float-let <+ case-float-cast <+ let-float-app <+ let-float-arg <+ let-float-lam <+ let-float-let <+ let-float-case <+ let-float-cast <+ let-float-top <+ cast-elim-refl <+ cast-elim-sym
 
 ------------------------------------------------------------------------------------------------------
 
diff --git a/src/HERMIT/Dictionary/FixPoint.hs b/src/HERMIT/Dictionary/FixPoint.hs
--- a/src/HERMIT/Dictionary/FixPoint.hs
+++ b/src/HERMIT/Dictionary/FixPoint.hs
@@ -34,8 +34,6 @@
 import HERMIT.Dictionary.Reasoning
 import HERMIT.Dictionary.Undefined
 
-import qualified Language.Haskell.TH as TH
-
 --------------------------------------------------------------------------------------------------
 
 -- | Externals for manipulating fixed points.
@@ -111,7 +109,7 @@
                    withPatFailMsg wrongFixBody $
                    do (tyA, Lam a (App f (App g (Var a')))) <- isFixExprT
                       guardMsg (a == a') wrongFixBody
-                      (tyA',tyB) <- funsWithInverseTypes g f
+                      (tyA',tyB) <- funExprsWithInverseTypes g f
                       guardMsg (eqType tyA tyA') "Type mismatch: this shouldn't have happened, report this as a bug."
                       res <- rollingRuleResult tyB g f
                       return (App f res)
@@ -124,7 +122,7 @@
                         do (tyB, Lam b (App g (App f' (Var b')))) <- isFixExprT <<< constant fx
                            guardMsg (b == b') wrongFixBody
                            guardMsg (exprAlphaEq f f') "external function does not match internal expression"
-                           (tyA,tyB') <- funsWithInverseTypes g f
+                           (tyA,tyB') <- funExprsWithInverseTypes g f
                            guardMsg (eqType tyB tyB') "Type mismatch: this shouldn't have happened, report this as a bug."
                            rollingRuleResult tyA f g
 
@@ -142,19 +140,19 @@
 -- h :: B -> B
 
 -- | If @f@ is strict, then (@f (g a)@ == @h (f a)@)  ==\>  (@f (fix g)@ == @fix h@)
-fixFusionRuleBR :: Maybe (RewriteH CoreExpr, RewriteH CoreExpr) -> Maybe (RewriteH CoreExpr) -> CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH CoreExpr
+fixFusionRuleBR :: Maybe (CoreExprEqualityProof HermitC HermitM) -> Maybe (RewriteH CoreExpr) -> CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH CoreExpr
 fixFusionRuleBR meq mfstrict f g h = beforeBiR
   (prefixFailMsg "fixed-point fusion failed: " $
-   do (tyA,tyB) <- funArgResTypes f
-      tyA'      <- endoFunType g
-      tyB'      <- endoFunType h
+   do (tyA,tyB) <- funExprArgResTypes f
+      tyA'      <- endoFunExprType g
+      tyB'      <- endoFunExprType h
       guardMsg (typeAlphaEq tyA tyA' && typeAlphaEq tyB tyB') "given functions do not have compatible types."
       whenJust (verifyStrictT f) mfstrict
-      whenJust (\ (lhsR,rhsR) ->
+      whenJust (\ eq ->
                   do a <- constT (newGlobalIdH "a" tyA)
                      let lhs = App f (App g (Var a))
                          rhs = App h (App f (Var a))
-                     verifyEqualityCommonTargetT lhs rhs lhsR rhsR
+                     verifyEqualityCommonTargetT lhs rhs eq
                )
                meq
   )
@@ -194,7 +192,7 @@
 
 -- | f  ==>  fix f
 mkFixT :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => CoreExpr -> Translate c m z CoreExpr
-mkFixT f = do t <- endoFunType f
+mkFixT f = do t <- endoFunExprType f
               fixId <- findFixId
               return $ mkCoreApps (varToCoreExpr fixId) [Type t, f]
 
@@ -203,6 +201,6 @@
 
 -- TODO: will crash if 'fix' is not used (or explicitly imported) in the source file.
 findFixId :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Translate c m a Id
-findFixId = findIdT (TH.mkName fixLocation)
+findFixId = findIdT fixLocation
 
 --------------------------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Fold.hs b/src/HERMIT/Dictionary/Fold.hs
--- a/src/HERMIT/Dictionary/Fold.hs
+++ b/src/HERMIT/Dictionary/Fold.hs
@@ -5,6 +5,8 @@
     , foldVarR
     , stashFoldR
     , stashFoldAnyR
+      -- * Unlifted fold interface
+    , fold
     )
 
 where
@@ -13,7 +15,6 @@
 import Control.Applicative
 import Control.Monad
 
-import Data.List (intercalate)
 import qualified Data.Map as Map
 
 import HERMIT.Core
@@ -23,19 +24,16 @@
 import HERMIT.External
 import HERMIT.GHC
 
-import HERMIT.Dictionary.Common (varBindingDepthT)
-import HERMIT.Dictionary.GHC hiding (externals)
+import HERMIT.Dictionary.Common (varBindingDepthT,inScope,findIdT)
 import HERMIT.Dictionary.Inline hiding (externals)
 
-import qualified Language.Haskell.TH as TH
-
 import Prelude hiding (exp)
 
 ------------------------------------------------------------------------
 
 externals :: [External]
 externals =
-    [ external "fold" (promoteExprR . foldR :: TH.Name -> RewriteH Core)
+    [ external "fold" (promoteExprR . foldR :: String -> RewriteH Core)
         [ "fold a definition"
         , ""
         , "double :: Int -> Int"
@@ -47,7 +45,7 @@
         , ""
         , "Note: due to associativity, if you wanted to fold 5 + 6 + 6, "
         , "you first need to apply an associativity rewrite." ]  .+ Context .+ Deep
-    , external "fold" (promoteExprR . stashFoldR :: Label -> RewriteH Core)
+    , external "fold-remembered" (promoteExprR . stashFoldR :: Label -> RewriteH Core)
         [ "Fold a remembered definition." ]                      .+ Context .+ Deep
     , external "fold-any" (promoteExprR stashFoldAnyR :: RewriteH Core)
         [ "Attempt to fold any of the remembered definitions." ] .+ Context .+ Deep
@@ -68,23 +66,20 @@
 stashFoldAnyR = setFailMsg "Fold failed: no definitions could be folded." $
                 catchesM =<< map stashFoldR <$> (Map.keys <$> constT getStash)
 
-foldR :: ReadBindings c => TH.Name -> Rewrite c HermitM CoreExpr
-foldR nm = prefixFailMsg "Fold failed: " $
-           do c <- contextT
-              case varSetElems (findBoundVars nm c) of
-                []  -> fail "cannot find name."
-                [v] -> foldVarR v Nothing
-                vs  -> fail $ "multiple names match: " ++ intercalate ", " (map var2String vs)
+foldR :: (HasGlobalRdrEnv c, ReadBindings c) => String -> Rewrite c HermitM CoreExpr
+foldR nm = prefixFailMsg "Fold failed: " $ do
+    v <- findIdT nm
+    foldVarR v Nothing
 
 foldVarR :: ReadBindings c => Var -> Maybe BindingDepth -> Rewrite c HermitM CoreExpr
-foldVarR v md =
-             do case md of
-                  Nothing    -> return ()
-                  Just depth -> do depth' <- varBindingDepthT v
-                                   guardMsg (depth == depth') "Specified binding depth does not match that of variable binding, this is probably a shadowing occurrence."
-                e <- idR
-                (rhs,_) <- getUnfoldingT AllBinders <<< return v
-                maybe (fail "no match.") return (fold v rhs e)
+foldVarR v md = do
+    case md of
+        Nothing    -> return ()
+        Just depth -> do depth' <- varBindingDepthT v
+                         guardMsg (depth == depth') "Specified binding depth does not match that of variable binding, this is probably a shadowing occurrence."
+    e <- idR
+    (rhs,_) <- getUnfoldingT AllBinders <<< return v
+    maybe (fail "no match.") return (fold v rhs e)
 
 ------------------------------------------------------------------------
 
@@ -113,39 +108,54 @@
     es <- sequence [ join (Map.lookup v m) | v <- vs ]
     return $ mkCoreApps (varToCoreExpr i) es
 
--- Note: Id in the concrete instance is first
--- (not the Id found in the definition we are trying to fold).
-addAlpha :: Id -> Id -> [(Id,Id)] -> [(Id,Id)]
+-- Note: Var in the concrete instance is first
+-- (not the Var found in the definition we are trying to fold).
+addAlpha :: Var -> Var -> [(Var,Var)] -> [(Var,Var)]
 addAlpha rId lId alphas | rId == lId = alphas
                         | otherwise  = (rId,lId) : alphas
 
+matchWithTypes :: [Var] -> [(Var,Var)] -> Id -> CoreExpr -> Maybe [(Var,CoreExpr)]
+matchWithTypes vs as i e = do
+    tys <- foldMatchType vs as (idType i) (exprType e)
+    return $ (i,e) : tyMatchesToCoreExpr tys
+
+tyMatchesToCoreExpr :: [(TyVar, Type)] -> [(Var, CoreExpr)]
+tyMatchesToCoreExpr = map (\(v,t) -> (v, Type t))
+
+------------------------------------------------------------------------
+
 -- Note: return list can have duplicate keys, caller is responsible
 -- for checking that dupes refer to same expression
 foldMatch :: [Var]          -- ^ vars that can unify with anything
-          -> [(Id,Id)]      -- ^ alpha equivalences, wherever there is binding
+          -> [(Var,Var)]    -- ^ alpha equivalences, wherever there is binding
                             --   note: we depend on behavior of lookup here, so new entries
                             --         should always be added to the front of the list so
                             --         we don't have to explicity remove them when shadowing occurs
           -> CoreExpr       -- ^ pattern we are matching on
           -> CoreExpr       -- ^ expression we are checking
           -> Maybe [(Var,CoreExpr)] -- ^ mapping of vars to expressions, or failure
-foldMatch vs as (Var i) e | i `elem` vs = return [(i,e)]
+
+foldMatch vs as (Var i) e | i `elem` vs = matchWithTypes vs as i e
                           | otherwise   = case e of
-                                            Var i' | maybe False (==i) (lookup i' as) -> return [(i,e)]
-                                                             -- TODO: type comparison here is a total hack,
-                                                             --       see notes in hermit-syb
-                                                   | i == i' && eqType (idType i) (idType i') -> return []
+                                            Var i' | maybe False (==i) (lookup i' as) -> matchWithTypes vs as i e
+                                                   | i == i' -> liftM tail $ matchWithTypes vs as i e 
+                                                                -- note we depend on (i,e) being at front here
+                                                                -- this is not strictly necessary, but is faster
                                             _                -> Nothing
 foldMatch _  _ (Lit l) (Lit l') | l == l' = return []
+
 foldMatch vs as (App e a) (App e' a') = do
     x <- foldMatch vs as e e'
     y <- foldMatch vs as a a'
     return (x ++ y)
+
 foldMatch vs as (Lam v e) (Lam v' e') = foldMatch (filter (/=v) vs) (addAlpha v' v as) e e'
+
 foldMatch vs as (Let (NonRec v rhs) e) (Let (NonRec v' rhs') e') = do
     x <- foldMatch vs as rhs rhs'
     y <- foldMatch (filter (/=v) vs) (addAlpha v' v as) e e'
     return (x ++ y)
+
 -- TODO: this depends on bindings being in the same order
 foldMatch vs as (Let (Rec bnds) e) (Let (Rec bnds') e') | length bnds == length bnds' = do
     let vs' = filter (`notElem` map fst bnds) vs
@@ -154,10 +164,12 @@
     x <- zipWithM bmatch bnds bnds'
     y <- foldMatch vs' as' e e'
     return (concat x ++ y)
+
 foldMatch vs as (Tick t e) (Tick t' e') | t == t' = foldMatch vs as e e'
-foldMatch vs as (Case s b ty alts) (Case s' b' ty' alts')
-  | length alts == length alts' = do
-    t <- foldMatch vs as (Type ty) (Type ty')
+
+foldMatch vs as (Case s b ty alts) (Case s' b' ty' alts') = do
+    guard (length alts == length alts')
+    t <- foldMatchType vs as ty ty'
     x <- foldMatch vs as s s'
     let as' = addAlpha b' b as
         vs' = filter (/=b) vs
@@ -165,12 +177,55 @@
             foldMatch (filter (`notElem` is) vs') (foldr (uncurry addAlpha) as' $ zip is' is) e e'
         altMatch _ _ = Nothing
     y <- zipWithM altMatch alts alts'
-    return (x ++ t ++ concat y)
-foldMatch vs as (Cast e c)   (Cast e' c')  | coreEqCoercion c c' = foldMatch vs as e e'
--- don't try to alpha type variables for now
-foldMatch vs _  (Type t@(TyVarTy v)) e@(Type t') | v `elem` vs = return [(v,e)]
-                                                 | eqType t t' = return []
-                                                 | otherwise   = Nothing
-foldMatch _ _   (Type t)     (Type t')     | eqType t t' = return []
-foldMatch _ _   (Coercion c) (Coercion c') | coreEqCoercion c c' = return []
+    return (x ++ tyMatchesToCoreExpr t ++ concat y)
+
+foldMatch vs as (Cast e c) (Cast e' c') = do
+    guard (coreEqCoercion c c') 
+    foldMatch vs as e e'
+
+foldMatch vs as (Type t1) (Type t2) = liftM tyMatchesToCoreExpr $ foldMatchType vs as t1 t2
+
+-- TODO: do we want to descend into these? There are Types in here.
+foldMatch _ _ (Coercion c) (Coercion c') | coreEqCoercion c c' = return []
+
 foldMatch _ _ _ _ = Nothing
+
+------------------------------------------------------------------------
+
+foldMatchType :: [TyVar]              -- ^ vars that can unify with anything
+              -> [(TyVar,TyVar)]      -- ^ alpha equivalences, wherever there is binding
+                                      --   note: we depend on behavior of lookup here, so new entries
+                                      --         should always be added to the front of the list so
+                                      --         we don't have to explicity remove them when shadowing occurs
+              -> Type                 -- ^ pattern we are matching on
+              -> Type                 -- ^ expression we are checking
+              -> Maybe [(TyVar,Type)] -- ^ mapping of vars to types, or failure
+
+foldMatchType vs as (TyVarTy v) t | v `elem` vs = return [(v,t)]
+                                  | otherwise = case t of
+                                                  TyVarTy v' | maybe False (==v) (lookup v' as) -> return [(v,t)]
+                                                             | v == v' {- compare kinds? -} -> return []
+                                                  _ -> Nothing
+
+foldMatchType vs as (AppTy ty1 ty2) (AppTy ty1' ty2') = do
+    x <- foldMatchType vs as ty1 ty1'
+    y <- foldMatchType vs as ty2 ty2'
+    return (x ++ y)
+
+foldMatchType vs as (TyConApp tc1 kOrTys1) (TyConApp tc2 kOrTys2) = do
+    guard ((tc1 == tc2) && (length kOrTys1 == length kOrTys2))
+    let f ty1 ty2 | isKind ty1 && eqKind ty1 ty2 = return []
+                  | otherwise = foldMatchType vs as ty1 ty2
+    liftM concat $ zipWithM f kOrTys1 kOrTys2
+    
+foldMatchType vs as (FunTy ty1 ty2) (FunTy ty1' ty2') = do
+    x <- foldMatchType vs as ty1 ty1'
+    y <- foldMatchType vs as ty2 ty2'
+    return (x ++ y)
+
+foldMatchType vs as (ForAllTy v ty) (ForAllTy v' ty') = foldMatchType (filter (/=v) vs) (addAlpha v' v as) ty ty'
+
+foldMatchType _ _ (LitTy l1) (LitTy l2) | l1 == l2 = return []
+
+foldMatchType _ _ _ _ = Nothing
+
diff --git a/src/HERMIT/Dictionary/Function.hs b/src/HERMIT/Dictionary/Function.hs
--- a/src/HERMIT/Dictionary/Function.hs
+++ b/src/HERMIT/Dictionary/Function.hs
@@ -60,7 +60,9 @@
     contextonlyT $ \ c -> do
         let bodyContext = foldl (flip addLambdaBinding) c bnds
 
-        callPats <- apply (callsT (var2THName f) (callT >>> arr snd)) bodyContext (ExprCore body)
+        -- TODO: we convert an Id to string here, and callsT then uses cmpString2Var
+        --       refactor to avoid intermediate string!
+        callPats <- apply (callsT (var2String f) (callT >>> arr snd)) bodyContext (ExprCore body)
         let argExprs = transpose callPats
             numCalls = length callPats
             allBinds = zip [0..] bnds
@@ -97,7 +99,7 @@
                 (_,exprs) <- callT
                 return $ mkApps (Var wkr) [ e | (p,e) <- zip [0..] exprs, (p::Int) `elem` ps ]
 
-        ExprCore body' <- apply (callsR (var2THName f) replaceCall) bodyContext (ExprCore body)
+        ExprCore body' <- apply (callsR (var2String f) replaceCall) bodyContext (ExprCore body)
 
         return $ Def f $ mkCoreLams bnds $ Let (Rec [(wkr, mkCoreLams dbnds body')])
                                              $ mkApps (Var wkr) (varsToCoreExprs dbnds)
diff --git a/src/HERMIT/Dictionary/GHC.hs b/src/HERMIT/Dictionary/GHC.hs
--- a/src/HERMIT/Dictionary/GHC.hs
+++ b/src/HERMIT/Dictionary/GHC.hs
@@ -1,24 +1,20 @@
-{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, FlexibleContexts #-}
 module HERMIT.Dictionary.GHC
        ( -- * GHC-based Transformations
          -- | This module contains transformations that are reflections of GHC functions, or derived from GHC functions.
          externals
-       , anyCallR
          -- ** Substitution
        , substR
-       , substAltR
+       , substCoreAlt
        , substCoreExpr
          -- ** Utilities
-       , inScope
-       , rule
-       , rules
+ --      , inScope
        , dynFlagsT
        , arityOf
          -- ** Lifted GHC capabilities
          -- A zombie is an identifer that has 'OccInfo' 'IAmDead', but still has occurrences.
        , lintExprT
        , lintModuleT
-       , specConstrR
        , occurAnalyseR
        , occurAnalyseChangedR
        , occurAnalyseExprChangedR
@@ -29,28 +25,19 @@
 
 import qualified Bag
 import qualified CoreLint
-import IOEnv hiding (liftIO)
-import qualified SpecConstr
-import qualified Specialise
 
 import Control.Arrow
-import Control.Monad
 
-import Data.Function (on)
-import Data.List (mapAccumL,deleteFirstsBy)
+import Data.List (mapAccumL)
 
 import HERMIT.Core
 import HERMIT.Context
-import HERMIT.Monad
 import HERMIT.Kure
 import HERMIT.External
 import HERMIT.GHC
 
 import HERMIT.Dictionary.Debug hiding (externals)
-import HERMIT.Dictionary.Kure (unitT)
 
-import qualified Language.Haskell.TH as TH
-
 ------------------------------------------------------------------------
 
 -- | Externals that reflect GHC functions, or are derived from GHC functions.
@@ -58,14 +45,6 @@
 externals =
          [ external "deshadow-prog" (promoteProgR deShadowProgR :: RewriteH Core)
                 [ "Deshadow a program." ] .+ Deep
-         , external "apply-rule" (promoteExprR . rule :: String -> RewriteH Core)
-                [ "Apply a named GHC rule" ] .+ Shallow
-         , external "apply-rule" (rules_help :: TranslateH Core String)
-                [ "List rules that can be used" ] .+ Query
-         , external "apply-rules" (promoteExprR . rules :: [String] -> RewriteH Core)
-                [ "Apply named GHC rules, succeed if any of the rules succeed" ] .+ Shallow
-         , external "add-rule" ((\ rule_name id_name -> promoteModGutsR (addCoreBindAsRule rule_name id_name)) :: String -> TH.Name -> RewriteH Core)
-                [ "add-rule \"rule-name\" <id> -- adds a new rule that freezes the right hand side of the <id>"]  .+ Introduce
          , external "dezombify" (promoteExprR dezombifyR :: RewriteH Core)
                 [ "Zap the occurrence information in the current identifer if it is a zombie."] .+ Shallow
          , external "occurrence-analysis" (occurrenceAnalysisR :: RewriteH Core)
@@ -78,21 +57,14 @@
                 , "will catch that however."] .+ Deep .+ Debug .+ Query
          , external "lint-module" (promoteModGutsT lintModuleT :: TranslateH Core String)
                 [ "Runs GHC's Core Lint, which typechecks the current module."] .+ Deep .+ Debug .+ Query
-         , external "spec-constr" (promoteModGutsR specConstrR :: RewriteH Core)
-                [ "Run GHC's SpecConstr pass, which performs call pattern specialization."] .+ Deep
-         , external "specialise" (promoteModGutsR specialise :: RewriteH Core)
-                [ "Run GHC's specialisation pass, which performs type and dictionary specialization."] .+ Deep
-         , external "any-call" (anyCallR :: RewriteH Core -> RewriteH Core)
-                [ "any-call (.. unfold command ..) applies an unfold command to all applications."
-                , "Preference is given to applications with more arguments." ] .+ Deep
          ]
 
 ------------------------------------------------------------------------
 
--- | Substitute all occurrences of a variable with an expression, in either a program or an expression.
+-- | Substitute all occurrences of a variable with an expression, in either a program, an expression, or a case alternative.
 substR :: MonadCatch m => Var -> CoreExpr -> Rewrite c m Core
 substR v e = setFailMsg "Can only perform substitution on expressions, case alternatives or programs." $
-             promoteExprR (arr $ substCoreExpr v e) <+ promoteProgR (substTopBindR v e) <+ promoteAltR (substAltR v e)
+             promoteExprR (arr $ substCoreExpr v e) <+ promoteProgR (substTopBindR v e) <+ promoteAltR (arr $ substCoreAlt v e)
 
 -- | Substitute all occurrences of a variable with an expression, in an expression.
 substCoreExpr :: Var -> CoreExpr -> (CoreExpr -> CoreExpr)
@@ -112,12 +84,12 @@
     return $ bindsToProg $ snd (mapAccumL substBind (extendSubst emptySub v e) (progToBinds p))
 
 -- | Substitute all occurrences of a variable with an expression, in a case alternative.
-substAltR :: Monad m => Var -> CoreExpr -> Rewrite c m CoreAlt
-substAltR v e = do
-    (inS, (c, vs, rhs)) <- arr (flip delVarSet v . unionVarSet (localFreeVarsExpr e) . localFreeVarsAlt) &&& idR
-    let subst = extendSubst (mkEmptySubst (mkInScopeSet inS)) v e
-        (subst', vs') = substBndrs subst vs
-    return (c, vs', substExpr (text "alt-rhs") subst' rhs)
+substCoreAlt :: Var -> CoreExpr -> CoreAlt -> CoreAlt
+substCoreAlt v e alt = let (con, vs, rhs) = alt
+                           inS            = (flip delVarSet v . unionVarSet (localFreeVarsExpr e) . localFreeVarsAlt) alt
+                           subst          = extendSubst (mkEmptySubst (mkInScopeSet inS)) v e
+                           (subst', vs')  = substBndrs subst vs
+                        in (con, vs', substExpr (text "alt-rhs") subst' rhs)
 
 ------------------------------------------------------------------------
 
@@ -130,120 +102,6 @@
 deShadowProgR :: Monad m => Rewrite c m CoreProg
 deShadowProgR = arr (bindsToProg . deShadowBinds . progToBinds)
 
-------------------------------------------------------------------------
-{-
-lookupRule :: (Activation -> Bool)	-- When rule is active
-	    -> IdUnfoldingFun		-- When Id can be unfolded
-            -> InScopeSet
-	    -> Id -> [CoreExpr]
-	    -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
-
-GHC HEAD:
-type InScopeEnv = (InScopeSet, IdUnfoldingFun)
-
-lookupRule :: DynFlags -> InScopeEnv
-           -> (Activation -> Bool)      -- When rule is active
-           -> Id -> [CoreExpr]
-           -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
--}
-
--- Neil: Commented this out as its not (currently) used.
--- rulesToEnv :: [CoreRule] -> Map.Map String (Rewrite c m CoreExpr)
--- rulesToEnv rs = Map.fromList
---         [ ( unpackFS (ruleName r), rulesToRewrite c m [r] )
---         | r <- rs
---         ]
-
-#if __GLASGOW_HASKELL__ > 706
-rulesToRewriteH :: (ReadBindings c, HasDynFlags m, MonadCatch m) => [CoreRule] -> Rewrite c m CoreExpr
-#else
-rulesToRewriteH :: (ReadBindings c, MonadCatch m) => [CoreRule] -> Rewrite c m CoreExpr
-#endif
-rulesToRewriteH rs = prefixFailMsg "RulesToRewrite failed: " $
-                     withPatFailMsg "rule not matched." $
-                     translate $ \ c e -> do
-    -- First, we normalize the lhs, so we can match it
-    (Var fn,args) <- return $ collectArgs e
-    -- Question: does this include Id's, or Var's (which include type names)
-    -- Assumption: Var's.
-    let in_scope = mkInScopeSet (mkVarEnv [ (v,v) | v <- varSetElems (localFreeVarsExpr e) ])
-        -- The rough_args are just an attempt to try eliminate silly things
-        -- that will never match
-        _rough_args = map (const Nothing) args   -- rough_args are never used!!! FIX ME!
-    -- Finally, we try match the rules
-    -- trace (showSDoc (ppr fn <+> ppr args $$ ppr rs)) $
-#if __GLASGOW_HASKELL__ > 706
-    dflags <- getDynFlags
-    case lookupRule dflags (in_scope, const NoUnfolding) (const True) fn args [r | r <- rs, ru_fn r == idName fn] of
-#else
-    case lookupRule (const True) (const NoUnfolding) in_scope fn args [r | r <- rs, ru_fn r == idName fn] of
-#endif
-        Nothing         -> fail "rule not matched"
-        Just (r, expr)  -> do
-            let e' = mkApps expr (drop (ruleArity r) args)
-            if all (inScope c) $ varSetElems $ localFreeVarsExpr e' -- TODO: The problem with this check, is that it precludes the case where this is an intermediate transformation.  I can imagine situations where some variables would be out-of-scope at this point, but in scope again after a subsequent transformation.
-              then return e'
-              else fail $ unlines ["Resulting expression after rule application contains variables that are not in scope."
-                                  ,"This can probably be solved by running the flatten-module command at the top level."]
-
--- | Determine whether an identifier is in scope.
-inScope :: ReadBindings c => c -> Id -> Bool
-inScope c v = (v `boundIn` c) ||                 -- defined in this module
-              case unfoldingInfo (idInfo v) of
-                CoreUnfolding {} -> True         -- defined elsewhere
-                DFunUnfolding {} -> True
-                _                -> False
-
--- | Lookup a rule and attempt to construct a corresponding rewrite.
-rule :: (ReadBindings c, HasCoreRules c) => String -> Rewrite c HermitM CoreExpr
-rule r = do
-    theRules <- getHermitRules
-    case lookup r theRules of
-        Nothing -> fail $ "failed to find rule: " ++ show r
-        Just rr -> rulesToRewriteH rr
-
-rules :: (ReadBindings c, HasCoreRules c) => [String] -> Rewrite c HermitM CoreExpr
-rules = orR . map rule
-
-getHermitRules :: HasCoreRules c => Translate c HermitM a [(String, [CoreRule])]
-getHermitRules = contextonlyT $ \ c -> do
-    rb     <- liftCoreM getRuleBase
-    hscEnv <- liftCoreM getHscEnv
-    rb'    <- liftM eps_rule_base $ liftIO $ runIOEnv () $ readMutVar (hsc_EPS hscEnv)
-    return [ ( unpackFS (ruleName r), [r] )
-           | r <- hermitCoreRules c ++ concat (nameEnvElts rb) ++ concat (nameEnvElts rb')
-           ]
-
-rules_help :: HasCoreRules c => Translate c HermitM Core String
-rules_help = do
-    rulesEnv <- getHermitRules
-    dynFlags <- dynFlagsT
-    return  $ (show (map fst rulesEnv) ++ "\n") ++
-              showSDoc dynFlags (pprRulesForUser $ concatMap snd rulesEnv)
-
-makeRule :: String -> Id -> CoreExpr -> CoreRule
-makeRule rule_name nm =   mkRule True   -- auto-generated
-                                 False  -- local
-                                 (mkFastString rule_name)
-                                 NeverActive    -- because we need to call for these
-                                 (varName nm)
-                                 []
-                                 []
-
--- TODO: check if a top-level binding
-addCoreBindAsRule :: Monad m => String -> TH.Name -> Rewrite c m ModGuts
-addCoreBindAsRule rule_name nm = contextfreeT $ \ modGuts ->
-        case [ (v,e)
-             | bnd   <- mg_binds modGuts
-             , (v,e) <- bindToVarExprs bnd
-             ,  nm `cmpTHName2Var` v
-             ] of
-         [] -> fail $ "cannot find binding " ++ show nm
-         [(v,e)] -> return $ modGuts { mg_rules = mg_rules modGuts
-                                              ++ [makeRule rule_name v e]
-                                     }
-         _ -> fail $ "found multiple bindings for " ++ show nm
-
 --------------------------------------------------------
 
 -- | Try to figure out the arity of an identifier.
@@ -290,59 +148,6 @@
 #else
                  $ CoreLint.lintUnfolding noSrcLoc (varSetElems $ boundVars c) e
 #endif
-
--- | Run GHC's specConstr pass, and apply any rules generated.
-specConstrR :: RewriteH ModGuts
-specConstrR = prefixFailMsg "spec-constr failed: " $ do
-    rs  <- extractT specRules
-    e'  <- contextfreeT $ liftCoreM . SpecConstr.specConstrProgram
-    rs' <- return e' >>> extractT specRules
-    let specRs = deleteFirstsBy ((==) `on` ru_name) rs' rs
-    guardMsg (notNull specRs) "no rules created."
-    return e' >>> extractR (repeatR (anyCallR (promoteExprR $ rulesToRewriteH specRs)))
-
--- | Run GHC's specialisation pass, and apply any rules generated.
-specialise :: RewriteH ModGuts
-specialise = prefixFailMsg "specialisation failed: " $ do
-    gRules <- arr mg_rules
-    lRules <- extractT specRules
-
-    dflags <- dynFlagsT
-    guts <- contextfreeT $ liftCoreM . Specialise.specProgram dflags
-
-    lRules' <- return guts >>> extractT specRules -- spec rules on bindings in this module
-    let gRules' = mg_rules guts            -- plus spec rules on imported bindings
-        gSpecRs = deleteFirstsBy ((==) `on` ru_name) gRules' gRules
-        lSpecRs = deleteFirstsBy ((==) `on` ru_name) lRules' lRules
-        specRs = gSpecRs ++ lSpecRs
-    guardMsg (notNull specRs) "no rules created."
-    liftIO $ putStrLn $ unlines $ map (unpackFS . ru_name) specRs
-    return guts >>> extractR (repeatR (anyCallR (promoteExprR $ rulesToRewriteH specRs)))
-
--- | Get all the specialization rules on a binding.
---   These are created by SpecConstr and other GHC passes.
-idSpecRules :: TranslateH Id [CoreRule]
-idSpecRules = contextfreeT $ \ i -> let SpecInfo rs _ = specInfo (idInfo i) in return rs
-
--- | Promote 'idSpecRules' to CoreBind.
-bindSpecRules :: TranslateH CoreBind [CoreRule]
-bindSpecRules =    recT (\_ -> defT idSpecRules unitT const) concat
-                <+ nonRecT idSpecRules unitT const
-
--- | Find all specialization rules in a Core fragment.
-specRules :: TranslateH Core [CoreRule]
-specRules = crushtdT $ promoteBindT bindSpecRules
-
--- | Top-down traversal tuned to matching function calls.
-anyCallR :: forall c m. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m)
-         => Rewrite c m Core -> Rewrite c m Core
-anyCallR rr = prefixFailMsg "any-call failed: " $
-              readerT $ \ e -> case e of
-        ExprCore (App {}) -> childR App_Arg rec >+> (rr <+ childR App_Fun rec)
-        ExprCore (Var {}) -> rr
-        _                 -> anyR rec
-    where rec :: Rewrite c m Core
-          rec = anyCallR rr
 
 -------------------------------------------
 
diff --git a/src/HERMIT/Dictionary/Induction.hs b/src/HERMIT/Dictionary/Induction.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Dictionary/Induction.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, MultiWayIf #-}
+
+module HERMIT.Dictionary.Induction
+  ( -- * Induction
+    inductionCaseSplit
+--  , inductionOnT
+--  , listInductionOnT
+  )
+where
+
+import Control.Arrow
+
+-- import Data.List (delete)
+
+import HERMIT.Context
+import HERMIT.Core
+import HERMIT.GHC
+import HERMIT.Kure
+import HERMIT.Monad
+-- import HERMIT.Utilities (soleElement)
+
+import HERMIT.Dictionary.Common
+import HERMIT.Dictionary.Local.Case (caseSplitInlineR)
+-- import HERMIT.Dictionary.Reasoning
+import HERMIT.Dictionary.Undefined
+
+------------------------------------------------------------------------------
+
+-- TODO: Warning, this is very experimental
+
+------------------------------------------------------------------------------
+
+inductionCaseSplit :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c, HasGlobalRdrEnv c) => [Var] -> Id -> CoreExpr -> CoreExpr -> Translate c HermitM x [(Maybe DataCon,[Var],CoreExpr,CoreExpr)]
+inductionCaseSplit vs i lhsE rhsE =
+    do -- first construct an expression containing both the LHS and the RHS
+       il <- constT $ newIdH "dummyL" (exprKindOrType lhsE)
+       ir <- constT $ newIdH "dummyR" (exprKindOrType rhsE)
+       let contrivedExpr = Let (NonRec il lhsE)
+                               (Let (NonRec ir rhsE)
+                                    (Var i)
+                               )
+
+       -- then case split on the identifier, inlining the pattern
+       -- we consider the other universally quantified variables to be in scope while doing so
+       Case _ _ _ alts <- withVarsInScope vs (caseSplitInlineR (==i)) <<< return contrivedExpr
+       let dataConCases = map compressAlts alts
+
+       lhsUndefined <- extractR (replaceIdWithUndefinedR i) <<< return lhsE
+       rhsUndefined <- extractR (replaceIdWithUndefinedR i) <<< return rhsE
+
+       let undefinedCase = (Nothing,[],lhsUndefined,rhsUndefined)
+
+       return (undefinedCase : dataConCases)
+
+  where
+    compressAlts :: CoreAlt -> (Maybe DataCon,[Var],CoreExpr,CoreExpr)
+    compressAlts (DataAlt con,bs,Let (NonRec _ lhsE') (Let (NonRec _ rhsE') _)) = (Just con,bs,lhsE',rhsE')
+    compressAlts _ = error "Bug in inductionCaseSplit"
+
+
+-- NOTE: Most of the Induction infrastructure has moved to HERMIT/Shell/Proof.hs
+
+
+-- -- | A general induction principle.  TODO: Is this valid for infinite data types?  Probably not.
+-- inductionOnT :: forall c. (AddBindings c, ReadBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c Core)
+--                     => (Id -> Bool) -> (DataCon -> [BiRewrite c HermitM CoreExpr] -> CoreExprEqualityProof c HermitM) -> Translate c HermitM CoreExprEquality ()
+-- inductionOnT idPred genCaseAltProofs = prefixFailMsg "Induction failed: " $
+--     do eq@(CoreExprEquality bs lhs rhs) <- idR
+
+--        i <- setFailMsg "specified identifier is not universally quantified in this equality lemma." $ soleElement (filter idPred bs)
+
+--        cases <- inductionCaseSplit bs i lhs rhs
+
+--        -- TODO: will this work if vs contains TyVars or CoVars?  Maybe we need to sort the Vars in order: TyVars; CoVars; Ids.
+--        let verifyInductiveCaseT :: (DataCon,[Var],CoreExpr,CoreExpr) -> Translate c HermitM x ()
+--            verifyInductiveCaseT (con,vs,lhsE,rhsE) =
+--                 let vs_matching_i_type = filter (typeAlphaEq (varType i) . varType) vs
+--                     eqs = [ discardUniVars (instantiateCoreExprEq [(i,Var i')] eq) | i' <- vs_matching_i_type ]
+--                     brs = map birewrite eqs -- These eqs now have no universally quantified variables.
+--                                             -- Thus they can only be used on variables in the induction hypothesis.
+--                                             -- TODO: consider whether this is unneccassarily restrictive
+--                     caseEq = CoreExprEquality (delete i bs ++ vs) lhsE rhsE
+--                 in return caseEq >>> verifyCoreExprEqualityT (genCaseAltProofs con brs)
+
+--        mapM_ verifyInductiveCaseT cases
+
+-- -- | An induction principle for lists.
+-- listInductionOnT :: (AddBindings c, ReadBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c Core)
+--                 => (Id -> Bool) -- Id to case split on
+--                 -> CoreExprEqualityProof c HermitM -- proof for [] case
+--                 -> (BiRewrite c HermitM CoreExpr -> CoreExprEqualityProof c HermitM) -- proof for (:) case, given smaller proof
+--                 -> Translate c HermitM CoreExprEquality ()
+-- listInductionOnT idPred nilCaseProof consCaseProof = inductionOnT idPred $ \ con brs ->
+--                                                                 if | con == nilDataCon   -> case brs of
+--                                                                                                   [] -> nilCaseProof
+--                                                                                                   _  -> error "Bug!"
+--                                                                    | con == consDataCon  -> case brs of
+--                                                                                                   [br] -> consCaseProof br
+--                                                                                                   _    -> error "Bug!"
+--                                                                    | otherwise           -> let msg = "Mystery constructor, this is a bug."
+--                                                                                              in (fail msg, fail msg)
+
+------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Inline.hs b/src/HERMIT/Dictionary/Inline.hs
--- a/src/HERMIT/Dictionary/Inline.hs
+++ b/src/HERMIT/Dictionary/Inline.hs
@@ -5,9 +5,11 @@
          , InlineConfig(..)
          , CaseBinderInlineOption(..)
          , getUnfoldingT
+         , ensureBoundT
          , inlineR
          , inlineNameR
          , inlineNamesR
+         , inlineMatchingPredR
          , inlineCaseScrutineeR
          , inlineCaseAlternativeR
          , configurableInlineR
@@ -34,8 +36,6 @@
 
 import HERMIT.Dictionary.Common
 
-import qualified Language.Haskell.TH as TH
-
 ------------------------------------------------------------------------
 
 -- | 'External's for inlining variables.
@@ -43,9 +43,9 @@
 externals =
             [ external "inline" (promoteExprR inlineR :: RewriteH Core)
                 [ "(Var v) ==> <defn of v>" ].+ Eval .+ Deep
-            , external "inline" (promoteExprR . inlineNameR :: TH.Name -> RewriteH Core)
+            , external "inline" (promoteExprR . inlineNameR :: String -> RewriteH Core)
                 [ "Given a specific v, (Var v) ==> <defn of v>" ] .+ Eval .+ Deep
-            , external "inline" (promoteExprR . inlineNamesR :: [TH.Name] -> RewriteH Core)
+            , external "inline" (promoteExprR . inlineNamesR :: [String] -> RewriteH Core)
                 [ "If the current variable matches any of the given names, then inline it." ] .+ Eval .+ Deep
             , external "inline-case-scrutinee" (promoteExprR inlineCaseScrutineeR :: RewriteH Core)
                 [ "if v is a case binder, replace (Var v) with the bound case scrutinee." ] .+ Eval .+ Deep
@@ -60,14 +60,18 @@
 data InlineConfig           = CaseBinderOnly CaseBinderInlineOption | AllBinders deriving (Eq, Show)
 
 -- | If the current variable matches the given name, then inline it.
-inlineNameR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => TH.Name -> Rewrite c HermitM CoreExpr
-inlineNameR nm = configurableInlineR AllBinders (arr $ cmpTHName2Var nm)
+inlineNameR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => String -> Rewrite c HermitM CoreExpr
+inlineNameR nm = inlineMatchingPredR (cmpString2Var nm)
 
 -- | If the current variable matches any of the given names, then inline it.
-inlineNamesR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [TH.Name] -> Rewrite c HermitM CoreExpr
+inlineNamesR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [String] -> Rewrite c HermitM CoreExpr
 inlineNamesR []  = fail "inline-names failed: no names given."
-inlineNamesR nms = configurableInlineR AllBinders (arr $ \ v -> any (flip cmpTHName2Var v) nms)
+inlineNamesR nms = inlineMatchingPredR (\ v -> any (flip cmpString2Var v) nms)
 
+-- | If the current variable satisifies the predicate, then inline it.
+inlineMatchingPredR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => (Id -> Bool) -> Rewrite c HermitM CoreExpr
+inlineMatchingPredR idPred = configurableInlineR AllBinders (arr $ idPred)
+
 -- | Inline the current variable.
 inlineR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
 inlineR = configurableInlineR AllBinders (return True)
@@ -93,8 +97,11 @@
       guardMsg b "identifier does not satisfy predicate."
       (e,uncaptured) <- varT (getUnfoldingT config)
       setFailMsg "values in inlined expression have been rebound."
-        (return e >>> accepterR (ensureDepthT uncaptured))
+        (return e >>> accepterR ensureBoundT >>> accepterR (ensureDepthT uncaptured))
 
+-- | Check that all free variables in an expression are bound.
+ensureBoundT :: (Monad m, ReadBindings c) => Translate c m CoreExpr Bool
+ensureBoundT = translate $ \ c -> return . all (inScope c) . varSetElems . localFreeVarsExpr
 
 -- NOTE: When inlining, we have to take care to avoid variable capture.
 --       Our approach is to track the binding depth of the inlined identifier.
@@ -106,8 +113,8 @@
 --         NONREC                (< d)
 --         REC                   (<= d)
 --         MUTUALREC             (<= d+1)
---         CASEWILD-scrutinee    (< d)
---         CASEWILD-alt          (<= d+1)
+--         CASEBINDER-scrutinee  (< d)
+--         CASEBINDER-alt        (<= d+1)
 --         SELFREC-def           NA
 --         LAM                   NA
 --         CASEALT               NA
@@ -130,6 +137,10 @@
     case lookupHermitBinding i c of
       Nothing -> do requireAllBinders config
                     let uncaptured = (<= 0) -- i.e. is global
+		    -- this check is necessary because idInfo panics on TyVars, though it
+		    -- should never be the case that a type variable is NOT in the context,
+		    -- at least this will give a reasonable error message, instead of a GHC panic.
+		    guardMsg (isId i) "type variable is not in Env (this should not happen)."
                     case unfoldingInfo (idInfo i) of
                       CoreUnfolding { uf_tmpl = uft } -> return (uft, uncaptured)
 #if __GLASGOW_HASKELL__ > 706
@@ -140,24 +151,24 @@
                       _                               -> fail $ "cannot find unfolding in Env or IdInfo."
       Just b -> let depth = hbDepth b
                 in case hbSite b of
-                          CASEWILD s alt -> let tys             = tyConAppArgs (idType i)
-                                                altExprDepthM   = (, (<= depth+1)) <$> alt2Exp tys alt
-                                                scrutExprDepthM = return (s, (< depth))
-                                             in case config of
-                                                  CaseBinderOnly Scrutinee   -> scrutExprDepthM
-                                                  CaseBinderOnly Alternative -> altExprDepthM
-                                                  AllBinders                 -> altExprDepthM <+ scrutExprDepthM
+                          CASEBINDER s alt -> let tys             = tyConAppArgs (idType i)
+                                                  altExprDepthM   = (, (<= depth+1)) <$> alt2Exp tys alt
+                                                  scrutExprDepthM = return (s, (< depth))
+                                               in case config of
+                                                    CaseBinderOnly Scrutinee   -> scrutExprDepthM
+                                                    CaseBinderOnly Alternative -> altExprDepthM
+                                                    AllBinders                 -> altExprDepthM <+ scrutExprDepthM
 
-                          NONREC e       -> do requireAllBinders config
-                                               return (e, (< depth))
+                          NONREC e         -> do requireAllBinders config
+                                                 return (e, (< depth))
 
-                          REC e          -> do requireAllBinders config
-                                               return (e, (<= depth))
+                          REC e            -> do requireAllBinders config
+                                                 return (e, (<= depth))
 
-                          MUTUALREC e    -> do requireAllBinders config
-                                               return (e, (<= depth+1))
+                          MUTUALREC e      -> do requireAllBinders config
+                                                 return (e, (<= depth+1))
 
-                          _              -> fail "variable is not bound to an expression."
+                          _                -> fail "variable is not bound to an expression."
   where
     requireAllBinders :: Monad m => InlineConfig -> m ()
     requireAllBinders AllBinders         = return ()
diff --git a/src/HERMIT/Dictionary/Kure.hs b/src/HERMIT/Dictionary/Kure.hs
--- a/src/HERMIT/Dictionary/Kure.hs
+++ b/src/HERMIT/Dictionary/Kure.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
 
 module HERMIT.Dictionary.Kure
        ( -- * KURE Strategies
          externals
-       , unitT
+       , anyCallR
        )
 where
 
@@ -12,6 +12,7 @@
 
 import HERMIT.Core
 import HERMIT.Context
+import HERMIT.GHC
 import HERMIT.Kure
 import HERMIT.External
 
@@ -22,8 +23,8 @@
 externals = map (.+ KURE)
    [ external "id"         (idR :: RewriteH Core)
        [ "Perform an identity rewrite."] .+ Shallow
-   , external "unit"       (unitT :: TranslateH Core ())
-       [ "An always succeeding translation to ()." ]
+   , external "success"    (successT :: TranslateH Core ())
+       [ "An always succeeding translation." ]
    , external "fail"       (fail :: String -> RewriteH Core)
        [ "A failing rewrite."]
    , external "<+"         ((<+) :: RewriteH Core -> RewriteH Core -> RewriteH Core)
@@ -90,6 +91,9 @@
        [ "Apply a bidirectional rewrite backwards." ]
    , external "test"       (testQuery :: RewriteH Core -> TranslateH Core String)
        [ "Determine if a rewrite could be successfully applied." ]
+   , external "any-call" (anyCallR :: RewriteH Core -> RewriteH Core)
+       [ "any-call (.. unfold command ..) applies an unfold command to all applications."
+       , "Preference is given to applications with more arguments." ] .+ Deep
    ]
 
 ------------------------------------------------------------------------------------
@@ -117,6 +121,15 @@
 
 ------------------------------------------------------------------------------------
 
-unitT :: Monad m => Translate c m a ()
-unitT = return ()
-{-# INLINE unitT #-}
+-- | Top-down traversal tuned to matching function calls.
+anyCallR :: forall c m. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m)
+         => Rewrite c m Core -> Rewrite c m Core
+anyCallR rr = prefixFailMsg "any-call failed: " $
+              readerT $ \ e -> case e of
+        ExprCore (App {}) -> childR App_Arg rec >+> (rr <+ childR App_Fun rec)
+        ExprCore (Var {}) -> rr
+        _                 -> anyR rec
+    where rec :: Rewrite c m Core
+          rec = anyCallR rr
+
+------------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Local.hs b/src/HERMIT/Dictionary/Local.hs
--- a/src/HERMIT/Dictionary/Local.hs
+++ b/src/HERMIT/Dictionary/Local.hs
@@ -45,8 +45,6 @@
 import HERMIT.Dictionary.Local.Let hiding (externals)
 import qualified HERMIT.Dictionary.Local.Let as Let
 
-import qualified Language.Haskell.TH as TH
-
 import Control.Arrow
 
 ------------------------------------------------------------------------------
@@ -65,7 +63,7 @@
         [ "(let v = e1 in e2) ==> (\\ v -> e2) e1" ]                            .+ Shallow
     , external "eta-reduce" (promoteExprR etaReduceR :: RewriteH Core)
         [ "(\\ v -> e1 v) ==> e1" ]                                             .+ Eval .+ Shallow
-    , external "eta-expand" (promoteExprR . etaExpandR . show :: TH.Name -> RewriteH Core)
+    , external "eta-expand" (promoteExprR . etaExpandR :: String -> RewriteH Core)
         [ "\"eta-expand 'v\" performs e1 ==> (\\ v -> e1 v)" ]                  .+ Shallow .+ Introduce
     , external "flatten-module" (promoteModGutsR flattenModuleR :: RewriteH Core)
         [ "Flatten all the top-level binding groups in the module to a single recursive binding group."
@@ -73,13 +71,13 @@
     , external "flatten-program" (promoteProgR flattenProgramR :: RewriteH Core)
         [ "Flatten all the top-level binding groups in a program (list of binding groups) to a single"
         , "recursive binding group.  This can be useful if you intend to apply GHC RULES." ]
-    , external "abstract" (promoteExprR . abstractR :: TH.Name -> RewriteH Core)
+    , external "abstract" (promoteExprR . abstractR :: String -> RewriteH Core)
         [ "Abstract over a variable using a lambda."
         , "e  ==>  (\\ x -> e) x" ]                                             .+ Shallow .+ Introduce .+ Context
-    , external "push" ((\ nm strictf -> push (Just strictf) (cmpTHName2Var nm)) :: TH.Name -> RewriteH Core -> RewriteH Core)
+    , external "push" ((\ nm strictf -> push (Just strictf) (cmpString2Var nm)) :: String -> RewriteH Core -> RewriteH Core)
         [ "Push a function 'f into a case-expression or let-expression argument,"
         , "given a proof that f (fully saturated with type arguments) is strict." ] .+ Shallow .+ Commute
-    , external "push-unsafe" (push Nothing . cmpTHName2Var :: TH.Name -> RewriteH Core)
+    , external "push-unsafe" (push Nothing . cmpString2Var :: String -> RewriteH Core)
         [ "Push a function 'f into a case-expression or let-expression argument."
         , "Requires 'f to be strict." ] .+ Shallow .+ Commute .+ PreCondition
     ]
@@ -201,7 +199,7 @@
 
 -- | Abstract over a variable using a lambda.
 --   e  ==>  (\ x. e) x
-abstractR :: (ReadBindings c) => TH.Name -> Rewrite c HermitM CoreExpr
+abstractR :: (ReadBindings c) => String -> Rewrite c HermitM CoreExpr
 abstractR nm = prefixFailMsg "abstraction failed: " $
    do v  <- findBoundVarT nm
       v' <- constT (cloneVarH id v) -- currently uses the same visible name (via "id").  We could do something else here, e.g. add a prime suffix.
@@ -221,15 +219,15 @@
       => Maybe (Rewrite c HermitM CoreExpr) -- ^ a proof that the function (after being applied to its type arguments) is strict
       -> (Id -> Bool)                       -- ^ a predicate to identify the function
       -> Rewrite c HermitM CoreExpr
-pushR strictf p = prefixFailMsg "push failed: " $
-                  withPatFailMsg (wrongExprForm "App f e") $
+pushR mstrictf p = prefixFailMsg "push failed: " $
+                   withPatFailMsg (wrongExprForm "App f e") $
      do App f e <- idR
         case collectArgs f of
           (Var i,args) -> do
                   guardMsg (p i) $ "identifier not matched."
                   guardMsg (all isTypeArg args) $ "initial arguments are not all type arguments."
                   case e of
-                     Case {} -> caseFloatArgR (Just (f,strictf))
+                     Case {} -> caseFloatArgR (Just f) mstrictf
                      Let {}  -> letFloatArgR
                      _       -> fail "argument is not a Case or Let."
           _ -> fail "no identifier to match."
diff --git a/src/HERMIT/Dictionary/Local/Case.hs b/src/HERMIT/Dictionary/Local/Case.hs
--- a/src/HERMIT/Dictionary/Local/Case.hs
+++ b/src/HERMIT/Dictionary/Local/Case.hs
@@ -21,7 +21,7 @@
     , caseInlineScrutineeR
     , caseInlineAlternativeR
     , caseMergeAltsR
-    , caseMergeAltsWithWildR
+    , caseMergeAltsWithBinderR
     , caseElimR
     , caseElimInlineScrutineeR
     , caseElimMergeAltsR
@@ -48,10 +48,9 @@
 import HERMIT.Dictionary.Inline hiding (externals)
 import HERMIT.Dictionary.AlphaConversion hiding (externals)
 import HERMIT.Dictionary.Fold (foldVarR)
+import HERMIT.Dictionary.GHC (substCoreExpr)
 import HERMIT.Dictionary.Undefined (verifyStrictT)
 
-import qualified Language.Haskell.TH as TH
-
 -- NOTE: these are hard to test in small examples, as GHC does them for us, so use with caution
 ------------------------------------------------------------------------------
 
@@ -60,13 +59,16 @@
 externals =
     [ external "case-float-app" (promoteExprR caseFloatAppR :: RewriteH Core)
         [ "(case ec of alt -> e) v ==> case ec of alt -> e v" ]              .+ Commute .+ Shallow
-    , external "case-float-arg" ((\ f strict -> promoteExprR (caseFloatArg (Just (f, Just strict)))) :: CoreString -> RewriteH Core -> RewriteH Core)
-        [ "For a specific f, given a proof that f is strict, then"
+    , external "case-float-arg" ((\ strict -> promoteExprR (caseFloatArg Nothing (Just strict))) :: RewriteH Core -> RewriteH Core)
+        [ "Given a proof that f is strict, then"
         , "f (case s of alt -> e) ==> case s of alt -> f e" ]                .+ Commute .+ Shallow
-    , external "case-float-arg-unsafe" ((\ f -> promoteExprR (caseFloatArg (Just (f, Nothing)))) :: CoreString -> RewriteH Core)
-        [ "For a specific f,"
+    , external "case-float-arg" ((\ f strict -> promoteExprR (caseFloatArg (Just f) (Just strict))) :: CoreString -> RewriteH Core -> RewriteH Core)
+        [ "For a specified f, given a proof that f is strict, then"
+        , "f (case s of alt -> e) ==> case s of alt -> f e" ]                .+ Commute .+ Shallow
+    , external "case-float-arg-unsafe" ((\ f -> promoteExprR (caseFloatArg (Just f) Nothing)) :: CoreString -> RewriteH Core)
+        [ "For a specified f,"
         , "f (case s of alt -> e) ==> case s of alt -> f e" ]                .+ Commute .+ Shallow .+ PreCondition
-    , external "case-float-arg-unsafe" (promoteExprR (caseFloatArg Nothing) :: RewriteH Core)
+    , external "case-float-arg-unsafe" (promoteExprR (caseFloatArg Nothing Nothing) :: RewriteH Core)
         [ "f (case s of alt -> e) ==> case s of alt -> f e" ]                .+ Commute .+ Shallow .+ PreCondition
     , external "case-float-case" (promoteExprR caseFloatCaseR :: RewriteH Core)
         [ "case (case ec of alt1 -> e1) of alta -> ea ==> case ec of alt1 -> case e1 of alta -> ea" ] .+ Commute .+ Eval
@@ -82,39 +84,39 @@
         [ "Float in a Case whose alternatives are parallel applications of the same function." ] .+ Commute .+ Shallow .+ PreCondition
     -- , external "case-float-in-app" (promoteExprR caseFloatInApp :: RewriteH Core)
     --     [ "Float in a Case whose alternatives are applications of different functions with the same arguments." ] .+ Commute .+ Shallow .+ PreCondition
-    , external "case-reduce" (promoteExprR caseReduceR :: RewriteH Core)
+    , external "case-reduce" (promoteExprR (caseReduceR True) :: RewriteH Core)
         [ "Case of Known Constructor"
         , "case-reduce-datacon <+ case-reduce-literal" ]                     .+ Shallow .+ Eval
-    , external "case-reduce-datacon" (promoteExprR caseReduceDataconR :: RewriteH Core)
+    , external "case-reduce-datacon" (promoteExprR (caseReduceDataconR True) :: RewriteH Core)
         [ "Case of Known Constructor"
         , "case C v1..vn of C w1..wn -> e ==> let { w1 = v1 ; .. ; wn = vn } in e" ]    .+ Shallow .+ Eval
-    , external "case-reduce-literal" (promoteExprR caseReduceLiteralR :: RewriteH Core)
+    , external "case-reduce-literal" (promoteExprR (caseReduceLiteralR True) :: RewriteH Core)
         [ "Case of Known Constructor"
         , "case L of L -> e ==> e" ]                                         .+ Shallow .+ Eval
-    , external "case-reduce-id" (promoteExprR caseReduceIdR :: RewriteH Core)
+    , external "case-reduce-id" (promoteExprR (caseReduceIdR True) :: RewriteH Core)
         [ "Inline the case scrutinee (if it is an identifier) and then case-reduce." ] .+ Shallow .+ Eval .+ Context
-    , external "case-split" (promoteExprR . caseSplitR :: TH.Name -> RewriteH Core)
+    , external "case-split" (promoteExprR . caseSplitR . cmpString2Var :: String -> RewriteH Core)
         [ "case-split 'x"
         , "e ==> case x of C1 vs -> e; C2 vs -> e, where x is free in e" ] .+ Shallow
-    , external "case-split-inline" (caseSplitInlineR :: TH.Name -> RewriteH Core)
+    , external "case-split-inline" (promoteExprR . caseSplitInlineR . cmpString2Var :: String -> RewriteH Core)
         [ "Like case-split, but additionally inlines the matched constructor "
         , "applications for all occurances of the named variable." ] .+ Deep
-    , external "case-intro-seq" (promoteExprR . caseIntroSeqR :: TH.Name -> RewriteH Core)
+    , external "case-intro-seq" (promoteExprR . caseIntroSeqR . cmpString2Var :: String -> RewriteH Core)
         [ "Force evaluation of a variable by introducing a case."
         , "case-seq 'v is is equivalent to adding @(seq v)@ in the source code." ] .+ Shallow .+ Introduce
     , external "case-elim-seq" (promoteExprR caseElimSeqR :: RewriteH Core)
         [ "Eliminate a case that corresponds to a pointless seq."  ] .+ Deep .+ Eval
     , external "case-inline-alternative" (promoteExprR caseInlineAlternativeR :: RewriteH Core)
-        [ "Inline the case wildcard binder as the case-alternative pattern everywhere in the case alternatives." ] .+ Deep
+        [ "Inline the case binder as the case-alternative pattern everywhere in the case alternatives." ] .+ Deep
     , external "case-inline-scrutinee" (promoteExprR caseInlineScrutineeR :: RewriteH Core)
-        [ "Inline the case wildcard binder as the case scrutinee everywhere in the case alternatives." ] .+ Deep
+        [ "Inline the case binder as the case scrutinee everywhere in the case alternatives." ] .+ Deep
     , external "case-merge-alts" (promoteExprR caseMergeAltsR :: RewriteH Core)
         [ "Merge all case alternatives into a single default case."
         , "The RHS of each alternative must be the same."
         , "case s of {pat1 -> e ; pat2 -> e ; ... ; patn -> e} ==> case s of {_ -> e}" ]
-    , external "case-merge-alts-with-wild" (promoteExprR caseMergeAltsWithWildR :: RewriteH Core)
+    , external "case-merge-alts-with-binder" (promoteExprR caseMergeAltsWithBinderR :: RewriteH Core)
         [ "A cleverer version of 'mergeCaseAlts' that first attempts to"
-        , "abstract out any occurrences of the alternative pattern using the wildcard binder." ] .+ Deep
+        , "abstract out any occurrences of the alternative pattern using the case binder." ] .+ Deep
     , external "case-elim" (promoteExprR caseElimR :: RewriteH Core)
         [ "case s of w; C vs -> e ==> e if w and vs are not free in e" ]     .+ Shallow
     , external "case-elim-inline-scrutinee" (promoteExprR caseElimInlineScrutineeR :: RewriteH Core)
@@ -122,8 +124,8 @@
     , external "case-elim-merge-alts" (promoteExprR caseElimMergeAltsR :: RewriteH Core)
         [ "Eliminate a case, merging the case alternatives into a single default alternative",
           "and inlining the case binder as the scrutinee (if possible)." ] .+ Deep
-    , external "case-fold-wild" (promoteExprR caseFoldWildR :: RewriteH Core)
-        [ "In the case alternatives, fold any occurrences of the case alt patterns to the wildcard binder." ]
+    , external "case-fold-binder" (promoteExprR caseFoldBinderR :: RewriteH Core)
+        [ "In the case alternatives, fold any occurrences of the case alt patterns to the case binder." ]
     ]
 
 ------------------------------------------------------------------------------
@@ -135,7 +137,7 @@
  do Case _ bnd _ alts <- idR
     case alts of
         [(_, vs, e)] -> do let fvs = freeVarsExpr e
-                           guardMsg (isEmptyVarSet $ intersectVarSet (mkVarSet (bnd:vs)) fvs) "wildcard or pattern binders free in RHS."
+                           guardMsg (isEmptyVarSet $ intersectVarSet (mkVarSet (bnd:vs)) fvs) "case binder or pattern binders free in RHS."
                            return e
         _ -> fail "more than one case alternative."
 
@@ -146,46 +148,69 @@
 caseFloatAppR = prefixFailMsg "Case floating from App function failed: " $
   do
     captures    <- appT (map mkVarSet <$> caseAltVarsT) (arr freeVarsExpr) (flip (map . intersectVarSet))
-    wildCapture <- appT caseWildIdT (arr freeVarsExpr) elemVarSet
-    appT ((if not wildCapture then idR else alphaCaseBinderR Nothing)
+    bndrCapture <- appT caseBinderIdT (arr freeVarsExpr) elemVarSet
+    appT ((if not bndrCapture then idR else alphaCaseBinderR Nothing)
           >>> caseAllR idR idR idR (\i -> if isEmptyVarSet (captures !! i) then idR else alphaAltR)
          )
           idR
           (\(Case s b _ alts) v -> let newAlts = mapAlts (`App` v) alts
                                     in Case s b (coreAltsType newAlts) newAlts)
 
-caseFloatArg :: Maybe (CoreString, Maybe (RewriteH Core)) -> RewriteH CoreExpr
-caseFloatArg Nothing                 = caseFloatArgR Nothing
-caseFloatArg (Just (f_str, mstrict)) =
-  do f <- parseCoreExprT f_str
-     caseFloatArgR (Just (f, extractR <$> mstrict))
+caseFloatArg :: Maybe CoreString -> Maybe (RewriteH Core) -> RewriteH CoreExpr
+caseFloatArg mfstr mstrictCore = let mstrict = extractR <$> mstrictCore
+                                  in case mfstr of
+                                       Nothing    -> caseFloatArgR Nothing mstrict
+                                       Just f_str -> do f <- parseCoreExprT f_str
+                                                        caseFloatArgR (Just f) mstrict
 
 -- | @f (case s of alt1 -> e1; alt2 -> e2)@ ==> @case s of alt1 -> f e1; alt2 -> f e2@
 --   Only safe if @f@ is strict.
 caseFloatArgR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c, HasGlobalRdrEnv c)
-              => Maybe (CoreExpr, Maybe (Rewrite c HermitM CoreExpr)) -- ^ Maybe the function to float past, and maybe a proof of its strictness.
+              => Maybe CoreExpr -> Maybe (Rewrite c HermitM CoreExpr) -- ^ Maybe the function to float past, and maybe a proof of its strictness.
               -> Rewrite c HermitM CoreExpr
-caseFloatArgR mfstrict = prefixFailMsg "Case floating from App argument failed: " $
-                         withPatFailMsg "App f (Case s w ty alts)" $
+caseFloatArgR mf mstrict = prefixFailMsg "Case floating from App argument failed: " $
+                           withPatFailMsg "App f (Case s w ty alts)" $
   do App f (Case s w _ alts) <- idR
-     whenJust (\ (f', mstrict) ->
-                     do guardMsg (exprAlphaEq f f') "given function does not match current application."
-                        whenJust (verifyStrictT f) mstrict
-              )
-              mfstrict
 
+     whenJust (\ f' -> guardMsg (exprAlphaEq f f') "given function does not match current application.") mf
+     whenJust (verifyStrictT f) mstrict
+
      let fvs         = freeVarsExpr f
          altCaptures = map (intersectVarSet fvs . mkVarSet . altVars) alts
-         wildCapture = elemVarSet w fvs
+         bndrCapture = elemVarSet w fvs
 
-     if | wildCapture                   -> appAllR idR (alphaCaseBinderR Nothing) >>> caseFloatArgR Nothing
+     if | bndrCapture                   -> appAllR idR (alphaCaseBinderR Nothing) >>> caseFloatArgR Nothing Nothing
         | all isEmptyVarSet altCaptures -> let new_alts = mapAlts (App f) alts
                                             in return $ Case s w (coreAltsType new_alts) new_alts
         | otherwise                     -> appAllR idR (caseAllR idR idR idR (\ n -> let vs = varSetElems (altCaptures !! n)
                                                                                       in if null vs then idR else alphaAltVarsR vs
                                                                              )
-                                                       ) >>> caseFloatArgR Nothing
+                                                       ) >>> caseFloatArgR Nothing Nothing
 
+-- caseFloatArgR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c, HasGlobalRdrEnv c)
+--               => Maybe (CoreExpr, Maybe (Rewrite c HermitM CoreExpr)) -- ^ Maybe the function to float past, and maybe a proof of its strictness.
+--               -> Rewrite c HermitM CoreExpr
+-- caseFloatArgR mfstrict = prefixFailMsg "Case floating from App argument failed: " $
+--                          withPatFailMsg "App f (Case s w ty alts)" $
+--   do App f (Case s w _ alts) <- idR
+--      whenJust (\ (f', mstrict) ->
+--                      do guardMsg (exprAlphaEq f f') "given function does not match current application."
+--                         whenJust (verifyStrictT f) mstrict
+--               )
+--               mfstrict
+
+--      let fvs         = freeVarsExpr f
+--          altCaptures = map (intersectVarSet fvs . mkVarSet . altVars) alts
+--          bndrCapture = elemVarSet w fvs
+
+--      if | bndrCapture                   -> appAllR idR (alphaCaseBinderR Nothing) >>> caseFloatArgR Nothing
+--         | all isEmptyVarSet altCaptures -> let new_alts = mapAlts (App f) alts
+--                                             in return $ Case s w (coreAltsType new_alts) new_alts
+--         | otherwise                     -> appAllR idR (caseAllR idR idR idR (\ n -> let vs = varSetElems (altCaptures !! n)
+--                                                                                       in if null vs then idR else alphaAltVarsR vs
+--                                                                              )
+--                                                        ) >>> caseFloatArgR Nothing
+
 -- | case (case s1 of alt11 -> e11; alt12 -> e12) of alt21 -> e21; alt22 -> e22
 --   ==>
 --   case s1 of
@@ -196,8 +221,8 @@
   do
     captures <- caseT (map mkVarSet <$> caseAltVarsT) idR mempty (const $ arr freeVarsAlt) (\ vss w () fvs -> map (intersectVarSet (delVarSet (unionVarSets fvs) w)) vss)
     -- does the binder of the inner case, shadow a free variable in any of the outer case alts?
-    wildCapture <- caseT caseWildIdT idR mempty (const $ arr freeVarsAlt) (\ innerBndr w () fvs -> innerBndr `elemVarSet` (delVarSet (unionVarSets fvs) w))
-    caseT ((if not wildCapture then idR else alphaCaseBinderR Nothing)
+    bndrCapture <- caseT caseBinderIdT idR mempty (const $ arr freeVarsAlt) (\ innerBndr w () fvs -> innerBndr `elemVarSet` (delVarSet (unionVarSets fvs) w))
+    caseT ((if not bndrCapture then idR else alphaCaseBinderR Nothing)
            >>> caseAllR idR idR idR (\i -> if isEmptyVarSet (captures !! i) then idR else alphaAltR)
           )
           idR
@@ -241,9 +266,9 @@
 caseFloatInArgsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => Rewrite c m CoreExpr
 caseFloatInArgsR = prefixFailMsg "Case floating into arguments failed: " $
                    withPatFailMsg (wrongExprForm "Case s v t alts") $
-    do Case s wild _ty alts <- idR
+    do Case s bndr _ty alts <- idR
        (vss, fs, argss) <- caseT mempty mempty mempty (\ _ -> altT mempty (\ _ -> idR) callT $ \ () vs (fn, args) -> (vs, fn, args))
-                                                      (\ () () () alts' -> unzip3 [ (wild:vs, fn, args) | (vs,fn,args) <- alts' ])
+                                                      (\ () () () alts' -> unzip3 [ (bndr:vs, fn, args) | (vs,fn,args) <- alts' ])
        guardMsg (equivalentBy exprAlphaEq fs) "alternatives are not parallel in function call."
        let fvs = [ varSetElems $ unionVarSets $ map freeVarsExpr $ f:tyArgs
                  | (f,args) <- zip fs argss
@@ -254,65 +279,76 @@
        return $ mkCoreApps (head fs) [ if isTyCoArg (head args)
                                        then head args
                                        else let alts' = [ (ac, vs, arg) | ((ac,vs,_),arg) <- zip alts args ]
-                                            in Case s wild (coreAltsType alts') alts'
+                                            in Case s bndr (coreAltsType alts') alts'
                                      | args <- argss' ]
 
 ------------------------------------------------------------------------------
 
 -- | Inline the case scrutinee (if it is an identifier), and then perform case reduction.
-caseReduceIdR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
-caseReduceIdR = caseAllR inlineR idR idR (const idR) >>> caseReduceR
+--   If first argument is True, perform substitution in RHS, if False, build let expressions.
+caseReduceIdR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Bool -> Rewrite c HermitM CoreExpr
+caseReduceIdR subst = caseAllR inlineR idR idR (const idR) >>> caseReduceR subst
 
 -- | Case of Known Constructor.
 --   Eliminate a case if the scrutinee is a data constructor or a literal.
-caseReduceR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
-caseReduceR = setFailMsg "Unsuitable expression for Case reduction." $
-              caseReduceDataconR <+ caseReduceLiteralR
+--   If first argument is True, perform substitution in RHS, if False, build let expressions.
+caseReduceR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Bool -> Rewrite c HermitM CoreExpr
+caseReduceR subst =
+    setFailMsg "Unsuitable expression for Case reduction." $
+    caseReduceDataconR subst <+ caseReduceLiteralR subst
 
 -- | Case of Known Constructor.
 --   Eliminate a case if the scrutinee is a literal.
+--   If first argument is True, perform substitution in RHS, if False, build let expressions.
 -- NB: LitAlt cases don't do evaluation
-caseReduceLiteralR :: MonadCatch m => Rewrite c m CoreExpr
-caseReduceLiteralR = prefixFailMsg "Case reduction failed: " $
-                     withPatFailMsg (wrongExprForm "Case (Lit l) v t alts") $
-    do Case s wild _ alts <- idR
+caseReduceLiteralR :: MonadCatch m => Bool -> Rewrite c m CoreExpr
+caseReduceLiteralR subst =
+    prefixFailMsg "Case reduction failed: " $
+    withPatFailMsg (wrongExprForm "Case (Lit l) v t alts") $ do
+        Case s bndr _ alts <- idR
 #if __GLASGOW_HASKELL__ > 706
-       let in_scope = mkInScopeSet (mkVarEnv [ (v,v) | v <- varSetElems (localFreeVarsExpr s) ])
-       case exprIsLiteral_maybe (in_scope, idUnfolding) s of
+        let in_scope = mkInScopeSet (localFreeVarsExpr s)
+        case exprIsLiteral_maybe (in_scope, idUnfolding) s of
 #else
-       case exprIsLiteral_maybe idUnfolding s of
+        case exprIsLiteral_maybe idUnfolding s of
 #endif
-        Nothing -> fail "scrutinee is not a literal."
-        Just l  -> do guardMsg (not (litIsLifted l)) "cannot case-reduce lifted literals" -- see Trac #5603
-                      case findAlt (LitAlt l) alts of
-                        Nothing          -> fail "no matching alternative."
-                        Just (_, _, rhs) -> return $ mkCoreLet (NonRec wild (Lit l)) rhs
+            Nothing -> fail "scrutinee is not a literal."
+            Just l  -> do guardMsg (not (litIsLifted l)) "cannot case-reduce lifted literals" -- see Trac #5603
+                          case findAlt (LitAlt l) alts of
+                            Nothing          -> fail "no matching alternative."
+                            Just (_, _, rhs) -> return $ if subst
+                                                         then substCoreExpr bndr (Lit l) rhs
+                                                         else mkCoreLet (NonRec bndr (Lit l)) rhs
 
 -- | Case of Known Constructor.
 --   Eliminate a case if the scrutinee is a data constructor.
-caseReduceDataconR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
-caseReduceDataconR = prefixFailMsg "Case reduction failed: " $
-                     withPatFailMsg (wrongExprForm "Case e v t alts")
-                     go
-  where
-    go :: Rewrite c HermitM CoreExpr
-    go = do Case e wild _ alts <- idR
+--   If first argument is True, perform substitution in RHS, if False, build let expressions.
+caseReduceDataconR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Bool -> Rewrite c HermitM CoreExpr
+caseReduceDataconR subst = prefixFailMsg "Case reduction failed: " $
+                           withPatFailMsg (wrongExprForm "Case e v t alts") go
+    where
+        go :: Rewrite c HermitM CoreExpr
+        go = do
+            Case e bndr _ alts <- idR
 #if __GLASGOW_HASKELL__ > 706
-            let in_scope = mkInScopeSet (mkVarEnv [ (v,v) | v <- varSetElems (localFreeVarsExpr e) ])
+            let in_scope = mkInScopeSet (localFreeVarsExpr e)
             case exprIsConApp_maybe (in_scope, idUnfolding) e of
 #else
             case exprIsConApp_maybe idUnfolding e of
 #endif
-              Nothing                -> fail "head of scrutinee is not a data constructor."
-              Just (dc, univTys, es) -> case findAlt (DataAlt dc) alts of
-                Nothing             -> fail "no matching alternative."
-                Just (dc', vs, rhs) -> -- dc' is either DEFAULT or dc
-                                       -- NB: It is possible that es contains one or more existentially quantified types.
-                                       let fvss    = map freeVarsExpr $ map Type univTys ++ es
-                                           shadows = [ v | (v,n) <- zip vs [1..], any (elemVarSet v) (drop n fvss) ]
-                                       in if | any (elemVarSet wild) fvss -> alphaCaseBinderR Nothing >>> go
-                                             | null shadows               -> return $ flip mkCoreLets rhs $ zipWith NonRec (wild : vs) (e : es)
-                                             | otherwise                  -> caseOneR (fail "scrutinee") (fail "binder") (fail "type") (\ _ -> acceptR (\ (dc'',_,_) -> dc'' == dc') >>> alphaAltVarsR shadows) >>> go
+                Nothing                -> fail "head of scrutinee is not a data constructor."
+                Just (dc, univTys, es) -> case findAlt (DataAlt dc) alts of
+                    Nothing             -> fail "no matching alternative."
+                    Just (dc', vs, rhs) -> -- dc' is either DEFAULT or dc
+                        -- NB: It is possible that es contains one or more existentially quantified types.
+                        let fvss    = map freeVarsExpr $ map Type univTys ++ es
+                            shadows = [ v | (v,n) <- zip vs [1..], any (elemVarSet v) (drop n fvss) ]
+                        in if | any (elemVarSet bndr) fvss -> alphaCaseBinderR Nothing >>> go
+                              | null shadows               -> do let binds = zip (bndr : vs) (e : es)
+                                                                 return $ if subst
+                                                                          then foldr (uncurry substCoreExpr) rhs binds
+                                                                          else flip mkCoreLets rhs $ map (uncurry NonRec) binds
+                              | otherwise                  -> caseOneR (fail "scrutinee") (fail "binder") (fail "type") (\ _ -> acceptR (\ (dc'',_,_) -> dc'' == dc') >>> alphaAltVarsR shadows) >>> go
 -- WARNING: The alpha-renaming to avoid variable capture has not been tested.  We need testing infrastructure!
 
 -- | Case split a free identifier in an expression:
@@ -322,34 +358,37 @@
 -- e ==> case i of i
 --         []     -> e
 --         (a:as) -> e
-caseSplitR :: TH.Name -> Rewrite c HermitM CoreExpr
-caseSplitR nm = prefixFailMsg "caseSplit failed: " $
-               do i <- matchingFreeIdT nm
-                  let (tycon, tys) = splitTyConApp (idType i)
-                      aNms         = map (:[]) $ cycle ['a'..'z']
+caseSplitR :: (Id -> Bool) -> Rewrite c HermitM CoreExpr
+caseSplitR idPred = prefixFailMsg "caseSplit failed: " $
+               do i            <- matchingFreeIdT idPred
+                  (tycon, tys) <- splitTyConAppM (idType i)
+                  let aNms     = map (:[]) $ cycle ['a'..'z']
                   contextfreeT $ \ e -> do dcsAndVars <- mapM (\ dc -> (dc,) <$> sequence [ newIdH a ty | (a,ty) <- zip aNms $ dataConInstArgTys dc tys ])
                                                               (tyConDataCons tycon)
-                                           let alts = [ (DataAlt dc, as, e) | (dc,as) <- dcsAndVars ]
-                                           return $ Case (Var i) i (coreAltsType alts) alts
+                                           w <- cloneVarH (++ "'") i
+                                           let e' = substCoreExpr i (Var w) e
+                                               alts = [ (DataAlt dc, as, e') | (dc,as) <- dcsAndVars ]
+                                           return $ Case (Var i) w (coreAltsType alts) alts
 
 -- | Force evaluation of an identifier by introducing a case.
 --   This is equivalent to adding @(seq v)@ in the source code.
 --
 -- e -> case v of v
 --        _ -> e
-caseIntroSeqR :: TH.Name -> Rewrite c HermitM CoreExpr
-caseIntroSeqR nm = prefixFailMsg "case-intro-seq failed: " $
-             do i <- matchingFreeIdT nm
-                e <- idR
-                guardMsg (not $ isTyCoArg e) "cannot case on a type or coercion."
-                let alts = [(DEFAULT, [], e)]
-                return $ Case (Var i) i (coreAltsType alts) alts
+caseIntroSeqR :: (Id -> Bool) -> Rewrite c HermitM CoreExpr
+caseIntroSeqR idPred = prefixFailMsg "case-intro-seq failed: " $
+             do i <- matchingFreeIdT idPred
+                contextfreeT $ \ e -> do guardMsg (not $ isTyCoArg e) "cannot case on a type or coercion."
+                                         w <- cloneVarH (++ "'") i
+                                         let e' = substCoreExpr i (Var w) e
+                                             alts = [(DEFAULT, [], e')]
+                                         return $ Case (Var i) w (coreAltsType alts) alts
 
 -- auxillary function for use by caseSplit and caseSeq
-matchingFreeIdT :: Monad m => TH.Name -> Translate c m CoreExpr Id
-matchingFreeIdT nm = do
+matchingFreeIdT :: Monad m => (Id -> Bool) -> Translate c m CoreExpr Id
+matchingFreeIdT idPred = do
   fvs <- arr freeVarsExpr
-  case varSetElems (filterVarSet (\ v -> cmpTHName2Var nm v && isId v) fvs) of
+  case varSetElems (filterVarSet (\ v -> idPred v && isId v) fvs) of
     []    -> fail "provided name is not a free identifier."
     [i]   -> return i
     is    -> fail ("provided name matches " ++ show (length is) ++ " free identifiers.")
@@ -357,25 +396,25 @@
 -- | Like caseSplit, but additionally inlines the constructor applications
 -- for each occurance of the named variable.
 --
--- > caseSplitInline nm = caseSplit nm >>> anybuR (inlineName nm)
-caseSplitInlineR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => TH.Name -> Rewrite c HermitM Core
-caseSplitInlineR nm = promoteR (caseSplitR nm) >>> anybuR (promoteExprR $ inlineNameR nm)
+-- > caseSplitInline idPred = caseSplit idPred >>> caseInlineAlternativeR
+caseSplitInlineR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => (Id -> Bool) -> Rewrite c HermitM CoreExpr
+caseSplitInlineR idPred = caseSplitR idPred >>> caseInlineAlternativeR
 
 ------------------------------------------------------------------------------
 
 caseInlineBinderR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => CaseBinderInlineOption -> Rewrite c HermitM CoreExpr
 caseInlineBinderR opt =
-  do w <- caseWildIdT
+  do w <- caseBinderIdT
      caseAllR idR idR idR $ \ _ -> setFailMsg "no inlinable occurrences." $
                                    do depth <- varBindingDepthT w
                                       extractR $ anybuR (promoteExprR (configurableInlineR (CaseBinderOnly opt) (varIsOccurrenceOfT w depth)) :: Rewrite c HermitM Core)
 
--- | Inline the case wildcard binder as the case scrutinee everywhere in the case alternatives.
+-- | Inline the case binder as the case scrutinee everywhere in the case alternatives.
 caseInlineScrutineeR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
 caseInlineScrutineeR = prefixFailMsg "case-inline-scrutinee failed: " $
                        caseInlineBinderR Scrutinee
 
--- | Inline the case wildcard binder as the case-alternative pattern everywhere in the case alternatives.
+-- | Inline the case binder as the case-alternative pattern everywhere in the case alternatives.
 caseInlineAlternativeR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
 caseInlineAlternativeR = prefixFailMsg "case-inline-alternative failed: " $
                          caseInlineBinderR Alternative
@@ -395,18 +434,19 @@
                     guardMsg (all altVarsUnused alts) "variables bound in case alt pattern appear free in alt right-hand side."
                     return $ Case e w ty [(DEFAULT,[],head rhss)]
 
--- | In the case alternatives, fold any occurrences of the case alt patterns to the wildcard binder.
-caseFoldWildR :: forall c.  (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
-caseFoldWildR = prefixFailMsg "case-fold-wild failed: " $
-                do w <- caseWildIdT
-                   caseAllR idR idR idR $ \ _ -> do depth <- varBindingDepthT w
-                                                    extractR $ anybuR (promoteExprR (foldVarR w (Just depth)) :: Rewrite c HermitM Core)
+-- | In the case alternatives, fold any occurrences of the case alt patterns to the case binder.
+caseFoldBinderR :: forall c.  (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
+caseFoldBinderR = prefixFailMsg "case-fold-binder failed: " $ do
+    w <- caseBinderIdT
+    caseAllR idR idR idR $ \ _ -> do depth <- varBindingDepthT w
+                                     extractR $ anybuR (promoteExprR (foldVarR w (Just depth)) :: Rewrite c HermitM Core)
 
--- | A cleverer version of 'mergeCaseAlts' that first attempts to abstract out any occurrences of the alternative pattern using the wildcard binder.
-caseMergeAltsWithWildR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
-caseMergeAltsWithWildR = prefixFailMsg "merge-case-alts-with-wild failed: " $
-                         withPatFailMsg (wrongExprForm "Case e w ty alts") $
-                         tryR caseFoldWildR >>> caseMergeAltsR
+-- | A cleverer version of 'mergeCaseAlts' that first attempts to abstract out any occurrences of the alternative pattern using the case binder.
+caseMergeAltsWithBinderR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
+caseMergeAltsWithBinderR =
+    prefixFailMsg "merge-case-alts-with-binder failed: " $
+    withPatFailMsg (wrongExprForm "Case e w ty alts") $
+    tryR caseFoldBinderR >>> caseMergeAltsR
 
 -- | Eliminate a case, inlining any occurrences of the case binder as the scrutinee.
 caseElimInlineScrutineeR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
@@ -414,7 +454,7 @@
 
 -- | Eliminate a case, merging the case alternatives into a single default alternative and inlining the case binder as the scrutinee (if possible).
 caseElimMergeAltsR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
-caseElimMergeAltsR = tryR caseFoldWildR >>> tryR caseMergeAltsR >>> caseElimInlineScrutineeR
+caseElimMergeAltsR = tryR caseFoldBinderR >>> tryR caseMergeAltsR >>> caseElimInlineScrutineeR
 
 ------------------------------------------------------------------------------
 
diff --git a/src/HERMIT/Dictionary/Local/Let.hs b/src/HERMIT/Dictionary/Local/Let.hs
--- a/src/HERMIT/Dictionary/Local/Let.hs
+++ b/src/HERMIT/Dictionary/Local/Let.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, MultiWayIf, LambdaCase #-}
 
 module HERMIT.Dictionary.Local.Let
        ( -- * Rewrites on Let Expressions
@@ -16,6 +16,10 @@
        , progBindRecElimR
          -- ** Let Introduction
        , letIntroR
+       , letNonRecIntroR
+       , progNonRecIntroR
+       , nonRecIntroR
+       , letIntroUnfoldingR
          -- ** Let Floating Out
        , letFloatAppR
        , letFloatArgR
@@ -53,12 +57,11 @@
 
 import HERMIT.Dictionary.Common
 import HERMIT.Dictionary.GHC hiding (externals)
+import HERMIT.Dictionary.Inline hiding (externals)
 import HERMIT.Dictionary.AlphaConversion hiding (externals)
 
 import HERMIT.Dictionary.Local.Bind hiding (externals)
 
-import qualified Language.Haskell.TH as TH
-
 ------------------------------------------------------------------------------
 
 -- | Externals relating to 'Let' expressions.
@@ -71,13 +74,17 @@
         [ "Safe let substitution"
         , "let x = e1 in e2, safe to inline without duplicating work ==> e2[e1/x],"
         , "x must not be free in e1." ]                                         .+ Deep .+ Eval
+    , external "let-nonrec-subst-safe" (promoteExprR letNonRecSubstSafeR :: RewriteH Core)
+        [ "As let-subst-safe, but does not try to convert a recursive let into a non-recursive let first." ] .+ Deep .+ Eval
     -- , external "safe-let-subst-plus" (promoteExprR safeLetSubstPlusR :: RewriteH Core)
     --     [ "Safe let substitution"
     --     , "let { x = e1, ... } in e2, "
     --     , "  where safe to inline without duplicating work ==> e2[e1/x,...],"
     --     , "only matches non-recursive lets" ]  .+ Deep .+ Eval
-    , external "let-intro" (promoteExprR . letIntroR . show :: TH.Name -> RewriteH Core)
+    , external "let-intro" (promoteExprR . letIntroR :: String -> RewriteH Core)
         [ "e => (let v = e in v), name of v is provided" ]                      .+ Shallow .+ Introduce
+    , external "let-intro-unfolding" (promoteExprR . letIntroUnfoldingR :: String -> RewriteH Core)
+        [ "e => let f' = defn[f'/f] in e[f'/f], name of f is provided" ]
     , external "let-elim" (promoteExprR letElimR :: RewriteH Core)
         [ "Remove an unused let binding."
         , "(let v = e1 in e2) ==> e2, if v is not free in e1 or e2." ]          .+ Eval .+ Shallow
@@ -115,10 +122,10 @@
     , external "let-float-in-lam" ((promoteExprR letFloatInLamR >+> anybuR (promoteExprR letElimR)) :: RewriteH Core)
         [ "let v = ev in \\ x -> e ==> \\ x -> let v = ev in e"
         , "if v does not shadow x" ]                                            .+ Commute .+ Shallow
-    , external "reorder-lets" (promoteExprR . reorderNonRecLetsR :: [TH.Name] -> RewriteH Core)
+    , external "reorder-lets" (promoteExprR . reorderNonRecLetsR :: [String] -> RewriteH Core)
         [ "Re-order a sequence of nested non-recursive let bindings."
         , "The argument list should contain the let-bound variables, in the desired order." ]
-    , external "let-tuple" (promoteExprR . letTupleR . show :: TH.Name -> RewriteH Core)
+    , external "let-tuple" (promoteExprR . letTupleR :: String -> RewriteH Core)
         [ "Combine nested non-recursive lets into case of a tuple."
         , "E.g. let {v1 = e1 ; v2 = e2 ; v3 = e3} in body ==> case (e1,e2,e3) of {(v1,v2,v3) -> body}" ] .+ Commute
     , external "prog-bind-elim" (promoteProgR progBindElimR :: RewriteH Core)
@@ -199,15 +206,6 @@
 
 -------------------------------------------------------------------------------------------
 
--- | @e@ ==> @(let v = e in v)@, name of v is provided
-letIntroR :: String -> Rewrite c HermitM CoreExpr
-letIntroR nm = prefixFailMsg "Let-introduction failed: " $
-              contextfreeT $ \ e -> do guardMsg (not $ isTypeArg e) "let expressions may not return a type."
-                                       v <- newIdH nm (exprKindOrType e)
-                                       return $ Let (NonRec v e) (Var v)
-
--------------------------------------------------------------------------------------------
-
 letElimR :: (ExtendPath c Crumb, AddBindings c, MonadCatch m) => Rewrite c m CoreExpr
 letElimR = prefixFailMsg "Let elimination failed: " $
           withPatFailMsg (wrongExprForm "Let binds expr") $
@@ -277,7 +275,7 @@
             withPatFailMsg (wrongExprForm "Let (NonRec v e1) e2") $
   do Let (NonRec v ev) _ <- idR
      guardMsg (not $ isTyCoArg ev) "cannot case on a type or coercion."
-     nameModifier <- freshNameGenT Nothing
+     nameModifier <- extractT (freshNameGenT Nothing)
      caseBndr <- constT (cloneVarH nameModifier v)
      letT mempty (replaceVarR v caseBndr) $ \ () e' -> Case ev caseBndr (varType v) [(DEFAULT, [], e')]
 
@@ -327,7 +325,7 @@
       then alphaLamR Nothing >>> letFloatLamR
       else return $ Let binds (Lam v body)
 
--- | @case (let bnds in e) of wild alts@ ==> @let bnds in (case e of wild alts)@
+-- | @case (let bnds in e) of bndr alts@ ==> @let bnds in (case e of bndr alts)@
 --   Fails if any variables bound in @bnds@ occurs in @alts@.
 letFloatCaseR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, BoundVars c) => Rewrite c HermitM CoreExpr
 letFloatCaseR = prefixFailMsg "Let floating from Case failed: " $
@@ -403,7 +401,7 @@
 
 -- | Re-order a sequence of nested non-recursive let bindings.
 --   The argument list should contain the let-bound variables, in the desired order.
-reorderNonRecLetsR :: MonadCatch m => [TH.Name] -> Rewrite c m CoreExpr
+reorderNonRecLetsR :: MonadCatch m => [String] -> Rewrite c m CoreExpr
 reorderNonRecLetsR nms = prefixFailMsg "Reorder lets failed: " $
                  do guardMsg (notNull nms) "no names given."
                     guardMsg (nodups nms) "duplicate names given."
@@ -423,12 +421,11 @@
     noneFreeIn ves = let (vs,es) = unzip ves
                       in all (`notElemVarSet` unionVarSets (map freeVarsExpr es)) vs
 
-    lookupName :: Monad m => [(Var,CoreExpr)] -> TH.Name -> m (Var,CoreExpr)
-    lookupName ves nm = let n = show nm
-                         in case filter (cmpString2Var n . fst) ves of
-                              []   -> fail $ "name " ++ n ++ " not matched."
-                              [ve] -> return ve
-                              _    -> fail $ "multiple matches for " ++ n ++ "."
+    lookupName :: Monad m => [(Var,CoreExpr)] -> String -> m (Var,CoreExpr)
+    lookupName ves nm = case filter (cmpString2Var nm . fst) ves of
+                            []   -> fail $ "name " ++ nm ++ " not matched."
+                            [ve] -> return ve
+                            _    -> fail $ "multiple matches for " ++ nm ++ "."
 
     mkNonRecLets :: [(Var,CoreExpr)] -> CoreExpr -> CoreExpr
     mkNonRecLets []          x  = x
@@ -451,8 +448,8 @@
              used   = unionVarSets $ zipWith intersectVarSet (map (mkVarSet . (`take` vs)) [1..]) frees
          if isEmptyVarSet used
            then let rhs = mkCoreTup rhss
-                in constT $ do wild <- newIdH nm (exprType rhs)
-                               return $ mkSmallTupleCase vs body wild rhs
+                in constT $ do bndr <- newIdH nm (exprType rhs)
+                               return $ mkSmallTupleCase vs body bndr rhs
 
            else fail $ "the following bound variables are used in subsequent bindings: " ++ showVarSet used
 
@@ -462,4 +459,55 @@
     collectLets (Let (NonRec v e) body) | isId v = first ((v,e):) (collectLets body)
     collectLets expr                             = ([],expr)
 
+-------------------------------------------------------------------------------------------
+
+-- TODO: come up with a better naming scheme for these
+
+-- This code could be factored better.
+
+-- | @e@ ==> @let v = e in v@
+letIntroR :: String -> Rewrite c HermitM CoreExpr
+letIntroR nm = do e <- idR
+                  Let (NonRec v e') _ <- letNonRecIntroR nm e
+                  return $ Let (NonRec v e') (varToCoreExpr v)
+
+-- | @body@ ==> @let v = e in body@
+letNonRecIntroR :: String -> CoreExpr -> Rewrite c HermitM CoreExpr
+letNonRecIntroR nm e = prefixFailMsg "Let-introduction failed: " $
+     contextfreeT $ \ body -> do let tyk = exprKindOrType e
+                                 v <- if | isTypeArg e  -> newTyVarH nm tyk
+                                         | isCoArg e    -> newCoVarH nm tyk
+                                         | otherwise    -> newIdH nm tyk
+                                 return $ Let (NonRec v e) body
+
+
+-- This isn't a "Let", but it's serving the same role.  Maybe create a Local/Prog module?
+
+-- | @prog@ ==> @'ProgCons' (v = e) prog@
+progNonRecIntroR :: String -> CoreExpr -> Rewrite c HermitM CoreProg
+progNonRecIntroR nm e = prefixFailMsg "Top-level binding introduction failed: " $
+  do guardMsg (not $ isTyCoArg e) "Top-level type or coercion definitions are prohibited."
+     contextfreeT $ \ prog -> do i <- newIdH nm (exprType e)
+                                 return $ ProgCons (NonRec i e) prog
+
+-- | nonRecIntroR nm e = 'letNonRecIntroR nm e' <+ 'progNonRecIntroR nm e'
+nonRecIntroR :: String -> CoreExpr -> Rewrite c HermitM Core
+nonRecIntroR nm e = readerT $ \case
+                      ExprCore{} -> promoteExprR (letNonRecIntroR nm e)
+                      ProgCore{} -> promoteProgR (progNonRecIntroR nm e)
+                      _          -> fail "can only introduce non-recursive bindings at Program or Expression nodes."
+
+-- | Introduce a local definition for a (possibly imported) identifier.
+-- Rewrites occurences of the identifier to point to this new local definiton.
+letIntroUnfoldingR :: (BoundVars c, HasGlobalRdrEnv c, ReadBindings c) => String -> Rewrite c HermitM CoreExpr
+letIntroUnfoldingR nm = do
+    i <- findIdT nm
+    (rhs,_) <- getUnfoldingT AllBinders <<< return i
+    contextfreeT $ \ body -> do
+        i' <- cloneVarH id i
+        let subst = substCoreExpr i (varToCoreExpr i')
+            bnd = if i `elemUFM` freeVarsExpr rhs then Rec [(i', subst rhs)]
+                                                  else NonRec i' rhs
+            body' = subst body
+        return $ mkCoreLet bnd body'
 -------------------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Navigation.hs b/src/HERMIT/Dictionary/Navigation.hs
--- a/src/HERMIT/Dictionary/Navigation.hs
+++ b/src/HERMIT/Dictionary/Navigation.hs
@@ -19,7 +19,7 @@
        )
 where
 
-import Data.Monoid (mempty)
+import Data.Monoid
 
 import Control.Arrow
 
@@ -27,34 +27,34 @@
 import HERMIT.Context
 import HERMIT.Kure
 import HERMIT.External
-import HERMIT.GHC
+import HERMIT.GHC hiding ((<>))
 
 import HERMIT.Dictionary.Navigation.Crumbs
 
-import qualified Language.Haskell.TH as TH
-
 ---------------------------------------------------------------------------------------
 
 -- | 'External's involving navigating to named entities.
 externals :: [External]
 externals = crumbExternals ++ map (.+ Navigation)
-            [ external "rhs-of" (rhsOfT . cmpTHName2Var :: TH.Name -> TranslateH Core LocalPathH)
+            [ external "rhs-of" (rhsOfT . cmpString2Var :: String -> TranslateH Core LocalPathH)
                 [ "Find the path to the RHS of the binding of the named variable." ]
-            , external "binding-group-of" (bindingGroupOfT . cmpTHName2Var :: TH.Name -> TranslateH CoreTC LocalPathH)
+            , external "binding-group-of" (bindingGroupOfT . cmpString2Var :: String -> TranslateH CoreTC LocalPathH)
                 [ "Find the path to the binding group of the named variable." ]
-            , external "binding-of" (bindingOfT . cmpTHName2Var :: TH.Name -> TranslateH CoreTC LocalPathH)
+            , external "binding-of" (bindingOfT . cmpString2Var :: String -> TranslateH CoreTC LocalPathH)
                 [ "Find the path to the binding of the named variable." ]
-            , external "occurrence-of" (occurrenceOfT . cmpTHName2Var :: TH.Name -> TranslateH CoreTC LocalPathH)
+            , external "occurrence-of" (occurrenceOfT . cmpString2Var :: String -> TranslateH CoreTC LocalPathH)
                 [ "Find the path to the first occurrence of the named variable." ]
-
-            , external "consider" (bindingOfT . cmpTHName2Var :: TH.Name -> TranslateH CoreTC LocalPathH)
-                [ "consider '<v> focuses on the definition of <v>" ] .+ Deprecated .+ TODO
-
             , external "consider" (considerConstruct :: String -> TranslateH Core LocalPathH)
                 [ "consider <c> focuses on the first construct <c>.",
                   recognizedConsiderables]
             , external "arg" (promoteExprT . nthArgPath :: Int -> TranslateH Core LocalPathH)
                 [ "arg n focuses on the (n-1)th argument of a nested application." ]
+            , external "lams-body" (promoteExprT lamsBodyT :: TranslateH Core LocalPathH)
+                [ "Descend into the body after a sequence of lambdas." ]
+            , external "lets-body" (promoteExprT letsBodyT :: TranslateH Core LocalPathH)
+                [ "Descend into the body after a sequence of let bindings." ]
+            , external "prog-end" (promoteModGutsT gutsProgEndT <+ promoteProgT progEndT :: TranslateH Core LocalPathH)
+                [ "Descend to the end of a program." ]
 
             , external "parent-of" (parentOfT :: TranslateH Core LocalPathH -> TranslateH Core LocalPathH)
                 [ "Focus on the parent of another focal point." ]
@@ -209,7 +209,8 @@
 
 considerConstruct :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, MonadCatch m) => String -> Translate c m Core LocalPathH
 considerConstruct str = case string2considerable str of
-                          Nothing -> fail $ "Unrecognized construct \"" ++ str ++ "\". " ++ recognizedConsiderables ++ ".  Or did you mean \"consider '" ++ str ++ "\"?"
+                          Nothing -> fail $ "Unrecognized construct \"" ++ str ++ "\". Perhaps you meant \"binding-of '" ++ str ++ "\"? " 
+                                            ++ recognizedConsiderables ++ "."
                           Just c  -> considerConstructT c
 
 -- | Find the path to the first matching construct.
@@ -244,5 +245,27 @@
                                       in if funCrumbs < 0
                                           then fail ("Argument " ++ show n ++ " does not exist.")
                                           else return (SnocPath (replicate funCrumbs App_Fun) @@ App_Arg)
+
+---------------------------------------------------------------------------------------
+
+exhaustRepeatCrumbT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c CoreTC, MonadCatch m) => Crumb -> Translate c m CoreTC LocalPathH
+exhaustRepeatCrumbT cr = let l = exhaustPathL (repeat cr)
+                          in withLocalPathT (focusT l exposeLocalPathT)
+
+-- | Construct a path to the body of a sequence of lambdas.
+lamsBodyT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c CoreTC, MonadCatch m) => Translate c m CoreExpr LocalPathH
+lamsBodyT = extractT (exhaustRepeatCrumbT Lam_Body)
+
+-- | Construct a path to the body of a sequence of let bindings.
+letsBodyT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c CoreTC, MonadCatch m) => Translate c m CoreExpr LocalPathH
+letsBodyT = extractT (exhaustRepeatCrumbT Let_Body)
+
+-- | Construct a path to end of a program.
+progEndT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c CoreTC, MonadCatch m) => Translate c m CoreProg LocalPathH
+progEndT = extractT (exhaustRepeatCrumbT ProgCons_Tail)
+
+-- | Construct a path to teh end of a program, starting at the 'ModGuts'.
+gutsProgEndT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c CoreTC, MonadCatch m) => Translate c m ModGuts LocalPathH
+gutsProgEndT = modGutsT progEndT (\ _ p -> (mempty @@ ModGuts_Prog) <> p)
 
 ---------------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/New.hs b/src/HERMIT/Dictionary/New.hs
--- a/src/HERMIT/Dictionary/New.hs
+++ b/src/HERMIT/Dictionary/New.hs
@@ -1,31 +1,47 @@
-{-# LANGUAGE FlexibleContexts, MultiWayIf #-}
+{-# LANGUAGE CPP, FlexibleContexts #-}
 module HERMIT.Dictionary.New where
 
 import Control.Arrow
 
 import HERMIT.Context
 import HERMIT.Core
-import HERMIT.Monad
 import HERMIT.Kure
 import HERMIT.External
 import HERMIT.GHC
+#if __GLASGOW_HASKELL__ > 706
+import HERMIT.Monad
+#endif
 import HERMIT.ParserCore
 
-import qualified Language.Haskell.TH as TH
+#if __GLASGOW_HASKELL__ > 706
+import HERMIT.Dictionary.Composite hiding (externals)
+import HERMIT.Dictionary.Debug hiding (externals)
+#endif
+import HERMIT.Dictionary.Local.Let hiding (externals)
 
 externals ::  [External]
 externals = map ((.+ Experiment) . (.+ TODO))
-         [ external "var" (promoteExprT . isVar :: TH.Name -> TranslateH Core ())
-                [ "var '<v> returns successfully for variable v, and fails otherwise.",
-                  "Useful in combination with \"when\", as in: when (var v) r" ] .+ Predicate
-         , external "prog-nonrec-intro" ((\ nm core -> promoteProgR $ progNonRecIntroR (show nm) core) :: TH.Name -> CoreString -> RewriteH Core)
-                [ "Introduce a new top-level definition."
-                , "prog-nonrec-into 'v [| e |]"
-                , "prog ==> ProgCons (v = e) prog" ] .+ Introduce .+ Shallow
-         , external "let-nonrec-intro" ((\ nm core -> promoteExprR $ letNonRecIntroR (show nm) core) :: TH.Name -> CoreString -> RewriteH Core)
-                [ "Introduce a new definition as a non-recursive let binding."
-                , "let-nonrec-intro 'v [| e |]"
-                , "body ==> let v = e in body" ] .+ Introduce .+ Shallow
+         [ external "var" (promoteExprT . isVar :: String -> TranslateH Core ())
+                [ "var '<v> returns successfully for variable v, and fails otherwise."
+                , "Useful in combination with \"when\", as in: when (var v) r"
+                ] .+ Predicate
+         , external "nonrec-intro" (nonRecIntro :: String -> CoreString -> RewriteH Core)
+                [ "Introduce a new non-recursive binding.  Only works at Expression or Program nodes."
+                , "nonrec-into 'v [| e |]"
+                , "body ==> let v = e in body"
+                ] .+ Introduce .+ Shallow
+         -- , external "prog-nonrec-intro" ((\ nm core -> promoteProgR $ progNonRecIntro nm core) :: String -> CoreString -> RewriteH Core)
+         --        [ "Introduce a new top-level definition."
+         --        , "prog-nonrec-into 'v [| e |]"
+         --        , "prog ==> ProgCons (v = e) prog" ] .+ Introduce .+ Shallow
+         -- , external "let-nonrec-intro" ((\ nm core -> promoteExprR $ letNonRecIntro nm core) :: String -> CoreString -> RewriteH Core)
+         --        [ "Introduce a new definition as a non-recursive let binding."
+         --        , "let-nonrec-intro 'v [| e |]"
+         --        , "body ==> let v = e in body" ] .+ Introduce .+ Shallow
+#if __GLASGOW_HASKELL__ > 706
+         , external "replace-typeable-int-list" (promoteExprR (return (mkListTy intTy) >>> buildTypeableT) :: RewriteH Core)
+                [ "test building a dictionary" ]
+#endif
          ]
 
 ------------------------------------------------------------------------------------------------------
@@ -34,43 +50,49 @@
 -- Probably better to have another predicate that operates on CoreTC, that way it can reach TyVars buried within types.
 -- But given the current setup (using Core for most things), changing "var" to operate on CoreTC would make it incompatible with other combinators.
 -- I'm not sure how to fix the current setup though.
--- isVar :: (ExtendPath c Crumb, AddBindings c, MonadCatch m) => TH.Name -> Translate c m CoreExpr ()
+-- isVar :: (ExtendPath c Crumb, AddBindings c, MonadCatch m) => String -> Translate c m CoreExpr ()
 -- isVar nm = (varT matchName <+ typeT (tyVarT matchName) <+ coercionT (coVarCoT matchName))
 --                  >>= guardM
 --   where
 --     matchName :: Monad m => Translate c m Var Bool
---     matchName = arr (cmpTHName2Var nm)
+--     matchName = arr (cmpString2Var nm)
 
 -- TODO: there might be a better module for this
 
 -- | Test if the current expression is an identifier matching the given name.
-isVar :: (ExtendPath c Crumb, AddBindings c, MonadCatch m) => TH.Name -> Translate c m CoreExpr ()
-isVar nm = varT (arr $ cmpTHName2Var nm) >>= guardM
+isVar :: (ExtendPath c Crumb, AddBindings c, MonadCatch m) => String -> Translate c m CoreExpr ()
+isVar nm = varT (arr $ cmpString2Var nm) >>= guardM
 
 ------------------------------------------------------------------------------------------------------
 
 -- The types of these can probably be generalised after the Core Parser is generalised.
 
 -- | @prog@ ==> @'ProgCons' (v = e) prog@
-progNonRecIntroR :: String -> CoreString -> RewriteH CoreProg
-progNonRecIntroR nm expr =
-  do e <- parseCoreExprT expr
-     guardMsg (not $ isTyCoArg e) "Top-level type or coercion definitions are prohibited."
+nonRecIntro :: String -> CoreString -> RewriteH Core
+nonRecIntro nm expr = parseCoreExprT expr >>= nonRecIntroR nm
      -- TODO: if e is not type-correct, then exprType will crash.
      --       Proposal: parseCore should check that its result is (locally) well-typed
-     contextfreeT $ \ prog -> do i <- newIdH nm (exprType e)
-                                 return $ ProgCons (NonRec i e) prog
 
--- | @body@ ==> @let v = e in body@
-letNonRecIntroR :: String -> CoreString -> RewriteH CoreExpr
-letNonRecIntroR nm expr =
-  do e <- parseCoreExprT expr
-     -- TODO: if e is not type-correct, then exprTypeOrKind will crash.
-     --       Proposal: parseCore should check that its result is (locally) well-typed
-     contextfreeT $ \ body -> do let tyk = exprKindOrType e
-                                 v <- if | isTypeArg e  -> newTyVarH nm tyk
-                                         | isCoArg e    -> newCoVarH nm tyk
-                                         | otherwise    -> newIdH nm tyk
-                                 return $ Let (NonRec v e) body
 
+-- -- | @prog@ ==> @'ProgCons' (v = e) prog@
+-- progNonRecIntro :: String -> CoreString -> RewriteH CoreProg
+-- progNonRecIntro nm expr = parseCoreExprT expr >>= progNonRecIntroR nm
+--      -- TODO: if e is not type-correct, then exprType will crash.
+--      --       Proposal: parseCore should check that its result is (locally) well-typed
+
+-- -- | @body@ ==> @let v = e in body@
+-- letNonRecIntro :: String -> CoreString -> RewriteH CoreExpr
+-- letNonRecIntro nm expr = parseCoreExprT expr >>= letNonRecIntroR nm
+--      -- TODO: if e is not type-correct, then exprTypeOrKind will crash.
+--      --       Proposal: parseCore should check that its result is (locally) well-typed
+
+
 ------------------------------------------------------------------------------------------------------
+
+#if __GLASGOW_HASKELL__ > 706
+buildTypeableT :: TranslateH Type CoreExpr
+buildTypeableT = do
+    (i, bnds) <- translate $ \ c -> liftCoreM . buildTypeable (hermitC_modguts c)
+    return (mkCoreLets bnds (varToCoreExpr i)) >>> tryR (extractR simplifyR) >>> observeR "buildTypeableT result"
+#endif
+
diff --git a/src/HERMIT/Dictionary/Query.hs b/src/HERMIT/Dictionary/Query.hs
--- a/src/HERMIT/Dictionary/Query.hs
+++ b/src/HERMIT/Dictionary/Query.hs
@@ -26,8 +26,6 @@
 import HERMIT.Dictionary.GHC hiding (externals)
 import HERMIT.Dictionary.Inline hiding (externals)
 
-import qualified Language.Haskell.TH as TH
-
 --------------------------------------------------------
 
 -- | Externals that reflect GHC functions, or are derived from GHC functions.
@@ -35,7 +33,7 @@
 externals =
          [ external "info" (infoT :: TranslateH CoreTC String)
                 [ "Display information about the current node." ] .+ Query
-         , external "compare-bound-ids" (compareBoundIds ::  TH.Name -> TH.Name -> TranslateH CoreTC ())
+         , external "compare-bound-ids" (compareBoundIds :: String -> String -> TranslateH CoreTC ())
                 [ "Compare the definitions of two in-scope identifiers for alpha equality."] .+ Query .+ Predicate
          , external "compare-core-at" (compareCoreAtT ::  TranslateH Core LocalPathH -> TranslateH Core LocalPathH -> TranslateH Core ())
                 [ "Compare the core fragments at the end of the given paths for alpha-equality."] .+ Query .+ Predicate
@@ -147,6 +145,7 @@
                          NthCo{}       -> "NthCo"
                          InstCo{}      -> "InstCo"
 #if __GLASGOW_HASKELL__ > 706
+                         AxiomRuleCo{} -> "AxiomRuleCo"
                          LRCo{}        -> "LRCo"
                          SubCo{}       -> "SubCo"
                          UnivCo{}      -> "UnivCo"
@@ -174,7 +173,7 @@
      guardMsg (e1 `exprAlphaEq` e2) "bindings are not alpha-equivalent."
 
 -- | Compare the definitions of the two named identifiers for alpha-equality.
-compareBoundIds :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c, HasGlobalRdrEnv c) => TH.Name -> TH.Name -> Translate c HermitM x ()
+compareBoundIds :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c, HasGlobalRdrEnv c) => String -> String -> Translate c HermitM x ()
 compareBoundIds nm1 nm2 = do i1 <- findIdT nm1
                              i2 <- findIdT nm2
                              compareBoundIdsT i1 i2
diff --git a/src/HERMIT/Dictionary/Reasoning.hs b/src/HERMIT/Dictionary/Reasoning.hs
--- a/src/HERMIT/Dictionary/Reasoning.hs
+++ b/src/HERMIT/Dictionary/Reasoning.hs
@@ -1,19 +1,32 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, FlexibleInstances, InstanceSigs, ScopedTypeVariables #-}
 
 module HERMIT.Dictionary.Reasoning
   ( -- * Equational Reasoning
     externals
+  , CoreExprEquality(..)
+  , CoreExprEqualityProof
+  , flipCoreExprEquality
+  , eqLhsIntroR
+  , eqRhsIntroR
+  , birewrite
+  , verifyCoreExprEqualityT
   , verifyEqualityLeftToRightT
   , verifyEqualityCommonTargetT
   , verifyIsomorphismT
   , verifyRetractionT
   , retractionBR
+  , instantiateCoreExprEq
+  , instantiateCoreExprEqVar
+  , discardUniVars
   )
 where
 
 import Control.Applicative
 import Control.Arrow
 
+import Data.Monoid
+
+import HERMIT.Context
 import HERMIT.Core
 import HERMIT.External
 import HERMIT.GHC
@@ -23,6 +36,9 @@
 import HERMIT.Utilities
 
 import HERMIT.Dictionary.Common
+import HERMIT.Dictionary.Fold hiding (externals)
+import HERMIT.Dictionary.Local.Let (nonRecIntroR)
+import HERMIT.Dictionary.Unfold hiding (externals)
 
 ------------------------------------------------------------------------------
 
@@ -41,6 +57,74 @@
 
 ------------------------------------------------------------------------------
 
+-- | An equality is represented as a set of universally quantified binders, and then the LHS and RHS of the equality.
+data CoreExprEquality = CoreExprEquality [CoreBndr] CoreExpr CoreExpr
+
+type CoreExprEqualityProof c m = (Rewrite c m CoreExpr, Rewrite c m CoreExpr)
+
+-- | Flip the LHS and RHS of a 'CoreExprEquality'.
+flipCoreExprEquality :: CoreExprEquality -> CoreExprEquality
+flipCoreExprEquality (CoreExprEquality xs lhs rhs) = CoreExprEquality xs rhs lhs
+
+------------------------------------------------------------------------------
+
+-- | @e@ ==> @let v = lhs in e@
+eqLhsIntroR :: CoreExprEquality -> Rewrite c HermitM Core
+eqLhsIntroR (CoreExprEquality bs lhs _) = nonRecIntroR "lhs" (mkCoreLams bs lhs)
+
+-- | @e@ ==> @let v = rhs in e@
+eqRhsIntroR :: CoreExprEquality -> Rewrite c HermitM Core
+eqRhsIntroR (CoreExprEquality bs _ rhs) = nonRecIntroR "rhs" (mkCoreLams bs rhs)
+
+------------------------------------------------------------------------------
+
+-- | Create a 'BiRewrite' from a 'CoreExprEquality'.
+--
+-- The high level idea: create a temporary function with two definitions.
+-- Fold one of the defintions, then immediately unfold the other.
+birewrite :: (AddBindings c, ReadBindings c, ExtendPath c Crumb, ReadPath c Crumb) => CoreExprEquality -> BiRewrite c HermitM CoreExpr
+birewrite (CoreExprEquality bnds l r) = bidirectional (foldUnfold l r) (foldUnfold r l)
+    where foldUnfold lhs rhs = translate $ \ c e -> do
+            let lhsLam = mkCoreLams bnds lhs
+            -- we use a unique, transitory variable for the 'function' we are folding
+            v <- newIdH "biTemp" (exprType lhsLam)
+            e' <- maybe (fail "folding LHS failed") return (fold v lhsLam e)
+            let rhsLam = mkCoreLams bnds rhs
+                -- create a temporary context with an unfolding for the
+                -- transitory function so we can reuse unfoldR.
+                c' = addHermitBindings [(v, NONREC rhsLam, mempty)] c
+            apply unfoldR c' e'
+
+-- Idea: use Haskell's functions to fill the holes automagically
+--
+-- plusId <- findIdT "+"
+-- timesId <- findIdT "*"
+-- mkEquality $ \ x -> ( mkCoreApps (Var plusId)  [x,x]
+--                     , mkCoreApps (Var timesId) [Lit 2, x])
+--
+-- Problem: need to know type of 'x' to generate a variable.
+class BuildEquality a where
+    mkEquality :: a -> HermitM CoreExprEquality
+
+instance BuildEquality (CoreExpr,CoreExpr) where
+    mkEquality :: (CoreExpr,CoreExpr) -> HermitM CoreExprEquality
+    mkEquality (lhs,rhs) = return $ CoreExprEquality [] lhs rhs
+
+instance BuildEquality a => BuildEquality (CoreExpr -> a) where
+    mkEquality :: (CoreExpr -> a) -> HermitM CoreExprEquality
+    mkEquality f = do
+        x <- newIdH "x" (error "need to create a type")
+        CoreExprEquality bnds lhs rhs <- mkEquality (f (varToCoreExpr x))
+        return $ CoreExprEquality (x:bnds) lhs rhs
+
+-- | Verify that a 'CoreExprEquality' holds, by applying a rewrite to each side, and checking that the results are equal.
+verifyCoreExprEqualityT :: forall c m. (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, MonadCatch m, Walker c Core) => CoreExprEqualityProof c m -> Translate c m CoreExprEquality ()
+verifyCoreExprEqualityT (lhsR,rhsR) =
+     do CoreExprEquality bs lhs rhs <- idR
+        verifyEqualityCommonTargetT lhs rhs (withVarsInScope bs lhsR, withVarsInScope bs rhsR)
+
+------------------------------------------------------------------------------
+
 -- | Given two expressions, and a rewrite from the former to the latter, verify that rewrite.
 verifyEqualityLeftToRightT :: MonadCatch m => CoreExpr -> CoreExpr -> Rewrite c m CoreExpr -> Translate c m a ()
 verifyEqualityLeftToRightT sourceExpr targetExpr r =
@@ -48,9 +132,9 @@
   do resultExpr <- r <<< return sourceExpr
      guardMsg (exprAlphaEq targetExpr resultExpr) "result of running proof on lhs of equality does not match rhs of equality."
 
--- | Given two expressions, and a rewrite from the former to the latter, verify that rewrite.
-verifyEqualityCommonTargetT :: MonadCatch m => CoreExpr -> CoreExpr -> Rewrite c m CoreExpr -> Rewrite c m CoreExpr -> Translate c m a ()
-verifyEqualityCommonTargetT lhs rhs lhsR rhsR =
+-- | Given two expressions, and a rewrite to apply to each, verify that the resulting expressions are equal.
+verifyEqualityCommonTargetT :: MonadCatch m => CoreExpr -> CoreExpr -> CoreExprEqualityProof c m -> Translate c m a ()
+verifyEqualityCommonTargetT lhs rhs (lhsR,rhsR) =
   prefixFailMsg "equality verification failed: " $
   do lhsResult <- lhsR <<< return lhs
      rhsResult <- rhsR <<< return rhs
@@ -63,7 +147,7 @@
 -- | Given f :: X -> Y and g :: Y -> X, verify that f (g y) ==> y and g (f x) ==> x.
 verifyIsomorphismT :: CoreExpr -> CoreExpr -> Rewrite c HermitM CoreExpr -> Rewrite c HermitM CoreExpr -> Translate c HermitM a ()
 verifyIsomorphismT f g fgR gfR = prefixFailMsg "Isomorphism verification failed: " $
-   do (tyX, tyY) <- funsWithInverseTypes f g
+   do (tyX, tyY) <- funExprsWithInverseTypes f g
       x          <- constT (newGlobalIdH "x" tyX)
       y          <- constT (newGlobalIdH "y" tyY)
       verifyEqualityLeftToRightT (App f (App g (Var y))) (Var y) fgR
@@ -72,7 +156,7 @@
 -- | Given f :: X -> Y and g :: Y -> X, verify that f (g y) ==> y.
 verifyRetractionT :: CoreExpr -> CoreExpr -> Rewrite c HermitM CoreExpr -> Translate c HermitM a ()
 verifyRetractionT f g r = prefixFailMsg "Retraction verification failed: " $
-   do (_tyX, tyY) <- funsWithInverseTypes f g
+   do (_tyX, tyY) <- funExprsWithInverseTypes f g
       y           <- constT (newGlobalIdH "y" tyY)
       let lhs = App f (App g (Var y))
           rhs = Var y
@@ -86,7 +170,7 @@
                          (prefixFailMsg "Retraction failed: " $
                           do whenJust (verifyRetractionT f g) mr
                              y        <- idR
-                             (_, tyY) <- funsWithInverseTypes f g
+                             (_, tyY) <- funExprsWithInverseTypes f g
                              guardMsg (exprKindOrType y `typeAlphaEq` tyY) "type of expression does not match given retraction components."
                              return y
                          )
@@ -107,3 +191,30 @@
 retraction mr = parse2beforeBiR (retractionBR (extractR <$> mr))
 
 ------------------------------------------------------------------------------
+
+-- | Instantiate one of the universally quantified variables in a 'CoreExprEquality'.
+-- Note: assumes implicit ordering of variables, such that substitution happens to the right
+-- as it does in case alternatives.
+instantiateCoreExprEqVar :: Var -> CoreExpr -> CoreExprEquality -> CoreExprEquality
+instantiateCoreExprEqVar i e c@(CoreExprEquality bs lhs rhs)
+    | i `notElem` bs = c
+    | otherwise =
+        let (bs',_:vs)    = break (==i) bs -- this is safe because we know i is in bs
+            inS           = delVarSetList (unionVarSets (map localFreeVarsExpr [lhs, rhs, e] ++ map freeVarsVar vs)) (i:vs)
+            subst         = extendSubst (mkEmptySubst (mkInScopeSet inS)) i e
+            (subst', vs') = substBndrs subst vs
+            lhs'          = substExpr (text "coreExprEquality-lhs") subst' lhs
+            rhs'          = substExpr (text "coreExprEquality-rhs") subst' rhs
+        in CoreExprEquality (bs'++vs') lhs' rhs'
+
+-- | Instantiate a set of universally quantified variables in a 'CoreExprEquality'.
+-- It is important that all type variables appear before any value-level variables in the first argument.
+instantiateCoreExprEq :: [(Var,CoreExpr)] -> CoreExprEquality -> CoreExprEquality
+instantiateCoreExprEq = flip (foldr (uncurry instantiateCoreExprEqVar))
+-- foldr is important here because it effectively does the substitutions in reverse order,
+-- which is what we want (all value variables should be instantiated before type variables).
+
+------------------------------------------------------------------------------
+
+discardUniVars :: CoreExprEquality -> CoreExprEquality
+discardUniVars (CoreExprEquality _ lhs rhs) = CoreExprEquality [] lhs rhs
diff --git a/src/HERMIT/Dictionary/Rules.hs b/src/HERMIT/Dictionary/Rules.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Dictionary/Rules.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE CPP, FlexibleContexts #-}
+module HERMIT.Dictionary.Rules
+       ( -- * GHC Rewrite Rules and Specialisation
+         externals
+         -- ** Rules
+       , RuleNameString
+       , ruleR
+       , rulesR
+       , ruleToEqualityT
+       , ruleNameToEqualityT
+       , getSingletonHermitRuleT
+       -- , verifyCoreRuleT
+       -- , verifyRuleT
+       -- , ruleLhsIntroR
+       -- , ruleRhsIntroR
+         -- ** Specialisation
+       , specConstrR
+       )
+where
+
+import IOEnv hiding (liftIO)
+import qualified SpecConstr
+import qualified Specialise
+
+import Control.Arrow
+import Control.Monad
+
+import Data.Function (on)
+import Data.List (deleteFirstsBy,intercalate)
+
+import HERMIT.Core
+import HERMIT.Context
+import HERMIT.Monad
+import HERMIT.Kure
+import HERMIT.External
+import HERMIT.GHC
+
+import HERMIT.Dictionary.Common (findIdT,inScope,callT)
+import HERMIT.Dictionary.GHC (dynFlagsT)
+-- import HERMIT.Dictionary.Induction
+import HERMIT.Dictionary.Kure (anyCallR)
+import HERMIT.Dictionary.Reasoning hiding (externals)
+import HERMIT.Dictionary.Unfold (cleanupUnfoldR)
+
+------------------------------------------------------------------------
+
+-- | Externals that reflect GHC functions, or are derived from GHC functions.
+externals :: [External]
+externals =
+         [ external "rules-help-list" (rulesHelpListT :: TranslateH CoreTC String)
+                [ "List all the rules in scope." ] .+ Query
+         , external "rule-help" (ruleHelpT :: RuleNameString -> TranslateH CoreTC String)
+                [ "Display details on the named rule." ] .+ Query
+         , external "apply-rule" (promoteExprR . ruleR :: RuleNameString -> RewriteH Core)
+                [ "Apply a named GHC rule" ] .+ Shallow
+         , external "apply-rules" (promoteExprR . rulesR :: [RuleNameString] -> RewriteH Core)
+                [ "Apply named GHC rules, succeed if any of the rules succeed" ] .+ Shallow
+         , external "add-rule" ((\ rule_name id_name -> promoteModGutsR (addCoreBindAsRule rule_name id_name)) :: String -> String -> RewriteH Core)
+                [ "add-rule \"rule-name\" <id> -- adds a new rule that freezes the right hand side of the <id>"]  .+ Introduce
+         , external "unfold-rule" ((\ nm -> promoteExprR (ruleR nm >>> cleanupUnfoldR)) :: String -> RewriteH Core)
+                [ "Unfold a named GHC rule" ] .+ Deep .+ Context .+ TODO -- TODO: does not work with rules with no arguments
+         , external "spec-constr" (promoteModGutsR specConstrR :: RewriteH Core)
+                [ "Run GHC's SpecConstr pass, which performs call pattern specialization."] .+ Deep
+         , external "specialise" (promoteModGutsR specialise :: RewriteH Core)
+                [ "Run GHC's specialisation pass, which performs type and dictionary specialisation."] .+ Deep
+         ]
+
+------------------------------------------------------------------------
+
+{-
+lookupRule :: (Activation -> Bool)	-- When rule is active
+	    -> IdUnfoldingFun		-- When Id can be unfolded
+            -> InScopeSet
+	    -> Id -> [CoreExpr]
+	    -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
+
+GHC HEAD:
+type InScopeEnv = (InScopeSet, IdUnfoldingFun)
+
+lookupRule :: DynFlags -> InScopeEnv
+           -> (Activation -> Bool)      -- When rule is active
+           -> Id -> [CoreExpr]
+           -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
+-}
+
+-- Neil: Commented this out as it's not (currently) used.
+-- rulesToEnv :: [CoreRule] -> Map.Map String (Rewrite c m CoreExpr)
+-- rulesToEnv rs = Map.fromList
+--         [ ( unpackFS (ruleName r), rulesToRewrite c m [r] )
+--         | r <- rs
+--         ]
+
+type RuleNameString = String
+
+-- TODO: deprecate this (and related functions) in favor of 'biRuleUnsafeR'
+#if __GLASGOW_HASKELL__ > 706
+rulesToRewriteH :: (ReadBindings c, HasDynFlags m, MonadCatch m) => [CoreRule] -> Rewrite c m CoreExpr
+#else
+rulesToRewriteH :: (ReadBindings c, MonadCatch m) => [CoreRule] -> Rewrite c m CoreExpr
+#endif
+rulesToRewriteH rs = prefixFailMsg "RulesToRewrite failed: " $
+                     withPatFailMsg "rule not matched." $ do
+    (Var fn, args) <- callT
+    translate $ \ c e -> do
+        let in_scope = mkInScopeSet (mkVarEnv [ (v,v) | v <- varSetElems (localFreeVarsExpr e) ])
+#if __GLASGOW_HASKELL__ > 706
+        dflags <- getDynFlags
+        case lookupRule dflags (in_scope, const NoUnfolding) (const True) fn args [r | r <- rs, ru_fn r == idName fn] of
+#else
+        case lookupRule (const True) (const NoUnfolding) in_scope fn args [r | r <- rs, ru_fn r == idName fn] of
+#endif
+            Nothing         -> fail "rule not matched"
+            Just (r, expr)  -> do
+                let e' = mkApps expr (drop (ruleArity r) args)
+                if all (inScope c) $ varSetElems $ localFreeVarsExpr e' -- TODO: The problem with this check, is that it precludes the case where this is an intermediate transformation.  I can imagine situations where some variables would be out-of-scope at this point, but in scope again after a subsequent transformation.
+                  then return e'
+                  else fail $ unlines ["Resulting expression after rule application contains variables that are not in scope."
+                                      ,"This can probably be solved by running the flatten-module command at the top level."]
+
+-- | Lookup a rule and attempt to construct a corresponding rewrite.
+ruleR :: (ReadBindings c, HasCoreRules c) => RuleNameString -> Rewrite c HermitM CoreExpr
+ruleR r = do
+    theRules <- getHermitRulesT
+    case lookup r theRules of
+        Nothing -> fail $ "failed to find rule: " ++ show r
+        Just rr -> rulesToRewriteH rr
+
+rulesR :: (ReadBindings c, HasCoreRules c) => [RuleNameString] -> Rewrite c HermitM CoreExpr
+rulesR = orR . map ruleR
+
+getHermitRulesT :: HasCoreRules c => Translate c HermitM a [(RuleNameString, [CoreRule])]
+getHermitRulesT = contextonlyT $ \ c -> do
+    rb     <- liftCoreM getRuleBase
+    hscEnv <- liftCoreM getHscEnv
+    rb'    <- liftM eps_rule_base $ liftIO $ runIOEnv () $ readMutVar (hsc_EPS hscEnv)
+    return [ ( unpackFS (ruleName r), [r] )
+           | r <- hermitCoreRules c ++ concat (nameEnvElts rb) ++ concat (nameEnvElts rb')
+           ]
+
+getHermitRuleT :: HasCoreRules c => RuleNameString -> Translate c HermitM a [CoreRule]
+getHermitRuleT name =
+  do rulesEnv <- getHermitRulesT
+     case filter ((name ==) . fst) rulesEnv of
+       []         -> fail ("Rule \"" ++ name ++ "\" not found.")
+       [(_,rus)]  -> return rus
+       _          -> fail ("Rule name \"" ++ name ++ "\" is ambiguous.")
+
+getSingletonHermitRuleT :: HasCoreRules c => RuleNameString -> Translate c HermitM a CoreRule
+getSingletonHermitRuleT name =
+  do rus <- getHermitRuleT name
+     case rus of
+        []    -> fail "No rules with that name."
+        [ru]  -> return ru
+        _     -> fail "Multiple rules with that name."
+
+
+rulesHelpListT :: HasCoreRules c => Translate c HermitM a String
+rulesHelpListT = do
+    rulesEnv <- getHermitRulesT
+    return (intercalate "\n" $ map fst rulesEnv)
+
+ruleHelpT :: HasCoreRules c => RuleNameString -> Translate c HermitM a String
+ruleHelpT name = showSDoc <$> dynFlagsT <*> (pprRulesForUser <$> getHermitRuleT name)
+
+-- Too much information.
+-- rulesHelpT :: HasCoreRules c => Translate c HermitM a String
+-- rulesHelpT = do
+--     rulesEnv <- getHermitRulesT
+--     dynFlags <- dynFlagsT
+--     return  $ (show (map fst rulesEnv) ++ "\n") ++
+--               showSDoc dynFlags (pprRulesForUser $ concatMap snd rulesEnv)
+
+makeRule :: RuleNameString -> Id -> CoreExpr -> CoreRule
+makeRule rule_name nm =   mkRule True   -- auto-generated
+                                 False  -- local
+                                 (mkFastString rule_name)
+                                 NeverActive    -- because we need to call for these
+                                 (varName nm)
+                                 []
+                                 []
+
+-- TODO: check if a top-level binding
+addCoreBindAsRule :: Monad m => RuleNameString -> String -> Rewrite c m ModGuts
+addCoreBindAsRule rule_name nm = contextfreeT $ \ modGuts ->
+        case [ (v,e)
+             | bnd   <- mg_binds modGuts
+             , (v,e) <- bindToVarExprs bnd
+             ,  nm `cmpString2Var` v
+             ] of
+         [] -> fail $ "cannot find binding " ++ nm
+         [(v,e)] -> return $ modGuts { mg_rules = mg_rules modGuts
+                                              ++ [makeRule rule_name v e]
+                                     }
+         _ -> fail $ "found multiple bindings for " ++ nm
+
+-- | Returns the universally quantified binders, the LHS, and the RHS.
+ruleToEqualityT :: (BoundVars c, HasGlobalRdrEnv c, HasDynFlags m, MonadThings m, MonadCatch m) => Translate c m CoreRule CoreExprEquality
+ruleToEqualityT = withPatFailMsg "HERMIT cannot handle built-in rules yet." $
+  do r@Rule{} <- idR -- other possibility is "BuiltinRule"
+     f <- findIdT (getOccString $ ru_fn r) -- TODO: refactor name lookup functions (like findIdT) to avoid intermediate String here
+     return $ CoreExprEquality (ru_bndrs r) (mkCoreApps (Var f) (ru_args r)) (ru_rhs r)
+
+ruleNameToEqualityT :: (BoundVars c, HasGlobalRdrEnv c, HasCoreRules c) => RuleNameString -> Translate c HermitM a CoreExprEquality
+ruleNameToEqualityT name = getSingletonHermitRuleT name >>> ruleToEqualityT
+
+------------------------------------------------------------------------
+
+-- | Run GHC's specConstr pass, and apply any rules generated.
+specConstrR :: RewriteH ModGuts
+specConstrR = prefixFailMsg "spec-constr failed: " $ do
+    rs  <- extractT specRules
+    e'  <- contextfreeT $ liftCoreM . SpecConstr.specConstrProgram
+    rs' <- return e' >>> extractT specRules
+    let specRs = deleteFirstsBy ((==) `on` ru_name) rs' rs
+    guardMsg (notNull specRs) "no rules created."
+    return e' >>> extractR (repeatR (anyCallR (promoteExprR $ rulesToRewriteH specRs)))
+
+-- | Run GHC's specialisation pass, and apply any rules generated.
+specialise :: RewriteH ModGuts
+specialise = prefixFailMsg "specialisation failed: " $ do
+    gRules <- arr mg_rules
+    lRules <- extractT specRules
+
+#if __GLASGOW_HASKELL__ <= 706
+    dflags <- dynFlagsT
+    guts <- contextfreeT $ liftCoreM . Specialise.specProgram dflags
+#else
+    guts <- contextfreeT $ liftCoreM . Specialise.specProgram
+#endif
+
+    lRules' <- return guts >>> extractT specRules -- spec rules on bindings in this module
+    let gRules' = mg_rules guts            -- plus spec rules on imported bindings
+        gSpecRs = deleteFirstsBy ((==) `on` ru_name) gRules' gRules
+        lSpecRs = deleteFirstsBy ((==) `on` ru_name) lRules' lRules
+        specRs = gSpecRs ++ lSpecRs
+    guardMsg (notNull specRs) "no rules created."
+    liftIO $ putStrLn $ unlines $ map (unpackFS . ru_name) specRs
+    return guts >>> extractR (repeatR (anyCallR (promoteExprR $ rulesToRewriteH specRs)))
+
+-- | Get all the specialization rules on a binding.
+--   These are created by SpecConstr and other GHC passes.
+idSpecRules :: TranslateH Id [CoreRule]
+idSpecRules = do
+    guardMsgM (arr isId) "idSpecRules called on TyVar." -- idInfo panics on TyVars
+    contextfreeT $ \ i -> let SpecInfo rs _ = specInfo (idInfo i) in return rs
+
+-- | Promote 'idSpecRules' to CoreBind.
+bindSpecRules :: TranslateH CoreBind [CoreRule]
+bindSpecRules =    recT (\_ -> defT idSpecRules successT const) concat
+                <+ nonRecT idSpecRules successT const
+
+-- | Find all specialization rules in a Core fragment.
+specRules :: TranslateH Core [CoreRule]
+specRules = crushtdT $ promoteBindT bindSpecRules
+
+------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Undefined.hs b/src/HERMIT/Dictionary/Undefined.hs
--- a/src/HERMIT/Dictionary/Undefined.hs
+++ b/src/HERMIT/Dictionary/Undefined.hs
@@ -6,7 +6,8 @@
     , verifyStrictT
     , mkUndefinedValT
     , isUndefinedValT
-    , replaceWithUndefinedR
+    , replaceCurrentExprWithUndefinedR
+    , replaceIdWithUndefinedR
     , errorToUndefinedR
     , undefinedExprR
     , undefinedAppR
@@ -20,6 +21,7 @@
     )
 where
 
+import Control.Monad ((>=>))
 import Data.Monoid
 
 import HERMIT.Context
@@ -29,17 +31,19 @@
 import HERMIT.External
 
 import HERMIT.Dictionary.Common
+import HERMIT.Dictionary.GHC (substR)
 import HERMIT.Dictionary.Reasoning hiding (externals)
 
-import qualified Language.Haskell.TH as TH
-
 ------------------------------------------------------------------------
 
 externals :: [External]
 externals = map (.+ Unsafe)
-    [ external "replace-with-undefined" (promoteExprR replaceWithUndefinedR :: RewriteH Core)
+    [ external "replace-current-expr-with-undefined" (promoteExprR replaceCurrentExprWithUndefinedR :: RewriteH Core)
         [ "Set the current expression to \"undefined\"."
         ] .+ Shallow .+ Context .+ Unsafe
+    , external "replace-id-with-undefined" (replaceIdWithUndefined :: String -> RewriteH Core)
+        [ "Replace the specified identifier with \"undefined\"."
+        ] .+ Deep .+ Context .+ Unsafe
     , external "error-to-undefined" (promoteExprR errorToUndefinedR :: RewriteH Core)
         [ "error ty string  ==>  undefined ty"
         ] .+ Shallow .+ Context
@@ -78,7 +82,7 @@
 
 -- TODO: will crash if 'undefined' is not used (or explicitly imported) in the source file.
 findUndefinedIdT :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Translate c m a Id
-findUndefinedIdT = findIdT (TH.mkName undefinedLocation)
+findUndefinedIdT = findIdT undefinedLocation
 
 -- | Check if the current expression is an undefined value.
 isUndefinedValT :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Translate c m CoreExpr ()
@@ -95,7 +99,7 @@
 
 -- TODO: will crash if 'error' is not used (or explicitly imported) in the source file.
 findErrorIdT :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Translate c m a Id
-findErrorIdT = findIdT (TH.mkName errorLocation)
+findErrorIdT = findIdT errorLocation
 
 -- | Check if the current expression is an undefined value.
 isErrorValT :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Translate c m CoreExpr ()
@@ -109,7 +113,7 @@
 
 -- | error ty string ==> undefined ty
 errorToUndefinedR :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
-errorToUndefinedR = prefixFailMsg "error-to-undefined failed: " (isErrorValT >> replaceWithUndefinedR)
+errorToUndefinedR = prefixFailMsg "error-to-undefined failed: " (isErrorValT >> replaceCurrentExprWithUndefinedR)
 
 ------------------------------------------------------------------------
 
@@ -122,9 +126,16 @@
 ------------------------------------------------------------------------------------------------------
 
 -- | Set the current expression to 'undefined'.
-replaceWithUndefinedR :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
-replaceWithUndefinedR = contextfreeT exprTypeM >>= mkUndefinedValT
+replaceCurrentExprWithUndefinedR :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
+replaceCurrentExprWithUndefinedR = contextfreeT exprTypeM >>= mkUndefinedValT
 
+-- | Replace all occurrences of the specified identifier with 'undefined'.
+replaceIdWithUndefinedR :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Id -> Rewrite c m Core
+replaceIdWithUndefinedR i = mkUndefinedValT (idType i) >>= substR i
+
+replaceIdWithUndefined :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => String -> Rewrite c m Core
+replaceIdWithUndefined = findIdT >=> replaceIdWithUndefinedR
+
 ------------------------------------------------------------------------------------------------------
 
 -- | undefinedExprR = undefinedAppR <+ undefinedLamR <+ undefinedLetR <+ undefinedCastR <+ undefinedTickR <+ undefinedCaseR
@@ -138,31 +149,31 @@
 undefinedAppR :: (BoundVars c, ExtendPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedAppR = prefixFailMsg "undefined-app failed: " $
                 do appT isUndefinedValT successT (<>)
-                   replaceWithUndefinedR
+                   replaceCurrentExprWithUndefinedR
 
 -- | @(\ v -> undefined ty1)@ ==> @undefined ty2@  (where v is not a 'TyVar')
 undefinedLamR :: (AddBindings c, BoundVars c, ExtendPath c Crumb, ReadPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedLamR = prefixFailMsg "undefined-lam failed: " $
                 do lamT successT isUndefinedValT (<>)
-                   replaceWithUndefinedR
+                   replaceCurrentExprWithUndefinedR
 
 -- | let bds in (undefined ty) ==> undefined ty
 undefinedLetR :: (AddBindings c, BoundVars c, ExtendPath c Crumb, ReadPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedLetR = prefixFailMsg "undefined-let failed: " $
                 do letT successT isUndefinedValT (<>)
-                   replaceWithUndefinedR
+                   replaceCurrentExprWithUndefinedR
 
 -- | Cast (undefined ty1) co ==> undefined ty2
 undefinedCastR :: (BoundVars c, ExtendPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedCastR = prefixFailMsg "undefined-cast failed: " $
                 do castT isUndefinedValT successT (<>)
-                   replaceWithUndefinedR
+                   replaceCurrentExprWithUndefinedR
 
 -- | Tick tick (undefined ty1) ==> undefined ty1
 undefinedTickR :: (BoundVars c, ExtendPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedTickR = prefixFailMsg "undefined-tick failed: " $
                 do tickT successT isUndefinedValT (<>)
-                   replaceWithUndefinedR
+                   replaceCurrentExprWithUndefinedR
 
 -- | undefinedCaseR = undefinedCaseScrutineeR <+ undefinedCaseAltsR
 undefinedCaseR :: (AddBindings c, BoundVars c, ExtendPath c Crumb, ReadPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
@@ -172,20 +183,20 @@
 undefinedCaseScrutineeR :: (AddBindings c, BoundVars c, ExtendPath c Crumb, ReadPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedCaseScrutineeR = prefixFailMsg "undefined-case failed: " $
                  do caseT isUndefinedValT successT successT (const successT) (\ _ _ _ _ -> ())
-                    replaceWithUndefinedR
+                    replaceCurrentExprWithUndefinedR
 
 -- | case e of {pat_1 -> undefined ty ; pat_2 -> undefined ty ; ... ; pat_n -> undefined ty} ==> undefined ty
 undefinedCaseAltsR :: (AddBindings c, BoundVars c, ExtendPath c Crumb, ReadPath c Crumb, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => Rewrite c m CoreExpr
 undefinedCaseAltsR = prefixFailMsg "undefined-case-alts failed: " $
                      do caseAltT successT successT successT (const (successT,const successT,isUndefinedValT)) (\ _ _ _ _ -> ())
-                        replaceWithUndefinedR
+                        replaceCurrentExprWithUndefinedR
 
 ------------------------------------------------------------------------
 
 -- | Verify that the given rewrite is a proof that the given expression is a strict function.
 verifyStrictT :: (BoundVars c, HasGlobalRdrEnv c, MonadCatch m, HasDynFlags m, MonadThings m) => CoreExpr -> Rewrite c m CoreExpr -> Translate c m a ()
 verifyStrictT f r = prefixFailMsg "strictness verification failed: " $
-  do (argTy, resTy) <- constT (funArgResTypes f)
+  do (argTy, resTy) <- constT (funExprArgResTypes f)
      undefArg       <- mkUndefinedValT argTy
      rhs            <- mkUndefinedValT resTy
      let lhs = App f undefArg
diff --git a/src/HERMIT/Dictionary/Unfold.hs b/src/HERMIT/Dictionary/Unfold.hs
--- a/src/HERMIT/Dictionary/Unfold.hs
+++ b/src/HERMIT/Dictionary/Unfold.hs
@@ -19,12 +19,9 @@
 import Data.List (intercalate)
 import qualified Data.Map as Map
 
-import qualified Language.Haskell.TH as TH
-
 import HERMIT.PrettyPrinter.Common (DocH, PrettyH, TranslateDocH(..), PrettyC)
 
 import HERMIT.Dictionary.Common
-import HERMIT.Dictionary.GHC (rule,inScope)
 import HERMIT.Dictionary.Inline (inlineR)
 import HERMIT.Dictionary.Local.Let (letNonRecSubstR)
 
@@ -47,20 +44,18 @@
         [ "Clean up immediately nested fully-applied lambdas, from the bottom up" ] .+ Deep
     , external "remember" (rememberR :: Label -> RewriteH Core)
         [ "Remember the current binding, allowing it to be folded/unfolded in the future." ] .+ Context
-    , external "unfold" (promoteExprR . unfoldStashR :: String -> RewriteH Core)
+    , external "unfold-remembered" (promoteExprR . unfoldStashR :: String -> RewriteH Core)
         [ "Unfold a remembered definition." ] .+ Deep .+ Context
     , external "unfold" (promoteExprR unfoldR :: RewriteH Core)
         [ "In application f x y z, unfold f." ] .+ Deep .+ Context
-    , external "unfold" (promoteExprR . unfoldNameR :: TH.Name -> RewriteH Core)
+    , external "unfold" (promoteExprR . unfoldNameR :: String -> RewriteH Core)
         [ "Inline a definition, and apply the arguments; traditional unfold." ] .+ Deep .+ Context
-    , external "unfold" (promoteExprR . unfoldNamesR :: [TH.Name] -> RewriteH Core)
+    , external "unfold" (promoteExprR . unfoldNamesR :: [String] -> RewriteH Core)
         [ "Unfold a definition if it is named in the list." ] .+ Deep .+ Context
     , external "unfold-saturated" (promoteExprR unfoldSaturatedR :: RewriteH Core)
         [ "Unfold a definition only if the function is fully applied." ] .+ Deep .+ Context
     , external "specialize" (promoteExprR specializeR :: RewriteH Core)
         [ "Specialize an application to its type and coercion arguments." ] .+ Deep .+ Context
-    , external "unfold-rule" ((\ nm -> promoteExprR (rule nm >>> cleanupUnfoldR)) :: String -> RewriteH Core)
-        [ "Unfold a named GHC rule" ] .+ Deep .+ Context .+ TODO -- TODO: does not work with rules with no arguments
     , external "show-remembered" (TranslateDocH showStashT :: TranslateDocH CoreTC)
         [ "Display all remembered definitions." ]
     ]
@@ -93,15 +88,15 @@
 unfoldR :: forall c. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => Rewrite c HermitM CoreExpr
 unfoldR = prefixFailMsg "unfold failed: " (go >>> cleanupUnfoldR)
     where go :: Rewrite c HermitM CoreExpr
-          go = inlineR <+ appAllR go idR
+          go = appAllR go idR <+ inlineR -- this order gives better error messages
 
 unfoldPredR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => (Id -> [CoreExpr] -> Bool) -> Rewrite c HermitM CoreExpr
 unfoldPredR p = callPredT p >> unfoldR
 
-unfoldNameR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => TH.Name -> Rewrite c HermitM CoreExpr
-unfoldNameR nm = prefixFailMsg ("unfold '" ++ show nm ++ " failed: ") (callNameT nm >> unfoldR)
+unfoldNameR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => String -> Rewrite c HermitM CoreExpr
+unfoldNameR nm = prefixFailMsg ("unfold '" ++ nm ++ " failed: ") (callNameT nm >> unfoldR)
 
-unfoldNamesR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [TH.Name] -> Rewrite c HermitM CoreExpr
+unfoldNamesR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c) => [String] -> Rewrite c HermitM CoreExpr
 unfoldNamesR []  = fail "unfold-names failed: no names given."
 unfoldNamesR nms = setFailMsg "unfold-names failed." $
                    orR (map unfoldNameR nms)
diff --git a/src/HERMIT/Dictionary/Unsafe.hs b/src/HERMIT/Dictionary/Unsafe.hs
--- a/src/HERMIT/Dictionary/Unsafe.hs
+++ b/src/HERMIT/Dictionary/Unsafe.hs
@@ -20,10 +20,11 @@
 externals :: [External]
 externals = map (.+ Unsafe)
     [ external "unsafe-replace" (promoteExprR . unsafeReplaceR :: CoreString -> RewriteH Core)
-        [ "replace the currently focused expression with a new expression" ]
+        [ "replace the currently focused expression with a new expression" 
+        , "DOES NOT ensure that free variables in the replacement expression are in scope" ]
     , external "unsafe-replace" (promoteExprR . unsafeReplaceStashR :: String -> RewriteH Core)
         [ "replace the currently focused expression with an expression from the stash"
-        , "DOES NOT ensure expressions have the same type, or that free variables in the replacement expression are in scope" ]
+        , "DOES NOT ensure that free variables in the replacement expression are in scope" ]
     ]
 
 ------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/WorkerWrapper/Fix.hs b/src/HERMIT/Dictionary/WorkerWrapper/Fix.hs
--- a/src/HERMIT/Dictionary/WorkerWrapper/Fix.hs
+++ b/src/HERMIT/Dictionary/WorkerWrapper/Fix.hs
@@ -35,8 +35,6 @@
 
 import HERMIT.Dictionary.WorkerWrapper.Common
 
-import qualified Language.Haskell.TH as TH
-
 --------------------------------------------------------------------------------------------------
 
 -- | Externals for manipulating fixed points, and for the worker/wrapper transformation.
@@ -253,15 +251,12 @@
 -- | \\ wrap unwrap ->  (@prog = expr@  ==>  @prog = let f = \\ prog -> expr in let work = unwrap (f (wrap work)) in wrap work)@
 wwSplitR :: Maybe WWAssumption -> CoreExpr -> CoreExpr -> RewriteH CoreDef
 wwSplitR mAss wrap unwrap =
-  let work = TH.mkName "work"
-      fx   = TH.mkName "fix"
-   in
       fixIntroR
       >>> defAllR idR ( appAllR idR (letIntroR "f")
                         >>> letFloatArgR
                         >>> letAllR idR ( forwardT (wwFacBR mAss wrap unwrap)
-                                          >>> appAllR idR ( unfoldNameR fx
-                                                            >>> alphaLetWithR [work]
+                                          >>> appAllR idR ( unfoldNameR "fix"
+                                                            >>> alphaLetWithR ["work"]
                                                             >>> letRecAllR (\ _ -> defAllR idR (betaReduceR >>> letNonRecSubstR)
                                                                                    >>> extractR (wwGenerateFusionR mAss)
                                                                            )
@@ -453,6 +448,6 @@
 
 wrapUnwrapTypes :: MonadCatch m => CoreExpr -> CoreExpr -> m (Type,Type)
 wrapUnwrapTypes wrap unwrap = setFailMsg "given expressions have the wrong types to form a valid wrap/unwrap pair." $
-                              funsWithInverseTypes unwrap wrap
+                              funExprsWithInverseTypes unwrap wrap
 
 --------------------------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/WorkerWrapper/FixResult.hs b/src/HERMIT/Dictionary/WorkerWrapper/FixResult.hs
--- a/src/HERMIT/Dictionary/WorkerWrapper/FixResult.hs
+++ b/src/HERMIT/Dictionary/WorkerWrapper/FixResult.hs
@@ -38,8 +38,6 @@
 
 import HERMIT.Dictionary.WorkerWrapper.Common
 
-import qualified Language.Haskell.TH as TH
-
 --------------------------------------------------------------------------------------------------
 
 -- | Externals for manipulating fixed points, and for the worker/wrapper transformation.
@@ -284,15 +282,12 @@
 -- | \\ abs rep -> (@prog = expr@  ==>  @prog = let f = \\ prog -> expr in let work = \\ x1 -> rep (f (\\ x2 -> abs (work x2)) x1) in \\ x0 -> abs (work x0)@)
 wwResultSplitR :: Maybe WWAssumption -> CoreExpr -> CoreExpr -> RewriteH CoreDef
 wwResultSplitR mAss abs rep =
-  let work = TH.mkName "work"
-      fx   = TH.mkName "fix"
-   in
       fixIntroR
       >>> defAllR idR ( appAllR idR (letIntroR "f")
                         >>> letFloatArgR
                         >>> letAllR idR ( forwardT (wwResultFacBR mAss abs rep)
-                                          >>> lamAllR idR (appAllR idR (appAllR ( unfoldNameR fx
-                                                                                  >>> alphaLetWithR [work]
+                                          >>> lamAllR idR (appAllR idR (appAllR ( unfoldNameR "fix"
+                                                                                  >>> alphaLetWithR ["work"]
                                                                                   >>> letRecAllR (\ _ -> defAllR idR (betaReduceR >>> letNonRecSubstR)
                                                                                                          >>> extractR (wwResultGenerateFusionR mAss)
                                                                                                  )
@@ -467,7 +462,7 @@
 verifyAssB abs rep f assB =
   prefixFailMsg ("verification of worker/wrapper assumption B failed: ") $
   do (tyA,_) <- absRepTypes abs rep
-     tyXA     <- constT (endoFunType f)
+     tyXA     <- constT (endoFunExprType f)
      (tyX,tA) <- constT (splitFunTypeM tyXA)
      guardMsg (eqType tyA tA) "type of program body does not match types of abs/rep."
      h        <- constT (newIdH "h" tyXA)
@@ -484,7 +479,7 @@
 verifyAssC abs rep f assC =
   prefixFailMsg ("verification of worker/wrapper assumption C failed: ") $
   do (tyA,_)  <- absRepTypes abs rep
-     tyXA     <- constT (endoFunType f)
+     tyXA     <- constT (endoFunExprType f)
      (tyX,tA) <- constT (splitFunTypeM tyXA)
      guardMsg (eqType tyA tA) "type of program body does not match types of abs/rep."
      h        <- constT (newIdH "h" tyXA)
@@ -497,6 +492,6 @@
 
 absRepTypes :: MonadCatch m => CoreExpr -> CoreExpr -> m (Type,Type)
 absRepTypes abs rep = setFailMsg "given expressions have the wrong types to form a valid abs/rep pair." $
-                      funsWithInverseTypes rep abs
+                      funExprsWithInverseTypes rep abs
 
 --------------------------------------------------------------------------------------------------
diff --git a/src/HERMIT/External.hs b/src/HERMIT/External.hs
--- a/src/HERMIT/External.hs
+++ b/src/HERMIT/External.hs
@@ -13,6 +13,7 @@
        , externTypeArgResString
        , Dictionary
        , toDictionary
+       , addToDictionary
        , toHelp
        , external
        , Extern(..)
@@ -39,13 +40,11 @@
        , TranslateCoreTCCheckBox(..)
        , TranslateCorePathBox(..)
        , TranslateCoreTCPathBox(..)
-       , NameBox(..)
        , CoreString(..)
        , CoreBox(..)
        , CrumbBox(..)
        , PathBox(..)
        , StringBox(..)
-       , NameListBox(..)
        , StringListBox(..)
        , IntListBox(..)
        , RewriteCoreListBox(..)
@@ -56,8 +55,6 @@
 import Data.List
 import Data.Typeable.Internal (TypeRep(..), funTc)
 
-import qualified Language.Haskell.TH as TH
-
 import HERMIT.Core
 import HERMIT.Context (LocalPathH)
 import HERMIT.Kure
@@ -241,13 +238,14 @@
 
 -- | Build a 'Data.Map' from names to 'Dynamic' values.
 toDictionary :: [External] -> Dictionary
-toDictionary
-        -- TODO: check names are uniquely-prefixed
-              = fromListWith (++) . map toD
-  where
-         toD :: External -> (ExternalName,[Dynamic])
-         toD e = (externName e,[externDyn e])
+toDictionary = fromListWith (++) . map toEntry
 
+toEntry :: External -> (ExternalName, [Dynamic])
+toEntry e = (externName e, [externDyn e])
+
+addToDictionary :: External -> Dictionary -> Dictionary
+addToDictionary ex d = fromListWith (++) $ toEntry ex : toList d
+
 -- | Build a 'Data.Map' from names to help information.
 toHelp :: [External] -> Map ExternalName ExternalHelp
 toHelp = fromListWith (++) . map toH
@@ -266,9 +264,12 @@
 
 -- | Remove the word 'Box' from a string.
 deBoxify :: String -> String
-deBoxify xs | "Box" `isPrefixOf` xs = deBoxify (drop 3 xs)
-deBoxify (x:xs)                     = x : deBoxify xs
-deBoxify []                         = []
+deBoxify xs 
+    | "CLSBox -> " `isPrefixOf` xs = deBoxify (drop 10 xs)
+deBoxify xs 
+    | "Box" `isPrefixOf` xs        = deBoxify (drop 3 xs)
+deBoxify (x:xs)                    = x : deBoxify xs
+deBoxify []                        = []
 
 externTypeArgResString :: External -> ([String], String)
 externTypeArgResString e = (map (deBoxify . show) aTys, deBoxify (show rTy))
@@ -392,15 +393,6 @@
 
 -----------------------------------------------------------------
 
-data NameBox = NameBox (TH.Name) deriving Typeable
-
-instance Extern TH.Name where
-    type Box TH.Name = NameBox
-    box = NameBox
-    unbox (NameBox n) = n
-
------------------------------------------------------------------
-
 -- TODO: We now have CrumbBoc, PathBox and TranslateCorePathBox.
 --       Ints are interpreted as a TranslateCorePathBox.
 --       This all needs cleaning up.
@@ -458,15 +450,6 @@
     type Box String = StringBox
     box = StringBox
     unbox (StringBox s) = s
-
------------------------------------------------------------------
-
-data NameListBox = NameListBox [TH.Name] deriving Typeable
-
-instance Extern [TH.Name] where
-    type Box [TH.Name] = NameListBox
-    box = NameListBox
-    unbox (NameListBox l) = l
 
 -----------------------------------------------------------------
 
diff --git a/src/HERMIT/GHC.hs b/src/HERMIT/GHC.hs
--- a/src/HERMIT/GHC.hs
+++ b/src/HERMIT/GHC.hs
@@ -1,4 +1,8 @@
 {-# LANGUAGE CPP, InstanceSigs, TypeSynonymInstances, FlexibleInstances #-}
+#if __GLASGOW_HASKELL__ > 706
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+#endif
+-- Above shadowing disabled because the eqExprX function has lots of shadowing
 module HERMIT.GHC
     ( -- * GHC Imports
       -- | Things that have been copied from GHC, or imported directly, for various reasons.
@@ -7,16 +11,11 @@
     , zapVarOccInfo
     , var2String
     , thRdrNameGuesses
-    , name2THName
-    , var2THName
-    , cmpTHName2Name
     , cmpString2Name
-    , cmpTHName2Var
     , cmpString2Var
     , fqName
     , uqName
     , findNamesFromString
-    , findNamesFromTH
     , alphaTyVars
     , Type(..)
     , TyLit(..)
@@ -26,7 +25,6 @@
     , occurAnalyseExpr
     , isKind
     , isLiftedTypeKindCon
-    , exprType -- TODO: remove once we can use GHC's exprType again
 #if __GLASGOW_HASKELL__ > 706
     , coAxiomName
     , CoAxiom.BranchIndex
@@ -39,7 +37,13 @@
     , Pair(..)
     , bndrRuleAndUnfoldingVars
 #if __GLASGOW_HASKELL__ <= 706
+    , exprType 
     , Control.Monad.IO.Class.liftIO
+#else
+    , runDsMtoCoreM
+    , runTcMtoCoreM
+    , buildTypeable
+    , eqExprX
 #endif
     ) where
 
@@ -47,18 +51,15 @@
 -- GHC 7.6
 import qualified Control.Monad.IO.Class
 import qualified MonadUtils (MonadIO,liftIO)
-import GhcPlugins hiding (exprFreeVars, exprFreeIds, bindFreeVars, exprType, liftIO)
-#else
-#if __GLASGOW_HASKELL__ < 708
--- TODO: remove this case once 7.8 comes out, only here because
--- my HEAD installs are pre-8522 patch, and I don't want to rebuild
--- on four different machines just yet.
--- GHC 7.7.XXX
-import GhcPlugins hiding (exprFreeVars, exprFreeIds, bindFreeVars, exprType) -- we hide these so that they don't get inadvertently used.  See Core.hs
+import GhcPlugins hiding (exprFreeVars, exprFreeIds, bindFreeVars, exprType, liftIO, PluginPass)
+import TysPrim (alphaTy, alphaTyVars)
+import PprCore (pprCoreExpr)
+import Data.Monoid hiding ((<>))
 #else
 -- GHC 7.8
-import GhcPlugins hiding (exprFreeVars, exprFreeIds, bindFreeVars) -- we hide these so that they don't get inadvertently used.  See Core.hs
-#endif
+-- we hide these so that they don't get inadvertently used.  See Core.hs
+import GhcPlugins hiding (exprFreeVars, exprFreeIds, bindFreeVars, PluginPass) 
+import TysPrim (alphaTyVars)
 #endif
 
 -- hacky direct GHC imports
@@ -68,23 +69,32 @@
 import OccurAnal (occurAnalyseExpr)
 import Pair (Pair(..))
 import Panic (GhcException(ProgramError), throwGhcException)
-import PprCore (pprCoreExpr)
 import TypeRep (Type(..),TyLit(..))
-import TysPrim (alphaTy, alphaTyVars)
 
 #if __GLASGOW_HASKELL__ <= 706
 import Data.Maybe (isJust)
 #else
+import qualified Bag
 import qualified CoAxiom -- for coAxiomName
+import DsBinds (dsEvBinds)
+import DsMonad (DsM, initDsTc)
+import PrelNames (typeableClassName)
+import TcEnv (tcLookupClass)
+import TcMType (newWantedEvVar)
+import TcRnMonad (getCtLoc)
+import TcRnTypes (TcM, mkNonCanonical, mkFlatWC, CtEvidence(..), SkolemInfo(..), CtOrigin(..))
+import TcSimplify (solveWantedsTcM)
+
+import HERMIT.GHC.Typechecker
 #endif
+
 import Data.List (intercalate)
-import Data.Monoid hiding ((<>))
-import qualified Language.Haskell.TH as TH
 
 --------------------------------------------------------------------------
 
-#if __GLASGOW_HASKELL < 708
--- Note: once 7.8 comes out, change condition above to "<= 706"
+#if __GLASGOW_HASKELL__ <= 706
+-- Note: prior to 7.8, the Let case was buggy for type 
+-- bindings, so we provide a fixed definition here.
 exprType :: CoreExpr -> Type
 -- ^ Recover the type of a well-typed Core expression. Fails when
 -- applied to the actual 'CoreSyn.Type' expression as it cannot
@@ -134,10 +144,6 @@
 -- getName :: NamedThing a => a -> Name
 -- getOccString :: NamedThing a => a -> String
 
--- TH.nameBase :: TH.Name -> String
--- showName :: TH.Name -> String
--- TH.mkName :: String -> TH.Name
-
 -- | Get the unqualified name from a 'NamedThing'.
 uqName :: NamedThing nm => nm -> String
 uqName = getOccString
@@ -151,47 +157,27 @@
 var2String :: Var -> String
 var2String = uqName . varName
 
--- | Converts a GHC 'Name' to a Template Haskell 'TH.Name', going via a 'String'.
-name2THName :: Name -> TH.Name
-name2THName = TH.mkName . uqName
-
--- | Converts an 'Var' to a Template Haskell 'TH.Name', going via a 'String'.
-var2THName :: Var -> TH.Name
-var2THName = name2THName . varName
-
 -- | Compare a 'String' to a 'Name' for equality.
 -- Strings containing a period are assumed to be fully qualified names.
+-- (Except for ".", which is an unqualified reference to composition.)
 cmpString2Name :: String -> Name -> Bool
 cmpString2Name str nm | isQualified str = str == fqName nm
                       | otherwise       = str == uqName nm
 
 isQualified :: String -> Bool
 isQualified [] = False
-isQualified xs = '.' `elem` init xs -- pathological case is compose
+isQualified xs = '.' `elem` init xs -- pathological case is compose (hence the 'init')
 
 -- | Compare a 'String' to a 'Var' for equality. See 'cmpString2Name'.
 cmpString2Var :: String -> Var -> Bool
 cmpString2Var str = cmpString2Name str . varName
 
--- | Compare a 'TH.Name' to a 'Name' for equality. See 'cmpString2Name'.
-cmpTHName2Name :: TH.Name -> Name -> Bool
-cmpTHName2Name th_nm = cmpString2Name (show th_nm)
-
--- | Compare a 'TH.Name' to a 'Var' for equality. See 'cmpString2Name'.
-cmpTHName2Var :: TH.Name -> Var -> Bool
-cmpTHName2Var nm = cmpTHName2Name nm . varName
-
 -- | Find 'Name's matching a given fully qualified or unqualified name.
--- If given name is fully qualified, will only return first result, which is assumed unique.
 findNamesFromString :: GlobalRdrEnv -> String -> [Name]
-findNamesFromString rdrEnv str | isQualified str = take 1 res
+findNamesFromString rdrEnv str | isQualified str = res
                                | otherwise       = res
     where res = [ nm | elt <- globalRdrEnvElts rdrEnv, let nm = gre_name elt, cmpString2Name str nm ]
 
--- | Find 'Name's matching a 'TH.Name'. See 'findNamesFromString'.
-findNamesFromTH :: GlobalRdrEnv -> TH.Name -> [Name]
-findNamesFromTH rdrEnv = findNamesFromString rdrEnv . show
-
 -- | Pretty-print an identifier.
 ppIdInfo :: Id -> IdInfo -> SDoc
 ppIdInfo v info
@@ -248,6 +234,7 @@
 notElemVarSet :: Var -> VarSet -> Bool
 notElemVarSet v vs = not (v `elemVarSet` vs)
 
+#if __GLASGOW_HASKELL__ <= 706
 instance Monoid VarSet where
   mempty :: VarSet
   mempty = emptyVarSet
@@ -257,7 +244,6 @@
 
 --------------------------------------------------------------------------
 
-#if __GLASGOW_HASKELL__ <= 706
 instance Control.Monad.IO.Class.MonadIO CoreM where
   liftIO :: IO a -> CoreM a
   liftIO = MonadUtils.liftIO
@@ -271,3 +257,103 @@
 bndrRuleAndUnfoldingVars :: Var -> VarSet
 bndrRuleAndUnfoldingVars v | isTyVar v = emptyVarSet
                            | otherwise = idRuleAndUnfoldingVars v
+
+--------------------------------------------------------------------------
+
+#if __GLASGOW_HASKELL__ > 706
+runTcMtoCoreM :: ModGuts -> TcM a -> CoreM a
+runTcMtoCoreM guts m = do
+    env <- getHscEnv
+    -- What is the effect of HsSrcFile (should we be using something else?)
+    -- What should the boolean flag be set to?
+    (msgs, mr) <- liftIO $ initTcFromModGuts env guts HsSrcFile False (mg_module guts) m
+    -- There is probably something better for reporting the errors.
+    let dumpSDocs endMsg = Bag.foldBag (\ d r -> d ++ ('\n':r)) show endMsg
+        showMsgs (warns, errs) = "Errors:\n" ++ dumpSDocs ("Warnings:\n" ++ dumpSDocs "" warns) errs
+    maybe (fail $ showMsgs msgs) return mr
+
+runDsMtoCoreM :: ModGuts -> DsM a -> CoreM a
+runDsMtoCoreM guts = runTcMtoCoreM guts . initDsTc
+
+-- TODO: 
+buildTypeable :: ModGuts -> Type -> CoreM (Id, [CoreBind])
+buildTypeable guts ty = do
+    (i, bs) <- runTcMtoCoreM guts $ do
+        cls <- tcLookupClass typeableClassName
+        let predTy = mkClassPred cls [typeKind ty, ty] -- recall that Typeable is now poly-kinded
+        loc <- getCtLoc $ GivenOrigin UnkSkol
+        evar <- newWantedEvVar predTy
+        let nonC = mkNonCanonical $ CtWanted { ctev_pred = predTy, ctev_evar = evar, ctev_loc = loc }
+            wCs = mkFlatWC [nonC]
+        (_wCs', bnds) <- solveWantedsTcM wCs
+        -- TODO: check for unsolved constraints?
+        return (evar, bnds)
+    bnds <- runDsMtoCoreM guts $ dsEvBinds bs
+    return (i,bnds)
+
+-- This function used to be in GHC itself, but was removed.
+-- It compares core for equality modulo alpha.
+eqExprX :: IdUnfoldingFun -> RnEnv2 -> CoreExpr -> CoreExpr -> Bool
+eqExprX id_unfolding_fun env e1 e2
+  = go env e1 e2
+  where
+    go env (Var v1) (Var v2)
+      | rnOccL env v1 == rnOccR env v2
+      = True
+
+    -- The next two rules expand non-local variables
+    -- C.f. Note [Expanding variables] in Rules.lhs
+    -- and  Note [Do not expand locally-bound variables] in Rules.lhs
+    go env (Var v1) e2
+      | not (locallyBoundL env v1)
+      , Just e1' <- expandUnfolding_maybe (id_unfolding_fun (lookupRnInScope env v1))
+      = go (nukeRnEnvL env) e1' e2
+
+    go env e1 (Var v2)
+      | not (locallyBoundR env v2)
+      , Just e2' <- expandUnfolding_maybe (id_unfolding_fun (lookupRnInScope env v2))
+      = go (nukeRnEnvR env) e1 e2'
+
+    go _   (Lit lit1)    (Lit lit2)      = lit1 == lit2
+    go env (Type t1)    (Type t2)        = eqTypeX env t1 t2
+    go env (Coercion co1) (Coercion co2) = coreEqCoercion2 env co1 co2
+    go env (Cast e1 co1) (Cast e2 co2) = coreEqCoercion2 env co1 co2 && go env e1 e2
+    go env (App f1 a1)   (App f2 a2)   = go env f1 f2 && go env a1 a2
+    go env (Tick n1 e1)  (Tick n2 e2)  = go_tickish n1 n2 && go env e1 e2
+
+    go env (Lam b1 e1)  (Lam b2 e2)
+      =  eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination
+      && go (rnBndr2 env b1 b2) e1 e2
+
+    go env (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)
+      =  go env r1 r2  -- No need to check binder types, since RHSs match
+      && go (rnBndr2 env v1 v2) e1 e2
+
+    go env (Let (Rec ps1) e1) (Let (Rec ps2) e2)
+      = all2 (go env') rs1 rs2 && go env' e1 e2
+      where
+        (bs1,rs1) = unzip ps1
+        (bs2,rs2) = unzip ps2
+        env' = rnBndrs2 env bs1 bs2
+
+    go env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
+      | null a1   -- See Note [Empty case alternatives] in TrieMap
+      = null a2 && go env e1 e2 && eqTypeX env t1 t2
+      | otherwise
+      =  go env e1 e2 && all2 (go_alt (rnBndr2 env b1 b2)) a1 a2
+
+    go _ _ _ = False
+
+    -----------
+    go_alt env (c1, bs1, e1) (c2, bs2, e2)
+      = c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2
+
+    -----------
+    go_tickish (Breakpoint lid lids) (Breakpoint rid rids)
+      = lid == rid  &&  map (rnOccL env) lids == map (rnOccR env) rids
+    go_tickish l r = l == r
+
+locallyBoundL, locallyBoundR :: RnEnv2 -> Var -> Bool
+locallyBoundL rn_env v = inRnEnvL rn_env v
+locallyBoundR rn_env v = inRnEnvR rn_env v
+#endif
diff --git a/src/HERMIT/GHC/Typechecker.hs b/src/HERMIT/GHC/Typechecker.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/GHC/Typechecker.hs
@@ -0,0 +1,182 @@
+{-# LANGUAGE CPP, RankNTypes #-}
+module HERMIT.GHC.Typechecker 
+    ( 
+#if __GLASGOW_HASKELL__ > 706
+      initTcFromModGuts
+    , mk_type_env
+#endif
+    ) where
+
+#if __GLASGOW_HASKELL__ > 706
+
+import Annotations (emptyAnnEnv)
+import HsSyn
+import RdrName
+import TcRnMonad
+import CoreSyn
+import ErrUtils
+import VarEnv
+import Module
+import Name
+import NameEnv
+import NameSet
+import SrcLoc
+import HscTypes
+import Outputable
+import Data.IORef ( newIORef, readIORef )
+
+import TcType   ( noUntouchables )
+
+import FastString
+import Bag
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+
+import Prelude hiding (mod)
+import VarSet (emptyVarSet)
+
+-- Note: the contents of this module should eventually be folded into GHC proper.
+
+-- | Re-Setup the typechecking environment from a ModGuts
+initTcFromModGuts
+    :: HscEnv
+    -> ModGuts
+    -> HscSource
+    -> Bool          -- True <=> retain renamed syntax trees
+    -> Module
+    -> TcM r
+    -> IO (Messages, Maybe r) -- Nothing => error thrown by the thing inside
+                              -- (error messages should have been printed already)
+initTcFromModGuts hsc_env guts hsc_src keep_rn_syntax mod do_this
+ = do { let { type_env = mk_type_env guts } ;
+        errs_var     <- newIORef (emptyBag, emptyBag) ;
+        tvs_var      <- newIORef emptyVarSet ;
+        keep_var     <- newIORef emptyNameSet ;
+        used_rdr_var <- newIORef Set.empty ;
+        th_var       <- newIORef False ;
+        th_splice_var<- newIORef False ;
+        infer_var    <- newIORef True ;
+        lie_var      <- newIORef emptyWC ;
+        dfun_n_var   <- newIORef (mk_dfun_n guts) ;
+        type_env_var <- newIORef type_env ;
+
+        dependent_files_var <- newIORef [] ;
+
+        th_topdecls_var      <- newIORef [] ;
+        th_topnames_var      <- newIORef emptyNameSet ;
+        th_modfinalizers_var <- newIORef [] ;
+        th_state_var         <- newIORef Map.empty ;
+
+        let {
+             maybe_rn_syntax :: forall a. a -> Maybe a ;
+             maybe_rn_syntax empty_val
+                | keep_rn_syntax = Just empty_val
+                | otherwise      = Nothing ;
+
+             gbl_env = TcGblEnv {
+                -- these first four are CPP'd in GHC itself, but we include them here
+                tcg_th_topdecls      = th_topdecls_var,
+                tcg_th_topnames      = th_topnames_var,
+                tcg_th_modfinalizers = th_modfinalizers_var,
+                tcg_th_state         = th_state_var,
+
+                -- queried during tcrnif
+                tcg_mod            = mod,
+                tcg_src            = hsc_src,
+                tcg_rdr_env        = mg_rdr_env guts,
+                tcg_default        = Nothing,
+                tcg_fix_env        = mg_fix_env guts,
+                tcg_field_env      = mk_field_env guts,
+                tcg_type_env       = type_env,
+                tcg_type_env_var   = type_env_var,
+                tcg_inst_env       = mg_inst_env guts,
+                tcg_fam_inst_env   = mg_fam_inst_env guts,
+                tcg_ann_env        = emptyAnnEnv,
+                tcg_dfun_n         = dfun_n_var,
+
+                -- accumulated, not queried, during tcrnif
+                tcg_dependent_files = dependent_files_var,
+                tcg_exports        = [],
+                tcg_warns          = NoWarnings,
+                tcg_anns           = [],
+                tcg_tcs            = [],
+                tcg_insts          = [],
+                tcg_fam_insts      = [],
+                tcg_rules          = [],
+                tcg_th_used        = th_var,
+                tcg_imports        = emptyImportAvails,
+                tcg_dus            = emptyDUs,
+                tcg_ev_binds       = emptyBag,
+                tcg_fords          = [],
+                tcg_vects          = [],
+                tcg_patsyns        = [],
+                tcg_doc_hdr        = Nothing,
+                tcg_hpc            = False,
+                tcg_main           = Nothing,
+                tcg_safeInfer      = infer_var,
+                tcg_binds          = emptyLHsBinds,
+                tcg_sigs           = emptyNameSet,
+                tcg_imp_specs      = [],
+                tcg_rn_decls       = maybe_rn_syntax emptyRnGroup,
+                tcg_used_rdrnames  = used_rdr_var,
+                tcg_rn_imports     = [],
+                tcg_rn_exports     = maybe_rn_syntax [],
+                tcg_keep           = keep_var,
+                tcg_th_splice_used = th_splice_var
+             } ;
+             lcl_env = TcLclEnv {
+                tcl_errs       = errs_var,
+                tcl_loc        = mkGeneralSrcSpan (fsLit "Top level"),
+                tcl_ctxt       = [],
+                tcl_rdr        = emptyLocalRdrEnv,
+                tcl_th_ctxt    = topStage,
+                tcl_th_bndrs   = emptyNameEnv,
+                tcl_arrow_ctxt = NoArrowCtxt,
+                tcl_env        = emptyNameEnv,
+                tcl_bndrs      = [],
+                tcl_tidy       = emptyTidyEnv,
+                tcl_tyvars     = tvs_var,
+                tcl_lie        = lie_var,
+                tcl_untch      = noUntouchables
+             } ;
+        } ;
+
+        -- OK, here's the business end!
+        maybe_res <- initTcRnIf 'a' hsc_env gbl_env lcl_env $
+                     do { r <- tryM do_this
+                        ; case r of
+                          Right res -> return (Just res)
+                          Left _    -> return Nothing } ;
+
+        -- Check for unsolved constraints
+        lie <- readIORef lie_var ;
+        if isEmptyWC lie
+           then return ()
+           else pprPanic "initTc: unsolved constraints"
+                         (pprWantedsWithLocs lie) ;
+
+        -- Collect any error messages
+        msgs <- readIORef errs_var ;
+
+        let { dflags = hsc_dflags hsc_env
+            ; final_res | errorsFound dflags msgs = Nothing
+                        | otherwise               = maybe_res } ;
+
+        return (msgs, final_res)
+    }
+
+mk_type_env :: ModGuts -> TypeEnv
+-- copied from GHC.compileCore
+mk_type_env guts = typeEnvFromEntities (bindersOfBinds (mg_binds guts))
+                                           (mg_tcs guts)
+                                           (mg_fam_insts guts)
+mk_field_env :: ModGuts -> RecFieldEnv
+-- TODO
+mk_field_env _ = RecFields emptyNameEnv emptyNameSet
+
+mk_dfun_n :: ModGuts -> OccSet
+-- TODO
+mk_dfun_n _ = emptyOccSet
+
+#endif
diff --git a/src/HERMIT/Interp.hs b/src/HERMIT/Interp.hs
deleted file mode 100644
--- a/src/HERMIT/Interp.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# LANGUAGE KindSignatures, GADTs, InstanceSigs #-}
-
-module HERMIT.Interp
-        ( -- * The HERMIT Interpreter
-          Interp
-        , interp
-        , interpExprH
-        ) where
-
-import Control.Monad (liftM, liftM2)
-
-import Data.Char
-import Data.Dynamic
-import qualified Data.Map as M
-
-import qualified Language.Haskell.TH as TH
-
-import HERMIT.External
-import HERMIT.Parser
-import HERMIT.Kure (deprecatedIntToPathT,pathToSnocPath)
-
--- | Interpret an 'ExprH' by looking up the appropriate 'Dynamic'(s) in the provided 'Dictionary', then interpreting the 'Dynamic'(s) with the provided 'Interp's, returning the first interpretation to succeed (or an error string if none succeed).
-interpExprH :: Monad m => Dictionary -> [Interp a] -> ExprH -> m a
-interpExprH dict interps e = do dyns <- interpExpr dict e
-                                runInterp dyns interps
-
-runInterp :: Monad m => [Dynamic] -> [Interp b] -> m b
-runInterp dyns interps = case [f a | Interp f <- interps, Just a <- map fromDynamic dyns] of
-                           []  -> fail "User error, HERMIT command does not type-check."
-                           b:_ -> return b
-
--- | An 'Interp' @a@ is a /possible/ means of converting a 'Typeable' value to a value of type @a@.
-data Interp :: * -> * where
-   Interp :: Typeable a => (a -> b) -> Interp b
-
--- | The primitive way of building an 'Interp'.
-interp :: Typeable a => (a -> b) -> Interp b
-interp = Interp
-
-instance Functor Interp where
-  fmap :: (a -> b) -> Interp a -> Interp b
-  fmap f (Interp g) = Interp (f . g)
-
-
-interpExpr :: Monad m => Dictionary -> ExprH -> m [Dynamic]
-interpExpr = interpExpr' False
-
--- input: list length n, each elem is a variable length list of possible interpretations
--- output: variable length list, each elem is list of length n
-fromDynList :: [[Dynamic]] -> [[Dynamic]]
-fromDynList [] = [[]]
-fromDynList (hs:dynss) = [ h:t | h <- hs, t <- fromDynList dynss ]
-
-toBoxedList :: (Extern a, Typeable b) => [[Dynamic]] -> ([a] -> b) -> [Dynamic]
-toBoxedList dyns boxCon = [ toDyn $ boxCon (map unbox l) | dl <- dyns, Just l <- [mapM fromDynamic dl] ]
-
-interpExpr' :: Monad m => Bool -> Dictionary -> ExprH -> m [Dynamic]
-interpExpr' _   _    (SrcName str) = return [ toDyn $ NameBox $ TH.mkName str ]
-interpExpr' _   _    (CoreH str)   = return [ toDyn $ CoreBox (CoreString str) ]
-interpExpr' _   dict (ListH exprs) = do dyns <- liftM fromDynList $ mapM (interpExpr' True dict) exprs
-                                        return $    toBoxedList dyns NameListBox
-                                                 ++ toBoxedList dyns StringListBox
-                                                 ++ toBoxedList dyns (PathBox . pathToSnocPath)
-                                                 ++ toBoxedList dyns (TranslateCorePathBox . return . pathToSnocPath) -- ugly hack.  The whole dynamic stuff could do with overhauling.
-                                                 ++ toBoxedList dyns IntListBox
-                                                 ++ toBoxedList dyns RewriteCoreListBox
-interpExpr' rhs dict (CmdName str)
-                                        -- An Int is either a Path, or will be interpreted specially later.
-  | all isDigit str                     = let i = read str in
-                                          return [ toDyn $ IntBox i
-                                                 , toDyn $ TranslateCorePathBox (deprecatedIntToPathT i) -- TODO: Find a better long-term solution.
-                                                 ]
-  | Just dyn <- M.lookup str dict       = return $ if rhs
-                                                     then toDyn (StringBox str) : dyn
-                                                     else dyn
-  -- not a command, try as a string arg... worst case: dynApply fails with "bad type of expression"
-  -- best case: 'help ls' works instead of 'help "ls"'. this is likewise done in the clause above
-  | rhs                                 = return [toDyn $ StringBox str]
-  | otherwise                           = fail $ "User error, unrecognised HERMIT command: " ++ show str
-interpExpr' _ env (AppH e1 e2)          = dynAppMsg (interpExpr' False env e1) (interpExpr' True env e2)
-
-dynAppMsg :: Monad m => m [Dynamic] -> m [Dynamic] -> m [Dynamic]
-dynAppMsg = liftM2 dynApply'
-   where
-           dynApply' :: [Dynamic] -> [Dynamic] -> [Dynamic]
-           dynApply' fs xs = [ r | f <- fs, x <- xs, Just r <- return (dynApply f x)]
-
--------------------------------------------
diff --git a/src/HERMIT/Kure.hs b/src/HERMIT/Kure.hs
--- a/src/HERMIT/Kure.hs
+++ b/src/HERMIT/Kure.hs
@@ -53,6 +53,8 @@
        , consRecT, consRecAllR, consRecAnyR, consRecOneR
        , consRecDefT, consRecDefAllR, consRecDefAnyR, consRecDefOneR
        , caseAltT, caseAltAllR, caseAltAnyR, caseAltOneR
+       -- ** Recursive Composite Congruence Combinators
+       , progBindsT, progBindsAllR, progBindsAnyR, progBindsOneR
        -- ** Types
        , tyVarT, tyVarR
        , litTyT, litTyR
@@ -547,7 +549,7 @@
          Case e w ty alts -> f <$> apply te (c @@ Case_Scrutinee) e
                                <*> apply tw (c @@ Case_Binder) w
                                <*> apply tty (c @@ Case_Type) ty
-                               <*> sequence [ apply (talts n) (addCaseWildBinding (w,e,alt) c @@ Case_Alt n) alt
+                               <*> sequence [ apply (talts n) (addCaseBinderBinding (w,e,alt) c @@ Case_Alt n) alt
                                             | (alt,n) <- zip alts [0..]
                                             ]
          _                -> fail "not a case."
@@ -868,6 +870,33 @@
             -> Rewrite c m CoreExpr
 caseAltOneR rsc rw rty ralts = caseOneR rsc rw rty (\ n -> let (rcon,rvs,re) = ralts n in altOneR rcon rvs re)
 {-# INLINE caseAltOneR #-}
+
+---------------------------------------------------------------------
+
+-- Recursive composite congruence combinators.
+
+-- | Translate all top-level binding groups in a program.
+progBindsT :: forall c m a b. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => (Int -> Translate c m CoreBind a) -> ([a] -> b) -> Translate c m CoreProg b
+progBindsT ts f = f <$> progBindsTaux 0
+  where
+    progBindsTaux :: Int -> Translate c m CoreProg [a]
+    progBindsTaux n = progNilT [] <+ progConsT (ts n) (progBindsTaux (succ n)) (:)
+{-# INLINE progBindsT #-}
+
+-- | Rewrite all top-level binding groups in a program.
+progBindsAllR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => (Int -> Rewrite c m CoreBind) -> Rewrite c m CoreProg
+progBindsAllR rs = progBindsT rs bindsToProg
+{-# INLINE progBindsAllR #-}
+
+-- | Rewrite any top-level binding groups in a program.
+progBindsAnyR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => (Int -> Rewrite c m CoreBind) -> Rewrite c m CoreProg
+progBindsAnyR rs = unwrapAnyR $ progBindsAllR (wrapAnyR . rs)
+{-# INLINE progBindsAnyR #-}
+
+-- | Rewrite any top-level binding groups in a program.
+progBindsOneR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, MonadCatch m) => (Int -> Rewrite c m CoreBind) -> Rewrite c m CoreProg
+progBindsOneR rs = unwrapOneR $ progBindsAllR (wrapOneR . rs)
+{-# INLINE progBindsOneR #-}
 
 ---------------------------------------------------------------------
 ---------------------------------------------------------------------
diff --git a/src/HERMIT/Optimize.hs b/src/HERMIT/Optimize.hs
deleted file mode 100644
--- a/src/HERMIT/Optimize.hs
+++ /dev/null
@@ -1,234 +0,0 @@
-{-# LANGUAGE KindSignatures, GADTs, FlexibleContexts, GeneralizedNewtypeDeriving, LambdaCase #-}
-module HERMIT.Optimize
-    ( -- * The HERMIT Plugin
-      optimize
-      -- ** Running translations
-    , query
-    , run
-      -- ** Using the shell
-    , interactive
-    , display
-    , setPretty
-    , setPrettyOptions
-      -- ** Active modifiers
-    , at
-    , phase
-    , after
-    , before
-    , until
-    , allPhases
-    , firstPhase
-    , lastPhase
-      -- ** Knobs and Dials
-    , getPhaseInfo
-    , modifyCLS
-      -- ** Types
-    , OM
-    , omToIO
-    ) where
-
-import Control.Applicative
-import Control.Arrow
-import Control.Concurrent.STM
-import Control.Monad.Error hiding (guard)
-import Control.Monad.Operational
-import Control.Monad.State hiding (guard)
-import Control.Monad.Reader hiding (guard)
-
-import Data.Default
-import Data.Monoid
-import qualified Data.Map as M
-
-import HERMIT.Dictionary
-import HERMIT.External hiding (Query, Shell)
-import HERMIT.Kernel.Scoped
-import HERMIT.Context
-import HERMIT.Kure
-import HERMIT.GHC hiding (singleton, liftIO, display, (<>))
-import qualified HERMIT.GHC as GHC
-import HERMIT.Monad
-import HERMIT.Plugin
-import HERMIT.PrettyPrinter.Common
-import qualified HERMIT.PrettyPrinter.Clean as Clean
-import HERMIT.Shell.Command
-import HERMIT.Shell.Types
-
-import Prelude hiding (until)
-
-import System.Console.Haskeline (defaultBehavior)
-
-data OInst :: * -> * where
-    Shell    :: [External] -> [CommandLineOption] -> OInst ()
-    Guard    :: (PhaseInfo -> Bool) -> OM ()      -> OInst ()
-    Focus    :: (Injection ModGuts g, Walker HermitC g) => TranslateH g LocalPathH -> OM a -> OInst a
-    RR       :: (Injection ModGuts g, Walker HermitC g) => RewriteH g                      -> OInst ()
-    Query    :: (Injection ModGuts g, Walker HermitC g) => TranslateH g a                  -> OInst a
-
-newtype OM a = OM (ProgramT OInst (ReaderT PhaseInfo (CLM IO)) a)
-    deriving (Functor, Applicative, Monad, MonadIO)
-
-optimize :: ([CommandLineOption] -> OM ()) -> Plugin
-optimize f = hermitPlugin $ \ phaseInfo -> runOM phaseInfo . f
-
-runOM :: PhaseInfo -> OM () -> ModGuts -> CoreM ModGuts
-runOM phaseInfo opt = scopedKernel $ \ kernel initSAST -> do
-    tick <- liftIO $ atomically $ newTVar M.empty
-    let initState = CommandLineState
-                       { cl_cursor         = initSAST
-                       , cl_pretty         = Clean.ppCoreTC
-                       , cl_pretty_opts    = def { po_width = 80 }
-                       , cl_render         = unicodeConsole
-                       , cl_height         = 30
-                       , cl_nav            = False
-                       , cl_running_script = False
-                       , cl_tick          = tick
-                       , cl_corelint      = False
-                       , cl_diffonly      = False
-                       , cl_failhard      = False
-                       , cl_window        = mempty
-                       , cl_dict          = error "cl_dict" -- TODO
-                       , cl_scripts       = []
-                       , cl_kernel        = kernel
-                       , cl_initSAST      = initSAST
-                       , cl_version       = VersionStore
-                                              { vs_graph = []
-                                              , vs_tags  = []
-                                              }
-                       }
-
-    (r,st) <- omToIO initState phaseInfo opt
-    either (\case CLAbort         -> abortS kernel
-                  CLResume   sast -> resumeS kernel sast
-                  CLContinue _    -> putStrLn "Uncaught CLContinue! Aborting..." >> abortS kernel
-                  CLError    err  -> putStrLn err >> abortS kernel)
-           (\ _ -> resumeS kernel $ cl_cursor st) r
-
--- TODO - better name!
-omToIO :: CommandLineState -> PhaseInfo -> OM a -> IO (Either CLException a, CommandLineState)
-omToIO initState phaseInfo (OM opt) = runCLM initState (runReaderT (eval opt) phaseInfo)
-
-eval :: ProgramT OInst (ReaderT PhaseInfo (CLM IO)) a -> ReaderT PhaseInfo (CLM IO) a
-eval comp = do
-    (kernel, env) <- gets $ cl_kernel &&& cl_kernel_env
-    v <- viewT comp
-    case v of
-        Return x            -> return x
-        RR rr       :>>= k  -> lift (runS (applyS kernel rr env)) >>= eval . k
-        Query tr    :>>= k  -> lift (runK (queryS kernel tr env)) >>= eval . k
-        Shell es os :>>= k -> do
-            lift $ do
-                -- We want to discard the current focus, open the shell at
-                -- the top level, then restore the current focus.
-                paths <- resetScoping env
-                catchContinue (commandLine os defaultBehavior es)
-                _ <- resetScoping env
-                restoreScoping env paths
-            eval $ k ()
-        Guard p (OM m)  :>>= k  -> ask >>= \ phaseInfo -> when (p phaseInfo) (eval m) >>= eval . k
-        Focus tp (OM m) :>>= k  -> do
-            lift $ do
-                sast <- gets cl_cursor
-                p <- queryS kernel tp env sast    -- run the pathfinding translation
-                runS $ beginScopeS kernel         -- remember the current path
-                runS $ modPathS kernel (<> p) env -- modify the current path
-            r <- eval m             -- run the focused computation
-            lift $ runS $ endScopeS kernel           -- endscope on it, so we go back to where we started
-            eval $ k r
-
-------------------------- Shell-related helpers --------------------------------------
-
-catchContinue :: Monad m => CLM m () -> CLM m ()
-catchContinue m = catchError m (\case CLContinue st -> put st
-                                      other -> throwError other)
-
-resetScoping :: HermitMEnv -> CLM IO [PathH]
-resetScoping env = do
-    kernel <- gets cl_kernel
-    paths <- runK $ pathS kernel
-    replicateM_ (length paths - 1) $ runS $ endScopeS kernel
-    -- modPathS commonly fails here because the path is unchanged, so throw away failures
-    catchM (runS $ modPathS kernel (const mempty) env) (const (return ()))
-    return paths
-
-restoreScoping :: HermitMEnv -> [PathH] -> CLM IO ()
-restoreScoping _   []    = return ()
-restoreScoping env (h:t) = do
-    kernel <- gets cl_kernel
-
-    let go p []      = restore p
-        go p (p':ps) = restore p >> runS (beginScopeS kernel) >> go p' ps
-
-        -- modPathS commonly fails here because the path is unchanged, so throw away failures
-        restore p = catchM (runS $ modPathS kernel (<> pathToSnocPath p) env)
-                           (const (return ()))
-
-    go h t
-
--- | Run a kernel function on the current SAST
-runK :: (SAST -> CLM IO a) -> CLM IO a
-runK f = gets cl_cursor >>= f
-
--- | Run a kernel function on the current SAST and update cl_cursor
-runS :: (SAST -> CLM IO SAST) -> CLM IO ()
-runS f = do
-    sast <- runK f
-    modify $ \st -> st { cl_cursor = sast }
-
-interactive :: [External] -> [CommandLineOption] -> OM ()
-interactive es os = OM . singleton $ Shell (externals ++ es) os
-
-run :: RewriteH CoreTC -> OM ()
-run = OM . singleton . RR
-
-query :: (Injection GHC.ModGuts g, Walker HermitC g) => TranslateH g a -> OM a
-query = OM . singleton . Query
-
------------------------------ guards ------------------------------
-
-guard :: (PhaseInfo -> Bool) -> OM () -> OM ()
-guard p = OM . singleton . Guard p
-
-at :: TranslateH CoreTC LocalPathH -> OM a -> OM a
-at tp = OM . singleton . Focus tp
-
-phase :: Int -> OM () -> OM ()
-phase n = guard ((n ==) . phaseNum)
-
-after :: CorePass -> OM () -> OM ()
-after cp = guard (\phaseInfo -> case phasesDone phaseInfo of
-                            [] -> False
-                            xs -> last xs == cp)
-
-before :: CorePass -> OM () -> OM ()
-before cp = guard (\phaseInfo -> case phasesLeft phaseInfo of
-                            (x:_) | cp == x -> True
-                            _               -> False)
-
-until :: CorePass -> OM () -> OM ()
-until cp = guard ((cp `elem`) . phasesLeft)
-
-allPhases :: OM () -> OM ()
-allPhases = guard (const True)
-
-firstPhase :: OM () -> OM ()
-firstPhase = guard (null . phasesDone)
-
-lastPhase :: OM () -> OM ()
-lastPhase = guard (null . phasesLeft)
-
------------------------------ other ------------------------------
-
-getPhaseInfo :: OM PhaseInfo
-getPhaseInfo = OM $ lift ask
-
-display :: OM ()
-display = OM $ lift $ lift $ performQuery Display
-
-modifyCLS :: (CommandLineState -> CommandLineState) -> OM ()
-modifyCLS = OM . modify
-
-setPretty :: PrettyH CoreTC -> OM ()
-setPretty pp = modifyCLS $ \s -> s { cl_pretty = pp }
-
-setPrettyOptions :: PrettyOptions -> OM ()
-setPrettyOptions po = modifyCLS $ \s -> s { cl_pretty_opts = po }
diff --git a/src/HERMIT/ParserCore.y b/src/HERMIT/ParserCore.y
--- a/src/HERMIT/ParserCore.y
+++ b/src/HERMIT/ParserCore.y
@@ -1,6 +1,6 @@
 {
 {-# LANGUAGE CPP #-}
- module HERMIT.ParserCore (parseCore, parseCoreExprT, parse2beforeBiR, parse3beforeBiR) where
+ module HERMIT.ParserCore (parseCore, parseCoreExprT, parse2beforeBiR, parse3beforeBiR, parse4beforeBiR, parse5beforeBiR) where
 
 import Control.Arrow
 import Control.Monad.Reader
@@ -16,8 +16,6 @@
 import HERMIT.Dictionary.Common
 
 import Language.KURE.MonadCatch (prefixFailMsg)
-
-import Language.Haskell.TH as TH
 }
 
 %name parser
@@ -93,7 +91,7 @@
 lookupName :: String -> (Id -> CoreExpr) -> CoreParseM CoreExpr
 lookupName nm k = do
     c <- ask
-    v <- lift $ prefixFailMsg (nm ++ " lookup: ") $ findId (TH.mkName nm) c
+    v <- lift $ prefixFailMsg (nm ++ " lookup: ") $ findId nm c
     return (k v)
 
 type CoreParseM a = ReaderT HermitC HermitM a
@@ -169,17 +167,27 @@
 
 ---------------------------------------------
 
--- These three should probably go somewhere else.
+-- These should probably go somewhere else.
 
 -- | Parse a 'CoreString' to a 'CoreExpr', using the current context.
 parseCoreExprT :: CoreString -> TranslateH a CoreExpr
 parseCoreExprT = contextonlyT . parseCore
 
-parse2beforeBiR :: (CoreExpr -> CoreExpr -> BiRewriteH a) -> CoreString -> CoreString -> BiRewriteH a
+parse2beforeBiR :: (CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> BiRewriteH a
 parse2beforeBiR f s1 s2 = beforeBiR (parseCoreExprT s1 &&& parseCoreExprT s2) (uncurry f)
 
-parse3beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a) -> CoreString -> CoreString -> CoreString -> BiRewriteH a
+parse3beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> CoreString -> BiRewriteH a
 parse3beforeBiR f s1 s2 s3 = beforeBiR ((parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3) ((uncurry.uncurry) f)
+
+parse4beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> CoreString -> CoreString -> BiRewriteH a
+parse4beforeBiR f s1 s2 s3 s4 = beforeBiR (((parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3) &&& parseCoreExprT s4) ((uncurry.uncurry.uncurry) f)
+
+parse5beforeBiR :: (CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr -> BiRewriteH a)
+                -> CoreString -> CoreString -> CoreString -> CoreString -> CoreString -> BiRewriteH a
+parse5beforeBiR f s1 s2 s3 s4 s5 = beforeBiR ((((parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3) &&& parseCoreExprT s4) &&& parseCoreExprT s5) ((uncurry.uncurry.uncurry.uncurry) f)
 
 ---------------------------------------------
 
diff --git a/src/HERMIT/Plugin.hs b/src/HERMIT/Plugin.hs
--- a/src/HERMIT/Plugin.hs
+++ b/src/HERMIT/Plugin.hs
@@ -1,150 +1,224 @@
+{-# LANGUAGE KindSignatures, GADTs, FlexibleContexts, GeneralizedNewtypeDeriving, LambdaCase #-}
 module HERMIT.Plugin
     ( -- * The HERMIT Plugin
-      HermitPass
-    , hermitPlugin
-    , CorePass(..)
-    , getCorePass
-    , ghcPasses
-    , PhaseInfo(..)
-    , getPhaseFlag
-    )  where
+      hermitPlugin
+      -- ** Running translations
+    , query
+    , run
+      -- ** Using the shell
+    , interactive
+    , display
+    , setPretty
+    , setPrettyOptions
+      -- ** Active modifiers
+    , at
+    , phase
+    , after
+    , before
+    , until
+    , allPhases
+    , firstPhase
+    , lastPhase
+      -- ** Knobs and Dials
+    , getPhaseInfo
+    , modifyCLS
+      -- ** Types
+    , defPS
+    , HPM
+    , hpmToIO
+    ) where
 
-import Data.List
-import System.IO
+import Control.Applicative
+import Control.Arrow
+import Control.Concurrent.STM
+import Control.Monad.Error hiding (guard)
+import Control.Monad.Operational
+import Control.Monad.State hiding (guard)
 
-import HERMIT.GHC
+import Data.Default
+import Data.Monoid
+import qualified Data.Map as M
 
--- | Given a list of 'CommandLineOption's, produce the 'ModGuts' to 'ModGuts' function required to build a plugin.
-type HermitPass = PhaseInfo -> [CommandLineOption] -> ModGuts -> CoreM ModGuts
+import HERMIT.Dictionary
+import HERMIT.External hiding (Query, Shell)
+import HERMIT.Kernel.Scoped
+import HERMIT.Context
+import HERMIT.Kure
+import HERMIT.GHC hiding (singleton, liftIO, display, (<>))
+import qualified HERMIT.GHC as GHC
+import HERMIT.Monad
 
--- | Build a hermit plugin. This mainly handles the per-module options.
-hermitPlugin :: HermitPass -> Plugin
-hermitPlugin hp = defaultPlugin { installCoreToDos = install }
-    where
-        install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
-        install opts todos = do
-            reinitializeGlobals
+import HERMIT.Plugin.Builder
+import qualified HERMIT.Plugin.Display as Display
+import HERMIT.Plugin.Renderer
+import HERMIT.Plugin.Types
 
-            -- This is a bit of a hack; otherwise we lose what we've not seen
-            liftIO $ hSetBuffering stdout NoBuffering
+import HERMIT.PrettyPrinter.Common
+import qualified HERMIT.PrettyPrinter.Clean as Clean
+import HERMIT.Shell.Command
+import HERMIT.Shell.Types (clm)
 
-            let todos' = flattenTodos todos
-                passes = map getCorePass todos'
-                allPasses = foldr (\ (n,p,seen,notyet) r -> mkPass n seen notyet : p : r)
-                                  [mkPass (length todos') passes []]
-                                  (zip4 [0..] todos' (inits passes) (tails passes))
-                mkPass n ps ps' = CoreDoPluginPass ("HERMIT" ++ show n) $ modFilter hp (PhaseInfo n ps ps') opts
+import Prelude hiding (until)
 
-            return allPasses
+import System.Console.Haskeline (defaultBehavior)
 
--- | Determine whether to act on this module, choose plugin pass.
--- NB: we have the ability to stick module info in the phase info here
-modFilter :: HermitPass -> HermitPass
-modFilter hp pInfo opts guts
-    | null modOpts && notNull opts = return guts -- don't process this module
-    | otherwise                    = hp pInfo (h_opts ++ filter notNull modOpts) guts
-    where modOpts = filterOpts m_opts guts
-          (m_opts, h_opts) = partition (isInfixOf ":") opts
+hermitPlugin :: ([CommandLineOption] -> HPM ()) -> Plugin
+hermitPlugin f = buildPlugin $ \ phaseInfo -> runHPM phaseInfo . f
 
--- | Filter options to those pertaining to this module, stripping module prefix.
-filterOpts :: [CommandLineOption] -> ModGuts -> [CommandLineOption]
-filterOpts opts guts = [ opt | nm <- opts
-                             , let mopt = if modName `isPrefixOf` nm
-                                          then Just (drop len nm)
-                                          else if "*:" `isPrefixOf` nm
-                                               then Just (drop 2 nm)
-                                               else Nothing
-                             , Just opt <- [mopt]
-                             ]
-    where modName = moduleNameString $ moduleName $ mg_module guts
-          len = length modName + 1 -- for the colon
+defPS :: SAST -> ScopedKernel -> PhaseInfo -> IO PluginState
+defPS initSAST kernel phaseInfo = do
+    emptyTick <- liftIO $ atomically $ newTVar M.empty
+    return $ PluginState
+                { ps_cursor         = initSAST
+                , ps_pretty         = Clean.ppCoreTC
+                , ps_pretty_opts    = def { po_width = 80 }
+                , ps_render         = unicodeConsole
+                , ps_running_script = False
+                , ps_tick           = emptyTick
+                , ps_corelint       = False
+                , ps_diffonly       = False
+                , ps_failhard       = False
+                , ps_kernel         = kernel
+                , ps_phase          = phaseInfo
+                }
 
-data CorePass = FloatInwards
-              | LiberateCase
-              | PrintCore
-              | StaticArgs
-              | Strictness
-              | WorkerWrapper
-              | Specialising
-              | SpecConstr
-              | CSE
-              | Vectorisation
-              | Desugar
-              | DesugarOpt
-              | Tidy
-              | Prep
-              | Simplify
-              | FloatOutwards
-              | RuleCheck
-              | Passes -- these should be flattened out in practice
-              | PluginPass String
-              | NoOp
-              | Unknown
-    deriving (Read, Show, Eq)
+data HPMInst :: * -> * where
+    Shell    :: [External] -> [CommandLineOption] -> HPMInst ()
+    Guard    :: (PhaseInfo -> Bool) -> HPM ()     -> HPMInst ()
+    Focus    :: (Injection ModGuts g, Walker HermitC g) => TranslateH g LocalPathH -> HPM a -> HPMInst a
+    RR       :: (Injection ModGuts g, Walker HermitC g) => RewriteH g                       -> HPMInst ()
+    Query    :: (Injection ModGuts g, Walker HermitC g) => TranslateH g a                   -> HPMInst a
 
-ghcPasses :: [(CorePass, CoreToDo)]
-ghcPasses = [ (FloatInwards , CoreDoFloatInwards)
-            , (LiberateCase , CoreLiberateCase)
-            , (PrintCore    , CoreDoPrintCore)
-            , (StaticArgs   , CoreDoStaticArgs)
-            , (Strictness   , CoreDoStrictness)
-            , (WorkerWrapper, CoreDoWorkerWrapper)
-            , (Specialising , CoreDoSpecialising)
-            , (SpecConstr   , CoreDoSpecConstr)
-            , (CSE          , CoreCSE)
-            , (Vectorisation, CoreDoVectorisation)
-            , (Desugar      , CoreDesugar)    -- Right after desugaring, no simple optimisation yet!
-            , (DesugarOpt   , CoreDesugarOpt) -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces
-            , (Tidy         , CoreTidy)
-            , (Prep         , CorePrep)
-            , (NoOp         , CoreDoNothing)
-            ]
+newtype HPM a = HPM { unHPM :: ProgramT HPMInst PluginM a }
+    deriving (Functor, Applicative, Monad, MonadIO)
 
--- The following are not allowed yet because they required options.
--- CoreDoSimplify {- The core-to-core simplifier. -} Int {- Max iterations -} SimplifierMode
--- CoreDoFloatOutwards FloatOutSwitches
--- CoreDoRuleCheck CompilerPhase String   -- Check for non-application of rules matching this string
--- CoreDoPasses [CoreToDo]                -- lists of these things
+runHPM :: PhaseInfo -> HPM () -> ModGuts -> CoreM ModGuts
+runHPM phaseInfo pass = scopedKernel $ \ kernel initSAST -> do
+    ps <- defPS initSAST kernel phaseInfo
+    (r,st) <- hpmToIO ps pass
+    either (\case PAbort       -> abortS kernel
+                  PResume sast -> resumeS kernel sast
+                  PError  err  -> putStrLn err >> abortS kernel)
+           (\ _ -> resumeS kernel $ ps_cursor st) r
 
-getCorePass :: CoreToDo -> CorePass
-getCorePass CoreDoFloatInwards  = FloatInwards
-getCorePass CoreLiberateCase    = LiberateCase
-getCorePass CoreDoPrintCore     = PrintCore
-getCorePass CoreDoStaticArgs    = StaticArgs
-getCorePass CoreDoStrictness    = Strictness
-getCorePass CoreDoWorkerWrapper = WorkerWrapper
-getCorePass CoreDoSpecialising  = Specialising
-getCorePass CoreDoSpecConstr    = SpecConstr
-getCorePass CoreCSE             = CSE
-getCorePass CoreDoVectorisation = Vectorisation
-getCorePass CoreDesugar         = Desugar
-getCorePass CoreDesugarOpt      = DesugarOpt
-getCorePass CoreTidy            = Tidy
-getCorePass CorePrep            = Prep
-getCorePass (CoreDoSimplify {}) = Simplify
-getCorePass (CoreDoFloatOutwards {}) = FloatOutwards
-getCorePass (CoreDoRuleCheck {}) = RuleCheck
-getCorePass (CoreDoPasses {})   = Passes -- these should be flattened out in practice
-getCorePass (CoreDoPluginPass nm _) = PluginPass nm
-getCorePass CoreDoNothing       = NoOp
--- getCorePass _                   = Unknown
+hpmToIO :: PluginState -> HPM a -> IO (Either PException a, PluginState)
+hpmToIO initState = runPluginT initState . eval . unHPM
 
-flattenTodos :: [CoreToDo] -> [CoreToDo]
-flattenTodos = concatMap f
-    where f (CoreDoPasses ps) = flattenTodos ps
-          f CoreDoNothing     = []
-          f other             = [other]
+eval :: ProgramT HPMInst PluginM a -> PluginM a
+eval comp = do
+    (kernel, env) <- gets $ ps_kernel &&& mkKernelEnv
+    v <- viewT comp
+    case v of
+        Return x            -> return x
+        RR rr       :>>= k  -> runS (applyS kernel rr env) >>= eval . k
+        Query tr    :>>= k  -> runK (queryS kernel tr env) >>= eval . k
+        Shell es os :>>= k -> do
+            -- We want to discard the current focus, open the shell at
+            -- the top level, then restore the current focus.
+            paths <- resetScoping env
+            clm (commandLine os defaultBehavior es)
+            _ <- resetScoping env
+            restoreScoping env paths
+            eval $ k ()
+        Guard p (HPM m)  :>>= k  -> gets (p . ps_phase) >>= \ b -> when b (eval m) >>= eval . k
+        Focus tp (HPM m) :>>= k  -> do
+            p <- runK (queryS kernel tp env)  -- run the pathfinding translation
+            runS $ beginScopeS kernel         -- remember the current path
+            runS $ modPathS kernel (<> p) env -- modify the current path
+            r <- eval m             	      -- run the focused computation
+            runS $ endScopeS kernel           -- endscope on it, so we go back to where we started
+            eval $ k r
 
-data PhaseInfo =
-    PhaseInfo { phaseNum :: Int
-              , phasesDone :: [CorePass]
-              , phasesLeft :: [CorePass]
-              }
-    deriving (Read, Show, Eq)
+------------------------- Shell-related helpers --------------------------------------
 
--- | If HERMIT user specifies the -pN flag, get the N
--- TODO: as written will discard other flags that start with -p
-getPhaseFlag :: [CommandLineOption] -> Maybe (Int, [CommandLineOption])
-getPhaseFlag opts = case partition ("-p" `isPrefixOf`) opts of
-                        ([],_) -> Nothing
-                        (ps,r) -> Just (read (drop 2 (last ps)), r)
+resetScoping :: HermitMEnv -> PluginM [PathH]
+resetScoping env = do
+    kernel <- gets ps_kernel
+    paths <- runK $ pathS kernel
+    replicateM_ (length paths - 1) $ runS $ endScopeS kernel
+    -- modPathS commonly fails here because the path is unchanged, so throw away failures
+    catchM (runS $ modPathS kernel (const mempty) env) (const (return ()))
+    return paths
+
+restoreScoping :: HermitMEnv -> [PathH] -> PluginM ()
+restoreScoping _   []    = return ()
+restoreScoping env (h:t) = do
+    kernel <- gets ps_kernel
+
+    let go p []      = restore p
+        go p (p':ps) = restore p >> runS (beginScopeS kernel) >> go p' ps
+
+        -- modPathS commonly fails here because the path is unchanged, so throw away failures
+        restore p = catchM (runS $ modPathS kernel (<> pathToSnocPath p) env)
+                           (const (return ()))
+
+    go h t
+
+-- | Run a kernel function on the current SAST
+runK :: (SAST -> PluginM a) -> PluginM a
+runK f = gets ps_cursor >>= f
+
+-- | Run a kernel function on the current SAST and update ps_cursor
+runS :: (SAST -> PluginM SAST) -> PluginM ()
+runS f = do
+    sast <- runK f
+    modify $ \st -> st { ps_cursor = sast }
+
+interactive :: [External] -> [CommandLineOption] -> HPM ()
+interactive es os = HPM . singleton $ Shell (externals ++ es) os
+
+run :: RewriteH CoreTC -> HPM ()
+run = HPM . singleton . RR
+
+query :: (Injection GHC.ModGuts g, Walker HermitC g) => TranslateH g a -> HPM a
+query = HPM . singleton . Query
+
+----------------------------- guards ------------------------------
+
+guard :: (PhaseInfo -> Bool) -> HPM () -> HPM ()
+guard p = HPM . singleton . Guard p
+
+at :: TranslateH CoreTC LocalPathH -> HPM a -> HPM a
+at tp = HPM . singleton . Focus tp
+
+phase :: Int -> HPM () -> HPM ()
+phase n = guard ((n ==) . phaseNum)
+
+after :: CorePass -> HPM () -> HPM ()
+after cp = guard (\phaseInfo -> case phasesDone phaseInfo of
+                            [] -> False
+                            xs -> last xs == cp)
+
+before :: CorePass -> HPM () -> HPM ()
+before cp = guard (\phaseInfo -> case phasesLeft phaseInfo of
+                            (x:_) | cp == x -> True
+                            _               -> False)
+
+until :: CorePass -> HPM () -> HPM ()
+until cp = guard ((cp `elem`) . phasesLeft)
+
+allPhases :: HPM () -> HPM ()
+allPhases = guard (const True)
+
+firstPhase :: HPM () -> HPM ()
+firstPhase = guard (null . phasesDone)
+
+lastPhase :: HPM () -> HPM ()
+lastPhase = guard (null . phasesLeft)
+
+----------------------------- other ------------------------------
+
+getPhaseInfo :: HPM PhaseInfo
+getPhaseInfo = HPM $ lift $ gets ps_phase
+
+display :: HPM ()
+display = HPM $ lift $ Display.display Nothing
+
+modifyCLS :: (PluginState -> PluginState) -> HPM ()
+modifyCLS = HPM . modify
+
+setPretty :: PrettyH CoreTC -> HPM ()
+setPretty pp = modifyCLS $ \s -> s { ps_pretty = pp }
+
+setPrettyOptions :: PrettyOptions -> HPM ()
+setPrettyOptions po = modifyCLS $ \s -> s { ps_pretty_opts = po }
diff --git a/src/HERMIT/Plugin/Builder.hs b/src/HERMIT/Plugin/Builder.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Plugin/Builder.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE CPP #-}
+
+module HERMIT.Plugin.Builder
+    ( -- * The HERMIT Plugin
+      PluginPass
+    , buildPlugin
+    , CorePass(..)
+    , getCorePass
+    , ghcPasses
+    , PhaseInfo(..)
+    , getPhaseFlag
+    )  where
+
+import Data.List
+import System.IO
+
+import HERMIT.GHC
+
+-- | Given a list of 'CommandLineOption's, produce the 'ModGuts' to 'ModGuts' function required to build a plugin.
+type PluginPass = PhaseInfo -> [CommandLineOption] -> ModGuts -> CoreM ModGuts
+
+-- | Build a plugin. This mainly handles the per-module options.
+buildPlugin :: PluginPass -> Plugin
+buildPlugin hp = defaultPlugin { installCoreToDos = install }
+    where
+        install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+        install opts todos = do
+            reinitializeGlobals
+
+            -- This is a bit of a hack; otherwise we lose what we've not seen
+            liftIO $ hSetBuffering stdout NoBuffering
+#ifdef mingw32_HOST_OS
+            liftIO $ hSetEncoding stdout utf8
+#endif
+
+            let todos' = flattenTodos todos
+                passes = map getCorePass todos'
+                allPasses = foldr (\ (n,p,seen,notyet) r -> mkPass n seen notyet : p : r)
+                                  [mkPass (length todos') passes []]
+                                  (zip4 [0..] todos' (inits passes) (tails passes))
+                mkPass n ps ps' = CoreDoPluginPass ("HERMIT" ++ show n) $ modFilter hp (PhaseInfo n ps ps') opts
+
+            return allPasses
+
+-- | Determine whether to act on this module, choose plugin pass.
+-- NB: we have the ability to stick module info in the phase info here
+modFilter :: PluginPass -> PluginPass
+modFilter hp pInfo opts guts
+    | null modOpts && notNull opts = return guts -- don't process this module
+    | otherwise                    = hp pInfo (h_opts ++ filter notNull modOpts) guts
+    where modOpts = filterOpts m_opts guts
+          (m_opts, h_opts) = partition (isInfixOf ":") opts
+
+-- | Filter options to those pertaining to this module, stripping module prefix.
+filterOpts :: [CommandLineOption] -> ModGuts -> [CommandLineOption]
+filterOpts opts guts = [ opt | nm <- opts
+                             , let mopt = if modName `isPrefixOf` nm
+                                          then Just (drop len nm)
+                                          else if "*:" `isPrefixOf` nm
+                                               then Just (drop 2 nm)
+                                               else Nothing
+                             , Just opt <- [mopt]
+                             ]
+    where modName = moduleNameString $ moduleName $ mg_module guts
+          len = length modName + 1 -- for the colon
+
+-- | An enumeration type for GHC's phases.
+data CorePass = FloatInwards
+              | LiberateCase
+              | PrintCore
+              | StaticArgs
+              | Strictness
+              | WorkerWrapper
+              | Specialising
+              | SpecConstr
+              | CSE
+              | Vectorisation
+              | Desugar
+              | DesugarOpt
+              | Tidy
+              | Prep
+              | Simplify
+              | FloatOutwards
+              | RuleCheck
+              | Passes -- these should be flattened out in practice
+              | PluginPass String
+              | NoOp
+              | Unknown
+    deriving (Read, Show, Eq)
+
+-- The following are not allowed yet because they required options.
+-- CoreDoSimplify {- The core-to-core simplifier. -} Int {- Max iterations -} SimplifierMode
+-- CoreDoFloatOutwards FloatOutSwitches
+-- CoreDoRuleCheck CompilerPhase String   -- Check for non-application of rules matching this string
+-- CoreDoPasses [CoreToDo]                -- lists of these things
+ghcPasses :: [(CorePass, CoreToDo)]
+ghcPasses = [ (FloatInwards , CoreDoFloatInwards)
+            , (LiberateCase , CoreLiberateCase)
+            , (PrintCore    , CoreDoPrintCore)
+            , (StaticArgs   , CoreDoStaticArgs)
+            , (Strictness   , CoreDoStrictness)
+            , (WorkerWrapper, CoreDoWorkerWrapper)
+            , (Specialising , CoreDoSpecialising)
+            , (SpecConstr   , CoreDoSpecConstr)
+            , (CSE          , CoreCSE)
+            , (Vectorisation, CoreDoVectorisation)
+            , (Desugar      , CoreDesugar)    -- Right after desugaring, no simple optimisation yet!
+            , (DesugarOpt   , CoreDesugarOpt) -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces
+            , (Tidy         , CoreTidy)
+            , (Prep         , CorePrep)
+            , (NoOp         , CoreDoNothing)
+            ]
+
+getCorePass :: CoreToDo -> CorePass
+getCorePass CoreDoFloatInwards  = FloatInwards
+getCorePass CoreLiberateCase    = LiberateCase
+getCorePass CoreDoPrintCore     = PrintCore
+getCorePass CoreDoStaticArgs    = StaticArgs
+getCorePass CoreDoStrictness    = Strictness
+getCorePass CoreDoWorkerWrapper = WorkerWrapper
+getCorePass CoreDoSpecialising  = Specialising
+getCorePass CoreDoSpecConstr    = SpecConstr
+getCorePass CoreCSE             = CSE
+getCorePass CoreDoVectorisation = Vectorisation
+getCorePass CoreDesugar         = Desugar
+getCorePass CoreDesugarOpt      = DesugarOpt
+getCorePass CoreTidy            = Tidy
+getCorePass CorePrep            = Prep
+getCorePass (CoreDoSimplify {}) = Simplify
+getCorePass (CoreDoFloatOutwards {}) = FloatOutwards
+getCorePass (CoreDoRuleCheck {}) = RuleCheck
+getCorePass (CoreDoPasses {})   = Passes -- these should be flattened out in practice
+getCorePass (CoreDoPluginPass nm _) = PluginPass nm
+getCorePass CoreDoNothing       = NoOp
+-- getCorePass _                   = Unknown
+
+flattenTodos :: [CoreToDo] -> [CoreToDo]
+flattenTodos = concatMap f
+    where f (CoreDoPasses ps) = flattenTodos ps
+          f CoreDoNothing     = []
+          f other             = [other]
+
+data PhaseInfo =
+    PhaseInfo { phaseNum :: Int
+              , phasesDone :: [CorePass]
+              , phasesLeft :: [CorePass]
+              }
+    deriving (Read, Show, Eq)
+
+-- | If HERMIT user specifies the -pN flag, get the N
+-- TODO: as written will discard other flags that start with -p
+getPhaseFlag :: [CommandLineOption] -> Maybe (Int, [CommandLineOption])
+getPhaseFlag opts = case partition ("-p" `isPrefixOf`) opts of
+                        ([],_) -> Nothing
+                        (ps,r) -> Just (read (drop 2 (last ps)), r)
diff --git a/src/HERMIT/Plugin/Display.hs b/src/HERMIT/Plugin/Display.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Plugin/Display.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleContexts #-}
+module HERMIT.Plugin.Display
+    ( display
+    , getFocusPath
+    , ps_putStr
+    , ps_putStrLn
+    ) where
+
+import Control.Monad.State
+
+import Data.Maybe (fromMaybe)
+
+import HERMIT.Kernel (queryK)
+import HERMIT.Kernel.Scoped
+import HERMIT.Kure
+import HERMIT.Plugin.Types
+import HERMIT.PrettyPrinter.Common
+
+import System.IO
+
+getFocusPath :: PluginM PathH
+getFocusPath = get >>= \ st -> liftM concat $ prefixFailMsg "getFocusPath - pathS failed: " $ pathS (ps_kernel st) (ps_cursor st)
+
+display :: Maybe PathH -> PluginM ()
+display window = do
+    st <- get
+    focusPath <- getFocusPath
+    let skernel = ps_kernel st
+        ppOpts = (ps_pretty_opts st) { po_focus = Just focusPath }
+    -- Do not show focus while loading
+    ifM (gets ps_running_script)
+        (return ())
+        (iokm' "Rendering error: "
+               (liftIO . ps_render st stdout ppOpts . Right)
+               (toASTS skernel (ps_cursor st) >>= \ ast ->
+                    queryK (kernelS skernel) ast (extractT $ pathT (fromMaybe focusPath window) $ liftPrettyH ppOpts $ ps_pretty st) (mkKernelEnv st))
+        )
+
+ps_putStr :: (MonadIO m, MonadState PluginState m) => String -> m ()
+ps_putStr str = do
+    st <- get
+    liftIO $ ps_render st stdout (ps_pretty_opts st) (Left str)
+
+ps_putStrLn :: (MonadIO m, MonadState PluginState m) => String -> m ()
+ps_putStrLn = ps_putStr . (++"\n")
+
diff --git a/src/HERMIT/Plugin/Renderer.hs b/src/HERMIT/Plugin/Renderer.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Plugin/Renderer.hs
@@ -0,0 +1,77 @@
+module HERMIT.Plugin.Renderer where
+
+import Control.Monad.State
+
+import Data.List (isPrefixOf)
+import Data.Monoid
+
+import HERMIT.Kure
+import HERMIT.Plugin.Types
+import HERMIT.PrettyPrinter.Common
+
+-- import HERMIT.Shell.Types
+
+import System.Console.ANSI
+import System.IO
+
+changeRenderer :: String -> PluginM ()
+changeRenderer renderer = modify $ \ st ->
+        case lookup renderer shellRenderers of
+          Nothing -> st          -- TODO: should fail with message
+          Just r  -> st { ps_render = r }
+
+-------------------------------------------------------------------------------
+
+newtype UnicodeTerminal = UnicodeTerminal (Handle -> Maybe PathH -> IO ())
+
+instance RenderSpecial UnicodeTerminal where
+        renderSpecial sym = UnicodeTerminal $ \ h _ -> hPutStr h [ch]
+                where (Unicode ch) = renderSpecial sym
+
+instance Monoid UnicodeTerminal where
+        mempty = UnicodeTerminal $ \ _ _ -> return ()
+        mappend (UnicodeTerminal f1) (UnicodeTerminal f2) = UnicodeTerminal $ \ h p -> f1 h p >> f2 h p
+
+shellRenderers :: [(String,Handle -> PrettyOptions -> Either String DocH -> IO ())]
+shellRenderers = [ ("unicode-terminal", unicodeConsole) ]
+              ++ [ (nm, \ h opts -> either (hPutStr h) (hPutStr h . fn opts)) | (nm,fn) <- coreRenders ]
+
+unicodeConsole :: Handle -> PrettyOptions -> Either String DocH -> IO ()
+unicodeConsole h _    (Left str)  = hPutStr h str
+unicodeConsole h opts (Right doc) = let UnicodeTerminal r = renderCode opts doc
+                                     in r h $ po_focus opts
+
+doSGR :: [SGR] -> UnicodeTerminal
+doSGR cmds = UnicodeTerminal $ \ h _ -> hSetSGR h cmds
+
+undoSGRWith :: [SGR] -> [Attr] -> UnicodeTerminal
+undoSGRWith cmds stk = doSGR cmds `mappend` rDoHighlight Nothing stk
+
+setHighlight :: PathH -> Handle -> Maybe PathH -> IO ()
+setHighlight _ _ Nothing   = return ()
+setHighlight p h (Just fp) = hSetSGR h (if fp `isPrefixOf` p then [ SetUnderlining SingleUnderline ] else [ Reset ])
+
+instance RenderCode UnicodeTerminal where
+        rPutStr txt  = UnicodeTerminal $ \ h _ -> hPutStr h txt
+
+        -- TODO: if we want an inplace CLI... rStart = UnicodeTerminal $ \ h _ -> hClearScreen h >> hSetCursorPosition h 0 0
+        rEnd = UnicodeTerminal $ \ h _ -> hSetSGR h [ Reset ] >> hPutStrLn h ""
+
+        -- anything that doesn't just change the foreground color needs to end itself cleanly
+        rDoHighlight (Just (Color KeywordColor)) stk = undoSGRWith [SetConsoleIntensity NormalIntensity] stk
+        rDoHighlight (Just (Color WarningColor)) stk = undoSGRWith [SetSwapForegroundBackground False] stk
+        rDoHighlight _ [] = doSGR [ Reset ]
+        rDoHighlight _ (Color col:_) =
+            doSGR $ case col of
+                        KeywordColor  -> [ SetConsoleIntensity BoldIntensity
+                                         , SetColor Foreground Dull Blue
+                                         ]
+                        SyntaxColor   -> [ SetColor Foreground Dull Red ]
+                        IdColor       -> [] -- equivalent to Reset
+                        CoercionColor -> [ SetColor Foreground Dull Yellow ]
+                        TypeColor     -> [ SetColor Foreground Dull Green ]
+                        LitColor      -> [ SetColor Foreground Dull Cyan ]
+                        WarningColor  -> [ SetSwapForegroundBackground True, SetColor Foreground Vivid Yellow ]
+-- TODO: enable        rDoHighlight _ (PathAttr p:_) = UnicodeTerminal $ setHighlight $ snocPathToPath p
+        rDoHighlight o (_:rest) = rDoHighlight o rest
+
diff --git a/src/HERMIT/Plugin/Types.hs b/src/HERMIT/Plugin/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Plugin/Types.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE TypeFamilies, DeriveDataTypeable, FlexibleContexts, 
+             LambdaCase, GADTs, GeneralizedNewtypeDeriving,
+             ScopedTypeVariables, FlexibleInstances #-}
+module HERMIT.Plugin.Types where
+
+import Control.Applicative
+import Control.Concurrent.STM
+import Control.Monad.Error
+import Control.Monad.State
+
+import Data.Dynamic
+import qualified Data.Map as M
+
+import HERMIT.Kure
+import HERMIT.External
+import HERMIT.Kernel.Scoped
+import HERMIT.Monad
+import HERMIT.Plugin.Builder
+import HERMIT.PrettyPrinter.Common
+
+import System.IO
+
+type PluginM = PluginT IO
+newtype PluginT m a = PluginT { unPluginT :: ErrorT PException (StateT PluginState m) a }
+    deriving (Functor, Applicative, Monad, MonadIO, MonadError PException, MonadState PluginState)
+
+runPluginT :: PluginState -> PluginT m a -> m (Either PException a, PluginState)
+runPluginT ps = flip runStateT ps . runErrorT . unPluginT
+
+instance MonadTrans PluginT where
+    lift = PluginT . lift . lift
+
+instance Monad m => MonadCatch (PluginT m) where
+    -- law: fail msg `catchM` f == f msg
+    -- catchM :: m a -> (String -> m a) -> m a
+    catchM m f = do
+        st <- get
+        (r,st') <- lift $ runPluginT st m
+        case r of
+            Left err -> case err of
+                            PError msg -> f msg
+                            other -> throwError other -- rethrow abort/resume
+            Right v  -> put st' >> return v
+
+-- Session-local issues; things that are never saved.
+data PluginState = PluginState
+    { ps_cursor         :: SAST                                     -- ^ the current AST
+    , ps_pretty         :: PrettyH CoreTC                           -- ^ which pretty printer to use
+    , ps_pretty_opts    :: PrettyOptions                            -- ^ the options for the pretty printer
+    , ps_render         :: Handle -> PrettyOptions -> Either String DocH -> IO () -- ^ the way of outputing to the screen
+    , ps_running_script :: Bool                                     -- ^ if running a script
+    , ps_tick           :: TVar (M.Map String Int)                  -- ^ the list of ticked messages
+    , ps_corelint       :: Bool                                     -- ^ if true, run Core Lint on module after each rewrite
+    , ps_diffonly       :: Bool                                     -- ^ if true, show diffs rather than pp full code (TODO: move into pretty opts)
+    , ps_failhard       :: Bool                                     -- ^ if true, abort on *any* failure
+    -- this should be in a reader
+    , ps_kernel         :: ScopedKernel
+    , ps_phase          :: PhaseInfo
+    } deriving (Typeable)
+
+data PException = PAbort | PResume SAST | PError String
+
+instance Error PException where strMsg = PError
+
+newtype PSBox = PSBox PluginState deriving Typeable
+instance Extern PluginState where
+    type Box PluginState = PSBox
+    unbox (PSBox st) = st
+    box = PSBox
+
+-- tick counter
+tick :: TVar (M.Map String Int) -> String -> IO Int
+tick var msg = atomically $ do
+        m <- readTVar var
+        let c = case M.lookup msg m of
+                Nothing -> 1
+                Just x  -> x + 1
+        writeTVar var (M.insert msg c m)
+        return c
+
+mkKernelEnv :: PluginState -> HermitMEnv
+mkKernelEnv st =
+    let out str = liftIO $ ps_render st stdout (ps_pretty_opts st) (Left $ str ++ "\n")
+
+    in  mkHermitMEnv $ \ msg -> case msg of
+                DebugTick    msg'      -> do
+                        c <- liftIO $ tick (ps_tick st) msg'
+                        out $ "<" ++ show c ++ "> " ++ msg'
+                DebugCore  msg' cxt core -> do
+                        out $ "[" ++ msg' ++ "]"
+                        doc :: DocH <- apply (ps_pretty st) (liftPrettyC (ps_pretty_opts st) cxt) (inject core)
+                        liftIO $ ps_render st stdout (ps_pretty_opts st) (Right doc)
+
+iokm' :: (MonadIO m, MonadCatch m) => String -> (a -> m b) -> IO (KureM a) -> m b
+iokm' msg ret m = liftIO m >>= runKureM ret (fail . (msg ++))
+
+iokm :: (MonadIO m, MonadCatch m) => String -> IO (KureM a) -> m a 
+iokm msg = iokm' msg return
+
+iokm'' :: (MonadIO m, MonadCatch m) => IO (KureM a) -> m a 
+iokm'' = iokm ""
diff --git a/src/HERMIT/PrettyPrinter/AST.hs b/src/HERMIT/PrettyPrinter/AST.hs
--- a/src/HERMIT/PrettyPrinter/AST.hs
+++ b/src/HERMIT/PrettyPrinter/AST.hs
@@ -11,6 +11,7 @@
   , ppCoreAlt
   , ppKindOrType
   , ppCoercion
+  , ppForallQuantification
   )
 where
 
@@ -18,7 +19,7 @@
 
 import Data.Char (isSpace)
 
-import HERMIT.GHC hiding (($$), (<+>), ($+$), cat, nest, parens, text, empty)
+import HERMIT.GHC hiding (($$), (<+>), (<>), ($+$), cat, nest, parens, text, empty, hsep)
 import HERMIT.Kure
 import HERMIT.Core
 
@@ -126,5 +127,14 @@
     modCol v | isTyVar v  = typeColor
              | isCoVar v  = coercionColor
              | otherwise  = idColor
+
+-- A bit hacky, currently only used to pretty-print Lemmas.
+ppForallQuantification :: PrettyH [Var]
+ppForallQuantification =
+  do vs <- mapT ppVar
+     return $ keywordText "forall" <+> hsep vs <> keywordText "."
+
+keywordText :: String -> DocH
+keywordText = keywordColor . text
 
 ---------------------------------------------------------------------------
diff --git a/src/HERMIT/PrettyPrinter/Clean.hs b/src/HERMIT/PrettyPrinter/Clean.hs
--- a/src/HERMIT/PrettyPrinter/Clean.hs
+++ b/src/HERMIT/PrettyPrinter/Clean.hs
@@ -10,6 +10,7 @@
   , ppCoreAlt
   , ppKindOrType
   , ppCoercion
+  , ppForallQuantification
   )
 where
 
@@ -17,6 +18,7 @@
 import Control.Applicative ((<$>))
 
 import Data.Char (isSpace)
+import Data.Monoid (mempty)
 
 import HERMIT.Context
 import HERMIT.Core
@@ -387,6 +389,13 @@
                                        | isLiftedTypeKindCon tyCon -> RetAtom $ tyChar p '*'
                                        | otherwise                 -> retApps p TyConApp_Arg pCon tys
              )
+
+
+-- A bit hacky, currently only used to pretty-print Lemmas.
+ppForallQuantification :: PrettyH [Var]
+ppForallQuantification =
+  do vs <- mapT ppBinderMode
+     return $ specialSymbol mempty ForallSymbol <+> hsep vs <> symbol mempty '.'
 
 --------------------------------------------------------------------
 
diff --git a/src/HERMIT/PrettyPrinter/GHC.hs b/src/HERMIT/PrettyPrinter/GHC.hs
--- a/src/HERMIT/PrettyPrinter/GHC.hs
+++ b/src/HERMIT/PrettyPrinter/GHC.hs
@@ -9,6 +9,7 @@
   , ppCoreAlt
   , ppKindOrType
   , ppCoercion
+  , ppForallQuantification
   )
 where
 
@@ -18,7 +19,7 @@
 
 import HERMIT.Kure
 import HERMIT.Core
-import HERMIT.GHC hiding ((<+>), char, text, parens)
+import HERMIT.GHC hiding ((<+>), (<>), char, text, parens, hsep)
 import HERMIT.PrettyPrinter.Common
 
 import Text.PrettyPrint.MarkedHughesPJ as PP
@@ -67,5 +68,11 @@
 
 ppCoercion :: PrettyH Coercion
 ppCoercion = ppSDoc
+
+-- A bit hacky, currently only used to pretty-print Lemmas.
+ppForallQuantification :: PrettyH [Var]
+ppForallQuantification =
+  do vs <- mapT ppSDoc
+     return $ text "forall" <+> hsep vs <> text "."
 
 ---------------------------------------------------------------------------
diff --git a/src/HERMIT/Shell/Command.hs b/src/HERMIT/Shell/Command.hs
--- a/src/HERMIT/Shell/Command.hs
+++ b/src/HERMIT/Shell/Command.hs
@@ -10,7 +10,6 @@
     , performKernelEffect
     , performQuery
     , performShellEffect
-    , performMetaCommand
     , cl_kernel_env
     , getFocusPath
     , shellComplete
@@ -20,7 +19,6 @@
 import Control.Applicative
 import Control.Arrow hiding (loop)
 import Control.Concurrent
-import Control.Concurrent.STM
 import Control.Exception.Base hiding (catch)
 import Control.Monad.State
 import Control.Monad.Error
@@ -35,20 +33,23 @@
 import HERMIT.Dictionary
 import HERMIT.External
 import qualified HERMIT.GHC as GHC
-import HERMIT.Interp
 import HERMIT.Kernel (queryK, AST)
 import HERMIT.Kernel.Scoped hiding (abortS, resumeS)
 import HERMIT.Kure
-import HERMIT.Monad
 import HERMIT.Parser
+
+import HERMIT.Plugin.Display
+import HERMIT.Plugin.Renderer
+import HERMIT.Plugin.Types
+
 import HERMIT.PrettyPrinter.Common
 import HERMIT.PrettyPrinter.Clean (ppCoreTC)
 
-
 import HERMIT.Shell.Dictionary
 import HERMIT.Shell.Externals
+import HERMIT.Shell.Interpreter
+import HERMIT.Shell.Proof
 import HERMIT.Shell.ScriptToRewrite
-import HERMIT.Shell.Renderer
 import HERMIT.Shell.Types
 
 import System.IO
@@ -56,27 +57,18 @@
 import System.Process
 
 -- import System.Console.ANSI
-import System.Console.Haskeline hiding (catch)
-import System.Console.Terminfo (setupTermFromEnv, getCapability, termColumns, termLines)
+import System.Console.Haskeline hiding (catch, display)
 
 ----------------------------------------------------------------------------------
 
 catch :: IO a -> (String -> IO a) -> IO a
 catch = catchJust (\ (err :: IOException) -> return (show err))
 
-cl_putStr :: MonadIO m => String -> CLM m ()
-cl_putStr str = do
-    st <- get
-    liftIO $ cl_render st stdout (cl_pretty_opts st) (Left str)
-
-cl_putStrLn :: MonadIO m => String -> CLM m ()
-cl_putStrLn = cl_putStr . (++"\n")
-
-fixWindow :: MonadIO m => CLM m ()
+fixWindow :: MonadIO m => CLT m ()
 fixWindow = do
     st <- get
     -- check to make sure new path is still inside window
-    focusPath <- getFocusPath
+    focusPath <- pluginM getFocusPath
     -- move the window in two cases:
     --  1. window path is not prefix of focus path
     --  2. window path is empty (since at the top level we only show type sigs)
@@ -84,24 +76,8 @@
        $ put $ st { cl_window = focusPath } -}
     put $ st { cl_window = focusPath } -- TODO: temporary until we figure out a better highlight interface
 
-getFocusPath :: MonadIO m => CLM m PathH
-getFocusPath = get >>= \ st -> liftM concat $ prefixFailMsg "getFocusPath - pathS failed: " $ pathS (cl_kernel st) (cl_cursor st)
-
-showWindow :: MonadIO m => CLM m ()
-showWindow = do
-    fixWindow
-    st <- get
-    focusPath <- getFocusPath
-    let skernel = cl_kernel st
-        ppOpts = (cl_pretty_opts st) { po_focus = Just focusPath }
-    -- Do not show focus while loading
-    ifM (gets cl_running_script)
-        (return ())
-        (iokm2clm' "Rendering error: "
-                   (liftIO . cl_render st stdout ppOpts . Right)
-                   (toASTS skernel (cl_cursor st) >>= \ ast ->
-                        queryK (kernelS skernel) ast (extractT $ pathT (cl_window st) $ liftPrettyH ppOpts $ cl_pretty st) (cl_kernel_env st))
-        )
+showWindow :: MonadIO m => CLT m ()
+showWindow = fixWindow >> gets cl_window >>= pluginM . display . Just
 
 -------------------------------------------------------------------------------
 
@@ -156,8 +132,8 @@
     cl <- catchM (queryS (cl_kernel st) targetQuery (cl_kernel_env st) (cl_cursor st)) (\_ -> return [])
     return $ (map simpleCompletion . nub . filter (so_far `isPrefixOf`)) cl
 
-setRunningScript :: MonadIO m => Bool -> CLM m ()
-setRunningScript b = modify $ \st -> st { cl_running_script = b }
+setRunningScript :: MonadIO m => Bool -> CLT m ()
+setRunningScript b = modify $ \st -> st { cl_pstate = (cl_pstate st) { ps_running_script = b } }
 
 banner :: String
 banner = unlines
@@ -174,7 +150,7 @@
     , "available HERMIT commands."
     , ""
     , "To get started, you could try the following:"
-    , "  - type \"consider 'foo\", where \"foo\" is a function"
+    , "  - type \"binding-of 'foo\", where \"foo\" is a function"
     , "    defined in the module;"
     , "  - type \"set-pp-type Show\" to display full type information;"
     , "  - type \"info\" for more information about the current node;"
@@ -185,37 +161,18 @@
     , "=============================================================="
     ]
 
-getTermDimensions :: IO (Int, Int)
-getTermDimensions = do
-    term <- setupTermFromEnv
-    let w = fromMaybe 80 $ getCapability term termColumns
-        h = fromMaybe 30 $ getCapability term termLines
-    return (w,h)
-
 -- | The first argument includes a list of files to load.
-commandLine :: MonadIO m => [GHC.CommandLineOption] -> Behavior -> [External] -> CLM m ()
+commandLine :: [GHC.CommandLineOption] -> Behavior -> [External] -> CLT IO ()
 commandLine opts behavior exts = do
-    let dict = mkDict $ shell_externals ++ exts
+    let (flags, filesToLoad) = partition (isPrefixOf "-") opts
         ws_complete = " ()"
-        (flags, filesToLoad) = partition (isPrefixOf "-") opts
 
-    (w,h) <- liftIO getTermDimensions
-
-    -- initialize shell-instance specific parts of the state
-    -- TODO: move into another transformer layer?
-    initState <- get
-    let clState = initState { cl_version     = VersionStore { vs_graph = [] , vs_tags = [] }
-                            , cl_scripts     = []
-                            , cl_dict        = dict
-                            , cl_pretty_opts = (cl_pretty_opts initState) { po_width = w }
-                            , cl_height      = h
-                            , cl_initSAST    = cl_cursor initState
-                            }
-    put clState
+    modify $ \ st -> st { cl_dict = mkDict (shell_externals ++ exts) }
 
+    clState <- get
     completionMVar <- liftIO $ newMVar clState
 
-    let loop :: (MonadIO m, MonadException m) => CLM (InputT m) ()
+    let loop :: CLT (InputT IO) ()
         loop = do
             st <- get
             let SAST n = cl_cursor st
@@ -225,7 +182,7 @@
                              lift $ getInputLine $ "hermit<" ++ show n ++ "> "
 
             case mLine of
-                Nothing          -> performMetaCommand Resume
+                Nothing          -> performShellEffect Resume
                 Just ('-':'-':_) -> loop
                 Just line        -> if all isSpace line
                                     then loop
@@ -238,7 +195,7 @@
 
     -- Load and run any scripts
     setRunningScript True
-    sequence_ [ performMetaCommand $ case fileName of
+    sequence_ [ performShellEffect $ case fileName of
                  "abort"  -> Abort
                  "resume" -> Resume
                  _        -> loadAndRun fileName
@@ -250,34 +207,31 @@
     -- Start the CLI
     showWindow
     let settings = setComplete (completeWordWithPrev Nothing ws_complete (shellComplete completionMVar)) defaultSettings
-    (r,s) <- get >>= liftIO . runInputTBehavior behavior settings . flip runCLM loop
+    (r,s) <- get >>= liftIO . runInputTBehavior behavior settings . flip runCLT loop
     either throwError (\v -> put s >> return v) r
 
-ourCatch :: MonadIO m => CLM m () -> (String -> CLM m ()) -> CLM m ()
+ourCatch :: MonadIO m => CLT m () -> (String -> CLT m ()) -> CLT m ()
 ourCatch m failure = catchM m $ \ msg -> ifM (gets cl_failhard) (performQuery Display >> cl_putStrLn msg >> abort) (failure msg)
 
-evalScript :: MonadIO m => String -> CLM m ()
-evalScript = parseScriptCLM >=> runScript
+evalScript :: MonadIO m => String -> CLT m ()
+evalScript = parseScriptCLT >=> runScript
 
-parseScriptCLM :: Monad m => String -> CLM m Script
-parseScriptCLM = either fail return . parseScript
+parseScriptCLT :: Monad m => String -> CLT m Script
+parseScriptCLT = either fail return . parseScript
 
-runScript :: MonadIO m => Script -> CLM m ()
+runScript :: MonadIO m => Script -> CLT m ()
 runScript = mapM_ runExprH
 
-runExprH :: MonadIO m => ExprH -> CLM m ()
-runExprH expr = do
-    dict <- gets cl_dict
-    runKureM (\case
-                 KernelEffect effect -> performKernelEffect effect expr
-                 ShellEffect effect  -> performShellEffect effect
-                 QueryFun query      -> performQuery query
-                 MetaCommand meta    -> performMetaCommand meta
-             )
-             fail
-             (interpExprH dict interpShellCommand expr)
+runExprH :: MonadIO m => ExprH -> CLT m ()
+runExprH expr = prefixFailMsg ("Error in expression: " ++ unparseExprH expr ++ "\n") $ do
+    shellCmd <- interpExprH interpShellCommand expr
+    case shellCmd of
+        KernelEffect effect -> performKernelEffect effect expr
+        ShellEffect effect  -> performShellEffect effect
+        QueryFun query      -> performQuery query
+        ProofCommand cmd    -> performProofCommand cmd
 
-ppWholeProgram :: MonadIO m => AST -> CLM m DocH
+ppWholeProgram :: MonadIO m => AST -> CLT m DocH
 ppWholeProgram ast = do
     st <- get
     liftIO (queryK (kernelS $ cl_kernel st)
@@ -291,7 +245,7 @@
 --   UPDATE: Not true.  We don't always showWindow.
 -- TODO: All of these should through an exception if they fail to execute the command as given.
 
-performKernelEffect :: MonadIO m => KernelEffect -> ExprH -> CLM m ()
+performKernelEffect :: MonadIO m => KernelEffect -> ExprH -> CLT m ()
 performKernelEffect (Apply rr) expr = do
     st <- get
 
@@ -352,17 +306,7 @@
 
 -------------------------------------------------------------------------------
 
-performShellEffect :: MonadIO m => ShellEffect -> CLM m ()
-performShellEffect (CLSModify f) = do
-    st <- get
-    opt <- liftIO (fmap Right (f st) `catch` \ str -> return (Left str))
-    case opt of
-        Right st' -> put st' >> showWindow
-        Left err  -> fail err
-
--------------------------------------------------------------------------------
-
-performQuery :: MonadIO m => QueryFun -> CLM m ()
+performQuery :: MonadIO m => QueryFun -> CLT m ()
 performQuery (QueryString q) = do
     st <- get
     str <- prefixFailMsg "Query failed: " $ queryS (cl_kernel st) q (cl_kernel_env st) (cl_cursor st)
@@ -373,32 +317,9 @@
     doc <- prefixFailMsg "Query failed: " $ queryS (cl_kernel st) (q (initPrettyC $ cl_pretty_opts st) $ cl_pretty st) (cl_kernel_env st) (cl_cursor st)
     liftIO $ cl_render st stdout (cl_pretty_opts st) (Right doc)
 
-performQuery (Inquiry f) = do
-    st <- get
-    str <- liftIO $ f st
-    putStrToConsole str
-
--- These two need to use Inquiry
--- performQuery (Message msg) = liftIO (putStrLn msg)
--- Explicit calls to display should work no matter what the loading state is.
-performQuery Display = do
-    running_script_st <- gets cl_running_script
-    setRunningScript False
-    showWindow
-    setRunningScript running_script_st
-
--------------------------------------------------------------------------------
-
-performMetaCommand :: MonadIO m => MetaCommand -> CLM m ()
-performMetaCommand (SeqMeta ms) = mapM_ performMetaCommand ms
-performMetaCommand Abort  = abort
-performMetaCommand Resume = do
-    st <- get
-    sast' <- applyS (cl_kernel st) occurAnalyseAndDezombifyR (cl_kernel_env st) (cl_cursor st)
-    resume sast'
+performQuery (Inquiry f) = get >>= liftIO . f >>= putStrToConsole
 
-performMetaCommand Continue = get >>= continue
-performMetaCommand (Diff s1 s2) = do
+performQuery (Diff s1 s2) = do
     st <- get
 
     ast1 <- toASTS (cl_kernel st) s1
@@ -421,8 +342,26 @@
     cl_putStrLn "====="
     cl_putStr r
 
-performMetaCommand (Dump fileName renderer width) = do
+-- Explicit calls to display should work no matter what the loading state is.
+performQuery Display = do
+    running_script_st <- gets cl_running_script
+    setRunningScript False
+    showWindow
+    setRunningScript running_script_st
+
+-------------------------------------------------------------------------------
+
+performShellEffect :: MonadIO m => ShellEffect -> CLT m ()
+performShellEffect (SeqMeta ms) = mapM_ performShellEffect ms
+performShellEffect Abort  = abort
+performShellEffect Resume = do
     st <- get
+    sast' <- applyS (cl_kernel st) occurAnalyseAndDezombifyR (cl_kernel_env st) (cl_cursor st)
+    resume sast'
+
+performShellEffect Continue = get >>= continue
+performShellEffect (Dump fileName renderer width) = do
+    st <- get
     case lookup renderer shellRenderers of
       Just r -> do doc <- prefixFailMsg "Bad renderer option: " $
                             queryS (cl_kernel st) (liftPrettyH (cl_pretty_opts st) $ cl_pretty st) (cl_kernel_env st) (cl_cursor st)
@@ -431,34 +370,32 @@
                                hClose h
       _ -> fail "dump: bad pretty-printer or renderer option"
 
-performMetaCommand (LoadFile scriptName fileName) =
+performShellEffect (LoadFile scriptName fileName) =
   do putStrToConsole $ "Loading \"" ++ fileName ++ "\"..."
      res <- liftIO $ try (readFile fileName)
      case res of
        Left (err :: IOException) -> fail ("IO error: " ++ show err)
-       Right str -> do script <- parseScriptCLM str
+       Right str -> do script <- parseScriptCLT str
                        modify $ \ st -> st {cl_scripts = (scriptName,script) : cl_scripts st}
                        putStrToConsole ("Script \"" ++ scriptName ++ "\" loaded successfully from \"" ++ fileName ++ "\".")
 
-performMetaCommand (SaveFile fileName) =
+performShellEffect (SaveFile fileName) =
   do version <- gets cl_version
      putStrToConsole $ "[saving " ++ fileName ++ "]"
      -- no checks to see if you are clobering; be careful
      liftIO $ writeFile fileName $ showGraph (vs_graph version) (vs_tags version) (SAST 0)
 
-performMetaCommand (ScriptToRewrite rewriteName scriptName) =
+performShellEffect (ScriptToRewrite rewriteName scriptName) =
   do script <- lookupScript scriptName
-     st <- get
-     dict' <- iokm2clm "script-to-rewrite failed: " (return $ addScriptToDict rewriteName script (cl_dict st))
-     put (st {cl_dict = dict'})
+     addScriptToDict rewriteName script 
      putStrToConsole ("Rewrite \"" ++ rewriteName ++ "\" defined successfully.")
 
-performMetaCommand (DefineScript scriptName str) =
-  do script <- parseScriptCLM str
+performShellEffect (DefineScript scriptName str) =
+  do script <- parseScriptCLT str
      modify $ \ st -> st {cl_scripts = (scriptName,script) : cl_scripts st}
      putStrToConsole ("Script \"" ++ scriptName ++ "\" defined successfully.")
 
-performMetaCommand (RunScript scriptName) =
+performShellEffect (RunScript scriptName) =
   do script <- lookupScript scriptName
      running_script_st <- gets cl_running_script
      setRunningScript True
@@ -467,22 +404,25 @@
      putStrToConsole ("Script \"" ++ scriptName ++ "\" ran successfully.")
      showWindow
 
-performMetaCommand (SaveScript fileName scriptName) =
+performShellEffect (SaveScript fileName scriptName) =
   do script <- lookupScript scriptName
      putStrToConsole $ "Saving script \"" ++ scriptName ++ "\" to file \"" ++ fileName ++ "\"."
      liftIO $ writeFile fileName $ unparseScript script
      putStrToConsole $ "Save successful."
 
-lookupScript :: Monad m => ScriptName -> CLM m Script
-lookupScript scriptName = do scripts <- gets cl_scripts
-                             case lookup scriptName scripts of
-                               Nothing     -> fail $ "No script of name " ++ scriptName ++ " is loaded."
-                               Just script -> return script
+performShellEffect (CLSModify f) = do
+    st <- get
+    opt <- liftIO (fmap Right (f st) `catch` \ str -> return (Left str))
+    case opt of
+        Right st' -> put st' >> showWindow
+        Left err  -> fail err
 
+performShellEffect (PluginComp m) = pluginM m
+
 -------------------------------------------------------------------------------
 
 -- TODO: merge with cl_putStr defn
-putStrToConsole :: MonadIO m => String -> CLM m ()
+putStrToConsole :: MonadIO m => String -> CLT m ()
 putStrToConsole str = ifM (gets cl_running_script)
                           (return ())
                           (cl_putStrLn str)
@@ -528,34 +468,6 @@
           , ("f",      res "step")
           ] ++
           [ (show n, res (show n)) | n <- [0..9] :: [Int] ]
-
-----------------------------------------------------------------------------------------------
-
-cl_kernel_env  :: CommandLineState -> HermitMEnv
-cl_kernel_env st =
-    let out str = do (r,_) <- liftIO $ runCLM st $ cl_putStrLn str
-                     either (\case CLError msg -> fail msg
-                                   _           -> fail "resume/abort/continue called from cl_putStrLn (impossible!)")
-                            return r
-
-    in  mkHermitMEnv $ \ msg -> case msg of
-                DebugTick    msg'      -> do
-                        c <- liftIO $ tick (cl_tick st) msg'
-                        out $ "<" ++ show c ++ "> " ++ msg'
-                DebugCore  msg' cxt core -> do
-                        out $ "[" ++ msg' ++ "]"
-                        doc :: DocH <- apply (cl_pretty st) (liftPrettyC (cl_pretty_opts st) cxt) (inject core)
-                        liftIO $ cl_render st stdout (cl_pretty_opts st) (Right doc)
-
--- tick counter
-tick :: TVar (M.Map String Int) -> String -> IO Int
-tick var msg = atomically $ do
-        m <- readTVar var
-        let c = case M.lookup msg m of
-                Nothing -> 1
-                Just x  -> x + 1
-        writeTVar var (M.insert msg c m)
-        return c
 
 ----------------------------------------------------------------------------------------------
 
diff --git a/src/HERMIT/Shell/Externals.hs b/src/HERMIT/Shell/Externals.hs
--- a/src/HERMIT/Shell/Externals.hs
+++ b/src/HERMIT/Shell/Externals.hs
@@ -11,17 +11,24 @@
 import HERMIT.Context
 import HERMIT.Kure
 import HERMIT.External
-import HERMIT.Interp
 import HERMIT.Kernel.Scoped
 import HERMIT.Parser
+import HERMIT.Plugin.Renderer
 import HERMIT.PrettyPrinter.Common
 
 import HERMIT.Shell.Dictionary
-import HERMIT.Shell.Renderer
+import HERMIT.Shell.Interpreter
+import HERMIT.Shell.Proof as Proof
 import HERMIT.Shell.Types
 
 ----------------------------------------------------------------------------------
 
+-- | There are four types of commands.
+data ShellCommand = KernelEffect KernelEffect -- ^ Command that modifies the state of the (scoped) kernel.
+                  | ShellEffect  ShellEffect  -- ^ Command that modifies the state of the shell.
+                  | QueryFun     QueryFun     -- ^ Command that queries the AST with a Translate (read only).
+                  | ProofCommand ProofCommand -- ^ Command that deals with proofs.
+
 -- | Interpret a boxed thing as one of the four possible shell command types.
 interpShellCommand :: [Interp ShellCommand]
 interpShellCommand =
@@ -41,7 +48,7 @@
   , interp $ \ (effect :: KernelEffect)      -> KernelEffect effect
   , interp $ \ (effect :: ShellEffect)       -> ShellEffect effect
   , interp $ \ (query :: QueryFun)           -> QueryFun query
-  , interp $ \ (meta :: MetaCommand)         -> MetaCommand meta
+  , interp $ \ (cmd :: ProofCommand)         -> ProofCommand cmd
   ]
 
 shell_externals :: [External]
@@ -91,47 +98,47 @@
        [ "show diff of two ASTs" ]                                              .+ VersionControl
    , external "set-pp-diffonly" (\ bStr -> CLSModify $ \ st ->
         case reads bStr of
-            [(b,"")] -> return $ st { cl_diffonly = b }
-            _        -> return st )
+            [(b,"")] -> return $ setDiffOnly st b
+            _        -> return st)
        [ "set-pp-diffonly <True|False>; False by default"
        , "print diffs rather than full code after a rewrite" ]
-   , external "set-fail-hard" (\ bStr -> CLSModify $ \ st ->
+   , external "set-fail-hard"   (\ bStr -> CLSModify $ \ st ->
         case reads bStr of
-            [(b,"")] -> return $ st { cl_failhard = b }
-            _        -> return st )
+            [(b,"")] -> return $ setFailHard st b
+            _        -> return st)
        [ "set-fail-hard <True|False>; False by default"
        , "any rewrite failure causes compilation to abort" ]
    , external "set-auto-corelint" (\ bStr -> CLSModify $ \ st ->
         case reads bStr of
-            [(b,"")] -> return $ st { cl_corelint = b }
+            [(b,"")] -> return $ setCoreLint st b
             _        -> return st )
        [ "set-auto-corelint <True|False>; False by default"
        , "run core lint type-checker after every rewrite, reverting on failure" ]
-   , external "set-pp"           (\ name -> CLSModify $ \ st ->
+   , external "set-pp"          (\ name -> CLSModify $ \ st ->
        case M.lookup name pp_dictionary of
          Nothing -> do
             putStrLn $ "List of Pretty Printers: " ++ intercalate ", " (M.keys pp_dictionary)
             return st
-         Just pp -> return $ st { cl_pretty = pp })
+         Just pp -> return $ setPretty st pp)
        [ "set the pretty printer"
        , "use 'set-pp ls' to list available pretty printers" ]
-   , external "set-pp-renderer"    changeRenderer
+   , external "set-pp-renderer"    (PluginComp . changeRenderer)
        [ "set the output renderer mode"]
    , external "set-pp-renderer"    showRenderers
        [ "set the output renderer mode"]
    , external "dump"    Dump
        [ "dump <filename> <renderer> <width>"]
    , external "set-pp-width" (\ w -> CLSModify $ \ st ->
-        return $ st { cl_pretty_opts = updateWidthOption w (cl_pretty_opts st) })
+        return $ setPrettyOpts st (updateWidthOption w (cl_pretty_opts st)))
        ["set the width of the screen"]
    , external "set-pp-type" (\ str -> CLSModify $ \ st ->
         case reads str :: [(ShowOption,String)] of
-            [(opt,"")] -> return $ st { cl_pretty_opts = updateTypeShowOption opt (cl_pretty_opts st) }
+            [(opt,"")] -> return $ setPrettyOpts st (updateTypeShowOption opt (cl_pretty_opts st))
             _          -> return st)
        ["set how to show expression-level types (Show|Abstact|Omit)"]
    , external "set-pp-coercion" (\ str -> CLSModify $ \ st ->
         case reads str :: [(ShowOption,String)] of
-            [(opt,"")] -> return $ st { cl_pretty_opts = updateCoShowOption opt (cl_pretty_opts st) }
+            [(opt,"")] -> return $ setPrettyOpts st (updateCoShowOption opt (cl_pretty_opts st))
             _          -> return st)
        ["set how to show coercions (Show|Abstact|Omit)"]
    , external "{"   BeginScope
@@ -166,7 +173,7 @@
    , external "display-scripts" displayScripts
        ["Display all loaded scripts."]
      -- TODO: maybe add a "list-scripts" as well that just lists the names of loaded scripts?
-   ]
+   ] ++ Proof.externals
 
 gc :: CommandLineState -> IO CommandLineState
 gc st = do
@@ -184,6 +191,9 @@
     paths <- concat <$> pathS (cl_kernel st) (cl_cursor st)
     return $ st { cl_window = paths }
 
+showRenderers :: QueryFun
+showRenderers = message $ "set-renderer " ++ show (map fst shellRenderers)
+
 --------------------------------------------------------
 
 versionCmd :: VersionCmd -> CommandLineState -> IO CommandLineState
@@ -192,10 +202,10 @@
         Goto n -> do
             all_nds <- listS (cl_kernel st)
             if SAST n `elem` all_nds
-                then return $ st { cl_cursor = SAST n }
+                then return $ setCursor st (SAST n)
                 else fail $ "Cannot find AST #" ++ show n ++ "."
         GotoTag tag -> case lookup tag (vs_tags (cl_version st)) of
-                        Just sast -> return $ st { cl_cursor = sast }
+                        Just sast -> return $ setCursor st sast
                         Nothing   -> fail $ "Cannot find tag " ++ show tag ++ "."
         Step -> do
             let ns = [ edge | edge@(s,_,_) <- vs_graph (cl_version st), s == cl_cursor st ]
@@ -203,7 +213,7 @@
                 [] -> fail "Cannot step forward (no more steps)."
                 [(_,cmd,d) ] -> do
                     putStrLn $ "step : " ++ unparseExprH cmd
-                    return $ st { cl_cursor = d }
+                    return $ setCursor st d 
                 _ -> fail "Cannot step forward (multiple choices)"
         Back -> do
             let ns = [ edge | edge@(_,_,d) <- vs_graph (cl_version st), d == cl_cursor st ]
@@ -211,7 +221,7 @@
                 []         -> fail "Cannot step backwards (no more steps)."
                 [(s,cmd,_) ] -> do
                     putStrLn $ "back, unstepping : " ++ unparseExprH cmd
-                    return $ st { cl_cursor = s }
+                    return $ setCursor st s
                 _          -> fail "Cannot step backwards (multiple choices, impossible!)."
         AddTag tag -> do
             return $ st { cl_version = (cl_version st) { vs_tags = (tag, cl_cursor st) : vs_tags (cl_version st) }}
diff --git a/src/HERMIT/Shell/Interpreter.hs b/src/HERMIT/Shell/Interpreter.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Shell/Interpreter.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE KindSignatures, GADTs, InstanceSigs, FlexibleContexts, ScopedTypeVariables #-}
+
+module HERMIT.Shell.Interpreter
+        ( -- * The HERMIT Interpreter
+          Interp
+        , interp
+        , interpExprH
+        ) where
+
+import Control.Monad.State
+
+import Data.Char
+import Data.Dynamic
+import qualified Data.Map as M
+
+import HERMIT.External
+import HERMIT.Parser
+import HERMIT.Kure (deprecatedIntToPathT,pathToSnocPath)
+
+import HERMIT.Shell.Types
+
+-- | Interpret an 'ExprH' by looking up the appropriate 'Dynamic'(s) in the provided 'Dictionary', then interpreting the 'Dynamic'(s) with the provided 'Interp's, returning the first interpretation to succeed (or an error string if none succeed).
+interpExprH :: MonadState CommandLineState m => [Interp a] -> ExprH -> m a
+interpExprH interps e = do 
+    dyns <- interpExpr e
+    runInterp e dyns interps
+
+runInterp :: Monad m => ExprH -> [Dynamic] -> [Interp b] -> m b
+runInterp e dyns interps = case [f a | Interp f <- interps, Just a <- map fromDynamic dyns] of
+                            []  -> fail $ "Does not type-check: " ++ unparseExprH e ++ "\n"
+                            b:_ -> return b
+
+-- | An 'Interp' @a@ is a /possible/ means of converting a 'Typeable' value to a value of type @a@.
+data Interp :: * -> * where
+   Interp :: Typeable a => (a -> b) -> Interp b
+
+-- | The primitive way of building an 'Interp'.
+interp :: Typeable a => (a -> b) -> Interp b
+interp = Interp
+
+instance Functor Interp where
+  fmap :: (a -> b) -> Interp a -> Interp b
+  fmap f (Interp g) = Interp (f . g)
+
+
+interpExpr :: MonadState CommandLineState m => ExprH -> m [Dynamic]
+interpExpr = interpExpr' False
+
+-- input: list length n, each elem is a variable length list of possible interpretations
+-- output: variable length list, each elem is list of length n
+fromDynList :: [[Dynamic]] -> [[Dynamic]]
+fromDynList [] = [[]]
+fromDynList (hs:dynss) = [ h:t | h <- hs, t <- fromDynList dynss ]
+
+toBoxedList :: (Extern a, Typeable b) => [[Dynamic]] -> ([a] -> b) -> [Dynamic]
+toBoxedList dyns boxCon = [ toDyn $ boxCon (map unbox l) | dl <- dyns, Just l <- [mapM fromDynamic dl] ]
+
+interpExpr' :: MonadState CommandLineState m => Bool -> ExprH -> m [Dynamic]
+interpExpr' _   (SrcName str) = return [ toDyn $ StringBox str ]
+interpExpr' _   (CoreH str)   = return [ toDyn $ CoreBox (CoreString str) ]
+interpExpr' _   (ListH exprs) = do 
+    dyns <- liftM fromDynList $ mapM (interpExpr' True) exprs
+    return $    toBoxedList dyns StringListBox
+             ++ toBoxedList dyns (PathBox . pathToSnocPath)
+                -- ugly hack.  The whole dynamic stuff could do with overhauling.
+             ++ toBoxedList dyns (TranslateCorePathBox . return . pathToSnocPath) 
+             ++ toBoxedList dyns IntListBox
+             ++ toBoxedList dyns RewriteCoreListBox
+
+interpExpr' rhs (CmdName str) 
+    | all isDigit str = do
+        let i = read str
+        return [ -- An Int is either a Path, or will be interpreted specially later.
+                 toDyn $ IntBox i
+                 -- TODO: Find a better long-term solution.
+               , toDyn $ TranslateCorePathBox (deprecatedIntToPathT i) 
+               ]
+    | otherwise = do
+        dict <- gets cl_dict
+        case M.lookup str dict of
+            Just dyns           -> do
+                dyns' <- mapM provideState dyns
+                return $ if rhs then toDyn (StringBox str) : dyns' else dyns'
+            -- not a command, try as a string arg... worst case: dynApply fails with "bad type of expression"
+            -- best case: 'help ls' works instead of 'help "ls"'. this is likewise done in the clause above
+            Nothing | rhs       -> return [toDyn $ StringBox str]
+                    | otherwise -> fail $ "User error, unrecognised HERMIT command: " ++ show str
+interpExpr' _ (AppH e1 e2) = liftM2 dynCrossApply (interpExpr' False e1) (interpExpr' True e2)
+
+-- We essentially treat externals of the type 'CommandLineState -> b' specially,
+-- providing them the shell state here, so they don't need a monadic return type
+-- in order to access it themselves.
+provideState :: MonadState CommandLineState m => Dynamic -> m Dynamic
+provideState dyn = do
+    st <- get
+    case dynApply dyn (toDyn $ box st) of
+        Just d  -> return d
+        Nothing -> return dyn
+
+-- Cross product of possible applications.
+dynCrossApply :: [Dynamic] -> [Dynamic] -> [Dynamic]
+dynCrossApply fs xs = [ r | f <- fs, x <- xs, Just r <- return (dynApply f x)]
+
+-------------------------------------------
diff --git a/src/HERMIT/Shell/Proof.hs b/src/HERMIT/Shell/Proof.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Shell/Proof.hs
@@ -0,0 +1,320 @@
+{-# LANGUAGE TypeFamilies, DeriveDataTypeable, FlexibleContexts, ScopedTypeVariables #-}
+
+module HERMIT.Shell.Proof where
+
+import Control.Arrow
+import Control.Monad.Error
+import Control.Monad.State
+
+import Data.Dynamic
+import Data.List
+import Data.Maybe (isNothing)
+
+import HERMIT.Core
+import HERMIT.External
+import HERMIT.GHC
+import HERMIT.Kernel.Scoped
+import HERMIT.Kure
+import HERMIT.Utilities
+
+import HERMIT.Dictionary.Common
+import HERMIT.Dictionary.Debug
+import HERMIT.Dictionary.Induction
+import HERMIT.Dictionary.Reasoning
+import HERMIT.Dictionary.Rules
+
+import HERMIT.Plugin.Types
+import HERMIT.PrettyPrinter.Common
+import qualified HERMIT.PrettyPrinter.Clean as Clean
+
+import HERMIT.Shell.ScriptToRewrite
+import HERMIT.Shell.Types
+
+import System.IO
+
+--------------------------------------------------------------------------------------------------------
+
+externals :: [External]
+externals =
+    [ external "script-to-proof" scriptToProof
+        [ "Convert a loaded script to an equality proof, by applying the script as a LHS to RHS rewrite." ]
+    , external "script-both-sides-to-proof" scriptBothSidesToProof
+        [ "Convert a pair of loaded scripts to a proof, by applying the first script to the LHS and the second script to the RHS." ]
+    , external "rewrite-to-proof" (rewriteToProof . extractR :: RewriteH Core -> ProofH)
+        [ "Convert a rewrite to an equality proof, by applying it to the LHS." ]
+    , external "rewrite-both-sides-to-proof" ((\ r1 r2 -> rewriteBothSidesToProof (extractR r1) (extractR r2)) :: RewriteH Core -> RewriteH Core -> ProofH)
+        [ "Convert a pair of rewrites to a proof, by applying the first rewrite to the LHS and the second rewrite to the RHS." ]
+    , external "lemma-to-proof" lemmaToProof
+        [ "Convert a (proven) lemma to an equality proof." ]
+    , external "inductive-proof" (inductiveProofExt :: String -> [String] -> [ScriptName] -> ProofH)
+        [ "inductive-proof <id-name> [<data-con-name>] [<script-name>]"
+        , "Build an equality proof by induction on the named identifier."
+        , "Takes a list of proofs (in the form of scripts converting the LHS to the RHS) for each data constructor case,"
+        , "in the same order as the given list of data constructor names."
+        , "For example: inductive-proof 'xs [ '[] , ': ] [ \"NilCaseScript\" , \"ConsCaseScript\" ]"
+        , "The induction hypotheses are available for use under the names ind-hyp-0, ind-hyp-1, etc..."
+        ]
+    , external "inductive-proof-both-sides" (inductiveProofBothSidesExt :: String -> [String] -> [ScriptName] -> [ScriptName] -> ProofH)
+        [ "inductive-proof-both-sides <id-name> [<data-con-name>] [<script-name>] [<script-name>]"
+        , "As inductive-proof, but takes scripts to apply to the RHS of each case as well as the LHS."
+        ]
+    , external "flip-proof" flipProof
+        [ "Flip the LHS and RHS of a proof."
+        , "Example usage: flip-proof (rewrite-to-proof r)"
+        ]
+    , external "rule-to-lemma" RuleToLemma
+        [ "Create a lemma from a GHC RULE." ]
+    , external "show-lemmas" ShowLemmas
+        [ "List lemmas." ]
+    , external "lemma" ((\s -> promoteExprBiR . lemma False s) :: CommandLineState -> LemmaName -> BiRewriteH Core)
+        [ "Generate a bi-directional rewrite from a proven lemma." ]
+    , external "lemma-unsafe" ((\s -> promoteExprBiR . lemma True s) :: CommandLineState -> LemmaName -> BiRewriteH Core)
+        [ "Generate a bi-directional rewrite from a lemma, even if it is unproven." ]
+    , external "verify-lemma" VerifyLemma
+        [ "Prove a lemma." ]
+    , external "lemma-lhs-intro" (lemmaLhsIntroR :: CommandLineState -> LemmaName -> RewriteH Core)
+        [ "Introduce the LHS of a lemma as a non-recursive binding, in either an expression or a program."
+        , "body ==> let v = lhs in body" ] .+ Introduce .+ Shallow
+    , external "lemma-rhs-intro" (lemmaRhsIntroR :: CommandLineState -> LemmaName -> RewriteH Core)
+        [ "Introduce the RHS of a lemma as a non-recursive binding, in either an expression or a program."
+        , "body ==> let v = rhs in body" ] .+ Introduce .+ Shallow
+    ]
+
+--------------------------------------------------------------------------------------------------------
+
+data ProofH = RewritingProof ScriptOrRewrite ScriptOrRewrite                                             -- ^ Prove by rewriting both sides to a common intermediate expression.
+            | InductiveProof (Id -> Bool) [((Maybe DataCon -> Bool), ScriptOrRewrite, ScriptOrRewrite)]  -- ^ Prove by induction.  'Nothing' is the 'undefined' case.
+            | UserProof (TranslateH CoreExprEquality ())                                                 -- ^ A user-defined proof technique.
+            | ProofH (CoreExprEquality -> CLT IO ())                                                     -- ^ User-defined proof with full access to shell monad stack.
+
+type ScriptOrRewrite = Either ScriptName (RewriteH CoreExpr) -- The named script should be convertible to a Rewrite.
+
+--------------------------------------------------------------------------------------------------------
+
+data ProofCommand
+    = RuleToLemma RuleNameString
+    | VerifyLemma LemmaName ProofH
+    | ShowLemmas
+    deriving (Typeable)
+
+instance Extern ProofCommand where
+    type Box ProofCommand = ProofCommand
+    box i = i
+    unbox i = i
+
+data ProofBox = ProofBox ProofH deriving Typeable
+
+instance Extern ProofH where
+    type Box ProofH = ProofBox
+    box = ProofBox
+    unbox (ProofBox p) = p
+
+--------------------------------------------------------------------------------------------------------
+
+-- | Verify an equality by applying a user-supplied predicate.
+--   If the predicate holds, HERMIT accepts the equality as proven.
+userProofTechnique :: TranslateH CoreExprEquality () -> ProofH
+userProofTechnique = UserProof
+
+--------------------------------------------------------------------------------------------------------
+
+scriptToProof :: ScriptName -> ProofH
+scriptToProof s = RewritingProof (Left s) (Right idR)
+
+scriptBothSidesToProof :: ScriptName -> ScriptName -> ProofH
+scriptBothSidesToProof s1 s2 = RewritingProof (Left s1) (Left s2)
+
+rewriteToProof :: RewriteH CoreExpr -> ProofH
+rewriteToProof r = RewritingProof (Right r) (Right idR)
+
+rewriteBothSidesToProof :: RewriteH CoreExpr -> RewriteH CoreExpr -> ProofH
+rewriteBothSidesToProof r1 r2 = RewritingProof (Right r1) (Right r2)
+
+--------------------------------------------------------------------------------------------------------
+
+inductiveProof :: (Id -> Bool) -> [((Maybe DataCon -> Bool), ScriptName)] -> ProofH
+inductiveProof p cases = InductiveProof p (map (\ (dp,s) -> (dp, Left s, Right idR)) cases)
+
+inductiveProofBothSides :: (Id -> Bool) -> [((Maybe DataCon -> Bool), ScriptName, ScriptName)] -> ProofH
+inductiveProofBothSides p cases = InductiveProof p (map (\ (dp,s1,s2) -> (dp, Left s1, Left s2)) cases)
+
+--------------------------------------------------------------------------------------------------------
+
+-- inductiveProofExt :: String -> [(String, ScriptName)] -> ProofH
+-- inductiveProofExt idn cases = inductiveProof (cmpString2Var idn) [ ((cmpString2Name dcn . dataConName), sn) | (dcn,sn) <- cases ]
+
+-- TODO: Upgrade the parser so that this can be a list of pairs.
+inductiveProofExt :: String -> [String] -> [ScriptName] -> ProofH
+inductiveProofExt idn dcns sns = inductiveProof (cmpString2Var idn) (zip (caseNamePreds dcns) sns)
+
+-- inductiveProofBothSidesExt :: String -> [(String, ScriptName, ScriptName)] -> ProofH
+-- inductiveProofBothSidesExt idn cases = inductiveProofBothSides (cmpString2Var idn) [ ((cmpString2Name dcn . dataConName), sln, srn) | (dcn,sln,srn) <- cases ]
+
+-- TODO: Upgrade the parser so that this can be a list of triples.
+inductiveProofBothSidesExt :: String -> [String] -> [ScriptName] -> [ScriptName] -> ProofH
+inductiveProofBothSidesExt idn dcns s1ns s2ns = inductiveProofBothSides (cmpString2Var idn) (zip3 (caseNamePreds dcns) s1ns s2ns)
+
+-- isNothing for the undefined case
+caseNamePreds :: [String] -> [Maybe DataCon -> Bool]
+caseNamePreds dcns = isNothing : [ maybe False (cmpString2Name dcn . dataConName) | dcn <- dcns ]
+
+--------------------------------------------------------------------------------------------------------
+
+flipProof :: ProofH -> ProofH
+flipProof (RewritingProof sr1 sr2)   = RewritingProof sr2 sr1
+flipProof (InductiveProof pr cases)  = InductiveProof pr [ (dp,s2,s1) | (dp,s1,s2) <- cases ]
+flipProof (UserProof t)              = UserProof (arr flipCoreExprEquality >>> t)
+flipProof (ProofH p)                 = ProofH (p . flipCoreExprEquality)
+
+--------------------------------------------------------------------------------------------------------
+
+getLemmaByName :: Monad m => CommandLineState -> LemmaName -> m Lemma
+getLemmaByName st nm =
+    case [ lm | lm@(n,_,_) <- cl_lemmas st, n == nm ] of
+        []    -> fail ("No lemma named: " ++ nm)
+        (l:_) -> return l
+
+lemma :: Bool -> CommandLineState -> LemmaName -> BiRewriteH CoreExpr
+lemma ok st nm = beforeBiR
+                   (do (_,equality,proven) <- getLemmaByName st nm
+                       guardMsg (proven || ok) ("Lemma " ++ nm ++ " has not been proven.")
+                       return equality
+                   )
+                   birewrite
+
+lemmaToProof :: CommandLineState -> LemmaName -> ProofH
+lemmaToProof st nm = rewriteToProof (forwardT (lemma False st nm))
+
+--------------------------------------------------------------------------------------------------------
+
+lemmaNameToEqualityT :: Monad m => CommandLineState -> LemmaName -> m CoreExprEquality
+lemmaNameToEqualityT st nm =
+  do (_,eq,_) <- getLemmaByName st nm
+     return eq
+
+-- | @e@ ==> @let v = lhs in e@  (also works in a similar manner at Program nodes)
+lemmaLhsIntroR :: CommandLineState -> LemmaName -> RewriteH Core
+lemmaLhsIntroR st = lemmaNameToEqualityT st >=> eqLhsIntroR
+
+-- | @e@ ==> @let v = rhs in e@  (also works in a similar manner at Program nodes)
+lemmaRhsIntroR :: CommandLineState -> LemmaName -> RewriteH Core
+lemmaRhsIntroR st = lemmaNameToEqualityT st >=> eqRhsIntroR
+
+--------------------------------------------------------------------------------------------------------
+
+performProofCommand :: MonadIO m => ProofCommand -> CLT m ()
+performProofCommand (RuleToLemma nm) = do
+    st <- gets cl_pstate
+    equality <- queryS (ps_kernel st) (ruleNameToEqualityT nm :: TranslateH Core CoreExprEquality) (mkKernelEnv st) (ps_cursor st)
+    modify $ \ s -> s { cl_lemmas = (nm,equality,False) : cl_lemmas s }
+
+performProofCommand (VerifyLemma nm proof) = do
+    st <- get
+    (_,equality,_) <- getLemmaByName st nm
+    prove equality proof -- this is like a guard
+    markProven nm
+
+performProofCommand ShowLemmas = gets cl_lemmas >>= \ ls -> forM_ (reverse ls) printLemma
+
+printLemma :: MonadIO m => Lemma -> CLT m ()
+printLemma (nm, CoreExprEquality bs lhs rhs, proven) = do
+    st <- gets cl_pstate
+    let k    = ps_kernel st
+        env  = mkKernelEnv st
+        sast = ps_cursor st
+        pos  = ps_pretty_opts st
+        pp   = ps_pretty st
+        pr :: [Var] -> CoreExpr -> TranslateH Core DocH
+        pr vs e = return e >>> withVarsInScope vs (extractT $ liftPrettyH pos pp)
+    cl_putStr nm
+    cl_putStrLn $ if proven then " (Proven)" else " (Not Proven)"
+    unless (null bs) $ do
+        forallDoc <- queryS k (return bs >>> extractT (liftPrettyH pos Clean.ppForallQuantification) :: TranslateH Core DocH) env sast -- TODO: rather than hardwiring the Clean PP here, we should store a pretty printer in the shell state, which should match the main PP, and be updated correspondingly.
+        liftIO $ ps_render st stdout pos (Right forallDoc)
+    lDoc <- queryS k (pr bs lhs) env sast
+    rDoc <- queryS k (pr bs rhs) env sast
+    liftIO $ ps_render st stdout pos (Right lDoc)
+    cl_putStrLn "=="
+    liftIO $ ps_render st stdout pos (Right rDoc)
+    cl_putStrLn ""
+
+--------------------------------------------------------------------------------------------------------
+
+-- | Prove a lemma using the given proof in the current kernel context.
+-- Required to fail if proof fails.
+prove :: MonadIO m => CoreExprEquality -> ProofH -> CLT m ()
+prove eq (RewritingProof lp rp) = do
+    (lrr, rrr) <- getRewrites (lp, rp)
+    st <- gets cl_pstate
+    queryS (ps_kernel st) (return eq >>> verifyCoreExprEqualityT (lrr, rrr) :: TranslateH Core ()) (mkKernelEnv st) (ps_cursor st)
+
+-- InductiveProof (Id -> Bool) [((DataCon -> Bool), ScriptOrRewrite, ScriptOrRewrite)]
+-- inductionOnT :: forall c. (AddBindings c, ReadBindings c, ReadPath c Crumb, ExtendPath c Crumb, Walker c Core)
+--              => (Id -> Bool)
+--              -> (DataCon -> [BiRewrite c HermitM CoreExpr] -> CoreExprEqualityProof c HermitM)
+--              -> Translate c HermitM CoreExprEquality ()
+prove eq@(CoreExprEquality bs lhs rhs) (InductiveProof idPred caseProofs) = do
+    st <- get
+    let ps = cl_pstate st
+
+    i <- setFailMsg "specified identifier is not universally quantified in this equality lemma." $ soleElement (filter idPred bs)
+    cases <- queryS (ps_kernel ps) (inductionCaseSplit bs i lhs rhs :: TranslateH Core [(Maybe DataCon,[Var],CoreExpr,CoreExpr)]) (mkKernelEnv ps) (ps_cursor ps)
+
+    forM_ cases $ \ (mdc,vs,lhsE,rhsE) -> do
+
+        (lp,rp) <- getProofsForCase mdc caseProofs
+
+        let vs_matching_i_type = filter (typeAlphaEq (varType i) . varType) vs
+            -- Generate list of specialized induction hypotheses for the recursive cases.
+            eqs = [ discardUniVars $ instantiateCoreExprEqVar i (Var i') eq
+                  | i' <- vs_matching_i_type ]
+            brs = map birewrite eqs
+            nms = [ "ind-hyp-" ++ show n | n :: Int <- [0..] ]
+
+        forM_ [ (nm, e, True) | (nm,e) <- zip nms eqs ] printLemma
+        catchError (do put $ addToDict (zip nms brs) st
+                       (l,r) <- getRewrites (lp,rp)
+                       prove (CoreExprEquality (delete i bs ++ vs) lhsE rhsE) (rewriteBothSidesToProof l r) -- recursion!
+                   )
+                   (\ err -> put st >> throwError err)
+        put st -- put original state (with original dictionary) back
+
+prove eq (UserProof t) =
+  do st <- gets cl_pstate
+     queryS (ps_kernel st) (return eq >>> t :: TranslateH Core ()) (mkKernelEnv st) (ps_cursor st)
+
+prove eq (ProofH p) = clm2clt (p eq)
+
+getProofsForCase :: Monad m => Maybe DataCon -> [(Maybe DataCon -> Bool, ScriptOrRewrite, ScriptOrRewrite)] -> m (ScriptOrRewrite, ScriptOrRewrite)
+getProofsForCase mdc cases =
+  let dcnm = maybe "undefined" getOccString mdc
+   in case [ (l,r) | (dcPred, l, r) <- cases, dcPred mdc ] of
+        []  -> fail $ "no case for " ++ dcnm
+        [p] -> return p
+        _   -> fail $ "more than one case for " ++ dcnm
+
+addToDict :: [(String, BiRewriteH CoreExpr)] -> CommandLineState -> CommandLineState
+addToDict rs st = st { cl_dict = foldr (\ (nm,r) -> addToDictionary (external nm (promoteExprBiR (beforeBiR (observeR ("Applying " ++ nm ++ " to: ")) (const r)) :: BiRewriteH Core) [])) (cl_dict st) rs }
+
+{-
+       let verifyInductiveCaseT :: (DataCon,[Var],CoreExpr,CoreExpr) -> Translate c HermitM x ()
+           verifyInductiveCaseT (con,vs,lhsE,rhsE) =
+                let vs_matching_i_type = filter (typeAlphaEq (varType i) . varType) vs
+                    eqs = [ discardUniVars (instantiateCoreExprEq [(i,Var i')] eq) | i' <- vs_matching_i_type ]
+                    brs = map birewrite eqs -- These eqs now have no universally quantified variables.
+                                            -- Thus they can only be used on variables in the induction hypothesis.
+                                            -- TODO: consider whether this is unneccassarily restrictive
+                    caseEq = CoreExprEquality (delete i bs ++ vs) lhsE rhsE
+                in return caseEq >>> verifyCoreExprEqualityT (genCaseAltProofs con brs)
+
+       mapM_ verifyInductiveCaseT cases
+-}
+
+getRewrites :: MonadState CommandLineState m => (ScriptOrRewrite, ScriptOrRewrite) -> m (RewriteH CoreExpr, RewriteH CoreExpr)
+getRewrites (l,r) = liftM2 (,) (getRewrite l) (getRewrite r)
+
+getRewrite :: MonadState CommandLineState m => ScriptOrRewrite -> m (RewriteH CoreExpr)
+getRewrite = either (lookupScript >=> liftM extractR . scriptToRewrite) return
+
+markProven :: MonadState CommandLineState m => LemmaName -> m ()
+markProven nm = modify $ \ st -> st { cl_lemmas = [ (n,e, if n == nm then True else p) | (n,e,p) <- cl_lemmas st ] }
diff --git a/src/HERMIT/Shell/Renderer.hs b/src/HERMIT/Shell/Renderer.hs
deleted file mode 100644
--- a/src/HERMIT/Shell/Renderer.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-module HERMIT.Shell.Renderer where
-
-import Data.List (isPrefixOf)
-import Data.Monoid
-
-import HERMIT.Kure
-import HERMIT.PrettyPrinter.Common
-
-import HERMIT.Shell.Types
-
-import System.Console.ANSI
-import System.IO
-
-
-showRenderers :: QueryFun
-showRenderers = message $ "set-renderer " ++ show (map fst shellRenderers)
-
-changeRenderer :: String -> ShellEffect
-changeRenderer renderer = CLSModify $ \ st ->
-        case lookup renderer shellRenderers of
-          Nothing -> return st          -- TODO: should fail with message
-          Just r  -> return $ st { cl_render = r }
-
--------------------------------------------------------------------------------
-
-newtype UnicodeTerminal = UnicodeTerminal (Handle -> Maybe PathH -> IO ())
-
-instance RenderSpecial UnicodeTerminal where
-        renderSpecial sym = UnicodeTerminal $ \ h _ -> hPutStr h [ch]
-                where (Unicode ch) = renderSpecial sym
-
-instance Monoid UnicodeTerminal where
-        mempty = UnicodeTerminal $ \ _ _ -> return ()
-        mappend (UnicodeTerminal f1) (UnicodeTerminal f2) = UnicodeTerminal $ \ h p -> f1 h p >> f2 h p
-
-shellRenderers :: [(String,Handle -> PrettyOptions -> Either String DocH -> IO ())]
-shellRenderers = [ ("unicode-terminal", unicodeConsole) ]
-              ++ [ (nm, \ h opts -> either (hPutStr h) (hPutStr h . fn opts)) | (nm,fn) <- coreRenders ]
-
-unicodeConsole :: Handle -> PrettyOptions -> Either String DocH -> IO ()
-unicodeConsole h _    (Left str)  = hPutStr h str
-unicodeConsole h opts (Right doc) = let UnicodeTerminal r = renderCode opts doc
-                                     in r h $ po_focus opts
-
-doSGR :: [SGR] -> UnicodeTerminal
-doSGR cmds = UnicodeTerminal $ \ h _ -> hSetSGR h cmds
-
-undoSGRWith :: [SGR] -> [Attr] -> UnicodeTerminal
-undoSGRWith cmds stk = doSGR cmds `mappend` rDoHighlight Nothing stk
-
-setHighlight :: PathH -> Handle -> Maybe PathH -> IO ()
-setHighlight _ _ Nothing   = return ()
-setHighlight p h (Just fp) = hSetSGR h (if fp `isPrefixOf` p then [ SetUnderlining SingleUnderline ] else [ Reset ])
-
-instance RenderCode UnicodeTerminal where
-        rPutStr txt  = UnicodeTerminal $ \ h _ -> hPutStr h txt
-
-        -- TODO: if we want an inplace CLI... rStart = UnicodeTerminal $ \ h _ -> hClearScreen h >> hSetCursorPosition h 0 0
-        rEnd = UnicodeTerminal $ \ h _ -> hSetSGR h [ Reset ] >> hPutStrLn h ""
-
-        -- anything that doesn't just change the foreground color needs to end itself cleanly
-        rDoHighlight (Just (Color KeywordColor)) stk = undoSGRWith [SetConsoleIntensity NormalIntensity] stk
-        rDoHighlight (Just (Color WarningColor)) stk = undoSGRWith [SetSwapForegroundBackground False] stk
-        rDoHighlight _ [] = doSGR [ Reset ]
-        rDoHighlight _ (Color col:_) =
-            doSGR $ case col of
-                        KeywordColor  -> [ SetConsoleIntensity BoldIntensity
-                                         , SetColor Foreground Dull Blue
-                                         ]
-                        SyntaxColor   -> [ SetColor Foreground Dull Red ]
-                        IdColor       -> [] -- equivalent to Reset
-                        CoercionColor -> [ SetColor Foreground Dull Yellow ]
-                        TypeColor     -> [ SetColor Foreground Dull Green ]
-                        LitColor      -> [ SetColor Foreground Dull Cyan ]
-                        WarningColor  -> [ SetSwapForegroundBackground True, SetColor Foreground Vivid Yellow ]
--- TODO: enable        rDoHighlight _ (PathAttr p:_) = UnicodeTerminal $ setHighlight $ snocPathToPath p
-        rDoHighlight o (_:rest) = rDoHighlight o rest
-
diff --git a/src/HERMIT/Shell/ScriptToRewrite.hs b/src/HERMIT/Shell/ScriptToRewrite.hs
--- a/src/HERMIT/Shell/ScriptToRewrite.hs
+++ b/src/HERMIT/Shell/ScriptToRewrite.hs
@@ -1,28 +1,39 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
 
 module HERMIT.Shell.ScriptToRewrite
   ( -- * Converting Scripts to Rewrites
     addScriptToDict
+  , lookupScript
+  , scriptToRewrite
   )
 where
 
 import Control.Arrow
-import Control.Monad (liftM)
+import Control.Monad.State
 
 import Data.Dynamic
-import Data.Map
+import Data.Map hiding (lookup)
 
 import HERMIT.Context(LocalPathH)
 import HERMIT.Kure
 import HERMIT.External
-import HERMIT.Interp
-import HERMIT.Parser(Script)
+import HERMIT.Parser(Script, ExprH, unparseExprH)
 
 import HERMIT.PrettyPrinter.Common(TranslateCoreTCDocHBox(..))
+
+import HERMIT.Shell.Interpreter
 import HERMIT.Shell.Types
 
 ------------------------------------
 
+lookupScript :: MonadState CommandLineState m => ScriptName -> m Script
+lookupScript scriptName = do scripts <- gets cl_scripts
+                             case lookup scriptName scripts of
+                               Nothing     -> fail $ "No script of name " ++ scriptName ++ " is loaded."
+                               Just script -> return script
+
+------------------------------------
+
 data UnscopedScriptR
               = ScriptBeginScope
               | ScriptEndScope
@@ -31,7 +42,7 @@
 
 data ScopedScriptR
               = ScriptScope [ScopedScriptR]
-              | ScriptPrimSc PrimScriptR
+              | ScriptPrimSc ExprH PrimScriptR
 
 data PrimScriptR
        = ScriptRewriteHCore (RewriteH Core)
@@ -40,33 +51,36 @@
 
 
 -- TODO: Hacky parsing, needs cleaning up
-unscopedToScopedScriptR :: forall m. Monad m => [UnscopedScriptR] -> m [ScopedScriptR]
+unscopedToScopedScriptR :: forall m. Monad m => [(ExprH, UnscopedScriptR)] -> m [ScopedScriptR]
 unscopedToScopedScriptR = parse
   where
-    parse :: [UnscopedScriptR] -> m [ScopedScriptR]
+    parse :: [(ExprH, UnscopedScriptR)] -> m [ScopedScriptR]
     parse []     = return []
     parse (y:ys) = case y of
-                     ScriptUnsupported msg -> fail ("script contains " ++ msg ++ " which cannot be converted to a rewrite.")
-                     ScriptPrimUn pr       -> (ScriptPrimSc pr :) <$> parse ys
-                     ScriptBeginScope      -> do (rs,zs) <- parseUntilEndScope ys
-                                                 (ScriptScope rs :) <$> parse zs
-                     ScriptEndScope        -> fail "unmatched end-of-scope."
+                     (e, ScriptUnsupported msg) -> fail $ mkMsg e msg
+                     (e, ScriptPrimUn pr)       -> (ScriptPrimSc e pr :) <$> parse ys
+                     (_, ScriptBeginScope)      -> do (rs,zs) <- parseUntilEndScope ys
+                                                      (ScriptScope rs :) <$> parse zs
+                     (_, ScriptEndScope)        -> fail "unmatched end-of-scope."
 
-    parseUntilEndScope :: Monad m => [UnscopedScriptR] -> m ([ScopedScriptR], [UnscopedScriptR])
+    parseUntilEndScope :: Monad m => [(ExprH, UnscopedScriptR)] -> m ([ScopedScriptR], [(ExprH, UnscopedScriptR)])
     parseUntilEndScope []     = fail "missing end-of-scope."
     parseUntilEndScope (y:ys) = case y of
-                                  ScriptEndScope        -> return ([],ys)
-                                  ScriptBeginScope      -> do (rs,zs)  <- parseUntilEndScope ys
-                                                              first (ScriptScope rs :) <$> parseUntilEndScope zs
-                                  ScriptPrimUn pr       -> first (ScriptPrimSc pr :) <$> parseUntilEndScope ys
-                                  ScriptUnsupported msg -> fail ("script contains " ++ msg ++ ", which cannot be converted to a rewrite.")
+                                  (_, ScriptEndScope)        -> return ([],ys)
+                                  (_, ScriptBeginScope)      -> do (rs,zs)  <- parseUntilEndScope ys
+                                                                   first (ScriptScope rs :) <$> parseUntilEndScope zs
+                                  (e, ScriptPrimUn pr)       -> first (ScriptPrimSc e pr :) <$> parseUntilEndScope ys
+                                  (e, ScriptUnsupported msg) -> fail $ mkMsg e msg
 
+    mkMsg :: ExprH -> String -> String
+    mkMsg e msg = "script cannot be converted to a rewrite because it contains the following " ++ msg ++ ": " ++ unparseExprH e
+
 -----------------------------------
 
 interpScriptR :: [Interp UnscopedScriptR]
 interpScriptR =
   [ interp (\ (RewriteCoreBox r)           -> ScriptPrimUn $ ScriptRewriteHCore r)
-  , interp (\ (RewriteCoreTCBox _)         -> ScriptUnsupported "rewrites that traverse types and coercions") -- TODO
+  , interp (\ (RewriteCoreTCBox _)         -> ScriptUnsupported "rewrite that traverses types and coercions") -- TODO
   , interp (\ (BiRewriteCoreBox br)        -> ScriptPrimUn $ ScriptRewriteHCore $ forwardT br)
   , interp (\ (CrumbBox cr)                -> ScriptPrimUn $ ScriptPath [cr])
   , interp (\ (PathBox p)                  -> ScriptPrimUn $ ScriptPath (snocPathToPath p))
@@ -74,15 +88,14 @@
   , interp (\ (effect :: KernelEffect)     -> case effect of
                                                 BeginScope -> ScriptBeginScope
                                                 EndScope   -> ScriptEndScope
-                                                _          -> ScriptUnsupported "Kernel effects" )
-  , interp (\ (_ :: MetaCommand)           -> ScriptUnsupported "meta commands")
-  , interp (\ (_ :: ShellEffect)           -> ScriptUnsupported "shell effects")
-  , interp (\ (_ :: QueryFun)              -> ScriptUnsupported "queries")
-  , interp (\ (TranslateCoreStringBox _)   -> ScriptUnsupported "queries")
-  , interp (\ (TranslateCoreTCStringBox _) -> ScriptUnsupported "queries")
-  , interp (\ (TranslateCoreTCDocHBox _)   -> ScriptUnsupported "queries")
-  , interp (\ (TranslateCoreCheckBox _)    -> ScriptUnsupported "predicates")
-  , interp (\ (StringBox _)                -> ScriptUnsupported "messages")
+                                                _          -> ScriptUnsupported "Kernel effect" )
+  , interp (\ (_ :: ShellEffect)           -> ScriptUnsupported "shell effect")
+  , interp (\ (_ :: QueryFun)              -> ScriptUnsupported "query")
+  , interp (\ (TranslateCoreStringBox _)   -> ScriptUnsupported "query")
+  , interp (\ (TranslateCoreTCStringBox _) -> ScriptUnsupported "query")
+  , interp (\ (TranslateCoreTCDocHBox _)   -> ScriptUnsupported "query")
+  , interp (\ (TranslateCoreCheckBox _)    -> ScriptUnsupported "predicate")
+  , interp (\ (StringBox _)                -> ScriptUnsupported "message")
   ]
 
 -----------------------------------
@@ -90,31 +103,37 @@
 scopedScriptsToRewrite :: [ScopedScriptR] -> RewriteH Core
 scopedScriptsToRewrite []        = idR
 scopedScriptsToRewrite (x : xs)  = let rest = scopedScriptsToRewrite xs
+                                       failWith e = prefixFailMsg ("Error in script expression: " ++ unparseExprH e ++ "\n") 
                                    in case x of
-                                        ScriptScope ys   -> scopedScriptsToRewrite ys >>> rest
-                                        ScriptPrimSc pr  -> case pr of
-                                                              ScriptRewriteHCore r       -> r >>> rest
-                                                              ScriptPath p               -> pathR p rest
-                                                              ScriptTranslateHCorePath t -> do p <- t
+                                        ScriptScope ys    -> scopedScriptsToRewrite ys >>> rest
+                                        ScriptPrimSc e pr -> case pr of
+                                                              ScriptRewriteHCore r       -> failWith e r >>> rest
+                                                              ScriptPath p               -> failWith e $ pathR p rest
+                                                              ScriptTranslateHCorePath t -> do p <- failWith e t
                                                                                                localPathR p rest
 
 -----------------------------------
 
+scriptToRewrite :: MonadState CommandLineState m => Script -> m (RewriteH Core)
+scriptToRewrite scr = do
+    unscoped <- mapM (interpExprH interpScriptR) scr
+    scoped   <- unscopedToScopedScriptR $ zip scr unscoped
+    return $ scopedScriptsToRewrite scoped
+
 -----------------------------------
 
 -- | Insert a script into the 'Dictionary'.
-addScriptToDict :: Monad m => ScriptName -> Script -> Dictionary -> m Dictionary
-addScriptToDict nm scr dict =
-  do unscoped <- mapM (interpExprH dict interpScriptR) scr
-     scoped   <- unscopedToScopedScriptR unscoped
-     let
-         dyn = toDyn (box $ scopedScriptsToRewrite scoped)
+addScriptToDict :: MonadState CommandLineState m => ScriptName -> Script -> m ()
+addScriptToDict nm scr = do
+    r <- scriptToRewrite scr
 
-         alteration :: Maybe [Dynamic] -> Maybe [Dynamic]
-         alteration Nothing     = Just [dyn]
-         alteration (Just dyns) = Just (dyn:dyns)
+    let dyn = toDyn (box r)
 
-     return $ alter alteration nm dict
+        alteration :: Maybe [Dynamic] -> Maybe [Dynamic]
+        alteration Nothing     = Just [dyn]
+        alteration (Just dyns) = Just (dyn:dyns)
+
+    modify $ \ st -> st { cl_dict = alter alteration nm (cl_dict st) }
 
 -----------------------------------
 
diff --git a/src/HERMIT/Shell/Types.hs b/src/HERMIT/Shell/Types.hs
--- a/src/HERMIT/Shell/Types.hs
+++ b/src/HERMIT/Shell/Types.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE KindSignatures, GADTs, FlexibleContexts, TypeFamilies, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP, KindSignatures, GADTs, FlexibleContexts, TypeFamilies,
+             DeriveDataTypeable, GeneralizedNewtypeDeriving, LambdaCase,
+             ScopedTypeVariables #-}
 
 module HERMIT.Shell.Types where
 
@@ -9,25 +11,31 @@
 
 import Data.Dynamic
 import qualified Data.Map as M
+import Data.Monoid (mempty)
 
 import HERMIT.Context
 import HERMIT.Kure
 import HERMIT.External
 import qualified HERMIT.GHC as GHC
 import HERMIT.Kernel.Scoped
+import HERMIT.Monad
 import HERMIT.Parser
 import HERMIT.PrettyPrinter.Common
 
-import System.IO
+import HERMIT.Plugin.Display
+import HERMIT.Plugin.Types
 
-----------------------------------------------------------------------------------
+import HERMIT.Dictionary.Reasoning (CoreExprEquality)
 
--- | There are four types of commands.
-data ShellCommand =  KernelEffect KernelEffect -- ^ Command that modifies the state of the (scoped) kernel.
-                  |  ShellEffect  ShellEffect  -- ^ Command that modifies the state of the shell.
-                  |  QueryFun     QueryFun     -- ^ Command that queries the AST with a Translate (read only).
-                  |  MetaCommand  MetaCommand  -- ^ Command that otherwise controls HERMIT (abort, resume, save, etc).
+import System.IO (Handle)
 
+#ifndef mingw32_HOST_OS
+import Data.Maybe (fromMaybe)
+import System.Console.Terminfo (setupTermFromEnv, getCapability, termColumns, termLines)
+#endif
+
+----------------------------------------------------------------------------------
+
 -- GADTs can't have docs on constructors. See Haddock ticket #43.
 -- | KernelEffects are things that affect the state of the Kernel
 --   - Apply a rewrite (giving a whole new lower-level AST).
@@ -51,14 +59,13 @@
    box i = i
    unbox i = i
 
-data ShellEffect :: * where
-   CLSModify :: (CommandLineState -> IO CommandLineState) -> ShellEffect
-   deriving Typeable
+----------------------------------------------------------------------------------
 
 data QueryFun :: * where
    QueryString   :: (Injection GHC.ModGuts g, Walker HermitC g)
                  => TranslateH g String                                   -> QueryFun
    QueryDocH     :: (PrettyC -> PrettyH CoreTC -> TranslateH CoreTC DocH) -> QueryFun
+   Diff          :: SAST -> SAST                                          -> QueryFun
    Display       ::                                                          QueryFun
    Inquiry       :: (CommandLineState -> IO String)                       -> QueryFun
    deriving Typeable
@@ -71,33 +78,38 @@
    box i = i
    unbox i = i
 
+----------------------------------------------------------------------------------
+
 type RewriteName = String
 
-data MetaCommand
-   = Resume
-   | Abort
-   | Continue -- exit the shell, but don't abort/resume
-   | Diff SAST SAST
-   | Dump String String Int
-   | LoadFile ScriptName FilePath  -- load a file on top of the current node
-   | SaveFile FilePath
-   | ScriptToRewrite RewriteName ScriptName
-   | DefineScript ScriptName String
-   | RunScript ScriptName
-   | SaveScript FilePath ScriptName
-   | SeqMeta [MetaCommand]
-   deriving Typeable
+data ShellEffect
+    = Abort -- ^ Abort GHC
+    | CLSModify (CommandLineState -> IO CommandLineState) -- ^ Modify shell state
+    | PluginComp (PluginM ())
+    | Continue -- ^ exit the shell, but don't abort/resume
+    | DefineScript ScriptName String
+    | Dump String String Int
+    | LoadFile ScriptName FilePath  -- load a file on top of the current node
+    | RunScript ScriptName
+    | SaveFile FilePath
+    | SaveScript FilePath ScriptName
+    | ScriptToRewrite RewriteName ScriptName
+    | SeqMeta [ShellEffect]
+    | Resume
+    deriving Typeable
 
 -- | A composite meta-command for running a loaded script immediately.
 --   The script is given the same name as the filepath.
-loadAndRun :: FilePath -> MetaCommand
+loadAndRun :: FilePath -> ShellEffect
 loadAndRun fp = SeqMeta [LoadFile fp fp, RunScript fp]
 
-instance Extern MetaCommand where
-    type Box MetaCommand = MetaCommand
+instance Extern ShellEffect where
+    type Box ShellEffect = ShellEffect
     box i = i
     unbox i = i
 
+----------------------------------------------------------------------------------
+
 data VersionCmd = Back                  -- back (up) the derivation tree
                 | Step                  -- down one step; assumes only one choice
                 | Goto Int              -- goto a specific node, if possible
@@ -105,67 +117,103 @@
                 | AddTag String         -- add a tag
         deriving Show
 
-instance Extern ShellEffect where
-    type Box ShellEffect = ShellEffect
-    box i = i
-    unbox i = i
-
 ----------------------------------------------------------------------------------
 
 data CLException = CLAbort
                  | CLResume SAST
-                 | CLContinue CommandLineState
+                 | CLContinue CommandLineState -- TODO: needed?
                  | CLError String
 
-instance Error CLException where
-    strMsg = CLError
+instance Error CLException where strMsg = CLError
 
-newtype CLM m a = CLM { unCLM :: ErrorT CLException (StateT CommandLineState m) a }
+abort :: Monad m => CLT m ()
+abort = throwError CLAbort
+
+resume :: Monad m => SAST -> CLT m ()
+resume = throwError . CLResume
+
+continue :: Monad m => CommandLineState -> CLT m ()
+continue = throwError . CLContinue
+
+rethrowCLE :: CLException -> PluginM a
+rethrowCLE CLAbort         = throwError PAbort
+rethrowCLE (CLResume sast) = throwError (PResume sast)
+rethrowCLE (CLContinue s)  = put (cl_pstate s) >> return (error "CLContinue cannot return a value")
+rethrowCLE (CLError msg)   = throwError (PError msg)
+
+rethrowPE :: Monad m => PException -> CLT m a
+rethrowPE PAbort         = throwError CLAbort
+rethrowPE (PResume sast) = throwError (CLResume sast)
+rethrowPE (PError msg)   = throwError (CLError msg)
+
+----------------------------------------------------------------------------------
+
+-- | This type is similiar to PluginM, except that its exception and state types are
+-- supersets of those for PluginM, and it is a transformer. There are two functions: 
+-- `clm` and `pluginM` for converting between the two. The reason we do this is to obtain 
+-- a clean separation of plugin state from commandline state without nesting state 
+-- transformers. Nesting StateT leads to a lot of awkward lifting and manual state 
+-- management in the command line code.
+--
+-- NB: an alternative to monad transformers, like Oleg's Extensible Effects, might be useful here.
+newtype CLT m a = CLT { unCLT :: ErrorT CLException (StateT CommandLineState m) a }
     deriving (Functor, Applicative, MonadIO, MonadError CLException, MonadState CommandLineState)
 
--- | Our own custom instance of Monad for CLM m so we don't have to depend on
+instance MonadTrans CLT where
+    -- lift :: Monad m => m a -> CLT m a
+    lift = CLT . lift . lift
+
+-- TODO: type CLM = CLT IO
+
+-- | Our own custom instance of Monad for CLT so we don't have to depend on
 -- newtype deriving to do the right thing for fail.
-instance Monad m => Monad (CLM m) where
-    return = CLM . return
-    (CLM m) >>= k = CLM (m >>= unCLM . k)
-    fail = CLM . throwError . CLError
+instance Monad m => Monad (CLT m) where
+    return = CLT . return
+    (CLT m) >>= k = CLT (m >>= unCLT . k)
+    fail = CLT . throwError . CLError
 
-abort :: Monad m => CLM m ()
-abort = throwError CLAbort
+-- | Run a CLT computation.
+runCLT :: CommandLineState -> CLT m a -> m (Either CLException a, CommandLineState)
+runCLT s = flip runStateT s . runErrorT . unCLT
 
-resume :: Monad m => SAST -> CLM m ()
-resume = throwError . CLResume
+-- | Lift a CLT IO computation into a CLT computation over an arbitrary MonadIO.
+clm2clt :: MonadIO m => CLT IO a -> CLT m a
+clm2clt m = do
+    st <- get
+    (ea, st') <- liftIO (runCLT st m)
+    either throwError (\r -> put st' >> return r) ea
 
-continue :: Monad m => CommandLineState -> CLM m ()
-continue = throwError . CLContinue
+-- | Lift a CLM computation into the PluginM monad.
+clm :: CLT IO a -> PluginM a
+clm m = do
+    s <- mkCLS
+    (r,s') <- liftIO $ runCLT s m
+    case r of
+        Left err -> rethrowCLE err
+        Right r' -> put (cl_pstate s') >> return r'
 
-instance MonadTrans CLM where
-    lift = CLM . lift . lift
+-- | Lift a PluginM computation into the CLM monad.
+pluginM :: MonadIO m => PluginM a -> CLT m a
+pluginM m = do
+    s <- get
+    (r,ps) <- liftIO $ runPluginT (cl_pstate s) m
+    case r of
+        Left err -> rethrowPE err
+        Right r' -> put (s { cl_pstate = ps }) >> return r'
 
-instance Monad m => MonadCatch (CLM m) where
+instance Monad m => MonadCatch (CLT m) where
     -- law: fail msg `catchM` f == f msg
     -- catchM :: m a -> (String -> m a) -> m a
     catchM m f = do
         st <- get
-        (r,st') <- lift $ runCLM st m
+        (r,st') <- lift $ runCLT st m
         case r of
             Left err -> case err of
                             CLError msg -> f msg
-                            other -> throwError other -- rethrow abort/resume
+                            other -> throwError other -- rethrow abort/resume/continue
             Right v  -> put st' >> return v
 
-runCLM :: CommandLineState -> CLM m a -> m (Either CLException a, CommandLineState)
-runCLM s = flip runStateT s . runErrorT . unCLM
-
--- TODO: Come up with names for these, and/or better characterise these abstractions.
-iokm2clm' :: MonadIO m => String -> (a -> CLM m b) -> IO (KureM a) -> CLM m b
-iokm2clm' msg ret m = liftIO m >>= runKureM ret (throwError . CLError . (msg ++))
-
-iokm2clm :: MonadIO m => String -> IO (KureM a) -> CLM m a
-iokm2clm msg = iokm2clm' msg return
-
-iokm2clm'' :: MonadIO m => IO (KureM a) -> CLM m a
-iokm2clm'' = iokm2clm ""
+----------------------------------------------------------------------------------
 
 data VersionStore = VersionStore
     { vs_graph       :: [(SAST,ExprH,SAST)]
@@ -173,31 +221,129 @@
     }
 
 newSAST :: ExprH -> SAST -> CommandLineState -> CommandLineState
-newSAST expr sast st = st { cl_cursor = sast
-                          , cl_version = (cl_version st) { vs_graph = (cl_cursor st, expr, sast) : vs_graph (cl_version st) }
+newSAST expr sast st = st { cl_pstate  = pstate  { ps_cursor = sast }
+                          , cl_version = version { vs_graph = (ps_cursor pstate, expr, sast) : vs_graph version }
                           }
+    where pstate  = cl_pstate st
+          version = cl_version st
 
--- Session-local issues; things that are never saved.
+----------------------------------------------------------------------------------
+
+-- Session-local issues; things that are never saved (except the PluginState).
 data CommandLineState = CommandLineState
-    { cl_cursor         :: SAST                                     -- ^ the current AST
-    , cl_pretty         :: PrettyH CoreTC                           -- ^ which pretty printer to use
-    , cl_pretty_opts    :: PrettyOptions                            -- ^ the options for the pretty printer
-    , cl_render         :: Handle -> PrettyOptions -> Either String DocH -> IO () -- ^ the way of outputing to the screen
-    , cl_height         :: Int                                      -- ^ console height, in lines
-    , cl_nav            :: Bool                                     -- ^ keyboard input the nav panel
-    , cl_running_script :: Bool                                     -- ^ if running a script
-    , cl_tick           :: TVar (M.Map String Int)                  -- ^ the list of ticked messages
-    , cl_corelint       :: Bool                                     -- ^ if true, run Core Lint on module after each rewrite
-    , cl_diffonly       :: Bool                                     -- ^ if true, show diffs rather than pp full code
-    , cl_failhard       :: Bool                                     -- ^ if true, abort on *any* failure
-    , cl_window         :: PathH                                    -- ^ path to beginning of window, always a prefix of focus path in kernel
-    -- these four should be in a reader
-    , cl_dict           :: Dictionary
+    { cl_pstate         :: PluginState           -- ^ Access to the enclosing plugin state. This is propagated back
+                                                 --   to the plugin after the CLT computation ends. We do it this way
+                                                 --   because nested StateT is a pain.
+    , cl_height         :: Int                   -- ^ console height, in lines
     , cl_scripts        :: [(ScriptName,Script)]
-    , cl_kernel         :: ScopedKernel
-    , cl_initSAST       :: SAST
-    -- and the version store
+    , cl_lemmas         :: [Lemma]               -- ^ list of lemmas, with flag indicating whether proven
+    , cl_nav            :: Bool                  -- ^ keyboard input the nav panel
     , cl_version        :: VersionStore
-    }
+    , cl_window         :: PathH                 -- ^ path to beginning of window, always a prefix of focus path in kernel
+    , cl_dict           :: Dictionary
+    -- this should be in a reader
+    , cl_initSAST       :: SAST
+    } deriving (Typeable)
 
+-- To ease the pain of nested records, define some boilerplate here.
+cl_corelint :: CommandLineState -> Bool
+cl_corelint = ps_corelint . cl_pstate
+
+setCoreLint :: CommandLineState -> Bool -> CommandLineState
+setCoreLint st b = st { cl_pstate = (cl_pstate st) { ps_corelint = b } }
+
+cl_cursor :: CommandLineState -> SAST
+cl_cursor = ps_cursor . cl_pstate
+
+setCursor :: CommandLineState -> SAST -> CommandLineState
+setCursor st sast = st { cl_pstate = (cl_pstate st) { ps_cursor = sast } }
+
+cl_diffonly :: CommandLineState -> Bool
+cl_diffonly = ps_diffonly . cl_pstate
+
+setDiffOnly :: CommandLineState -> Bool -> CommandLineState
+setDiffOnly st b = st { cl_pstate = (cl_pstate st) { ps_diffonly = b } }
+
+cl_failhard :: CommandLineState -> Bool
+cl_failhard = ps_failhard . cl_pstate
+
+setFailHard :: CommandLineState -> Bool -> CommandLineState
+setFailHard st b = st { cl_pstate = (cl_pstate st) { ps_failhard = b } }
+
+cl_kernel :: CommandLineState -> ScopedKernel
+cl_kernel = ps_kernel . cl_pstate
+
+cl_kernel_env :: CommandLineState -> HermitMEnv
+cl_kernel_env = mkKernelEnv . cl_pstate
+
+cl_pretty :: CommandLineState -> PrettyH CoreTC
+cl_pretty = ps_pretty . cl_pstate
+
+setPretty :: CommandLineState -> PrettyH CoreTC -> CommandLineState
+setPretty st pp = st { cl_pstate = (cl_pstate st) { ps_pretty = pp } }
+
+cl_pretty_opts :: CommandLineState -> PrettyOptions
+cl_pretty_opts = ps_pretty_opts . cl_pstate
+
+setPrettyOpts :: CommandLineState -> PrettyOptions -> CommandLineState
+setPrettyOpts st po = st { cl_pstate = (cl_pstate st) { ps_pretty_opts = po } }
+
+cl_render :: CommandLineState -> (Handle -> PrettyOptions -> Either String DocH -> IO ())
+cl_render = ps_render . cl_pstate
+
+cl_running_script :: CommandLineState -> Bool
+cl_running_script = ps_running_script . cl_pstate
+
+-- | Create default CommandLineState from PluginState. 
+-- Note: the dictionary (cl_dict) will be empty, and should be populated if needed.
+mkCLS :: PluginM CommandLineState
+mkCLS = do
+    ps <- get
+    (w,h) <- liftIO getTermDimensions    
+    return $ CommandLineState { cl_pstate   = (ps { ps_pretty_opts = (ps_pretty_opts ps) { po_width = w } })
+                              , cl_height   = h
+                              , cl_scripts  = []
+                              , cl_lemmas   = []
+                              , cl_nav      = False
+                              , cl_version  = VersionStore { vs_graph = [] , vs_tags = [] }
+                              , cl_window   = mempty
+                              , cl_dict     = M.empty -- Note, empty dictionary.
+                              , cl_initSAST = ps_cursor ps
+                              }
+
+getTermDimensions :: IO (Int, Int)
+getTermDimensions = do
+#ifdef mingw32_HOST_OS
+    return (80,25) -- these are the standard windows CLI dimensions
+#else
+    term <- setupTermFromEnv
+    let w = fromMaybe 80 $ getCapability term termColumns
+        h = fromMaybe 25 $ getCapability term termLines
+    return (w,h)
+#endif
+
+newtype CLSBox = CLSBox CommandLineState deriving Typeable
+instance Extern CommandLineState where
+    type Box CommandLineState = CLSBox
+    unbox (CLSBox st) = st
+    box = CLSBox
+
 type ScriptName = String
+type LemmaName = String
+type Lemma = (LemmaName,CoreExprEquality,Bool)
+
+-- tick counter
+tick :: TVar (M.Map String Int) -> String -> IO Int
+tick var msg = atomically $ do
+        m <- readTVar var
+        let c = case M.lookup msg m of
+                    Nothing -> 1
+                    Just x  -> x + 1
+        writeTVar var (M.insert msg c m)
+        return c
+
+cl_putStr :: MonadIO m => String -> CLT m ()
+cl_putStr = pluginM . ps_putStr
+
+cl_putStrLn :: MonadIO m => String -> CLT m ()
+cl_putStrLn = pluginM . ps_putStrLn
diff --git a/src/HERMIT/Utilities.hs b/src/HERMIT/Utilities.hs
--- a/src/HERMIT/Utilities.hs
+++ b/src/HERMIT/Utilities.hs
@@ -1,9 +1,11 @@
 module HERMIT.Utilities
   ( -- * Utilities
     nodups
+  , soleElement
   , equivalentBy
   , equivalent
   , whenJust
+  , maybeM
   )
 where
 
@@ -14,6 +16,11 @@
 nodups []     = True
 nodups (a:as) = (a `notElem` as) && nodups as
 
+soleElement :: Monad m => [a] -> m a
+soleElement []  = fail "soleElement: list is empty."
+soleElement [a] = return a
+soleElement _   = fail "soleElement: multiple elements found."
+
 ------------------------------------------------------------------------------
 
 -- Drew: surely this exists generally somewhere?
@@ -36,5 +43,9 @@
 -- | Perform the monadic action only in the 'Just' case.
 whenJust :: Monad m => (a -> m ()) -> Maybe a -> m ()
 whenJust f = maybe (return ()) f
+
+-- | Lift a 'Maybe' into an arbitrary monad, using 'return' or 'fail'.
+maybeM :: Monad m => String -> Maybe a -> m a
+maybeM msg = maybe (fail msg) return
 
 ------------------------------------------------------------------------------