diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,6 @@
+# HERMIT [![Hackage version](https://img.shields.io/hackage/v/hermit.svg?style=flat)](http://hackage.haskell.org/package/hermit) [![Build Status](https://img.shields.io/travis/ku-fpg/hermit.svg?style=flat)](https://travis-ci.org/ku-fpg/hermit)
+
+The Haskell Equational Reasoning Model-to-Implementation Tunnel.
+
+## Links
+* http://www.ittc.ku.edu/csdl/fpg/Tools/HERMIT
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,6 +1,7 @@
 {-# OPTIONS_GHC -w #-}
 {-# OPTIONS -fglasgow-exts -cpp #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
 module HERMIT.ParserCore
     ( parseCore
     , parseCoreExprT
@@ -18,6 +19,7 @@
 import Control.Arrow
 import Control.Monad.Reader
 import Data.Char (isSpace, isDigit)
+import qualified Data.Map as M
 
 import HERMIT.Context
 import HERMIT.External
@@ -335,27 +337,35 @@
 
 ---------------------------------------------
 
-parseCore :: BoundVars c => CoreString -> c -> HermitM CoreExpr
+parseCore :: ReadBindings c => CoreString -> c -> HermitM CoreExpr
 parseCore (CoreString s) c =
     case lexer s of
         Left msg -> fail msg
-        Right tokens -> runReaderT (parser tokens) (boundVars c)
+        Right tokens ->
+            -- Since we are comparing occurrence names, only take the
+            -- most recently defined (deepest) when variables shadow each other.
+            let comb v1@(_,d1) v2@(_,d2) = if d1 > d2 then v1 else v2
+                vars = mkVarSet . map fst . M.elems
+                     $ M.mapKeysWith comb getOccString
+                     $ M.mapWithKey (\k -> (k,) . hbDepth)
+                     $ hermitBindings c
+            in runReaderT (parser tokens) vars
 
 ---------------------------------------------
 
 -- These should probably go somewhere else.
 
 -- | Parse a 'CoreString' to a 'CoreExpr', using the current context.
-parseCoreExprT :: (BoundVars c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m)
+parseCoreExprT :: (ReadBindings c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m)
                => CoreString -> Transform c m a CoreExpr
 parseCoreExprT cs = contextonlyT $ embedHermitM . parseCore cs
 
-parse2BeforeT :: (BoundVars c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m)
+parse2BeforeT :: (ReadBindings c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m)
               => (CoreExpr -> CoreExpr -> Translate c m a b)
               -> CoreString -> CoreString -> Translate c m a b
 parse2BeforeT f s1 s2 = parseCoreExprT s1 &&& parseCoreExprT s2 >>= uncurry f
 
-parse3BeforeT :: (BoundVars c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m)
+parse3BeforeT :: (ReadBindings c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m)
               => (CoreExpr -> CoreExpr -> CoreExpr -> Translate c m a b)
               -> CoreString -> CoreString -> CoreString -> Translate c m a b
 parse3BeforeT f s1 s2 s3 = (parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3 >>= (uncurry . uncurry $ f)
diff --git a/examples/concatVanishes/ConcatVanishes.hss b/examples/concatVanishes/ConcatVanishes.hss
--- a/examples/concatVanishes/ConcatVanishes.hss
+++ b/examples/concatVanishes/ConcatVanishes.hss
@@ -9,7 +9,7 @@
   lam-body
   eta-expand 'acc
   lam-body
-  bash-extended-with [ push 'repH StrictRepH, forward ww-result-fusion, apply-rules ["repH ++","repH (:)","repH []"] ]
+  bash-extended-with [ push 'repH StrictRepH, forward ww-result-fusion, unfold-rules-unsafe ["repH ++","repH (:)","repH []"] ]
   try (bash-extended-with [push-unsafe 'work])
 }
 one-td (unfold 'absH)
diff --git a/examples/flatten/Flatten.hec b/examples/flatten/Flatten.hec
new file mode 100644
--- /dev/null
+++ b/examples/flatten/Flatten.hec
@@ -0,0 +1,102 @@
+load-as-rewrite "WWA" "WW-Ass-A.hss"
+define-rewrite "WWC" "ww-result-AssA-to-AssC WWA"
+load-as-rewrite "StrictRepH" "StrictRepH.hss"
+
+-- module main:Main where
+--   flatten :: forall a . Tree a -> [a]
+--   $dShow :: Show [Char]
+--   main :: IO ()
+--   main :: IO ()
+
+binding-of 'flatten
+
+-- flatten = \ * ds ->
+--   case ds of wild *
+--     Node l r -> (++) * (flatten * l) (flatten * r)
+--     Leaf a -> (:) * a ([] *)
+
+ww-result-split-static-arg 1 [0] [| absH |] [| repH |] WWC
+
+-- flatten = \ * ds ->
+--   (let f = \ flatten' ds ->
+--          case ds of wild *
+--            Node l r -> (++) * (flatten' l) (flatten' r)
+--            Leaf a -> (:) * a ([] *)
+--        rec work = \ x1 -> repH * (f (\ x2 -> absH * (work x2)) x1)
+--    in \ x0 -> absH * (work x0)) ds
+
+bash
+{
+
+-- flatten = \ * ->
+--   let rec work = \ x1 ->
+--             repH *
+--                  (case x1 of wild *
+--                     Node l r -> (++) * (absH * (work l)) (absH * (work r))
+--                     Leaf a -> (:) * a ([] *))
+--   in \ x0 -> absH * (work x0)
+
+rhs-of 'work
+
+-- \ x1 ->
+--   repH *
+--        (case x1 of wild *
+--           Node l r -> (++) * (absH * (work l)) (absH * (work r))
+--           Leaf a -> (:) * a ([] *))
+
+alpha-lam 'tree
+
+-- \ tree ->
+--   repH *
+--        (case tree of wild *
+--           Node l r -> (++) * (absH * (work l)) (absH * (work r))
+--           Leaf a -> (:) * a ([] *))
+
+lam-body
+
+-- repH *
+--      (case tree of wild *
+--         Node l r -> (++) * (absH * (work l)) (absH * (work r))
+--         Leaf a -> (:) * a ([] *))
+
+eta-expand 'acc
+
+-- \ acc ->
+--   repH *
+--        (case tree of wild *
+--           Node l r -> (++) * (absH * (work l)) (absH * (work r))
+--           Leaf a -> (:) * a ([] *))
+--        acc
+
+lam-body
+
+-- repH *
+--      (case tree of wild *
+--         Node l r -> (++) * (absH * (work l)) (absH * (work r))
+--         Leaf a -> (:) * a ([] *))
+--      acc
+
+bash-extended-with [push 'repH StrictRepH,forward ww-result-fusion,unfold-rules-unsafe ["repH ++","repH (:)","repH []"]]
+
+-- case tree of wild *
+--   Node l r -> work l (work r acc)
+--   Leaf a -> (:) * a acc
+
+ }
+
+-- flatten = \ * ->
+--   let rec work = \ tree acc ->
+--             case tree of wild *
+--               Node l r -> work l (work r acc)
+--               Leaf a -> (:) * a acc
+--   in \ x0 -> absH * (work x0)
+
+one-td (unfold 'absH)
+
+-- flatten = \ * ->
+--   let rec work = \ tree acc ->
+--             case tree of wild *
+--               Node l r -> work l (work r acc)
+--               Leaf a -> (:) * a acc
+--   in \ x0 -> work x0 ([] *)
+
diff --git a/examples/flatten/Flatten.hss b/examples/flatten/Flatten.hss
deleted file mode 100644
--- a/examples/flatten/Flatten.hss
+++ /dev/null
@@ -1,14 +0,0 @@
-load-as-rewrite "WWA" "WW-Ass-A.hss"
-define-rewrite "WWC" "ww-result-AssA-to-AssC WWA"
-load-as-rewrite "StrictRepH" "StrictRepH.hss"
-binding-of 'flatten
-ww-result-split-static-arg 1 [0] [| absH |] [| repH |] WWC
-bash
-{ rhs-of 'work
-  alpha-lam 'tree
-  lam-body
-  eta-expand 'acc
-  lam-body
-  bash-extended-with [push 'repH StrictRepH, forward ww-result-fusion, apply-rules ["repH ++", "repH (:)", "repH []"] ]
-}
-one-td (unfold 'absH)
diff --git a/examples/last/NewLast.hss b/examples/last/NewLast.hss
new file mode 100644
--- /dev/null
+++ b/examples/last/NewLast.hss
@@ -0,0 +1,15 @@
+flatten-module
+set-pp-type Show
+
+binding-of 'last
+fix-intro
+{ application-of 'fix
+  split-1-beta last [| wrap |] [| unwrap |]
+  -- prove the assumption
+  lhs (repeat (any-call (unfold ['., 'wrap, 'unwrap])))
+  both smash
+  end-proof
+
+  repeat (any-call (unfold ['g, 'wrap, 'unwrap, 'fix]))
+  bash
+}
diff --git a/examples/new_reverse/HList.hs b/examples/new_reverse/HList.hs
new file mode 100644
--- /dev/null
+++ b/examples/new_reverse/HList.hs
@@ -0,0 +1,30 @@
+module HList
+    ( H
+    , repH
+    , absH
+    , myAppend
+    ) where
+
+type H a = [a] -> [a]
+
+{-# INLINABLE repH #-}
+repH :: [a] -> H a
+repH xs = (xs ++)
+
+{-# INLINABLE absH #-}
+absH :: H a -> [a]
+absH f = f []
+
+-- Because we can't get unfolding for ++
+myAppend :: [a] -> [a] -> [a]
+myAppend []     ys = ys
+myAppend (x:xs) ys = x : myAppend xs ys
+{-# RULES "appendFix" [~] (++) = myAppend #-}
+
+-- Algebra for repH
+{-# RULES "repH []"  [~]               repH [] = id #-}
+{-# RULES "repH (:)" [~] forall x xs.  repH (x:xs) = (x:) . repH xs #-}
+{-# RULES "repH ++"  [~] forall xs ys. repH (xs ++ ys) = repH xs . repH ys #-}
+
+-- Needed because the fusion rule we generate isn't too useful yet.
+{-# RULES "repH-absH-fusion" [~] forall h. repH (absH h) = h #-}
diff --git a/examples/new_reverse/Reverse.hec b/examples/new_reverse/Reverse.hec
new file mode 100644
--- /dev/null
+++ b/examples/new_reverse/Reverse.hec
@@ -0,0 +1,674 @@
+flatten-module
+rule-to-lemma "++ []"
+
+-- module main:Main where
+--   absR :: forall a . ([a] -> H a) -> [a] -> [a]
+--   repR :: forall a . ([a] -> [a]) -> [a] -> H a
+--   rev :: forall a . [a] -> [a]
+--   main :: IO ()
+--   main :: IO ()
+
+prove-lemma "++ []"
+
+-- Goal:
+-- forall * xs. (++) * xs ([] *) = xs
+
+lhs (one-td (unfold-rule appendFix))
+
+-- Goal:
+-- forall *. (++) * = myAppend *
+
+assume -- proven appendFix
+
+-- Goal:
+-- forall * xs. myAppend * xs ([] *) = xs
+
+induction 'xs
+
+-- Goal:
+-- forall *. myAppend * (undefined *) ([] *) = undefined *
+
+lhs unfold
+
+-- Goal:
+-- forall *.
+-- case undefined * of wild *
+--   [] -> [] *
+--   (:) x xs -> (:) * x (myAppend * xs ([] *))
+-- =
+-- undefined *
+
+lhs undefined-expr
+
+-- Goal:
+-- forall *. undefined * = undefined *
+
+end-case -- proven "++ []-induction-case-undefined"
+
+-- Goal:
+-- forall *. myAppend * ([] *) ([] *) = [] *
+
+lhs unfold
+
+-- Goal:
+-- forall *.
+-- case [] * of wild *
+--   [] -> [] *
+--   (:) x xs -> (:) * x (myAppend * xs ([] *))
+-- =
+-- [] *
+
+lhs simplify
+
+-- Goal:
+-- forall *. [] * = [] *
+
+end-case -- proven "++ []-induction-case-[]"
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   myAppend * b ([] *) = b
+-- Goal:
+-- forall * a b. myAppend * ((:) * a b) ([] *) = (:) * a b
+
+lhs unfold
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   myAppend * b ([] *) = b
+-- Goal:
+-- forall * a b.
+-- case (:) * a b of wild *
+--   [] -> [] *
+--   (:) x xs -> (:) * x (myAppend * xs ([] *))
+-- =
+-- (:) * a b
+
+lhs simplify
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   myAppend * b ([] *) = b
+-- Goal:
+-- forall * a b. (:) * a (myAppend * b ([] *)) = (:) * a b
+
+lhs (one-td (lemma-forward ind-hyp-0))
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   myAppend * b ([] *) = b
+-- Goal:
+-- forall * a b. (:) * a b = (:) * a b
+
+end-case -- proven "++ []-induction-case-:"
+-- proven "++ []"
+rule-to-lemma "repH []"
+
+-- module main:Main where
+--   absR :: forall a . ([a] -> H a) -> [a] -> [a]
+--   repR :: forall a . ([a] -> [a]) -> [a] -> H a
+--   rev :: forall a . [a] -> [a]
+--   main :: IO ()
+--   main :: IO ()
+
+prove-lemma "repH []"
+
+-- Goal:
+-- forall *. repH * ([] *) = id *
+
+lhs unfold
+
+-- Goal:
+-- forall *. (++) * ([] *) = id *
+
+extensionality
+
+-- Goal:
+-- forall * x. (++) * ([] *) x = id * x
+
+lhs (one-td (unfold-rule appendFix))
+
+-- Goal:
+-- forall * x. myAppend * ([] *) x = id * x
+
+lhs unfold
+
+-- Goal:
+-- forall * x.
+-- case [] * of wild *
+--   [] -> x
+--   (:) x xs -> (:) * x (myAppend * xs x)
+-- =
+-- id * x
+
+both smash
+
+-- Goal:
+-- forall * x. x = x
+
+end-proof -- proven "repH []"
+rule-to-lemma "repH (:)"
+
+-- module main:Main where
+--   absR :: forall a . ([a] -> H a) -> [a] -> [a]
+--   repR :: forall a . ([a] -> [a]) -> [a] -> H a
+--   rev :: forall a . [a] -> [a]
+--   main :: IO ()
+--   main :: IO ()
+
+prove-lemma "repH (:)"
+
+-- Goal:
+-- forall * x xs. repH * ((:) * x xs) = (.) * * * ((:) * x) (repH * xs)
+
+both (any-call (unfold 'repH))
+
+-- Goal:
+-- forall * x xs. (++) * ((:) * x xs) = (.) * * * ((:) * x) ((++) * xs)
+
+both (any-call (unfold-rule appendFix))
+
+-- Goal:
+-- forall * x xs. myAppend * ((:) * x xs) = (.) * * * ((:) * x) (myAppend * xs)
+
+rhs unfold
+
+-- Goal:
+-- forall * x xs. myAppend * ((:) * x xs) = \ x -> (:) * x (myAppend * xs x)
+
+lhs (unfold >>> smash)
+
+-- Goal:
+-- forall * x xs. \ ys -> (:) * x (myAppend * xs ys) = \ x -> (:) * x (myAppend * xs x)
+
+end-proof -- proven "repH (:)"
+rule-to-lemma "repH ++"
+
+-- module main:Main where
+--   absR :: forall a . ([a] -> H a) -> [a] -> [a]
+--   repR :: forall a . ([a] -> [a]) -> [a] -> H a
+--   rev :: forall a . [a] -> [a]
+--   main :: IO ()
+--   main :: IO ()
+
+prove-lemma "repH ++"
+
+-- Goal:
+-- forall * xs ys. repH * ((++) * xs ys) = (.) * * * (repH * xs) (repH * ys)
+
+both (any-call (unfold 'repH))
+
+-- Goal:
+-- forall * xs ys. (++) * ((++) * xs ys) = (.) * * * ((++) * xs) ((++) * ys)
+
+both (any-call (unfold-rule appendFix))
+
+-- Goal:
+-- forall * xs ys. myAppend * (myAppend * xs ys) = (.) * * * (myAppend * xs) (myAppend * ys)
+
+lhs (eta-expand 'x)
+
+-- Goal:
+-- forall * xs ys. \ x -> myAppend * (myAppend * xs ys) x = (.) * * * (myAppend * xs) (myAppend * ys)
+
+rhs unfold
+
+-- Goal:
+-- forall * xs ys. \ x -> myAppend * (myAppend * xs ys) x = \ x -> myAppend * xs (myAppend * ys x)
+
+induction 'xs
+
+-- Goal:
+-- forall * ys x. myAppend * (myAppend * (undefined *) ys) x = myAppend * (undefined *) (myAppend * ys x)
+
+both (replicate 2 (any-call (unfold 'myAppend)))
+
+-- Goal:
+-- forall * ys x.
+-- case case undefined * of wild *
+--        [] -> ys
+--        (:) x xs -> (:) * x (myAppend * xs ys)
+--  of wild *
+--   [] -> x
+--   (:) x xs ->
+--     (:) * x
+--         (case xs of wild *
+--            [] -> x
+--            (:) x xs -> (:) * x (myAppend * xs x))
+-- =
+-- case undefined * of wild *
+--   [] ->
+--     case ys of wild *
+--       [] -> x
+--       (:) x xs ->
+--         (:) * x
+--             (case xs of wild *
+--                [] -> x
+--                (:) x xs -> (:) * x (myAppend * xs x))
+--   (:) x xs ->
+--     (:) * x
+--         (case xs of wild *
+--            [] ->
+--              case ys of wild *
+--                [] -> x
+--                (:) x xs ->
+--                  (:) * x
+--                      (case xs of wild *
+--                         [] -> x
+--                         (:) x xs -> (:) * x (myAppend * xs x))
+--            (:) x xs ->
+--              (:) * x
+--                  (myAppend * xs
+--                            (case ys of wild *
+--                               [] -> x
+--                               (:) x xs ->
+--                                 (:) * x
+--                                     (case xs of wild *
+--                                        [] -> x
+--                                        (:) x xs -> (:) * x (myAppend * xs x)))))
+
+both (innermost undefined-expr)
+
+-- Goal:
+-- forall * ys x. undefined * = undefined *
+
+end-case -- proven "repH ++-induction-case-undefined"
+
+-- Goal:
+-- forall * ys x. myAppend * (myAppend * ([] *) ys) x = myAppend * ([] *) (myAppend * ys x)
+
+both (replicate 2 (any-call (unfold 'myAppend)))
+
+-- Goal:
+-- forall * ys x.
+-- case case [] * of wild *
+--        [] -> ys
+--        (:) x xs -> (:) * x (myAppend * xs ys)
+--  of wild *
+--   [] -> x
+--   (:) x xs ->
+--     (:) * x
+--         (case xs of wild *
+--            [] -> x
+--            (:) x xs -> (:) * x (myAppend * xs x))
+-- =
+-- case [] * of wild *
+--   [] ->
+--     case ys of wild *
+--       [] -> x
+--       (:) x xs ->
+--         (:) * x
+--             (case xs of wild *
+--                [] -> x
+--                (:) x xs -> (:) * x (myAppend * xs x))
+--   (:) x xs ->
+--     (:) * x
+--         (case xs of wild *
+--            [] ->
+--              case ys of wild *
+--                [] -> x
+--                (:) x xs ->
+--                  (:) * x
+--                      (case xs of wild *
+--                         [] -> x
+--                         (:) x xs -> (:) * x (myAppend * xs x))
+--            (:) x xs ->
+--              (:) * x
+--                  (myAppend * xs
+--                            (case ys of wild *
+--                               [] -> x
+--                               (:) x xs ->
+--                                 (:) * x
+--                                     (case xs of wild *
+--                                        [] -> x
+--                                        (:) x xs -> (:) * x (myAppend * xs x)))))
+
+both smash
+
+-- Goal:
+-- forall * ys x.
+-- case ys of wild *
+--   [] -> x
+--   (:) x xs ->
+--     (:) * x
+--         (case xs of wild *
+--            [] -> x
+--            (:) x xs -> (:) * x (myAppend * xs x))
+-- =
+-- case ys of wild *
+--   [] -> x
+--   (:) x xs ->
+--     (:) * x
+--         (case xs of wild *
+--            [] -> x
+--            (:) x xs -> (:) * x (myAppend * xs x))
+
+end-case -- proven "repH ++-induction-case-[]"
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   \ x -> myAppend * (myAppend * b ys) x = \ x -> myAppend * b (myAppend * ys x)
+-- Goal:
+-- forall * ys a b x. myAppend * (myAppend * ((:) * a b) ys) x = myAppend * ((:) * a b) (myAppend * ys x)
+
+both (one-td unfold)
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   \ x -> myAppend * (myAppend * b ys) x = \ x -> myAppend * b (myAppend * ys x)
+-- Goal:
+-- forall * ys a b x.
+-- case myAppend * ((:) * a b) ys of wild *
+--   [] -> x
+--   (:) x xs -> (:) * x (myAppend * xs x)
+-- =
+-- case (:) * a b of wild *
+--   [] -> myAppend * ys x
+--   (:) x xs -> (:) * x (myAppend * xs (myAppend * ys x))
+
+lhs (one-td unfold)
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   \ x -> myAppend * (myAppend * b ys) x = \ x -> myAppend * b (myAppend * ys x)
+-- Goal:
+-- forall * ys a b x.
+-- case case (:) * a b of wild *
+--        [] -> ys
+--        (:) x xs -> (:) * x (myAppend * xs ys)
+--  of wild *
+--   [] -> x
+--   (:) x xs -> (:) * x (myAppend * xs x)
+-- =
+-- case (:) * a b of wild *
+--   [] -> myAppend * ys x
+--   (:) x xs -> (:) * x (myAppend * xs (myAppend * ys x))
+
+both smash
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   \ x -> myAppend * (myAppend * b ys) x = \ x -> myAppend * b (myAppend * ys x)
+-- Goal:
+-- forall * ys a b x. (:) * a (myAppend * (myAppend * b ys) x) = (:) * a (myAppend * b (myAppend * ys x))
+
+rhs (one-td (lemma-backward ind-hyp-0))
+
+-- Assumed lemmas:
+-- ind-hyp-0 (Assumed)
+--   \ x -> myAppend * (myAppend * b ys) x = \ x -> myAppend * b (myAppend * ys x)
+-- Goal:
+-- forall * ys a b x. (:) * a (myAppend * (myAppend * b ys) x) = (:) * a (myAppend * (myAppend * b ys) x)
+
+end-case -- proven "repH ++-induction-case-:"
+-- proven "repH ++"
+
+-- module main:Main where
+--   absR :: forall a . ([a] -> H a) -> [a] -> [a]
+--   repR :: forall a . ([a] -> [a]) -> [a] -> H a
+--   rev :: forall a . [a] -> [a]
+--   main :: IO ()
+--   main :: IO ()
+
+binding-of 'rev
+
+-- rev = \ * ds ->
+--   case ds of wild *
+--     [] -> [] *
+--     (:) x xs -> (++) * (rev * xs) ((:) * x ([] *))
+
+fix-intro
+
+-- rev = \ * ->
+--   fix *
+--       (\ rev ds ->
+--          case ds of wild *
+--            [] -> [] *
+--            (:) x xs -> (++) * (rev xs) ((:) * x ([] *)))
+
+application-of 'fix
+
+-- fix *
+--     (\ rev ds ->
+--        case ds of wild *
+--          [] -> [] *
+--          (:) x xs -> (++) * (rev xs) ((:) * x ([] *)))
+
+split-1-beta rev [| absR |] [| repR |]
+
+-- Goal:
+-- fix *
+--     ((.) * * * (absR *)
+--          ((.) * * * (repR *)
+--               (\ rev ds ->
+--                  case ds of wild *
+--                    [] -> [] *
+--                    (:) x xs -> (++) * (rev xs) ((:) * x ([] *)))))
+-- =
+-- fix *
+--     (\ rev ds ->
+--        case ds of wild *
+--          [] -> [] *
+--          (:) x xs -> (++) * (rev xs) ((:) * x ([] *)))
+
+both (unfold >>> smash)
+
+-- Goal:
+-- let rec x =
+--           absR *
+--                (repR *
+--                      (\ ds ->
+--                         case ds of wild *
+--                           [] -> [] *
+--                           (:) x xs -> (++) * (x xs) ((:) * x ([] *))))
+-- in x
+-- =
+-- let rec x = \ ds ->
+--           case ds of wild *
+--             [] -> [] *
+--             (:) x xs -> (++) * (x xs) ((:) * x ([] *))
+-- in x
+
+lhs (replicate 5 ((one-td unfold) >+> smash))
+
+-- Goal:
+-- let rec x = \ x ->
+--           (++) *
+--                (case x of wild *
+--                   [] -> [] *
+--                   (:) x xs -> (++) * (x xs) ((:) * x ([] *)))
+--                ([] *)
+-- in x
+-- =
+-- let rec x = \ ds ->
+--           case ds of wild *
+--             [] -> [] *
+--             (:) x xs -> (++) * (x xs) ((:) * x ([] *))
+-- in x
+
+lhs (one-td (lemma-forward "++ []"))
+
+-- Goal:
+-- let rec x = \ x ->
+--           case x of wild *
+--             [] -> [] *
+--             (:) x xs -> (++) * (x xs) ((:) * x ([] *))
+-- in x
+-- =
+-- let rec x = \ ds ->
+--           case ds of wild *
+--             [] -> [] *
+--             (:) x xs -> (++) * (x xs) ((:) * x ([] *))
+-- in x
+
+end-proof -- proven rev-assumption
+
+-- let g =
+--       (.) * * * (repR *)
+--           ((.) * * *
+--                (\ rev ds ->
+--                   case ds of wild *
+--                     [] -> [] *
+--                     (:) x xs -> (++) * (rev xs) ((:) * x ([] *)))
+--                (absR *))
+--     worker = fix * g
+-- in absR * worker
+
+any-call (unfold ['absR,'repR])
+
+-- let g =
+--       (.) * * * (\ eta -> (\ f -> (.) * * * (repH *) f) eta)
+--           ((.) * * *
+--                (\ rev ds ->
+--                   case ds of wild *
+--                     [] -> [] *
+--                     (:) x xs -> (++) * (rev xs) ((:) * x ([] *)))
+--                (\ eta -> (\ g -> (.) * * * (absH *) g) eta))
+--     worker = fix * g
+-- in (\ g -> (.) * * * (absH *) g) worker
+
+repeat (any-call (unfold '.)) ; smash
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              repH *
+--                   (case x of wild *
+--                      [] -> [] *
+--                      (:) x xs -> (++) * (absH * (x xs)) ((:) * x ([] *))))
+-- in \ x -> absH * (worker x)
+
+one-td (case-float-arg-lemma repHstrict)
+
+-- Goal:
+-- forall *. repH * (undefined *) = undefined *
+
+lhs unfold
+
+-- Goal:
+-- forall *. (++) * (undefined *) = undefined *
+
+lhs (one-td (unfold-rule appendFix))
+
+-- Goal:
+-- forall *. myAppend * (undefined *) = undefined *
+
+lhs unfold
+
+-- Goal:
+-- forall *.
+-- \ ys ->
+--   case undefined * of wild *
+--     [] -> ys
+--     (:) x xs -> (:) * x (myAppend * xs ys)
+-- =
+-- undefined *
+
+both (innermost undefined-expr)
+
+-- Goal:
+-- forall *. undefined * = undefined *
+
+end-proof -- proven repHstrict
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              case x of wild *
+--                [] -> repH * ([] *)
+--                (:) x xs -> repH * ((++) * (absH * (x xs)) ((:) * x ([] *))))
+-- in \ x -> absH * (worker x)
+
+one-td (lemma-forward "repH ++")
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              case x of wild *
+--                [] -> repH * ([] *)
+--                (:) x xs -> (.) * * * (repH * (absH * (x xs))) (repH * ((:) * x ([] *))))
+-- in \ x -> absH * (worker x)
+
+repeat (any-call (unfold '.))
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              case x of wild *
+--                [] -> repH * ([] *)
+--                (:) x xs -> \ x -> repH * (absH * (x xs)) (repH * ((:) * x ([] *)) x))
+-- in \ x -> absH * (worker x)
+
+one-td (unfold-rule repH-absH-fusion)
+
+-- Goal:
+-- forall * h. repH * (absH * h) = h
+
+assume -- proven repH-absH-fusion
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              case x of wild *
+--                [] -> repH * ([] *)
+--                (:) x xs -> \ x -> x xs (repH * ((:) * x ([] *)) x))
+-- in \ x -> absH * (worker x)
+
+one-td (lemma-forward "repH (:)")
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              case x of wild *
+--                [] -> repH * ([] *)
+--                (:) x xs -> \ x -> x xs ((.) * * * ((:) * x) (repH * ([] *)) x))
+-- in \ x -> absH * (worker x)
+
+any-td (lemma-forward "repH []")
+
+-- let worker =
+--       fix *
+--           (\ x x ->
+--              case x of wild *
+--                [] -> id *
+--                (:) x xs -> \ x -> x xs ((.) * * * ((:) * x) (id *) x))
+-- in \ x -> absH * (worker x)
+
+any-call (unfold 'fix)
+
+-- let worker =
+--       let rec x =
+--                 (\ x x ->
+--                    case x of wild *
+--                      [] -> id *
+--                      (:) x xs -> \ x -> x xs ((.) * * * ((:) * x) (id *) x)) x
+--       in x
+-- in \ x -> absH * (worker x)
+
+any-call (unfold 'absH)
+
+-- let worker =
+--       let rec x =
+--                 (\ x x ->
+--                    case x of wild *
+--                      [] -> id *
+--                      (:) x xs -> \ x -> x xs ((.) * * * ((:) * x) (id *) x)) x
+--       in x
+-- in \ x -> worker x ([] *)
+
+bash
+
+-- let rec x = \ x ->
+--           case x of wild *
+--             [] -> \ x -> x
+--             (:) x xs -> \ x -> x xs ((:) * x x)
+-- in \ x -> x x ([] *)
+
+unshadow
+
+-- let rec x = \ x0 ->
+--           case x0 of wild *
+--             [] -> \ x1 -> x1
+--             (:) x1 xs -> \ x2 -> x xs ((:) * x1 x2)
+-- in \ x0 -> x x0 ([] *)
+
diff --git a/examples/new_reverse/Reverse.hs b/examples/new_reverse/Reverse.hs
new file mode 100644
--- /dev/null
+++ b/examples/new_reverse/Reverse.hs
@@ -0,0 +1,22 @@
+module Main where
+
+import HList
+import Data.Function (fix)
+
+{-# INLINE repR #-}
+repR :: ([a] -> [a]) -> ([a] -> H a)
+repR f = repH . f
+
+{-# INLINE absR #-}
+absR :: ([a] -> H a) -> ([a] -> [a])
+absR g = absH . g
+
+rev :: [a] -> [a]
+rev []     = []
+rev (x:xs) = rev xs ++ [x]
+
+main :: IO ()
+main = print $ rev [1..10]
+
+-- useful auxilliary lemma for proving the w/w assumption
+{-# RULES "++ []" [~] forall xs. xs ++ [] = xs #-}
diff --git a/examples/nub/Nub.hs b/examples/nub/Nub.hs
new file mode 100644
--- /dev/null
+++ b/examples/nub/Nub.hs
@@ -0,0 +1,27 @@
+module Main where
+
+import qualified Data.Set as Set
+import Data.Set (Set)
+
+import Prelude hiding (filter) -- because we can't get unfolding for filter
+
+filter :: (a -> Bool) -> [a] -> [a]
+filter _ [] = []
+filter p (x:xs) = if p x then x : filter p xs else filter p xs
+
+nub :: [Int] -> [Int]
+nub [] = []
+nub (x:xs) = x : nub (filter (/= x) xs)
+
+absN :: ([Int] -> Set Int -> [Int]) -> [Int] -> [Int]
+absN h [] = []
+absN h (x:xs) = x : h xs (Set.singleton x)
+
+repN :: ([Int] -> [Int]) -> [Int] -> Set Int -> [Int]
+repN h xs s = h (filter (`Set.notMember` s) xs)
+
+main :: IO ()
+main = print (nub [ x | n <- [1..1000], x <- [1..n] ])
+
+{-# RULES "filter-fusion" [~] forall p q ys. filter p (filter q ys) = filter (\y -> p y && q y) ys #-}
+{-# RULES "member-fusion" [~] forall y x s. (y /= x) && (y `Set.notMember` s) = y `Set.notMember` (Set.insert x s) #-}
diff --git a/examples/nub/Nub.hss b/examples/nub/Nub.hss
new file mode 100644
--- /dev/null
+++ b/examples/nub/Nub.hss
@@ -0,0 +1,37 @@
+set-pp-type Show
+
+flatten-module
+
+binding-of 'nub
+fix-intro ; def-rhs
+split-2-beta nub [| absN |] [| repN |] ; assume
+
+-- this bit to essentially undo the fix-intro
+{ application-of 'repN ; app-arg ; let-intro 'nub ; one-td (unfold 'fix) ; simplify }
+innermost let-float
+alpha-let ['nub'] -- rename x to nub'
+
+-- back to the derivation
+binding-of 'worker
+one-td (unfold 'repN)
+remember origworker
+one-td (unfold 'filter)
+one-td (case-float-arg-lemma nubStrict)
+
+-- prove strictness condition
+lhs (unfold >>> undefined-expr)
+end-proof
+
+one-td (unfold 'nub')
+simplify
+
+one-td (case-float-arg-lemma nubStrict)
+{ consider case ; consider case ; case-alt 1 ; alt-rhs
+  unfold ; simplify
+  one-td (unfold-rule "filter-fusion") ; assume
+  simplify
+  one-td (unfold-rule "member-fusion") ; assume
+}
+nonrec-to-rec
+any-td (fold-remembered origworker)
+
diff --git a/examples/qsort/HList.hs b/examples/qsort/HList.hs
--- a/examples/qsort/HList.hs
+++ b/examples/qsort/HList.hs
@@ -22,3 +22,6 @@
 {-# RULES "repH ++" forall xs ys   . repH (xs ++ ys) = repH xs . repH ys #-}
 {-# RULES "repH []" 	             repH [] = id  	       	         #-}
 {-# RULES "repH (:)" forall x xs   . repH (x:xs) = ((:) x) . repH xs     #-}
+
+-- Needed because the fusion rule we generate isn't too useful yet.
+{-# RULES "repH-absH-fusion" [~] forall h. repH (absH h) = h #-}
diff --git a/examples/qsort/QSort.hs b/examples/qsort/QSort.hs
--- a/examples/qsort/QSort.hs
+++ b/examples/qsort/QSort.hs
@@ -7,6 +7,14 @@
 
 data Tree a = Node (Tree a) (Tree a) | Leaf a
 
+{-# INLINE repR #-}
+repR :: ([a] -> [a]) -> ([a] -> H a)
+repR f = repH . f
+
+{-# INLINE absR #-}
+absR :: ([a] -> H a) -> ([a] -> [a])
+absR g = absH . g
+
 qsort :: Ord a => [a] -> [a]
 qsort []     = []
 qsort (a:as) = qsort bs ++ [a] ++ qsort cs
diff --git a/examples/qsort/QSort.hss b/examples/qsort/QSort.hss
--- a/examples/qsort/QSort.hss
+++ b/examples/qsort/QSort.hss
@@ -1,15 +1,25 @@
-load-as-rewrite "WWA" "WW-Ass-A.hss"
-define-rewrite "WWC" "ww-result-AssA-to-AssC WWA"
-load-as-rewrite "StrictRepH" "StrictRepH.hss"
+flatten-module
 binding-of 'qsort
-ww-result-split-static-arg 2 [0] [| absH |] [| repH |] WWC
-bash
-{ rhs-of 'work
-  alpha-lam 'xs
-  lam-body
-  eta-expand 'acc
-  lam-body
-  bash-extended-with [push 'repH StrictRepH, forward ww-result-fusion, apply-rules ["repH ++", "repH (:)", "repH []"] ]
-  bash-extended-with [push-unsafe 'work]
+static-arg
+{
+    binding-of 'qsort'
+    fix-intro
+    def-rhs
+    split-1-beta qsort [|absR|] [|repR|] ; assume
+    rhs-of 'worker
+    repeat (any-call (unfold ['.,'fix,'g,'repR,'absR]))
+    simplify
+    one-td (case-float-arg-lemma repHstrict) ; assume
+    innermost let-float
+    any-td (unfold-rule "repH ++") ; assume
+    any-call (unfold-rule repH-absH-fusion) ; assume
+    unshadow
+    any-td (inline 'ds1)
+    simplify
+    alpha-let [worker]
+    repeat (any-call (unfold-rules ["repH (:)","repH []"]))
+    assume ; assume
 }
-one-td (unfold 'absH)
+repeat (any-call (unfold ['.,'absR, 'absH]))
+innermost let-float
+bash
diff --git a/examples/reverse/Reverse.hss b/examples/reverse/Reverse.hss
--- a/examples/reverse/Reverse.hss
+++ b/examples/reverse/Reverse.hss
@@ -9,6 +9,6 @@
   lam-body
   eta-expand 'acc
   lam-body
-  bash-extended-with [push 'repH StrictRepH, forward ww-result-fusion, apply-rules ["repH ++", "repH (:)", "repH []"] ]
+  bash-extended-with [push 'repH StrictRepH, forward ww-result-fusion, unfold-rules-unsafe ["repH ++", "repH (:)", "repH []"] ]
 }
 one-td (unfold 'absH)
diff --git a/hermit.cabal b/hermit.cabal
--- a/hermit.cabal
+++ b/hermit.cabal
@@ -1,22 +1,9 @@
 Name:                hermit
-Version:             0.6.0.0
+Version:             0.7.0.0
 Synopsis:            Haskell Equational Reasoning Model-to-Implementation Tunnel
 Description:
-  HERMIT uses Haskell to express semi-formal models,
-  efficient implementations, and provide a bridging DSL
-  to describe via stepwise refinement the connection between
-  these models and implementations. The key transformation
-  in the bridging DSL is the worker/wrapper transformation.
-  .
-  This is an alpha `please give feedback' release.
-  Shortcomings/gotchas include:
-  .
-    * Command line completion is ad hoc at the moment.
-  .
-    * log command prints linearly, even if command history is a tree.
-  .
-    * A number of rewrites don't enforce preconditions. eg: cast elimination
-      always works, even if the cast is necessary
+  HERMIT is a Haskell-specific toolkit designed to mechanize
+  equational reasoning and program transformation during compilation in GHC.
   .
   Examples can be found in the examples sub-directory.
   .
@@ -28,12 +15,12 @@
   .
   @
    $ hermit Reverse.hs Reverse.hss resume
-   [starting HERMIT v0.6.0.0 on Reverse.hs]
+   [starting HERMIT v0.7.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.6.0.0 ... linking ... done.
+   Loading package hermit-0.7.0.0 ... linking ... done.
    [2 of 2] Compiling Main             ( Reverse.hs, Reverse.o )
    Linking Reverse ...
    $ ./Reverse
@@ -44,12 +31,12 @@
   .
   @
    $ hermit Reverse.hs
-   [starting HERMIT v0.6.0.0 on Reverse.hs]
+   [starting HERMIT v0.7.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.6.0.0 ... linking ... done.
+   Loading package hermit-0.7.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
@@ -95,12 +82,13 @@
 License:             BSD3
 License-file:        LICENSE
 Author:              Andrew Farmer, Andy Gill, Ed Komp, Neil Sculthorpe
-Maintainer:          Andy Gill <andygill@ku.edu>
-Stability:           alpha
+Maintainer:          Andrew Farmer <afarmer@ittc.ku.edu>
+Stability:           beta
 build-type:          Simple
 Cabal-Version:       >= 1.14
 
 extra-source-files:
+    README.md
     examples/concatVanishes/ConcatVanishes.hss
     examples/concatVanishes/Flatten.hs
     examples/concatVanishes/Flatten.hss
@@ -121,38 +109,45 @@
     examples/fib-tuple/Fib.hss
     examples/flatten/HList.hs
     examples/flatten/Flatten.hs
-    examples/flatten/Flatten.hss
+    examples/flatten/Flatten.hec
     examples/hanoi/Hanoi.hs
     examples/hanoi/Hanoi.hss
     examples/last/Last.hs
     examples/last/Last.hss
+    examples/last/NewLast.hss
     examples/mean/Mean.hs
     examples/mean/Mean.hss
+    examples/nub/Nub.hs
+    examples/nub/Nub.hss
     examples/qsort/HList.hs
     examples/qsort/QSort.hs
     examples/qsort/QSort.hss
     examples/reverse/HList.hs
     examples/reverse/Reverse.hs
     examples/reverse/Reverse.hss
+    examples/new_reverse/HList.hs
+    examples/new_reverse/Reverse.hs
+    examples/new_reverse/Reverse.hec
 
 Library
   ghc-options: -Wall -fno-warn-orphans
-  Build-Depends: base >= 4 && < 5,
-                 ansi-terminal >= 0.5.5,
+  Build-Depends: base                >= 4 && < 5,
+                 ansi-terminal       >= 0.5.5,
                  array,
-                 containers >= 0.5.0.0,
-                 data-default >= 0.5.0,
-                 directory >= 1.2.0.0,
-                 ghc >= 7.8,
-                 haskeline >= 0.7.0.3,
-                 kure >= 2.16.4,
-                 marked-pretty >= 0.1,
-                 mtl >= 2.1.2,
-                 operational >= 0.2.2.1,
-                 process >= 1.1.0.2,
-                 stm >= 2.4,
-                 temporary >= 1.2.0.3,
-                 transformers
+                 containers          >= 0.5.0.0,
+                 data-default-class  >= 0.0.1,
+                 directory           >= 1.2.0.0,
+                 ghc                 >= 7.8,
+                 haskeline           >= 0.7.0.3,
+                 kure                >= 2.16.8,
+                 marked-pretty       >= 0.1,
+                 mtl                 >= 2.1.2,
+                 operational         >= 0.2.2.1,
+                 process             >= 1.1.0.2,
+                 stm                 >= 2.4,
+                 temporary           >= 1.2.0.3,
+                 transformers        >= 0.2,
+                 transformers-compat >= 0.4
 
   if os(windows)
     build-depends: Win32
@@ -193,6 +188,7 @@
        HERMIT.Dictionary.New
        HERMIT.Dictionary.Query
        HERMIT.Dictionary.Reasoning
+       HERMIT.Dictionary.Remembered
        HERMIT.Dictionary.Rules
        HERMIT.Dictionary.Undefined
        HERMIT.Dictionary.Unfold
@@ -205,9 +201,9 @@
        HERMIT.GHC
        HERMIT.GHC.Typechecker
        HERMIT.Kernel
-       HERMIT.Kernel.Scoped
        HERMIT.Kure
-       HERMIT.Kure.SumTypes
+       HERMIT.Kure.Universes
+       HERMIT.Lemma
        HERMIT.Monad
        HERMIT.Name
        HERMIT.Parser
@@ -237,6 +233,8 @@
        HERMIT.Shell.Types
 
        HERMIT.Utilities
+
+       HERMIT.Libraries.Int
 
   Other-modules:
        HERMIT.Syntax
diff --git a/src/HERMIT/Context.hs b/src/HERMIT/Context.hs
--- a/src/HERMIT/Context.hs
+++ b/src/HERMIT/Context.hs
@@ -35,6 +35,7 @@
        , lookupHermitBinding
        , lookupHermitBindingDepth
        , lookupHermitBindingSite
+       , inScope
          -- ** Accessing GHC rewrite rules from the context
        , HasCoreRules(..)
          -- ** An empty Context
@@ -59,7 +60,6 @@
 -- | The depth of a binding.  Used, for example, to detect shadowing when inlining.
 type BindingDepth = Int
 
-
 -- | 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.
@@ -190,6 +190,11 @@
 -- | Determine if a variable is bound in a context.
 boundIn :: ReadBindings c => Var -> c -> Bool
 boundIn i c = i `member` hermitBindings c
+
+-- | Determine whether a variable is in scope.
+inScope :: BoundVars c => c -> Var -> Bool
+inScope c v = not (isDeadBinder v || (isLocalVar v && (v `notElemVarSet` boundVars c)))
+-- Used in Dictionary.Inline and Dictionary.Fold to check if variables are in scope.
 
 -- | Lookup the binding for a variable in a context.
 lookupHermitBinding :: (ReadBindings c, Monad m) => Var -> c -> m HermitBinding
diff --git a/src/HERMIT/Core.hs b/src/HERMIT/Core.hs
--- a/src/HERMIT/Core.hs
+++ b/src/HERMIT/Core.hs
@@ -1,79 +1,81 @@
 {-# LANGUAGE CPP, LambdaCase #-}
 module HERMIT.Core
-          (
-          -- * Generic Data Type
-            CoreProg(..)
-          , CoreDef(..)
-          , CoreTickish
-          -- * Equality
-          -- | We define both syntactic equality and alpha equality.
+    ( -- * Generic Data Type
+      CoreProg(..)
+    , CoreDef(..)
+    , CoreTickish
+      -- * Equality
+      -- | We define both syntactic equality and alpha equality.
 
-          -- ** Syntactic Equality
-          , progSyntaxEq
-          , bindSyntaxEq
-          , defSyntaxEq
-          , exprSyntaxEq
-          , altSyntaxEq
-          , typeSyntaxEq
-          , coercionSyntaxEq
+      -- ** Syntactic Equality
+    , progSyntaxEq
+    , bindSyntaxEq
+    , defSyntaxEq
+    , exprSyntaxEq
+    , altSyntaxEq
+    , typeSyntaxEq
+    , coercionSyntaxEq
 
-          -- ** Alpha Equality
-          , progAlphaEq
-          , bindAlphaEq
-          , defAlphaEq
-          , exprAlphaEq
-          , altAlphaEq
-          , typeAlphaEq
-          , coercionAlphaEq
+      -- ** Alpha Equality
+    , progAlphaEq
+    , bindAlphaEq
+    , defAlphaEq
+    , exprAlphaEq
+    , altAlphaEq
+    , typeAlphaEq
+    , coercionAlphaEq
 
-          -- * Conversions to/from 'Core'
-          , defsToRecBind
-          , defToIdExpr
-          , progToBinds
-          , bindsToProg
-          , bindToVarExprs
+      -- * Conversions to/from 'Core'
+    , defsToRecBind
+    , defToIdExpr
+    , progToBinds
+    , bindsToProg
+    , bindToVarExprs
 
-          -- * Collecting variable bindings
-          , progIds
-          , bindVars
-          , defId
-          , altVars
+      -- * Collecting variable bindings
+    , progIds
+    , bindVars
+    , defId
+    , altVars
 
-          -- * Collecting free variables
-          -- $freeVarsNote
-          , freeVarsProg
-          , freeVarsBind
-          , freeVarsDef
-          , freeVarsExpr
-          , freeVarsAlt
-          , freeVarsVar
-          , localFreeVarsAlt
-          , freeVarsType
-          , freeVarsCoercion
-          , localFreeVarsExpr
-          , freeIdsExpr
-          , localFreeIdsExpr
+      -- * Collecting free variables
+      -- $freeVarsNote
+    , freeVarsProg
+    , freeVarsBind
+    , freeVarsDef
+    , freeVarsExpr
+    , freeVarsAlt
+    , freeVarsVar
+    , localFreeVarsAlt
+    , freeVarsType
+    , freeVarsCoercion
+    , localFreeVarsExpr
+    , freeIdsExpr
+    , localFreeIdsExpr
 
-          -- * Utilities
-          , isCoArg
-          , exprKindOrType
-          , exprTypeM
-          , endoFunTypeM
-          , splitTyConAppM
-          , splitFunTypeM
-          , endoFunExprTypeM
-          , funExprArgResTypesM
-          , funExprsWithInverseTypes
-          , appCount
-          , mapAlts
+      -- * Utilities
+    , isCoArg
+    , exprKindOrType
+    , exprTypeM
+    , endoFunTypeM
+    , splitTyConAppM
+    , splitFunTypeM
+    , endoFunExprTypeM
+    , funExprArgResTypesM
+    , funExprsWithInverseTypes
+    , appCount
+    , mapAlts
+    , substCoreAlt
+    , substCoreExpr
+    , betaReduceAll
+    , mkDataConApp
 
-          -- * Crumbs
-          , Crumb(..)
-          , showCrumbs
---          , crumbToDeprecatedInt
-          , deprecatedLeftSibling
-          , deprecatedRightSibling
-) where
+      -- * Crumbs
+    , Crumb(..)
+    , showCrumbs
+    , leftSibling
+    , rightSibling
+    ) where
 
 import Control.Monad ((>=>))
 
@@ -277,24 +279,39 @@
 -- The GHC Function exprFreeVars defined in "CoreFVs" only returns *locally-defined* free variables.
 -- In HERMIT, this is typically not what we want, so we define our own functions.
 -- We reuse some of the functionality in "CoreFVs", but alas much of it is not exposed, so we have to reimplement some of it.
-
--- | Find all free variables in an expression.
-freeVarsExpr :: CoreExpr -> VarSet
-freeVarsExpr = exprSomeFreeVars (const True)
+-- We do not use GHC's exprSomeFreeVars because it does not return the full set of free vars for a Var.
+-- It only returns the Var itself, rather than extendVarSet (freeVarsVar v) v like it should.
 
 -- | Find all free identifiers in an expression.
 freeIdsExpr :: CoreExpr -> IdSet
-freeIdsExpr = exprSomeFreeVars isId
+freeIdsExpr = filterVarSet isId . freeVarsExpr
 
 -- | Find all locally defined free variables in an expression.
 localFreeVarsExpr :: CoreExpr -> VarSet
-localFreeVarsExpr = exprSomeFreeVars isLocalVar
+localFreeVarsExpr = filterVarSet isLocalVar . freeVarsExpr
 
 -- | Find all locally defined free identifiers in an expression.
 localFreeIdsExpr :: CoreExpr -> VarSet
-localFreeIdsExpr = exprSomeFreeVars isLocalId
+localFreeIdsExpr = filterVarSet isLocalId . freeVarsExpr
 
+-- | Find all free variables in an expression.
+freeVarsExpr :: CoreExpr -> VarSet
+freeVarsExpr (Var v) = extendVarSet (freeVarsVar v) v
+freeVarsExpr (Lit {}) = emptyVarSet
+freeVarsExpr (App e1 e2) = freeVarsExpr e1 `unionVarSet` freeVarsExpr e2
+freeVarsExpr (Lam b e) = delVarSet (freeVarsExpr e) b
+freeVarsExpr (Let b e) = freeVarsBind b `unionVarSet` delVarSetList (freeVarsExpr e) (bindersOf b)
+freeVarsExpr (Case s b ty alts) = let altFVs = delVarSet (unionVarSets $ map freeVarsAlt alts) b
+                                  in unionVarSets [freeVarsExpr s, freeVarsType ty, altFVs]
+freeVarsExpr (Cast e co) = freeVarsExpr e `unionVarSet` freeVarsCoercion co
+freeVarsExpr (Tick t e) = freeVarsTick t `unionVarSet` freeVarsExpr e
+freeVarsExpr (Type ty) = freeVarsType ty
+freeVarsExpr (Coercion co) = freeVarsCoercion co
 
+freeVarsTick :: Tickish Id -> VarSet
+freeVarsTick (Breakpoint _ ids) = mkVarSet ids
+freeVarsTick _ = emptyVarSet
+
 -- | Find all free identifiers in a binding group, which excludes any variables bound in the group.
 freeVarsBind :: CoreBind -> VarSet
 freeVarsBind (NonRec v e) = freeVarsExpr e `unionVarSet` freeVarsVar v
@@ -448,10 +465,14 @@
            | NthCo_Int | NthCo_Co
            | InstCo_Co | InstCo_Type
            | LRCo_LR | LRCo_Co
+           -- Quantified
+           | Forall_Body
+           | Conj_Lhs | Conj_Rhs
+           | Disj_Lhs | Disj_Rhs
+           | Impl_Lhs | Impl_Rhs
+           | Eq_Lhs | Eq_Rhs
            deriving (Eq,Read,Show)
-           -- TODO: Write a prettier Show instance
 
-
 showCrumbs :: [Crumb] -> String
 showCrumbs crs = "[" ++ intercalate ", " (map showCrumb crs) ++ "]"
 
@@ -501,65 +522,70 @@
                InstCo_Co         -> "inst-co"
                InstCo_Type       -> "inst-type"
                LRCo_Co           -> "lr-co"
-
-               _              -> "Warning: Crumb should not be in use!  This is probably Neil's fault."
+               -- Quantified
+               Forall_Body -> "forall-body"
+               Conj_Lhs    -> "conj-lhs"
+               Conj_Rhs    -> "conj-rhs"
+               Disj_Lhs    -> "disj-lhs"
+               Disj_Rhs    -> "disj-rhs"
+               Impl_Lhs    -> "antecedent"
+               Impl_Rhs    -> "consequent"
+               Eq_Lhs      -> "eq-lhs"
+               Eq_Rhs      -> "eq-rhs"
+               _ -> "Warning: Crumb should not be in use!  This is probably Neil's fault."
 
-{-
--- | Earlier versions of HERMIT used 'Int' as the crumb type.
---   This function maps a 'Crumb' back to that corresponding 'Int', for backwards compatibility purposes.
-crumbToDeprecatedInt :: Crumb -> Maybe Int
-crumbToDeprecatedInt = \case
-                          ModGuts_Prog   -> Just 0
-                          ProgCons_Bind  -> Just 0
-                          ProgCons_Tail  -> Just 1
-                          NonRec_RHS     -> Just 0
-                          NonRec_Var     -> Nothing
-                          Rec_Def n      -> Just n
-                          Def_Id         -> Nothing
-                          Def_RHS        -> Just 0
-                          App_Fun        -> Just 0
-                          App_Arg        -> Just 1
-                          Lam_Var        -> Nothing
-                          Lam_Body       -> Just 0
-                          Let_Bind       -> Just 0
-                          Let_Body       -> Just 1
-                          Case_Scrutinee -> Just 0
-                          Case_Binder    -> Nothing
-                          Case_Type      -> Nothing
-                          Case_Alt n     -> Just (n + 1)
-                          Cast_Expr      -> Just 0
-                          Cast_Co        -> Nothing
-                          Tick_Tick      -> Nothing
-                          Tick_Expr      -> Just 0
-                          Type_Type      -> Nothing
-                          Co_Co          -> Nothing
-                          Alt_Con        -> Nothing
-                          Alt_Var _      -> Nothing
-                          Alt_RHS        -> Just 0
--}
 -- | Converts a 'Crumb' into the 'Crumb' pointing to its left-sibling, if a such a 'Crumb' exists.
---   This is for backwards compatibility purposes with the old Int representation.
-deprecatedLeftSibling :: Crumb -> Maybe Crumb
-deprecatedLeftSibling = \case
-                           ProgCons_Tail       -> Just ProgCons_Head
-                           Rec_Def n | n > 0   -> Just (Rec_Def (n-1))
-                           App_Arg             -> Just App_Fun
-                           Let_Body            -> Just Let_Bind
-                           Case_Alt n | n == 0 -> Just Case_Scrutinee
-                                      | n >  0 -> Just (Case_Alt (n-1))
-                           _                   -> Nothing
+--   This is used for moving 'left' in the shell.
+leftSibling :: Crumb -> Maybe Crumb
+leftSibling = \case
+                   ProgCons_Tail       -> Just ProgCons_Head
+                   Rec_Def n | n > 0   -> Just (Rec_Def (n-1))
+                   App_Arg             -> Just App_Fun
+                   Let_Body            -> Just Let_Bind
+                   Case_Alt n | n == 0 -> Just Case_Scrutinee
+                              | n >  0 -> Just (Case_Alt (n-1))
+                   _                   -> Nothing
 
 -- | Converts a 'Crumb' into the 'Crumb' pointing to its right-sibling, if a such a 'Crumb' exists.
---   This is for backwards compatibility purposes with the old Int representation.
-deprecatedRightSibling :: Crumb -> Maybe Crumb
-deprecatedRightSibling = \case
-                           ProgCons_Head       -> Just ProgCons_Tail
-                           Rec_Def n           -> Just (Rec_Def (n+1))
-                           App_Fun             -> Just App_Arg
-                           Let_Bind            -> Just Let_Body
-                           Case_Scrutinee      -> Just (Case_Alt 0)
-                           Case_Alt n          -> Just (Case_Alt (n+1))
-                           _                   -> Nothing
-
+--   This is used for moving 'right' in the shell.
+rightSibling :: Crumb -> Maybe Crumb
+rightSibling = \case
+                   ProgCons_Head       -> Just ProgCons_Tail
+                   Rec_Def n           -> Just (Rec_Def (n+1))
+                   App_Fun             -> Just App_Arg
+                   Let_Bind            -> Just Let_Body
+                   Case_Scrutinee      -> Just (Case_Alt 0)
+                   Case_Alt n          -> Just (Case_Alt (n+1))
+                   _                   -> Nothing
 
 -----------------------------------------------------------------------
+
+-- | Substitute all occurrences of a variable with an expression, in an expression.
+substCoreExpr :: Var -> CoreExpr -> (CoreExpr -> CoreExpr)
+substCoreExpr v e expr = substExpr (text "substCoreExpr") (extendSubst emptySub v e) expr
+    where emptySub = mkEmptySubst (mkInScopeSet (localFreeVarsExpr (Let (NonRec v e) expr)))
+
+-- | Substitute all occurrences of a variable with an expression, in a case alternative.
+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)
+
+-- | Beta-reduce as many lambda-binders as possible.
+betaReduceAll :: CoreExpr -> [CoreExpr] -> (CoreExpr, [CoreExpr])
+betaReduceAll (Lam v body) (a:as) = betaReduceAll (substCoreExpr v a body) as
+betaReduceAll e            as     = (e,as)
+
+-- | Build a constructor application.
+--   Accepts a list of types to which the type constructor is instantiated. Ex.
+--
+-- > data T a b = C a b Int
+--
+-- Pseudocode:
+--
+-- > mkDataConApp [a',b'] C [x,y,z] ==> C a' b' (x::a') (y::b') (z::Int) :: T a' b'
+--
+mkDataConApp :: [Type] -> DataCon -> [Var] -> CoreExpr
+mkDataConApp tys dc vs = mkCoreConApps dc (map Type tys ++ map (varToCoreExpr . zapVarOccInfo) vs)
diff --git a/src/HERMIT/Dictionary.hs b/src/HERMIT/Dictionary.hs
--- a/src/HERMIT/Dictionary.hs
+++ b/src/HERMIT/Dictionary.hs
@@ -16,6 +16,7 @@
     , module HERMIT.Dictionary.New
     , module HERMIT.Dictionary.Query
     , module HERMIT.Dictionary.Reasoning
+    , module HERMIT.Dictionary.Remembered
     , module HERMIT.Dictionary.Rules
     , module HERMIT.Dictionary.Undefined
     , module HERMIT.Dictionary.Unfold
@@ -57,6 +58,8 @@
 import qualified HERMIT.Dictionary.Query as Query
 import           HERMIT.Dictionary.Reasoning hiding (externals)
 import qualified HERMIT.Dictionary.Reasoning as Reasoning
+import           HERMIT.Dictionary.Remembered hiding (externals)
+import qualified HERMIT.Dictionary.Remembered as Remembered
 import           HERMIT.Dictionary.Rules hiding (externals)
 import qualified HERMIT.Dictionary.Rules as Rules
 import           HERMIT.Dictionary.Undefined hiding (externals)
@@ -71,7 +74,12 @@
 import qualified HERMIT.Dictionary.WorkerWrapper.Fix as WorkerWrapperFix
 import           HERMIT.Dictionary.WorkerWrapper.FixResult hiding (externals)
 import qualified HERMIT.Dictionary.WorkerWrapper.FixResult as WorkerWrapperFixResult
+--------------------------------------------------------------------------
 
+import qualified HERMIT.PrettyPrinter.AST as AST
+import qualified HERMIT.PrettyPrinter.Clean as Clean
+import qualified HERMIT.PrettyPrinter.GHC as GHCPP
+
 --------------------------------------------------------------------------
 
 -- | List of all 'External's provided by HERMIT.
@@ -91,6 +99,7 @@
     ++ New.externals
     ++ Query.externals
     ++ Reasoning.externals
+    ++ Remembered.externals
     ++ Rules.externals
     ++ Undefined.externals
     ++ Unfold.externals
@@ -98,5 +107,8 @@
     ++ WorkerWrapperCommon.externals
     ++ WorkerWrapperFix.externals
     ++ WorkerWrapperFixResult.externals
+    ++ AST.externals
+    ++ Clean.externals
+    ++ GHCPP.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
@@ -54,33 +54,33 @@
 -- | Externals for alpha-renaming.
 externals :: [External]
 externals = map (.+ Deep)
-         [  external "alpha" (alphaR :: RewriteH Core)
+         [  external "alpha" (promoteCoreR alphaR :: RewriteH LCore)
                [ "Renames the bound variables at the current node."]
-         ,  external "alpha-lam" (promoteExprR . alphaLamR . Just :: String -> RewriteH Core)
+         ,  external "alpha-lam" (promoteExprR . alphaLamR . Just :: String -> RewriteH LCore)
                [ "Renames the bound variable in a Lambda expression to the given name."]
-         ,  external "alpha-lam" (promoteExprR  (alphaLamR Nothing) :: RewriteH Core)
+         ,  external "alpha-lam" (promoteExprR  (alphaLamR Nothing) :: RewriteH LCore)
                [ "Renames the bound variable in a Lambda expression."]
-         ,  external "alpha-case-binder" (promoteExprR . alphaCaseBinderR . Just :: String -> RewriteH Core)
+         ,  external "alpha-case-binder" (promoteExprR . alphaCaseBinderR . Just :: String -> RewriteH LCore)
                [ "Renames the binder in a Case expression to the given name."]
-         ,  external "alpha-case-binder" (promoteExprR (alphaCaseBinderR Nothing) :: RewriteH Core)
+         ,  external "alpha-case-binder" (promoteExprR (alphaCaseBinderR Nothing) :: RewriteH LCore)
                [ "Renames the binder in a Case expression."]
-         ,  external "alpha-alt" (promoteAltR alphaAltR :: RewriteH Core)
+         ,  external "alpha-alt" (promoteAltR alphaAltR :: RewriteH LCore)
                [ "Renames all binders in a Case alternative."]
-         ,  external "alpha-alt" (promoteAltR . alphaAltWithR :: [String] -> RewriteH Core)
+         ,  external "alpha-alt" (promoteAltR . alphaAltWithR :: [String] -> RewriteH LCore)
                [ "Renames all binders in a Case alternative using the user-provided list of new names."]
-         ,  external "alpha-case" (promoteExprR alphaCaseR :: RewriteH Core)
+         ,  external "alpha-case" (promoteExprR alphaCaseR :: RewriteH LCore)
                [ "Renames all binders in a Case alternative."]
-         ,  external "alpha-let" (promoteExprR . alphaLetWithR :: [String] -> RewriteH Core)
+         ,  external "alpha-let" (promoteExprR . alphaLetWithR :: [String] -> RewriteH LCore)
                [ "Renames the bound variables in a Let expression using a list of suggested names."]
-         ,  external "alpha-let" (promoteExprR alphaLetR :: RewriteH Core)
+         ,  external "alpha-let" (promoteExprR alphaLetR :: RewriteH LCore)
                [ "Renames the bound variables in a Let expression."]
-         ,  external "alpha-top" (promoteProgR . alphaProgConsWithR :: [String] -> RewriteH Core)
+         ,  external "alpha-top" (promoteProgR . alphaProgConsWithR :: [String] -> RewriteH LCore)
                [ "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 alphaProgConsR :: RewriteH Core)
+         ,  external "alpha-top" (promoteProgR alphaProgConsR :: RewriteH LCore)
                [ "Renames the bound identifiers in the top-level binding at the head of the program."]
-         ,  external "alpha-prog" (promoteProgR alphaProgR :: RewriteH Core)
+         ,  external "alpha-prog" (promoteProgR alphaProgR :: RewriteH LCore)
                [ "Rename all top-level identifiers in the program."]
-         ,  external "unshadow" (unshadowR :: RewriteH Core)
+         ,  external "unshadow" (promoteCoreR unshadowR :: RewriteH LCore)
                 [ "Rename local variables with manifestly unique names (x, x0, x1, ...)."]
          ]
 
@@ -99,7 +99,8 @@
 
 -- | Collect all visible variables (in the expression or the context).
 visibleVarsT :: (BoundVars c, Monad m) => Transform c m CoreTC VarSet
-visibleVarsT = liftM2 unionVarSet boundVarsT (arr freeVarsCoreTC)
+visibleVarsT = -- TODO: implement freeVarsLCoreTC
+               liftM2 unionVarSet boundVarsT (promoteT $ arr freeVarsCoreTC)
 
 -- | If a name is provided, use that as the name of the new variable.
 --   Otherwise modify the variable name making sure to /not/ clash with the given variables or any visible variables.
@@ -403,6 +404,8 @@
 --       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.
 
 -- TODO 2: Also, we should be able to rename inside types and coercions.
+
+-- TODO 3: Also, we should be able to rename lemma quantifiers
 
 -----------------------------------------------------------------------
 
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
@@ -36,7 +36,6 @@
     , varBindingDepthT
     , varIsOccurrenceOfT
     , exprIsOccurrenceOfT
-    , inScope
     , withVarsInScope
       -- Miscellaneous
     , wrongExprForm
@@ -91,9 +90,9 @@
 
 -- | Succeeds if we are looking at a fully saturated function call.
 callSaturatedT :: Monad m => Transform c m CoreExpr (CoreExpr, [CoreExpr])
-callSaturatedT = callPredT (\ i args -> idArity i == length args)
--- TODO: probably better to calculate arity based on Id's type, as
---       idArity is conservatively set to zero by default.
+callSaturatedT = callPredT (\ i args -> let (tvs, ty) = splitForAllTys (varType i)
+                                            (bs,_) = splitFunTys ty
+                                        in (length tvs + length bs) == length args)
 
 -- | Succeeds if we are looking at an application of given function
 callNameG :: MonadCatch m => HermitName -> Transform c m CoreExpr ()
@@ -213,19 +212,6 @@
 findTypeT :: (BoundVars c, HasHermitMEnv m, HasHscEnv m, MonadCatch m, MonadIO m, MonadThings m)
           => HermitName -> Transform c m a Type
 findTypeT nm = prefixFailMsg ("Cannot resolve name " ++ show nm ++ ", ") $ contextonlyT (findType nm)
-
--- TODO: "inScope" was defined elsewhere, but I've moved it here.  Should it be combined with the above functions?
--- Used in Dictionary.Inline to check if variables an in scope.
--- Used in Dictionary.Fold
-
--- | 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)
 
 -- | Modify transformation to apply to current expression as if it were the body of a lambda binding the given variables.
 withVarsInScope :: (AddBindings c, ReadPath c Crumb) => [Var] -> Transform c m a b -> Transform c m a 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
@@ -14,6 +14,7 @@
     ) where
 
 import Control.Arrow
+import Control.Monad
 
 import Data.String (fromString)
 
@@ -25,6 +26,7 @@
 import HERMIT.Monad
 import HERMIT.Name
 
+import HERMIT.Dictionary.Common
 import HERMIT.Dictionary.Debug hiding (externals)
 import HERMIT.Dictionary.GHC hiding (externals)
 import HERMIT.Dictionary.Inline hiding (externals)
@@ -35,24 +37,24 @@
 
 externals ::  [External]
 externals =
-    [ external "unfold-basic-combinator" (promoteExprR unfoldBasicCombinatorR :: RewriteH Core)
+    [ external "unfold-basic-combinator" (promoteExprR unfoldBasicCombinatorR :: RewriteH LCore)
         [ "Unfold the current expression if it is one of the basic combinators:"
         , "($), (.), id, flip, const, fst, snd, curry, and uncurry." ]
-    , external "simplify" (simplifyR :: RewriteH Core)
+    , external "simplify" (simplifyR :: RewriteH LCore)
         [ "innermost (unfold-basic-combinator <+ beta-reduce-plus <+ safe-let-subst <+ case-reduce <+ let-elim)" ]
-    , external "bash" (bashR :: RewriteH Core)
+    , external "bash" (bashR :: RewriteH LCore)
         bashHelp .+ Eval .+ Deep .+ Loop
-    , external "smash" (smashR :: RewriteH Core)
+    , external "smash" (smashR :: RewriteH LCore)
         smashHelp .+ Eval .+ Deep .+ Loop .+ Experiment
-    , external "bash-extended-with" (bashExtendedWithR :: [RewriteH Core] -> RewriteH Core)
+    , external "bash-extended-with" (bashExtendedWithR :: [RewriteH LCore] -> RewriteH LCore)
         [ "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)
+    , external "smash-extended-with" (smashExtendedWithR :: [RewriteH LCore] -> RewriteH LCore)
         [ "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)
+    , external "bash-debug" (bashDebugR :: RewriteH LCore)
         [ "verbose bash - most useful with set-auto-corelint True" ] .+ Eval .+ Deep .+ Loop
     ]
 
@@ -67,11 +69,13 @@
 unfoldBasicCombinatorR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
                           , MonadCatch m )
                        => Rewrite c m CoreExpr
-unfoldBasicCombinatorR = setFailMsg "unfold-basic-combinator failed." $ unfoldNamesR basicCombinators
+unfoldBasicCombinatorR = setFailMsg "unfold-basic-combinator failed." $ orR (map f basicCombinators)
+    where f nm = voidM (callNameT nm) >> voidM callSaturatedT >> unfoldR
+          voidM = liftM (const ()) -- can't wait for AMP
 
 simplifyR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
              , MonadCatch m, MonadUnique m )
-          => Rewrite c m Core
+          => Rewrite c m LCore
 simplifyR = setFailMsg "Simplify failed: nothing to simplify." $
     innermostR (   promoteBindR recToNonrecR
                 <+ promoteExprR ( unfoldBasicCombinatorR
@@ -91,13 +95,13 @@
 -- IdInfo attributes relied-upon by GHC.
 bashR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
          , MonadCatch m, MonadUnique m )
-      => Rewrite c m Core
+      => Rewrite c m LCore
 bashR = bashExtendedWithR []
 
 -- | An extensible bash. Given rewrites are performed before normal bash rewrites.
 bashExtendedWithR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
                      , MonadCatch m, MonadUnique m )
-                  => [Rewrite c m Core] -> Rewrite c m Core
+                  => [Rewrite c m LCore] -> Rewrite c m LCore
 bashExtendedWithR rs = bashUsingR (rs ++ map fst bashComponents)
 
 -- | Like 'bashR', but outputs name of each successful sub-rewrite, providing a log.
@@ -107,13 +111,13 @@
 -- Useful for debugging the bash command itself.
 bashDebugR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
               , HasDebugChan m, HasDynFlags m, MonadCatch m, MonadUnique m )
-           => Rewrite c m Core
+           => Rewrite c m LCore
 bashDebugR = bashUsingR [ bracketR nm r >>> catchM (promoteT lintExprT >> idR) traceR
                         | (r,nm) <- bashComponents ]
 
 -- | Perform the 'bash' algorithm with a given list of rewrites.
 bashUsingR :: (AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadPath c Crumb, MonadCatch m)
-           => [Rewrite c m Core] -> Rewrite c m Core
+           => [Rewrite c m LCore] -> Rewrite c m LCore
 bashUsingR rs = setFailMsg "bash failed: nothing to do." $
     repeatR (occurAnalyseR >>> onetdR (catchesT rs)) >+> anytdR (promoteExprR dezombifyR) >+> occurAnalyseChangedR
 
@@ -134,12 +138,12 @@
 
 bashHelp :: [String]
 bashHelp = "Iteratively apply the following rewrites until nothing changes:"
-         : map snd (bashComponents :: [(RewriteH Core,String)] -- to resolve ambiguity
+         : map snd (bashComponents :: [(RewriteH LCore,String)] -- to resolve ambiguity
                                                                                        )
 -- TODO: Think about a good order for bash.
 bashComponents :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
                   , MonadCatch m, MonadUnique m )
-               => [(Rewrite c m Core, String)]
+               => [(Rewrite c m LCore, String)]
 bashComponents =
   [ -- (promoteExprR occurAnalyseExprChangedR, "occur-analyse-expr")    -- ??
     (promoteExprR betaReduceR, "beta-reduce")                        -- O(1)
@@ -176,16 +180,16 @@
 -- and is intended for use during proving tasks.
 smashR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
           , MonadCatch m, MonadUnique m )
-       => Rewrite c m Core
+       => Rewrite c m LCore
 smashR = smashExtendedWithR []
 
 smashExtendedWithR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
                       , MonadCatch m, MonadUnique m )
-                   => [Rewrite c m Core] -> Rewrite c m Core
+                   => [Rewrite c m LCore] -> Rewrite c m LCore
 smashExtendedWithR rs = smashUsingR (rs ++ map fst smashComponents1) (map fst smashComponents2)
 
 
-smashUsingR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => [Rewrite c m Core] -> [Rewrite c m Core] -> Rewrite c m Core
+smashUsingR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => [Rewrite c m LCore] -> [Rewrite c m LCore] -> Rewrite c m LCore
 smashUsingR rs1 rs2 =
     setFailMsg "smash failed: nothing to do." $
     repeatR (occurAnalyseR >>> (onetdR (catchesT rs1) <+ onetdR (catchesT rs2))) >+> anytdR (promoteExprR dezombifyR) >+> occurAnalyseChangedR
@@ -193,14 +197,14 @@
 
 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
+                                                                                           :: [(RewriteH LCore,String)] -- to resolve ambiguity
                                                                                         )
 
 
 -- | As bash, but with "let-nonrec-subst" instead of "let-nonrec-subst-safe".
 smashComponents1 :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
                     , MonadCatch m, MonadUnique m )
-                 => [(Rewrite c m Core, String)]
+                 => [(Rewrite c m LCore, String)]
 smashComponents1 =
   [ -- (promoteExprR occurAnalyseExprChangedR, "occur-analyse-expr")    -- ??
     (promoteExprR betaReduceR, "beta-reduce")                        -- O(1)
@@ -226,12 +230,14 @@
   , (promoteProgR letFloatTopR, "let-float-top")                     -- O(n)
   , (promoteExprR castElimReflR, "cast-elim-refl")                   -- O(1)
   , (promoteExprR castElimSymR, "cast-elim-sym")                     -- O(1)
+  , (promoteExprR castFloatAppR, "cast-float-app")                   -- O(1)
+  , (promoteExprR castFloatLamR, "cast-float-lam")                   -- O(1)
 --  , (promoteExprR dezombifyR, "dezombify")                           -- O(1) -- performed at the end
   ]
 
 smashComponents2 :: ( ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c, HasEmptyContext c
                     , MonadCatch m, MonadUnique m )
-                 => [(Rewrite c m Core, String)]
+                 => [(Rewrite c m LCore, String)]
 smashComponents2 =
     [ (promoteExprR caseElimMergeAltsR, "case-elim-merge-alts") -- do this last, lest it prevent other simplifications
     ]
diff --git a/src/HERMIT/Dictionary/Debug.hs b/src/HERMIT/Dictionary/Debug.hs
--- a/src/HERMIT/Dictionary/Debug.hs
+++ b/src/HERMIT/Dictionary/Debug.hs
@@ -19,23 +19,23 @@
 -- | Exposed debugging 'External's.
 externals :: [External]
 externals = map (.+ Debug)
-    [ external "trace" (traceR :: String -> RewriteH Core)
+    [ external "trace" (traceR :: String -> RewriteH LCoreTC)
         [ "give a side-effect message as output when processing this command" ]
-    , external "observe" (observeR :: String -> RewriteH Core)
+    , external "observe" (observeR :: String -> RewriteH LCoreTC)
         [ "give a side-effect message as output, and observe the value being processed" ]
-    , external "observe-failure" (observeFailureR :: String -> RewriteH Core -> RewriteH Core)
+    , external "observe-failure" (observeFailureR :: String -> RewriteH LCoreTC -> RewriteH LCoreTC)
         [ "give a side-effect message if the rewrite fails, including the failing input" ]
-    , external "bracket" (bracketR :: String -> RewriteH Core -> RewriteH Core)
+    , external "bracket" (bracketR :: String -> RewriteH LCoreTC -> RewriteH LCoreTC)
         [ "if given rewrite succeeds, see its input and output" ]
     ]
 
 -- | If the 'Rewrite' fails, print out the 'Core', with a message.
-observeFailureR :: (Injection a CoreTC, ReadBindings c, ReadPath c Crumb, HasDebugChan m, MonadCatch m)
+observeFailureR :: (Injection a LCoreTC, ReadBindings c, ReadPath c Crumb, HasDebugChan m, MonadCatch m)
                 => String -> Rewrite c m a -> Rewrite c m a
 observeFailureR str m = m <+ observeR str
 
 -- | Print out the 'Core', with a message.
-observeR :: (Injection a CoreTC, ReadBindings c, ReadPath c Crumb, HasDebugChan m, Monad m)
+observeR :: (Injection a LCoreTC, ReadBindings c, ReadPath c Crumb, HasDebugChan m, Monad m)
          => String -> Rewrite c m a
 observeR msg = extractR $ sideEffectR $ \ cxt -> sendDebugMessage . DebugCore msg cxt
 
@@ -44,7 +44,7 @@
 traceR msg = sideEffectR $ \ _ _ -> sendDebugMessage $ DebugTick msg
 
 -- | Show before and after a rewrite.
-bracketR :: (Injection a CoreTC, ReadBindings c, ReadPath c Crumb, HasDebugChan m, MonadCatch m)
+bracketR :: (Injection a LCoreTC, ReadBindings c, ReadPath c Crumb, HasDebugChan m, MonadCatch m)
          => String -> Rewrite c m a -> Rewrite c m a
 bracketR msg rr = do
     -- Be careful to only run the rr once, in case it has side effects.
@@ -53,4 +53,3 @@
                             return e' >>> observeR after) r
     where before = msg ++ " (before)"
           after  = msg ++ " (after)"
--- attemptM :: MonadCatch m => m a -> m (Either String a)
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
@@ -14,7 +14,6 @@
     , isFixExprT
     ) where
 
-import Control.Applicative
 import Control.Arrow
 import Control.Monad
 import Control.Monad.IO.Class
@@ -43,21 +42,21 @@
 -- | Externals for manipulating fixed points.
 externals ::  [External]
 externals =
-    [ external "fix-intro" (fixIntroR :: RewriteH Core)
+    [ external "fix-intro" (promoteCoreR fixIntroR :: RewriteH LCore)
         [ "rewrite a function binding into a non-recursive binding using fix" ] .+ Introduce .+ Context
-    , external "fix-computation-rule" (promoteExprBiR fixComputationRuleBR :: BiRewriteH Core)
+    , external "fix-computation-rule" (promoteExprBiR fixComputationRuleBR :: BiRewriteH LCore)
         [ "Fixed-Point Computation Rule",
           "fix t f  <==>  f (fix t f)"
         ] .+ Context
-    , external "fix-rolling-rule" (promoteExprBiR fixRollingRuleBR :: BiRewriteH Core)
+    , external "fix-rolling-rule" (promoteExprBiR fixRollingRuleBR :: BiRewriteH LCore)
         [ "Rolling Rule",
           "fix tyA (\\ a -> f (g a))  <==>  f (fix tyB (\\ b -> g (f b))"
         ] .+ Context
     , external "fix-fusion-rule" ((\ f g h r1 r2 strictf -> promoteExprBiR
                                                                 (fixFusionRule (Just (r1,r2)) (Just strictf) f g h))
                                                                 :: CoreString -> CoreString -> CoreString
-                                                                    -> RewriteH Core -> RewriteH Core
-                                                                    -> RewriteH Core -> BiRewriteH Core)
+                                                                    -> RewriteH LCore -> RewriteH LCore
+                                                                    -> RewriteH LCore -> BiRewriteH LCore)
         [ "Fixed-point Fusion Rule"
         , "Given f :: A -> B, g :: A -> A, h :: B -> B, and"
         , "proofs that, for some x, (f (g a) ==> x) and (h (f a) ==> x) and that f is strict, then"
@@ -65,7 +64,7 @@
         ] .+ Context
     , external "fix-fusion-rule-unsafe" ((\ f g h r1 r2 -> promoteExprBiR (fixFusionRule (Just (r1,r2)) Nothing f g h))
                                                             :: CoreString -> CoreString -> CoreString
-                                                                -> RewriteH Core -> RewriteH Core -> BiRewriteH Core)
+                                                                -> RewriteH LCore -> RewriteH LCore -> BiRewriteH LCore)
         [ "(Unsafe) Fixed-point Fusion Rule"
         , "Given f :: A -> B, g :: A -> A, h :: B -> B, and"
         , "a proof that, for some x, (f (g a) ==> x) and (h (f a) ==> x), then"
@@ -73,7 +72,7 @@
         , "Note that the precondition that f is strict is required to hold."
         ] .+ Context .+ PreCondition
     , external "fix-fusion-rule-unsafe" ((\ f g h -> promoteExprBiR (fixFusionRule Nothing Nothing f g h))
-                                                        :: CoreString -> CoreString -> CoreString -> BiRewriteH Core)
+                                                        :: CoreString -> CoreString -> CoreString -> BiRewriteH LCore)
         [ "(Very Unsafe) Fixed-point Fusion Rule"
         , "Given f :: A -> B, g :: A -> A, h :: B -> B, then"
         , "f (fix g) <==> fix h"
@@ -216,7 +215,7 @@
                        App f <$> buildFixT g
 
 -- | If @f@ is strict, then (@f (g a)@ == @h (f a)@)  ==>  (@f (fix g)@ == @fix h@)
-fixFusionRule :: Maybe (RewriteH Core, RewriteH Core) -> Maybe (RewriteH Core) -> CoreString -> CoreString -> CoreString -> BiRewriteH CoreExpr
+fixFusionRule :: Maybe (RewriteH LCore, RewriteH LCore) -> Maybe (RewriteH LCore) -> CoreString -> CoreString -> CoreString -> BiRewriteH CoreExpr
 fixFusionRule meq mfstrict = parse3beforeBiR $ fixFusionRuleBR ((extractR *** extractR) <$> meq) (extractR <$> mfstrict)
 
 --------------------------------------------------------------------------------------------------
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
@@ -1,42 +1,61 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 module HERMIT.Dictionary.Fold
     ( -- * Fold/Unfold Transformation
       externals
     , foldR
     , foldVarR
-    , stashFoldR
-    , stashFoldAnyR
+    , foldVarConfigR
+    , runFoldR
       -- * Unlifted fold interface
-    , fold
-    , unifyTypes -- TODO: remove in favor of GHC's unification
-    , tyMatchesToCoreExpr
+    , fold, compileFold, runFold, runFoldMatches, CompiledFold
+    , proves -- for now
+    , lemmaMatch
+      -- * Equality
+    , Equality(..)
+    , toEqualities
+    , flipEquality
+    , freeVarsEquality
+    , ppEqualityT
     ) where
 
 import Control.Arrow
-import Control.Applicative
 import Control.Monad
 import Control.Monad.IO.Class
 
-import qualified Data.Map as Map
+import Data.List (delete, (\\), intersect)
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, fromMaybe, maybeToList)
+import qualified Data.IntMap.Lazy as I
+import Data.Typeable
 
 import HERMIT.Core
 import HERMIT.Context
 import HERMIT.External
 import HERMIT.GHC
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
 import HERMIT.Name
+import HERMIT.Utilities
 
-import HERMIT.Dictionary.Common (varBindingDepthT,inScope,findIdT)
+import HERMIT.Dictionary.Common (varBindingDepthT,findIdT)
 import HERMIT.Dictionary.Inline hiding (externals)
 
+import HERMIT.PrettyPrinter.Common
+import qualified Text.PrettyPrint.MarkedHughesPJ as PP
+
 import Prelude hiding (exp)
 
 ------------------------------------------------------------------------
 
 externals :: [External]
 externals =
-    [ external "fold" (promoteExprR . foldR :: HermitName -> RewriteH Core)
+    [ external "fold" (promoteExprR . foldR :: HermitName -> RewriteH LCore)
         [ "fold a definition"
         , ""
         , "double :: Int -> Int"
@@ -48,208 +67,580 @@
         , ""
         , "Note: due to associativity, if you wanted to fold 5 + 6 + 6, "
         , "you first need to apply an associativity rewrite." ]  .+ Context .+ Deep
-    , external "fold-remembered" (promoteExprR . stashFoldR :: RememberedName -> 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
     ]
 
 ------------------------------------------------------------------------
 
-stashFoldR :: (ReadBindings c, HasStash m, MonadCatch m) => RememberedName -> Rewrite c m CoreExpr
-stashFoldR label = prefixFailMsg "Fold failed: " $
-    transform $ \ c e -> do
-        Def i rhs <- lookupDef label
-        guardMsg (inScope c i) $ unqualifiedName i ++ " is not in scope.\n(A common cause of this error is trying to fold a recursive call while being in the body of a non-recursive definition.  This can be resolved by calling \"nonrec-to-rec\" on the non-recursive binding group.)"
-        maybe (fail "no match.")
-              return
-              (fold i rhs e)
-
-stashFoldAnyR :: (ReadBindings c, HasStash m, MonadCatch m) => Rewrite c m CoreExpr
-stashFoldAnyR = setFailMsg "Fold failed: no definitions could be folded." $
-                catchesM =<< liftM (map stashFoldR) (liftM Map.keys (constT getStash))
-
 foldR :: (ReadBindings c, HasHermitMEnv m, HasHscEnv m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m)
       => HermitName -> Rewrite c m CoreExpr
 foldR nm = prefixFailMsg "Fold failed: " $ findIdT nm >>= foldVarR Nothing
 
 foldVarR :: (ReadBindings c, MonadCatch m, MonadUnique m) => Maybe BindingDepth -> Var -> Rewrite c m CoreExpr
-foldVarR md v = do
+foldVarR = foldVarConfigR AllBinders
+
+foldVarConfigR :: (ReadBindings c, MonadCatch m, MonadUnique m)
+               => InlineConfig -> Maybe BindingDepth -> Var -> Rewrite c m CoreExpr
+foldVarConfigR config md v = 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)
+    rhss <- liftM (map fst) $ getUnfoldingsT config <<< return v
+    transform $ \ c -> maybeM "no match." . fold [mkEquality [] rhs (varToCoreExpr v) | rhs <- rhss] c
 
+-- | Rewrite using a compiled fold. Useful inside traversal strategies like
+-- anytdR, because you can compile the fold once outside the traversal, then
+-- apply it everywhere in the tree.
+runFoldR :: (BoundVars c, Monad m) => CompiledFold -> Rewrite c m CoreExpr
+runFoldR compiled = transform $ \c -> maybeM "no match." . runFold compiled c
+
 ------------------------------------------------------------------------
 
-countBinders :: CoreExpr -> Int
-countBinders e = length vs
-    where (vs,_) = collectBinders e
+newtype CompiledFold = CompiledFold (EMap ([Var], CoreExpr))
 
-collectNBinders :: Int -> CoreExpr -> Maybe ([Var], CoreExpr)
-collectNBinders = go []
-  where
-    go bs 0 e         = return (reverse bs, e)
-    go bs i (Lam b e) = go (b:bs) (i-1) e
-    go _ _  _         = Nothing
+-- | Attempt to apply a list of Equalitys to the given expression, folding the
+-- left-hand side into an application of the right-hand side. This
+-- implementation depends on `Equality` being well-formed. That is, both the
+-- LHS and RHS are NOT lambda expressions. Always use `mkEquality` to ensure
+-- this is the case.
+fold :: BoundVars c => [Equality] -> c -> CoreExpr -> Maybe CoreExpr
+fold = runFold . compileFold
 
-unifyHoles :: Ord k
-           => [k]              -- keys we care about (TODO: figure out what else is getting in there)
-           -> (a -> a -> Bool) -- notion of equality
-           -> [(k,a)]          -- list of key/values
-           -> Maybe [(k,a)]    -- list of unified key/values, or failure
-unifyHoles vs eq kvs = do
-    -- return Nothing if not equal, so sequence will fail below
-    let checkEqual m1 m2 = ifM (eq <$> m1 <*> m2) m1 Nothing
-        m = Map.fromListWith checkEqual [(k,Just v) | (k,v) <- kvs ]
+-- | Compile a list of Equality's into a single fold matcher.
+compileFold :: [Equality] -> CompiledFold
+compileFold = CompiledFold . foldr addFold fEmpty
+    where addFold (Equality vs lhs rhs) =
+            let hs = vs `intersect` varSetElems (freeVarsExpr lhs)
+            in insertFold emptyAlphaEnv vs lhs (hs, rhs)
 
-    es <- sequence [ join (Map.lookup v m) | v <- vs ]
-    return $ zip vs es
+-- | Attempt to fold an expression using a matcher in a given context.
+runFold :: BoundVars c => CompiledFold -> c -> CoreExpr -> Maybe CoreExpr
+runFold f c e = fst <$> runFoldMatches f c e
 
-fold :: Id -> CoreExpr -> CoreExpr -> Maybe CoreExpr
-fold i lam exp = do
-    (vs,body) <- collectNBinders (countBinders lam - countBinders exp) lam
-    al <- foldMatch vs [] body exp
+-- | Attempt to fold an expression using a matcher in a given context.
+-- Return resulting expression and a map of what when in the holes in the pattern.
+runFoldMatches :: BoundVars c => CompiledFold -> c -> CoreExpr -> Maybe (CoreExpr, VarEnv CoreExpr)
+runFoldMatches (CompiledFold f) c exp = do
+    (hs, (vs', rhs')) <- soleElement $ filterOutOfScope c $ findFold exp f
+    args <- sequence [ lookupVarEnv hs v | v <- vs' ]
+    return (uncurry mkCoreApps $ betaReduceAll (mkCoreLams vs' rhs') args, hs)
 
-    es <- liftM (map snd) $ unifyHoles vs exprAlphaEq al
+insertFold :: Fold m => AlphaEnv -> [Var] -> Key m -> a -> m a -> m a
+insertFold env vs k x = fAlter env vs k (const (Just x))
 
-    return $ mkCoreApps (varToCoreExpr i) es
+findFold :: Fold m => Key m -> m a -> [(VarEnv CoreExpr, a)]
+findFold = fFold emptyVarEnv emptyAlphaEnv
 
--- 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
+filterOutOfScope :: BoundVars c => c -> [(VarEnv CoreExpr, ([Var], CoreExpr))] -> [(VarEnv CoreExpr, ([Var], CoreExpr))]
+filterOutOfScope c = go
+    where go [] = []
+          go (x@(_,(vs,e)):r)
+            | isEmptyVarSet (filterVarSet (not . inScope c) (delVarSetList (freeVarsExpr e) vs)) = x : go r
+            | otherwise = go r
 
-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))
+data AlphaEnv = AE { _aeNext :: Int, _aeEnv :: VarEnv Int }
 
+emptyAlphaEnv :: AlphaEnv
+emptyAlphaEnv = AE 0 emptyVarEnv
+
+extendAlphaEnv :: Var -> AlphaEnv -> AlphaEnv
+extendAlphaEnv v (AE i env) = AE (i+1) (extendVarEnv env v i)
+
+lookupAlphaEnv :: Var -> AlphaEnv -> Maybe Int
+lookupAlphaEnv v (AE _ env) = lookupVarEnv env v
+
 ------------------------------------------------------------------------
 
--- 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
-          -> [(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
+-- TODO: Maybe a -> a ??? -- we never need to delete
+type A a = Maybe a -> Maybe a
 
-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) -> 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 []
+toA :: Fold m => (m a -> m a) -> Maybe (m a) -> Maybe (m a)
+toA f = Just . f . fromMaybe fEmpty
 
-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)
+type LMap a = M.Map Literal a
+type BMap = TyMap -- Binders are de-bruijn indexed, so we only compare their types
 
-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)
+class Fold m where
+    type Key m :: *
+    fEmpty :: m a
+    fAlter :: AlphaEnv -> [Var] -> Key m -> A a -> m a -> m a
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key m -> m a -> [(VarEnv CoreExpr, a)]
 
--- 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
-        as' = foldr (uncurry addAlpha) as $ zip (map fst bnds) (map fst bnds')
-        bmatch (_,rhs) (_,rhs') = foldMatch vs' as' rhs rhs'
-    x <- zipWithM bmatch bnds bnds'
-    y <- foldMatch vs' as' e e'
-    return (concat x ++ y)
+-- TODO: Idea ... Generalized Tries with Effects
+--       Reader - De Bruijn indexing
+--       State-ish - Folding with hole filling
 
-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') = 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
-        altMatch (ac, is, e) (ac', is', e') | ac == ac' =
-            foldMatch (filter (`notElem` is) vs') (foldr (uncurry addAlpha) as' $ zip is' is) e e'
-        altMatch _ _ = Nothing
-    y <- zipWithM altMatch alts alts'
-    return (x ++ tyMatchesToCoreExpr t ++ concat y)
+-- Note [Var Uniques]
+-- Free variable occurrences can have the same unique at a different type!
+-- The reason is that when GHC substitutes into the type of the Var, it DOES NOT
+-- freshen the unique of the Var. This is not normally a problem for GHC, because
+-- if two Vars with the same unique are bound within scope of each other, one gets
+-- freshened at creation. However, with Lemmas, we have the possibility of applying
+-- a fold from one subtree to a completely different subtree, so can cross scopes.
+--
+-- To solve this, we first look up the Var by unique, then check it's type with a TyMap.
+-- This is unnecessary for bound vars, because their types are checked when we pass
+-- the binding itself.
 
-foldMatch vs as (Cast e c) (Cast e' c') = do
-    guard (coreEqCoercion c c')
-    foldMatch vs as e e'
+data VMap a = VM { bvmap :: I.IntMap a, fvmap :: VarEnv (TyMap a) } -- See Note [Var Uniques]
+            | VMEmpty
 
-foldMatch vs as (Type t1) (Type t2) = liftM tyMatchesToCoreExpr $ foldMatchType vs as t1 t2
+instance Fold VMap where
+    type Key VMap = Var
 
--- TODO: do we want to descend into these? There are Types in here.
-foldMatch _ _ (Coercion c) (Coercion c') | coreEqCoercion c c' = return []
+    fEmpty :: VMap a
+    fEmpty = VMEmpty
 
-foldMatch _ _ _ _ = Nothing
+    fAlter :: AlphaEnv -> [Var] -> Key VMap -> A a -> VMap a -> VMap a
+    fAlter env vs v f VMEmpty = fAlter env vs v f (VM I.empty emptyVarEnv)
+    fAlter env vs v f m@VM{}
+        | Just bv <- lookupAlphaEnv v env = m { bvmap = I.alter f bv (bvmap m) }
+        | otherwise                       = m { fvmap = alterVarEnv (toA (fAlter env vs (varType v) f)) (fvmap m) v }
 
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key VMap -> VMap a -> [(VarEnv CoreExpr, a)]
+    fFold _  _   _ VMEmpty = []
+    fFold hs env v m@VM{}
+        | Just bv <- lookupAlphaEnv v env = maybeToList $ (hs,) <$> I.lookup bv (bvmap m)
+        | otherwise                       = do
+            m' <- maybeToList $ lookupVarEnv (fvmap m) v
+            fFold hs env (varType v) m'
+
 ------------------------------------------------------------------------
 
--- | Given list of TyVars which can match any type (the holes),
--- a pattern, and a concrete type, return mapping from hole to type
--- for successful unification.
-unifyTypes :: [TyVar] -> Type -> Type -> Maybe [(TyVar, Type)]
-unifyTypes holes pat ty = do
-    al <- foldMatchType holes [] pat ty
-    -- unlike folding itself, we don't care that every hole is assigned
-    let found = [ v | (v,_) <- al, v `elem` holes ]
-    unifyHoles found typeAlphaEq al
+data TyMap a = TyMEmpty
+             | TyM { tmHole   :: TyMap (M.Map Var a)
+                   , tmVar    :: VMap a
+                   , tmApp    :: TyMap (TyMap a)
+                   , tmFun    :: TyMap (TyMap a)
+                   , tmTcApp  :: NameEnv (ListMap TyMap a)
+                   , tmForall :: TyMap (BMap a)
+                   , tmTyLit  :: TyLitMap a
+                   }
 
-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
+instance Fold TyMap where
+    type Key TyMap = Type
 
--- look through type synonyms
-foldMatchType vs as t1 t2 | Just t1' <- tcView t1 = foldMatchType vs as t1' t2
-                          | Just t2' <- tcView t2 = foldMatchType vs as t1 t2'
+    fEmpty :: TyMap a
+    fEmpty = TyMEmpty
 
-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
+    fAlter :: AlphaEnv -> [Var] -> Key TyMap -> A a -> TyMap a -> TyMap a
+    fAlter env vs ty f TyMEmpty = fAlter env vs ty f (TyM fEmpty fEmpty fEmpty fEmpty emptyNameEnv fEmpty fEmpty)
+    fAlter env vs ty f m@TyM{} = go ty
+        where go (TyVarTy v)
+                | v `elem` vs  = m { tmHole = fAlter env vs (varType v) (Just . M.alter f v . fromMaybe M.empty) (tmHole m) }
+                | otherwise    = m { tmVar = fAlter env vs v f (tmVar m) }
+              go (AppTy t1 t2) = m { tmApp = fAlter env vs t1 (toA (fAlter env vs t2 f)) (tmApp m) }
+              go (FunTy t1 t2) = m { tmFun = fAlter env vs t1 (toA (fAlter env vs t2 f)) (tmFun m) }
+              go (TyConApp tc tys) = m { tmTcApp = alterNameEnv (toA (fAlter env vs tys f)) (tmTcApp m) (getName tc) }
+              go (ForAllTy tv t) = m { tmForall = fAlter (extendAlphaEnv tv env) (delete tv vs) t
+                                                         (toA (fAlter env vs (varType tv) f)) (tmForall m) }
+              go (LitTy l)     = m { tmTyLit = fAlter env vs l f (tmTyLit m) }
 
-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)
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key TyMap -> TyMap a -> [(VarEnv CoreExpr, a)]
+    fFold _ _ _ TyMEmpty = []
+    fFold hs env ty m@TyM{} = hss ++ go ty
+        where hss = do
+                (hs', m') <- fFold hs env (typeKind ty) (tmHole m)
+                extendResult m' (Type ty) hs'
 
-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
+              go (TyVarTy v) = fFold hs env v (tmVar m)
+              go (AppTy t1 t2) = do
+                (hs', m') <- fFold hs env t1 (tmApp m)
+                fFold hs' env t2 m'
+              go (FunTy t1 t2) = do
+                (hs', m') <- fFold hs env t1 (tmFun m)
+                fFold hs' env t2 m'
+              go (TyConApp tc tys) = maybeToList (lookupNameEnv (tmTcApp m) (getName tc)) >>= fFold hs env tys
+              go (ForAllTy tv t) = do
+                (hs', m') <- fFold hs (extendAlphaEnv tv env) t (tmForall m)
+                fFold hs' env (varType tv) m'
+              go (LitTy l) = fFold hs env l (tmTyLit m)
 
-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'
+data TyLitMap a = TLM { tlmNumber :: M.Map Integer a
+                      , tlmString :: M.Map FastString a
+                      }
 
-foldMatchType _ _ (LitTy l1) (LitTy l2) | l1 == l2 = return []
+instance Fold TyLitMap where
+    type Key TyLitMap = TyLit
 
-foldMatchType _ _ _ _ = Nothing
+    fEmpty :: TyLitMap a
+    fEmpty = TLM M.empty M.empty
 
+    fAlter :: AlphaEnv -> [Var] -> Key TyLitMap -> A a -> TyLitMap a -> TyLitMap a
+    fAlter _ _ l f m = go l
+        where go (NumTyLit n) = m { tlmNumber = M.alter f n (tlmNumber m) }
+              go (StrTyLit s) = m { tlmString = M.alter f s (tlmString m) }
+
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key TyLitMap -> TyLitMap a -> [(VarEnv CoreExpr, a)]
+    fFold hs _ l m = go l
+        where go (NumTyLit n) = maybeToList $ (hs,) <$> M.lookup n (tlmNumber m)
+              go (StrTyLit s) = maybeToList $ (hs,) <$> M.lookup s (tlmString m)
+
+------------------------------------------------------------------------
+
+-- Note [Coercions]
+-- We don't actually care about the structure of the coercion evidence
+-- itself when we are folding types and expressions. We merely care that
+-- there are two coercions with the same type. Hence, we look up the type
+-- of the coercion in a TyMap.
+
+-- Note [Tick]
+-- We completely look through Ticks, discarding them from pattern expressions
+-- at insertion and from candidate expressions at folding/lookup. It is assumed
+-- that the Tick is properly present in the RHS, which is the ultimate return
+-- value of fFold, thus it will appear in the resulting code.
+
+-- Note [Holes]
+-- Holes are distinguished variables which can match any expression. (The universally
+-- quantified variables in an Equality.) They are stored as a TyMap, so the type
+-- of the expression can be checked against the type of the hole. This wraps a
+-- map from Var to result. We use a regular map instead of a VarEnv so we can get
+-- the Var back, which allows us to assign it to the expression when building
+-- the fold result.
+
+data EMap a = EMEmpty
+            | EM { emHole  :: TyMap (M.Map Var a) -- See Note [Holes]
+                 , emVar   :: VMap a
+                 , emLit   :: LMap a
+                 , emCo    :: TyMap a        -- See Note [Coercions]
+                 , emType  :: TyMap a
+                 , emCast  :: EMap (TyMap a) -- See Note [Coercions]
+                 , emApp   :: EMap (EMap a)
+                 , emLam   :: EMap (BMap a)
+                 , emLetN  :: EMap (EMap (BMap a))
+                   -- consider using set rather than list for order-independence
+                 , emLetR  :: ListMap EMap (EMap (ListMap BMap a))
+                 , emCase  :: EMap (ListMap AMap a)
+                 , emECase :: EMap (TyMap a)
+                 }
+
+emptyEMapWrapper :: EMap a
+emptyEMapWrapper = EM fEmpty fEmpty M.empty fEmpty fEmpty fEmpty
+                      fEmpty fEmpty fEmpty fEmpty fEmpty fEmpty
+
+instance Fold EMap where
+    type Key EMap = CoreExpr
+    fEmpty = EMEmpty
+
+    fAlter :: AlphaEnv -> [Var] -> Key EMap -> A a -> EMap a -> EMap a
+    fAlter env vs exp f EMEmpty = fAlter env vs exp f emptyEMapWrapper
+    fAlter env vs exp f m@EM{} = go exp
+        where go (Var v)
+                | v `elem` vs = m { emHole = fAlter env vs (varType v) (Just . M.alter f v . fromMaybe M.empty) (emHole m) }
+                | otherwise   = m { emVar  = fAlter env vs v f (emVar m) }
+              go (Lit l)      = m { emLit  = M.alter f l (emLit m) }
+              go (Coercion c) = m { emCo   = fAlter env vs (coercionType c) f (emCo m) }
+              go (Type t)     = m { emType = fAlter env vs t f (emType m) }
+              go (Cast e c)   = m { emCast = fAlter env vs e (toA (fAlter env vs (coercionType c) f)) (emCast m) }
+              go (Tick _ e)   = fAlter env vs e f m -- See Note [Tick]
+              go (App l r)    = m { emApp  = fAlter env vs l (toA (fAlter env vs r f)) (emApp m) }
+              go (Lam b e)    = m { emLam  = fAlter (extendAlphaEnv b env) (delete b vs) e
+                                                    (toA (fAlter env vs (varType b) f))
+                                                    (emLam m) }
+              go (Case s _ t []) = m { emECase = fAlter env vs s (toA (fAlter env vs t f)) (emECase m) }
+              go (Case s b _ as) = m { emCase = fAlter env vs s
+                                                       (toA (fAlter (extendAlphaEnv b env) (delete b vs) as f))
+                                                       (emCase m) }
+              go (Let (NonRec b r) e) = m { emLetN = fAlter (extendAlphaEnv b env) (delete b vs) e
+                                                            (toA (fAlter env vs r (toA (fAlter env vs (varType b) f))))
+                                                            (emLetN m) }
+              go (Let (Rec ds) e) = let (bs, rhss) = unzip ds
+                                        env' = foldr extendAlphaEnv env bs
+                                        vs' = vs \\ bs
+                                    in m { emLetR = fAlter env' vs' rhss
+                                                           (toA (fAlter env' vs' e
+                                                                        (toA (fAlter env vs (map varType bs) f))))
+                                                           (emLetR m) }
+
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key EMap -> EMap a -> [(VarEnv CoreExpr, a)]
+    fFold _  _   _ EMEmpty = []
+    fFold hs env exp m@EM{} = hss ++ go exp
+        where hss = do
+                (hs', m') <- fFold hs env (exprKindOrType exp) (emHole m)
+                extendResult m' exp hs'
+
+              go (Var v)      = fFold hs env v (emVar m)
+              go (Lit l)      = maybeToList $ (hs,) <$> M.lookup l (emLit m)
+              go (Coercion c) = fFold hs env (coercionType c) (emCo m)
+              go (Type t)     = fFold hs env t (emType m)
+              go (Cast e c)   = do
+                (hs', m') <- fFold hs env e (emCast m)
+                fFold hs' env (coercionType c) m'
+              go (Tick _ e)   = fFold hs env e m -- See Note [Tick]
+              go (App l r)    = do
+                (hs', m') <- fFold hs env l (emApp m)
+                fFold hs' env r m'
+              go (Lam b e)    = do
+                (hs', m') <- fFold hs (extendAlphaEnv b env) e (emLam m)
+                fFold hs' env (varType b) m'
+              go (Case s _ t []) = do
+                (hs', m') <- fFold hs env s (emECase m)
+                fFold hs' env t m'
+              go (Case s b _ as) = do
+                (hs', m') <- fFold hs env s (emCase m)
+                fFold hs' (extendAlphaEnv b env) as m'
+              go (Let (NonRec b r) e) = do
+                (hs' , m' ) <- fFold hs (extendAlphaEnv b env) e (emLetN m)
+                (hs'', m'') <- fFold hs' env r m'
+                fFold hs'' env (varType b) m''
+              go (Let (Rec ds) e) = do
+                let (bs, rhss) = unzip ds
+                    env' = foldr extendAlphaEnv env bs
+                (hs' , m' ) <- fFold hs env' rhss (emLetR m)
+                (hs'', m'') <- fFold hs' env' e m'
+                fFold hs'' env (map varType bs) m''
+
+-- Add the matched expression to the holes map, fails if expression differs from one already in hole.
+extendResult :: M.Map Var a -> CoreExpr -> VarEnv CoreExpr -> [(VarEnv CoreExpr, a)]
+extendResult hm e m = catMaybes
+    [ case lookupVarEnv m v of
+        Nothing -> return (extendVarEnv m v e, x)
+        Just e' -> sameExpr e e' >> return (m, x)
+    | (v,x) <- M.assocs hm ]
+
+-- | Determine if two expressions are alpha-equivalent.
+sameExpr :: CoreExpr -> CoreExpr -> Maybe ()
+sameExpr e1 e2 = snd <$> soleElement (findFold e2 m)
+    where m = insertFold emptyAlphaEnv [] e1 () EMEmpty
+
+-- | Determine if the left Quantified 'proves' the right one.
+-- Here, 'proves' means that the right Quantified is a substitution
+-- of the left one, where only the top-level binders of the left
+-- Quantified can be substituted.
+proves :: Quantified -> Quantified -> Bool
+proves (Quantified bs cl1) (Quantified _ cl2) = maybe False (const True) $ soleElement (findFold cl2 m)
+    where m = insertFold emptyAlphaEnv bs cl1 () CLMEmpty
+
+-- | Determine if the right Quantified is a substitution
+-- instance of the left Quantified (which is a pattern
+-- with a given set of holes).
+lemmaMatch :: [Var] -> Quantified -> Quantified -> Maybe (VarEnv CoreExpr)
+lemmaMatch hs ql qr = fmap fst $ soleElement (findFold qr m)
+    where m = insertFold emptyAlphaEnv hs ql () emptyQMapWrapper
+
+------------------------------------------------------------------------
+
+data ListMap m a
+  = ListMap { lmNil  :: Maybe a
+            , lmCons :: m (ListMap m a) }
+
+instance Fold m => Fold (ListMap m) where
+    type Key (ListMap m) = [Key m]
+
+    fEmpty :: ListMap m a
+    fEmpty = ListMap Nothing fEmpty
+
+    fAlter :: AlphaEnv -> [Var] -> Key (ListMap m) -> A a -> ListMap m a -> ListMap m a
+    fAlter _   _  []     f m = m { lmNil  = f (lmNil m) }
+    fAlter env vs (x:xs) f m = m { lmCons = fAlter env vs x (toA (fAlter env vs xs f)) (lmCons m) }
+
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key (ListMap m) -> ListMap m a -> [(VarEnv CoreExpr, a)]
+    fFold hs _   []     m = maybeToList $ (hs,) <$> lmNil m
+    fFold hs env (x:xs) m = do
+        (hs', m') <- fFold hs env x (lmCons m)
+        fFold hs' env xs m'
+
+------------------------------------------------------------------------
+
+-- Note [Alt Binders]
+-- We don't store the uniques/types of the alt-binders, because they are
+-- completely determined by the scrutinee/datacon/rhs.
+
+data AMap a = AMEmpty
+            | AM { amDef  :: EMap a
+                 , amData :: NameEnv (EMap a) -- See Note [Alt Binders]
+                 , amLit  :: LMap (EMap a) }
+
+instance Fold AMap where
+    type Key AMap = Alt CoreBndr
+
+    fEmpty :: AMap a
+    fEmpty = AMEmpty
+
+    fAlter :: AlphaEnv -> [Var] -> Key AMap -> A a -> AMap a -> AMap a
+    fAlter env vs alt f AMEmpty = fAlter env vs alt f (AM fEmpty emptyNameEnv M.empty)
+    fAlter env vs alt f m@AM{} = go alt
+        where go (DEFAULT  , _ , rhs) = m { amDef  = fAlter env vs rhs f (amDef m) }
+              go (DataAlt d, bs, rhs) = m { amData = alterNameEnv
+                                                        (toA (fAlter (foldr extendAlphaEnv env bs) (vs \\ bs) rhs f))
+                                                        (amData m) (getName d) }
+              go (LitAlt l , _ , rhs) = m { amLit  = M.alter (toA (fAlter env vs rhs f)) l (amLit m) }
+
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key AMap -> AMap a -> [(VarEnv CoreExpr, a)]
+    fFold _ _ _ AMEmpty = []
+    fFold hs env alt m@AM{} = go alt
+        where go (DEFAULT  , _ , rhs) = fFold hs env rhs (amDef m)
+              go (DataAlt d, bs, rhs) = do
+                m' <- maybeToList (lookupNameEnv (amData m) (getName d))
+                fFold hs (foldr extendAlphaEnv env bs) rhs m'
+              go (LitAlt l , _ , rhs) = maybeToList (M.lookup l (amLit m)) >>= fFold hs env rhs
+
+----------------------------------------------------------------------------
+
+data QMap a = QM { qmap :: CLMap (ListMap BMap a) }
+
+emptyQMapWrapper :: QMap a
+emptyQMapWrapper = QM fEmpty
+
+instance Fold QMap where
+    type Key QMap = Quantified
+
+    fEmpty :: QMap a
+    fEmpty = emptyQMapWrapper
+
+    fAlter :: AlphaEnv -> [Var] -> Key QMap -> A a -> QMap a -> QMap a
+    fAlter env vs (Quantified bs cl) f m =
+        m { qmap = fAlter (foldr extendAlphaEnv env bs) (vs \\ bs) cl
+                          (toA (fAlter env vs (map varType bs) f)) (qmap m) }
+
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key QMap -> QMap a -> [(VarEnv CoreExpr, a)]
+    fFold hs env (Quantified bs cl) m = do
+        (hs', m') <- fFold hs (foldr extendAlphaEnv env bs) cl (qmap m)
+        fFold hs' env (map varType bs) m'
+
+----------------------------------------------------------------------------
+
+data CLMap a = CLMEmpty
+             | CLM { clmConj  :: QMap (QMap a)
+                   , clmDisj  :: QMap (QMap a)
+                   , clmImpl  :: QMap (QMap a)
+                   , clmEquiv :: EMap (EMap a)
+                   }
+
+emptyCLMapWrapper :: CLMap a
+emptyCLMapWrapper = CLM fEmpty fEmpty fEmpty fEmpty
+
+instance Fold CLMap where
+    type Key CLMap = Clause
+
+    fEmpty :: CLMap a
+    fEmpty = CLMEmpty
+
+    fAlter :: AlphaEnv -> [Var] -> Key CLMap -> A a -> CLMap a -> CLMap a
+    fAlter env vs cl f CLMEmpty = fAlter env vs cl f emptyCLMapWrapper
+    fAlter env vs cl f m@(CLM{}) = go cl
+        where go (Conj  q1 q2) = m { clmConj  = fAlter env vs q1 (toA (fAlter env vs q2 f)) (clmConj  m) }
+              go (Disj  q1 q2) = m { clmDisj  = fAlter env vs q1 (toA (fAlter env vs q2 f)) (clmDisj  m) }
+              go (Impl  q1 q2) = m { clmImpl  = fAlter env vs q1 (toA (fAlter env vs q2 f)) (clmImpl  m) }
+              go (Equiv e1 e2) = m { clmEquiv = fAlter env vs e1 (toA (fAlter env vs e2 f)) (clmEquiv m) }
+
+    fFold :: VarEnv CoreExpr -> AlphaEnv -> Key CLMap -> CLMap a -> [(VarEnv CoreExpr, a)]
+    fFold _  _   _  CLMEmpty = []
+    fFold hs env cl m@CLM{}  = go cl
+        where go (Conj q1 q2) = do
+                (hs', m') <- fFold hs env q1 (clmConj m)
+                fFold hs' env q2 m'
+              go (Disj q1 q2) = do
+                (hs', m') <- fFold hs env q1 (clmDisj m)
+                fFold hs' env q2 m'
+              go (Impl q1 q2) = do
+                (hs', m') <- fFold hs env q1 (clmImpl m)
+                fFold hs' env q2 m'
+              go (Equiv e1 e2) = do
+                (hs', m') <- fFold hs env e1 (clmEquiv m)
+                fFold hs' env e2 m'
+
+----------------------------------------------------------------------------
+
+-- | An equality is represented as a set of universally quantified binders, and the LHS and RHS of the equality.
+data Equality = Equality [CoreBndr] CoreExpr CoreExpr
+
+-- | Build an equality from a list of universally quantified binders and two expressions.
+-- If the head of either expression is a lambda expression, it's binder will become a universally quantified binder
+-- over both sides. It is assumed the two expressions have the same type.
+--
+-- Ex.    mkEquality [] (\x. foo x) bar === forall x. foo x = bar x
+--        mkEquality [] (baz y z) (\x. foo x x) === forall x. baz y z x = foo x x
+--        mkEquality [] (\x. foo x) (\y. bar y) === forall x. foo x = bar x
+mkEquality :: [CoreBndr] -> CoreExpr -> CoreExpr -> Equality
+mkEquality vs lhs rhs = case mkQuantified vs lhs rhs of
+                            Quantified vs' (Equiv lhs' rhs') -> Equality vs' lhs' rhs'
+
+toEqualities :: Quantified -> [Equality]
+toEqualities = go []
+    where go qs (Quantified vs cl) = go2 (qs++vs) cl
+
+          go2 qs (Equiv e1 e2) = [mkEquality qs e1 e2]
+          go2 qs (Conj q1 q2)  = go qs q1 ++ go qs q2
+          go2 _  _             = []
+
+ppEqualityT :: PrettyPrinter -> PrettyH Equality
+ppEqualityT pp = do
+    Equality bs lhs rhs <- idR
+    dfa <- return bs >>> pForall pp
+    d1 <- return lhs >>> extractT (pCoreTC pp)
+    d2 <- return rhs >>> extractT (pCoreTC pp)
+    return $ PP.sep [dfa,d1,PP.text "=",d2]
+
+------------------------------------------------------------------------------
+
+-- | Flip the LHS and RHS of a 'Equality'.
+flipEquality :: Equality -> Equality
+flipEquality (Equality xs lhs rhs) = Equality xs rhs lhs
+
+------------------------------------------------------------------------------
+
+{-
+-- 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])
+--
+-- TODO: need to know type of 'x' to generate a variable.
+class BuildEquality a where
+    mkEquality :: a -> HermitM Equality
+
+instance BuildEquality (CoreExpr,CoreExpr) where
+    mkEquality :: (CoreExpr,CoreExpr) -> HermitM Equality
+    mkEquality (lhs,rhs) = return $ Equality [] lhs rhs
+
+instance BuildEquality a => BuildEquality (CoreExpr -> a) where
+    mkEquality :: (CoreExpr -> a) -> HermitM Equality
+    mkEquality f = do
+        x <- newIdH "x" (error "need to create a type")
+        Equality bnds lhs rhs <- mkEquality (f (varToCoreExpr x))
+        return $ Equality (x:bnds) lhs rhs
+-}
+
+------------------------------------------------------------------------------
+
+freeVarsEquality :: Equality -> VarSet
+freeVarsEquality (Equality bs lhs rhs) =
+    delVarSetList (unionVarSets (map freeVarsExpr [lhs,rhs])) bs
+
+------------------------------------------------------------------------------
+
+data RewriteEqualityBox = RewriteEqualityBox (RewriteH Equality) deriving Typeable
+
+instance Extern (RewriteH Equality) where
+    type Box (RewriteH Equality) = RewriteEqualityBox
+    box = RewriteEqualityBox
+    unbox (RewriteEqualityBox r) = r
+
+-----------------------------------------------------------------
+
+data TransformEqualityStringBox = TransformEqualityStringBox (TransformH Equality String) deriving Typeable
+
+instance Extern (TransformH Equality String) where
+    type Box (TransformH Equality String) = TransformEqualityStringBox
+    box = TransformEqualityStringBox
+    unbox (TransformEqualityStringBox t) = t
+
+-----------------------------------------------------------------
+
+data TransformEqualityUnitBox = TransformEqualityUnitBox (TransformH Equality ()) deriving Typeable
+
+instance Extern (TransformH Equality ()) where
+    type Box (TransformH Equality ()) = TransformEqualityUnitBox
+    box = TransformEqualityUnitBox
+    unbox (TransformEqualityUnitBox i) = i
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
@@ -2,7 +2,8 @@
 module HERMIT.Dictionary.Function
     ( externals
     , appArgM
-    , buildApplicationM
+    , buildAppM
+    , buildAppsM
     , buildCompositionT
     , buildFixT
     , buildIdT
@@ -13,6 +14,7 @@
     ) where
 
 import Control.Arrow
+import Control.Monad
 import Control.Monad.IO.Class
 
 import Data.List (nub, intercalate, intersect, partition, transpose)
@@ -28,15 +30,14 @@
 import HERMIT.Name
 
 import HERMIT.Dictionary.Common
-import HERMIT.Dictionary.GHC hiding (externals)
 
 externals ::  [External]
 externals =
-    [ external "static-arg" (promoteDefR staticArgR :: RewriteH Core)
+    [ external "static-arg" (promoteDefR staticArgR :: RewriteH LCore)
         [ "perform the static argument transformation on a recursive function." ]
-    , external "static-arg-types" (promoteDefR staticArgTypesR :: RewriteH Core)
+    , external "static-arg-types" (promoteDefR staticArgTypesR :: RewriteH LCore)
         [ "perform the static argument transformation on a recursive function, only transforming type arguments." ]
-    , external "static-arg-pos" (promoteDefR . staticArgPosR :: [Int] -> RewriteH Core)
+    , external "static-arg-pos" (promoteDefR . staticArgPosR :: [Int] -> RewriteH LCore)
         [ "perform the static argument transformation on a recursive function, only transforming the arguments specified (by index)." ]
     ]
 
@@ -131,29 +132,25 @@
                              else return $ l !! n
 
 -- | Build composition of two functions.
-buildCompositionT :: (BoundVars c, HasDynFlags m, HasHermitMEnv m, HasHscEnv m, MonadCatch m, MonadIO m, MonadThings m)
+buildCompositionT :: (BoundVars c, HasHermitMEnv m, HasHscEnv m, MonadCatch m, MonadIO m, MonadThings m)
                   => CoreExpr -> CoreExpr -> Transform c m x CoreExpr
 buildCompositionT f g = do
     composeId <- findIdT $ fromString "Data.Function.."
-    fDot <- buildApplicationM (varToCoreExpr composeId) f
-    buildApplicationM fDot g
+    fDot <- prefixFailMsg "building (.) f failed:" $ buildAppM (varToCoreExpr composeId) f
+    prefixFailMsg "building f . g failed:" $ buildAppM fDot g
 
+buildAppsM :: MonadCatch m => CoreExpr -> [CoreExpr] -> m CoreExpr
+buildAppsM = foldM buildAppM
+
 -- | Given expression for f and for x, build f x, figuring out the type arguments.
-buildApplicationM :: (HasDynFlags m, MonadCatch m, MonadIO m) => CoreExpr -> CoreExpr -> m CoreExpr
-buildApplicationM f x = do
+buildAppM :: MonadCatch m => CoreExpr -> CoreExpr -> m CoreExpr
+buildAppM f x = do
     (vsF, domF, _) <- splitFunTypeM (exprType f)
     let (vsX, xTy) = splitForAllTys (exprType x)
         allTvs = vsF ++ vsX
         bindFn v = if v `elem` allTvs then BindMe else Skolem
 
-    sub <- maybe (do d <- getDynFlags
-                     liftIO $ putStrLn $ "f: " ++ showPpr d f
-                     liftIO $ putStrLn $ "x: " ++ showPpr d x
-                     liftIO $ putStrLn $ "vsF: " ++ showPpr d vsF
-                     liftIO $ putStrLn $ "domF: " ++ showPpr d domF
-                     liftIO $ putStrLn $ "vsX: " ++ showPpr d vsX
-                     liftIO $ putStrLn $ "xTy: " ++ showPpr d xTy
-                     fail "buildApplicationM - domain of f and type of x do not unify")
+    sub <- maybe (fail "buildAppM - domain of f and type of x do not unify")
                  return
                  (tcUnifyTys bindFn [domF] [xTy])
 
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,18 +1,18 @@
 {-# 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
-     -- ** Substitution
+      -- | This module contains transformations that are reflections of GHC functions, or derived from GHC functions.
+      externals
+      -- ** Dynamic Loading
+    , loadLemmaLibraryT
+    , LemmaLibrary
+      -- ** Substitution
     , substR
-    , substCoreAlt
-    , substCoreExpr
-     -- ** Utilities
-    --      , inScope
+      -- ** Utilities
     , dynFlagsT
     , arityOf
-     -- ** Lifted GHC capabilities
-     -- A zombie is an identifer that has 'OccInfo' 'IAmDead', but still has occurrences.
+      -- ** Lifted GHC capabilities
+      -- A zombie is an identifer that has 'OccInfo' 'IAmDead', but still has occurrences.
     , lintExprT
     , lintModuleT
     , occurAnalyseR
@@ -33,13 +33,15 @@
 
 import           Data.Char (isSpace)
 import           Data.List (mapAccumL)
+import qualified Data.Map as M
+import           Data.String
 
 import           HERMIT.Core
 import           HERMIT.Context
-import           HERMIT.Dictionary.Debug hiding (externals)
 import           HERMIT.External
 import           HERMIT.GHC
 import           HERMIT.Kure
+import           HERMIT.Lemma
 import           HERMIT.Monad
 import           HERMIT.Name
 
@@ -48,21 +50,23 @@
 -- | Externals that reflect GHC functions, or are derived from GHC functions.
 externals :: [External]
 externals =
-         [ external "deshadow-prog" (promoteProgR deShadowProgR :: RewriteH Core)
-                [ "Deshadow a program." ] .+ Deep
-         , 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)
-                [ "Perform dependency analysis on all sub-expressions; simplifying and updating identifer info."] .+ Deep
-         , external "lint-expr" (promoteExprT lintExprT :: TransformH CoreTC String)
-                [ "Runs GHC's Core Lint, which typechecks the current expression."
-                , "Note: this can miss several things that a whole-module core lint will find."
-                , "For instance, running this on the RHS of a binding, the type of the RHS will"
-                , "not be checked against the type of the binding. Running on the whole let expression"
-                , "will catch that however."] .+ Deep .+ Debug .+ Query
-         , external "lint-module" (promoteModGutsT lintModuleT :: TransformH CoreTC String)
-                [ "Runs GHC's Core Lint, which typechecks the current module."] .+ Deep .+ Debug .+ Query
-         ]
+    [ external "deshadow-prog" (promoteProgR deShadowProgR :: RewriteH LCore)
+        [ "Deshadow a program." ] .+ Deep
+    , external "dezombify" (promoteExprR dezombifyR :: RewriteH LCore)
+        [ "Zap the occurrence information in the current identifer if it is a zombie."] .+ Shallow
+    , external "occurrence-analysis" (occurrenceAnalysisR :: RewriteH LCore)
+        [ "Perform dependency analysis on all sub-expressions; simplifying and updating identifer info."] .+ Deep
+    , external "lint-expr" (promoteExprT lintExprT :: TransformH LCoreTC String)
+        [ "Runs GHC's Core Lint, which typechecks the current expression."
+        , "Note: this can miss several things that a whole-module core lint will find."
+        , "For instance, running this on the RHS of a binding, the type of the RHS will"
+        , "not be checked against the type of the binding. Running on the whole let expression"
+        , "will catch that however."] .+ Deep .+ Debug .+ Query
+    , external "lint-module" (promoteModGutsT lintModuleT :: TransformH LCoreTC String)
+        [ "Runs GHC's Core Lint, which typechecks the current module."] .+ Deep .+ Debug .+ Query
+    , external "load-lemma-library" (loadLemmaLibraryT :: HermitName -> TransformH LCore ())
+        [ "Dynamically load a library of lemmas." ]
+    ]
 
 ------------------------------------------------------------------------
 
@@ -71,16 +75,6 @@
 substR v e = setFailMsg "Can only perform substitution on expressions, case alternatives or programs." $
              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)
-substCoreExpr v e expr =
-    -- The InScopeSet needs to include any free variables appearing in the
-    -- expression to be substituted.  Constructing a NonRec Let expression
-    -- to pass on to exprFeeVars takes care of this, but ...
-    -- TODO Is there a better way to do this ???
-    let emptySub = mkEmptySubst (mkInScopeSet (localFreeVarsExpr (Let (NonRec v e) expr)))
-     in substExpr (text "substCoreExpr") (extendSubst emptySub v e) expr
-
 -- | Substitute all occurrences of a variable with an expression, in a program.
 substTopBindR :: Monad m => Var -> CoreExpr -> Rewrite c m CoreProg
 substTopBindR v e =  contextfreeT $ \ p -> do
@@ -88,14 +82,6 @@
     let emptySub =  emptySubst -- mkEmptySubst (mkInScopeSet (exprFreeVars exp))
     return $ bindsToProg $ snd (mapAccumL substBind (extendSubst emptySub v e) (progToBinds p))
 
--- | Substitute all occurrences of a variable with an expression, in a case alternative.
-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)
-
 ------------------------------------------------------------------------
 
 -- | [from GHC documentation] De-shadowing the program is sometimes a useful pre-pass.
@@ -134,7 +120,7 @@
          dumpSDocs endMsg = Bag.foldBag (\ d r -> d ++ ('\n':r)) (showSDoc dynFlags) endMsg
      if Bag.isEmptyBag errs
        then return $ dumpSDocs "Core Lint Passed" warns
-       else observeR (dumpSDocs "" errs) >>> fail "Core Lint Failed"
+       else fail $ "Core Lint Failed:\n" ++ dumpSDocs "" errs
 
 -- | Note: this can miss several things that a whole-module core lint will find.
 -- For instance, running this on the RHS of a binding, the type of the RHS will
@@ -164,7 +150,7 @@
 dezombifyR = varR (acceptR isDeadBinder >>^ zapVarOccInfo)
 
 -- | Apply 'occurAnalyseExprR' to all sub-expressions.
-occurAnalyseR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Rewrite c m Core
+occurAnalyseR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m, Walker c u, Injection CoreExpr u) => Rewrite c m u
 occurAnalyseR = let r  = promoteExprR (arr occurAnalyseExpr_NoBinderSwap) -- See Note [No Binder Swap]
                     go = r <+ anyR go
                  in tryR go -- always succeed
@@ -184,14 +170,14 @@
 occurAnalyseExprChangedR = changedByR exprSyntaxEq (arr occurAnalyseExpr_NoBinderSwap) -- See Note [No Binder Swap]
 
 -- | Occurrence analyse all sub-expressions, failing if the result is syntactically equal to the initial expression.
-occurAnalyseChangedR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Rewrite c m Core
-occurAnalyseChangedR = changedByR coreSyntaxEq occurAnalyseR
+occurAnalyseChangedR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Rewrite c m LCore
+occurAnalyseChangedR = changedByR lcoreSyntaxEq occurAnalyseR
 
 -- | Run GHC's occurrence analyser, and also eliminate any zombies.
-occurAnalyseAndDezombifyR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Rewrite c m Core
+occurAnalyseAndDezombifyR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m, Walker c u, Injection CoreExpr u) => Rewrite c m u
 occurAnalyseAndDezombifyR = allbuR (tryR $ promoteExprR dezombifyR) >>> occurAnalyseR
 
-occurrenceAnalysisR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Rewrite c m Core
+occurrenceAnalysisR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m, Walker c LCore) => Rewrite c m LCore
 occurrenceAnalysisR = occurAnalyseAndDezombifyR
 
 {- Does not work (no export)
@@ -224,7 +210,8 @@
             nonC = mkNonCanonical $ CtWanted { ctev_pred = predTy, ctev_evar = evar, ctev_loc = loc }
             wCs = mkFlatWC [nonC]
         (wCs', bnds) <- solveWantedsTcM wCs
-        reportAllUnsolved wCs'
+        -- reportAllUnsolved wCs' -- this is causing a panic with dictionary instantiation
+                                  -- revist and fix!
         return (evar, bnds)
     bnds <- runDsM $ dsEvBinds bs
     return (i,bnds)
@@ -239,3 +226,42 @@
     return $ case bnds of
                 [NonRec v e] | i == v -> e -- the common case that we would have gotten a single non-recursive let
                 _ -> mkCoreLets bnds (varToCoreExpr i)
+
+-- | A LemmaLibrary is a transformation that produces a set of lemmas,
+-- which are then added to the lemma store. It is not allowed to insert
+-- its own lemmas directly (if it tries they are throw away), but can
+-- certainly read the existing store.
+type LemmaLibrary = TransformH () Lemmas
+
+loadLemmaLibraryT :: HermitName -> TransformH x ()
+loadLemmaLibraryT nm = contextonlyT $ \ c -> do
+    hscEnv <- getHscEnv
+    comp <- liftAndCatchIO $ loadLemmaLibrary hscEnv nm
+    m' <- applyT comp c () -- TODO: discard side effects
+    m <- getLemmas
+    putLemmas $ m' `M.union` m
+
+loadLemmaLibrary :: HscEnv -> HermitName -> IO LemmaLibrary
+loadLemmaLibrary hscEnv hnm = do
+    name <- lookupHermitNameForPlugins hscEnv varNS hnm
+    lib_tycon_name <- lookupHermitNameForPlugins hscEnv tyConClassNS $ fromString "HERMIT.Dictionary.GHC.LemmaLibrary"
+    lib_tycon <- forceLoadTyCon hscEnv lib_tycon_name
+    mb_v <- getValueSafely hscEnv name $ mkTyConTy lib_tycon
+    let dflags = hsc_dflags hscEnv
+    maybe (fail $ showSDoc dflags $ hsep
+                [ ptext (sLit "The value"), ppr name
+                , ptext (sLit "did not have the type")
+                , ppr lib_tycon, ptext (sLit "as required.")])
+          return mb_v
+
+lookupHermitNameForPlugins :: HscEnv -> NameSpace -> HermitName -> IO Name
+lookupHermitNameForPlugins hscEnv ns hnm = do
+    modName <- maybe (fail "name must be fully qualified with module name.") return (hnModuleName hnm)
+    let dflags = hsc_dflags hscEnv
+        rdrName = toRdrName ns hnm
+    mbName <- lookupRdrNameInModuleForPlugins hscEnv modName rdrName
+    maybe (fail $ showSDoc dflags $ hsep
+            [ ptext (sLit "The module"), ppr modName
+            , ptext (sLit "did not export the name")
+            , ppr rdrName ])
+          return mbName
diff --git a/src/HERMIT/Dictionary/Induction.hs b/src/HERMIT/Dictionary/Induction.hs
--- a/src/HERMIT/Dictionary/Induction.hs
+++ b/src/HERMIT/Dictionary/Induction.hs
@@ -3,26 +3,20 @@
 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.Name
--- import HERMIT.Utilities (soleElement)
 
 import HERMIT.Dictionary.Common
 import HERMIT.Dictionary.Local.Case (caseSplitInlineR)
--- import HERMIT.Dictionary.Reasoning
 import HERMIT.Dictionary.Undefined
 
 ------------------------------------------------------------------------------
@@ -44,7 +38,7 @@
 
        -- 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
+       Case _ _ _ alts <- withVarsInScope vs (caseSplitInlineR (varToCoreExpr i)) <<< return contrivedExpr
        let dataConCases = map compressAlts alts
 
        lhsUndefined <- extractR (replaceIdWithUndefinedR i) <<< return lhsE
@@ -60,46 +54,3 @@
     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) -> Transform 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) -> Transform 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
---                 -> Transform 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,6 +5,7 @@
     , InlineConfig(..)
     , CaseBinderInlineOption(..)
     , getUnfoldingT
+    , getUnfoldingsT
     , ensureBoundT
     , inlineR
     , inlineNameR
@@ -33,16 +34,16 @@
 -- | 'External's for inlining variables.
 externals :: [External]
 externals =
-    [ external "inline" (promoteExprR inlineR :: RewriteH Core)
+    [ external "inline" (promoteExprR inlineR :: RewriteH LCore)
         [ "(Var v) ==> <defn of v>" ].+ Eval .+ Deep
-    , external "inline" (promoteExprR . inlineMatchingPredR . mkOccPred :: OccurrenceName -> RewriteH Core)
+    , external "inline" (promoteExprR . inlineMatchingPredR . mkOccPred :: OccurrenceName -> RewriteH LCore)
         [ "Given a specific v, (Var v) ==> <defn of v>" ] .+ Eval .+ Deep
-    , external "inline" (promoteExprR . inlineNamesR :: [String] -> RewriteH Core)
+    , external "inline" (promoteExprR . inlineNamesR :: [String] -> RewriteH LCore)
         [ "If the current variable matches any of the given names, then inline it." ] .+ Eval .+ Deep
-    , external "inline-case-scrutinee" (promoteExprR inlineCaseScrutineeR :: RewriteH Core)
+    , external "inline-case-scrutinee" (promoteExprR inlineCaseScrutineeR :: RewriteH LCore)
         [ "if v is a case binder, replace (Var v) with the bound case scrutinee." ] .+ Eval .+ Deep
-    , external "inline-case-alternative" (promoteExprR inlineCaseAlternativeR :: RewriteH Core)
-        [ "if v is a case binder, replace (Var v) with the bound case-alternative pattern." ] .+ Eval .+ Deep .+ Unsafe
+    , external "inline-case-alternative" (promoteExprR inlineCaseAlternativeR :: RewriteH LCore)
+        [ "if v is a case binder, replace (Var v) with the bound case-alternative pattern." ] .+ Eval .+ Deep
     ]
 
 ------------------------------------------------------------------------
@@ -142,7 +143,16 @@
 getUnfoldingT :: (ReadBindings c, MonadCatch m)
               => InlineConfig
               -> Transform c m Id (CoreExpr, BindingDepth -> Bool)
-getUnfoldingT config = transform $ \ c i ->
+getUnfoldingT config = do
+    r <- getUnfoldingsT config
+    case r of
+        [] -> fail "no unfolding for variable."
+        (u:_) -> return u
+
+getUnfoldingsT :: (ReadBindings c, MonadCatch m)
+               => InlineConfig
+               -> Transform c m Id [(CoreExpr, BindingDepth -> Bool)]
+getUnfoldingsT config = transform $ \ c i ->
     case lookupHermitBinding i c of
       Nothing -> do requireAllBinders config
                     let uncaptured = (<= 0) -- i.e. is global
@@ -151,34 +161,38 @@
                     -- will give a reasonable error message if something goes wrong, 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)
-                      dunf@(DFunUnfolding {})         -> liftM (,uncaptured) $ dFunExpr dunf
+                      CoreUnfolding { uf_tmpl = uft } -> single (uft, uncaptured)
+                      dunf@(DFunUnfolding {})         -> single . (,uncaptured) =<< dFunExpr dunf
                       _                               -> fail $ "cannot find unfolding in Env or IdInfo."
       Just b -> let depth = hbDepth b
                 in case hbSite b of
                           CASEBINDER s alt -> let tys             = tyConAppArgs (idType i)
-                                                  altExprDepthM   = liftM (, (<= depth+1)) $ alt2Exp tys alt
-                                                  scrutExprDepthM = return (s, (< depth))
+                                                  altExprDepthM   = single . (, (<= depth+1)) =<< alt2Exp tys alt
+                                                  scrutExprDepthM = single (s, (< depth))
                                                in case config of
                                                     CaseBinderOnly Scrutinee   -> scrutExprDepthM
                                                     CaseBinderOnly Alternative -> altExprDepthM
-                                                    AllBinders                 -> altExprDepthM <+ scrutExprDepthM
+                                                    AllBinders                 -> do
+                                                        au <- altExprDepthM <+ return []
+                                                        su <- scrutExprDepthM
+                                                        return $ au ++ su
 
                           NONREC e         -> do requireAllBinders config
-                                                 return (e, (< depth))
+                                                 single (e, (< depth))
 
                           REC e            -> do requireAllBinders config
-                                                 return (e, (<= depth))
+                                                 single (e, (<= depth))
 
                           MUTUALREC e      -> do requireAllBinders config
-                                                 return (e, (<= depth+1))
+                                                 single (e, (<= depth+1))
 
                           TOPLEVEL e       -> do requireAllBinders config
-                                                 return (e, (<= depth)) -- Depth should always be 0 for top-level bindings.
+                                                 single (e, (<= depth)) -- Depth should always be 0 for top-level bindings.
                                                                         -- Any inlined variables should only refer to top-level bindings or global things, else they've been captured.
 
                           _                -> fail "variable is not bound to an expression."
   where
+    single = return . (:[])
     requireAllBinders :: Monad m => InlineConfig -> m ()
     requireAllBinders AllBinders         = return ()
     requireAllBinders (CaseBinderOnly _) = fail "not a case binder."
@@ -196,12 +210,12 @@
 alt2Exp :: Monad m => [Type] -> (AltCon,[Var]) -> m CoreExpr
 alt2Exp _   (DEFAULT   , _ ) = fail "DEFAULT alternative cannot be converted to an expression."
 alt2Exp _   (LitAlt l  , _ ) = return $ Lit l
-alt2Exp tys (DataAlt dc, vs) = return $ mkCoreConApps dc (map Type tys ++ map (varToCoreExpr . zapVarOccInfo) vs)
+alt2Exp tys (DataAlt dc, vs) = return $ mkDataConApp tys dc vs
 
 -- | Get list of possible inline targets. Used by shell for completion.
 inlineTargetsT :: ( ExtendPath c Crumb, ReadPath c Crumb, AddBindings c
                   , ReadBindings c, HasEmptyContext c, MonadCatch m )
-               => Transform c m Core [String]
+               => Transform c m LCore [String]
 inlineTargetsT = collectT $ promoteT $ whenM (testM inlineR) (varT $ arr unqualifiedName)
 
 -- | Build a CoreExpr for a DFunUnfolding
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,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, LambdaCase #-}
 
 module HERMIT.Dictionary.Kure
     ( -- * KURE Strategies
@@ -21,95 +21,117 @@
 -- | -- This list contains reflections of the KURE strategies as 'External's.
 externals :: [External]
 externals = map (.+ KURE)
-   [ external "id"         (idR :: RewriteH Core)
+   [ external "id"         (idR :: RewriteH LCore)
        [ "Perform an identity rewrite."] .+ Shallow
-   , external "success"    (successT :: TransformH Core ())
+   , external "id"         (idR :: RewriteH LCoreTC)
+       [ "Perform an identity rewrite."] .+ Shallow
+   , external "success"    (successT :: TransformH LCore ())
        [ "An always succeeding translation." ]
-   , external "fail"       (fail :: String -> RewriteH Core)
+   , external "fail"       (fail :: String -> RewriteH LCore)
        [ "A failing rewrite."]
-   , external "<+"         ((<+) :: RewriteH Core -> RewriteH Core -> RewriteH Core)
+   , external "<+"         ((<+) :: RewriteH LCore -> RewriteH LCore -> RewriteH LCore)
        [ "Perform the first rewrite, and then, if it fails, perform the second rewrite." ]
-   , external "<+"         ((<+) :: TransformH Core () -> TransformH Core () -> TransformH Core ())
+   , external "<+"         ((<+) :: TransformH LCore () -> TransformH LCore () -> TransformH LCore ())
        [ "Perform the first check, and then, if it fails, perform the second check." ]
-   , external ">>>"        ((>>>) :: RewriteH Core -> RewriteH Core -> RewriteH Core)
+   , external ">>>"        ((>>>) :: RewriteH LCore -> RewriteH LCore -> RewriteH LCore)
        [ "Compose rewrites, requiring both to succeed." ]
-   , external ">>>"        ((>>>) :: BiRewriteH Core -> BiRewriteH Core -> BiRewriteH Core)
+   , external ">>>"        ((>>>) :: BiRewriteH LCore -> BiRewriteH LCore -> BiRewriteH LCore)
        [ "Compose bidirectional rewrites, requiring both to succeed." ]
-   , external ">+>"        ((>+>) :: RewriteH Core -> RewriteH Core -> RewriteH Core)
+   , external ">>>"        ((>>>) :: RewriteH LCoreTC -> RewriteH LCoreTC -> RewriteH LCoreTC)
+       [ "Compose rewrites, requiring both to succeed." ]
+   , external ">+>"        ((>+>) :: RewriteH LCore -> RewriteH LCore -> RewriteH LCore)
        [ "Compose rewrites, allowing one to fail." ]
-   , external "try"        (tryR :: RewriteH Core -> RewriteH Core)
+   , external "try"        (tryR :: RewriteH LCore -> RewriteH LCore)
        [ "Try a rewrite, and perform the identity if the rewrite fails." ]
-   , external "repeat"     (repeatR :: RewriteH Core -> RewriteH Core)
+   , external "repeat"     (repeatR :: RewriteH LCore -> RewriteH LCore)
        [ "Repeat a rewrite until it would fail." ] .+ Loop
-   , external "replicate"  ((\ n -> andR . replicate n)  :: Int -> RewriteH Core -> RewriteH Core)
+   , external "replicate"  ((\ n -> andR . replicate n)  :: Int -> RewriteH LCore -> RewriteH LCore)
        [ "Repeat a rewrite n times." ]
-   , external "all"        (allR :: RewriteH Core -> RewriteH Core)
+   , external "all"        (allR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite to all children of the node, requiring success at every child." ] .+ Shallow
-   , external "any"        (anyR :: RewriteH Core -> RewriteH Core)
+   , external "any"        (anyR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite to all children of the node, requiring success for at least one child." ] .+ Shallow
-   , external "one"        (oneR :: RewriteH Core -> RewriteH Core)
+   , external "one"        (oneR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite to the first child of the node for which it can succeed." ] .+ Shallow
-   , external "all-bu"     (allbuR :: RewriteH Core -> RewriteH Core)
+   , external "all-bu"     (allbuR :: RewriteH LCore -> RewriteH LCore)
        [ "Promote a rewrite to operate over an entire tree in bottom-up order, requiring success at every node." ] .+ Deep
-   , external "all-td"     (alltdR :: RewriteH Core -> RewriteH Core)
+   , external "all-td"     (alltdR :: RewriteH LCore -> RewriteH LCore)
        [ "Promote a rewrite to operate over an entire tree in top-down order, requiring success at every node." ] .+ Deep
-   , external "all-du"     (allduR :: RewriteH Core -> RewriteH Core)
+   , external "all-du"     (allduR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite twice, in a top-down and bottom-up way, using one single tree traversal,",
          "succeeding if they all succeed."] .+ Deep
-   , external "any-bu"     (anybuR :: RewriteH Core -> RewriteH Core)
+   , external "any-bu"     (anybuR :: RewriteH LCore -> RewriteH LCore)
        [ "Promote a rewrite to operate over an entire tree in bottom-up order, requiring success for at least one node." ] .+ Deep
-   , external "any-td"     (anytdR :: RewriteH Core -> RewriteH Core)
+   , external "any-td"     (anytdR :: RewriteH LCore -> RewriteH LCore)
        [ "Promote a rewrite to operate over an entire tree in top-down order, requiring success for at least one node." ] .+ Deep
-   , external "any-du"     (anyduR :: RewriteH Core -> RewriteH Core)
+   , external "any-du"     (anyduR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite twice, in a top-down and bottom-up way, using one single tree traversal,",
          "succeeding if any succeed."] .+ Deep
-   , external "one-td"     (onetdR :: RewriteH Core -> RewriteH Core)
+   , external "one-td"     (onetdR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite to the first node (in a top-down order) for which it can succeed." ] .+ Deep
-   , external "one-bu"     (onebuR :: RewriteH Core -> RewriteH Core)
+   , external "one-bu"     (onebuR :: RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite to the first node (in a bottom-up order) for which it can succeed." ] .+ Deep
-   , external "prune-td"   (prunetdR :: RewriteH Core -> RewriteH Core)
+   , external "prune-td"   (prunetdR :: RewriteH LCore -> RewriteH LCore)
        [ "Attempt to apply a rewrite in a top-down manner, prunning at successful rewrites." ] .+ Deep
-   , external "innermost"  (innermostR :: RewriteH Core -> RewriteH Core)
+   , external "innermost"  (innermostR :: RewriteH LCore -> RewriteH LCore)
        [ "A fixed-point traveral, starting with the innermost term." ] .+ Deep .+ Loop
-   , external "focus"      (hfocusR :: TransformH CoreTC LocalPathH -> RewriteH CoreTC -> RewriteH CoreTC)
+   , external "focus"      (hfocusR :: TransformH LCoreTC LocalPathH -> RewriteH LCoreTC -> RewriteH LCoreTC)
        [ "Apply a rewrite to a focal point."] .+ Navigation .+ Deep
-   , external "focus"      (hfocusT :: TransformH CoreTC LocalPathH -> TransformH CoreTC String -> TransformH CoreTC String)
+   , external "focus"      (hfocusT :: TransformH LCoreTC LocalPathH -> TransformH LCoreTC String -> TransformH LCoreTC String)
        [ "Apply a query at a focal point."] .+ Navigation .+ Deep
-   , external "focus"      (hfocusR . return :: LocalPathH -> RewriteH CoreTC -> RewriteH CoreTC)
+   , external "focus"      ((\p -> hfocusR (return p)) :: LocalPathH -> RewriteH LCoreTC -> RewriteH LCoreTC)
        [ "Apply a rewrite to a focal point."] .+ Navigation .+ Deep
-   , external "focus"      (hfocusT . return :: LocalPathH -> TransformH CoreTC String -> TransformH CoreTC String)
+   , external "focus"      ((\p -> hfocusT (return p)) :: LocalPathH -> TransformH LCoreTC String -> TransformH LCoreTC String)
        [ "Apply a query at a focal point."] .+ Navigation .+ Deep
-   , external "when"       ((>>) :: TransformH Core () -> RewriteH Core -> RewriteH Core)
+   , external "focus"      (hfocusR :: TransformH LCore LocalPathH -> RewriteH LCore -> RewriteH LCore)
+       [ "Apply a rewrite to a focal point."] .+ Navigation .+ Deep
+   , external "focus"      (hfocusT :: TransformH LCore LocalPathH -> TransformH LCore String -> TransformH LCore String)
+       [ "Apply a query at a focal point."] .+ Navigation .+ Deep
+   , external "focus"      ((\p -> hfocusR (return p)) :: LocalPathH -> RewriteH LCore -> RewriteH LCore)
+       [ "Apply a rewrite to a focal point."] .+ Navigation .+ Deep
+   , external "focus"      ((\p -> hfocusT (return p)) :: LocalPathH -> TransformH LCore String -> TransformH LCore String)
+       [ "Apply a query at a focal point."] .+ Navigation .+ Deep
+   , external "when"       ((>>) :: TransformH LCore () -> RewriteH LCore -> RewriteH LCore)
        [ "Apply a rewrite only if the check succeeds." ] .+ Predicate
-   , external "not"        (notM :: TransformH Core () -> TransformH Core ())
+   , external "not"        (notM :: TransformH LCore () -> TransformH LCore ())
        [ "Cause a failing check to succeed, a succeeding check to fail." ] .+ Predicate
-   , external "invert"     (invertBiT :: BiRewriteH Core -> BiRewriteH Core)
+   , external "invert"     (invertBiT :: BiRewriteH LCore -> BiRewriteH LCore)
        [ "Reverse a bidirectional rewrite." ]
-   , external "forward"    (forwardT :: BiRewriteH Core -> RewriteH Core)
+   , external "forward"    (forwardT :: BiRewriteH LCore -> RewriteH LCore)
        [ "Apply a bidirectional rewrite forewards." ]
-   , external "backward"   (backwardT :: BiRewriteH Core -> RewriteH Core)
+   , external "backward"   (backwardT :: BiRewriteH LCore -> RewriteH LCore)
        [ "Apply a bidirectional rewrite backwards." ]
-   , external "test"       (testQuery :: RewriteH Core -> TransformH Core String)
+   , external "test"       (testQuery :: RewriteH LCore -> TransformH LCore String)
        [ "Determine if a rewrite could be successfully applied." ]
-   , external "any-call"   (anyCallR :: RewriteH Core -> RewriteH Core)
+   , external "any-call"   (anyCallR_LCore :: RewriteH LCore -> RewriteH LCore)
        [ "any-call (.. unfold command ..) applies an unfold command to all applications."
        , "Preference is given to applications with more arguments." ] .+ Deep
-   , external "promote"    (promoteR :: RewriteH Core -> RewriteH CoreTC)
+   , external "promote"    (promoteR :: RewriteH LCore -> RewriteH LCoreTC)
        [ "Promote a RewriteCore to a RewriteCoreTC" ]
-   , external "extract"    (extractR :: RewriteH CoreTC -> RewriteH Core)
+   , external "extract"    (extractR :: RewriteH LCoreTC -> RewriteH LCore)
        [ "Extract a RewriteCore from a RewriteCoreTC" ]
-   , external "between"    (betweenR :: Int -> Int -> RewriteH CoreTC -> RewriteH CoreTC)
+   , external "extract"    (extractT :: TransformH LCoreTC String -> TransformH LCore String)
+       [ "Extract a TransformLCoreString from a TransformLCoreTCString" ]
+   , external "between"    (betweenR :: Int -> Int -> RewriteH LCoreTC -> RewriteH LCoreTC)
        [ "between x y rr -> perform rr at least x times and at most y times." ]
+   , external "atPath"     (flip hfocusT idR :: TransformH LCore LocalPathH -> TransformH LCore LCore)
+       [ "return the expression found at the given path" ]
+   , external "atPath"     (flip hfocusT idR :: TransformH LCoreTC LocalPathH -> TransformH LCoreTC LCoreTC)
+       [ "return the expression found at the given path" ]
+   , external "atPath"     (extractT . flip hfocusT projectT :: TransformH LCoreTC LocalPathH -> TransformH LCore LCore)
+       [ "return the expression found at the given path" ]
    ]
 
 ------------------------------------------------------------------------------------
 
-hfocusR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m CoreTC LocalPathH -> Rewrite c m CoreTC -> Rewrite c m CoreTC
+hfocusR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, Walker c u, MonadCatch m)
+        => Transform c m u LocalPathH -> Rewrite c m u -> Rewrite c m u
 hfocusR tp r = do lp <- tp
                   localPathR lp r
 {-# INLINE hfocusR #-}
 
-hfocusT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m CoreTC LocalPathH -> Transform c m CoreTC String -> Transform c m CoreTC String
+hfocusT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, Walker c u, MonadCatch m)
+        => Transform c m u LocalPathH -> Transform c m u b -> Transform c m u b
 hfocusT tp t = do lp <- tp
                   localPathT lp t
 {-# INLINE hfocusT #-}
@@ -131,13 +153,24 @@
 anyCallR :: forall c m. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext 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
+              readerT $ \case
+                           ExprCore (App {}) -> childR App_Arg (anyCallR rr)
+                                                >+> (rr <+ childR App_Fun (anyCallR rr))
+                           ExprCore (Var {}) -> rr
+                           _                 -> anyR (anyCallR rr)
 
+-- | Top-down traversal tuned to matching function calls.
+anyCallR_LCore :: forall c m. (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m)
+         => Rewrite c m LCore -> Rewrite c m LCore
+anyCallR_LCore rr = prefixFailMsg "any-call failed: " $
+              readerT $ \case
+                           LCore (ExprCore (App {})) ->     childR App_Arg (anyCallR_LCore rr)
+                                                        >+> (rr <+ childR App_Fun (anyCallR_LCore rr))
+                           LCore (ExprCore (Var {})) -> rr
+                           _                         -> anyR (anyCallR_LCore rr)
+
+-- TODO: sort out this duplication
+
 ------------------------------------------------------------------------------------
 
 -- | betweenR x y rr -> perform rr at least x times and at most y times.
@@ -150,3 +183,4 @@
                | c < l  = rr >>> go (c+1)   -- haven't hit lower bound yet
                | otherwise = tryR (rr >>> go (c+1))  -- met lower bound
 
+------------------------------------------------------------------------------------
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
@@ -34,7 +34,6 @@
 import HERMIT.Utilities
 
 import HERMIT.Dictionary.Common
-import HERMIT.Dictionary.GHC (substCoreExpr)
 import HERMIT.Dictionary.Local.Bind hiding (externals)
 import qualified HERMIT.Dictionary.Local.Bind as Bind
 import HERMIT.Dictionary.Local.Case hiding (externals)
@@ -52,31 +51,31 @@
 --   (Many taken from Chapter 3 of Andre Santos' dissertation.)
 externals :: [External]
 externals =
-    [ external "beta-reduce" (promoteExprR betaReduceR :: RewriteH Core)
+    [ external "beta-reduce" (promoteExprR betaReduceR :: RewriteH LCore)
         [ "((\\ v -> E1) E2) ==> let v = E2 in E1"
         , "This form of beta-reduction is safe if E2 is an arbitrary expression"
         , "(won't duplicate work)." ]                                 .+ Eval .+ Shallow
-    , external "beta-expand" (promoteExprR betaExpandR :: RewriteH Core)
+    , external "beta-expand" (promoteExprR betaExpandR :: RewriteH LCore)
         [ "(let v = e1 in e2) ==> (\\ v -> e2) e1" ]                            .+ Shallow
-    , external "eta-reduce" (promoteExprR etaReduceR :: RewriteH Core)
+    , external "eta-reduce" (promoteExprR etaReduceR :: RewriteH LCore)
         [ "(\\ v -> e1 v) ==> e1" ]                                             .+ Eval .+ Shallow
-    , external "eta-expand" (promoteExprR . etaExpandR :: String -> RewriteH Core)
+    , external "eta-expand" (promoteExprR . etaExpandR :: String -> RewriteH LCore)
         [ "\"eta-expand 'v\" performs e1 ==> (\\ v -> e1 v)" ]                  .+ Shallow .+ Introduce
-    , external "flatten-module" (promoteModGutsR flattenModuleR :: RewriteH Core)
+    , external "flatten-module" (promoteModGutsR flattenModuleR :: RewriteH LCore)
         [ "Flatten all the top-level binding groups in the module to a single recursive binding group."
         , "This can be useful if you intend to appply GHC RULES." ]
-    , external "flatten-program" (promoteProgR flattenProgramR :: RewriteH Core)
+    , external "flatten-program" (promoteProgR flattenProgramR :: RewriteH LCore)
         [ "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 . mkOccPred :: OccurrenceName -> RewriteH Core)
+    , external "abstract" (promoteExprR . abstractR . mkOccPred :: OccurrenceName -> RewriteH LCore)
         [ "Abstract over a variable using a lambda."
         , "e  ==>  (\\ x -> e) x" ]                                             .+ Shallow .+ Introduce .+ Context
-    , external "push" ((\ nm strictf -> push (Just strictf) (cmpString2Var nm)) :: String -> RewriteH Core -> RewriteH Core)
+    , external "push" ((\ nm strictf -> push (Just strictf) (cmpString2Var nm)) :: String -> RewriteH LCore -> RewriteH LCore)
         [ "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 . cmpString2Var :: String -> RewriteH Core)
+    , external "push-unsafe" (push Nothing . cmpString2Var :: String -> RewriteH LCore)
         [ "Push a function 'f into a case-expression or let-expression argument."
-        , "Requires 'f to be strict." ] .+ Shallow .+ Commute .+ PreCondition
+        , "Requires 'f to be strict." ] .+ Shallow .+ Commute .+ PreCondition .+ Unsafe
     ]
     ++ Bind.externals
     ++ Case.externals
@@ -163,9 +162,9 @@
 
 ------------------------------------------------------------------------------------------------------
 
-push :: Maybe (RewriteH Core) -- ^ a proof that the function (after being applied to its type arguments) is strict
+push :: Maybe (RewriteH LCore) -- ^ a proof that the function (after being applied to its type arguments) is strict
      -> (Id -> Bool)          -- ^ a predicate to identify the function
-     -> RewriteH Core
+     -> RewriteH LCore
 push mstrict p = promoteExprR (pushR (extractR `fmap` mstrict) p)
 
 -- | Push a function through a Case or Let expression.
diff --git a/src/HERMIT/Dictionary/Local/Bind.hs b/src/HERMIT/Dictionary/Local/Bind.hs
--- a/src/HERMIT/Dictionary/Local/Bind.hs
+++ b/src/HERMIT/Dictionary/Local/Bind.hs
@@ -17,10 +17,10 @@
 -- | Externals for manipulating binding groups.
 externals :: [External]
 externals =
-    [ external "nonrec-to-rec" (promoteBindR nonrecToRecR :: RewriteH Core)
+    [ external "nonrec-to-rec" (promoteBindR nonrecToRecR :: RewriteH LCore)
         [ "Convert a non-recursive binding into a recursive binding group with a single definition."
         , "NonRec v e ==> Rec [Def v e]" ]                           .+ Shallow
-    , external "rec-to-nonrec" (promoteBindR recToNonrecR :: RewriteH Core)
+    , external "rec-to-nonrec" (promoteBindR recToNonrecR :: RewriteH LCore)
         [ "Convert a singleton recursive binding into a non-recursive binding group."
         , "Rec [Def v e] ==> NonRec v e,  (v not free in e)" ]
     ]
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
@@ -16,8 +16,9 @@
     , caseReduceR
     , caseReduceDataconR
     , caseReduceLiteralR
-    -- , caseReduceIdR
     , caseReduceUnfoldR
+    , casesForM
+    , caseExprsForM
     , caseSplitR
     , caseSplitInlineR
     , caseInlineScrutineeR
@@ -32,7 +33,6 @@
     ) where
 
 import Control.Arrow
-import Control.Applicative
 import Control.Monad
 import Control.Monad.IO.Class
 
@@ -44,96 +44,101 @@
 import HERMIT.External
 import HERMIT.GHC
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
 import HERMIT.Name
 import HERMIT.ParserCore
 import HERMIT.Utilities
 
+import HERMIT.Dictionary.AlphaConversion hiding (externals)
 import HERMIT.Dictionary.Common
+import HERMIT.Dictionary.Fold hiding (externals)
 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, buildStrictnessLemmaT)
 import HERMIT.Dictionary.Unfold (unfoldR)
 
--- NOTE: these are hard to test in small examples, as GHC does them for us, so use with caution
 ------------------------------------------------------------------------------
 
 -- | Externals relating to Case expressions.
 externals :: [External]
 externals =
-    [ external "case-float-app" (promoteExprR caseFloatAppR :: RewriteH Core)
+    [ external "case-float-app" (promoteExprR caseFloatAppR :: RewriteH LCore)
         [ "(case ec of alt -> e) v ==> case ec of alt -> e v" ] .+ Commute .+ Shallow
-    , external "case-float-arg" ((\ strict -> promoteExprR (caseFloatArg Nothing (Just strict))) :: RewriteH Core -> RewriteH Core)
+    , external "case-float-arg" ((\ strict -> promoteExprR (caseFloatArg Nothing (Just strict))) :: RewriteH LCore -> RewriteH LCore)
         [ "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" ((\ f strict -> promoteExprR (caseFloatArg (Just f) (Just strict))) :: CoreString -> RewriteH Core -> RewriteH Core)
+    , external "case-float-arg" ((\ f strict -> promoteExprR (caseFloatArg (Just f) (Just strict))) :: CoreString -> RewriteH LCore -> RewriteH LCore)
         [ "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)
+    , external "case-float-arg-unsafe" ((\ f -> promoteExprR (caseFloatArg (Just f) Nothing)) :: CoreString -> RewriteH LCore)
         [ "For a specified f,"
         , "f (case s of alt -> e) ==> case s of alt -> f e" ]   .+ Commute .+ Shallow .+ PreCondition .+ Strictness
-    , 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 .+ Strictness
-    , external "case-float-arg-lemma" (promoteExprR . caseFloatArgLemmaR :: LemmaName -> RewriteH Core)
+    , external "case-float-arg-unsafe" (promoteExprR . caseFloatArgLemmaR UnsafeUsed :: LemmaName -> RewriteH LCore)
+        [ "f (case s of alt -> e) ==> case s of alt -> f e" ]   .+ Commute .+ Shallow .+ PreCondition .+ Strictness .+ Unsafe
+    , external "case-float-arg-lemma" (promoteExprR . caseFloatArgLemmaR Obligation :: LemmaName -> RewriteH LCore)
         [ "f (case s of alt -> e) ==> case s of alt -> f e"
         , "Generates a lemma with given name for strictness side condition on f." ] .+ Commute .+ Shallow .+ PreCondition .+ Strictness
-    , external "case-float-case" (promoteExprR caseFloatCaseR :: RewriteH Core)
+    , external "case-float-case" (promoteExprR caseFloatCaseR :: RewriteH LCore)
         [ "case (case ec of alt1 -> e1) of alta -> ea ==> case ec of alt1 -> case e1 of alta -> ea" ] .+ Commute .+ Eval
-    , external "case-float-cast" (promoteExprR caseFloatCastR :: RewriteH Core)
+    , external "case-float-cast" (promoteExprR caseFloatCastR :: RewriteH LCore)
         [ "cast (case s of p -> e) co ==> case s of p -> cast e co" ]        .+ Shallow .+ Commute
-    , external "case-float-let" (promoteExprR caseFloatLetR :: RewriteH Core)
+    , external "case-float-let" (promoteExprR caseFloatLetR :: RewriteH LCore)
         [ "let v = case ec of alt1 -> e1 in e ==> case ec of alt1 -> let v = e1 in e" ] .+ Commute .+ Shallow .+ Strictness
-    , external "case-float" (promoteExprR caseFloatR :: RewriteH Core)
+    , external "case-float" (promoteExprR caseFloatR :: RewriteH LCore)
         [ "case-float = case-float-app <+ case-float-case <+ case-float-let <+ case-float-cast" ] .+ Commute .+ Shallow .+ Strictness
-    , external "case-float-in" (promoteExprR caseFloatInR :: RewriteH Core)
+    , external "case-float-in" (promoteExprR caseFloatInR :: RewriteH LCore)
         [ "Float in a Case whatever the context." ]                             .+ Commute .+ Shallow .+ PreCondition
-    , external "case-float-in-args" (promoteExprR caseFloatInArgsR :: RewriteH Core)
+    , external "case-float-in-args" (promoteExprR caseFloatInArgsR :: RewriteH LCore)
         [ "Float in a Case whose alternatives are parallel applications of the same function." ] .+ Commute .+ Shallow .+ PreCondition .+ Strictness
-    -- , external "case-float-in-app" (promoteExprR caseFloatInApp :: RewriteH Core)
+    -- , external "case-float-in-app" (promoteExprR caseFloatInApp :: RewriteH LCore)
     --     [ "Float in a Case whose alternatives are applications of different functions with the same arguments." ] .+ Commute .+ Shallow .+ PreCondition
-    , external "case-reduce" (promoteExprR (caseReduceR True) :: RewriteH Core)
+    , external "case-reduce" (promoteExprR (caseReduceR True) :: RewriteH LCore)
         [ "Case of Known Constructor"
         , "case-reduce-datacon <+ case-reduce-literal" ]                     .+ Shallow .+ Eval
-    , external "case-reduce-datacon" (promoteExprR (caseReduceDataconR True) :: RewriteH Core)
+    , external "case-reduce-datacon" (promoteExprR (caseReduceDataconR True) :: RewriteH LCore)
         [ "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 True) :: RewriteH Core)
+    , external "case-reduce-literal" (promoteExprR (caseReduceLiteralR True) :: RewriteH LCore)
         [ "Case of Known Constructor"
         , "case L of L -> e ==> e" ]                                         .+ Shallow .+ Eval
-    , external "case-reduce-unfold" (promoteExprR (caseReduceUnfoldR True) :: RewriteH Core)
+    , external "case-reduce-unfold" (promoteExprR (caseReduceUnfoldR True) :: RewriteH LCore)
         [ "Unfold the case scrutinee and then case-reduce." ] .+ Shallow .+ Eval .+ Context
-    , external "case-split" (promoteExprR . caseSplitR . cmpString2Var :: String -> RewriteH Core)
+    , external "case-split" ((\nm -> findVarT (unOccurrenceName nm) >>= promoteExprR . caseSplitR . varToCoreExpr) :: OccurrenceName -> RewriteH LCore)
         [ "case-split 'x"
-        , "e ==> case x of C1 vs -> e; C2 vs -> e, where x is free in e" ] .+ Shallow .+ Strictness
-    , external "case-split-inline" (promoteExprR . caseSplitInlineR . cmpString2Var :: String -> RewriteH Core)
+        , "e ==> case x of C1 vs -> e; C2 vs -> e, where x is free in e" ] .+ Deep .+ Strictness
+    , external "case-split" (parseCoreExprT >=> promoteR . caseSplitR :: CoreString -> RewriteH LCore)
+        [ "case-split [| expr |]"
+        , "e ==> case expr of C1 vs -> e; C2 vs -> e"] .+ Deep .+ Strictness
+    , external "case-split-inline" ((\nm -> findVarT (unOccurrenceName nm) >>= promoteExprR . caseSplitInlineR . varToCoreExpr) :: OccurrenceName -> RewriteH LCore)
         [ "Like case-split, but additionally inlines the matched constructor "
         , "applications for all occurances of the named variable." ] .+ Deep .+ Strictness
-    , external "case-intro-seq" (promoteExprR . caseIntroSeqR . cmpString2Var :: String -> RewriteH Core)
+    , external "case-split-inline" (parseCoreExprT >=> promoteExprR . caseSplitInlineR :: CoreString -> RewriteH LCore)
+        [ "Like case-split, but additionally inlines the matched constructor "
+        , "applications for all occurances of the case binder." ] .+ Deep .+ Strictness
+    , external "case-intro-seq" (promoteExprR . caseIntroSeqR . cmpString2Var :: String -> RewriteH LCore)
         [ "Force evaluation of a variable by introducing a case."
         , "case-intro-seq 'v is is equivalent to adding @(seq v)@ in the source code." ] .+ Shallow .+ Introduce .+ Strictness
-    , external "case-elim-seq" (promoteExprR caseElimSeqR :: RewriteH Core)
+    , external "case-elim-seq" (promoteExprR caseElimSeqR :: RewriteH LCore)
         [ "Eliminate a case that corresponds to a pointless seq."  ] .+ Deep .+ Eval .+ Strictness
-    , external "case-inline-alternative" (promoteExprR caseInlineAlternativeR :: RewriteH Core)
+    , external "case-inline-alternative" (promoteExprR caseInlineAlternativeR :: RewriteH LCore)
         [ "Inline the case binder as the case-alternative pattern everywhere in the case alternatives." ] .+ Deep
-    , external "case-inline-scrutinee" (promoteExprR caseInlineScrutineeR :: RewriteH Core)
+    , external "case-inline-scrutinee" (promoteExprR caseInlineScrutineeR :: RewriteH LCore)
         [ "Inline the case binder as the case scrutinee everywhere in the case alternatives." ] .+ Deep
-    , external "case-merge-alts" (promoteExprR caseMergeAltsR :: RewriteH Core)
+    , external "case-merge-alts" (promoteExprR caseMergeAltsR :: RewriteH LCore)
         [ "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-binder" (promoteExprR caseMergeAltsWithBinderR :: RewriteH Core)
+    , external "case-merge-alts-with-binder" (promoteExprR caseMergeAltsWithBinderR :: RewriteH LCore)
         [ "A cleverer version of 'mergeCaseAlts' that first attempts to"
         , "abstract out any occurrences of the alternative pattern using the case binder." ] .+ Deep
-    , external "case-elim" (promoteExprR caseElimR :: RewriteH Core)
+    , external "case-elim" (promoteExprR caseElimR :: RewriteH LCore)
         [ "case s of w; C vs -> e ==> e if w and vs are not free in e" ]     .+ Shallow .+ Strictness
-    , external "case-elim-inline-scrutinee" (promoteExprR caseElimInlineScrutineeR :: RewriteH Core)
+    , external "case-elim-inline-scrutinee" (promoteExprR caseElimInlineScrutineeR :: RewriteH LCore)
         [ "Eliminate a case, inlining any occurrences of the case binder as the scrutinee." ] .+ Deep
-    , external "case-elim-merge-alts" (promoteExprR caseElimMergeAltsR :: RewriteH Core)
+    , external "case-elim-merge-alts" (promoteExprR caseElimMergeAltsR :: RewriteH LCore)
         [ "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-binder" (promoteExprR caseFoldBinderR :: RewriteH Core)
+    , external "case-fold-binder" (promoteExprR caseFoldBinderR :: RewriteH LCore)
         [ "In the case alternatives, fold any occurrences of the case alt patterns to the case binder." ]
     ]
 
@@ -166,7 +171,7 @@
           (\(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 :: Maybe CoreString -> Maybe (RewriteH LCore) -> RewriteH CoreExpr
 caseFloatArg mfstr mstrictCore = let mstrict = extractR <$> mstrictCore
                                   in case mfstr of
                                        Nothing    -> caseFloatArgR Nothing mstrict
@@ -202,9 +207,9 @@
 --   Only safe if @f@ is strict, so introduces a lemma to prove.
 caseFloatArgLemmaR :: ( AddBindings c, BoundVars c, ExtendPath c Crumb, ReadPath c Crumb, HasHermitMEnv m
                       , HasHscEnv m, HasDynFlags m, HasLemmas m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
-                   => LemmaName -> Rewrite c m CoreExpr
-caseFloatArgLemmaR nm = prefixFailMsg "Case floating from application argument failed: " $
-                        withPatFailMsg "App f (Case s w ty alts)" $ do
+                   => Used -> LemmaName -> Rewrite c m CoreExpr
+caseFloatArgLemmaR u nm = prefixFailMsg "Case floating from application argument failed: " $
+                          withPatFailMsg "App f (Case s w ty alts)" $ do
     App f (Case s w _ alts) <- idR
 
     let fvs         = freeVarsExpr f
@@ -215,7 +220,7 @@
             appAllR idR (alphaCaseBinderR Nothing) >>> caseFloatArgR Nothing Nothing
        | all isEmptyVarSet altCaptures -> do
             let new_alts = mapAlts (App f) alts
-            buildStrictnessLemmaT nm f
+            buildStrictnessLemmaT u nm f
             return $ Case s w (coreAltsType new_alts) new_alts
        | otherwise ->
             appAllR idR (caseAllR idR idR idR (\ n -> let vs = varSetElems (altCaptures !! n)
@@ -363,25 +368,44 @@
                               | 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:
+-- | Case split on an arbitrary scrutinee s. All free variables in s should be in scope.
 --
--- E.g. Assume expression e which mentions i :: [a]
+-- E.g. If s has type [a], then case-split s:
 --
--- e ==> case i of i
---         []     -> e
---         (a:as) -> e
-caseSplitR :: (MonadCatch m, MonadUnique m) => (Id -> Bool) -> Rewrite c m 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 -> liftM (dc,) (sequence [ newIdH a ty | (a,ty) <- zip aNms $ dataConInstArgTys dc tys ]))
-                                                              (tyConDataCons tycon)
-                                           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
+-- e ==> case s of w
+--         []     -> e[w/s]
+--         (a:as) -> e[w/s]
+--
+-- Note that occurrences of s in e are replaced with the case binder.
+caseSplitR :: forall c m. ( AddBindings c, BoundVars c, ExtendPath c Crumb, HasEmptyContext c, ReadPath c Crumb
+                          , MonadCatch m, MonadUnique m )
+           => CoreExpr -> Rewrite c m CoreExpr
+caseSplitR s = prefixFailMsg "case-split failed: " $ do
+    c <- contextT
+    guardMsg (all (inScope c) $ varSetElems $ freeVarsExpr s) "variables in desired scrutinee are unbound."
+    w <- constT $ newVarH "w" (exprType s)
+    let f = compileFold [Equality [] s (varToCoreExpr w)]
+    e' <- tryR $ withVarsInScope [w] $ extractR (anytdR (promoteR $ runFoldR f) :: Rewrite c m Core)
+    constT $ do
+        dcsAndBss <- casesForM s
+        let alts = [ (DataAlt dc, bs, e') | (dc,bs) <- dcsAndBss ]
+        guardMsg (not (null alts)) "no constructors for scrutinee of that type."
+        return $ Case s w (exprType e') alts
 
+casesForM :: MonadUnique m => CoreExpr -> m [(DataCon, [Id])]
+casesForM e = do
+    (tyCon, tys) <- splitTyConAppM (exprType e)
+    let aNms = map (:[]) $ cycle ['a'..'z']
+    forM (tyConDataCons tyCon) $ \ dc -> do
+        bs <- sequence [ newIdH a ty | (a,ty) <- zip aNms $ dataConInstArgTys dc tys ]
+        return (dc,bs)
+
+caseExprsForM :: MonadUnique m => CoreExpr -> m [CoreExpr]
+caseExprsForM e = do
+    (_, tys) <- splitTyConAppM (exprType e)
+    cases <- casesForM e
+    return [ mkDataConApp tys dc vs | (dc,vs) <- cases ]
+
 -- | Force evaluation of an identifier by introducing a case.
 --   This is equivalent to adding @(seq v)@ in the source code.
 --
@@ -411,8 +435,8 @@
 -- > caseSplitInline idPred = caseSplit idPred >>> caseInlineAlternativeR
 caseSplitInlineR :: ( ExtendPath c Crumb, ReadPath c Crumb, AddBindings c
                     , ReadBindings c, HasEmptyContext c, MonadCatch m, MonadUnique m )
-                 => (Id -> Bool) -> Rewrite c m CoreExpr
-caseSplitInlineR idPred = caseSplitR idPred >>> caseInlineAlternativeR
+                 => CoreExpr -> Rewrite c m CoreExpr
+caseSplitInlineR s = caseSplitR s >>> caseInlineAlternativeR
 
 ------------------------------------------------------------------------------
 
@@ -458,10 +482,12 @@
 caseFoldBinderR :: forall c m. ( ExtendPath c Crumb, ReadPath c Crumb, AddBindings c
                                , ReadBindings c, HasEmptyContext c, MonadCatch m, MonadUnique m )
                 => Rewrite c m CoreExpr
-caseFoldBinderR = prefixFailMsg "case-fold-binder failed: " $ do
-    w <- caseBinderIdT
-    caseAllR idR idR idR $ \ _ -> do depth <- varBindingDepthT w
-                                     extractR $ anybuR (promoteExprR (foldVarR (Just depth) w) :: Rewrite c m Core)
+caseFoldBinderR = prefixFailMsg "case-fold-binder failed: " $
+    -- ensure the case binder is not dead, or else fold will fail
+    caseAllR idR (arr (flip setIdOccInfo NoOccInfo)) idR (const idR) >>> (do
+        w <- caseBinderIdT
+        caseAllR idR idR idR $ \ _ -> do depth <- varBindingDepthT w
+                                         extractR $ anybuR (promoteExprR (foldVarR (Just depth) w) :: Rewrite c m Core))
 
 -- | 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
diff --git a/src/HERMIT/Dictionary/Local/Cast.hs b/src/HERMIT/Dictionary/Local/Cast.hs
--- a/src/HERMIT/Dictionary/Local/Cast.hs
+++ b/src/HERMIT/Dictionary/Local/Cast.hs
@@ -6,6 +6,7 @@
     , castElimReflR
     , castElimSymR
     , castFloatAppR
+    , castFloatLamR
     , castElimSymPlusR -- TODO: revisit
     )
 where
@@ -17,9 +18,9 @@
 
 import HERMIT.Core
 import HERMIT.Context
-import HERMIT.Kure
 import HERMIT.External
 import HERMIT.GHC
+import HERMIT.Kure
 
 import HERMIT.Dictionary.Common
 
@@ -28,17 +29,19 @@
 -- | Externals relating to Case expressions.
 externals :: [External]
 externals =
-    [ external "cast-elim" (promoteExprR castElimR :: RewriteH Core)
+    [ external "cast-elim" (promoteExprR castElimR :: RewriteH LCore)
         [ "cast-elim-refl <+ cast-elim-sym" ] .+ Shallow -- don't include in "Bash", as sub-rewrites are tagged "Bash" already.
-    , external "cast-elim-refl" (promoteExprR castElimReflR :: RewriteH Core)
+    , external "cast-elim-refl" (promoteExprR castElimReflR :: RewriteH LCore)
         [ "cast e co ==> e ; if co is a reflexive coercion" ] .+ Shallow
-    , external "cast-elim-sym" (promoteExprR castElimSymR :: RewriteH Core)
+    , external "cast-elim-sym" (promoteExprR castElimSymR :: RewriteH LCore)
         [ "removes pairs of symmetric casts" ]                .+ Shallow
-    , external "cast-elim-sym-plus" (promoteExprR castElimSymPlusR :: RewriteH Core)
+    , external "cast-elim-sym-plus" (promoteExprR castElimSymPlusR :: RewriteH LCore)
         [ "removes pairs of symmetric casts possibly separated by let or case forms" ] .+ Deep .+ TODO
-    , external "cast-float-app" (promoteExprR castFloatAppR :: RewriteH Core)
+    , external "cast-float-app" (promoteExprR castFloatAppR :: RewriteH LCore)
         [ "(cast e (c1 -> c2)) x ==> cast (e (cast x (sym c1))) c2" ] .+ Shallow
-    , external "cast-elim-unsafe" (promoteExprR castElimUnsafeR :: RewriteH Core)
+    , external "cast-float-lam" (promoteExprR castFloatLamR :: RewriteH LCore)
+        [ "\\ x::a -> cast x (a -> b) ==> cast (\\x::a -> x) ((a -> a) -> (a -> b))" ] .+ Shallow
+    , external "cast-elim-unsafe" (promoteExprR castElimUnsafeR :: RewriteH LCore)
         [ "removes casts regardless of whether it is safe to do so" ] .+ Shallow .+ Experiment .+ Unsafe .+ TODO
     ]
 
@@ -78,6 +81,16 @@
                 return (Cast (App e1 e2) (Coercion.substCo (Coercion.extendTvSubst emptyCvSubst t x') c2))
             _ -> fail "castFloatApp"
 
+-- (\ x::a -> cast e (b -> c)) :: a -> c
+-- cast (\x::a -> e) ((a -> b) -> (a -> c))
+castFloatLamR :: MonadCatch m => Rewrite c m CoreExpr
+castFloatLamR = prefixFailMsg "Cast float from lambda failed: " $
+                withPatFailMsg (wrongExprForm "Lam b (Cast e co)") $ do
+    Lam b (Cast e co) <- idR
+    let r = coercionRole co
+        aTy = varType b
+    return (Cast (Lam b e) (mkFunCo r (mkReflCo r aTy) co))
+
 -- | Attempts to tease a coercion apart into a type constructor and the application
 -- of a number of coercion arguments to that constructor
 splitTyConAppCo_maybe :: Coercion -> Maybe (TyCon, [Coercion])
@@ -124,4 +137,3 @@
 
 castElimUnsafeR :: (ExtendPath c Crumb, Monad m) => Rewrite c m CoreExpr
 castElimUnsafeR = castT idR idR const
-
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
@@ -69,81 +69,81 @@
 -- | Externals relating to 'Let' expressions.
 externals :: [External]
 externals =
-    [ external "let-subst" (promoteExprR letSubstR :: RewriteH Core)
+    [ external "let-subst" (promoteExprR letSubstR :: RewriteH LCore)
         [ "Let substitution: (let x = e1 in e2) ==> (e2[e1/x])"
         , "x must not be free in e1." ]                                         .+ Deep .+ Eval
-    , external "let-subst-safe" (promoteExprR letSubstSafeR :: RewriteH Core)
+    , external "let-subst-safe" (promoteExprR letSubstSafeR :: RewriteH LCore)
         [ "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)
+    , external "let-nonrec-subst-safe" (promoteExprR letNonRecSubstSafeR :: RewriteH LCore)
         [ "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)
+    -- , external "safe-let-subst-plus" (promoteExprR safeLetSubstPlusR :: RewriteH LCore)
     --     [ "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 :: String -> RewriteH Core)
+    , external "let-intro" (promoteExprR . letIntroR :: String -> RewriteH LCore)
         [ "e => (let v = e in v), name of v is provided" ]                      .+ Shallow .+ Introduce
-    , external "let-intro-unfolding" (promoteExprR . letIntroUnfoldingR :: HermitName -> RewriteH Core)
+    , external "let-intro-unfolding" (promoteExprR . letIntroUnfoldingR :: HermitName -> RewriteH LCore)
         [ "e => let f' = defn[f'/f] in e[f'/f], name of f is provided" ]
-    , external "let-elim" (promoteExprR letElimR :: RewriteH Core)
+    , external "let-elim" (promoteExprR letElimR :: RewriteH LCore)
         [ "Remove an unused let binding."
         , "(let v = e1 in e2) ==> e2, if v is not free in e1 or e2." ]          .+ Eval .+ Shallow
---    , external "let-constructor-reuse" (promoteR $ not_defined "constructor-reuse" :: RewriteH Core)
+--    , external "let-constructor-reuse" (promoteR $ not_defined "constructor-reuse" :: RewriteH LCore)
 --        [ "let v = C v1..vn in ... C v1..vn ... ==> let v = C v1..vn in ... v ..., fails otherwise" ] .+ Eval
-    , external "let-float-app" (promoteExprR letFloatAppR :: RewriteH Core)
+    , external "let-float-app" (promoteExprR letFloatAppR :: RewriteH LCore)
         [ "(let v = ev in e) x ==> let v = ev in e x" ]                         .+ Commute .+ Shallow
-    , external "let-float-arg" (promoteExprR letFloatArgR :: RewriteH Core)
+    , external "let-float-arg" (promoteExprR letFloatArgR :: RewriteH LCore)
         [ "f (let v = ev in e) ==> let v = ev in f e" ]                         .+ Commute .+ Shallow
-    , external "let-float-lam" (promoteExprR letFloatLamR :: RewriteH Core)
+    , external "let-float-lam" (promoteExprR letFloatLamR :: RewriteH LCore)
         [ "The Full Laziness Transformation"
         , "(\\ v1 -> let v2 = e1 in e2)  ==>  let v2 = e1 in (\\ v1 -> e2), if v1 is not free in e2."
         , "If v1 = v2 then v1 will be alpha-renamed." ]                         .+ Commute .+ Shallow
-    , external "let-float-let" (promoteExprR letFloatLetR :: RewriteH Core)
+    , external "let-float-let" (promoteExprR letFloatLetR :: RewriteH LCore)
         [ "let v = (let w = ew in ev) in e ==> let w = ew in let v = ev in e" ] .+ Commute .+ Shallow
-    , external "let-float-case" (promoteExprR letFloatCaseR :: RewriteH Core)
+    , external "let-float-case" (promoteExprR letFloatCaseR :: RewriteH LCore)
         [ "case (let v = ev in e) of ... ==> let v = ev in case e of ..." ]     .+ Commute .+ Shallow .+ Eval
-    , external "let-float-case-alt" (promoteExprR (letFloatCaseAltR Nothing) :: RewriteH Core)
+    , external "let-float-case-alt" (promoteExprR (letFloatCaseAltR Nothing) :: RewriteH LCore)
         [ "case s of { ... ; p -> let v = ev in e ; ... } "
         , "==> let v = ev in case s of { ... ; p -> e ; ... } " ]               .+ Commute .+ Shallow .+ Eval
-    , external "let-float-case-alt" (promoteExprR . letFloatCaseAltR . Just :: Int -> RewriteH Core)
+    , external "let-float-case-alt" (promoteExprR . letFloatCaseAltR . Just :: Int -> RewriteH LCore)
         [ "Float a let binding from specified alternative."
         , "case s of { ... ; p -> let v = ev in e ; ... } "
         , "==> let v = ev in case s of { ... ; p -> e ; ... } " ]               .+ Commute .+ Shallow .+ Eval
-    , external "let-float-cast" (promoteExprR letFloatCastR :: RewriteH Core)
+    , external "let-float-cast" (promoteExprR letFloatCastR :: RewriteH LCore)
         [ "cast (let bnds in e) co ==> let bnds in cast e co" ]                 .+ Commute .+ Shallow
-    , external "let-float-top" (promoteProgR letFloatTopR :: RewriteH Core)
+    , external "let-float-top" (promoteProgR letFloatTopR :: RewriteH LCore)
         [ "v = (let bds in e) : prog ==> bds : v = e : prog" ]                  .+ Commute .+ Shallow
-    , external "let-float" (promoteProgR letFloatTopR <+ promoteExprR letFloatExprR :: RewriteH Core)
+    , external "let-float" (promoteProgR letFloatTopR <+ promoteExprR letFloatExprR :: RewriteH LCore)
         [ "Float a Let whatever the context." ]                                 .+ Commute .+ Shallow  -- Don't include in bash, as each sub-rewrite is tagged "Bash" already.
-    , external "let-to-case" (promoteExprR letToCaseR :: RewriteH Core)
+    , external "let-to-case" (promoteExprR letToCaseR :: RewriteH LCore)
         [ "let v = ev in e ==> case ev of v -> e" ]                             .+ Commute .+ Shallow .+ PreCondition
---    , external "let-to-case-unbox" (promoteR $ not_defined "let-to-case-unbox" :: RewriteH Core)
+--    , external "let-to-case-unbox" (promoteR $ not_defined "let-to-case-unbox" :: RewriteH LCore)
 --        [ "let v = ev in e ==> case ev of C v1..vn -> let v = C v1..vn in e" ]
-    , external "let-float-in" (promoteExprR letFloatInR :: RewriteH Core)
+    , external "let-float-in" (promoteExprR letFloatInR :: RewriteH LCore)
         [ "Float-in a let if possible." ]                                        .+ Commute .+ Shallow
-    , external "let-float-in-app" ((promoteExprR letFloatInAppR >+> anybuR (promoteExprR letElimR)) :: RewriteH Core)
+    , external "let-float-in-app" ((promoteExprR letFloatInAppR >+> anybuR (promoteExprR letElimR)) :: RewriteH LCore)
         [ "let v = ev in f a ==> (let v = ev in f) (let v = ev in a)" ]         .+ Commute .+ Shallow
-    , external "let-float-in-case" ((promoteExprR letFloatInCaseR >+> anybuR (promoteExprR letElimR)) :: RewriteH Core)
+    , external "let-float-in-case" ((promoteExprR letFloatInCaseR >+> anybuR (promoteExprR letElimR)) :: RewriteH LCore)
         [ "let v = ev in case s of p -> e ==> case (let v = ev in s) of p -> let v = ev in e"
         , "if v does not shadow a pattern binder in p" ]                        .+ Commute .+ Shallow
-    , external "let-float-in-lam" ((promoteExprR letFloatInLamR >+> anybuR (promoteExprR letElimR)) :: RewriteH Core)
+    , external "let-float-in-lam" ((promoteExprR letFloatInLamR >+> anybuR (promoteExprR letElimR)) :: RewriteH LCore)
         [ "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 :: [String] -> RewriteH Core)
+    , external "reorder-lets" (promoteExprR . reorderNonRecLetsR :: [String] -> RewriteH LCore)
         [ "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 :: String -> RewriteH Core)
+    , external "let-tuple" (promoteExprR . letTupleR :: String -> RewriteH LCore)
         [ "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)
+    , external "prog-bind-elim" (promoteProgR progBindElimR :: RewriteH LCore)
         [ "Remove unused top-level binding(s)."
         , "prog-bind-nonrec-elim <+ prog-bind-rec-elim" ]                       .+ Eval .+ Shallow
-    , external "prog-bind-nonrec-elim" (promoteProgR progBindNonRecElimR :: RewriteH Core)
+    , external "prog-bind-nonrec-elim" (promoteProgR progBindNonRecElimR :: RewriteH LCore)
         [ "Remove unused top-level binding(s)."
         , "v = e : prog ==> prog, if v is not free in prog and not exported." ] .+ Eval .+ Shallow
-    , external "prog-bind-rec-elim" (promoteProgR progBindRecElimR :: RewriteH Core)
+    , external "prog-bind-rec-elim" (promoteProgR progBindRecElimR :: RewriteH LCore)
         [ "Remove unused top-level binding(s)."
         , "v+ = e+ : prog ==> v* = e* : prog, where v* is a subset of v+ consisting"
         , "of vs that are free in prog or e+, or exported." ]                   .+ Eval .+ Shallow
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
@@ -1,4 +1,10 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, InstanceSigs, ScopedTypeVariables, TypeFamilies #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module HERMIT.Dictionary.Navigation
     ( -- * Navigation
@@ -19,16 +25,18 @@
     , string2considerable
     ) where
 
+import Control.Arrow
+import Control.Monad
+
 import Data.Dynamic (Typeable)
 import Data.Monoid
 
-import Control.Arrow
-
 import HERMIT.Core
 import HERMIT.Context
 import HERMIT.External
 import HERMIT.GHC hiding ((<>))
 import HERMIT.Kure
+import HERMIT.Lemma(Quantified(..))
 import HERMIT.Name
 
 import HERMIT.Dictionary.Navigation.Crumbs
@@ -39,29 +47,29 @@
 externals :: [External]
 externals = crumbExternals
     ++ map (.+ Navigation)
-        [ external "rhs-of" (rhsOfT . mkRhsOfPred :: RhsOfName -> TransformH Core LocalPathH)
+        [ external "rhs-of" (rhsOfT . mkRhsOfPred :: RhsOfName -> TransformH LCoreTC LocalPathH)
             [ "Find the path to the RHS of the binding of the named variable." ]
-        , external "binding-group-of" (bindingGroupOfT . cmpString2Var :: String -> TransformH CoreTC LocalPathH)
+        , external "binding-group-of" (bindingGroupOfT . cmpString2Var :: String -> TransformH LCoreTC LocalPathH)
             [ "Find the path to the binding group of the named variable." ]
-        , external "binding-of" (bindingOfT . mkBindingPred :: BindingName -> TransformH CoreTC LocalPathH)
+        , external "binding-of" (bindingOfT . mkBindingPred :: BindingName -> TransformH LCoreTC LocalPathH)
             [ "Find the path to the binding of the named variable." ]
-        , external "occurrence-of" (occurrenceOfT . mkOccPred :: OccurrenceName -> TransformH CoreTC LocalPathH)
+        , external "occurrence-of" (occurrenceOfT . mkOccPred :: OccurrenceName -> TransformH LCoreTC LocalPathH)
             [ "Find the path to the first occurrence of the named variable." ]
-        , external "application-of" (applicationOfT . mkOccPred :: OccurrenceName -> TransformH CoreTC LocalPathH)
+        , external "application-of" (applicationOfT . mkOccPred :: OccurrenceName -> TransformH LCoreTC LocalPathH)
             [ "Find the path to the first application of the named variable." ]
-        , external "consider" (considerConstructT :: Considerable -> TransformH Core LocalPathH)
+        , external "consider" (considerConstructT :: Considerable -> TransformH LCore LocalPathH)
             [ "consider <c> focuses on the first construct <c>.", recognizedConsiderables ]
-        , external "arg" (promoteExprT . nthArgPath :: Int -> TransformH Core LocalPathH)
+        , external "arg" (promoteExprT . nthArgPath :: Int -> TransformH LCore LocalPathH)
             [ "arg n focuses on the (n-1)th argument of a nested application." ]
-        , external "lams-body" (promoteExprT lamsBodyT :: TransformH Core LocalPathH)
+        , external "lams-body" (promoteExprT lamsBodyT :: TransformH LCore LocalPathH)
             [ "Descend into the body after a sequence of lambdas." ]
-        , external "lets-body" (promoteExprT letsBodyT :: TransformH Core LocalPathH)
+        , external "lets-body" (promoteExprT letsBodyT :: TransformH LCore LocalPathH)
             [ "Descend into the body after a sequence of let bindings." ]
-        , external "prog-end" (promoteModGutsT gutsProgEndT <+ promoteProgT progEndT :: TransformH Core LocalPathH)
+        , external "prog-end" (promoteModGutsT gutsProgEndT <+ promoteProgT progEndT :: TransformH LCore LocalPathH)
             [ "Descend to the end of a program." ]
-        , external "parent-of" (parentOfT :: TransformH Core LocalPathH -> TransformH Core LocalPathH)
+        , external "parent-of" (parentOfT :: TransformH LCore LocalPathH -> TransformH LCore LocalPathH)
             [ "Focus on the parent of another focal point." ]
-        , external "parent-of" (parentOfT :: TransformH CoreTC LocalPathH -> TransformH CoreTC LocalPathH)
+        , external "parent-of" (parentOfT :: TransformH LCoreTC LocalPathH -> TransformH LCoreTC LocalPathH)
             [ "Focus on the parent of another focal point." ]
         ]
 
@@ -76,7 +84,7 @@
 -----------------------------------------------------------------------
 
 -- | Find the path to the RHS of a binding.
-rhsOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m Core LocalPathH
+rhsOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m LCoreTC LocalPathH
 rhsOfT p = prefixFailMsg ("rhs-of failed: ") $
            do lp <- onePathToT (arr $ bindingOf p . inject)
               case lastCrumb lp of
@@ -85,26 +93,27 @@
                                 Let_Bind      -> return (lp @@ NonRec_RHS)
                                 ProgCons_Head -> return (lp @@ NonRec_RHS)
                                 _             -> fail "does not have a RHS."
-                Nothing -> defOrNonRecT successT lastCrumbT (\ () cr -> mempty @@ cr)
+                Nothing -> promoteCoreT (defOrNonRecT successT lastCrumbT (\ () cr -> mempty @@ cr))
 
 -- | Find the path to the binding group of a variable.
-bindingGroupOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m CoreTC LocalPathH
+bindingGroupOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m LCoreTC LocalPathH
 bindingGroupOfT p = prefixFailMsg ("binding-group-of failed: ") $
                     oneNonEmptyPathToT (promoteBindT $ arr $ bindingGroupOf p)
 
 -- | Find the path to the binding of a variable.
-bindingOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m CoreTC LocalPathH
+bindingOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m LCoreTC LocalPathH
 bindingOfT p = prefixFailMsg ("binding-of failed: ") $
                oneNonEmptyPathToT (arr $ bindingOf p)
 
 -- | Find the path to the first occurrence of a variable.
-occurrenceOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => (Var -> Bool) -> Transform c m CoreTC LocalPathH
+occurrenceOfT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m)
+              => (Var -> Bool) -> Transform c m LCoreTC LocalPathH
 occurrenceOfT p = prefixFailMsg ("occurrence-of failed: ") $
                   oneNonEmptyPathToT (arr $ occurrenceOf p)
 
 -- | Find the path to an application of a given function.
 applicationOfT :: (AddBindings c, ExtendPath c Crumb, HasEmptyContext c, MonadCatch m, ReadPath c Crumb)
-               => (Var -> Bool) -> Transform c m CoreTC LocalPathH
+               => (Var -> Bool) -> Transform c m LCoreTC LocalPathH
 applicationOfT p = prefixFailMsg "application-of failed:" $ oneNonEmptyPathToT go
     where go = promoteExprT (appT (extractT go) successT const) <+ arr (occurrenceOf p)
 
@@ -115,13 +124,16 @@
 
 -----------------------------------------------------------------------
 
-bindingOf :: (Var -> Bool) -> CoreTC -> Bool
+bindingOf :: (Var -> Bool) -> LCoreTC -> Bool
 bindingOf p = any p . varSetElems . binders
 
-binders :: CoreTC -> VarSet
-binders (Core core)              = bindersCore core
-binders (TyCo (TypeCore ty))     = binderType ty
-binders (TyCo (CoercionCore co)) = binderCoercion co
+-- TODO: check this is correct, written in a hurry
+binders :: LCoreTC -> VarSet
+binders (LTCCore (LQuantified (Quantified bs _)))  = mkVarSet bs
+binders (LTCCore (LClause _))                      = emptyVarSet
+binders (LTCCore (LCore core))                     = bindersCore core
+binders (LTCTyCo (TypeCore ty))                    = binderType ty
+binders (LTCTyCo (CoercionCore co))                = binderCoercion co
 
 bindersCore :: Core -> VarSet
 bindersCore (BindCore bnd)  = binderBind bnd
@@ -152,14 +164,14 @@
 
 -----------------------------------------------------------------------
 
-occurrenceOf :: (Var -> Bool) -> CoreTC -> Bool
-occurrenceOf p = maybe False p . varOccurrence
+occurrenceOf :: (Var -> Bool) -> LCoreTC -> Bool
+occurrenceOf p = maybe False p . (projectM >=> varOccurrence)
 
-varOccurrence :: CoreTC -> Maybe Var
-varOccurrence (Core (ExprCore e))      = varOccurrenceExpr e
-varOccurrence (TyCo (TypeCore ty))     = varOccurrenceType ty
-varOccurrence (TyCo (CoercionCore co)) = varOccurrenceCoercion co
-varOccurrence _                        = Nothing
+varOccurrence :: LCoreTC -> Maybe Var
+varOccurrence (LTCCore (LCore (ExprCore e))) = varOccurrenceExpr e
+varOccurrence (LTCTyCo (TypeCore ty))        = varOccurrenceType ty
+varOccurrence (LTCTyCo (CoercionCore co))    = varOccurrenceCoercion co
+varOccurrence _                              = Nothing
 
 varOccurrenceExpr :: CoreExpr -> Maybe Var
 varOccurrenceExpr (Var v)       = Just v
@@ -176,19 +188,19 @@
 -----------------------------------------------------------------------
 
 -- | Find all possible targets of 'occurrenceOfT'.
-occurrenceOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m CoreTC VarSet
+occurrenceOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m LCoreTC VarSet
 occurrenceOfTargetsT = allT $ crushbuT (arr varOccurrence >>> projectT >>^ unitVarSet)
 
 -- | Find all possible targets of 'bindingOfT'.
-bindingOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m CoreTC VarSet
+bindingOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m LCoreTC VarSet
 bindingOfTargetsT = allT $ crushbuT (arr binders)
 
 -- | Find all possible targets of 'bindingGroupOfT'.
-bindingGroupOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m CoreTC VarSet
+bindingGroupOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m LCoreTC VarSet
 bindingGroupOfTargetsT = allT $ crushbuT (promoteBindT $ arr (mkVarSet . bindVars))
 
 -- | Find all possible targets of 'rhsOfT'.
-rhsOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m CoreTC VarSet
+rhsOfTargetsT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c, MonadCatch m) => Transform c m LCoreTC VarSet
 rhsOfTargetsT = crushbuT (promoteBindT (arr binderBind) <+ promoteDefT (arr binderDef))
 
 -----------------------------------------------------------------------
@@ -223,12 +235,18 @@
                   ]
 
 -- | Find the path to the first matching construct.
-considerConstructT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Considerable -> Transform c m Core LocalPathH
-considerConstructT con = oneNonEmptyPathToT (arr $ underConsideration con)
+considerConstructT :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Considerable -> Transform c m LCore LocalPathH
+considerConstructT con = oneNonEmptyPathToT (arr $ underConsiderationLCore con)
 
 string2considerable :: String -> Maybe Considerable
 string2considerable = flip lookup considerables
 
+-- TODO: cleanup this code
+
+underConsiderationLCore :: Considerable -> LCore -> Bool
+underConsiderationLCore con (LCore c) = underConsideration con c
+underConsiderationLCore _   _         = False
+
 underConsideration :: Considerable -> Core -> Bool
 underConsideration Binding      (BindCore _)               = True
 underConsideration Definition   (BindCore (NonRec _ _))    = True
@@ -262,24 +280,22 @@
   setEmptyContext ec = ec { baseContext = setEmptyContext (baseContext ec)
                           , extraContext = mempty }
 
-exhaustRepeatCrumbT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, HasEmptyContext c, Walker c CoreTC, MonadCatch m) => Crumb -> Transform c m CoreTC LocalPathH
+exhaustRepeatCrumbT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, HasEmptyContext c, Walker c LCoreTC, MonadCatch m) => Crumb -> Transform c m LCoreTC 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, HasEmptyContext c, Walker c CoreTC, MonadCatch m) => Transform c m CoreExpr LocalPathH
+lamsBodyT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, HasEmptyContext c, Walker c LCoreTC, MonadCatch m) => Transform 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, HasEmptyContext c, Walker c CoreTC, MonadCatch m) => Transform c m CoreExpr LocalPathH
+letsBodyT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, HasEmptyContext c, Walker c LCoreTC, MonadCatch m) => Transform 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, HasEmptyContext c, Walker c CoreTC, MonadCatch m) => Transform c m CoreProg LocalPathH
+progEndT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, HasEmptyContext c, Walker c LCoreTC, MonadCatch m) => Transform 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, HasEmptyContext c, Walker c CoreTC, MonadCatch m) => Transform c m ModGuts LocalPathH
+-- | Construct a path to the end of a program, starting at the 'ModGuts'.
+gutsProgEndT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, HasEmptyContext c, Walker c LCoreTC, MonadCatch m) => Transform c m ModGuts LocalPathH
 gutsProgEndT = modGutsT progEndT (\ _ p -> (mempty @@ ModGuts_Prog) <> p)
-
----------------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Navigation/Crumbs.hs b/src/HERMIT/Dictionary/Navigation/Crumbs.hs
--- a/src/HERMIT/Dictionary/Navigation/Crumbs.hs
+++ b/src/HERMIT/Dictionary/Navigation/Crumbs.hs
@@ -1,8 +1,7 @@
 module HERMIT.Dictionary.Navigation.Crumbs
-       ( -- * Navigating Using Crumbs
-         crumbExternals
-       )
-where
+    ( -- * Navigating Using Crumbs
+      crumbExternals
+    ) where
 
 import HERMIT.Core
 import HERMIT.External
@@ -12,89 +11,106 @@
 -- | 'External's for individual 'Crumb's.
 crumbExternals :: [External]
 crumbExternals = map (.+ Navigation)
-            [
-              external "prog" ModGuts_Prog
-                [ "Descend into the program within a module." ]
-            , external "prog-head" ProgCons_Head
-                [ "Descend into the first binding group in a program." ]
-            , external "prog-tail" ProgCons_Tail
-                [ "Descend into the tail of the program." ]
-            , external "nonrec-rhs" NonRec_RHS
-                [ "Descend into the right-hand side of a non-recursive binding." ]
-            , external "rec-def" Rec_Def
-                [ "Descend into the (n-1)th definition in a recursive binding group." ]
-            , external "def-rhs" Def_RHS
-                [ "Descend into the right-hand side of a recursive definition." ]
-            , external "app-fun" App_Fun
-                [ "Descend into the function in an application." ]
-            , external "app-arg" App_Arg
-                [ "Descend into the argument in an application." ]
-            , external "lam-body" Lam_Body
-                [ "Descend into the body of a lambda." ]
-            , external "let-bind" Let_Bind
-                [ "Descend into the binding group of a let expression." ]
-            , external "let-body" Let_Body
-                [ "Descend into the body of a let expression." ]
-            , external "case-expr" Case_Scrutinee
-                [ "Descend into the scrutinised expression in a case expression." ]
-            , external "case-type" Case_Type
-                [ "Descend into the type of a case expression." ]
-            , external "case-alt" Case_Alt
-                [ "Descend into the (n-1)th alternative in a case expression." ]
-            , external "cast-expr" Cast_Expr
-                [ "Descend into the expression in a cast." ]
-            , external "cast-co" Cast_Co
-                [ "Descend into the coercion in a cast." ]
-            , external "tick-expr" Tick_Expr
-                [ "Descend into the expression in a tick." ]
-            , external "alt-rhs" Alt_RHS
-                [ "Descend into the right-hand side of a case alternative." ]
-            , external "type" Type_Type
-                [ "Descend into the type within a type expression." ]
-            , external "coercion" Co_Co
-                [ "Descend into the coercion within a coercion expression." ]
-            , external "appTy-fun" AppTy_Fun
-                [ "Descend into the type function in a type application." ]
-            , external "appTy-arg" AppTy_Fun
-                [ "Descend into the type argument in a type application." ]
-            , external "tyCon-arg" TyConApp_Arg
-                [ "Descend into the (n-1)th argument of a type constructor application." ]
-            , external "fun-dom" FunTy_Dom
-                [ "Descend into the domain of a function type." ]
-            , external "fun-cod" FunTy_CoDom
-                [ "Descend into the codomain of a function type." ]
-            , external "forall-body" ForAllTy_Body
-                [ "Descend into the body of a forall type." ]
-            , external "refl-type" Refl_Type
-                [ "Descend into the (n-1)th argument of a type constructor coercion." ]
-            , external "coCon-arg" TyConAppCo_Arg
-                [ "Descend into the function of a coercion application." ]
-            , external "appCo-fun" AppCo_Fun
-                [ "Descend into the coercion function in a coercion application." ]
-            , external "appCo-arg" AppCo_Arg
-                [ "Descend into the coercion argument in a coercion application." ]
-            , external "coForall-body" ForAllCo_Body
-                [ "Descend into the body of a forall coercion." ]
-            , external "axiom-inst" AxiomInstCo_Arg
-                [ "Descend into the (n-1)th argument of a coercion axiom instantiation." ]
-            , external "unsafe-left" UnsafeCo_Left
-                [ "Descend into the left-hand type of an unsafe coercion." ]
-            , external "unsafe-right" UnsafeCo_Right
-                [ "Descend into the right-hand type of an unsafe coercion." ]
-            , external "sym-co" SymCo_Co
-                [ "Descend into the coercion within a symmetric coercion." ]
-            , external "trans-left" TransCo_Left
-                [ "Descend into the left-hand type of a transitive coercion." ]
-            , external "trans-right" TransCo_Right
-                [ "Descend into the right-hand type of a transitive coercion." ]
-            , external "nth-co" NthCo_Co
-                [ "Descend into the coercion within an nth projection coercion." ]
-            , external "inst-co" InstCo_Co
-                [ "Descend into the coercion within a coercion instantiation." ]
-            , external "inst-type" InstCo_Type
-                [ "Descend into the type within a coercion instantiation." ]
-            , external "lr-co" LRCo_Co
-                [ "Descend into the coercion within a left/right projection coercion." ]
-            ]
+    [ external "prog" ModGuts_Prog
+        [ "Descend into the program within a module." ]
+    , external "prog-head" ProgCons_Head
+        [ "Descend into the first binding group in a program." ]
+    , external "prog-tail" ProgCons_Tail
+        [ "Descend into the tail of the program." ]
+    , external "nonrec-rhs" NonRec_RHS
+        [ "Descend into the right-hand side of a non-recursive binding." ]
+    , external "rec-def" Rec_Def
+        [ "Descend into the (n-1)th definition in a recursive binding group." ]
+    , external "def-rhs" Def_RHS
+        [ "Descend into the right-hand side of a recursive definition." ]
+    , external "app-fun" App_Fun
+        [ "Descend into the function in an application." ]
+    , external "app-arg" App_Arg
+        [ "Descend into the argument in an application." ]
+    , external "lam-body" Lam_Body
+        [ "Descend into the body of a lambda." ]
+    , external "let-bind" Let_Bind
+        [ "Descend into the binding group of a let expression." ]
+    , external "let-body" Let_Body
+        [ "Descend into the body of a let expression." ]
+    , external "case-expr" Case_Scrutinee
+        [ "Descend into the scrutinised expression in a case expression." ]
+    , external "case-type" Case_Type
+        [ "Descend into the type of a case expression." ]
+    , external "case-alt" Case_Alt
+        [ "Descend into the (n-1)th alternative in a case expression." ]
+    , external "cast-expr" Cast_Expr
+        [ "Descend into the expression in a cast." ]
+    , external "cast-co" Cast_Co
+        [ "Descend into the coercion in a cast." ]
+    , external "tick-expr" Tick_Expr
+        [ "Descend into the expression in a tick." ]
+    , external "alt-rhs" Alt_RHS
+        [ "Descend into the right-hand side of a case alternative." ]
+    , external "type" Type_Type
+        [ "Descend into the type within a type expression." ]
+    , external "coercion" Co_Co
+        [ "Descend into the coercion within a coercion expression." ]
+    , external "appTy-fun" AppTy_Fun
+        [ "Descend into the type function in a type application." ]
+    , external "appTy-arg" AppTy_Fun
+        [ "Descend into the type argument in a type application." ]
+    , external "tyCon-arg" TyConApp_Arg
+        [ "Descend into the (n-1)th argument of a type constructor application." ]
+    , external "fun-dom" FunTy_Dom
+        [ "Descend into the domain of a function type." ]
+    , external "fun-cod" FunTy_CoDom
+        [ "Descend into the codomain of a function type." ]
+    , external "forall-body" ForAllTy_Body
+        [ "Descend into the body of a forall type." ]
+    , external "refl-type" Refl_Type
+        [ "Descend into the (n-1)th argument of a type constructor coercion." ]
+    , external "coCon-arg" TyConAppCo_Arg
+        [ "Descend into the function of a coercion application." ]
+    , external "appCo-fun" AppCo_Fun
+        [ "Descend into the coercion function in a coercion application." ]
+    , external "appCo-arg" AppCo_Arg
+        [ "Descend into the coercion argument in a coercion application." ]
+    , external "coForall-body" ForAllCo_Body
+        [ "Descend into the body of a forall coercion." ]
+    , external "axiom-inst" AxiomInstCo_Arg
+        [ "Descend into the (n-1)th argument of a coercion axiom instantiation." ]
+    , external "unsafe-left" UnsafeCo_Left
+        [ "Descend into the left-hand type of an unsafe coercion." ]
+    , external "unsafe-right" UnsafeCo_Right
+        [ "Descend into the right-hand type of an unsafe coercion." ]
+    , external "sym-co" SymCo_Co
+        [ "Descend into the coercion within a symmetric coercion." ]
+    , external "trans-left" TransCo_Left
+        [ "Descend into the left-hand type of a transitive coercion." ]
+    , external "trans-right" TransCo_Right
+        [ "Descend into the right-hand type of a transitive coercion." ]
+    , external "nth-co" NthCo_Co
+        [ "Descend into the coercion within an nth projection coercion." ]
+    , external "inst-co" InstCo_Co
+        [ "Descend into the coercion within a coercion instantiation." ]
+    , external "inst-type" InstCo_Type
+        [ "Descend into the type within a coercion instantiation." ]
+    , external "lr-co" LRCo_Co
+        [ "Descend into the coercion within a left/right projection coercion." ]
+    , external "forall-body" Forall_Body
+        [ "Descend into the clause of a quantified clause." ]
+    , external "conj-lhs" Conj_Lhs
+        [ "Descend into left-hand side of a conjunction." ]
+    , external "conj-rhs" Conj_Rhs
+        [ "Descend into right-hand side of a conjunction." ]
+    , external "disj-lhs" Disj_Lhs
+        [ "Descend into left-hand side of a disjunction." ]
+    , external "disj-rhs" Disj_Rhs
+        [ "Descend into right-hand side of a disjunction." ]
+    , external "antecedent" Impl_Lhs
+        [ "Descend into antecedent of an implication." ]
+    , external "consequent" Impl_Rhs
+        [ "Descend into consequent of an implication." ]
+    , external "eq-lhs" Eq_Lhs
+        [ "Descend into left-hand side of an equivalence." ]
+    , external "eq-rhs" Eq_Rhs
+        [ "Descend into right-hand side of an equivalence." ]
+    ]
 
 ---------------------------------------------------------------------------------------
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
@@ -14,11 +14,11 @@
 
 externals ::  [External]
 externals = map ((.+ Experiment) . (.+ TODO))
-         [ external "var" (promoteExprT . isVar :: String -> TransformH Core ())
+         [ external "var" (promoteExprT . isVar :: String -> TransformH LCore ())
                 [ "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)
+         , external "nonrec-intro" ((\ s str -> promoteCoreR (nonRecIntro s str)) :: String -> CoreString -> RewriteH LCore)
                 [ "Introduce a new non-recursive binding.  Only works at Expression or Program nodes."
                 , "nonrec-into 'v [| e |]"
                 , "body ==> let v = e in body"
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
@@ -31,16 +31,17 @@
 -- | Externals that reflect GHC functions, or are derived from GHC functions.
 externals :: [External]
 externals =
-    [ external "info" (infoT :: TransformH CoreTC String)
+    [ external "info" (promoteCoreTCT infoT :: TransformH LCoreTC String)
         [ "Display information about the current node." ] .+ Query
-    , external "compare-bound-ids" (compareBoundIds :: HermitName -> HermitName -> TransformH CoreTC ())
+    , external "compare-bound-ids" (compareBoundIds :: HermitName -> HermitName -> TransformH LCoreTC ())
         [ "Compare the definitions of two in-scope identifiers for alpha equality."] .+ Query .+ Predicate
-    , external "compare-core-at" (compareCoreAtT ::  TransformH Core LocalPathH -> TransformH Core LocalPathH -> TransformH Core ())
+    , external "compare-core-at" (compareCoreAtT ::  TransformH LCoreTC LocalPathH -> TransformH LCoreTC LocalPathH -> TransformH LCoreTC ())
         [ "Compare the core fragments at the end of the given paths for alpha-equality."] .+ Query .+ Predicate
     ]
 
 --------------------------------------------------------
 
+-- TODO: update this to cope with lemmas
 infoT :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c, BoundVars c, HasEmptyContext c, HasDynFlags m, MonadCatch m) => Transform c m CoreTC String
 infoT =
   do crumbs <- childrenT
@@ -162,12 +163,13 @@
 --------------------------------------------------------
 
 -- | Compare the core fragments at the end of the specified 'LocalPathH's.
-compareCoreAtT :: (ExtendPath c Crumb, AddBindings c, ReadBindings c, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Transform c m Core LocalPathH -> Transform c m Core LocalPathH -> Transform c m Core ()
+compareCoreAtT :: (ExtendPath c Crumb, AddBindings c, ReadBindings c, ReadPath c Crumb, HasEmptyContext c, MonadCatch m) => Transform c m LCoreTC LocalPathH -> Transform c m LCoreTC LocalPathH -> Transform c m LCoreTC ()
 compareCoreAtT p1T p2T =
   do p1 <- p1T
      p2 <- p2T
-     core1 <- localPathT p1 idR
-     core2 <- localPathT p2 idR
+     -- TODO: temproary hack.  Need to properly check whether the paths point to COre or not, and report a decent error message
+     LTCCore (LCore core1) <- localPathT p1 idR
+     LTCCore (LCore core2) <- localPathT p2 idR
      guardMsg (core1 `coreAlphaEq` core2) "core fragments are not alpha-equivalent."
 
 -- | Compare the definitions of two identifiers for alpha-equality.
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,74 +1,89 @@
-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, InstanceSigs,
-             ScopedTypeVariables, TupleSections, TypeFamilies #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module HERMIT.Dictionary.Reasoning
     ( -- * Equational Reasoning
       externals
     , EqualityProof
-    , flipEquality
     , eqLhsIntroR
     , eqRhsIntroR
     , birewrite
     , extensionalityR
     , getLemmasT
     , getLemmaByNameT
-    , insertLemmaR
-    , lemmaR
-    , markLemmaUsedR
-    , modifyLemmaR
-    -- ** Lifting transformations over 'Equality'
+    , getObligationNotProvenT
+    , insertLemmaT
+    , insertLemmasT
+    , lemmaBiR
+    , lemmaConsequentR
+    , markLemmaUsedT
+    , markLemmaProvedT
+    , markLemmaAssumedT
+    , modifyLemmaT
+    , showLemmaT
+    , showLemmasT
+    , ppLemmaT
+    , ppQuantifiedT
+    , ppLCoreTCT
+      -- ** Lifting transformations over 'Quantified'
     , lhsT
     , rhsT
     , bothT
-    , forallVarsT
     , lhsR
     , rhsR
     , bothR
-    , ppEqualityT
-    , proveEqualityT
-    , verifyEqualityT
+    , forallVarsT
+    , verifyQuantifiedT
+    , verifyEquivalentT
+    , verifyOrCreateT
+    , lintQuantifiedT
     , verifyEqualityLeftToRightT
     , verifyEqualityCommonTargetT
     , verifyIsomorphismT
     , verifyRetractionT
     , retractionBR
-    , alphaEqualityR
-    , unshadowEqualityR
+    , unshadowQuantifiedR
     , instantiateDictsR
-    , instantiateEquality
-    , instantiateEqualityVar
-    , instantiateEqualityVarR
+    , instantiateQuantifiedVarR
+    , abstractQuantifiedR
     , discardUniVars
     ) where
 
-import           Control.Applicative
-import           Control.Arrow
+import           Control.Arrow hiding ((<+>))
 import           Control.Monad
-import           Control.Monad.IO.Class
 
+import           Data.Either (partitionEithers)
+import           Data.List (isInfixOf, nubBy)
 import qualified Data.Map as Map
-import           Data.List (nubBy)
 import           Data.Maybe (fromMaybe)
 import           Data.Monoid
 
 import           HERMIT.Context
 import           HERMIT.Core
 import           HERMIT.External
-import           HERMIT.GHC
+import           HERMIT.GHC hiding ((<>), (<+>), nest, ($+$))
 import           HERMIT.Kure
+import           HERMIT.Lemma
 import           HERMIT.Monad
 import           HERMIT.Name
 import           HERMIT.ParserCore
 import           HERMIT.ParserType
 import           HERMIT.PrettyPrinter.Common
+import           HERMIT.PrettyPrinter.Clean (symbol) -- this should be in Common
 import           HERMIT.Utilities
-                
-import           HERMIT.Dictionary.AlphaConversion hiding (externals)
+
 import           HERMIT.Dictionary.Common
 import           HERMIT.Dictionary.Fold hiding (externals)
 import           HERMIT.Dictionary.GHC hiding (externals)
 import           HERMIT.Dictionary.Local.Let (nonRecIntroR)
-import           HERMIT.Dictionary.Unfold hiding (externals)
 
 import qualified Text.PrettyPrint.MarkedHughesPJ as PP
 
@@ -76,71 +91,103 @@
 
 externals :: [External]
 externals =
-    [ external "retraction" ((\ f g r -> promoteExprBiR $ retraction (Just r) f g) :: CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+    [ external "retraction" ((\ f g r -> promoteExprBiR $ retraction (Just r) f g) :: CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
         [ "Given f :: X -> Y and g :: Y -> X, and a proof that f (g y) ==> y, then"
         , "f (g y) <==> y."
         ] .+ Shallow
-    , external "retraction-unsafe" ((\ f g -> promoteExprBiR $ retraction Nothing f g) :: CoreString -> CoreString -> BiRewriteH Core)
+    , external "retraction-unsafe" ((\ f g -> promoteExprBiR $ retraction Nothing f g) :: CoreString -> CoreString -> BiRewriteH LCore)
         [ "Given f :: X -> Y and g :: Y -> X, then"
         , "f (g y) <==> y."
         , "Note that the precondition (f (g y) == y) is expected to hold."
         ] .+ Shallow .+ PreCondition
-    , external "alpha-equality" ((\ nm newName -> alphaEqualityR (cmpString2Var nm) (const newName)))
-        [ "Alpha-rename a universally quantified variable." ]
-    , external "unshadow-equality" unshadowEqualityR
-        [ "Unshadow an equality." ]
-    , external "lemma" (promoteExprBiR . lemmaR :: LemmaName -> BiRewriteH Core)
+    , external "unshadow-quantified" (promoteQuantifiedR unshadowQuantifiedR :: RewriteH LCoreTC)
+        [ "Unshadow a quantified clause." ]
+    , external "merge-quantifiers" (\n1 n2 -> promoteR (mergeQuantifiersR (cmpHN2Var n1) (cmpHN2Var n2)) :: RewriteH LCore)
+        [ "Merge quantifiers from two clauses if they have the same type."
+        , "Example:"
+        , "(forall (x::Int). foo x = x) ^ (forall (y::Int). bar y y = 5)"
+        , "merge-quantifiers 'x 'y"
+        , "forall (x::Int). (foo x = x) ^ (bar x x = 5)"
+        , "Note: if only one quantifier matches, it will be floated if possible." ]
+    , external "float-left" (\n1 -> promoteR (mergeQuantifiersR (cmpHN2Var n1) (const False)) :: RewriteH LCore)
+        [ "Float quantifier out of left-hand side." ]
+    , external "float-right" (\n1 -> promoteR (mergeQuantifiersR (const False) (cmpHN2Var n1)) :: RewriteH LCore)
+        [ "Float quantifier out of right-hand side." ]
+    , external "conjunct" (\n1 n2 n3 -> conjunctLemmasT n1 n2 n3 :: TransformH LCore ())
+        [ "conjunt new-name lhs-name rhs-name" ]
+    , external "disjunct" (\n1 n2 n3 -> disjunctLemmasT n1 n2 n3 :: TransformH LCore ())
+        [ "disjunt new-name lhs-name rhs-name" ]
+    , external "imply" (\n1 n2 n3 -> implyLemmasT n1 n2 n3 :: TransformH LCore ())
+        [ "imply new-name antecedent-name consequent-name" ]
+    , external "lint" (promoteT lintQuantifiedT :: TransformH LCoreTC String)
+        [ "Lint check a quantified clause." ]
+    , external "lemma-birewrite" (promoteExprBiR . lemmaBiR Obligation :: LemmaName -> BiRewriteH LCore)
         [ "Generate a bi-directional rewrite from a lemma." ]
-    , external "lemma-lhs-intro" (lemmaLhsIntroR :: LemmaName -> RewriteH Core)
+    , external "lemma-forward" (forwardT . promoteExprBiR . lemmaBiR Obligation :: LemmaName -> RewriteH LCore)
+        [ "Generate a rewrite from a lemma, left-to-right." ]
+    , external "lemma-backward" (backwardT . promoteExprBiR . lemmaBiR Obligation :: LemmaName -> RewriteH LCore)
+        [ "Generate a rewrite from a lemma, right-to-left." ]
+    , external "lemma-consequent" (promoteQuantifiedR . lemmaConsequentR Obligation :: LemmaName -> RewriteH LCore)
+        [ "Match the current lemma with the consequent of an implication lemma."
+        , "Upon success, replaces with antecedent of the implication, properly instantiated." ]
+    , external "lemma-consequent-birewrite" (promoteExprBiR . lemmaConsequentBiR Obligation :: LemmaName -> BiRewriteH LCore)
+        [ "Generate a bi-directional rewrite from the consequent of an implication lemma."
+        , "The antecedent is instantiated and introduced as an unproven obligation." ]
+    , external "lemma-lhs-intro" (promoteCoreR . lemmaLhsIntroR :: LemmaName -> RewriteH LCore)
         [ "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 :: LemmaName -> RewriteH Core)
+    , external "lemma-rhs-intro" (promoteCoreR . lemmaRhsIntroR :: LemmaName -> RewriteH LCore)
         [ "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
-    , external "inst-lemma" (\ nm v cs -> modifyLemmaR nm id (instantiateEqualityVarR (cmpString2Var v) cs) id id :: RewriteH Core)
+    , external "inst-lemma" (\ nm v cs -> modifyLemmaT nm id (instantiateQuantifiedVarR (cmpHN2Var v) cs) id id :: TransformH LCore ())
         [ "Instantiate one of the universally quantified variables of the given lemma,"
         , "with the given Core expression, creating a new lemma. Instantiating an"
         , "already proven lemma will result in the new lemma being considered proven." ]
-    , external "inst-lemma-dictionaries" (\ nm -> modifyLemmaR nm id instantiateDictsR id id :: RewriteH Core)
-        [ "Instantiate all of the universally quantified dictionaries of the given lemma."
-        , "Only works on dictionaries whose types are monomorphic (no free type variables)." ]
-    , external "copy-lemma" (\ nm newName -> modifyLemmaR nm (const newName) idR id id :: RewriteH Core)
+    , external "inst-dictionaries" (promoteQuantifiedR instantiateDictsR :: RewriteH LCore)
+        [ "Instantiate all of the universally quantified dictionaries of the given lemma." ]
+    , external "abstract" ((\nm -> promoteQuantifiedR . abstractQuantifiedR nm . csInQBodyT) :: String -> CoreString -> RewriteH LCore)
+        [ "Weaken a lemma by abstracting an expression to a new quantifier." ]
+    , external "abstract" ((\nm rr -> promoteQuantifiedR $ abstractQuantifiedR nm $ extractT rr >>> setFailMsg "path must focus on an expression" projectT) :: String -> RewriteH LCore -> RewriteH LCore)
+        [ "Weaken a lemma by abstracting an expression to a new quantifier." ]
+    , external "copy-lemma" (\ nm newName -> modifyLemmaT nm (const newName) idR id id :: TransformH LCore ())
         [ "Copy a given lemma, with a new name." ]
-    , external "modify-lemma" (\ nm rr -> modifyLemmaR nm id rr (const False) (const False) :: RewriteH Core)
-        [ "Modify a given lemma. Resets the proven status to Not Proven and used status to Not Used." ]
-    , external "query-lemma" ((\ nm t -> getLemmaByNameT nm >>> arr lemmaEq >>> t) :: LemmaName -> TransformH Equality String -> TransformH Core String)
+    , external "modify-lemma" ((\ nm rr -> modifyLemmaT nm id (extractR rr) (const NotProven) (const NotUsed)) :: LemmaName -> RewriteH LCore -> TransformH LCore ())
+        [ "Modify a given lemma. Resets proven status to Not Proven and used status to Not Used." ]
+    , external "query-lemma" ((\ nm t -> getLemmaByNameT nm >>> arr lemmaQ >>> extractT t) :: LemmaName -> TransformH LCore String -> TransformH LCore String)
         [ "Apply a transformation to a lemma, returning the result." ]
-    , external "extensionality" (extensionalityR . Just :: String -> RewriteH Equality)
+    , external "show-lemma" ((\pp n -> showLemmaT n pp) :: PrettyPrinter -> LemmaName -> PrettyH LCore)
+        [ "Display a lemma." ]
+    , external "show-lemmas" ((\pp n -> showLemmasT (Just n) pp) :: PrettyPrinter -> LemmaName -> PrettyH LCore)
+        [ "List lemmas whose names match search string." ]
+    , external "show-lemmas" (showLemmasT Nothing :: PrettyPrinter -> PrettyH LCore)
+        [ "List lemmas." ]
+    , external "extensionality" (promoteR . extensionalityR . Just :: String -> RewriteH LCore)
         [ "Given a name 'x, then"
         , "f == g  ==>  forall x.  f x == g x" ]
-    , external "extensionality" (extensionalityR Nothing :: RewriteH Equality)
+    , external "extensionality" (promoteR (extensionalityR Nothing) :: RewriteH LCore)
         [ "f == g  ==>  forall x.  f x == g x" ]
-    , external "lhs" (lhsR . extractR :: RewriteH Core -> RewriteH Equality)
-        [ "Apply a rewrite to the LHS of an equality." ]
-    , external "lhs" (lhsT . extractT :: TransformH CoreTC String -> TransformH Equality String)
-        [ "Apply a transformation to the LHS of an equality." ]
-    , external "rhs" (rhsR . extractR :: RewriteH Core -> RewriteH Equality)
-        [ "Apply a rewrite to the RHS of an equality." ]
-    , external "rhs" (rhsT . extractT :: TransformH CoreTC String -> TransformH Equality String)
-        [ "Apply a transformation to the RHS of an equality." ]
-    , external "both" (bothR . extractR :: RewriteH Core -> RewriteH Equality)
+    , external "lhs" (promoteQuantifiedR . lhsR :: RewriteH LCore -> RewriteH LCore)
+        [ "Apply a rewrite to the LHS of a quantified clause." ]
+    , external "lhs" (promoteQuantifiedT . lhsT :: TransformH LCore String -> TransformH LCore String)
+        [ "Apply a transformation to the LHS of a quantified clause." ]
+    , external "rhs" (promoteQuantifiedR . rhsR :: RewriteH LCore -> RewriteH LCore)
+        [ "Apply a rewrite to the RHS of a quantified clause." ]
+    , external "rhs" (promoteQuantifiedT . rhsT :: TransformH LCore String -> TransformH LCore String)
+        [ "Apply a transformation to the RHS of a quantified clause." ]
+    , external "both" (promoteQuantifiedR . bothR :: RewriteH LCore -> RewriteH LCore)
         [ "Apply a rewrite to both sides of an equality, succeeding if either succeed." ]
-    , external "both" ((\t -> liftM (\(r,s) -> unlines [r,s]) (bothT (extractT t))) :: TransformH CoreTC String -> TransformH Equality String)
-        [ "Apply a transformation to the RHS of an equality." ]
+    , external "both" ((\t -> do (r,s) <- promoteQuantifiedT (bothT t); return (unlines [r,s])) :: TransformH LCore String -> TransformH LCore String)
+        [ "Apply a transformation to both sides of a quantified clause." ]
     ]
 
 ------------------------------------------------------------------------------
 
 type EqualityProof c m = (Rewrite c m CoreExpr, Rewrite c m CoreExpr)
 
--- | Flip the LHS and RHS of a 'Equality'.
-flipEquality :: Equality -> Equality
-flipEquality (Equality xs lhs rhs) = Equality xs rhs lhs
-
 -- | f == g  ==>  forall x.  f x == g x
-extensionalityR :: Maybe String -> Rewrite c HermitM Equality
+extensionalityR :: Maybe String -> Rewrite c HermitM Quantified
 extensionalityR mn = prefixFailMsg "extensionality failed: " $
-  do Equality vs lhs rhs <- idR
+  do Quantified vs (Equiv lhs rhs) <- idR
 
      let tyL = exprKindOrType lhs
          tyR = exprKindOrType rhs
@@ -152,123 +199,179 @@
 
      let x = varToCoreExpr v
 
-     return $ Equality (vs ++ [v]) (mkCoreApp lhs x) (mkCoreApp rhs x)
+     return $ Quantified (vs ++ [v]) $ Equiv (mkCoreApp lhs x) (mkCoreApp rhs x)
 
 ------------------------------------------------------------------------------
 
 -- | @e@ ==> @let v = lhs in e@
-eqLhsIntroR :: Equality -> Rewrite c HermitM Core
-eqLhsIntroR (Equality bs lhs _) = nonRecIntroR "lhs" (mkCoreLams bs lhs)
+eqLhsIntroR :: Quantified -> Rewrite c HermitM Core
+eqLhsIntroR (Quantified bs (Equiv lhs _)) = nonRecIntroR "lhs" (mkCoreLams bs lhs)
+eqLhsIntroR _                             = fail "compound lemmas not supported."
 
 -- | @e@ ==> @let v = rhs in e@
-eqRhsIntroR :: Equality -> Rewrite c HermitM Core
-eqRhsIntroR (Equality bs _ rhs) = nonRecIntroR "rhs" (mkCoreLams bs rhs)
+eqRhsIntroR :: Quantified -> Rewrite c HermitM Core
+eqRhsIntroR (Quantified bs (Equiv _ rhs)) = nonRecIntroR "rhs" (mkCoreLams bs rhs)
+eqRhsIntroR _                             = fail "compound lemmas not supported."
 
 ------------------------------------------------------------------------------
 
--- | Create a 'BiRewrite' from a 'Equality'.
---
--- The high level idea: create a temporary function with two definitions.
--- Fold one of the defintions, then immediately unfold the other.
+-- | Create a 'BiRewrite' from a 'Quantified'.
 birewrite :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c
              , ReadPath c Crumb, MonadCatch m, MonadUnique m )
-          => Equality -> BiRewrite c m CoreExpr
-birewrite (Equality bnds l r) = bidirectional (foldUnfold l r) (foldUnfold r l)
-    where foldUnfold lhs rhs = transform $ \ 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
-            applyT unfoldR c' e'
+          => Quantified -> BiRewrite c m CoreExpr
+birewrite q = bidirectional (foldUnfold "left" id) (foldUnfold "right" flipEquality)
+    where foldUnfold side f = transform $ \ c ->
+                                maybeM ("expression did not match "++side++"-hand side")
+                                . fold (map f (toEqualities q)) c
 
--- | Lift a transformation over 'CoreExpr' into a transformation over the left-hand side of a 'Equality'.
-lhsT :: (AddBindings c, Monad m, ReadPath c Crumb) => Transform c m CoreExpr b -> Transform c m Equality b
-lhsT t = idR >>= \ (Equality vs lhs _) -> return lhs >>> withVarsInScope vs t
+------------------------------------------------------------------------------
+-- TODO: deprecate these?
+-- Yes, but later.  They're in the paper now.
+-- We should be using "childR crumb", really.
 
--- | Lift a transformation over 'CoreExpr' into a transformation over the right-hand side of a 'Equality'.
-rhsT :: (AddBindings c, Monad m, ReadPath c Crumb) => Transform c m CoreExpr b -> Transform c m Equality b
-rhsT t = idR >>= \ (Equality vs _ rhs) -> return rhs >>> withVarsInScope vs t
+-- | Lift a transformation over 'LCoreTC' into a transformation over the left-hand side of a 'Quantified'.
+lhsT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Monad m)
+     => Transform c m LCore a -> Transform c m Quantified a
+lhsT t = quantifiedT successT (clauseT t successT (\_ l _ -> l)) (flip const)
 
--- | Lift a transformation over 'CoreExpr' into a transformation over both sides of a 'Equality'.
-bothT :: (AddBindings c, Monad m, ReadPath c Crumb) => Transform c m CoreExpr b -> Transform c m Equality (b,b)
-bothT t = liftM2 (,) (lhsT t) (rhsT t) -- Can't wait for Applicative to be a superclass of Monad
+-- | Lift a transformation over 'LCoreTC' into a transformation over the right-hand side of a 'Quantified'.
+rhsT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Monad m)
+     => Transform c m LCore a -> Transform c m Quantified a
+rhsT t = quantifiedT successT (clauseT successT t (\_ _ r -> r)) (flip const)
 
--- | Lift a transformation over '[Var]' into a transformation over the universally quantified variables of a 'Equality'.
-forallVarsT :: Monad m => Transform c m [Var] b -> Transform c m Equality b
-forallVarsT t = idR >>= \ (Equality vs _ _) -> return vs >>> t
+-- | Lift a transformation over 'LCoreTC' into a transformation over both sides of a 'Quantified'.
+bothT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Monad m)
+      => Transform c m LCore a -> Transform c m Quantified (a, a)
+bothT t = quantifiedT successT (clauseT t t (const (,))) (flip const)
 
--- | Lift a rewrite over 'CoreExpr' into a rewrite over the left-hand side of a 'Equality'.
-lhsR :: (AddBindings c, Monad m, ReadPath c Crumb) => Rewrite c m CoreExpr -> Rewrite c m Equality
-lhsR r = do
-    Equality vs lhs rhs <- idR
-    lhs' <- withVarsInScope vs r <<< return lhs
-    return $ Equality vs lhs' rhs
+-- | Lift a rewrite over 'LCoreTC' into a rewrite over the left-hand side of a 'Quantified'.
+lhsR :: (AddBindings c, Monad m, ReadPath c Crumb, ExtendPath c Crumb)
+     => Rewrite c m LCore -> Rewrite c m Quantified
+lhsR r = quantifiedR idR (clauseR r idR)
 
--- | Lift a rewrite over 'CoreExpr' into a rewrite over the right-hand side of a 'Equality'.
-rhsR :: (AddBindings c, Monad m, ReadPath c Crumb) => Rewrite c m CoreExpr -> Rewrite c m Equality
-rhsR r = do
-    Equality vs lhs rhs <- idR
-    rhs' <- withVarsInScope vs r <<< return rhs
-    return $ Equality vs lhs rhs'
+-- | Lift a rewrite over 'LCoreTC' into a rewrite over the right-hand side of a 'Quantified'.
+rhsR :: (AddBindings c, Monad m, ReadPath c Crumb, ExtendPath c Crumb)
+     => Rewrite c m LCore -> Rewrite c m Quantified
+rhsR r = quantifiedR idR (clauseR idR r)
 
--- | Lift a rewrite over 'CoreExpr' into a rewrite over both sides of a 'Equality'.
-bothR :: (AddBindings c, MonadCatch m, ReadPath c Crumb) => Rewrite c m CoreExpr -> Rewrite c m Equality
+-- | Lift a rewrite over 'LCoreTC' into a rewrite over both sides of a 'Quantified'.
+bothR :: (AddBindings c, MonadCatch m, ReadPath c Crumb, ExtendPath c Crumb)
+      => Rewrite c m LCore -> Rewrite c m Quantified
 bothR r = lhsR r >+> rhsR r
 
 ------------------------------------------------------------------------------
 
-ppEqualityT :: PrettyPrinter -> TransformH Equality DocH
-ppEqualityT pp = do
-    let pos = pOptions pp
-    d1 <- forallVarsT (liftPrettyH pos $ pForall pp)
-    (d2,d3) <- bothT (liftPrettyH pos $ extractT $ pCoreTC pp)
-    return $ PP.sep [d1,d2,syntaxColor (PP.text "="),d3]
+-- | Original clause passed to function so it can decide how to handle connective.
+clauseT :: (Monad m, ExtendPath c Crumb) => Transform c m LCore a -> Transform c m LCore b -> (Clause -> a -> b -> d) -> Transform c m Clause d
+clauseT t1 t2 f = readerT $ \ cl -> case cl of
+                                      Conj{}  -> conjT  (extractT t1) (extractT t2) (f cl)
+                                      Disj{}  -> disjT  (extractT t1) (extractT t2) (f cl)
+                                      Impl{}  -> implT  (extractT t1) (extractT t2) (f cl)
+                                      Equiv{} -> equivT (extractT t1) (extractT t2) (f cl)
 
+clauseR :: (Monad m, ExtendPath c Crumb) => Rewrite c m LCore -> Rewrite c m LCore -> Rewrite c m Clause
+clauseR r1 r2 = readerT $ \case
+                             Conj{}  -> conjAllR (extractR r1) (extractR r2)
+                             Disj{}  -> disjAllR (extractR r1) (extractR r2)
+                             Impl{}  -> implAllR (extractR r1) (extractR r2)
+                             Equiv{} -> equivAllR (extractR r1) (extractR r2)
+
+-- | Lift a transformation over '[Var]' into a transformation over the universally quantified variables of a 'Quantified'.
+forallVarsT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, Monad m) => Transform c m [Var] b -> Transform c m Quantified b
+forallVarsT t = quantifiedT t successT const
+
 ------------------------------------------------------------------------------
 
--- 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])
---
--- TODO: need to know type of 'x' to generate a variable.
-class BuildEquality a where
-    mkEquality :: a -> HermitM Equality
+showLemmasT :: Maybe LemmaName -> PrettyPrinter -> PrettyH a
+showLemmasT mnm pp = do
+    ls <- getLemmasT
+    let ls' = Map.toList $ Map.filterWithKey (maybe (\ _ _ -> True) (\ nm n _ -> show nm `isInfixOf` show n) mnm) ls
+    ds <- forM ls' $ \(nm,l) -> return l >>> ppLemmaT pp nm
+    return $ PP.vcat ds
 
-instance BuildEquality (CoreExpr,CoreExpr) where
-    mkEquality :: (CoreExpr,CoreExpr) -> HermitM Equality
-    mkEquality (lhs,rhs) = return $ Equality [] lhs rhs
+showLemmaT :: LemmaName -> PrettyPrinter -> PrettyH a
+showLemmaT nm pp = getLemmaByNameT nm >>> ppLemmaT pp nm
 
-instance BuildEquality a => BuildEquality (CoreExpr -> a) where
-    mkEquality :: (CoreExpr -> a) -> HermitM Equality
-    mkEquality f = do
-        x <- newIdH "x" (error "need to create a type")
-        Equality bnds lhs rhs <- mkEquality (f (varToCoreExpr x))
-        return $ Equality (x:bnds) lhs rhs
+ppLemmaT :: PrettyPrinter -> LemmaName -> PrettyH Lemma
+ppLemmaT pp nm = do
+    Lemma q p _u _t <- idR
+    qDoc <- return q >>> ppQuantifiedT pp
+    let hDoc = PP.text (show nm) PP.<+> PP.text ("(" ++ show p ++ ")")
+    return $ hDoc PP.$+$ PP.nest 2 qDoc
 
+ppLCoreTCT :: PrettyPrinter -> PrettyH LCoreTC
+ppLCoreTCT pp = promoteT (ppQuantifiedT pp) <+ promoteT (ppClauseT pp) <+ promoteT (pCoreTC pp)
+
+ppQuantifiedT :: PrettyPrinter -> PrettyH Quantified
+ppQuantifiedT pp = do
+    (d1,d2) <- quantifiedT (pForall pp) (ppClauseT pp) (,)
+    return $ PP.sep [d1,d2]
+
+ppClauseT :: PrettyPrinter -> PrettyH Clause
+ppClauseT pp = do
+    let t = absPathT &&& (promoteT (ppQuantifiedT pp) <+ promoteT (extractT (pCoreTC pp) :: PrettyH Core)) -- TODO: temporary hack, need to think about what's going on here and fix it
+        parenify (p1,d1) (p2,d2) o = ( symbol p1 '(' PP.<> d1 PP.<> symbol p1 ')'
+                                     , symbol p2 '(' PP.<> d2 PP.<> symbol p2 ')'
+                                     , syntaxColor (PP.text o)
+                                     )
+    (d1,d2,oper) <- clauseT t t (\ cl r1 r2 ->
+                                    case cl of
+                                        Conj {} -> parenify r1 r2 "^"
+                                        Disj {} -> parenify r1 r2 "v"
+                                        Impl {} -> parenify r1 r2 "=>"
+                                        Equiv {} -> (snd r1, snd r2, syntaxColor $ PP.text "="))
+    return $ PP.sep [d1,oper,d2]
+
 ------------------------------------------------------------------------------
 
--- | Verify that a 'Equality' holds, by applying a rewrite to each side, and checking that the results are equal.
-proveEqualityT :: forall c m. (AddBindings c, Monad m, ReadPath c Crumb)
-                        => EqualityProof c m -> Transform c m Equality ()
-proveEqualityT (l,r) = lhsR l >>> rhsR r >>> verifyEqualityT
+verifyQuantifiedT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, MonadCatch m) => Transform c m Quantified ()
+verifyQuantifiedT = quantifiedT successT verifyClauseT (flip const)
 
--- | Verify that the left- and right-hand sides of a 'Equality' are alpha equivalent.
-verifyEqualityT :: Monad m => Transform c m Equality ()
-verifyEqualityT = do
-    Equality _ lhs rhs <- idR
-    guardMsg (exprAlphaEq lhs rhs) "the two sides of the equality do not match."
+verifyClauseT :: (AddBindings c, ReadPath c Crumb, ExtendPath c Crumb, MonadCatch m) => Transform c m Clause ()
+verifyClauseT =
+    readerT (\case Conj  q1 q2 -> (return q1 >>> verifyQuantifiedT) >> (return q2 >>> verifyQuantifiedT)
+                   Disj  q1 q2 -> (return q1 >>> verifyQuantifiedT) <+ (return q2 >>> verifyQuantifiedT)
+                   Impl  _  _  -> fail "verifyClauseT: Impl TODO"
+                   Equiv e1 e2 -> guardMsg (exprAlphaEq e1 e2) "the two sides of the equality do not match.")
 
+verifyEquivalentT :: (HasLemmas m, MonadCatch m) => Used -> LemmaName -> Transform c m Quantified ()
+verifyEquivalentT used nm = prefixFailMsg "verification failed: " $ do
+    Lemma q _ _ _ <- getLemmaByNameT nm
+    eq <- arr (q `proves`)
+    guardMsg eq "lemmas are not equivalent."
+    markLemmaUsedT nm used
+
+verifyOrCreateT :: (HasLemmas m, MonadCatch m) => Used -> LemmaName -> Lemma -> Transform c m a ()
+verifyOrCreateT u nm l = do
+    exists <- testM $ getLemmaByNameT nm
+    if exists
+    then return (lemmaQ l) >>> verifyEquivalentT u nm
+    else insertLemmaT nm l
+
 ------------------------------------------------------------------------------
 
--- TODO: are these other functions used? If so, can they be rewritten in terms of lhsR and rhsR as above?
+lintQuantifiedT :: (AddBindings c, BoundVars c, ReadPath c Crumb, ExtendPath c Crumb, HasDynFlags m, MonadCatch m)
+                => Transform c m Quantified String
+lintQuantifiedT = lintQuantifiedWorkT []
 
+lintQuantifiedWorkT :: (AddBindings c, BoundVars c, ReadPath c Crumb, ExtendPath c Crumb, HasDynFlags m, MonadCatch m)
+                    => [Var] -> Transform c m Quantified String
+lintQuantifiedWorkT bs = readerT $ \ (Quantified bs' _) -> quantifiedT successT (lintClauseT (bs++bs')) (flip const)
+
+lintClauseT :: (AddBindings c, BoundVars c, ReadPath c Crumb, ExtendPath c Crumb, HasDynFlags m, MonadCatch m)
+            => [Var] -> Transform c m Clause String
+lintClauseT bs = do
+    t <- readerT $ \case Equiv {} -> return $ promoteT ({- arr (mkCoreLams bs) >>> -} lintExprT) -- TODO: why does this break core lint?!
+                         _        -> return $ promoteT (lintQuantifiedWorkT bs)
+    (w1,w2) <- clauseT t t (const (,))
+    return $ unlines [w1,w2]
+
+------------------------------------------------------------------------------
+
+-- TODO: everything between here and instantiateDictsR needs to be rethought/removed
+
+-- TODO: this is used in century plugin, but otherwise should be removed
+
 -- | Given two expressions, and a rewrite from the former to the latter, verify that rewrite.
 verifyEqualityLeftToRightT :: MonadCatch m => CoreExpr -> CoreExpr -> Rewrite c m CoreExpr -> Transform c m a ()
 verifyEqualityLeftToRightT sourceExpr targetExpr r =
@@ -331,13 +434,13 @@
          return y
 
 -- | Given @f :: X -> Y@ and @g :: Y -> X@, and a proof that @f (g y)@ ==> @y@, then @f (g y)@ <==> @y@.
-retraction :: Maybe (RewriteH Core) -> CoreString -> CoreString -> BiRewriteH CoreExpr
+retraction :: Maybe (RewriteH LCore) -> CoreString -> CoreString -> BiRewriteH CoreExpr
 retraction mr = parse2beforeBiR (retractionBR (extractR <$> mr))
 
 ------------------------------------------------------------------------------
 
 -- TODO: revisit this for binder re-ordering issue
-instantiateDictsR :: RewriteH Equality
+instantiateDictsR :: RewriteH Quantified
 instantiateDictsR = prefixFailMsg "Dictionary instantiation failed: " $ do
     bs <- forallVarsT idR
     let dArgs = filter (\b -> isId b && isDictTy (varType b)) bs
@@ -346,160 +449,264 @@
     ds <- forM uniqDs $ \ b -> constT $ do
             (i,bnds) <- buildDictionary b
             let dExpr = case bnds of
-                            [NonRec v e] | i == v -> e -- the common case that we would have gotten a single non-recursive let
+                            -- the common case that we would have gotten a single non-recursive let
+                            [NonRec v e] | i == v -> e
                             _ -> mkCoreLets bnds (varToCoreExpr i)
-                new = varSetElems $ delVarSetList (localFreeVarsExpr dExpr) bs
-            return (b,dExpr,new)
-    let buildSubst :: Monad m => Var -> m (Var, CoreExpr, [Var])
-        buildSubst b = case [ (b,e,[]) | (b',e,_) <- ds, eqType (varType b) (varType b') ] of
+            return (b,dExpr)
+    let buildSubst :: Monad m => Var -> m (Var, CoreExpr)
+        buildSubst b = case [ (b,e) | (b',e) <- ds, eqType (varType b) (varType b') ] of
                         [] -> fail "cannot find equivalent dictionary expression (impossible!)"
                         [t] -> return t
                         _   -> fail "multiple dictionary expressions found (impossible!)"
-        lookup3 :: Var -> [(Var,CoreExpr,[Var])] -> (Var,CoreExpr,[Var])
-        lookup3 v l = head [ t | t@(v',_,_) <- l, v == v' ]
+        lookup2 :: Var -> [(Var,CoreExpr)] -> (Var,CoreExpr)
+        lookup2 v l = head [ t | t@(v',_) <- l, v == v' ]
     allDs <- forM dArgs $ \ b -> constT $ do
                 if b `elem` uniqDs
-                then return $ lookup3 b ds
+                then return $ lookup2 b ds
                 else buildSubst b
-    contextfreeT $ instantiateEquality allDs
+    transform (\ c -> instsQuantified (boundVars c) allDs) >>> arr redundantDicts
 
 ------------------------------------------------------------------------------
 
-alphaEqualityR :: (Var -> Bool) -> (String -> String) -> RewriteH Equality
-alphaEqualityR p f = prefixFailMsg "Alpha-renaming binder in equality failed: " $ do
-    Equality bs lhs rhs <- idR
-    guardMsg (any p bs) "specified variable is not universally quantified."
+conjunctLemmasT :: (HasLemmas m, Monad m) => LemmaName -> LemmaName -> LemmaName -> Transform c m a ()
+conjunctLemmasT new lhs rhs = do
+    Lemma ql pl _ tl <- getLemmaByNameT lhs
+    Lemma qr pr _ tr <- getLemmaByNameT rhs
+    insertLemmaT new $ Lemma (Quantified [] (Conj ql qr)) (pl `andP` pr) NotUsed (tl || tr)
 
-    let (bs',i:vs) = break p bs -- this is safe because we know i is in bs
-    i' <- constT $ cloneVarH f i
+disjunctLemmasT :: (HasLemmas m, Monad m) => LemmaName -> LemmaName -> LemmaName -> Transform c m a ()
+disjunctLemmasT new lhs rhs = do
+    Lemma ql pl _ tl <- getLemmaByNameT lhs
+    Lemma qr pr _ tr <- getLemmaByNameT rhs
+    insertLemmaT new $ Lemma (Quantified [] (Disj ql qr)) (pl `orP` pr) NotUsed (tl || tr)
 
-    let inS           = delVarSetList (unionVarSets (map localFreeVarsExpr [lhs, rhs] ++ map freeVarsVar vs)) (i:i':vs)
-        subst         = extendSubst (mkEmptySubst (mkInScopeSet inS)) i (varToCoreExpr i')
-        (subst', vs') = substBndrs subst vs
-        lhs'          = substExpr (text "coreExprEquality-lhs") subst' lhs
-        rhs'          = substExpr (text "coreExprEquality-rhs") subst' rhs
-    return $ Equality (bs'++(i':vs')) lhs' rhs'
+implyLemmasT :: (HasLemmas m, Monad m) => LemmaName -> LemmaName -> LemmaName -> Transform c m a ()
+implyLemmasT new lhs rhs = do
+    Lemma ql _  _ tl <- getLemmaByNameT lhs
+    Lemma qr pr _ tr <- getLemmaByNameT rhs
+    insertLemmaT new $ Lemma (Quantified [] (Impl ql qr)) pr NotUsed (tl || tr)
 
-unshadowEqualityR :: RewriteH Equality
-unshadowEqualityR = prefixFailMsg "Unshadowing equality failed: " $ do
-    c@(Equality bs _ _) <- idR
-    bvs <- boundVarsT
-    let visible = unionVarSets [bvs , freeVarsEquality c]
-    ss <- varSetElems <$> detectShadowsM bs visible
-    guardMsg (not (null ss)) "no shadows to eliminate."
-    let f = freshNameGenAvoiding Nothing . extendVarSet visible
-    andR [ alphaEqualityR (==s) (f s) | s <- reverse ss ] >>> bothR (tryR unshadowExprR)
+------------------------------------------------------------------------------
 
-freeVarsEquality :: Equality -> VarSet
-freeVarsEquality (Equality bs lhs rhs) =
-    delVarSetList (unionVarSets (map freeVarsExpr [lhs,rhs])) bs
+mergeQuantifiersR :: MonadCatch m => (Var -> Bool) -> (Var -> Bool) -> Rewrite c m Quantified
+mergeQuantifiersR pl pr = contextfreeT $ mergeQuantifiers pl pr
 
+mergeQuantifiers :: MonadCatch m => (Var -> Bool) -> (Var -> Bool) -> Quantified -> m Quantified
+mergeQuantifiers pl pr (Quantified bs cl) = prefixFailMsg "merge-quantifiers failed: " $ do
+    (con,lq@(Quantified bsl cll),rq@(Quantified bsr clr)) <- case cl of
+        Conj q1 q2 -> return (Conj,q1,q2)
+        Disj q1 q2 -> return (Disj,q1,q2)
+        Impl q1 q2 -> return (Impl,q1,q2)
+        _ -> fail "no quantifiers on either side."
+
+    let (lBefore,lbs) = break pl bsl
+        (rBefore,rbs) = break pr bsr
+        check b q l r = guardMsg (not (b `elemVarSet` freeVarsQuantified q)) $
+                                 "specified "++l++" binder would capture in "++r++"-hand clause."
+        checkUB v vs = let fvs = freeVarsVar v
+                       in guardMsg (not (any (`elemVarSet` fvs) vs)) $ "binder " ++ getOccString v ++
+                            " cannot be floated because it depends on binders not being floated."
+
+    case (lbs,rbs) of
+        ([],[])        -> fail "no quantifiers match."
+        ([],rb:rAfter) -> do
+            check rb lq "right" "left"
+            checkUB rb rBefore
+            return $ Quantified (bs++[rb]) $ con lq (Quantified (rBefore++rAfter) clr)
+        (lb:lAfter,[]) -> do
+            check lb rq "left" "right"
+            checkUB lb lBefore
+            return $ Quantified (bs++[lb]) $ con (Quantified (lBefore++lAfter) cll) rq
+        (lb:lAfter,rb:rAfter) -> do
+            guardMsg (eqType (varType lb) (varType rb)) "specified quantifiers have differing types."
+            check lb rq "left" "right"
+            check rb lq "right" "left"
+            checkUB lb lBefore
+            checkUB rb rBefore
+
+            let Quantified partial clr' = substQuantified rb (varToCoreExpr lb) $ Quantified rAfter clr
+                rq' = Quantified (rBefore ++ partial) clr'
+                lq' = Quantified (lBefore ++ lAfter) cll
+
+            return $ Quantified (bs++[lb]) (con lq' rq')
+
 ------------------------------------------------------------------------------
 
-instantiateEqualityVarR :: (Var -> Bool) -> CoreString -> RewriteH Equality
-instantiateEqualityVarR p cs = prefixFailMsg "instantiation failed: " $ do
-    bs <- forallVarsT idR
-    (e,new) <- case filter p bs of
-                [] -> fail "no universally quantified variables match predicate."
-                (b:_) | isId b    -> let (before,_) = break (==b) bs
-                                     in liftM (,[]) $ withVarsInScope before $ parseCoreExprT cs
-                      | otherwise -> do let (before,_) = break (==b) bs
-                                        (ty, tvs) <- withVarsInScope before $ parseTypeWithHolesT cs
-                                        return (Type ty, tvs)
-    eq <- contextfreeT $ instantiateEqualityVar p e new
-    (_,_) <- return eq >>> bothT lintExprT -- sanity check
-    return eq
+unshadowQuantifiedR :: MonadUnique m => Rewrite c m Quantified
+unshadowQuantifiedR = contextfreeT unshadowQuantified
 
--- | Instantiate one of the universally quantified variables in a 'Equality'.
--- Note: assumes implicit ordering of variables, such that substitution happens to the right
--- as it does in case alternatives. Only first variable that matches predicate is
--- instantiated.
-instantiateEqualityVar :: MonadIO m => (Var -> Bool) -- predicate to select var
-                                    -> CoreExpr      -- expression to instantiate with
-                                    -> [Var]         -- new binders to add in place of var
-                                    -> Equality -> m Equality
-instantiateEqualityVar p e new (Equality bs lhs rhs)
-    | not (any p bs) = fail "specified variable is not universally quantified."
-    | otherwise = do
-        let (bs',i:vs) = break p bs -- this is safe because we know i is in bs
-            tyVars    = filter isTyVar bs'
-            failMsg   = fail "type of provided expression differs from selected binder."
+unshadowQuantified :: MonadUnique m => Quantified -> m Quantified
+unshadowQuantified q = go emptySubst (mapUniqSet fs (freeVarsQuantified q)) q
+    where fs = occNameFS . getOccName
 
-            -- unifyTypes will give back mappings from a TyVar to itself
-            -- we don't want to do these instantiations, or else variables
-            -- become unbound
-            dropSelfSubst :: [(TyVar, Type)] -> [(TyVar,Type)]
-            dropSelfSubst ps = [ (v,t) | (v,t) <- ps, case t of
-                                                        TyVarTy v' | v' == v -> False
-                                                        _ -> True ]
-        tvs <- maybe failMsg (return . tyMatchesToCoreExpr . dropSelfSubst)
-                $ unifyTypes tyVars (varType i) (exprKindOrType e)
+          go subst seen (Quantified bs cl) = go1 subst seen bs [] cl
 
-        let 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 "equality-lhs") subst' lhs
-            rhs'          = substExpr (text "equality-rhs") subst' rhs
-        instantiateEquality (noAdds tvs) $ Equality (bs'++new++vs') lhs' rhs'
+          go1 subst seen []     bs' cl = do
+            cl' <- go2 subst seen cl
+            return $ Quantified (reverse bs') cl'
+          go1 subst seen (b:bs) bs' cl
+            | fsb `elementOfUniqSet` seen = do
+                b'' <- cloneVarFSH (inventNames seen) b'
+                go1 (extendSubst subst' b' (varToCoreExpr b'')) (addOneToUniqSet seen (fs b'')) bs (b'':bs') cl
+            | otherwise = go1 subst' (addOneToUniqSet seen fsb) bs (b':bs') cl
+                where fsb = fs b'
+                      (subst', b') = substBndr subst b
 
-noAdds :: [(Var,CoreExpr)] -> [(Var,CoreExpr,[Var])]
-noAdds ps = [ (v,e,[]) | (v,e) <- ps ]
+          go2 subst seen (Conj q1 q2) = do
+            q1' <- go subst seen q1
+            q2' <- go subst seen q2
+            return $ Conj q1' q2'
+          go2 subst seen (Disj q1 q2) = do
+            q1' <- go subst seen q1
+            q2' <- go subst seen q2
+            return $ Disj q1' q2'
+          go2 subst seen (Impl q1 q2) = do
+            q1' <- go subst seen q1
+            q2' <- go subst seen q2
+            return $ Impl q1' q2'
+          go2 subst _ (Equiv e1 e2) =
+            let e1' = substExpr (text "unshadowQuantified e1") subst e1
+                e2' = substExpr (text "unshadowQuantified e2") subst e2
+            in return $ Equiv e1' e2'
 
--- | Instantiate a set of universally quantified variables in a 'Equality'.
--- It is important that all type variables appear before any value-level variables in the first argument.
-instantiateEquality :: MonadIO m => [(Var,CoreExpr,[Var])] -> Equality -> m Equality
-instantiateEquality = flip (foldM (\ eq (v,e,vs) -> instantiateEqualityVar (==v) e vs eq)) . reverse
--- foldM is a left-to-right fold, so the reverse is important to do substitutions in reverse order
--- which is what we want (all value variables should be instantiated before type variables).
+inventNames :: UniqSet FastString -> FastString -> FastString
+inventNames s nm = head [ nm' | i :: Int <- [0..]
+                              , let nm' = nm `appendFS` (mkFastString (show i))
+                              , not (nm' `elementOfUniqSet` s) ]
 
 ------------------------------------------------------------------------------
 
-discardUniVars :: Equality -> Equality
-discardUniVars (Equality _ lhs rhs) = Equality [] lhs rhs
+instantiateQuantifiedVarR :: (Var -> Bool) -> CoreString -> RewriteH Quantified
+instantiateQuantifiedVarR p cs = prefixFailMsg "instantiation failed: " $ do
+    bs <- forallVarsT idR
+    e <- case filter p bs of
+                [] -> fail "no universally quantified variables match predicate."
+                (b:_) | isId b    -> let (before,_) = break (==b) bs
+                                     in withVarsInScope before $ parseCoreExprT cs
+                      | otherwise -> let (before,_) = break (==b) bs
+                                     in liftM (Type . fst) $ withVarsInScope before $ parseTypeWithHolesT cs
+    transform (\ c -> instQuantified (boundVars c) p e) >>> (lintQuantifiedT >> idR) -- lint for sanity
 
 ------------------------------------------------------------------------------
 
+-- | Replace all occurrences of the given expression with a new quantified variable.
+abstractQuantifiedR :: forall c m.
+                       ( AddBindings c, BoundVars c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+                       , HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadUnique m )
+                    => String -> Transform c m Quantified CoreExpr -> Rewrite c m Quantified
+abstractQuantifiedR nm tr = prefixFailMsg "abstraction failed: " $ do
+    e <- tr
+    Quantified bs cl <- idR
+    b <- constT $ newVarH nm (exprKindOrType e)
+    let f = compileFold [Equality [] e (varToCoreExpr b)] -- we don't use mkEquality on purpose, so we can abstract lambdas
+    liftM dropBinders $ return (Quantified (bs++[b]) cl) >>>
+                            extractR (anytdR $ promoteExprR $ runFoldR f :: Rewrite c m LCoreTC)
+
+csInQBodyT :: ( AddBindings c, ReadBindings c, ReadPath c Crumb, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m ) => CoreString -> Transform c m Quantified CoreExpr
+csInQBodyT cs = do
+    Quantified bs _ <- idR
+    withVarsInScope bs $ parseCoreExprT cs
+
+------------------------------------------------------------------------------
+
 getLemmasT :: HasLemmas m => Transform c m x Lemmas
 getLemmasT = constT getLemmas
 
 getLemmaByNameT :: (HasLemmas m, Monad m) => LemmaName -> Transform c m x Lemma
 getLemmaByNameT nm = getLemmasT >>= maybe (fail $ "No lemma named: " ++ show nm) return . Map.lookup nm
 
-lemmaR :: LemmaName -> BiRewriteH CoreExpr
-lemmaR nm = afterBiR (beforeBiR (getLemmaByNameT nm) (birewrite . lemmaEq)) (markLemmaUsedR nm)
+getObligationNotProvenT :: (HasLemmas m, Monad m) => Transform c m x [NamedLemma]
+getObligationNotProvenT = do
+    ls <- getLemmasT
+    return [ (nm,l) | (nm, l@(Lemma _ NotProven Obligation _)) <- Map.toList ls ]
 
 ------------------------------------------------------------------------------
 
--- We use sideEffectR because only rewrites generate new state in the Kernel.
+lemmaBiR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+            , HasLemmas m, MonadCatch m, MonadUnique m)
+         => Used -> LemmaName -> BiRewrite c m CoreExpr
+lemmaBiR u nm = afterBiR (beforeBiR (getLemmaByNameT nm) (birewrite . lemmaQ)) (markLemmaUsedT nm u >> idR)
 
-insertLemmaR :: (HasLemmas m, Monad m) => LemmaName -> Lemma -> Rewrite c m a
-insertLemmaR nm l = sideEffectR $ \ _ _ -> insertLemma nm l
+lemmaConsequentR :: forall c m. ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c
+                                , ReadPath c Crumb, HasLemmas m, MonadCatch m, MonadUnique m)
+                 => Used -> LemmaName -> Rewrite c m Quantified
+lemmaConsequentR u nm = prefixFailMsg "lemma-consequent failed:" $
+                        withPatFailMsg "lemma is not an implication." $ do
+    Quantified hs (Impl ante con) <- lemmaQ <$> getLemmaByNameT nm
+    q' <- transform $ \ c q -> do
+        m <- maybeM ("consequent did not match.") $ lemmaMatch hs con q
+        subs <- maybeM ("some quantifiers not instantiated.") $
+                mapM (\h -> (h,) <$> lookupVarEnv m h) hs
+        let q' = substQuantifieds subs ante
+        guardMsg (all (inScope c) $ varSetElems (freeVarsQuantified q'))
+                 "some variables in result would be out of scope."
+        return q'
+    markLemmaUsedT nm u
+    return q'
 
-modifyLemmaR :: (HasLemmas m, Monad m)
+lemmaConsequentBiR :: forall c m. ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c
+                                  , ReadPath c Crumb, HasLemmas m, MonadCatch m, MonadUnique m)
+                   => Used -> LemmaName -> BiRewrite c m CoreExpr
+lemmaConsequentBiR u nm = afterBiR (beforeBiR (getLemmaByNameT nm) (go . lemmaQ)) (markLemmaUsedT nm u >> idR)
+    where go :: Quantified -> BiRewrite c m CoreExpr
+          go (Quantified bs (Impl ante (Quantified bs' cl))) = do
+            let eqs = toEqualities $ Quantified (bs++bs') cl -- consequent
+                foldUnfold side f =
+                    transform $ \ c e -> do
+                        let cf = compileFold $ map f eqs
+                        (e',hs) <- maybeM ("expression did not match "++side++"-hand side") $ runFoldMatches cf c e
+                        let matches = [ case lookupVarEnv hs b of
+                                            Nothing -> Left b
+                                            Just arg -> Right (b,arg)
+                                      | b <- bs ]
+                            (unmatched, subs) = partitionEithers matches
+                            Quantified aBs acl = substQuantifieds subs ante
+                            q = Quantified (unmatched++aBs) acl
+                        insertLemma (nm <> "-antecedent") $ Lemma q NotProven u True
+                        return e'
+            bidirectional (foldUnfold "left" id) (foldUnfold "right" flipEquality)
+          go _ = let t = fail $ show nm ++ " is not an implication."
+                 in bidirectional t t
+
+------------------------------------------------------------------------------
+
+insertLemmaT :: (HasLemmas m, Monad m) => LemmaName -> Lemma -> Transform c m a ()
+insertLemmaT nm l = constT $ insertLemma nm l
+
+insertLemmasT :: (HasLemmas m, Monad m) => [NamedLemma] -> Transform c m a ()
+insertLemmasT = constT . mapM_ (uncurry insertLemma)
+
+modifyLemmaT :: (HasLemmas m, Monad m)
              => LemmaName
              -> (LemmaName -> LemmaName) -- ^ modify lemma name
-             -> Rewrite c m Equality     -- ^ rewrite the equality
-             -> (Bool -> Bool)           -- ^ modify proven status
-             -> (Bool -> Bool)           -- ^ modify used status
-             -> Rewrite c m a
-modifyLemmaR nm nFn rr pFn uFn = do
-    Lemma eq p u <- getLemmaByNameT nm
-    eq' <- rr <<< return eq
-    sideEffectR $ \ _ _ -> insertLemma (nFn nm) $ Lemma eq' (pFn p) (uFn u)
+             -> Rewrite c m Quantified   -- ^ rewrite the quantified clause
+             -> (Proven -> Proven)       -- ^ modify proven status
+             -> (Used -> Used)           -- ^ modify used status
+             -> Transform c m a ()
+modifyLemmaT nm nFn rr pFn uFn = do
+    Lemma q p u t <- getLemmaByNameT nm
+    q' <- rr <<< return q
+    constT $ insertLemma (nFn nm) $ Lemma q' (pFn p) (uFn u) t
 
-markLemmaUsedR :: (HasLemmas m, Monad m) => LemmaName -> Rewrite c m a
-markLemmaUsedR nm = modifyLemmaR nm id idR id (const True)
+markLemmaUsedT :: (HasLemmas m, Monad m) => LemmaName -> Used -> Transform c m a ()
+markLemmaUsedT nm u = modifyLemmaT nm id idR id (const u)
 
+markLemmaProvedT :: (HasLemmas m, Monad m) => LemmaName -> Transform c m a ()
+markLemmaProvedT nm = modifyLemmaT nm id idR (const Proven) id
+
+markLemmaAssumedT :: (HasLemmas m, Monad m) => Bool -> LemmaName -> Transform c m a ()
+markLemmaAssumedT user nm = modifyLemmaT nm id idR (const (Assumed user)) id
 ------------------------------------------------------------------------------
 
-lemmaNameToEqualityT :: (HasLemmas m, Monad m) => LemmaName -> Transform c m x Equality
-lemmaNameToEqualityT nm = liftM lemmaEq $ getLemmaByNameT nm
+lemmaNameToQuantifiedT :: (HasLemmas m, Monad m) => LemmaName -> Transform c m x Quantified
+lemmaNameToQuantifiedT nm = liftM lemmaQ $ getLemmaByNameT nm
 
 -- | @e@ ==> @let v = lhs in e@  (also works in a similar manner at Program nodes)
 lemmaLhsIntroR :: LemmaName -> RewriteH Core
-lemmaLhsIntroR = lemmaNameToEqualityT >=> eqLhsIntroR
+lemmaLhsIntroR = lemmaNameToQuantifiedT >=> eqLhsIntroR
 
 -- | @e@ ==> @let v = rhs in e@  (also works in a similar manner at Program nodes)
 lemmaRhsIntroR :: LemmaName -> RewriteH Core
-lemmaRhsIntroR = lemmaNameToEqualityT >=> eqRhsIntroR
+lemmaRhsIntroR = lemmaNameToQuantifiedT >=> eqRhsIntroR
 
+------------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/Remembered.hs b/src/HERMIT/Dictionary/Remembered.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Dictionary/Remembered.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+module HERMIT.Dictionary.Remembered
+    ( -- * Remembering definitions.
+      externals
+    , prefixRemembered
+    , rememberR
+    , unfoldRememberedR
+    , foldRememberedR
+    , foldAnyRememberedR
+    , compileRememberedT
+    ) where
+
+import           Control.Monad
+
+import qualified Data.Map as Map
+import           Data.List (isPrefixOf)
+import           Data.Monoid
+
+import           HERMIT.Context
+import           HERMIT.Core
+import           HERMIT.External
+import           HERMIT.GHC hiding ((<>), (<+>), nest, ($+$))
+import           HERMIT.Kure
+import           HERMIT.Lemma
+import           HERMIT.Monad
+import           HERMIT.PrettyPrinter.Common
+
+import           HERMIT.Dictionary.Fold hiding (externals)
+import           HERMIT.Dictionary.Reasoning hiding (externals)
+
+------------------------------------------------------------------------------
+
+externals :: [External]
+externals =
+    [ external "remember" (promoteCoreT . rememberR :: LemmaName -> TransformH LCore ())
+        [ "Remember the current binding, allowing it to be folded/unfolded in the future." ] .+ Context
+    , external "unfold-remembered" (promoteExprR . unfoldRememberedR Obligation :: LemmaName -> RewriteH LCore)
+        [ "Unfold a remembered definition." ] .+ Deep .+ Context
+    , external "fold-remembered" (promoteExprR . foldRememberedR Obligation :: LemmaName -> RewriteH LCore)
+        [ "Fold a remembered definition." ]                      .+ Context .+ Deep
+    , external "fold-any-remembered" (promoteExprR foldAnyRememberedR :: RewriteH LCore)
+        [ "Attempt to fold any of the remembered definitions." ] .+ Context .+ Deep
+    , external "show-remembered" (promoteCoreT . showLemmasT (Just "remembered-") :: PrettyPrinter -> PrettyH LCore)
+        [ "Display all remembered definitions." ]
+    ]
+
+------------------------------------------------------------------------------
+
+prefixRemembered :: LemmaName -> LemmaName
+prefixRemembered = ("remembered-" <>)
+
+-- | Remember a binding with a name for later use. Allows us to look at past definitions.
+rememberR :: (AddBindings c, ExtendPath c Crumb, ReadPath c Crumb, HasLemmas m, MonadCatch m)
+          => LemmaName -> Transform c m Core ()
+rememberR nm = prefixFailMsg "remember failed: " $ do
+    Def v e <- setFailMsg "not applied to a binding." $ defOrNonRecT idR idR Def
+    insertLemmaT (prefixRemembered nm) $ Lemma (mkQuantified [] (varToCoreExpr v) e) Proven NotUsed False
+
+-- | Unfold a remembered definition (like unfoldR, but looks in stash instead of context).
+unfoldRememberedR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+                     , HasLemmas m, MonadCatch m, MonadUnique m)
+                  => Used -> LemmaName -> Rewrite c m CoreExpr
+unfoldRememberedR u = prefixFailMsg "Unfolding remembered definition failed: " . forwardT . lemmaBiR u . prefixRemembered
+
+-- | Fold a remembered definition (like foldR, but looks in stash instead of context).
+foldRememberedR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+                   , HasLemmas m, MonadCatch m, MonadUnique m)
+                => Used -> LemmaName -> Rewrite c m CoreExpr
+foldRememberedR u = prefixFailMsg "Folding remembered definition failed: " . backwardT . lemmaBiR u . prefixRemembered
+
+-- | Fold any of the remembered definitions.
+foldAnyRememberedR :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+                      , HasLemmas m, MonadCatch m, MonadUnique m)
+                   => Rewrite c m CoreExpr
+foldAnyRememberedR = setFailMsg "Fold failed: no definitions could be folded."
+                   $ compileRememberedT >>= runFoldR
+
+-- | Compile all remembered definitions into something that can be run with `runFoldR`
+compileRememberedT :: (HasLemmas m, Monad m) => Transform c m x CompiledFold
+compileRememberedT = do
+    qs <- liftM (map lemmaQ . Map.elems . Map.filterWithKey (\ k _ -> "remembered-" `isPrefixOf` show k)) getLemmasT
+    return $ compileFold $ concatMap (map flipEquality . toEqualities) qs -- fold rhs to lhs
diff --git a/src/HERMIT/Dictionary/Rules.hs b/src/HERMIT/Dictionary/Rules.hs
--- a/src/HERMIT/Dictionary/Rules.hs
+++ b/src/HERMIT/Dictionary/Rules.hs
@@ -5,10 +5,13 @@
       -- ** Rules
     , RuleName(..)
     , RuleNameListBox(..)
-    , ruleR
-    , rulesR
-    , ruleToEqualityT
-    , ruleNameToEqualityT
+    , foldRuleR
+    , foldRulesR
+    , unfoldRuleR
+    , unfoldRulesR
+    , compileRulesT
+    , ruleToQuantifiedT
+    , ruleNameToQuantifiedT
     , getHermitRuleT
     , getHermitRulesT
       -- ** Specialisation
@@ -27,18 +30,20 @@
 import Data.List (deleteFirstsBy,intercalate)
 import Data.String (IsString(..))
 
-import HERMIT.Core
 import HERMIT.Context
-import HERMIT.Monad
-import HERMIT.Kure
+import HERMIT.Core
 import HERMIT.External
 import HERMIT.GHC
+import HERMIT.Kure
+import HERMIT.Lemma
+import HERMIT.Monad
 
-import HERMIT.Dictionary.GHC (dynFlagsT)
+import HERMIT.Dictionary.Fold (compileFold, CompiledFold, toEqualities)
 import HERMIT.Dictionary.Kure (anyCallR)
 import HERMIT.Dictionary.Reasoning hiding (externals)
-import HERMIT.Dictionary.Unfold (betaReducePlusR)
 
+import HERMIT.PrettyPrinter.Common
+
 import IOEnv hiding (liftIO)
 
 ------------------------------------------------------------------------
@@ -46,22 +51,27 @@
 -- | Externals dealing with GHC rewrite rules.
 externals :: [External]
 externals =
-    [ external "rule-help" (rulesHelpListT :: TransformH CoreTC String)
+    [ external "show-rules" (rulesHelpListT :: TransformH LCoreTC String)
         [ "List all the rules in scope." ] .+ Query
-    , external "rule-help" (ruleHelpT :: RuleName -> TransformH CoreTC String)
+    , external "show-rule" (ruleHelpT :: PrettyPrinter -> RuleName -> TransformH LCoreTC DocH)
         [ "Display details on the named rule." ] .+ Query
-    , external "apply-rule" (promoteExprR . ruleR :: RuleName -> RewriteH Core)
-        [ "Apply a named GHC rule" ] .+ Shallow
-    , external "apply-rules" (promoteExprR . rulesR :: [RuleName] -> RewriteH Core)
-        [ "Apply named GHC rules, succeed if any of the rules succeed" ] .+ Shallow
-    , external "unfold-rule" ((\ nm -> promoteExprR (ruleR nm >>> tryR betaReducePlusR)) :: RuleName -> RewriteH Core)
-        [ "Unfold a named GHC rule" ] .+ Deep .+ Context .+ TODO -- TODO: does not work with rules with no arguments
-    , external "rule-to-lemma" (\nm -> do eq <- ruleNameToEqualityT nm
-                                          insertLemmaR (fromString (show nm)) $ Lemma eq False False :: RewriteH Core)
+    , external "fold-rule" (promoteExprR . foldRuleR Obligation :: RuleName -> RewriteH LCore)
+        [ "Apply a named GHC rule right-to-left." ] .+ Shallow
+    , external "fold-rules" (promoteExprR . foldRulesR Obligation :: [RuleName] -> RewriteH LCore)
+        [ "Apply named GHC rules right-to-left, succeed if any of the rules succeed." ] .+ Shallow
+    , external "unfold-rule" (promoteExprR . unfoldRuleR Obligation :: RuleName -> RewriteH LCore)
+        [ "Apply a named GHC rule left-to-right." ] .+ Shallow
+    , external "unfold-rule-unsafe" (promoteExprR . unfoldRuleR UnsafeUsed :: RuleName -> RewriteH LCore)
+        [ "Apply a named GHC rule left-to-right." ] .+ Shallow .+ Unsafe
+    , external "unfold-rules" (promoteExprR . unfoldRulesR Obligation :: [RuleName] -> RewriteH LCore)
+        [ "Apply named GHC rules left-to-right, succeed if any of the rules succeed" ] .+ Shallow
+    , external "unfold-rules-unsafe" (promoteExprR . unfoldRulesR UnsafeUsed :: [RuleName] -> RewriteH LCore)
+        [ "Apply named GHC rules left-to-right, succeed if any of the rules succeed" ] .+ Shallow .+ Unsafe
+    , external "rule-to-lemma" ((\pp nm -> ruleToLemmaT nm >> liftPrettyH (pOptions pp) (showLemmaT (fromString (show nm)) pp)) :: PrettyPrinter -> RuleName -> TransformH LCore DocH)
         [ "Create a lemma from a GHC RULE." ]
-    , external "spec-constr" (promoteModGutsR specConstrR :: RewriteH Core)
+    , external "spec-constr" (promoteModGutsR specConstrR :: RewriteH LCore)
         [ "Run GHC's SpecConstr pass, which performs call pattern specialization."] .+ Deep
-    , external "specialise" (promoteModGutsR specialiseR :: RewriteH Core)
+    , external "specialise" (promoteModGutsR specialiseR :: RewriteH LCore)
         [ "Run GHC's specialisation pass, which performs type and dictionary specialisation."] .+ Deep
     ]
 
@@ -84,19 +94,49 @@
     box = RuleNameListBox
     unbox (RuleNameListBox l) = l
 
--- | Lookup a rule by name, attempt to apply it. If successful, record it as an unproven lemma.
-ruleR :: ( AddBindings c, ExtendPath c Crumb, HasCoreRules c, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
-         , HasDynFlags m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
-      => RuleName -> Rewrite c m CoreExpr
-ruleR nm = do
-    eq <- ruleNameToEqualityT nm
-    forwardT (birewrite eq) >>> sideEffectR (\ _ _ -> addLemma (fromString (show nm)) $ Lemma eq False True)
+-- | Lookup a rule by name, attempt to apply it left-to-right. If successful, record it as an unproven lemma.
+foldRuleR :: ( AddBindings c, ExtendPath c Crumb, HasCoreRules c, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+               , HasDynFlags m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
+            => Used -> RuleName -> Rewrite c m CoreExpr
+foldRuleR u nm = do
+    q <- ruleNameToQuantifiedT nm
+    backwardT (birewrite q) >>> (verifyOrCreateT u (fromString (show nm)) (Lemma q NotProven u False) >> idR)
 
-rulesR :: ( AddBindings c, ExtendPath c Crumb, HasCoreRules c, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
-          , HasDynFlags m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
-       => [RuleName] -> Rewrite c m CoreExpr
-rulesR = orR . map ruleR
+-- | Lookup a set of rules by name, attempt to apply them left-to-right. Record an unproven lemma for the one that succeeds.
+foldRulesR :: ( AddBindings c, ExtendPath c Crumb, HasCoreRules c, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+              , HasDynFlags m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
+           => Used -> [RuleName] -> Rewrite c m CoreExpr
+foldRulesR u = orR . map (foldRuleR u)
 
+-- | Lookup a rule by name, attempt to apply it left-to-right. If successful, record it as an unproven lemma.
+unfoldRuleR :: ( AddBindings c, ExtendPath c Crumb, HasCoreRules c, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+               , HasDynFlags m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
+            => Used -> RuleName -> Rewrite c m CoreExpr
+unfoldRuleR u nm = do
+    q <- ruleNameToQuantifiedT nm
+    forwardT (birewrite q) >>> (verifyOrCreateT u (fromString (show nm)) (Lemma q NotProven u False) >> idR)
+
+-- | Lookup a set of rules by name, attempt to apply them left-to-right. Record an unproven lemma for the one that succeeds.
+unfoldRulesR :: ( AddBindings c, ExtendPath c Crumb, HasCoreRules c, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
+                , HasDynFlags m, HasHermitMEnv m, HasLemmas m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
+             => Used -> [RuleName] -> Rewrite c m CoreExpr
+unfoldRulesR u = orR . map (unfoldRuleR u)
+
+-- | Can be used with runFoldR. Note: currently doesn't create a lemma for the rule used.
+compileRulesT :: (BoundVars c, HasCoreRules c, HasHermitMEnv m, LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m)
+              => [RuleName] -> Transform c m a CompiledFold
+compileRulesT nms = do
+    let suggestion = "If you think the rule exists, try running the flatten-module command at the top level."
+    let failMsg []   = "no rule names supplied."
+        failMsg [nm] = "failed to find rule: " ++ show nm ++ ". " ++ suggestion
+        failMsg _    = "failed to find any rules named " ++ intercalate ", " (map show nms) ++ ". " ++ suggestion
+    allRules <- getHermitRulesT
+    case filter ((`elem` nms) . fst) allRules of
+        [] -> fail (failMsg nms)
+        rs -> liftM (compileFold . concatMap toEqualities)
+                $ forM (map snd rs) $ \ r -> return r >>> ruleToQuantifiedT
+
+
 -- | Return all in-scope CoreRules (including specialization RULES on binders), with their names.
 getHermitRulesT :: (HasCoreRules c, HasHermitMEnv m, LiftCoreM m, MonadIO m) => Transform c m a [(RuleName, CoreRule)]
 getHermitRulesT = contextonlyT $ \ c -> do
@@ -123,29 +163,32 @@
     rulesEnv <- getHermitRulesT
     return (intercalate "\n" $ reverse $ map (show.fst) rulesEnv)
 
--- | Print a named CoreRule using GHC's pretty printer for rewrite rules.
--- TODO: use our own Equality pretty printer.
-ruleHelpT :: (HasCoreRules c, HasDynFlags m, HasHermitMEnv m, LiftCoreM m, MonadIO m)
-          => RuleName -> Transform c m a String
-ruleHelpT nm = do
-    r <- getHermitRuleT nm
-    dflags <- dynFlagsT
-    return $ showSDoc dflags $ pprRulesForUser [r]
+-- | Print a named CoreRule using the quantified printer.
+ruleHelpT :: (HasCoreRules c, ReadBindings c, ReadPath c Crumb) => PrettyPrinter -> RuleName -> Transform c HermitM a DocH
+ruleHelpT pp nm = ruleNameToQuantifiedT nm >>> liftPrettyH (pOptions pp) (ppQuantifiedT pp)
 
--- | Build an Equality from a named GHC rewrite rule.
-ruleNameToEqualityT :: ( BoundVars c, HasCoreRules c, HasDynFlags m, HasHermitMEnv m
+-- | Build an Quantified from a named GHC rewrite rule.
+ruleNameToQuantifiedT :: ( BoundVars c, HasCoreRules c, HasDynFlags m, HasHermitMEnv m
                        , LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m )
-                    => RuleName -> Transform c m a Equality
-ruleNameToEqualityT name = getHermitRuleT name >>> ruleToEqualityT
+                    => RuleName -> Transform c m a Quantified
+ruleNameToQuantifiedT name = getHermitRuleT name >>> ruleToQuantifiedT
 
--- | Transform GHC's CoreRule into an Equality.
-ruleToEqualityT :: (BoundVars c, HasDynFlags m, HasHermitMEnv m, MonadThings m, MonadCatch m)
-                => Transform c m CoreRule Equality
-ruleToEqualityT = withPatFailMsg "HERMIT cannot handle built-in rules yet." $
-  do r@Rule{} <- idR -- other possibility is "BuiltinRule"
-     f <- lookupId $ ru_fn r
-     return $ Equality (ru_bndrs r) (mkCoreApps (Var f) (ru_args r)) (ru_rhs r)
+-- | Transform GHC's CoreRule into an Quantified.
+ruleToQuantifiedT :: (BoundVars c, HasHermitMEnv m, MonadThings m, MonadCatch m)
+                => Transform c m CoreRule Quantified
+ruleToQuantifiedT = withPatFailMsg "HERMIT cannot handle built-in rules yet." $ do
+    r@Rule{} <- idR -- other possibility is "BuiltinRule"
+    f <- lookupId $ ru_fn r
+    let lhs = mkCoreApps (varToCoreExpr f) (ru_args r)
+    return $ mkQuantified (ru_bndrs r) lhs (ru_rhs r)
 
+ruleToLemmaT :: ( BoundVars c, HasCoreRules c, HasDynFlags m, HasHermitMEnv m, HasLemmas m
+                , LiftCoreM m, MonadCatch m, MonadIO m, MonadThings m)
+             => RuleName -> Transform c m a ()
+ruleToLemmaT nm = do
+    q <- ruleNameToQuantifiedT nm
+    insertLemmaT (fromString (show nm)) $ Lemma q NotProven NotUsed False
+
 ------------------------------------------------------------------------
 
 -- | Run GHC's specConstr pass, and apply any rules generated.
@@ -202,6 +245,6 @@
 rulesToRewrite :: ( AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadBindings c, ReadPath c Crumb
                   , HasDynFlags m, HasHermitMEnv m, MonadCatch m, MonadThings m, MonadUnique m )
                => [CoreRule] -> Rewrite c m CoreExpr
-rulesToRewrite rs = catchesM [ (return r >>> ruleToEqualityT) >>= forwardT . birewrite | r <- rs ]
+rulesToRewrite rs = catchesM [ (return r >>> ruleToQuantifiedT) >>= forwardT . birewrite | r <- rs ]
 
 ------------------------------------------------------------------------
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
@@ -5,6 +5,7 @@
       externals
     , buildStrictnessLemmaT
     , verifyStrictT
+    , applyToUndefinedT
     , mkUndefinedValT
     , isUndefinedValT
     , replaceCurrentExprWithUndefinedR
@@ -31,6 +32,7 @@
 import HERMIT.External
 import HERMIT.GHC hiding ((<>))
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
 import HERMIT.Name
 
@@ -41,40 +43,40 @@
 ------------------------------------------------------------------------
 
 externals :: [External]
-externals = map (.+ Unsafe)
-    [ external "replace-current-expr-with-undefined" (promoteExprR replaceCurrentExprWithUndefinedR :: RewriteH Core)
+externals = map (.+ Strictness)
+    [ external "replace-current-expr-with-undefined" (promoteExprR replaceCurrentExprWithUndefinedR :: RewriteH LCore)
         [ "Set the current expression to \"undefined\"."
         ] .+ Shallow .+ Context .+ Unsafe
-    , external "replace-id-with-undefined" (replaceIdWithUndefined :: HermitName -> RewriteH Core)
+    , external "replace-id-with-undefined" (promoteCoreR . replaceIdWithUndefined :: HermitName -> RewriteH LCore)
         [ "Replace the specified identifier with \"undefined\"."
         ] .+ Deep .+ Context .+ Unsafe
-    , external "error-to-undefined" (promoteExprR errorToUndefinedR :: RewriteH Core)
+    , external "error-to-undefined" (promoteExprR errorToUndefinedR :: RewriteH LCore)
         [ "error ty string  ==>  undefined ty"
         ] .+ Shallow .+ Context
-    , external "is-undefined-val" (promoteExprT isUndefinedValT :: TransformH Core ())
+    , external "is-undefined-val" (promoteExprT isUndefinedValT :: TransformH LCore ())
         [ "Succeed if the current expression is an undefined value."
         ] .+ Shallow .+ Context .+ Predicate
-    , external "undefined-expr" (promoteExprR undefinedExprR :: RewriteH Core)
+    , external "undefined-expr" (promoteExprR undefinedExprR :: RewriteH LCore)
         [ "undefined-app <+ undefined-lam <+ undefined-let <+ undefined-cast <+ undefined-tick <+ undefined-case"
         ] .+ Eval .+ Shallow .+ Context
-    , external "undefined-app" (promoteExprR undefinedAppR :: RewriteH Core)
+    , external "undefined-app" (promoteExprR undefinedAppR :: RewriteH LCore)
         [ "(undefined ty1) e  ==>  undefined ty2"
         ] .+ Eval .+ Shallow .+ Context
-    , external "undefined-lam" (promoteExprR undefinedLamR :: RewriteH Core)
+    , external "undefined-lam" (promoteExprR undefinedLamR :: RewriteH LCore)
         [ "(\\ v -> undefined ty1)  ==>  undefined ty2   (where v is not a 'TyVar')"
         ] .+ Eval .+ Shallow .+ Context
-    , external "undefined-let" (promoteExprR undefinedLetR :: RewriteH Core)
+    , external "undefined-let" (promoteExprR undefinedLetR :: RewriteH LCore)
         [ "let bds in (undefined ty)  ==>  undefined ty"
         ] .+ Eval .+ Shallow .+ Context
-    , external "undefined-case" (promoteExprR undefinedCaseR :: RewriteH Core)
+    , external "undefined-case" (promoteExprR undefinedCaseR :: RewriteH LCore)
         [ "case (undefined ty) of alts  ==>  undefined ty"
         , "OR"
         , "case e of {pat_1 -> undefined ty ; pat_2 -> undefined ty ; ... ; pat_n -> undefined ty} ==> undefined ty"
         ] .+ Eval .+ Shallow .+ Context
-    , external "undefined-cast" (promoteExprR undefinedCastR :: RewriteH Core)
+    , external "undefined-cast" (promoteExprR undefinedCastR :: RewriteH LCore)
         [ "Cast (undefined ty1) co  ==>  undefined ty2"
         ] .+ Eval .+ Shallow .+ Context
-    , external "undefined-tick" (promoteExprR undefinedTickR :: RewriteH Core)
+    , external "undefined-tick" (promoteExprR undefinedTickR :: RewriteH LCore)
         [ "Tick tick (undefined ty1)  ==>  undefined ty1"
         ] .+ Eval .+ Shallow .+ Context
     ]
@@ -216,10 +218,10 @@
 -- | Add a lemma for the strictness of a function.
 -- Note: assumes added lemma has been used
 buildStrictnessLemmaT :: (BoundVars c, HasDynFlags m, HasHscEnv m, HasHermitMEnv m, HasLemmas m, MonadCatch m, MonadIO m, MonadThings m)
-                      => LemmaName -> CoreExpr -> Transform c m x ()
-buildStrictnessLemmaT nm f = do
+                      => Used -> LemmaName -> CoreExpr -> Transform c m x ()
+buildStrictnessLemmaT u nm f = do
     (tvs, lhs) <- liftM collectTyBinders $ applyToUndefinedT f
     rhs <- mkUndefinedValT (exprType lhs)
-    constT $ insertLemma nm $ Lemma (Equality tvs lhs rhs) False True
+    verifyOrCreateT u nm $ Lemma (mkQuantified tvs lhs rhs) NotProven u False
 
 ------------------------------------------------------------------------
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
@@ -2,27 +2,18 @@
 module HERMIT.Dictionary.Unfold
     ( externals
     , betaReducePlusR
-    , rememberR
-    , showStashT
     , unfoldR
     , unfoldPredR
     , unfoldNameR
     , unfoldNamesR
     , unfoldSaturatedR
-    , unfoldStashR
     , specializeR
     ) where
 
 import Control.Arrow
 import Control.Monad
 
-import Data.List (intercalate)
-import qualified Data.Map as Map
-
-import HERMIT.PrettyPrinter.Common (DocH, PrettyH, TransformDocH(..), PrettyC)
-
 import HERMIT.Dictionary.Common
-import HERMIT.Dictionary.GHC (substCoreExpr)
 import HERMIT.Dictionary.Inline (inlineR)
 
 import HERMIT.Core
@@ -35,30 +26,22 @@
 
 import Prelude hiding (exp)
 
-import qualified Text.PrettyPrint.MarkedHughesPJ as PP
-
 ------------------------------------------------------------------------
 
 externals :: [External]
 externals =
-    [ external "beta-reduce-plus" (promoteExprR betaReducePlusR :: RewriteH Core)
+    [ external "beta-reduce-plus" (promoteExprR betaReducePlusR :: RewriteH LCore)
         [ "Perform one or more beta-reductions."]                               .+ Eval .+ Shallow
-    , external "remember" (rememberR :: RememberedName -> RewriteH Core)
-        [ "Remember the current binding, allowing it to be folded/unfolded in the future." ] .+ Context
-    , external "unfold-remembered" (promoteExprR . unfoldStashR :: RememberedName -> RewriteH Core)
-        [ "Unfold a remembered definition." ] .+ Deep .+ Context
-    , external "unfold" (promoteExprR unfoldR :: RewriteH Core)
+    , external "unfold" (promoteExprR unfoldR :: RewriteH LCore)
         [ "In application f x y z, unfold f." ] .+ Deep .+ Context
-    , external "unfold" (promoteExprR . unfoldNameR . unOccurrenceName :: OccurrenceName -> RewriteH Core)
+    , external "unfold" (promoteExprR . unfoldNameR . unOccurrenceName :: OccurrenceName -> RewriteH LCore)
         [ "Inline a definition, and apply the arguments; traditional unfold." ] .+ Deep .+ Context
-    , external "unfold" (promoteExprR . unfoldNamesR . map unOccurrenceName:: [OccurrenceName] -> RewriteH Core)
+    , external "unfold" (promoteExprR . unfoldNamesR . map unOccurrenceName:: [OccurrenceName] -> RewriteH LCore)
         [ "Unfold a definition if it is named in the list." ] .+ Deep .+ Context
-    , external "unfold-saturated" (promoteExprR unfoldSaturatedR :: RewriteH Core)
+    , external "unfold-saturated" (promoteExprR unfoldSaturatedR :: RewriteH LCore)
         [ "Unfold a definition only if the function is fully applied." ] .+ Deep .+ Context
-    , external "specialize" (promoteExprR specializeR :: RewriteH Core)
+    , external "specialize" (promoteExprR specializeR :: RewriteH LCore)
         [ "Specialize an application to its type and coercion arguments." ] .+ Deep .+ Context
-    , external "show-remembered" (TransformDocH showStashT :: TransformDocH CoreTC)
-        [ "Display all remembered definitions." ]
     ]
 
 ------------------------------------------------------------------------
@@ -104,45 +87,3 @@
 
 specializeR :: (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, ReadBindings c, HasEmptyContext c) => Rewrite c HermitM CoreExpr
 specializeR = unfoldPredR (const $ all isTyCoArg)
-
--- NOTE: Using a Rewrite because of the way the Kernel is set up.
---       This is a temporary hack until we work out the best way to structure the Kernel.
-
--- | Stash a binding with a name for later use.
--- Allows us to look at past definitions.
-rememberR :: RememberedName -> Rewrite c HermitM Core
-rememberR label = sideEffectR $ \ _ -> \case
-                                          DefCore def           -> saveDef label def
-                                          BindCore (NonRec i e) -> saveDef label (Def i e)
-                                          _                     -> fail "remember failed: not applied to a binding."
-
--- | Stash a binding with a name for later use.
--- Allows us to look at past definitions.
--- rememberR :: String -> Transform c m Core ()
--- rememberR label = contextfreeT $ \ core ->
---     case core of
---         DefCore def -> saveDef label def
---         BindCore (NonRec i e) -> saveDef label (Def i e)
---         _           -> fail "remember: not a binding"
-
--- | Apply a stashed definition (like inline, but looks in stash instead of context).
-unfoldStashR :: ReadBindings c => RememberedName -> Rewrite c HermitM CoreExpr
-unfoldStashR label = prefixFailMsg "Inlining stashed definition failed: " $
-                     withPatFailMsg (wrongExprForm "Var v") $
-    do (c, Var v) <- exposeT
-       constT $ do Def i rhs <- lookupDef label
-                   dflags <- getDynFlags
-                   if idName i == idName v -- TODO: Is there a reason we're not just using equality on Id?
-                   then let fvars = varSetElems $ localFreeVarsExpr rhs
-                        in if all (inScope c) fvars
-                           then return rhs
-                           else fail $ "free variables " ++ intercalate "," (map (showPpr dflags) (filter (not . inScope c) fvars)) ++ " in stashed definition are no longer in scope."
-                   else fail $ "stashed definition applies to " ++ unqualifiedName i ++ " not " ++ unqualifiedName v
-
-showStashT :: Injection CoreDef a => PrettyC -> PrettyH a -> Transform c HermitM a DocH
-showStashT pctx pp = do
-    stash <- constT getStash
-    docs <- forM (Map.toList stash) $ \ (l,d) -> do
-                dfn <- constT $ applyT (extractT pp) pctx d
-                return $ PP.text ("[ " ++ show l ++ " ]") PP.$+$ dfn PP.$+$ PP.space
-    return $ PP.vcat docs
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
@@ -1,7 +1,6 @@
 module HERMIT.Dictionary.Unsafe
     ( externals
     , unsafeReplaceR
-    , unsafeReplaceStashR
     ) where
 
 import Control.Monad
@@ -9,7 +8,6 @@
 import HERMIT.Core
 import HERMIT.Kure
 import HERMIT.GHC
-import HERMIT.Monad
 import HERMIT.External
 import HERMIT.ParserCore
 
@@ -19,12 +17,9 @@
 
 externals :: [External]
 externals = map (.+ Unsafe)
-    [ external "unsafe-replace" (promoteExprR . unsafeReplaceR :: CoreString -> RewriteH Core)
+    [ external "unsafe-replace" (promoteExprR . unsafeReplaceR :: CoreString -> RewriteH LCore)
         [ "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 :: RememberedName -> RewriteH Core)
-        [ "replace the currently focused expression with a remembered expression"
-        , "DOES NOT ensure that free variables in the replacement expression are in scope" ]
     ]
 
 ------------------------------------------------------------------------
@@ -35,12 +30,5 @@
         e' <- parseCore core c
         guardMsg (eqType (exprKindOrType e) (exprKindOrType e')) "expression types differ."
         return e'
-
-unsafeReplaceStashR :: RememberedName -> RewriteH CoreExpr
-unsafeReplaceStashR label = prefixFailMsg "unsafe-replace failed: " $
-    contextfreeT $ \ e -> do
-        Def _ rhs <- lookupDef label
-        guardMsg (eqType (exprKindOrType e) (exprKindOrType rhs)) "expression types differ."
-        return rhs
 
 ------------------------------------------------------------------------
diff --git a/src/HERMIT/Dictionary/WorkerWrapper/Common.hs b/src/HERMIT/Dictionary/WorkerWrapper/Common.hs
--- a/src/HERMIT/Dictionary/WorkerWrapper/Common.hs
+++ b/src/HERMIT/Dictionary/WorkerWrapper/Common.hs
@@ -3,9 +3,9 @@
     ( externals
     , WWAssumptionTag(..)
     , WWAssumption(..)
-    , assumptionAEqualityT
-    , assumptionBEqualityT
-    , assumptionCEqualityT
+    , assumptionAQuantifiedT
+    , assumptionBQuantifiedT
+    , assumptionCQuantifiedT
     , split1BetaR
     , split2BetaR
     , workLabel
@@ -21,6 +21,7 @@
 import HERMIT.External
 import HERMIT.GHC
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
 import HERMIT.ParserCore
 
@@ -36,30 +37,30 @@
 externals = map (.+ Proof)
     [ external "intro-ww-assumption-A"
         (\nm absC repC -> do
-            eq <- parse2BeforeT assumptionAEqualityT absC repC
-            insertLemmaR nm $ Lemma eq False False :: RewriteH Core)
+            q <- parse2BeforeT assumptionAQuantifiedT absC repC
+            insertLemmaT nm $ Lemma q NotProven NotUsed False :: TransformH LCore ())
         [ "Introduce a lemma for worker/wrapper assumption A"
         , "using given abs and rep functions." ]
     , external "intro-ww-assumption-B"
         (\nm absC repC bodyC -> do
-            eq <- parse3BeforeT assumptionBEqualityT absC repC bodyC
-            insertLemmaR nm $ Lemma eq False False :: RewriteH Core)
+            q <- parse3BeforeT assumptionBQuantifiedT absC repC bodyC
+            insertLemmaT nm $ Lemma q NotProven NotUsed False :: TransformH LCore ())
         [ "Introduce a lemma for worker/wrapper assumption B"
         , "using given abs, rep, and body functions." ]
     , external "intro-ww-assumption-C"
         (\nm absC repC bodyC -> do
-            eq <- parse3BeforeT assumptionCEqualityT absC repC bodyC
-            insertLemmaR nm $ Lemma eq False False :: RewriteH Core)
+            q <- parse3BeforeT assumptionCQuantifiedT absC repC bodyC
+            insertLemmaT nm $ Lemma q NotProven NotUsed False :: TransformH LCore ())
         [ "Introduce a lemma for worker/wrapper assumption C"
         , "using given abs, rep, and body functions." ]
-    , external "split-1-beta" (\ nm absC -> promoteExprR . parse2BeforeT (split1BetaR nm) absC :: CoreString -> RewriteH Core)
+    , external "split-1-beta" (\ nm absC -> promoteExprR . parse2BeforeT (split1BetaR Obligation nm) absC :: CoreString -> RewriteH LCore)
         [ "split-1-beta <name> <abs expression> <rep expression>"
         , "Perform worker/wrapper split with condition 1-beta."
         , "Given lemma name argument is used as prefix to two introduced lemmas."
         , "  <name>-assumption: unproven lemma for w/w assumption C."
         , "  <name>-fusion: assumed lemma for w/w fusion."
         ]
-    , external "split-2-beta" (\ nm absC -> promoteExprR . parse2BeforeT (split2BetaR nm) absC :: CoreString -> RewriteH Core)
+    , external "split-2-beta" (\ nm absC -> promoteExprR . parse2BeforeT (split2BetaR Obligation nm) absC :: CoreString -> RewriteH LCore)
         [ "split-2-beta <name> <abs expression> <rep expression>"
         , "Perform worker/wrapper split with condition 2-beta."
         , "Given lemma name argument is used as prefix to two introduced lemmas."
@@ -87,94 +88,95 @@
 -- That would have to exist at the Shell level though.
 
 -- This isn't entirely safe, as a malicious the user could define a label with this name.
-workLabel :: RememberedName
+workLabel :: LemmaName
 workLabel = fromString "recursive-definition-of-work-for-use-by-ww-fusion"
 
 --------------------------------------------------------------------------------------------------
 
 -- Given abs and rep expressions, build "abs . rep = id"
-assumptionAEqualityT :: ( BoundVars c, HasDynFlags m, HasHermitMEnv m, HasHscEnv m
+assumptionAQuantifiedT :: ( BoundVars c, HasHermitMEnv m, HasHscEnv m
                         , MonadCatch m, MonadIO m, MonadThings m )
-                     => CoreExpr -> CoreExpr -> Transform c m x Equality
-assumptionAEqualityT absE repE = prefixFailMsg "Building assumption A failed: " $ do
+                     => CoreExpr -> CoreExpr -> Transform c m x Quantified
+assumptionAQuantifiedT absE repE = prefixFailMsg "Building assumption A failed: " $ do
     comp <- buildCompositionT absE repE
     let (_,compBody) = collectTyBinders comp
     (tvs, xTy, _) <- splitFunTypeM (exprType comp)
     idE <- buildIdT xTy
-    return $ Equality tvs compBody idE
+    return $ Quantified tvs (Equiv compBody idE)
 
 -- Given abs, rep, and f expressions, build "abs . rep . f = f"
-assumptionBEqualityT :: ( BoundVars c, HasDynFlags m, HasHermitMEnv m, HasHscEnv m
+assumptionBQuantifiedT :: ( BoundVars c, HasHermitMEnv m, HasHscEnv m
                         , MonadCatch m, MonadIO m, MonadThings m)
-                     => CoreExpr -> CoreExpr -> CoreExpr -> Transform c m x Equality
-assumptionBEqualityT absE repE fE = prefixFailMsg "Building assumption B failed: " $ do
+                     => CoreExpr -> CoreExpr -> CoreExpr -> Transform c m x Quantified
+assumptionBQuantifiedT absE repE fE = prefixFailMsg "Building assumption B failed: " $ do
     repAfterF <- buildCompositionT repE fE
     comp <- buildCompositionT absE repAfterF
     let (tvs,lhs) = collectTyBinders comp
     rhs <- appArgM 5 lhs >>= appArgM 5 -- get f with proper tvs applied
-    return $ Equality tvs lhs rhs
+    return $ Quantified tvs (Equiv lhs rhs)
 
 -- Given abs, rep, and f expressions, build "fix (abs . rep . f) = fix f"
-assumptionCEqualityT :: (BoundVars c, HasDynFlags m, HasHermitMEnv m, HasHscEnv m, MonadCatch m, MonadIO m, MonadThings m)
-                     => CoreExpr -> CoreExpr -> CoreExpr -> Transform c m x Equality
-assumptionCEqualityT absE repE fE = prefixFailMsg "Building assumption C failed: " $ do
-    Equality vs lhs rhs <- assumptionBEqualityT absE repE fE
+assumptionCQuantifiedT :: (BoundVars c, HasHermitMEnv m, HasHscEnv m, MonadCatch m, MonadIO m, MonadThings m)
+                     => CoreExpr -> CoreExpr -> CoreExpr -> Transform c m x Quantified
+assumptionCQuantifiedT absE repE fE = prefixFailMsg "Building assumption C failed: " $ do
+    Quantified vs (Equiv lhs rhs) <- assumptionBQuantifiedT absE repE fE
     lhs' <- buildFixT lhs
     rhs' <- buildFixT rhs
-    return $ Equality vs lhs' rhs'
+    return $ Quantified vs (Equiv lhs' rhs')
 
 -- Given abs, rep, and 'fix g' expressions, build "rep (abs (fix g)) = fix g"
-wwFusionEqualityT :: (HasDynFlags m, MonadCatch m, MonadIO m)
-                  => CoreExpr -> CoreExpr -> CoreExpr -> Transform c m x Equality
-wwFusionEqualityT absE repE fixgE = prefixFailMsg "Building worker/wrapper fusion lemma failed: " $ do
-    protoLhs <- buildApplicationM repE =<< buildApplicationM absE fixgE
+wwFusionQuantifiedT :: MonadCatch m => CoreExpr -> CoreExpr -> CoreExpr -> Transform c m x Quantified
+wwFusionQuantifiedT absE repE fixgE = prefixFailMsg "Building worker/wrapper fusion lemma failed: " $ do
+    protoLhs <- buildAppM repE =<< buildAppM absE fixgE
     let (tvs, lhs) = collectTyBinders protoLhs
     -- This way, the rhs is applied to the proper type variables.
     rhs <- case lhs of
             (App _ (App _ rhs)) -> return rhs
             _                   -> fail "lhs malformed"
-    return $ Equality tvs lhs rhs
+    return $ Quantified tvs (Equiv lhs rhs)
 
 -- Perform the worker/wrapper split using condition 1-beta, introducing
 -- an unproven lemma for assumption C, and an appropriate w/w fusion lemma.
-split1BetaR :: ( BoundVars c, HasDynFlags m, HasHermitMEnv m, HasHscEnv m, HasLemmas m
+split1BetaR :: ( BoundVars c, HasHermitMEnv m, HasHscEnv m, HasLemmas m
                , MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
-            => LemmaName -> CoreExpr -> CoreExpr -> Rewrite c m CoreExpr
-split1BetaR nm absE repE = do
+            => Used -> LemmaName -> CoreExpr -> CoreExpr -> Rewrite c m CoreExpr
+split1BetaR u nm absE repE = do
     (_fixId, [_tyA, f]) <- callNameT $ fromString "Data.Function.fix"
 
-    g <- buildCompositionT repE =<< buildCompositionT f absE
+    g <- prefixFailMsg "building (rep . f . abs) failed: "
+       $ buildCompositionT repE =<< buildCompositionT f absE
     gId <- constT $ newIdH "g" $ exprType g
 
     workRhs <- buildFixT $ varToCoreExpr gId
     workId <- constT $ newIdH "worker" $ exprType workRhs
 
-    newRhs <- buildApplicationM absE (varToCoreExpr workId)
+    newRhs <- prefixFailMsg "building (abs work) failed: "
+            $ buildAppM absE (varToCoreExpr workId)
 
-    assumptionEq <- assumptionCEqualityT absE repE f
-    _ <- insertLemmaR (fromString (show nm ++ "-assumption")) $ Lemma assumptionEq False True -- unproven, used
+    assumptionQ <- assumptionCQuantifiedT absE repE f
+    verifyOrCreateT u (fromString (show nm ++ "-assumption")) $ Lemma assumptionQ NotProven u False -- unproven, used, permanent
 
-    wwFusionEq <- wwFusionEqualityT absE repE workRhs
-    _ <- insertLemmaR (fromString (show nm ++ "-fusion")) $ Lemma wwFusionEq True False -- proven (assumed), unused
+    wwFusionQ <- wwFusionQuantifiedT absE repE workRhs
+    insertLemmaT (fromString (show nm ++ "-fusion")) $ Lemma wwFusionQ (Assumed False) NotUsed False -- assumed, unused, permanent
 
     return $ mkCoreLets [NonRec gId g, NonRec workId workRhs] newRhs
 
-split2BetaR :: ( BoundVars c, HasDynFlags m, HasHermitMEnv m, HasHscEnv m, HasLemmas m
+split2BetaR :: ( BoundVars c, HasHermitMEnv m, HasHscEnv m, HasLemmas m
                , MonadCatch m, MonadIO m, MonadThings m, MonadUnique m )
-            => LemmaName -> CoreExpr -> CoreExpr -> Rewrite c m CoreExpr
-split2BetaR nm absE repE = do
+            => Used -> LemmaName -> CoreExpr -> CoreExpr -> Rewrite c m CoreExpr
+split2BetaR u nm absE repE = do
     (_fixId, [_tyA, f]) <- callNameT $ fromString "Data.Function.fix"
     fixfE <- idR
 
-    repFixFE <- buildApplicationM repE fixfE
+    repFixFE <- buildAppM repE fixfE
     workId <- constT $ newIdH "worker" $ exprType repFixFE
 
-    newRhs <- buildApplicationM absE (varToCoreExpr workId)
+    newRhs <- buildAppM absE (varToCoreExpr workId)
 
-    assumptionEq <- assumptionCEqualityT absE repE f
-    _ <- insertLemmaR (fromString (show nm ++ "-assumption")) $ Lemma assumptionEq False True -- unproven, used
+    assumptionQ <- assumptionCQuantifiedT absE repE f
+    verifyOrCreateT u (fromString (show nm ++ "-assumption")) $ Lemma assumptionQ NotProven u False -- unproven, used, permanent
 
-    wwFusionEq <- wwFusionEqualityT absE repE (varToCoreExpr workId)
-    _ <- insertLemmaR (fromString (show nm ++ "-fusion")) $ Lemma wwFusionEq True False -- proven (assumed), unused
+    wwFusionQ <- wwFusionQuantifiedT absE repE (varToCoreExpr workId)
+    insertLemmaT (fromString (show nm ++ "-fusion")) $ Lemma wwFusionQ (Assumed False) NotUsed False -- assumed, unused, permanent
 
     return $ mkCoreLets [NonRec workId repFixFE] newRhs
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
@@ -5,14 +5,13 @@
     , wwFacBR
     , wwSplitR
     , wwSplitStaticArg
-    , wwGenerateFusionR
+    , wwGenerateFusionT
     , wwFusionBR
     , wwAssA
     , wwAssB
     , wwAssC
     ) where
 
-import Control.Applicative
 import Control.Arrow
 
 import Data.String (fromString)
@@ -21,6 +20,7 @@
 import HERMIT.External
 import HERMIT.GHC
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
 import HERMIT.Name
 import HERMIT.ParserCore
@@ -44,21 +44,21 @@
 externals =
          [
            external "ww-factorisation" ((\ wrap unwrap assC -> promoteExprBiR $ wwFac (mkWWAssC assC) wrap unwrap)
-                                          :: CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                          :: CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Factorisation",
                   "For any \"f :: A -> A\", and given \"wrap :: B -> A\" and \"unwrap :: A -> B\" as arguments,",
                   "and a proof of Assumption C (fix A (\\ a -> wrap (unwrap (f a))) ==> fix A f), then",
                   "fix A f  ==>  wrap (fix B (\\ b -> unwrap (f (wrap b))))"
                 ] .+ Introduce .+ Context
          , external "ww-factorisation-unsafe" ((\ wrap unwrap -> promoteExprBiR $ wwFac Nothing wrap unwrap)
-                                               :: CoreString -> CoreString -> BiRewriteH Core)
+                                               :: CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Factorisation",
                   "For any \"f :: A -> A\", and given \"wrap :: B -> A\" and \"unwrap :: A -> B\" as arguments, then",
                   "fix A f  <==>  wrap (fix B (\\ b -> unwrap (f (wrap b))))",
                   "Note: the pre-condition \"fix A (\\ a -> wrap (unwrap (f a))) == fix A f\" is expected to hold."
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-split" ((\ wrap unwrap assC -> promoteDefR $ wwSplit (mkWWAssC assC) wrap unwrap)
-                                  :: CoreString -> CoreString -> RewriteH Core -> RewriteH Core)
+                                  :: CoreString -> CoreString -> RewriteH LCore -> RewriteH LCore)
                 [ "Worker/Wrapper Split",
                   "For any \"prog :: A\", and given \"wrap :: B -> A\" and \"unwrap :: A -> B\" as arguments,",
                   "and a proof of Assumption C (fix A (\\ a -> wrap (unwrap (f a))) ==> fix A f), then",
@@ -67,7 +67,7 @@
                   "                              in wrap work"
                 ] .+ Introduce .+ Context
          , external "ww-split-unsafe" ((\ wrap unwrap -> promoteDefR $ wwSplit Nothing wrap unwrap)
-                                       :: CoreString -> CoreString -> RewriteH Core)
+                                       :: CoreString -> CoreString -> RewriteH LCore)
                 [ "Unsafe Worker/Wrapper Split",
                   "For any \"prog :: A\", and given \"wrap :: B -> A\" and \"unwrap :: A -> B\" as arguments, then",
                   "prog = expr  ==>  prog = let f = \\ prog -> expr",
@@ -76,79 +76,79 @@
                   "Note: the pre-condition \"fix A (wrap . unwrap . f) == fix A f\" is expected to hold."
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-split-static-arg" ((\ n is wrap unwrap assC -> promoteDefR $ wwSplitStaticArg n is (mkWWAssC assC) wrap unwrap)
-                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH Core -> RewriteH Core)
+                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH LCore -> RewriteH LCore)
                 [ "Worker/Wrapper Split - Static Argument Variant",
                   "Perform the static argument transformation on the first n arguments, then perform the worker/wrapper split,",
                   "applying the given wrap and unwrap functions to the specified (by index) static arguments before use."
                 ] .+ Introduce .+ Context
          , external "ww-split-static-arg-unsafe" ((\ n is wrap unwrap -> promoteDefR $ wwSplitStaticArg n is Nothing wrap unwrap)
-                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH Core)
+                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH LCore)
                 [ "Unsafe Worker/Wrapper Split - Static Argument Variant",
                   "Perform the static argument transformation on the first n arguments, then perform the (unsafe) worker/wrapper split,",
                   "applying the given wrap and unwrap functions to the specified (by index) static arguments before use."
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-assumption-A" ((\ wrap unwrap assA -> promoteExprBiR $ wwA (Just $ extractR assA) wrap unwrap)
-                                       :: CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                       :: CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Assumption A",
                   "For a \"wrap :: B -> A\" and an \"unwrap :: A -> B\",",
                   "and given a proof of \"wrap (unwrap a) ==> a\", then",
                   "wrap (unwrap a)  <==>  a"
                 ] .+ Introduce .+ Context
          , external "ww-assumption-B" ((\ wrap unwrap f assB -> promoteExprBiR $ wwB (Just $ extractR assB) wrap unwrap f)
-                                       :: CoreString -> CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                       :: CoreString -> CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Assumption B",
                   "For a \"wrap :: B -> A\", an \"unwrap :: A -> B\", and an \"f :: A -> A\",",
                   "and given a proof of \"wrap (unwrap (f a)) ==> f a\", then",
                   "wrap (unwrap (f a))  <==>  f a"
                 ] .+ Introduce .+ Context
          , external "ww-assumption-C" ((\ wrap unwrap f assC -> promoteExprBiR $ wwC (Just $ extractR assC) wrap unwrap f)
-                                       :: CoreString -> CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                       :: CoreString -> CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Assumption C",
                   "For a \"wrap :: B -> A\", an \"unwrap :: A -> B\", and an \"f :: A -> A\",",
                   "and given a proof of \"fix A (\\ a -> wrap (unwrap (f a))) ==> fix A f\", then",
                   "fix A (\\ a -> wrap (unwrap (f a)))  <==>  fix A f"
                 ] .+ Introduce .+ Context
          , external "ww-assumption-A-unsafe" ((\ wrap unwrap -> promoteExprBiR $ wwA Nothing wrap unwrap)
-                                              :: CoreString -> CoreString -> BiRewriteH Core)
+                                              :: CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Assumption A",
                   "For a \"wrap :: B -> A\" and an \"unwrap :: A -> B\", then",
                   "wrap (unwrap a)  <==>  a",
                   "Note: only use this if it's true!"
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-assumption-B-unsafe" ((\ wrap unwrap f -> promoteExprBiR $ wwB Nothing wrap unwrap f)
-                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH Core)
+                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Assumption B",
                   "For a \"wrap :: B -> A\", an \"unwrap :: A -> B\", and an \"f :: A -> A\", then",
                   "wrap (unwrap (f a))  <==>  f a",
                   "Note: only use this if it's true!"
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-assumption-C-unsafe" ((\ wrap unwrap f -> promoteExprBiR $ wwC Nothing wrap unwrap f)
-                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH Core)
+                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Assumption C",
                   "For a \"wrap :: B -> A\", an \"unwrap :: A -> B\", and an \"f :: A -> A\", then",
                   "fix A (\\ a -> wrap (unwrap (f a)))  <==>  fix A f",
                   "Note: only use this if it's true!"
                 ] .+ Introduce .+ Context .+ PreCondition
-         , external "ww-AssA-to-AssB" (promoteExprR . wwAssAimpliesAssB . extractR :: RewriteH Core -> RewriteH Core)
+         , external "ww-AssA-to-AssB" (promoteExprR . wwAssAimpliesAssB . extractR :: RewriteH LCore -> RewriteH LCore)
                    [ "Convert a proof of worker/wrapper Assumption A into a proof of worker/wrapper Assumption B."
                    ]
-         , external "ww-AssB-to-AssC" (promoteExprR . wwAssBimpliesAssC . extractR :: RewriteH Core -> RewriteH Core)
+         , external "ww-AssB-to-AssC" (promoteExprR . wwAssBimpliesAssC . extractR :: RewriteH LCore -> RewriteH LCore)
                    [ "Convert a proof of worker/wrapper Assumption B into a proof of worker/wrapper Assumption C."
                    ]
-         , external "ww-AssA-to-AssC" (promoteExprR . wwAssAimpliesAssC . extractR :: RewriteH Core -> RewriteH Core)
+         , external "ww-AssA-to-AssC" (promoteExprR . wwAssAimpliesAssC . extractR :: RewriteH LCore -> RewriteH LCore)
                    [ "Convert a proof of worker/wrapper Assumption A into a proof of worker/wrapper Assumption C."
                    ]
-         , external "ww-generate-fusion" (wwGenerateFusionR . mkWWAssC :: RewriteH Core -> RewriteH Core)
+         , external "ww-generate-fusion" (wwGenerateFusionT . mkWWAssC :: RewriteH LCore -> TransformH LCore ())
                    [ "Given a proof of Assumption C (fix A (\\ a -> wrap (unwrap (f a))) ==> fix A f), then",
                      "execute this command on \"work = unwrap (f (wrap work))\" to enable the \"ww-fusion\" rule thereafter.",
                      "Note that this is performed automatically as part of \"ww-split\"."
                    ] .+ Experiment .+ TODO
-         , external "ww-generate-fusion-unsafe" (wwGenerateFusionR Nothing :: RewriteH Core)
+         , external "ww-generate-fusion-unsafe" (wwGenerateFusionT Nothing :: TransformH LCore ())
                    [ "Execute this command on \"work = unwrap (f (wrap work))\" to enable the \"ww-fusion\" rule thereafter.",
                      "The precondition \"fix A (wrap . unwrap . f) == fix A f\" is expected to hold.",
                      "Note that this is performed automatically as part of \"ww-split\"."
                    ] .+ Experiment .+ TODO
-         , external "ww-fusion" (promoteExprBiR wwFusion :: BiRewriteH Core)
+         , external "ww-fusion" (promoteExprBiR wwFusion :: BiRewriteH LCore)
                 [ "Worker/Wrapper Fusion",
                   "unwrap (wrap work)  <==>  work",
                   "Note: you are required to have previously executed the command \"ww-generate-fusion\" on the definition",
@@ -156,7 +156,7 @@
                 ] .+ Introduce .+ Context .+ PreCondition .+ TODO
          ]
   where
-    mkWWAssC :: RewriteH Core -> Maybe WWAssumption
+    mkWWAssC :: RewriteH LCore -> Maybe WWAssumption
     mkWWAssC r = Just (WWAssumption C (extractR r))
 
 --------------------------------------------------------------------------------------------------
@@ -203,9 +203,9 @@
 wwFusionBR =
     beforeBiR (prefixFailMsg "worker/wrapper fusion failed: " $
                withPatFailMsg "malformed WW Fusion rule." $
-               do Def w (App unwrap (App _f (App wrap (Var w')))) <- constT (lookupDef workLabel)
-                  guardMsg (w == w') "malformed WW Fusion rule."
-                  return (wrap,unwrap,Var w)
+               do Quantified _ (Equiv w (App unwrap (App _f (App wrap w')))) <- constT (lemmaQ <$> findLemma workLabel)
+                  guardMsg (exprSyntaxEq w w') "malformed WW Fusion rule."
+                  return (wrap,unwrap,w)
               )
               (\ (wrap,unwrap,work) -> bidirectional (fusL wrap unwrap work) (fusR wrap unwrap work))
   where
@@ -237,14 +237,14 @@
 -- | Save the recursive definition of work in the stash, so that we can later verify uses of 'wwFusionBR'.
 --   Must be applied to a definition of the form: @work = unwrap (f (wrap work))@
 --   Note that this is performed automatically as part of 'wwSplitR'.
-wwGenerateFusionR :: Maybe WWAssumption -> RewriteH Core
-wwGenerateFusionR mAss =
+wwGenerateFusionT :: Maybe WWAssumption -> TransformH LCore ()
+wwGenerateFusionT mAss =
     prefixFailMsg "generate WW fusion failed: " $
     withPatFailMsg wrongForm $
-    do Def w (App unwrap (App f (App wrap (Var w')))) <- projectT
+    do Def w e@(App unwrap (App f (App wrap (Var w')))) <- projectT
        guardMsg (w == w') wrongForm
        whenJust (verifyWWAss wrap unwrap f) mAss
-       rememberR workLabel
+       insertLemmaT workLabel $ Lemma (Quantified [] (Equiv (varToCoreExpr w) e)) Proven NotUsed False
   where
     wrongForm = "definition does not have the form: work = unwrap (f (wrap work))"
 
@@ -260,7 +260,7 @@
                                           >>> appAllR idR ( unfoldNameR (fromString "Data.Function.fix")
                                                             >>> alphaLetWithR ["work"]
                                                             >>> letRecAllR (\ _ -> defAllR idR (betaReduceR >>> letNonRecSubstR)
-                                                                                   >>> extractR (wwGenerateFusionR mAss)
+                                                                                   >>> (extractT (wwGenerateFusionT mAss) >> idR)
                                                                            )
                                                                            idR
                                                           )
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
@@ -7,7 +7,7 @@
     , wwResultFacBR
     , wwResultSplitR
     , wwResultSplitStaticArg
-    , wwResultGenerateFusionR
+    , wwResultGenerateFusionT
     , wwResultFusionBR
     , wwResultAssA
     , wwResultAssB
@@ -24,6 +24,7 @@
 import HERMIT.External
 import HERMIT.GHC
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
 import HERMIT.Name
 import HERMIT.ParserCore
@@ -47,21 +48,21 @@
 externals =
          [
            external "ww-result-factorisation" ((\ abs rep assC -> promoteExprBiR $ wwFac (mkWWAssC assC) abs rep)
-                                          :: CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                          :: CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Factorisation (Result Variant)",
                   "For any \"f :: (X -> A) -> (X -> A)\", and given \"abs :: B -> A\" and \"rep :: A -> B\" as arguments,",
                   "and a proof of Assumption C (fix (X -> A) (\\ h x -> abs (rep (f h x))) ==> fix (X->A) f), then",
                   "fix (X->A) f  ==>  \\ x1 -> abs (fix (X->B) (\\ h x2 -> rep (f (\\ x3 -> abs (h x3)) x2)) x1"
                 ] .+ Introduce .+ Context
          , external "ww-result-factorisation-unsafe" ((\ abs rep -> promoteExprBiR $ wwFac Nothing abs rep)
-                                               :: CoreString -> CoreString -> BiRewriteH Core)
+                                               :: CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Factorisation (Result Variant)",
                   "For any \"f :: (X -> A) -> (X -> A)\", and given \"abs :: B -> A\" and \"rep :: A -> B\" as arguments, then",
                   "fix (X->A) f  ==>  \\ x1 -> abs (fix (X->B) (\\ h x2 -> rep (f (\\ x3 -> abs (h x3)) x2)) x1",
                   "Note: the pre-condition \"fix (X -> A) (\\ h x -> abs (rep (f h x))) == fix (X->A) f\" is expected to hold."
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-result-split" ((\ abs rep assC -> promoteDefR $ wwSplit (mkWWAssC assC) abs rep)
-                                  :: CoreString -> CoreString -> RewriteH Core -> RewriteH Core)
+                                  :: CoreString -> CoreString -> RewriteH LCore -> RewriteH LCore)
                 [ "Worker/Wrapper Split (Result Variant)",
                   "For any \"prog :: X -> A\", and given \"abs :: B -> A\" and \"rep :: A -> B\" as arguments,",
                   "and a proof of Assumption C (fix (X->A) (\\ h x -> abs (rep (f h x))) ==> fix (X->A) f), then",
@@ -70,88 +71,88 @@
                   "                              in \\ x0 -> abs (work x0)"
                 ] .+ Introduce .+ Context
          , external "ww-result-split-unsafe" ((\ abs rep -> promoteDefR $ wwSplit Nothing abs rep)
-                                       :: CoreString -> CoreString -> RewriteH Core)
+                                       :: CoreString -> CoreString -> RewriteH LCore)
                 [ "Unsafe Worker/Wrapper Split (Result Variant)",
                   "For any \"prog :: X -> A\", and given \"abs :: B -> A\" and \"rep :: A -> B\" as arguments, then",
                   "prog = expr  ==>  prog = let f = \\ prog -> expr",
                   "                          in let work = \\ x1 -> rep (f (\\ x2 -> abs (work x2)) x1)",
                   "                              in \\ x0 -> abs (work x0)",
                   "Note: the pre-condition \"fix (X->A) (\\ h x -> abs (rep (f h x))) == fix (X->A) f\" is expected to hold."
-                ] .+ Introduce .+ Context .+ PreCondition
+                ] .+ Introduce .+ Context .+ PreCondition .+ Unsafe
          , external "ww-result-split-static-arg" ((\ n is abs rep assC -> promoteDefR $ wwResultSplitStaticArg n is (mkWWAssC assC) abs rep)
-                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH Core -> RewriteH Core)
+                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH LCore -> RewriteH LCore)
                 [ "Worker/Wrapper Split - Static Argument Variant (Result Variant)",
                   "Perform the static argument transformation on the first n arguments, then perform the worker/wrapper split,",
                   "applying the given abs and rep functions to the specified (by index) static arguments before use."
                 ] .+ Introduce .+ Context
          , external "ww-result-split-static-arg-unsafe" ((\ n is abs rep -> promoteDefR $ wwResultSplitStaticArg n is Nothing abs rep)
-                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH Core)
+                                      :: Int -> [Int] -> CoreString -> CoreString -> RewriteH LCore)
                 [ "Unsafe Worker/Wrapper Split - Static Argument Variant (Result Variant)",
                   "Perform the static argument transformation on the first n arguments, then perform the (unsafe) worker/wrapper split,",
                   "applying the given abs and rep functions to the specified (by index) static arguments before use."
-                ] .+ Introduce .+ Context .+ PreCondition
+                ] .+ Introduce .+ Context .+ PreCondition .+ Unsafe
          , external "ww-result-assumption-A" ((\ abs rep assA -> promoteExprBiR $ wwA (Just $ extractR assA) abs rep)
-                                       :: CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                       :: CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Assumption A (Result Variant)",
                   "For a \"abs :: B -> A\" and a \"rep :: A -> B\",",
                   "and given a proof of \"abs (rep a)  ==>  a\", then",
                   "abs (rep a)  <==>  a"
                 ] .+ Introduce .+ Context
          , external "ww-result-assumption-B" ((\ abs rep f assB -> promoteExprBiR $ wwB (Just $ extractR assB) abs rep f)
-                                       :: CoreString -> CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                       :: CoreString -> CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Assumption B (Result Variant)",
                   "For a \"abs :: B -> A\", an \"rep :: A -> B\", and an \"f :: (X -> A) -> X -> A\",",
                   "and given a proof of \"abs (rep (f h x))  ==>  f h x\", then",
                   "abs (rep (f h x))  <==>  f h x"
                 ] .+ Introduce .+ Context
          , external "ww-result-assumption-C" ((\ abs rep f assC -> promoteExprBiR $ wwC (Just $ extractR assC) abs rep f)
-                                       :: CoreString -> CoreString -> CoreString -> RewriteH Core -> BiRewriteH Core)
+                                       :: CoreString -> CoreString -> CoreString -> RewriteH LCore -> BiRewriteH LCore)
                 [ "Worker/Wrapper Assumption C (Result Variant)",
                   "For a \"abs :: B -> A\", an \"rep :: A -> B\", and an \"f :: (X -> A) -> X -> A\",",
                   "and given a proof of \"fix (X->A) (\\ h x -> abs (rep (f h x))) ==> fix (X->A) f\", then",
                   "fix (X->A) (\\ h x -> abs (rep (f h x)))  <==>  fix (X->A) f"
                 ] .+ Introduce .+ Context
          , external "ww-result-assumption-A-unsafe" ((\ abs rep -> promoteExprBiR $ wwA Nothing abs rep)
-                                              :: CoreString -> CoreString -> BiRewriteH Core)
+                                              :: CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Assumption A (Result Variant)",
                   "For a \"abs :: B -> A\" and a \"rep :: A -> B\", then",
                   "abs (rep a)  <==>  a",
                   "Note: only use this if it's true!"
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-result-assumption-B-unsafe" ((\ abs rep f -> promoteExprBiR $ wwB Nothing abs rep f)
-                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH Core)
+                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Assumption B (Result Variant)",
                   "For a \"abs :: B -> A\", an \"rep :: A -> B\", and an \"f :: (X -> A) -> X -> A\", then",
                   "abs (rep (f h x))  <==>  f h x",
                   "Note: only use this if it's true!"
                 ] .+ Introduce .+ Context .+ PreCondition
          , external "ww-result-assumption-C-unsafe" ((\ abs rep f -> promoteExprBiR $ wwC Nothing abs rep f)
-                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH Core)
+                                              :: CoreString -> CoreString -> CoreString -> BiRewriteH LCore)
                 [ "Unsafe Worker/Wrapper Assumption C (Result Variant)",
                   "For a \"abs :: B -> A\", an \"rep :: A -> B\", and an \"f :: (X -> A) -> X -> A\", then",
                   "fix (X->A) (\\ h x -> abs (rep (f h x)))  <==>  fix (X->A) f",
                   "Note: only use this if it's true!"
                 ] .+ Introduce .+ Context .+ PreCondition
-         , external "ww-result-AssA-to-AssB" (promoteExprR . wwResultAssAimpliesAssB . extractR :: RewriteH Core -> RewriteH Core)
+         , external "ww-result-AssA-to-AssB" (promoteExprR . wwResultAssAimpliesAssB . extractR :: RewriteH LCore -> RewriteH LCore)
                    [ "Convert a proof of worker/wrapper Assumption A into a proof of worker/wrapper Assumption B."
                    ]
-         , external "ww-result-AssB-to-AssC" (promoteExprR . wwResultAssBimpliesAssC . extractR :: RewriteH Core -> RewriteH Core)
+         , external "ww-result-AssB-to-AssC" (promoteExprR . wwResultAssBimpliesAssC . extractR :: RewriteH LCore -> RewriteH LCore)
                    [ "Convert a proof of worker/wrapper Assumption B into a proof of worker/wrapper Assumption C."
                    ]
-         , external "ww-result-AssA-to-AssC" (promoteExprR . wwResultAssAimpliesAssC . extractR :: RewriteH Core -> RewriteH Core)
+         , external "ww-result-AssA-to-AssC" (promoteExprR . wwResultAssAimpliesAssC . extractR :: RewriteH LCore -> RewriteH LCore)
                    [ "Convert a proof of worker/wrapper Assumption A into a proof of worker/wrapper Assumption C."
                    ]
-         , external "ww-result-generate-fusion" (wwResultGenerateFusionR . mkWWAssC :: RewriteH Core -> RewriteH Core)
+         , external "ww-result-generate-fusion" (wwResultGenerateFusionT . mkWWAssC :: RewriteH LCore -> TransformH LCore ())
                    [ "Given a proof of Assumption C (fix (X->A) (\\ h x -> abs (rep (f h x))) ==> fix (X->A) f), then",
                      "execute this command on \"work = \\ x1 -> rep (f (\\ x2 -> abs (work x2)) x1)\" to enable the \"ww-result-fusion\" rule thereafter.",
                      "Note that this is performed automatically as part of \"ww-result-split\"."
                    ] .+ Experiment .+ TODO
-         , external "ww-result-generate-fusion-unsafe" (wwResultGenerateFusionR Nothing :: RewriteH Core)
+         , external "ww-result-generate-fusion-unsafe" (wwResultGenerateFusionT Nothing :: TransformH LCore ())
                    [ "Execute this command on \"work = \\ x1 -> rep (f (\\ x2 -> abs (work x2)) x1)\" to enable the \"ww-fusion\" rule thereafter.",
                      "The precondition \"fix (X->A) (\\ h x -> abs (rep (f h x))) == fix (X->A) f\" is expected to hold.",
                      "Note that this is performed automatically as part of \"ww-result-split\"."
                    ] .+ Experiment .+ TODO
-         , external "ww-result-fusion" (promoteExprBiR wwFusion :: BiRewriteH Core)
+         , external "ww-result-fusion" (promoteExprBiR wwFusion :: BiRewriteH LCore)
                 [ "Worker/Wrapper Fusion (Result Variant)",
                   "rep (abs (work x))  <==>  work x",
                   "Note: you are required to have previously executed the command \"ww-generate-fusion\" on the definition",
@@ -159,7 +160,7 @@
                 ] .+ Introduce .+ Context .+ PreCondition .+ TODO
          ]
   where
-    mkWWAssC :: RewriteH Core -> Maybe WWAssumption
+    mkWWAssC :: RewriteH LCore -> Maybe WWAssumption
     mkWWAssC r = Just (WWAssumption C (extractR r))
 
 --------------------------------------------------------------------------------------------------
@@ -223,14 +224,15 @@
 wwResultFusionBR =
     beforeBiR (prefixFailMsg "worker/wrapper fusion failed: " $
                withPatFailMsg "malformed WW Fusion rule." $
-               do Def w (Lam x1 (App rep
-                                     (App (App _ (Lam x2 (App abs (App (Var w') (Var x2')))))
+               do Quantified _ (Equiv w
+                        (Lam x1 (App rep
+                                     (App (App _ (Lam x2 (App abs (App w' (Var x2')))))
                                           (Var x1')
                                      )
                                 )
-                        ) <- constT (lookupDef workLabel)
-                  guardMsg (w == w' && x1 == x1' && x2 == x2') "malformed WW Fusion rule."
-                  return (abs,rep,Var w)
+                        )) <- constT (lemmaQ <$> findLemma workLabel)
+                  guardMsg (exprSyntaxEq w w' && x1 == x1' && x2 == x2') "malformed WW Fusion rule."
+                  return (abs,rep,w)
               )
               (\ (abs,rep,work) -> bidirectional (fusL abs rep work) (fusR abs rep work))
   where
@@ -262,19 +264,19 @@
 -- | Save the recursive definition of work in the stash, so that we can later verify uses of 'wwResultFusionBR'.
 --   Must be applied to a definition of the form: @work = \\ x1 -> rep (f (\\ x2 -> abs (work x2)) x1)@
 --   Note that this is performed automatically as part of 'wwResultSplitR'.
-wwResultGenerateFusionR :: Maybe WWAssumption -> RewriteH Core
-wwResultGenerateFusionR mAss =
+wwResultGenerateFusionT :: Maybe WWAssumption -> TransformH LCore ()
+wwResultGenerateFusionT mAss =
     prefixFailMsg "generate WW fusion failed: " $
     withPatFailMsg wrongForm $
-    do Def w (Lam x1 (App rep
+    do Def w e@(Lam x1 (App rep
                           (App (App f (Lam x2 (App abs (App (Var w') (Var x2')))))
                                (Var x1')
                           )
-                     )
-             ) <- projectT
+                       )
+               ) <- projectT
        guardMsg (w == w' && x1 == x1' && x2 == x2') wrongForm
        whenJust (verifyWWAss abs rep f) mAss
-       rememberR workLabel
+       insertLemmaT workLabel $ Lemma (Quantified [] (Equiv (varToCoreExpr w) e)) Proven NotUsed False
   where
     wrongForm = "definition does not have the form: work = \\ x1 -> rep (f (\\ x2 -> abs (work x2)) x1)"
 
@@ -291,7 +293,7 @@
                                           >>> lamAllR idR (appAllR idR (appAllR ( unfoldNameR (fromString "Data.Function.fix")
                                                                                   >>> alphaLetWithR ["work"]
                                                                                   >>> letRecAllR (\ _ -> defAllR idR (betaReduceR >>> letNonRecSubstR)
-                                                                                                         >>> extractR (wwResultGenerateFusionR mAss)
+                                                                                                         >>> (extractT (wwResultGenerateFusionT mAss) >> idR)
                                                                                                  )
                                                                                                  idR
                                                                                 )
diff --git a/src/HERMIT/External.hs b/src/HERMIT/External.hs
--- a/src/HERMIT/External.hs
+++ b/src/HERMIT/External.hs
@@ -26,26 +26,29 @@
     , dictionaryOfTags
       -- * Boxes
       -- | Boxes are used by the 'Extern' class.
-    , BiRewriteCoreBox(..)
     , CoreString(..)
     , CrumbBox(..)
     , IntBox(..)
     , IntListBox(..)
     , PathBox(..)
-    , RewriteCoreBox(..)
-    , RewriteCoreListBox(..)
-    , RewriteCoreTCBox(..)
-    , RewriteEqualityBox(..)
     , StringBox(..)
     , StringListBox(..)
     , TagBox(..)
-    , TransformCoreCheckBox(..)
-    , TransformCorePathBox(..)
-    , TransformCoreStringBox(..)
-    , TransformCoreTCCheckBox(..)
-    , TransformCoreTCPathBox(..)
-    , TransformCoreTCStringBox(..)
-    , TransformEqualityStringBox(..)
+      -- ** LCore Boxes
+    , TransformLCoreStringBox(..)
+    , TransformLCoreUnitBox(..)
+    , TransformLCorePathBox(..)
+    , RewriteLCoreBox(..)
+    , BiRewriteLCoreBox(..)
+    , RewriteLCoreListBox(..)
+      -- ** LCoreTC Boxes
+    , TransformLCoreTCStringBox(..)
+    , TransformLCoreTCUnitBox(..)
+    , TransformLCoreTCLCoreBox(..)
+    , TransformLCoreTCPathBox(..)
+    , RewriteLCoreTCBox(..)
+    , BiRewriteLCoreTCBox(..)
+    , RewriteLCoreTCListBox(..)
     ) where
 
 import Data.Map hiding (map)
@@ -56,7 +59,7 @@
 import HERMIT.Core
 import HERMIT.Context (LocalPathH)
 import HERMIT.Kure
-import HERMIT.Monad
+import HERMIT.Lemma
 
 -----------------------------------------------------------------
 
@@ -90,6 +93,8 @@
             | Context        -- ^ A command that uses its context, such as inlining.
             | Unsafe         -- ^ Commands that are not type safe (may cause Core Lint to fail),
                              --   or may otherwise change the semantics of the program.
+                             --   Only available in unsafe mode!
+            | Safe           -- ^ Include in Strict Safety mode (currently unused)
             | Proof          -- ^ Commands related to proving lemmas.
 
             | TODO           -- ^ An incomplete or potentially buggy command.
@@ -235,12 +240,13 @@
 
 -- | Remove the word 'Box' from a string.
 deBoxify :: String -> String
-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 []                        = []
+deBoxify s | "CLSBox -> "        `isPrefixOf` s = go (drop 10 s)
+           | "PrettyPrinter -> " `isPrefixOf` s = go (drop 17 s)
+           | otherwise = go s
+    where go xs
+            | "Box" `isPrefixOf` xs = go (drop 3 xs)
+          go (x:xs)                 = x : go xs
+          go []                     = []
 
 externTypeArgResString :: External -> ([String], String)
 externTypeArgResString e = (map (deBoxify . show) aTys, deBoxify (show rTy))
@@ -301,182 +307,181 @@
 
 -----------------------------------------------------------------
 
-data RewriteCoreBox = RewriteCoreBox (RewriteH Core) deriving Typeable
+-- TODO: Considering unifying CrumbBox and PathBox under TransformLCoreTCPathBox.
+data CrumbBox = CrumbBox Crumb deriving Typeable
 
-instance Extern (RewriteH Core) where
-    type Box (RewriteH Core) = RewriteCoreBox
-    box = RewriteCoreBox
-    unbox (RewriteCoreBox r) = r
+instance Extern Crumb where
+    type Box Crumb = CrumbBox
+    box = CrumbBox
+    unbox (CrumbBox cr) = cr
 
 -----------------------------------------------------------------
 
-data RewriteCoreTCBox = RewriteCoreTCBox (RewriteH CoreTC) deriving Typeable
+data PathBox = PathBox LocalPathH deriving Typeable
 
-instance Extern (RewriteH CoreTC) where
-    type Box (RewriteH CoreTC) = RewriteCoreTCBox
-    box = RewriteCoreTCBox
-    unbox (RewriteCoreTCBox r) = r
+instance Extern LocalPathH where
+    type Box LocalPathH = PathBox
+    box = PathBox
+    unbox (PathBox p) = p
 
 -----------------------------------------------------------------
 
-data BiRewriteCoreBox = BiRewriteCoreBox (BiRewriteH Core) deriving Typeable
+newtype CoreString = CoreString { unCoreString :: String } deriving Typeable
 
-instance Extern (BiRewriteH Core) where
-    type Box (BiRewriteH Core) = BiRewriteCoreBox
-    box = BiRewriteCoreBox
-    unbox (BiRewriteCoreBox b) = b
+instance Extern CoreString where
+    type Box CoreString = CoreString
+    box = id
+    unbox = id
 
 -----------------------------------------------------------------
 
-data TransformCoreTCStringBox = TransformCoreTCStringBox (TransformH CoreTC String) deriving Typeable
+data StringBox = StringBox String deriving Typeable
 
-instance Extern (TransformH CoreTC String) where
-    type Box (TransformH CoreTC String) = TransformCoreTCStringBox
-    box = TransformCoreTCStringBox
-    unbox (TransformCoreTCStringBox t) = t
+instance Extern String where
+    type Box String = StringBox
+    box = StringBox
+    unbox (StringBox s) = s
 
 -----------------------------------------------------------------
 
-data TransformCoreStringBox = TransformCoreStringBox (TransformH Core String) deriving Typeable
+data StringListBox = StringListBox [String] deriving Typeable
 
-instance Extern (TransformH Core String) where
-    type Box (TransformH Core String) = TransformCoreStringBox
-    box = TransformCoreStringBox
-    unbox (TransformCoreStringBox t) = t
+instance Extern [String] where
+    type Box [String] = StringListBox
+    box = StringListBox
+    unbox (StringListBox l) = l
 
 -----------------------------------------------------------------
 
-data TransformCoreTCCheckBox = TransformCoreTCCheckBox (TransformH CoreTC ()) deriving Typeable
+data IntListBox = IntListBox [Int] deriving Typeable
 
-instance Extern (TransformH CoreTC ()) where
-    type Box (TransformH CoreTC ()) = TransformCoreTCCheckBox
-    box = TransformCoreTCCheckBox
-    unbox (TransformCoreTCCheckBox t) = t
+instance Extern [Int] where
+    type Box [Int] = IntListBox
+    box = IntListBox
+    unbox (IntListBox l) = l
 
 -----------------------------------------------------------------
 
-data TransformCoreCheckBox = TransformCoreCheckBox (TransformH Core ()) deriving Typeable
-
-instance Extern (TransformH Core ()) where
-    type Box (TransformH Core ()) = TransformCoreCheckBox
-    box = TransformCoreCheckBox
-    unbox (TransformCoreCheckBox t) = t
+instance Extern LemmaName where
+    type Box LemmaName = LemmaName
+    box = id
+    unbox = id
 
 -----------------------------------------------------------------
 
--- TODO: We now have CrumbBoc, PathBox and TransformCorePathBox.
---       Ints are interpreted as a TransformCorePathBox.
---       This all needs cleaning up.
-
-data CrumbBox = CrumbBox Crumb deriving Typeable
+data RewriteLCoreBox = RewriteLCoreBox (RewriteH LCore) deriving Typeable
 
-instance Extern Crumb where
-    type Box Crumb = CrumbBox
-    box = CrumbBox
-    unbox (CrumbBox cr) = cr
+instance Extern (RewriteH LCore) where
+    type Box (RewriteH LCore) = RewriteLCoreBox
+    box = RewriteLCoreBox
+    unbox (RewriteLCoreBox r) = r
 
 -----------------------------------------------------------------
 
-data PathBox = PathBox LocalPathH deriving Typeable
+data TransformLCoreStringBox = TransformLCoreStringBox (TransformH LCore String) deriving Typeable
 
-instance Extern LocalPathH where
-    type Box LocalPathH = PathBox
-    box = PathBox
-    unbox (PathBox p) = p
+instance Extern (TransformH LCore String) where
+    type Box (TransformH LCore String) = TransformLCoreStringBox
+    box = TransformLCoreStringBox
+    unbox (TransformLCoreStringBox t) = t
 
 -----------------------------------------------------------------
 
-data TransformCorePathBox = TransformCorePathBox (TransformH Core LocalPathH) deriving Typeable
+data TransformLCoreUnitBox = TransformLCoreUnitBox (TransformH LCore ()) deriving Typeable
 
-instance Extern (TransformH Core LocalPathH) where
-    type Box (TransformH Core LocalPathH) = TransformCorePathBox
-    box = TransformCorePathBox
-    unbox (TransformCorePathBox t) = t
+instance Extern (TransformH LCore ()) where
+    type Box (TransformH LCore ()) = TransformLCoreUnitBox
+    box = TransformLCoreUnitBox
+    unbox (TransformLCoreUnitBox t) = t
 
 -----------------------------------------------------------------
 
-data TransformCoreTCPathBox = TransformCoreTCPathBox (TransformH CoreTC LocalPathH) deriving Typeable
+data TransformLCorePathBox = TransformLCorePathBox (TransformH LCore LocalPathH) deriving Typeable
 
-instance Extern (TransformH CoreTC LocalPathH) where
-    type Box (TransformH CoreTC LocalPathH) = TransformCoreTCPathBox
-    box = TransformCoreTCPathBox
-    unbox (TransformCoreTCPathBox t) = t
+instance Extern (TransformH LCore LocalPathH) where
+    type Box (TransformH LCore LocalPathH) = TransformLCorePathBox
+    box = TransformLCorePathBox
+    unbox (TransformLCorePathBox t) = t
 
 -----------------------------------------------------------------
 
-newtype CoreString = CoreString { unCoreString :: String } deriving Typeable
+data BiRewriteLCoreBox = BiRewriteLCoreBox (BiRewriteH LCore) deriving Typeable
 
-instance Extern CoreString where
-    type Box CoreString = CoreString
-    box = id
-    unbox = id
+instance Extern (BiRewriteH LCore) where
+    type Box (BiRewriteH LCore) = BiRewriteLCoreBox
+    box = BiRewriteLCoreBox
+    unbox (BiRewriteLCoreBox b) = b
 
 -----------------------------------------------------------------
 
-data StringBox = StringBox String deriving Typeable
+data RewriteLCoreListBox = RewriteLCoreListBox [RewriteH LCore] deriving Typeable
 
-instance Extern String where
-    type Box String = StringBox
-    box = StringBox
-    unbox (StringBox s) = s
+instance Extern [RewriteH LCore] where
+    type Box [RewriteH LCore] = RewriteLCoreListBox
+    box = RewriteLCoreListBox
+    unbox (RewriteLCoreListBox l) = l
 
 -----------------------------------------------------------------
 
-data StringListBox = StringListBox [String] deriving Typeable
+data RewriteLCoreTCBox = RewriteLCoreTCBox (RewriteH LCoreTC) deriving Typeable
 
-instance Extern [String] where
-    type Box [String] = StringListBox
-    box = StringListBox
-    unbox (StringListBox l) = l
+instance Extern (RewriteH LCoreTC) where
+    type Box (RewriteH LCoreTC) = RewriteLCoreTCBox
+    box = RewriteLCoreTCBox
+    unbox (RewriteLCoreTCBox r) = r
 
 -----------------------------------------------------------------
 
-data IntListBox = IntListBox [Int] deriving Typeable
+data TransformLCoreTCStringBox = TransformLCoreTCStringBox (TransformH LCoreTC String) deriving Typeable
 
-instance Extern [Int] where
-    type Box [Int] = IntListBox
-    box = IntListBox
-    unbox (IntListBox l) = l
+instance Extern (TransformH LCoreTC String) where
+    type Box (TransformH LCoreTC String) = TransformLCoreTCStringBox
+    box = TransformLCoreTCStringBox
+    unbox (TransformLCoreTCStringBox t) = t
 
 -----------------------------------------------------------------
 
-data RewriteCoreListBox = RewriteCoreListBox [RewriteH Core] deriving Typeable
+data TransformLCoreTCUnitBox = TransformLCoreTCUnitBox (TransformH LCoreTC ()) deriving Typeable
 
-instance Extern [RewriteH Core] where
-    type Box [RewriteH Core] = RewriteCoreListBox
-    box = RewriteCoreListBox
-    unbox (RewriteCoreListBox l) = l
+instance Extern (TransformH LCoreTC ()) where
+    type Box (TransformH LCoreTC ()) = TransformLCoreTCUnitBox
+    box = TransformLCoreTCUnitBox
+    unbox (TransformLCoreTCUnitBox t) = t
 
 -----------------------------------------------------------------
 
-instance Extern RememberedName where
-    type Box RememberedName = RememberedName
-    box = id
-    unbox = id
+data TransformLCoreTCLCoreBox = TransformLCoreTCLCoreBox (TransformH LCoreTC LCore) deriving Typeable
 
+instance Extern (TransformH LCoreTC LCore) where
+    type Box (TransformH LCoreTC LCore) = TransformLCoreTCLCoreBox
+    box = TransformLCoreTCLCoreBox
+    unbox (TransformLCoreTCLCoreBox t) = t
+
 -----------------------------------------------------------------
 
-instance Extern LemmaName where
-    type Box LemmaName = LemmaName
-    box = id
-    unbox = id
+data TransformLCoreTCPathBox = TransformLCoreTCPathBox (TransformH LCoreTC LocalPathH) deriving Typeable
 
+instance Extern (TransformH LCoreTC LocalPathH) where
+    type Box (TransformH LCoreTC LocalPathH) = TransformLCoreTCPathBox
+    box = TransformLCoreTCPathBox
+    unbox (TransformLCoreTCPathBox t) = t
+
 -----------------------------------------------------------------
 
-data RewriteEqualityBox = RewriteEqualityBox (RewriteH Equality) deriving Typeable
+data BiRewriteLCoreTCBox = BiRewriteLCoreTCBox (BiRewriteH LCoreTC) deriving Typeable
 
-instance Extern (RewriteH Equality) where
-    type Box (RewriteH Equality) = RewriteEqualityBox
-    box = RewriteEqualityBox
-    unbox (RewriteEqualityBox r) = r
+instance Extern (BiRewriteH LCoreTC) where
+    type Box (BiRewriteH LCoreTC) = BiRewriteLCoreTCBox
+    box = BiRewriteLCoreTCBox
+    unbox (BiRewriteLCoreTCBox b) = b
 
 -----------------------------------------------------------------
 
-data TransformEqualityStringBox = TransformEqualityStringBox (TransformH Equality String) deriving Typeable
+data RewriteLCoreTCListBox = RewriteLCoreTCListBox [RewriteH LCoreTC] deriving Typeable
 
-instance Extern (TransformH Equality String) where
-    type Box (TransformH Equality String) = TransformEqualityStringBox
-    box = TransformEqualityStringBox
-    unbox (TransformEqualityStringBox t) = t
+instance Extern [RewriteH LCoreTC] where
+    type Box [RewriteH LCoreTC] = RewriteLCoreTCListBox
+    box = RewriteLCoreTCListBox
+    unbox (RewriteLCoreTCListBox l) = l
 
 -----------------------------------------------------------------
diff --git a/src/HERMIT/GHC.hs b/src/HERMIT/GHC.hs
--- a/src/HERMIT/GHC.hs
+++ b/src/HERMIT/GHC.hs
@@ -19,6 +19,7 @@
     , TyLit(..)
     , GhcException(..)
     , throwGhcException
+    , throwCmdLineErrorS
     , exprArity
     , occurAnalyseExpr_NoBinderSwap
     , isKind
@@ -44,6 +45,7 @@
     , module Class
     , module DsBinds
     , module DsMonad
+    , module DynamicLoading
     , module ErrUtils
     , module PrelNames
     , module TcEnv
@@ -65,12 +67,13 @@
 import qualified CoreMonad -- for getHscEnv
 import           DsBinds (dsEvBinds)
 import           DsMonad (DsM, initDsTc)
+import           DynamicLoading (forceLoadTyCon, getValueSafely, lookupRdrNameInModuleForPlugins)
 import           Encoding (zEncodeString)
 import           ErrUtils (pprErrMsgBag)
 import           Finder (findImportedModule, cannotFindModule)
 -- we hide these so that they don't get inadvertently used.
 -- several are redefined in Core.hs and elsewhere
-import           GhcPlugins hiding (exprFreeVars, exprFreeIds, bindFreeVars, PluginPass, getHscEnv, RuleName)
+import           GhcPlugins hiding (exprSomeFreeVars, exprFreeVars, exprFreeIds, bindFreeVars, getHscEnv, RuleName)
 import           Kind (isKind,isLiftedTypeKindCon)
 import           LoadIface (loadSysInterface)
 import qualified OccName -- for varName
diff --git a/src/HERMIT/Kernel.hs b/src/HERMIT/Kernel.hs
--- a/src/HERMIT/Kernel.hs
+++ b/src/HERMIT/Kernel.hs
@@ -1,149 +1,236 @@
-{-# LANGUAGE RankNTypes, ScopedTypeVariables, TupleSections, GADTs #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module HERMIT.Kernel
     ( -- * The HERMIT Kernel
       AST
+    , firstAST
+    , ASTMap
     , Kernel
     , KernelEnv(..)
     , hermitKernel
+    , CommitMsg(..)
+      -- ** Kernel Interface
     , resumeK
     , abortK
     , applyK
     , queryK
     , deleteK
     , listK
+    , tellK
     ) where
 
-import Prelude hiding (lookup)
+import Prelude hiding (lookup, null)
 
-import HERMIT.Context
-import HERMIT.Monad
-import HERMIT.Kure
-import HERMIT.GHC hiding (singleton, empty)
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.IO.Class
 
+import Data.IORef
 import Data.Map
-import Control.Concurrent
+import Data.Typeable
 
--- | A 'Kernel' is a repository for complete Core syntax trees ('ModGuts').
---   For now, operations on a 'Kernel' are sequential, but later
---   it will be possible to have two 'applyK's running in parallel.
+import HERMIT.Context
+import HERMIT.External
+import HERMIT.GHC hiding (singleton, empty)
+import HERMIT.Kure
+import HERMIT.Lemma
+import HERMIT.Monad
+
+-- | A 'Kernel' is a repository for complete Core syntax trees ('ModGuts') and Lemmas.
 data Kernel = Kernel
-  { resumeK ::            AST                                      -> IO ()          -- ^ Halt the 'Kernel' and return control to GHC, which compiles the specified 'AST'.
-  , abortK  ::                                                        IO ()          -- ^ Halt the 'Kernel' and abort GHC without compiling.
-  , applyK  ::            AST -> RewriteH ModGuts     -> KernelEnv -> IO (KureM AST) -- ^ Apply a 'Rewrite' to the specified 'AST' and return a handle to the resulting 'AST'.
-  , queryK  :: forall a . AST -> TransformH ModGuts a -> KernelEnv -> IO (KureM a)   -- ^ Apply a 'TransformH' to the 'AST' and return the resulting value.
-  , deleteK ::            AST                                      -> IO ()          -- ^ Delete the internal record of the specified 'AST'.
-  , listK   ::                                                        IO [AST]       -- ^ List all the 'AST's tracked by the 'Kernel'.
+  { -- | Halt the 'Kernel' and return control to GHC, which compiles the specified 'AST'.
+    resumeK :: MonadIO m =>                                   AST -> m ()
+    -- | Halt the 'Kernel' and abort GHC without compiling.
+  , abortK  :: MonadIO m =>                                          m ()
+    -- | Apply a 'Rewrite' to the specified 'AST' and return a handle to the resulting 'AST'.
+  , applyK  :: (MonadIO m, MonadCatch m)
+            => RewriteH ModGuts     -> CommitMsg -> KernelEnv -> AST -> m AST
+    -- | Apply a 'TransformH' to the 'AST', return the resulting value, and potentially a new 'AST'.
+  , queryK  :: (MonadIO m, MonadCatch m)
+            => TransformH ModGuts a -> CommitMsg -> KernelEnv -> AST -> m (AST,a)
+    -- | Delete the internal record of the specified 'AST'.
+  , deleteK :: MonadIO m =>                                   AST -> m ()
+    -- | List all the 'AST's tracked by the 'Kernel', including version data.
+  , listK   :: MonadIO m =>                                          m [(AST,Maybe String, Maybe AST)]
+    -- | Log a new AST with same Lemmas/ModGuts as given AST.
+  , tellK   :: (MonadIO m, MonadCatch m) => String         -> AST -> m AST
   }
 
+data CommitMsg = Always String | Changed String | Never
+
+msg :: CommitMsg -> Maybe String
+msg Never = Nothing
+msg (Always s) = Just s
+msg (Changed s) = Just s
+
 -- | A /handle/ for a specific version of the 'ModGuts'.
 newtype AST = AST Int -- ^ Currently 'AST's are identified by an 'Int' label.
-              deriving (Eq, Ord, Show)
+    deriving (Eq, Ord, Typeable)
 
-data Msg s r = forall a . Req (s -> CoreM (KureM (a,s))) (MVar (KureM a))
-             | Done (s -> CoreM r)
+firstAST :: AST
+firstAST = AST 0
 
-type ASTMap = Map AST KernelState
+-- for succ
+instance Enum AST where
+    toEnum = AST
+    fromEnum (AST i) = i
 
-data KernelState = KernelState { _ksStash  :: DefStash
-                               , _ksLemmas :: Lemmas
-                               , ksGuts   :: ModGuts
-                               }
+instance Show AST where
+    show (AST i) = show i
 
-fromHermitMResult :: HermitMResult ModGuts -> KernelState
-fromHermitMResult hRes = sideEffectsOnly hRes (hResult hRes)
+instance Read AST where
+    readsPrec p s = [ (AST i,s') | (i,s') <- readsPrec p s ]
 
-sideEffectsOnly :: HermitMResult a -> ModGuts -> KernelState
-sideEffectsOnly hRes = KernelState (hResStash hRes) (hResLemmas hRes)
+instance Extern AST where
+    type Box AST = AST
+    box i = i
+    unbox i = i
 
-data KernelEnv = KernelEnv { kEnvChan :: DebugMessage -> HermitM () }
+data ASTMap = ASTMap { astNext :: AST
+                     , astMap  :: Map AST KernelState
+                     }
 
--- | Start a HERMIT client by providing an IO function that takes the initial 'Kernel' and inital 'AST' handle.
---   The 'Modguts' to 'CoreM' Modguts' function required by GHC Plugins is returned.
---   The callback is only ever called once.
-hermitKernel :: (Kernel -> AST -> IO ()) -> ModGuts -> CoreM ModGuts
-hermitKernel callback modGuts = do
+emptyASTMap :: ASTMap
+emptyASTMap = ASTMap firstAST empty
 
-        msgMV :: MVar (Msg ASTMap ModGuts) <- liftIO newEmptyMVar
+data KernelState = KernelState { ksLemmas  :: Lemmas
+                               , ksGuts    :: ModGuts
+                               , _ksParent :: Maybe AST
+                               , _ksCommit :: Maybe String
+                               }
 
-        nextASTname :: MVar AST <- liftIO newEmptyMVar
+data KernelEnv = KernelEnv { kEnvChan :: DebugMessage -> HermitM () }
 
-        _ <- liftIO $ forkIO $ let loop n = do putMVar nextASTname (AST n)
-                                               loop (succ n)
-                                in loop 0
+-- | Internal API. The 'Kernel' object wraps these calls.
+data Msg where
+    Apply  :: AST -> (KernelState -> CoreM (KureM (Maybe KernelState, a)))
+                  -> (MVar (KureM (AST, a))) -> Msg
+    Read   :: (Map AST KernelState -> IO ()) -> Msg
+    Delete :: AST                            -> Msg
+    Done   :: Maybe AST                      -> Msg
 
-        let sendDone :: (ASTMap -> CoreM ModGuts) -> IO ()
-            sendDone = putMVar msgMV . Done
+-- | Put a 'KernelState' in the 'ASTMap', returning
+-- the 'AST' to which it was assigned.
+insertAST :: KernelState -> ASTMap -> (AST, ASTMap)
+insertAST ks (ASTMap k m) = (k, ASTMap (succ k) (insert k ks m))
 
-        let sendReq :: (ASTMap -> CoreM (KureM (a, ASTMap))) -> IO (KureM a)
-            sendReq fn = do rep  <- newEmptyMVar
-                            putMVar msgMV (Req fn rep)
-                            takeMVar rep
+findAST :: AST -> Map AST KernelState -> (String -> b) -> (KernelState -> b) -> b
+findAST ast m f = find ast m (f $ "Cannot find syntax tree: " ++ show ast)
 
-        let sendReqRead :: (ASTMap -> CoreM (KureM a)) -> IO (KureM a)
-            sendReqRead fn = sendReq (\ st -> (fmap.fmap) (,st) $ fn st) -- >>= return . fmap fst
+-- | Start a HERMIT client by providing an IO callback that takes the
+--   initial 'Kernel' and inital 'AST' handle. The callback is only
+--   ever called once. The 'Modguts -> CoreM Modguts' function
+--   required by GHC Plugins is returned.
+hermitKernel :: IORef (Maybe (AST, ASTMap)) -- ^ Global (across passes) AST store.
+             -> String                      -- ^ Last GHC pass name
+             -> (Kernel -> AST -> IO ())    -- ^ Callback
+             -> ModGuts -> CoreM ModGuts
+hermitKernel store lastPass callback modGuts = do
 
-        let sendReqWrite :: (ASTMap -> CoreM ASTMap) -> IO ()
-            sendReqWrite fn = sendReq (fmap ( return . ((),) ) . fn) >>= {- fmap fst . -} liftKureM
+    msgMV :: MVar Msg <- liftIO newEmptyMVar
 
-        let kernel :: Kernel
-            kernel = Kernel
-                { resumeK = \ name ->
-                                sendDone $ \ st ->
-                                    findWithErrMsg name
-                                                   st
-                                                   (\ msg -> throwGhcException
-                                                             $ ProgramError
-                                                             $ msg ++ ", exiting HERMIT and aborting GHC compilation.")
-                                                   (return.ksGuts)
+    let withAST :: (MonadIO m, MonadCatch m)
+                => AST -> (KernelState -> CoreM (KureM (Maybe KernelState, a))) -> m (AST, a)
+        withAST ast k = do
+            r <- liftIO $ do
+                    resVar <- newEmptyMVar
+                    putMVar msgMV $ Apply ast k resVar
+                    takeMVar resVar
+            runKureM return fail r
 
-                , abortK  = sendDone $ \ _ -> throwGhcException
-                                              $ ProgramError "Exiting HERMIT and aborting GHC compilation."
+        readOnly :: MonadIO m => (Map AST KernelState -> KureM a) -> m (KureM a)
+        readOnly f = liftIO $ do
+            resVar <- newEmptyMVar
+            putMVar msgMV (Read (runKureM (putMVar resVar . return)
+                                          (putMVar resVar . fail) . f))
+            takeMVar resVar
 
-                , applyK = \ name r kEnv ->
-                                sendReq $ \ st ->
-                                    findWithErrMsg name st fail $ \ (KernelState defs lemmas guts) ->
-                                        runHM (kEnvChan kEnv)
-                                              (mkEnv guts defs lemmas)
-                                              (\ hRes -> do
-                                                    ast <- liftIO $ takeMVar nextASTname
-                                                    return $ return (ast, insert ast (fromHermitMResult hRes) st))
-                                              (return . fail)
-                                              (applyT r (topLevelHermitC guts) guts)
+    let kernel :: Kernel
+        kernel = Kernel
+            { resumeK = liftIO . putMVar msgMV . Done . Just
 
-                , queryK = \ name t kEnv ->
-                                sendReqRead $ \ st ->
-                                    findWithErrMsg name st fail $ \ (KernelState defs lemmas guts) ->
-                                        runHM (kEnvChan kEnv)
-                                              (mkEnv guts defs lemmas)
-                                              (return . return . hResult)
-                                              (return . fail)
-                                              (applyT t (topLevelHermitC guts) guts)
+            , abortK  = liftIO $ putMVar msgMV (Done Nothing)
 
-                , deleteK = \ name -> sendReqWrite (return . delete name)
+            , applyK = \ rr cm kEnv ast -> liftM fst $
+                            withAST ast $ \ (KernelState lemmas guts _ _) -> do
+                                let handleS hRes = return $ return
+                                                   (Just (KernelState (hResLemmas hRes) (hResult hRes) (Just ast) (msg cm)), ())
+                                runHM (kEnvChan kEnv)
+                                      (mkEnv guts lemmas)
+                                      handleS
+                                      (return . fail)
+                                      (applyT rr (topLevelHermitC guts) guts)
 
-                , listK = sendReqRead (return . return . keys) >>= liftKureM
-                }
+            , queryK = \ t cm kEnv ast ->
+                            withAST ast $ \ (KernelState lemmas guts _ _) -> do
+                                let handleS hRes
+                                        | hResChanged hRes = f (Just (KernelState (hResLemmas hRes) guts (Just ast) (msg cm)), r)
+                                        | Always s <- cm   = f (Just (KernelState lemmas guts (Just ast) (Just s)), r)
+                                        | otherwise        = f (Nothing, r) -- pure query, not recorded in AST store
+                                        where r = hResult hRes
+                                              f = return . return
+                                runHM (kEnvChan kEnv)
+                                      (mkEnv guts lemmas)
+                                      handleS
+                                      (return . fail)
+                                      (applyT t (topLevelHermitC guts) guts)
 
-        -- We always start with AST 0
-        ast0 <- liftIO $ takeMVar nextASTname
+            , deleteK = liftIO . putMVar msgMV . Delete
 
-        let loop :: ASTMap -> CoreM ModGuts
-            loop st = do
-                m <- liftIO $ takeMVar msgMV
-                case m of
-                  Req fn rep -> fn st >>= runKureM (\ (a,st') -> liftIO (putMVar rep $ return a) >> loop st')
-                                                   (\ msg     -> liftIO (putMVar rep $ fail msg) >> loop st)
-                  Done fn -> fn st
+            , listK = readOnly (\m -> return [ (ast,cm,p) | (ast,KernelState _ _ p cm) <- toList m ])
+                        >>= runKureM return fail
 
-        _pid <- liftIO $ forkIO $ callback kernel ast0
+            , tellK = \ str ast -> liftM fst $
+                            withAST ast $ \ (KernelState lemmas guts _ _) ->
+                                return $ return (Just $ KernelState lemmas guts (Just ast) (Just str), ())
+            }
 
-        loop (singleton ast0 $ KernelState empty empty modGuts)
+    let loop :: ASTMap -> CoreM ModGuts
+        loop m = do
+            cmd <- liftIO $ takeMVar msgMV
+            case cmd of
+              Apply ast f resVar -> do
+                kr <- findAST ast (astMap m) (return . fail) f
+                let handleS (mbKS, r) =
+                        case mbKS of
+                            Nothing -> liftIO (putMVar resVar $ return (ast,r)) >> loop m
+                            Just ks -> let (ast', m') = insertAST ks m in
+                                       liftIO (putMVar resVar (return (ast',r))) >> loop m'
+                    handleF str = liftIO (putMVar resVar $ fail str) >> loop m
+                runKureM handleS handleF kr
+              Read fn -> liftIO (fn (astMap m)) >> loop m
+              Delete ast -> loop $ ASTMap (astNext m) $ delete ast (astMap m)
+              Done mbAST ->
+                case mbAST of
+                    Nothing  ->
+                        abortKernel "Exiting HERMIT and aborting GHC compilation."
+                    Just ast -> do
+                        findAST ast (astMap m)
+                            (\str -> abortKernel $ str ++ ", exiting HERMIT and aborting GHC compilation.")
+                            (\ks -> liftIO (writeIORef store (Just (ast, m))) >> return (ksGuts ks))
 
-        -- (Kill the pid'd thread? do we need to?)
+    -- Get the most recent AST and ASTMap the last HERMIT pass resumed with.
+    mbS <- liftIO $ readIORef store
+    (ast0,m) <- case mbS of
+        Nothing      -> return $ insertAST (KernelState empty modGuts Nothing Nothing) emptyASTMap
+        Just (ast,m) -> do
+            ls <- findAST ast (astMap m)
+                    (\str -> abortKernel $ str ++ ", exiting HERMIT and aborting GHC compilation.")
+                    (return . ksLemmas)
+            return $ insertAST (KernelState ls modGuts (Just ast) (Just lastPass)) m
 
-findWithErrMsg :: AST -> Map AST v -> (String -> b) -> (v -> b) -> b
-findWithErrMsg ast m f = find ast m (f $ "Cannot find syntax tree: " ++ show ast)
+    void $ liftIO $ forkIO $ callback kernel ast0
+
+    loop m
+
+abortKernel :: String -> CoreM a
+abortKernel = throwGhcException . ProgramError
 
 find :: Ord k => k -> Map k v -> b -> (v -> b) -> b
 find k m f s = maybe f s (lookup k m)
diff --git a/src/HERMIT/Kernel/Scoped.hs b/src/HERMIT/Kernel/Scoped.hs
deleted file mode 100644
--- a/src/HERMIT/Kernel/Scoped.hs
+++ /dev/null
@@ -1,167 +0,0 @@
-{-# LANGUAGE RankNTypes, FlexibleContexts, InstanceSigs #-}
-module HERMIT.Kernel.Scoped
-    ( Direction(..)
-    , LocalPath
-    , moveLocally
-    , ScopedKernel(..)
-    , SAST(..)
-    , scopedKernel
-    ) where
-
-import Control.Arrow
-import Control.Concurrent.STM
-import Control.Exception (bracketOnError)
-import Control.Monad
-import Control.Monad.IO.Class
-
-import Data.Maybe (fromMaybe)
-import Data.Monoid (mempty)
-import qualified Data.IntMap as I
-
-import HERMIT.Core
-import HERMIT.Context
-import HERMIT.Kure
-import HERMIT.GHC hiding (Direction,L)
-import HERMIT.Kernel
-
-----------------------------------------------------------------------------
-
--- | A primitive means of denoting navigation of a tree (within a local scope).
-data Direction = L -- ^ Left
-               | R -- ^ Right
-               | U -- ^ Up
-               | T -- ^ Top
-               deriving (Eq,Show)
-
-pathStack2Paths :: [LocalPath crumb] -> LocalPath crumb -> [Path crumb]
-pathStack2Paths ps p = reverse (map snocPathToPath (p:ps))
-
--- | Movement confined within the local scope.
-moveLocally :: Direction -> LocalPathH -> LocalPathH
-moveLocally d (SnocPath p) = case p of
-                               []     -> mempty
-                               cr:crs -> case d of
-                                           T -> mempty
-                                           U -> SnocPath crs
-                                           L -> SnocPath (fromMaybe cr (deprecatedLeftSibling cr)  : crs)
-                                           R -> SnocPath (fromMaybe cr (deprecatedRightSibling cr) : crs)
-
-
-pathStackToLens :: (Injection ModGuts g, Walker HermitC g) => [LocalPathH] -> LocalPathH -> LensH ModGuts g
-pathStackToLens ps p = injectL >>> pathL (concat $ pathStack2Paths ps p)
-
--- This function is used to check the validity of paths, so which sum type we use is important.
-testPathStackT :: [LocalPathH] -> LocalPathH -> TransformH ModGuts Bool
-testPathStackT ps p = testLensT (pathStackToLens ps p :: LensH ModGuts CoreTC)
-
-----------------------------------------------------------------------------
-
--- | An alternative HERMIT kernel, that provides scoping.
-data ScopedKernel = ScopedKernel
-    { resumeS      :: (MonadIO m, MonadCatch m) =>               SAST -> m ()
-    , abortS       ::  MonadIO m                =>                       m ()
-    , applyS       :: (MonadIO m, MonadCatch m, Injection ModGuts g, Walker HermitC g)
-                   => RewriteH g     -> KernelEnv ->             SAST -> m SAST
-    , queryS       :: (MonadIO m, MonadCatch m, Injection ModGuts g, Walker HermitC g)
-                   => TransformH g a -> KernelEnv ->             SAST -> m a
-    , deleteS      :: (MonadIO m, MonadCatch m) =>               SAST -> m ()
-    , listS        ::  MonadIO m                =>                       m [SAST]
-    , pathS        :: (MonadIO m, MonadCatch m) =>               SAST -> m [PathH]
-    , modPathS     :: (MonadIO m, MonadCatch m)
-                   => (LocalPathH -> LocalPathH) -> KernelEnv -> SAST -> m SAST
-    , beginScopeS  :: (MonadIO m, MonadCatch m) =>               SAST -> m SAST
-    , endScopeS    :: (MonadIO m, MonadCatch m) =>               SAST -> m SAST
-    -- means of accessing the underlying kernel, obviously for unsafe purposes
-    , kernelS      ::                                                    Kernel
-    , toASTS       :: (MonadIO m, MonadCatch m) =>               SAST -> m AST
-    }
-
--- | A /handle/ for an 'AST' combined with scoping information.
-newtype SAST = SAST Int deriving (Eq, Ord, Show)
-
--- path stack, representing the base path, then the relative path
-type SASTStore = I.IntMap (AST, [LocalPathH], LocalPathH)
-
-get :: Monad m => Int -> SASTStore -> m (AST, [LocalPathH], LocalPathH)
-get sAst m = maybe (fail "scopedKernel: invalid SAST") return (I.lookup sAst m)
-
--- | Ensures that the TMVar is replaced when an error is thrown, and all exceptions are lifted into MonadCatch failures.
-safeTakeTMVar :: (MonadCatch m, MonadIO m) => TMVar a -> (a -> IO b) -> m b
-safeTakeTMVar mvar = liftAndCatchIO . bracketOnError (atomically $ takeTMVar mvar) (atomically . putTMVar mvar)
-
--- | Start a HERMIT client by providing an IO function that takes the initial 'ScopedKernel' and inital 'SAST' handle.
---   The 'Modguts' to 'CoreM' Modguts' function required by GHC Plugins is returned.
-scopedKernel :: (ScopedKernel -> SAST -> IO ()) -> ModGuts -> CoreM ModGuts
-scopedKernel callback = hermitKernel $ \ kernel initAST -> do
-    store <- newTMVarIO $ I.fromList [(0,(initAST, [], mempty))]
-    key <- newTMVarIO (1::Int)
-
-    let newKey = do
-            k <- takeTMVar key
-            putTMVar key (k+1)
-            return k
-
-        skernel = ScopedKernel
-            { resumeS     = \ (SAST sAst) -> liftAndCatchIO $ do
-                                m <- atomically $ readTMVar store
-                                (ast,_,_) <- get sAst m
-                                resumeK kernel ast
-            , abortS      = liftIO $ abortK kernel
-            , applyS      = \ rr env (SAST sAst) -> safeTakeTMVar store $ \ m -> do
-                                (ast, base, rel) <- get sAst m
-                                applyK kernel ast (focusR (pathStackToLens base rel) rr) env
-                                  >>= runKureM (\ ast' -> atomically $ do
-                                                    k <- newKey
-                                                    putTMVar store $ I.insert k (ast', base, rel) m
-                                                    return (SAST k))
-                                               fail
-            , queryS      = \ t env (SAST sAst) -> liftAndCatchIO $ do
-                                m <- atomically $ readTMVar store
-                                (ast, base, rel) <- get sAst m
-                                queryK kernel ast (focusT (pathStackToLens base rel) t) env
-                                    >>= liftKureM
-            , deleteS     = \ (SAST sAst) -> safeTakeTMVar store $ \ m -> do
-                                (ast,_,_) <- get sAst m
-                                let m' = I.delete sAst m
-                                    fst3 (x,_,_) = x
-                                    asts = I.foldr ((:) . fst3) [] m'
-                                when (ast `notElem` asts) $ deleteK kernel ast
-                                atomically $ putTMVar store m'
-            , listS       = do m <- liftIO $ atomically $ readTMVar store
-                               return [ SAST sAst | sAst <- I.keys m ]
-            , pathS       = \ (SAST sAst) -> liftAndCatchIO $ do
-                                m <- atomically $ readTMVar store
-                                (_, base, rel) <- get sAst m
-                                return $ pathStack2Paths base rel
-            , modPathS    = \ f env (SAST sAst) -> safeTakeTMVar store $ \ m -> do
-                                (ast, base, rel) <- get sAst m
-                                let rel' = f rel
-                                queryK kernel ast (testPathStackT base rel') env
-                                  >>= runKureM (\ b -> if rel == rel'
-                                                        then fail "Path is unchanged, nothing to do."
-                                                        else if b
-                                                              then atomically $ do k <- newKey
-                                                                                   putTMVar store $ I.insert k (ast, base, rel') m
-                                                                                   return $ SAST k
-                                                              else fail "Invalid path created.")
-                                               fail
-            , beginScopeS = \ (SAST sAst) -> safeTakeTMVar store $ \m -> do
-                                (ast, base, rel) <- get sAst m
-                                atomically $ do k <- newKey
-                                                putTMVar store $ I.insert k (ast, rel : base, mempty) m
-                                                return $ SAST k
-            , endScopeS   = \ (SAST sAst) -> safeTakeTMVar store $ \m -> do
-                                (ast, base, _) <- get sAst m
-                                case base of
-                                    []          -> fail "Scoped Kernel: no scope to end."
-                                    rel : base' -> atomically $ do k <- newKey
-                                                                   putTMVar store $ I.insert k (ast, base', rel) m
-                                                                   return $ SAST k
-            , kernelS     = kernel
-            , toASTS      = \ (SAST sAst) -> liftAndCatchIO $ do
-                                m <- atomically $ readTMVar store
-                                (ast, _, _) <- get sAst m
-                                return ast
-            }
-
-    callback skernel $ SAST 0
diff --git a/src/HERMIT/Kure.hs b/src/HERMIT/Kure.hs
--- a/src/HERMIT/Kure.hs
+++ b/src/HERMIT/Kure.hs
@@ -1,84 +1,96 @@
-{-# LANGUAGE CPP, LambdaCase, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances, ScopedTypeVariables, InstanceSigs #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module HERMIT.Kure
-       (
-       -- * KURE
+    ( -- * KURE
 
-       -- | All the required functionality of KURE is exported here, so other modules do not need to import KURE directly.
-         module Language.KURE
-       , module Language.KURE.BiTransform
-       , module Language.KURE.Lens
-       , module Language.KURE.ExtendableContext
-       , module Language.KURE.Pathfinder
-       -- * Sub-Modules
-       , module HERMIT.Kure.SumTypes
-       -- * Synonyms
-       , TransformH
-       , RewriteH
-       , BiRewriteH
-       , LensH
-       , PathH
+      -- | All the required functionality of KURE is exported here, so other modules do not need to import KURE directly.
+      module Language.KURE
+    , module Language.KURE.BiTransform
+    , module Language.KURE.Lens
+    , module Language.KURE.ExtendableContext
+    , module Language.KURE.Pathfinder
+      -- * Sub-Modules
+    , module HERMIT.Kure.Universes
+      -- * Synonyms
+    , TransformH
+    , RewriteH
+    , BiRewriteH
+    , LensH
+    , PathH
 
-       -- * Congruence combinators
-       -- ** Modguts
-       , modGutsT, modGutsR
-       -- ** Program
-       , progNilT
-       , progConsT, progConsAllR, progConsAnyR, progConsOneR
-       -- ** Binding Groups
-       , nonRecT, nonRecAllR, nonRecAnyR, nonRecOneR
-       , recT, recAllR, recAnyR, recOneR
-       -- ** Recursive Definitions
-       , defT, defAllR, defAnyR, defOneR
-       -- ** Case Alternatives
-       , altT, altAllR, altAnyR, altOneR
-       -- ** Expressions
-       , varT, varR
-       , litT, litR
-       , appT, appAllR, appAnyR, appOneR
-       , lamT, lamAllR, lamAnyR, lamOneR
-       , letT, letAllR, letAnyR, letOneR
-       , caseT, caseAllR, caseAnyR, caseOneR
-       , castT, castAllR, castAnyR, castOneR
-       , tickT, tickAllR, tickAnyR, tickOneR
-       , typeT, typeR
-       , coercionT, coercionR
-       -- ** Composite Congruence Combinators
-       , defOrNonRecT, defOrNonRecAllR, defOrNonRecAnyR, defOrNonRecOneR
-       , recDefT, recDefAllR, recDefAnyR, recDefOneR
-       , letNonRecT, letNonRecAllR, letNonRecAnyR, letNonRecOneR
-       , letRecT, letRecAllR, letRecAnyR, letRecOneR
-       , letRecDefT, letRecDefAllR, letRecDefAnyR, letRecDefOneR
-       , consNonRecT, consNonRecAllR, consNonRecAnyR, consNonRecOneR
-       , 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
-       , appTyT, appTyAllR, appTyAnyR, appTyOneR
-       , funTyT, funTyAllR, funTyAnyR, funTyOneR
-       , forAllTyT, forAllTyAllR, forAllTyAnyR, forAllTyOneR
-       , tyConAppT, tyConAppAllR, tyConAppAnyR, tyConAppOneR
-       -- ** Coercions
-       , reflT, reflR
-       , tyConAppCoT, tyConAppCoAllR, tyConAppCoAnyR, tyConAppCoOneR
-       , appCoT, appCoAllR, appCoAnyR, appCoOneR
-       , forAllCoT, forAllCoAllR, forAllCoAnyR, forAllCoOneR
-       , coVarCoT, coVarCoR
-       , axiomInstCoT, axiomInstCoAllR, axiomInstCoAnyR, axiomInstCoOneR
-       , symCoT, symCoR
-       , transCoT, transCoAllR, transCoAnyR, transCoOneR
-       , nthCoT, nthCoAllR, nthCoAnyR, nthCoOneR
-       , instCoT, instCoAllR, instCoAnyR, instCoOneR
-       , lrCoT, lrCoAllR, lrCoAnyR, lrCoOneR
-       -- * Conversion to deprecated Int representation
-       , deprecatedIntToCrumbT
-       , deprecatedIntToPathT
-       )
-where
+      -- * Congruence combinators
+      -- ** Modguts
+    , modGutsT, modGutsR
+      -- ** Program
+    , progNilT
+    , progConsT, progConsAllR, progConsAnyR, progConsOneR
+      -- ** Binding Groups
+    , nonRecT, nonRecAllR, nonRecAnyR, nonRecOneR
+    , recT, recAllR, recAnyR, recOneR
+      -- ** Recursive Definitions
+    , defT, defAllR, defAnyR, defOneR
+      -- ** Case Alternatives
+    , altT, altAllR, altAnyR, altOneR
+      -- ** Expressions
+    , varT, varR
+    , litT, litR
+    , appT, appAllR, appAnyR, appOneR
+    , lamT, lamAllR, lamAnyR, lamOneR
+    , letT, letAllR, letAnyR, letOneR
+    , caseT, caseAllR, caseAnyR, caseOneR
+    , castT, castAllR, castAnyR, castOneR
+    , tickT, tickAllR, tickAnyR, tickOneR
+    , typeT, typeR
+    , coercionT, coercionR
+      -- ** Composite Congruence Combinators
+    , defOrNonRecT, defOrNonRecAllR, defOrNonRecAnyR, defOrNonRecOneR
+    , recDefT, recDefAllR, recDefAnyR, recDefOneR
+    , letNonRecT, letNonRecAllR, letNonRecAnyR, letNonRecOneR
+    , letRecT, letRecAllR, letRecAnyR, letRecOneR
+    , letRecDefT, letRecDefAllR, letRecDefAnyR, letRecDefOneR
+    , consNonRecT, consNonRecAllR, consNonRecAnyR, consNonRecOneR
+    , 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
+    , appTyT, appTyAllR, appTyAnyR, appTyOneR
+    , funTyT, funTyAllR, funTyAnyR, funTyOneR
+    , forAllTyT, forAllTyAllR, forAllTyAnyR, forAllTyOneR
+    , tyConAppT, tyConAppAllR, tyConAppAnyR, tyConAppOneR
+      -- ** Coercions
+    , reflT, reflR
+    , tyConAppCoT, tyConAppCoAllR, tyConAppCoAnyR, tyConAppCoOneR
+    , appCoT, appCoAllR, appCoAnyR, appCoOneR
+    , forAllCoT, forAllCoAllR, forAllCoAnyR, forAllCoOneR
+    , coVarCoT, coVarCoR
+    , axiomInstCoT, axiomInstCoAllR, axiomInstCoAnyR, axiomInstCoOneR
+    , symCoT, symCoR
+    , transCoT, transCoAllR, transCoAnyR, transCoOneR
+    , nthCoT, nthCoAllR, nthCoAnyR, nthCoOneR
+    , instCoT, instCoAllR, instCoAnyR, instCoOneR
+    , lrCoT, lrCoAllR, lrCoAnyR, lrCoOneR
+      -- ** Lemmas
+    , conjT, conjAllR
+    , disjT, disjAllR
+    , implT, implAllR
+    , equivT, equivAllR
+    , quantifiedT, quantifiedR
+      -- * Applicative
+      -- | Remove in 7.10
+    , (<$>)
+    , (<*>)
+    ) where
 
 import Language.KURE
 import Language.KURE.BiTransform
@@ -89,13 +101,12 @@
 import HERMIT.Context
 import HERMIT.Core
 import HERMIT.GHC
+import HERMIT.Kure.Universes
+import HERMIT.Lemma
 import HERMIT.Monad
-import HERMIT.Kure.SumTypes
 
 import Control.Monad
 
-import Data.Monoid (mempty)
-
 ---------------------------------------------------------------------
 
 type TransformH a b = Transform HermitC HermitM a b
@@ -164,9 +175,6 @@
                               _       -> idR
       {-# INLINE allRexpr #-}
 
--- NOTE: I tried telling GHC to inline allR and compilation hit the (default) simplifier tick limit.
--- TODO: Investigate whether that was achieving useful optimisations.
-
 ---------------------------------------------------------------------
 
 -- | Walking over types (only).
@@ -228,7 +236,56 @@
 
 ---------------------------------------------------------------------
 
--- | Walking over modules, programs, binding groups, definitions, expressions and case alternatives.
+-- | Walking over modules, programs, binding groups, definitions, expressions, case alternatives, lemma quantifiers and lemma clauses.
+instance (AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadPath c Crumb) => Walker c LCore where
+
+    allR :: forall m. MonadCatch m => Rewrite c m LCore -> Rewrite c m LCore
+    allR r = prefixFailMsg "allR failed: " $
+                rewrite $ \ c -> \case
+                    LQuantified q  -> inject <$> applyT allRquantified c q
+                    LClause cl     -> inject <$> applyT allRclause c cl
+                    LCore core     -> inject <$> applyT (allR $ extractR r) c core -- exploiting the fact that quantified/clause does not appear within Core
+        where
+            allRquantified :: MonadCatch m => Rewrite c m Quantified
+            allRquantified = quantifiedR idR (extractR r) -- we don't descend into the binders
+            {-# INLINE allRquantified #-}
+
+            allRclause :: MonadCatch m => Rewrite c m Clause
+            allRclause = readerT $ \case
+                                Conj{}  -> conjAllR  (extractR r) (extractR r)
+                                Disj{}  -> disjAllR  (extractR r) (extractR r)
+                                Impl{}  -> implAllR  (extractR r) (extractR r)
+                                Equiv{} -> equivAllR (extractR r) (extractR r)
+            {-# INLINE allRclause #-}
+
+---------------------------------------------------------------------
+
+-- | Walking over modules, programs, binding groups, definitions, expressions, case alternatives, types, coercions, lemma quantifiers and lemma clauses.
+instance (AddBindings c, ExtendPath c Crumb, HasEmptyContext c, ReadPath c Crumb) => Walker c LCoreTC where
+
+    allR :: forall m. MonadCatch m => Rewrite c m LCoreTC -> Rewrite c m LCoreTC
+    allR r = prefixFailMsg "allR failed: " $
+                rewrite $ \ c -> \case
+                    LTCCore (LQuantified q)  -> inject <$> applyT allRquantified c q
+                    LTCCore (LClause cl)     -> inject <$> applyT allRclause c cl
+                    LTCCore (LCore core)     -> inject <$> applyT (allR (extractR r :: Rewrite c m CoreTC)) c (Core core) -- convert to CoreTC, and exploit the fact that quantifiers and clauses will not appear in Core/CoreTC
+                    LTCTyCo tyCo             -> inject <$> applyT (allR $ extractR r) c tyCo -- exploiting the fact that only types and coercions appear within types and coercions
+        where
+            allRquantified :: MonadCatch m => Rewrite c m Quantified
+            allRquantified = quantifiedR idR (extractR r) -- we don't descend into the binders
+            {-# INLINE allRquantified #-}
+
+            allRclause :: MonadCatch m => Rewrite c m Clause
+            allRclause = readerT $ \case
+                                Conj{}  -> conjAllR (extractR r) (extractR r)
+                                Disj{}  -> disjAllR (extractR r) (extractR r)
+                                Impl{}  -> implAllR  (extractR r) (extractR r)
+                                Equiv{} -> equivAllR (extractR r) (extractR r)
+            {-# INLINE allRclause #-}
+
+---------------------------------------------------------------------
+
+-- | Walking over modules, programs, binding groups, definitions, expressions, case alternatives, types and coercions.
 instance (ExtendPath c Crumb, ReadPath c Crumb, AddBindings c, HasEmptyContext c) => Walker c CoreTC where
 
   allR :: forall m. MonadCatch m => Rewrite c m CoreTC -> Rewrite c m CoreTC
@@ -1232,38 +1289,73 @@
 {-# INLINE instCoOneR #-}
 
 ---------------------------------------------------------------------
----------------------------------------------------------------------
 
--- | Earlier versions of HERMIT used 'Int' as the crumb type.
---   This translation maps an 'Int' to the corresponding 'Crumb', for backwards compatibility purposes.
-deprecatedIntToCrumbT :: Monad m => Int -> Transform c m Core Crumb
-deprecatedIntToCrumbT n = contextfreeT $ \case
-                                            GutsCore _                 | n == 0                        -> return ModGuts_Prog
-                                            AltCore _                  | n == 0                        -> return Alt_RHS
-                                            DefCore _                  | n == 0                        -> return Def_RHS
-                                            ProgCore (ProgCons _ _)    | n == 0                        -> return ProgCons_Head
-                                                                       | n == 1                        -> return ProgCons_Tail
-                                            BindCore (NonRec _ _)      | n == 0                        -> return NonRec_RHS
-                                            BindCore (Rec bds)         | (n >= 0) && (n < length bds)  -> return (Rec_Def n)
-                                            ExprCore (App _ _)         | n == 0                        -> return App_Fun
-                                                                       | n == 1                        -> return App_Arg
-                                            ExprCore (Lam _ _)         | n == 0                        -> return Lam_Body
-                                            ExprCore (Let _ _)         | n == 0                        -> return Let_Bind
-                                                                       | n == 1                        -> return Let_Body
-                                            ExprCore (Case _ _ _ alts) | n == 0                        -> return Case_Scrutinee
-                                                                       | (n > 0) && (n <= length alts) -> return (Case_Alt (n-1))
-                                            ExprCore (Cast _ _)        | n == 0                        -> return Cast_Expr
-                                            ExprCore (Tick _ _)        | n == 0                        -> return Tick_Expr
-                                            _                                                          -> fail ("Child " ++ show n ++ " does not exist.")
-{-# INLINE deprecatedIntToCrumbT #-}
+-- | Transform a clause of the form: @Conj@ 'Quantified' 'Quantified'
+conjT :: (ExtendPath c Crumb, Monad m) => Transform c m Quantified a1 -> Transform c m Quantified a2 -> (a1 -> a2 -> b) -> Transform c m Clause b
+conjT t1 t2 f = transform $ \ c -> \case
+                                     Conj q1 q2 -> f <$> applyT t1 (c @@ Conj_Lhs) q1 <*> applyT t2 (c @@ Conj_Rhs) q2
+                                     _          -> fail "not a conjunction."
+{-# INLINE conjT #-}
 
--- | Builds a path to the first child, based on the old numbering system.
-deprecatedIntToPathT :: Monad m => Int -> Transform c m Core LocalPathH
-deprecatedIntToPathT =  liftM (mempty @@) . deprecatedIntToCrumbT
-{-# INLINE deprecatedIntToPathT #-}
+-- | Rewrite all children of a clause of the form: : @Conj@ 'Quantified' 'Quantified'
+conjAllR :: (ExtendPath c Crumb, Monad m) => Rewrite c m Quantified -> Rewrite c m Quantified -> Rewrite c m Clause
+conjAllR r1 r2 = conjT r1 r2 Conj
+{-# INLINE conjAllR #-}
 
+
+-- | Transform a clause of the form: @Disj@ 'Quantified' 'Quantified'
+disjT :: (ExtendPath c Crumb, Monad m) => Transform c m Quantified a1 -> Transform c m Quantified a2 -> (a1 -> a2 -> b) -> Transform c m Clause b
+disjT t1 t2 f = transform $ \ c -> \case
+                                     Conj q1 q2 -> f <$> applyT t1 (c @@ Disj_Lhs) q1 <*> applyT t2 (c @@ Disj_Rhs) q2
+                                     _          -> fail "not a disjunction."
+{-# INLINE disjT #-}
+
+-- | Rewrite all children of a clause of the form: : @Disj@ 'Quantified' 'Quantified'
+disjAllR :: (ExtendPath c Crumb, Monad m) => Rewrite c m Quantified -> Rewrite c m Quantified -> Rewrite c m Clause
+disjAllR r1 r2 = disjT r1 r2 Disj
+{-# INLINE disjAllR #-}
+
+
+-- | Transform a clause of the form: @Impl@ 'Quantified' 'Quantified'
+implT :: (ExtendPath c Crumb, Monad m) => Transform c m Quantified a1 -> Transform c m Quantified a2 -> (a1 -> a2 -> b) -> Transform c m Clause b
+implT t1 t2 f = transform $ \ c -> \case
+                                     Impl q1 q2 -> f <$> applyT t1 (c @@ Impl_Lhs) q1 <*> applyT t2 (c @@ Impl_Rhs) q2
+                                     _          -> fail "not an implication."
+{-# INLINE implT #-}
+
+-- | Rewrite all children of a clause of the form: : @Impl@ 'Quantified' 'Quantified'
+implAllR :: (ExtendPath c Crumb, Monad m) => Rewrite c m Quantified -> Rewrite c m Quantified -> Rewrite c m Clause
+implAllR r1 r2 = implT r1 r2 Impl
+{-# INLINE implAllR #-}
+
+-- | Transform a clause of the form: @Equiv@ 'CoreExpr' 'CoreExpr'
+equivT :: (ExtendPath c Crumb, Monad m) => Transform c m CoreExpr a1 -> Transform c m CoreExpr a2 -> (a1 -> a2 -> b) -> Transform c m Clause b
+equivT t1 t2 f = transform $ \ c -> \case
+                                     Equiv e1 e2 -> f <$> applyT t1 (c @@ Eq_Lhs) e1 <*> applyT t2 (c @@ Eq_Rhs) e2
+                                     _           -> fail "not an equivalence."
+{-# INLINE equivT #-}
+
+-- | Rewrite all children of a clause of the form: : @Equiv@ 'CoreExpr' 'CoreExpr'
+equivAllR :: (ExtendPath c Crumb, Monad m) => Rewrite c m CoreExpr -> Rewrite c m CoreExpr -> Rewrite c m Clause
+equivAllR r1 r2 = equivT r1 r2 Equiv
+{-# INLINE equivAllR #-}
+
 ---------------------------------------------------------------------
+
+-- | Transform a quantifier of the form: @Quantified@ 'Clause'
+quantifiedT :: (ExtendPath c Crumb, AddBindings c, ReadPath c Crumb, Monad m) => Transform c m [CoreBndr] a1 -> Transform c m Clause a2 -> (a1 -> a2 -> b) -> Transform c m Quantified b
+quantifiedT t1 t2 f = transform $ \ c (Quantified bs cl) -> let c' = foldl (flip addLambdaBinding) c bs
+                                                             in f <$> applyT t1 c bs <*> applyT t2 (c' @@ Forall_Body) cl
+{-# INLINE quantifiedT #-}
+
+-- | Rewrite the clause of a quantifier of the form: @Quantified@ 'Clause'
+quantifiedR :: (ExtendPath c Crumb, AddBindings c, ReadPath c Crumb, Monad m) => Rewrite c m [CoreBndr] -> Rewrite c m Clause -> Rewrite c m Quantified
+quantifiedR r1 r2 = quantifiedT r1 r2 Quantified
+{-# INLINE quantifiedR #-}
+
 ---------------------------------------------------------------------
 
 instance HasDynFlags m => HasDynFlags (Transform c m a) where
     getDynFlags = constT getDynFlags
+
+---------------------------------------------------------------------
diff --git a/src/HERMIT/Kure/SumTypes.hs b/src/HERMIT/Kure/SumTypes.hs
deleted file mode 100644
--- a/src/HERMIT/Kure/SumTypes.hs
+++ /dev/null
@@ -1,453 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, InstanceSigs, LambdaCase #-}
-
-module HERMIT.Kure.SumTypes
-  ( -- * Sum Types
-    Core(..)
-  , TyCo(..)
-  , CoreTC(..)
-  -- * Equality
-  -- ** Syntactic Equality
-  , coreSyntaxEq
-  , tyCoSyntaxEq
-  , coreTCSyntaxEq
-  -- ** Alpha Equality
-  , coreAlphaEq
-  , tyCoAlphaEq
-  , coreTCAlphaEq
-  -- ** Collecting Free Variables
-  , freeVarsCore
-  , freeVarsTyCo
-  , freeVarsCoreTC
-  -- * Promotion Combinators
-  -- ** Transform Promotions
-  , promoteModGutsT
-  , promoteProgT
-  , promoteBindT
-  , promoteDefT
-  , promoteExprT
-  , promoteAltT
-  , promoteTypeT
-  , promoteCoercionT
-  -- ** Rewrite Promotions
-  , promoteModGutsR
-  , promoteProgR
-  , promoteBindR
-  , promoteDefR
-  , promoteExprR
-  , promoteAltR
-  , promoteTypeR
-  , promoteCoercionR
-  -- ** BiRewrite Promotions
-  , promoteExprBiR
-  )
-where
-
-import Language.KURE.Transform
-import Language.KURE.Injection
-import Language.KURE.BiTransform
-
-import HERMIT.Core
-import HERMIT.GHC
-
----------------------------------------------------------------------
-
--- | Core is a sum type for use by KURE.  Core = ModGuts + CoreProg + CoreBind + CoreDef + CoreExpr + CoreAlt
-data Core = GutsCore  ModGuts            -- ^ The module.
-          | ProgCore  CoreProg           -- ^ A program (a telescope of top-level binding groups).
-          | BindCore  CoreBind           -- ^ A binding group.
-          | DefCore   CoreDef            -- ^ A recursive definition.
-          | ExprCore  CoreExpr           -- ^ An expression.
-          | AltCore   CoreAlt            -- ^ A case alternative.
-
--- | TyCo is a sum type for use by KURE.  TyCo = Type + Coercion
-data TyCo = TypeCore Type                -- ^ A type.
-          | CoercionCore Coercion        -- ^ A coercion.
-
--- | CoreTC is a sum type for use by KURE.  CoreTC = Core + TyCo
-data CoreTC = Core Core
-            | TyCo TyCo
-
----------------------------------------------------------------------
-
--- | Alpha equality of 'Core' fragments.
-coreAlphaEq :: Core -> Core -> Bool
-coreAlphaEq (GutsCore g1) (GutsCore g2) = progAlphaEq (bindsToProg $ mg_binds g1) (bindsToProg $ mg_binds g2)
-coreAlphaEq (ProgCore p1) (ProgCore p2) = progAlphaEq p1 p2
-coreAlphaEq (BindCore b1) (BindCore b2) = bindAlphaEq b1 b2
-coreAlphaEq (DefCore d1)  (DefCore d2)  = defAlphaEq d1 d2
-coreAlphaEq (ExprCore e1) (ExprCore e2) = exprAlphaEq e1 e2
-coreAlphaEq (AltCore a1)  (AltCore a2)  = altAlphaEq a1 a2
-coreAlphaEq _             _             = False
-
--- | Alpha equality of 'TyCo' fragments.
-tyCoAlphaEq :: TyCo -> TyCo -> Bool
-tyCoAlphaEq (TypeCore ty1)     (TypeCore ty2)     = typeAlphaEq ty1 ty2
-tyCoAlphaEq (CoercionCore co1) (CoercionCore co2) = coercionAlphaEq co1 co2
-tyCoAlphaEq _                  _                  = False
-
--- | Alpha equality of 'CoreTC' fragments.
-coreTCAlphaEq :: CoreTC -> CoreTC -> Bool
-coreTCAlphaEq (Core c1)  (Core c2)  = coreAlphaEq c1 c2
-coreTCAlphaEq (TyCo tc1) (TyCo tc2) = tyCoAlphaEq tc1 tc2
-coreTCAlphaEq _          _          = False
-
----------------------------------------------------------------------
-
--- | Syntactic equality of 'Core' fragments.
-coreSyntaxEq :: Core -> Core -> Bool
-coreSyntaxEq (GutsCore g1) (GutsCore g2) = all2 bindSyntaxEq (mg_binds g1) (mg_binds g2)
-coreSyntaxEq (ProgCore p1) (ProgCore p2) = progSyntaxEq p1 p2
-coreSyntaxEq (BindCore b1) (BindCore b2) = bindSyntaxEq b1 b2
-coreSyntaxEq (DefCore d1)  (DefCore d2)  = defSyntaxEq d1 d2
-coreSyntaxEq (ExprCore e1) (ExprCore e2) = exprSyntaxEq e1 e2
-coreSyntaxEq (AltCore a1)  (AltCore a2)  = altSyntaxEq a1 a2
-coreSyntaxEq _             _             = False
-
--- | Syntactic equality of 'TyCo' fragments.
-tyCoSyntaxEq :: TyCo -> TyCo -> Bool
-tyCoSyntaxEq (TypeCore ty1)     (TypeCore ty2)     = typeSyntaxEq ty1 ty2
-tyCoSyntaxEq (CoercionCore co1) (CoercionCore co2) = coercionSyntaxEq co1 co2
-tyCoSyntaxEq _                  _                  = False
-
--- | Syntactic equality of 'CoreTC' fragments.
-coreTCSyntaxEq :: CoreTC -> CoreTC -> Bool
-coreTCSyntaxEq (Core c1)  (Core c2)  = coreSyntaxEq c1 c2
-coreTCSyntaxEq (TyCo tc1) (TyCo tc2) = tyCoSyntaxEq tc1 tc2
-coreTCSyntaxEq _          _          = False
-
----------------------------------------------------------------------
-
--- | Find all free variables in a 'Core' node.
-freeVarsCore :: Core -> VarSet
-freeVarsCore = \case
-                  GutsCore g -> freeVarsProg (bindsToProg $ mg_binds g)
-                  ProgCore p -> freeVarsProg p
-                  BindCore b -> freeVarsBind b
-                  DefCore d  -> freeVarsDef d
-                  ExprCore e -> freeVarsExpr e
-                  AltCore a  -> freeVarsAlt a
-
--- | Find all free variables in a 'TyCo' node.
-freeVarsTyCo :: TyCo -> VarSet
-freeVarsTyCo = \case
-                  TypeCore ty     -> tyVarsOfType ty
-                  CoercionCore co -> tyCoVarsOfCo co
-
--- | Find all free variables in a 'CoreTC' node.
-freeVarsCoreTC :: CoreTC -> VarSet
-freeVarsCoreTC = \case
-                    TyCo tyco -> freeVarsTyCo tyco
-                    Core core -> freeVarsCore core
-
----------------------------------------------------------------------
-
-instance Injection ModGuts Core where
-
-  inject :: ModGuts -> Core
-  inject = GutsCore
-  {-# INLINE inject #-}
-
-  project :: Core -> Maybe ModGuts
-  project (GutsCore guts) = Just guts
-  project _               = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreProg Core where
-
-  inject :: CoreProg -> Core
-  inject = ProgCore
-  {-# INLINE inject #-}
-
-  project :: Core -> Maybe CoreProg
-  project (ProgCore bds) = Just bds
-  project _              = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreBind Core where
-
-  inject :: CoreBind -> Core
-  inject = BindCore
-  {-# INLINE inject #-}
-
-  project :: Core -> Maybe CoreBind
-  project (BindCore bnd)  = Just bnd
-  project _               = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreDef Core where
-
-  inject :: CoreDef -> Core
-  inject = DefCore
-  {-# INLINE inject #-}
-
-  project :: Core -> Maybe CoreDef
-  project (DefCore def) = Just def
-  project _             = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreAlt Core where
-
-  inject :: CoreAlt -> Core
-  inject = AltCore
-  {-# INLINE inject #-}
-
-  project :: Core -> Maybe CoreAlt
-  project (AltCore expr) = Just expr
-  project _              = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreExpr Core where
-
-  inject :: CoreExpr -> Core
-  inject = ExprCore
-  {-# INLINE inject #-}
-
-  project :: Core -> Maybe CoreExpr
-  project (ExprCore expr) = Just expr
-  project _               = Nothing
-  {-# INLINE project #-}
-
----------------------------------------------------------------------
-
-instance Injection Type TyCo where
-
-  inject :: Type -> TyCo
-  inject = TypeCore
-  {-# INLINE inject #-}
-
-  project :: TyCo -> Maybe Type
-  project (TypeCore ty) = Just ty
-  project _             = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection Coercion TyCo where
-
-  inject :: Coercion -> TyCo
-  inject = CoercionCore
-  {-# INLINE inject #-}
-
-  project :: TyCo -> Maybe Coercion
-  project (CoercionCore ty) = Just ty
-  project _                 = Nothing
-  {-# INLINE project #-}
-
----------------------------------------------------------------------
-
-instance Injection Core CoreTC where
-
-  inject :: Core -> CoreTC
-  inject = Core
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe Core
-  project (Core core) = Just core
-  project _           = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection TyCo CoreTC where
-
-  inject :: TyCo -> CoreTC
-  inject = TyCo
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe TyCo
-  project (TyCo tyCo) = Just tyCo
-  project _           = Nothing
-  {-# INLINE project #-}
-
----------------------------------------------------------------------
-
-instance Injection ModGuts CoreTC where
-
-  inject :: ModGuts -> CoreTC
-  inject = Core . GutsCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe ModGuts
-  project (Core (GutsCore guts)) = Just guts
-  project _                      = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreProg CoreTC where
-
-  inject :: CoreProg -> CoreTC
-  inject = Core . ProgCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe CoreProg
-  project (Core (ProgCore bds)) = Just bds
-  project _                     = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreBind CoreTC where
-
-  inject :: CoreBind -> CoreTC
-  inject = Core . BindCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe CoreBind
-  project (Core (BindCore bnd))  = Just bnd
-  project _                      = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreDef CoreTC where
-
-  inject :: CoreDef -> CoreTC
-  inject = Core . DefCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe CoreDef
-  project (Core (DefCore def)) = Just def
-  project _                    = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreAlt CoreTC where
-
-  inject :: CoreAlt -> CoreTC
-  inject = Core . AltCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe CoreAlt
-  project (Core (AltCore expr)) = Just expr
-  project _                     = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection CoreExpr CoreTC where
-
-  inject :: CoreExpr -> CoreTC
-  inject = Core . ExprCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe CoreExpr
-  project (Core (ExprCore expr)) = Just expr
-  project _                      = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection Type CoreTC where
-
-  inject :: Type -> CoreTC
-  inject = TyCo . TypeCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe Type
-  project (TyCo (TypeCore ty)) = Just ty
-  project _                    = Nothing
-  {-# INLINE project #-}
-
-
-instance Injection Coercion CoreTC where
-
-  inject :: Coercion -> CoreTC
-  inject = TyCo . CoercionCore
-  {-# INLINE inject #-}
-
-  project :: CoreTC -> Maybe Coercion
-  project (TyCo (CoercionCore ty)) = Just ty
-  project _                        = Nothing
-  {-# INLINE project #-}
-
----------------------------------------------------------------------
-
--- | Promote a translate on 'ModGuts'.
-promoteModGutsT :: (Monad m, Injection ModGuts g) => Transform c m ModGuts b -> Transform c m g b
-promoteModGutsT = promoteWithFailMsgT "This translate can only succeed at the module level."
-{-# INLINE promoteModGutsT #-}
-
--- | Promote a translate on 'CoreProg'.
-promoteProgT :: (Monad m, Injection CoreProg g) => Transform c m CoreProg b -> Transform c m g b
-promoteProgT = promoteWithFailMsgT "This translate can only succeed at program nodes (the top-level)."
-{-# INLINE promoteProgT #-}
-
--- | Promote a translate on 'CoreBind'.
-promoteBindT :: (Monad m, Injection CoreBind g) => Transform c m CoreBind b -> Transform c m g b
-promoteBindT = promoteWithFailMsgT "This translate can only succeed at binding group nodes."
-{-# INLINE promoteBindT #-}
-
--- | Promote a translate on 'CoreDef'.
-promoteDefT :: (Monad m, Injection CoreDef g) => Transform c m CoreDef b -> Transform c m g b
-promoteDefT = promoteWithFailMsgT "This translate can only succeed at recursive definition nodes."
-{-# INLINE promoteDefT #-}
-
--- | Promote a translate on 'CoreAlt'.
-promoteAltT :: (Monad m, Injection CoreAlt g) => Transform c m CoreAlt b -> Transform c m g b
-promoteAltT = promoteWithFailMsgT "This translate can only succeed at case alternative nodes."
-{-# INLINE promoteAltT #-}
-
--- | Promote a translate on 'CoreExpr'.
-promoteExprT :: (Monad m, Injection CoreExpr g) => Transform c m CoreExpr b -> Transform c m g b
-promoteExprT = promoteWithFailMsgT "This translate can only succeed at expression nodes."
-{-# INLINE promoteExprT #-}
-
--- | Promote a translate on 'Type'.
-promoteTypeT :: (Monad m, Injection Type g) => Transform c m Type b -> Transform c m g b
-promoteTypeT = promoteWithFailMsgT "This translate can only succeed at type nodes."
-{-# INLINE promoteTypeT #-}
-
--- | Promote a translate on 'Coercion'.
-promoteCoercionT :: (Monad m, Injection Coercion g) => Transform c m Coercion b -> Transform c m g b
-promoteCoercionT = promoteWithFailMsgT "This translate can only succeed at coercion nodes."
-{-# INLINE promoteCoercionT #-}
-
----------------------------------------------------------------------
-
--- | Promote a rewrite on 'ModGuts'.
-promoteModGutsR :: (Monad m, Injection ModGuts g) => Rewrite c m ModGuts -> Rewrite c m g
-promoteModGutsR = promoteWithFailMsgR "This rewrite can only succeed at the module level."
-{-# INLINE promoteModGutsR #-}
-
--- | Promote a rewrite on 'CoreProg'.
-promoteProgR :: (Monad m, Injection CoreProg g) => Rewrite c m CoreProg -> Rewrite c m g
-promoteProgR = promoteWithFailMsgR "This rewrite can only succeed at program nodes (the top-level)."
-{-# INLINE promoteProgR #-}
-
--- | Promote a rewrite on 'CoreBind'.
-promoteBindR :: (Monad m, Injection CoreBind g) => Rewrite c m CoreBind -> Rewrite c m g
-promoteBindR = promoteWithFailMsgR "This rewrite can only succeed at binding group nodes."
-{-# INLINE promoteBindR #-}
-
--- | Promote a rewrite on 'CoreDef'.
-promoteDefR :: (Monad m, Injection CoreDef g) => Rewrite c m CoreDef -> Rewrite c m g
-promoteDefR = promoteWithFailMsgR "This rewrite can only succeed at recursive definition nodes."
-{-# INLINE promoteDefR #-}
-
--- | Promote a rewrite on 'CoreAlt'.
-promoteAltR :: (Monad m, Injection CoreAlt g) => Rewrite c m CoreAlt -> Rewrite c m g
-promoteAltR = promoteWithFailMsgR "This rewrite can only succeed at case alternative nodes."
-{-# INLINE promoteAltR #-}
-
--- | Promote a rewrite on 'CoreExpr'.
-promoteExprR :: (Monad m, Injection CoreExpr g) => Rewrite c m CoreExpr -> Rewrite c m g
-promoteExprR = promoteWithFailMsgR "This rewrite can only succeed at expression nodes."
-{-# INLINE promoteExprR #-}
-
--- | Promote a rewrite on 'Type'.
-promoteTypeR :: (Monad m, Injection Type g) => Rewrite c m Type -> Rewrite c m g
-promoteTypeR = promoteWithFailMsgR "This rewrite can only succeed at type nodes."
-{-# INLINE promoteTypeR #-}
-
--- | Promote a rewrite on 'Coercion'.
-promoteCoercionR :: (Monad m, Injection Coercion g) => Rewrite c m Coercion -> Rewrite c m g
-promoteCoercionR = promoteWithFailMsgR "This rewrite can only succeed at coercion nodes."
-{-# INLINE promoteCoercionR #-}
-
----------------------------------------------------------------------
-
--- | Promote a bidirectional rewrite on 'CoreExpr'.
-promoteExprBiR :: (Monad m, Injection CoreExpr g) => BiRewrite c m CoreExpr -> BiRewrite c m g
-promoteExprBiR b = bidirectional (promoteExprR $ forwardT b) (promoteExprR $ backwardT b)
-{-# INLINE promoteExprBiR #-}
-
----------------------------------------------------------------------
diff --git a/src/HERMIT/Kure/Universes.hs b/src/HERMIT/Kure/Universes.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Kure/Universes.hs
@@ -0,0 +1,813 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+
+module HERMIT.Kure.Universes
+    ( -- * Universes
+      Core(..)
+    , TyCo(..)
+    , LCore(..)
+    , LCoreTC(..)
+    , CoreTC(..)
+      -- * Equality
+      -- ** Syntactic Equality
+    , coreSyntaxEq
+    , tyCoSyntaxEq
+    , coreTCSyntaxEq
+    , lcoreSyntaxEq
+    , lcoreTCSyntaxEq
+      -- ** Alpha Equality
+    , coreAlphaEq
+    , tyCoAlphaEq
+    , coreTCAlphaEq
+      -- ** Collecting Free Variables
+    , freeVarsCore
+    , freeVarsTyCo
+    , freeVarsCoreTC
+      -- * Promotion Combinators
+      -- ** Transform Promotions
+    , promoteModGutsT
+    , promoteProgT
+    , promoteBindT
+    , promoteDefT
+    , promoteExprT
+    , promoteAltT
+    , promoteTypeT
+    , promoteCoercionT
+    , promoteQuantifiedT
+    , promoteClauseT
+    , promoteCoreT
+    , promoteLCoreT
+    , promoteCoreTCT
+      -- ** Rewrite Promotions
+    , promoteModGutsR
+    , promoteProgR
+    , promoteBindR
+    , promoteDefR
+    , promoteExprR
+    , promoteAltR
+    , promoteTypeR
+    , promoteCoercionR
+    , promoteQuantifiedR
+    , promoteClauseR
+    , promoteCoreR
+    , promoteLCoreR
+    , promoteCoreTCR
+      -- ** BiRewrite Promotions
+    , promoteExprBiR
+    ) where
+
+import Language.KURE.Transform
+import Language.KURE.Injection
+import Language.KURE.BiTransform
+
+import HERMIT.Core
+import HERMIT.GHC
+import HERMIT.Lemma
+
+---------------------------------------------------------------------
+
+-- | Core is a KURE universe for traversing GHC Core, excluding types and coercions.
+--   Core = ModGuts + CoreProg + CoreBind + CoreDef + CoreExpr + CoreAlt
+data Core = GutsCore  ModGuts            -- ^ The module.
+          | ProgCore  CoreProg           -- ^ A program (a telescope of top-level binding groups).
+          | BindCore  CoreBind           -- ^ A binding group.
+          | DefCore   CoreDef            -- ^ A recursive definition.
+          | ExprCore  CoreExpr           -- ^ An expression.
+          | AltCore   CoreAlt            -- ^ A case alternative.
+
+-- | TyCo is a KURE universe for traversing types and coercions.
+--   TyCo = Type + Coercion
+data TyCo = TypeCore Type                -- ^ A type.
+          | CoercionCore Coercion        -- ^ A coercion.
+
+-- | Core is a KURE universe for traversing GHC Core, including types and coercions.
+--   CoreTC = Core + TyCo
+data CoreTC = Core Core
+            | TyCo TyCo
+
+-- | LCore is a KURE universe for traversing HERMIT lemmas and the Core expressions they contain.
+--   Types and coercions are not traversed (for that, use 'LCoreTC').
+--   LCore = Core + Quantified + Clause
+data LCore = LQuantified Quantified
+           | LClause     Clause
+           | LCore       Core
+
+-- | LCoreTC is a KURE universe for traversing HERMIT lemmas and the Core expressions they contain.
+--   Unlike 'LCore', types and coercions are also traversed.
+--   LCore = LCore + TyCo
+data LCoreTC = LTCCore LCore
+             | LTCTyCo TyCo
+
+---------------------------------------------------------------------
+
+-- | Alpha equality of 'Core' fragments.
+coreAlphaEq :: Core -> Core -> Bool
+coreAlphaEq (GutsCore g1) (GutsCore g2) = progAlphaEq (bindsToProg $ mg_binds g1) (bindsToProg $ mg_binds g2)
+coreAlphaEq (ProgCore p1) (ProgCore p2) = progAlphaEq p1 p2
+coreAlphaEq (BindCore b1) (BindCore b2) = bindAlphaEq b1 b2
+coreAlphaEq (DefCore d1)  (DefCore d2)  = defAlphaEq d1 d2
+coreAlphaEq (ExprCore e1) (ExprCore e2) = exprAlphaEq e1 e2
+coreAlphaEq (AltCore a1)  (AltCore a2)  = altAlphaEq a1 a2
+coreAlphaEq _             _             = False
+
+-- | Alpha equality of 'TyCo' fragments.
+tyCoAlphaEq :: TyCo -> TyCo -> Bool
+tyCoAlphaEq (TypeCore ty1)     (TypeCore ty2)     = typeAlphaEq ty1 ty2
+tyCoAlphaEq (CoercionCore co1) (CoercionCore co2) = coercionAlphaEq co1 co2
+tyCoAlphaEq _                  _                  = False
+
+-- | Alpha equality of 'CoreTC' fragments.
+coreTCAlphaEq :: CoreTC -> CoreTC -> Bool
+coreTCAlphaEq (Core c1)  (Core c2)  = coreAlphaEq c1 c2
+coreTCAlphaEq (TyCo tc1) (TyCo tc2) = tyCoAlphaEq tc1 tc2
+coreTCAlphaEq _          _          = False
+
+-- TODO: alpha equality for LCore and LCoreTC
+
+---------------------------------------------------------------------
+
+-- | Syntactic equality of 'Core' fragments.
+coreSyntaxEq :: Core -> Core -> Bool
+coreSyntaxEq (GutsCore g1) (GutsCore g2) = all2 bindSyntaxEq (mg_binds g1) (mg_binds g2)
+coreSyntaxEq (ProgCore p1) (ProgCore p2) = progSyntaxEq p1 p2
+coreSyntaxEq (BindCore b1) (BindCore b2) = bindSyntaxEq b1 b2
+coreSyntaxEq (DefCore d1)  (DefCore d2)  = defSyntaxEq d1 d2
+coreSyntaxEq (ExprCore e1) (ExprCore e2) = exprSyntaxEq e1 e2
+coreSyntaxEq (AltCore a1)  (AltCore a2)  = altSyntaxEq a1 a2
+coreSyntaxEq _             _             = False
+
+-- | Syntactic equality of 'TyCo' fragments.
+tyCoSyntaxEq :: TyCo -> TyCo -> Bool
+tyCoSyntaxEq (TypeCore ty1)     (TypeCore ty2)     = typeSyntaxEq ty1 ty2
+tyCoSyntaxEq (CoercionCore co1) (CoercionCore co2) = coercionSyntaxEq co1 co2
+tyCoSyntaxEq _                  _                  = False
+
+-- | Syntactic equality of 'CoreTC' fragments.
+coreTCSyntaxEq :: CoreTC -> CoreTC -> Bool
+coreTCSyntaxEq (Core c1)  (Core c2)  = coreSyntaxEq c1 c2
+coreTCSyntaxEq (TyCo tc1) (TyCo tc2) = tyCoSyntaxEq tc1 tc2
+coreTCSyntaxEq _          _          = False
+
+-- | Syntactic equality of 'LCore' fragments.
+lcoreSyntaxEq :: LCore -> LCore -> Bool
+lcoreSyntaxEq (LCore c1)       (LCore c2)       = coreSyntaxEq c1 c2
+lcoreSyntaxEq (LClause cl1)    (LClause cl2)    = clauseSyntaxEq cl1 cl2
+lcoreSyntaxEq (LQuantified q1) (LQuantified q2) = quantifiedSyntaxEq q1 q2
+lcoreSyntaxEq _                _                = False
+
+-- | Syntactic equality of 'LCoreTC' fragments.
+lcoreTCSyntaxEq :: LCoreTC -> LCoreTC -> Bool
+lcoreTCSyntaxEq (LTCCore lc1) (LTCCore lc2) = lcoreSyntaxEq lc1 lc2
+lcoreTCSyntaxEq (LTCTyCo tc1) (LTCTyCo tc2) = tyCoSyntaxEq tc1 tc2
+lcoreTCSyntaxEq _             _             = False
+
+---------------------------------------------------------------------
+
+-- | Find all free variables in a 'Core' node.
+freeVarsCore :: Core -> VarSet
+freeVarsCore = \case
+                  GutsCore g -> freeVarsProg (bindsToProg $ mg_binds g)
+                  ProgCore p -> freeVarsProg p
+                  BindCore b -> freeVarsBind b
+                  DefCore d  -> freeVarsDef d
+                  ExprCore e -> freeVarsExpr e
+                  AltCore a  -> freeVarsAlt a
+
+-- | Find all free variables in a 'TyCo' node.
+freeVarsTyCo :: TyCo -> VarSet
+freeVarsTyCo = \case
+                  TypeCore ty     -> tyVarsOfType ty
+                  CoercionCore co -> tyCoVarsOfCo co
+
+-- | Find all free variables in a 'CoreTC' node.
+freeVarsCoreTC :: CoreTC -> VarSet
+freeVarsCoreTC = \case
+                    TyCo tyco -> freeVarsTyCo tyco
+                    Core core -> freeVarsCore core
+
+---------------------------------------------------------------------
+
+instance Injection ModGuts Core where
+
+  inject :: ModGuts -> Core
+  inject = GutsCore
+  {-# INLINE inject #-}
+
+  project :: Core -> Maybe ModGuts
+  project (GutsCore guts) = Just guts
+  project _               = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreProg Core where
+
+  inject :: CoreProg -> Core
+  inject = ProgCore
+  {-# INLINE inject #-}
+
+  project :: Core -> Maybe CoreProg
+  project (ProgCore bds) = Just bds
+  project _              = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreBind Core where
+
+  inject :: CoreBind -> Core
+  inject = BindCore
+  {-# INLINE inject #-}
+
+  project :: Core -> Maybe CoreBind
+  project (BindCore bnd)  = Just bnd
+  project _               = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreDef Core where
+
+  inject :: CoreDef -> Core
+  inject = DefCore
+  {-# INLINE inject #-}
+
+  project :: Core -> Maybe CoreDef
+  project (DefCore def) = Just def
+  project _             = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreAlt Core where
+
+  inject :: CoreAlt -> Core
+  inject = AltCore
+  {-# INLINE inject #-}
+
+  project :: Core -> Maybe CoreAlt
+  project (AltCore expr) = Just expr
+  project _              = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreExpr Core where
+
+  inject :: CoreExpr -> Core
+  inject = ExprCore
+  {-# INLINE inject #-}
+
+  project :: Core -> Maybe CoreExpr
+  project (ExprCore expr) = Just expr
+  project _               = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection Type TyCo where
+
+  inject :: Type -> TyCo
+  inject = TypeCore
+  {-# INLINE inject #-}
+
+  project :: TyCo -> Maybe Type
+  project (TypeCore ty) = Just ty
+  project _             = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection Coercion TyCo where
+
+  inject :: Coercion -> TyCo
+  inject = CoercionCore
+  {-# INLINE inject #-}
+
+  project :: TyCo -> Maybe Coercion
+  project (CoercionCore ty) = Just ty
+  project _                 = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection Core LCore where
+
+  inject :: Core -> LCore
+  inject = LCore
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe Core
+  project (LCore c) = Just c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection Clause LCore where
+
+  inject :: Clause -> LCore
+  inject = LClause
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe Clause
+  project (LClause cl) = Just cl
+  project _            = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection Quantified LCore where
+
+  inject :: Quantified -> LCore
+  inject = LQuantified
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe Quantified
+  project (LQuantified q) = Just q
+  project _               = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection LCore LCoreTC where
+
+  inject :: LCore -> LCoreTC
+  inject = LTCCore
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe LCore
+  project (LTCCore core) = Just core
+  project _              = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection TyCo LCoreTC where
+
+  inject :: TyCo -> LCoreTC
+  inject = LTCTyCo
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe TyCo
+  project (LTCTyCo tyCo) = Just tyCo
+  project _              = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection ModGuts LCore where
+
+  inject :: ModGuts -> LCore
+  inject = LCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe ModGuts
+  project (LCore c) = project c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreProg LCore where
+
+  inject :: CoreProg -> LCore
+  inject = LCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe CoreProg
+  project (LCore c) = project c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreExpr LCore where
+  inject :: CoreExpr -> LCore
+  inject = LCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe CoreExpr
+  project (LCore c) = project c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreBind LCore where
+  inject :: CoreBind -> LCore
+  inject = LCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe CoreBind
+  project (LCore c) = project c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreDef LCore where
+  inject :: CoreDef -> LCore
+  inject = LCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe CoreDef
+  project (LCore c) = project c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreAlt LCore where
+  inject :: CoreAlt -> LCore
+  inject = LCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCore -> Maybe CoreAlt
+  project (LCore c) = project c
+  project _         = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection Quantified LCoreTC where
+
+  inject :: Quantified -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe Quantified
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection Clause LCoreTC where
+
+  inject :: Clause -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe Clause
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection Core LCoreTC where
+
+  inject :: Core -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe Core
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection ModGuts LCoreTC where
+
+  inject :: ModGuts -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe ModGuts
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreProg LCoreTC where
+
+  inject :: CoreProg -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe CoreProg
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreExpr LCoreTC where
+  inject :: CoreExpr -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe CoreExpr
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreBind LCoreTC where
+  inject :: CoreBind -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe CoreBind
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreDef LCoreTC where
+  inject :: CoreDef -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe CoreDef
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection CoreAlt LCoreTC where
+  inject :: CoreAlt -> LCoreTC
+  inject = LTCCore . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe CoreAlt
+  project (LTCCore lc) = project lc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection Type LCoreTC where
+  inject :: Type -> LCoreTC
+  inject = LTCTyCo . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe Type
+  project (LTCTyCo tc) = project tc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+instance Injection Coercion LCoreTC where
+  inject :: Coercion -> LCoreTC
+  inject = LTCTyCo . inject
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe Coercion
+  project (LTCTyCo tc) = project tc
+  project _            = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection Core CoreTC where
+
+  inject :: Core -> CoreTC
+  inject = Core
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe Core
+  project (Core core) = Just core
+  project _           = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection TyCo CoreTC where
+
+  inject :: TyCo -> CoreTC
+  inject = TyCo
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe TyCo
+  project (TyCo tyCo) = Just tyCo
+  project _           = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+instance Injection ModGuts CoreTC where
+
+  inject :: ModGuts -> CoreTC
+  inject = Core . GutsCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe ModGuts
+  project (Core (GutsCore guts)) = Just guts
+  project _                      = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreProg CoreTC where
+
+  inject :: CoreProg -> CoreTC
+  inject = Core . ProgCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe CoreProg
+  project (Core (ProgCore bds)) = Just bds
+  project _                     = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreBind CoreTC where
+
+  inject :: CoreBind -> CoreTC
+  inject = Core . BindCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe CoreBind
+  project (Core (BindCore bnd))  = Just bnd
+  project _                      = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreDef CoreTC where
+
+  inject :: CoreDef -> CoreTC
+  inject = Core . DefCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe CoreDef
+  project (Core (DefCore def)) = Just def
+  project _                    = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreAlt CoreTC where
+
+  inject :: CoreAlt -> CoreTC
+  inject = Core . AltCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe CoreAlt
+  project (Core (AltCore expr)) = Just expr
+  project _                     = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection CoreExpr CoreTC where
+
+  inject :: CoreExpr -> CoreTC
+  inject = Core . ExprCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe CoreExpr
+  project (Core (ExprCore expr)) = Just expr
+  project _                      = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection Type CoreTC where
+
+  inject :: Type -> CoreTC
+  inject = TyCo . TypeCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe Type
+  project (TyCo (TypeCore ty)) = Just ty
+  project _                    = Nothing
+  {-# INLINE project #-}
+
+
+instance Injection Coercion CoreTC where
+
+  inject :: Coercion -> CoreTC
+  inject = TyCo . CoercionCore
+  {-# INLINE inject #-}
+
+  project :: CoreTC -> Maybe Coercion
+  project (TyCo (CoercionCore ty)) = Just ty
+  project _                        = Nothing
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+-- This one's a bit unusual, as it doesn't directly follow the structure of the sum types.
+
+instance Injection CoreTC LCoreTC where
+
+  inject :: CoreTC -> LCoreTC
+  inject (Core c)  = LTCCore (LCore c)
+  inject (TyCo tc) = LTCTyCo tc
+  {-# INLINE inject #-}
+
+  project :: LCoreTC -> Maybe CoreTC
+  project (LTCCore c)  = Core `fmap` project c
+  project (LTCTyCo tc) = Just (TyCo tc)
+  {-# INLINE project #-}
+
+---------------------------------------------------------------------
+
+-- | Promote a translate on 'ModGuts'.
+promoteModGutsT :: (Monad m, Injection ModGuts g) => Transform c m ModGuts b -> Transform c m g b
+promoteModGutsT = promoteWithFailMsgT "This translate can only succeed at the module level."
+{-# INLINE promoteModGutsT #-}
+
+-- | Promote a translate on 'CoreProg'.
+promoteProgT :: (Monad m, Injection CoreProg g) => Transform c m CoreProg b -> Transform c m g b
+promoteProgT = promoteWithFailMsgT "This translate can only succeed at program nodes (the top-level)."
+{-# INLINE promoteProgT #-}
+
+-- | Promote a translate on 'CoreBind'.
+promoteBindT :: (Monad m, Injection CoreBind g) => Transform c m CoreBind b -> Transform c m g b
+promoteBindT = promoteWithFailMsgT "This translate can only succeed at binding group nodes."
+{-# INLINE promoteBindT #-}
+
+-- | Promote a translate on 'CoreDef'.
+promoteDefT :: (Monad m, Injection CoreDef g) => Transform c m CoreDef b -> Transform c m g b
+promoteDefT = promoteWithFailMsgT "This translate can only succeed at recursive definition nodes."
+{-# INLINE promoteDefT #-}
+
+-- | Promote a translate on 'CoreAlt'.
+promoteAltT :: (Monad m, Injection CoreAlt g) => Transform c m CoreAlt b -> Transform c m g b
+promoteAltT = promoteWithFailMsgT "This translate can only succeed at case alternative nodes."
+{-# INLINE promoteAltT #-}
+
+-- | Promote a translate on 'CoreExpr'.
+promoteExprT :: (Monad m, Injection CoreExpr g) => Transform c m CoreExpr b -> Transform c m g b
+promoteExprT = promoteWithFailMsgT "This translate can only succeed at expression nodes."
+{-# INLINE promoteExprT #-}
+
+-- | Promote a translate on 'Type'.
+promoteTypeT :: (Monad m, Injection Type g) => Transform c m Type b -> Transform c m g b
+promoteTypeT = promoteWithFailMsgT "This translate can only succeed at type nodes."
+{-# INLINE promoteTypeT #-}
+
+-- | Promote a translate on 'Coercion'.
+promoteCoercionT :: (Monad m, Injection Coercion g) => Transform c m Coercion b -> Transform c m g b
+promoteCoercionT = promoteWithFailMsgT "This translate can only succeed at coercion nodes."
+{-# INLINE promoteCoercionT #-}
+
+-- | Promote a translate on 'Quantified'.
+promoteQuantifiedT :: (Monad m, Injection Quantified g) => Transform c m Quantified b -> Transform c m g b
+promoteQuantifiedT = promoteWithFailMsgT "This translate can only succeed at quantified nodes."
+{-# INLINE promoteQuantifiedT #-}
+
+-- | Promote a translate on 'Clause'.
+promoteClauseT :: (Monad m, Injection Clause g) => Transform c m Clause b -> Transform c m g b
+promoteClauseT = promoteWithFailMsgT "This translate can only succeed at clause nodes."
+{-# INLINE promoteClauseT #-}
+
+-- | Promote a translate on 'Core'.
+promoteCoreT :: (Monad m, Injection Core g) => Transform c m Core b -> Transform c m g b
+promoteCoreT = promoteWithFailMsgT "This translate can only succeed at core nodes."
+{-# INLINE promoteCoreT #-}
+
+-- | Promote a translate on 'LCore'.
+promoteLCoreT :: (Monad m, Injection LCore g) => Transform c m LCore b -> Transform c m g b
+promoteLCoreT = promoteWithFailMsgT "This translate can only succeed at lemma or core nodes."
+{-# INLINE promoteLCoreT #-}
+
+-- | Promote a translate on 'CoreTC'.
+promoteCoreTCT :: (Monad m, Injection CoreTC g) => Transform c m CoreTC b -> Transform c m g b
+promoteCoreTCT = promoteWithFailMsgT "This translate can only succeed at core nodes."
+{-# INLINE promoteCoreTCT #-}
+
+---------------------------------------------------------------------
+
+-- | Promote a rewrite on 'ModGuts'.
+promoteModGutsR :: (Monad m, Injection ModGuts g) => Rewrite c m ModGuts -> Rewrite c m g
+promoteModGutsR = promoteWithFailMsgR "This rewrite can only succeed at the module level."
+{-# INLINE promoteModGutsR #-}
+
+-- | Promote a rewrite on 'CoreProg'.
+promoteProgR :: (Monad m, Injection CoreProg g) => Rewrite c m CoreProg -> Rewrite c m g
+promoteProgR = promoteWithFailMsgR "This rewrite can only succeed at program nodes (the top-level)."
+{-# INLINE promoteProgR #-}
+
+-- | Promote a rewrite on 'CoreBind'.
+promoteBindR :: (Monad m, Injection CoreBind g) => Rewrite c m CoreBind -> Rewrite c m g
+promoteBindR = promoteWithFailMsgR "This rewrite can only succeed at binding group nodes."
+{-# INLINE promoteBindR #-}
+
+-- | Promote a rewrite on 'CoreDef'.
+promoteDefR :: (Monad m, Injection CoreDef g) => Rewrite c m CoreDef -> Rewrite c m g
+promoteDefR = promoteWithFailMsgR "This rewrite can only succeed at recursive definition nodes."
+{-# INLINE promoteDefR #-}
+
+-- | Promote a rewrite on 'CoreAlt'.
+promoteAltR :: (Monad m, Injection CoreAlt g) => Rewrite c m CoreAlt -> Rewrite c m g
+promoteAltR = promoteWithFailMsgR "This rewrite can only succeed at case alternative nodes."
+{-# INLINE promoteAltR #-}
+
+-- | Promote a rewrite on 'CoreExpr'.
+promoteExprR :: (Monad m, Injection CoreExpr g) => Rewrite c m CoreExpr -> Rewrite c m g
+promoteExprR = promoteWithFailMsgR "This rewrite can only succeed at expression nodes."
+{-# INLINE promoteExprR #-}
+
+-- | Promote a rewrite on 'Type'.
+promoteTypeR :: (Monad m, Injection Type g) => Rewrite c m Type -> Rewrite c m g
+promoteTypeR = promoteWithFailMsgR "This rewrite can only succeed at type nodes."
+{-# INLINE promoteTypeR #-}
+
+-- | Promote a rewrite on 'Coercion'.
+promoteCoercionR :: (Monad m, Injection Coercion g) => Rewrite c m Coercion -> Rewrite c m g
+promoteCoercionR = promoteWithFailMsgR "This rewrite can only succeed at coercion nodes."
+{-# INLINE promoteCoercionR #-}
+
+-- | Promote a rewrite on 'Quantified'.
+promoteQuantifiedR :: (Monad m, Injection Quantified g) => Rewrite c m Quantified -> Rewrite c m g
+promoteQuantifiedR = promoteWithFailMsgR "This rewrite can only succeed at quantified nodes."
+{-# INLINE promoteQuantifiedR #-}
+
+-- | Promote a rewrite on 'Clause'.
+promoteClauseR :: (Monad m, Injection Clause g) => Rewrite c m Clause -> Rewrite c m g
+promoteClauseR = promoteWithFailMsgR "This rewrite can only succeed at quantified nodes."
+{-# INLINE promoteClauseR #-}
+
+-- | Promote a rewrite on 'Core'.
+promoteCoreR :: (Monad m, Injection Core g) => Rewrite c m Core -> Rewrite c m g
+promoteCoreR = promoteWithFailMsgR "This rewrite can only succeed at core nodes."
+{-# INLINE promoteCoreR #-}
+
+-- | Promote a rewrite on 'Core'.
+promoteLCoreR :: (Monad m, Injection LCore g) => Rewrite c m LCore -> Rewrite c m g
+promoteLCoreR = promoteWithFailMsgR "This rewrite can only succeed at lemma or core nodes."
+{-# INLINE promoteLCoreR #-}
+
+-- | Promote a rewrite on 'CoreTC'.
+promoteCoreTCR :: (Monad m, Injection CoreTC g) => Rewrite c m CoreTC -> Rewrite c m g
+promoteCoreTCR = promoteWithFailMsgR "This rewrite can only succeed at core nodes."
+{-# INLINE promoteCoreTCR #-}
+
+---------------------------------------------------------------------
+
+-- | Promote a bidirectional rewrite on 'CoreExpr'.
+promoteExprBiR :: (Monad m, Injection CoreExpr g) => BiRewrite c m CoreExpr -> BiRewrite c m g
+promoteExprBiR = promoteWithFailMsgBiR "This rewrite can only succeed at expression nodes."
+{-# INLINE promoteExprBiR #-}
+
+---------------------------------------------------------------------
diff --git a/src/HERMIT/Lemma.hs b/src/HERMIT/Lemma.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Lemma.hs
@@ -0,0 +1,303 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module HERMIT.Lemma
+    ( -- * Quantified
+      Quantified(..)
+    , mkQuantified
+    , Clause(..)
+    , instQuantified
+    , instsQuantified
+    , discardUniVars
+    , freeVarsQuantified
+    , clauseSyntaxEq
+    , quantifiedSyntaxEq
+    , substQuantified
+    , substQuantifieds
+    , dropBinders
+    , redundantDicts
+      -- * Lemmas
+    , LemmaName(..)
+    , Lemma(..)
+    , Proven(..)
+    , andP, orP
+    , Used(..)
+    , Lemmas
+    , NamedLemma
+    ) where
+
+import Prelude hiding (lookup)
+
+import Control.Monad
+
+import Data.Dynamic (Typeable)
+import Data.String (IsString(..))
+import qualified Data.Map as M
+import Data.Monoid
+
+import HERMIT.Core
+import HERMIT.GHC hiding ((<>))
+import Language.KURE.MonadCatch
+
+----------------------------------------------------------------------------
+
+-- | Build a Quantified from a list of universally quantified binders and two expressions.
+-- If the head of either expression is a lambda expression, it's binder will become a universally quantified binder
+-- over both sides. It is assumed the two expressions have the same type.
+--
+-- Ex.    mkQuantified [] (\x. foo x) bar === forall x. foo x = bar x
+--        mkQuantified [] (baz y z) (\x. foo x x) === forall x. baz y z x = foo x x
+--        mkQuantified [] (\x. foo x) (\y. bar y) === forall x. foo x = bar x
+mkQuantified :: [CoreBndr] -> CoreExpr -> CoreExpr -> Quantified
+mkQuantified vs lhs rhs = redundantDicts $ dropBinders $ Quantified (tvs++vs++lbs++rbs) (Equiv lhs' rbody)
+    where (lbs, lbody) = collectBinders lhs
+          rhs' = uncurry mkCoreApps $ betaReduceAll rhs $ map varToCoreExpr lbs
+          (rbs, rbody) = collectBinders rhs'
+          lhs' = mkCoreApps lbody $ map varToCoreExpr rbs
+          -- now quantify over the free type variables
+          tvs = varSetElems
+              $ filterVarSet isTyVar
+              $ delVarSetList (unionVarSets $ map freeVarsExpr [lhs',rbody]) (vs++lbs++rbs)
+
+freeVarsQuantified :: Quantified -> VarSet
+freeVarsQuantified (Quantified bs cl) = delVarSetList (freeVarsClause cl) bs
+
+freeVarsClause :: Clause -> VarSet
+freeVarsClause (Conj  q1 q2) = unionVarSets $ map freeVarsQuantified [q1,q2]
+freeVarsClause (Disj  q1 q2) = unionVarSets $ map freeVarsQuantified [q1,q2]
+freeVarsClause (Impl  q1 q2) = unionVarSets $ map freeVarsQuantified [q1,q2]
+freeVarsClause (Equiv e1 e2) = unionVarSets $ map freeVarsExpr [e1,e2]
+
+dropBinders :: Quantified -> Quantified
+dropBinders (Quantified bs cl) =
+    case bs of
+        []      -> Quantified [] (dropBindersClause cl)
+        (b:bs') -> case dropBinders (Quantified bs' cl) of
+                    q@(Quantified bs'' cl')
+                        | b `elemVarSet` freeVarsQuantified q -> Quantified (b:bs'') cl'
+                        | otherwise -> q
+
+dropBindersClause :: Clause -> Clause
+dropBindersClause (Conj q1 q2) = Conj (dropBinders q1) (dropBinders q2)
+dropBindersClause (Disj q1 q2) = Disj (dropBinders q1) (dropBinders q2)
+dropBindersClause (Impl q1 q2) = Impl (dropBinders q1) (dropBinders q2)
+dropBindersClause equiv        = equiv
+
+
+-- | A name for lemmas. Use a newtype so we can tab-complete in shell.
+newtype LemmaName = LemmaName String deriving (Eq, Ord, Typeable)
+
+instance Monoid LemmaName where
+    mempty = LemmaName mempty
+    mappend (LemmaName n1) (LemmaName n2) = LemmaName (mappend n1 n2)
+
+instance IsString LemmaName where fromString = LemmaName
+instance Show LemmaName where show (LemmaName s) = s
+
+-- | An equality with a proven/used status.
+data Lemma = Lemma { lemmaQ :: Quantified
+                   , lemmaP :: Proven     -- whether lemma has been proven
+                   , lemmaU :: Used       -- whether lemma has been used
+                   , lemmaT :: Bool       -- whether lemma is temporary
+                   }
+
+data Proven = Proven
+            | Assumed Bool -- ^ True = assumed by user, False = assumed by library/HERMIT for good reason
+            | NotProven
+    deriving (Eq, Typeable)
+
+instance Show Proven where
+    show Proven = "Proven"
+    show (Assumed _) = "Assumed"
+    show NotProven = "Not Proven"
+
+-- Ordering: NotProven < Assumed True < Assumed False < Proven
+instance Ord Proven where
+    compare :: Proven -> Proven -> Ordering
+    compare Proven    Proven    = EQ
+    compare (Assumed l) (Assumed r)
+        | l && (not r) = LT
+        | (not l) && r = GT
+        | otherwise = EQ
+    compare NotProven NotProven = EQ
+    compare Proven    _         = GT
+    compare _         Proven    = LT
+    compare NotProven _         = LT
+    compare _         NotProven = GT
+
+-- When conjuncting, result is as proven as the least of the two
+andP :: Proven -> Proven -> Proven
+andP = min
+
+-- When disjuncting, result is as proven as the most of the two
+orP :: Proven -> Proven -> Proven
+orP = max
+
+data Used = Obligation -- ^ this MUST be proven immediately
+          | UnsafeUsed -- ^ used, but can be proven later (only introduced in unsafe shell)
+          | NotUsed    -- ^ not used
+    deriving (Eq, Typeable)
+
+instance Show Used where
+    show Obligation = "Obligation"
+    show UnsafeUsed = "Used"
+    show NotUsed    = "Not Used"
+
+data Quantified = Quantified [CoreBndr] Clause
+
+data Clause = Conj Quantified Quantified
+            | Disj Quantified Quantified
+            | Impl Quantified Quantified
+            | Equiv CoreExpr CoreExpr
+
+-- | A collection of named lemmas.
+type Lemmas = M.Map LemmaName Lemma
+
+-- | A LemmaName, Lemma pair.
+type NamedLemma = (LemmaName, Lemma)
+
+------------------------------------------------------------------------------
+
+discardUniVars :: Quantified -> Quantified
+discardUniVars (Quantified _ cl) = Quantified [] cl
+
+------------------------------------------------------------------------------
+
+-- | Assumes Var is free in Quantified. If not, no substitution will happen, though uniques might be freshened.
+substQuantified :: Var -> CoreArg -> Quantified -> Quantified
+substQuantified v e = substQuantifieds [(v,e)]
+
+substQuantifieds :: [(Var,CoreArg)] -> Quantified -> Quantified
+substQuantifieds ps q = substQuantifiedSubst (extendSubstList sub ps) q
+    where (vs,es) = unzip ps
+          sub = mkEmptySubst
+              $ mkInScopeSet
+              $ delVarSetList (unionVarSets $ freeVarsQuantified q : map freeVarsExpr es) vs
+
+-- | Note: Subst must be properly set up with an InScopeSet that includes all vars
+-- in scope in the *range* of the substitution.
+substQuantifiedSubst :: Subst -> Quantified -> Quantified
+substQuantifiedSubst = go
+    where go sub (Quantified bs cl) =
+            let (bs', cl') = go1 sub bs [] cl
+            in Quantified bs' cl'
+
+          go1 subst [] bs' cl = (reverse bs', go2 subst cl)
+          go1 subst (b:bs) bs' cl =
+            let (subst',b') = substBndr subst b
+            in go1 subst' bs (b':bs') cl
+          go2 subst (Conj q1 q2) = Conj (go subst q1) (go subst q2)
+          go2 subst (Disj q1 q2) = Disj (go subst q1) (go subst q2)
+          go2 subst (Impl q1 q2) = Impl (go subst q1) (go subst q2)
+          go2 subst (Equiv e1 e2) =
+            let e1' = substExpr (text "substQuantified e1") subst e1
+                e2' = substExpr (text "substQuantified e2") subst e2
+            in Equiv e1' e2'
+
+------------------------------------------------------------------------------
+
+redundantDicts :: Quantified -> Quantified
+redundantDicts (Quantified bs cl) = go [] [] cl bs
+    where go bnds _   c [] = Quantified (reverse bnds) c
+          go bnds tys c (b:bs')
+              | isDictTy bTy = -- is a dictionary binder
+                let match = [ varToCoreExpr pb | (pb,ty) <- tys , eqType bTy ty ]
+                in if null match
+                   then go (b:bnds) ((b,bTy):tys) c bs' -- not seen before
+                   else let Quantified bs'' c' = substQuantified b (head match) $ Quantified bs' c
+                        in go bnds tys c' bs'' -- seen
+              | otherwise = go (b:bnds) tys c bs'
+            where bTy = varType b
+
+------------------------------------------------------------------------------
+
+-- | Instantiate one of the universally quantified variables in a 'Quantified'.
+-- Note: assumes implicit ordering of variables, such that substitution happens to the right
+-- as it does in case alternatives. Only first variable that matches predicate is
+-- instantiated.
+instQuantified :: MonadCatch m => VarSet        -- vars in scope
+                               -> (Var -> Bool) -- predicate to select var
+                               -> CoreExpr      -- expression to instantiate with
+                               -> Quantified -> m Quantified
+instQuantified inScope p e = liftM fst . go []
+    where go bbs (Quantified bs cl)
+            | not (any p bs) = -- not quantified at this level, so try further down
+                let go2 con q1 q2 = do
+                        er <- attemptM $ go (bs++bbs) q1
+                        (cl',s) <- case er of
+                            Right (q1',s) -> return (con q1' q2, s)
+                            Left _ -> do
+                                er' <- attemptM $ go (bs++bbs) q2
+                                case er' of
+                                    Right (q2',s) -> return (con q1 q2', s)
+                                    Left msg -> fail msg
+                        return (replaceVars s bs (Quantified [] cl'), s)
+                in case cl of
+                    Equiv{} -> fail "specified variable is not universally quantified."
+                    Conj q1 q2 -> go2 Conj q1 q2
+                    Disj q1 q2 -> go2 Disj q1 q2
+                    Impl q1 q2 -> go2 Impl q1 q2
+
+            | otherwise = do -- quantified here, so do substitution and start bubbling up
+                let (bs',i:vs) = break p bs -- this is safe because we know i is in bs
+                    (eTvs, eTy) = splitForAllTys $ exprKindOrType e
+                    bsInScope = bs'++bbs
+                    tyVars = eTvs ++ filter isTyVar bsInScope
+                    failMsg = fail "type of provided expression differs from selected binder."
+
+                    bindFn v = if v `elem` tyVars then BindMe else Skolem
+
+                sub <- maybe failMsg return $ tcUnifyTys bindFn [varType i] [eTy]
+
+                    -- if i is a tyvar, we know e is a type, so free vars will be tyvars
+                let e' = mkCoreApps e [ case lookupTyVar sub v of
+                                            Nothing -> Type (mkTyVarTy v)
+                                            Just ty -> Type ty | v <- eTvs ]
+                let newBs = varSetElems
+                          $ filterVarSet (\v -> not (isId v) || isLocalId v)
+                          $ delVarSetList (minusVarSet (freeVarsExpr e') inScope) bsInScope
+                    q' = substQuantified i e' $ Quantified vs cl
+
+                return (replaceVars sub (bs' ++ newBs) q', sub)
+
+-- | The function which 'bubbles up' after the instantiation takes place,
+-- replacing any type variables that were instantiated as a result of specialization.
+replaceVars :: TvSubst -> [Var] -> Quantified -> Quantified
+replaceVars sub vs = go (reverse vs)
+    where addB b (Quantified bs cl) = Quantified (b:bs) cl
+
+          go [] q = q
+          go (b:bs) q
+            | isTyVar b = case lookupTyVar sub b of
+                            Nothing -> go bs (addB b q)
+                            Just ty -> let new = varSetElems (freeVarsType ty)
+                                       in go (new++bs) (substQuantified b (Type ty) q)
+            | otherwise = go bs (addB b q)
+
+-- tvSubstToSubst :: TvSubst -> Subst
+-- tvSubstToSubst (TvSubst inS tEnv) = mkSubst inS tEnv emptyVarEnv emptyVarEnv
+
+-- | Instantiate a set of universally quantified variables in a 'Quantified'.
+-- It is important that all type variables appear before any value-level variables in the first argument.
+instsQuantified :: MonadCatch m => VarSet -> [(Var,CoreExpr)] -> Quantified -> m Quantified
+instsQuantified inScope = flip (foldM (\ q (v,e) -> instQuantified inScope (==v) e q)) . reverse
+-- foldM is a left-to-right fold, so the reverse is important to do substitutions in reverse order
+-- which is what we want (all value variables should be instantiated before type variables).
+
+------------------------------------------------------------------------------
+
+-- Syntactic Equality
+
+-- | Syntactic Equality of clauses.
+clauseSyntaxEq :: Clause -> Clause -> Bool
+clauseSyntaxEq (Conj q1 q2)  (Conj p1 p2)    = quantifiedSyntaxEq q1 p1 && quantifiedSyntaxEq q2 p2
+clauseSyntaxEq (Disj q1 q2)  (Disj p1 p2)    = quantifiedSyntaxEq q1 p1 && quantifiedSyntaxEq q2 p2
+clauseSyntaxEq (Impl q1 q2)  (Impl p1 p2)    = quantifiedSyntaxEq q1 p1 && quantifiedSyntaxEq q2 p2
+clauseSyntaxEq (Equiv e1 e2) (Equiv e1' e2') = exprSyntaxEq e1 e1'      && exprSyntaxEq e2 e2'
+clauseSyntaxEq _             _               = False
+
+-- | Syntactic Equality of quantifiers.
+quantifiedSyntaxEq :: Quantified -> Quantified -> Bool
+quantifiedSyntaxEq (Quantified bs1 cl1) (Quantified bs2 cl2) = (bs1 == bs2) && clauseSyntaxEq cl1 cl2
+
+------------------------------------------------------------------------------
diff --git a/src/HERMIT/Libraries/Int.hs b/src/HERMIT/Libraries/Int.hs
new file mode 100644
--- /dev/null
+++ b/src/HERMIT/Libraries/Int.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+module HERMIT.Libraries.Int where
+
+import Control.Arrow
+
+import qualified Data.Map as M
+
+import HERMIT.GHC hiding (intTy)
+import HERMIT.Kure
+import HERMIT.Lemma
+import HERMIT.Name
+import HERMIT.Dictionary.Common
+import HERMIT.Dictionary.GHC
+
+{-
+Defines the following lemmas:
+
+forall n m.  (m == n) = (n == m)
+forall n m.  (m < n ) = (n > m)
+forall n m.  (m <= n) = (n >= m)
+forall n m.  (m >= n) = (n < m)
+
+forall n m.  (m <= n) = False  =>  (m == n) = False
+forall n m.  (m == n) = True  =>  (m <= n) = True
+
+forall n m.  (min n m)  =  (min m n)
+forall n m.  (max n m)  =  (max m n)
+forall n m.  (min n m <= n) = True
+forall n m.  (max n m >= n) = True
+-}
+
+lemmas :: LemmaLibrary
+lemmas = do
+    intTy <- findTypeT "Prelude.Int"
+
+    nId <- constT $ newIdH "n" intTy
+    mId <- constT $ newIdH "m" intTy
+
+    let n = varToCoreExpr nId
+        m = varToCoreExpr mId
+        appTo i e = return $ mkCoreApp (varToCoreExpr i) e
+        appToInt i = appTo i (Type intTy)
+        appToDict e = do
+            let (aTys, _) = splitFunTys (exprType e)
+            case aTys of
+                (ty:_) | isDictTy ty -> return ty >>> buildDictionaryT >>> arr (mkCoreApp e)
+                _ -> fail "first argument is not a dictionary."
+
+        appMN e = mkCoreApps e [m,n]
+        appNM e = mkCoreApps e [n,m]
+        mkEL l r = mkL (Equiv l r)
+        mkL cl = Lemma (Quantified [mId,nId] cl) (Assumed False) NotUsed False
+        mkIL al ar cl cr = mkL (Impl (Quantified [] $ Equiv al ar) (Quantified [] $ Equiv cl cr))
+
+    eqE <- findIdT "Data.Eq.==" >>= appToInt >>= appToDict
+
+    gtE <- findIdT "Data.Ord.>" >>= appToInt >>= appToDict
+    ltE <- findIdT "Data.Ord.<" >>= appToInt >>= appToDict
+    gteE <- findIdT "Data.Ord.>=" >>= appToInt >>= appToDict
+    lteE <- findIdT "Data.Ord.<=" >>= appToInt >>= appToDict
+    minE <- findIdT "Data.Ord.min" >>= appToInt >>= appToDict
+    maxE <- findIdT "Data.Ord.max" >>= appToInt >>= appToDict
+
+    trueE <- varToCoreExpr <$> findIdT "Data.Bool.True"
+    falseE <- varToCoreExpr <$> findIdT "Data.Bool.False"
+
+    return $ M.fromList
+                [ ("EqCommutativeInt", mkEL (appMN eqE) (appNM eqE))
+                , ("LtGtInt", mkEL (appMN ltE) (appNM gtE))
+                , ("LteGteInt", mkEL (appMN lteE) (appNM gteE))
+                , ("GteLtInt", mkEL (appMN gteE) (appNM ltE))
+                , ("LteFalseImpliesEqFalseInt", mkIL (appMN lteE) falseE (appMN eqE) falseE)
+                , ("EqTrueImpliesLteTrueInt", mkIL (appMN eqE) trueE (appMN lteE) trueE)
+                , ("MinCommutativeInt", mkEL (appMN minE) (appNM minE))
+                , ("MaxCommutativeInt", mkEL (appMN maxE) (appNM maxE))
+                , ("MinLteInt", mkEL (mkCoreApps lteE [appNM minE, n]) trueE)
+                , ("MaxGteInt", mkEL (mkCoreApps gteE [appNM maxE, n]) trueE)
+                ]
diff --git a/src/HERMIT/Monad.hs b/src/HERMIT/Monad.hs
--- a/src/HERMIT/Monad.hs
+++ b/src/HERMIT/Monad.hs
@@ -1,34 +1,29 @@
-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, GADTs, InstanceSigs, KindSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE KindSignatures #-}
 
 module HERMIT.Monad
     ( -- * The HERMIT Monad
       HermitM
     , runHM
     , embedHermitM
-    , HermitMEnv(..)
+    , HermitMEnv
     , HermitMResult(..)
     , LiftCoreM(..)
     , runTcM
     , runDsM
-      -- * Saving Definitions
-    , RememberedName(..)
-    , DefStash
-    , saveDef
-    , lookupDef
-    , HasStash(..)
       -- * Lemmas
-    , Equality(..)
-    , LemmaName(..)
-    , Lemma(..)
-    , Lemmas
+    , HasLemmas(..)
     , addLemma
+    , findLemma
+    , insertLemma
+    , deleteLemma
       -- * Reader Information
     , HasHermitMEnv(..)
     , mkEnv
     , getModGuts
     , HasHscEnv(..)
-      -- * Writer Information
-    , HasLemmas(..)
       -- * Messages
     , HasDebugChan(..)
     , DebugMessage(..)
@@ -37,78 +32,50 @@
 
 import Prelude hiding (lookup)
 
-import Data.Dynamic (Typeable)
-import Data.Map
-import Data.String (IsString(..))
-
 import Control.Applicative
-import Control.Arrow
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.IO.Class
 
+import Data.Map
+
 import Language.KURE
 
 import HERMIT.Core
 import HERMIT.Context
-import HERMIT.Kure.SumTypes
 import HERMIT.GHC
 import HERMIT.GHC.Typechecker
+import HERMIT.Kure.Universes
+import HERMIT.Lemma
 
 ----------------------------------------------------------------------------
 
--- | A label for individual definitions. Use a newtype so we can tab-complete in shell.
-newtype RememberedName = RememberedName String deriving (Eq, Ord, Typeable)
-
-instance IsString RememberedName where fromString = RememberedName
-instance Show RememberedName where show (RememberedName s) = s
-
--- | A store of saved definitions.
-type DefStash = Map RememberedName CoreDef
-
--- | An equality is represented as a set of universally quantified binders, and the LHS and RHS of the equality.
-data Equality = Equality [CoreBndr] CoreExpr CoreExpr
-
--- | A name for lemmas. Use a newtype so we can tab-complete in shell.
-newtype LemmaName = LemmaName String deriving (Eq, Ord, Typeable)
-
-instance IsString LemmaName where fromString = LemmaName
-instance Show LemmaName where show (LemmaName s) = s
-
--- | An equality with a proven status.
-data Lemma = Lemma { lemmaEq :: Equality
-                   , lemmaP  :: Bool     -- whether lemma has been proven
-                   , lemmaU  :: Bool     -- whether lemma has been used
-                   }
-
--- | A collectin of named lemmas.
-type Lemmas = Map LemmaName Lemma
-
--- | The HermitM reader environment.
-data HermitMEnv = HermitMEnv { hEnvModGuts   :: ModGuts -- ^ Note: this is a snapshot of the ModGuts from
+-- | The HermitM environment.
+data HermitMEnv = HermitMEnv { hEnvChanged   :: Bool -- ^ Whether Lemmas have changed
+                             , hEnvModGuts   :: ModGuts -- ^ Note: this is a snapshot of the ModGuts from
                                                         --         before the current transformation.
-                             , hEnvStash     :: DefStash
                              , hEnvLemmas    :: Lemmas
                              }
 
-mkEnv :: ModGuts -> DefStash -> Lemmas -> HermitMEnv
-mkEnv = HermitMEnv
+mkEnv :: ModGuts -> Lemmas -> HermitMEnv
+mkEnv = HermitMEnv False
 
 -- | The HermitM result record.
-data HermitMResult a = HermitMResult { hResStash  :: DefStash
+data HermitMResult a = HermitMResult { hResChanged :: Bool -- ^ Whether Lemmas have changed
                                      , hResLemmas :: Lemmas
                                      , hResult    :: a
                                      }
 
-mkResult :: DefStash -> Lemmas -> a -> HermitMResult a
-mkResult = HermitMResult
+changedResult :: Lemmas -> a -> HermitMResult a
+changedResult = HermitMResult True
 
-mkResultEnv :: HermitMEnv -> a -> HermitMResult a
-mkResultEnv env = mkResult (hEnvStash env) (hEnvLemmas env)
+-- Does not change the Changed status of Lemmas
+mkResult :: HermitMEnv -> a -> HermitMResult a
+mkResult env = HermitMResult (hEnvChanged env) (hEnvLemmas env)
 
 -- | The HERMIT monad is kept abstract.
 --
--- It provides a reader for ModGuts, state for DefStash and Lemmas,
+-- It provides a reader for ModGuts, state for Lemmas,
 -- and access to a debugging channel.
 newtype HermitM a = HermitM { runHermitM :: DebugChan -> HermitMEnv -> CoreM (KureM (HermitMResult a)) }
 
@@ -124,7 +91,7 @@
 runHM chan env success failure ma = runHermitM ma chan env >>= runKureM success failure
 
 -- | Allow HermitM to be embedded in another monad with proper capabilities.
-embedHermitM :: (HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m) => HermitM a -> m a
+embedHermitM :: (HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m) => HermitM a -> m a
 embedHermitM hm = do
     env <- getHermitMEnv
     c <- liftCoreM $ liftIO newTChanIO -- we are careful to do IO within liftCoreM to avoid the MonadIO constraint
@@ -137,8 +104,7 @@
                 Just dm -> chan dm >> relayDebugMessages
 
     relayDebugMessages
-    putStash $ hResStash r
-    forM_ (toList (hResLemmas r)) $ uncurry insertLemma
+    forM_ (toList (hResLemmas r)) $ uncurry insertLemma -- TODO: fix
     return $ hResult r
 
 instance Functor HermitM where
@@ -154,12 +120,12 @@
 
 instance Monad HermitM where
   return :: a -> HermitM a
-  return a = HermitM $ \ _ env -> return (return (mkResultEnv env a))
+  return a = HermitM $ \ _ env -> return (return (mkResult env a))
 
   (>>=) :: HermitM a -> (a -> HermitM b) -> HermitM b
   (HermitM gcm) >>= f =
-        HermitM $ \ chan env -> gcm chan env >>= runKureM (\ (HermitMResult s ls a) ->
-                                                            let env' = env { hEnvStash = s, hEnvLemmas = ls }
+        HermitM $ \ chan env -> gcm chan env >>= runKureM (\ (HermitMResult c ls a) ->
+                                                            let env' = env { hEnvChanged = c, hEnvLemmas = ls }
                                                             in  runHermitM (f a) chan env')
                                                           (return . fail)
 
@@ -202,34 +168,12 @@
 
 ----------------------------------------------------------------------------
 
-class HasStash m where
-    -- | Get the stash of saved definitions.
-    getStash :: m DefStash
-
-    -- | Replace the stash of saved definitions.
-    putStash :: DefStash -> m ()
-
-instance HasStash HermitM where
-    getStash = HermitM $ \ _ env -> return $ return $ mkResultEnv env $ hEnvStash env
-
-    putStash s = HermitM $ \ _ env -> return $ return $ mkResult s (hEnvLemmas env) ()
-
--- | Save a definition for future use.
-saveDef :: (HasStash m, Monad m) => RememberedName -> CoreDef -> m ()
-saveDef l d = getStash >>= (insert l d >>> putStash)
-
--- | Lookup a previously saved definition.
-lookupDef :: (HasStash m, Monad m) => RememberedName -> m CoreDef
-lookupDef l = getStash >>= (lookup l >>> maybe (fail "Definition not found.") return)
-
-----------------------------------------------------------------------------
-
 class HasHermitMEnv m where
     -- | Get the HermitMEnv
     getHermitMEnv :: m HermitMEnv
 
 instance HasHermitMEnv HermitM where
-    getHermitMEnv = HermitM $ \ _ env -> return $ return $ mkResultEnv env env
+    getHermitMEnv = HermitM $ \ _ env -> return $ return $ mkResult env env
 
 getModGuts :: (HasHermitMEnv m, Monad m) => m ModGuts
 getModGuts = liftM hEnvModGuts getHermitMEnv
@@ -241,7 +185,7 @@
     getDebugChan :: m (DebugMessage -> m ())
 
 instance HasDebugChan HermitM where
-    getDebugChan = HermitM $ \ chan env -> return $ return $ mkResultEnv env chan
+    getDebugChan = HermitM $ \ chan env -> return $ return $ mkResult env chan
 
 sendDebugMessage :: (HasDebugChan m, Monad m) => DebugMessage -> m ()
 sendDebugMessage msg = getDebugChan >>= ($ msg)
@@ -260,15 +204,23 @@
 ----------------------------------------------------------------------------
 
 class HasLemmas m where
-    -- | Add (or replace) a named lemma.
-    insertLemma :: LemmaName -> Lemma -> m ()
-
     getLemmas :: m Lemmas
+    putLemmas :: Lemmas -> m ()
+    withLemmas :: Lemmas -> m a -> m a
 
 instance HasLemmas HermitM where
-    insertLemma nm l = HermitM $ \ _ env -> return $ return $ mkResult (hEnvStash env) (insert nm l $ hEnvLemmas env) ()
+    getLemmas = HermitM $ \ _ env -> return $ return $ mkResult env (hEnvLemmas env)
+    putLemmas m = HermitM $ \ _ _ -> return $ return $ changedResult m ()
+    withLemmas ls (HermitM f) = HermitM $ \ d env -> do
+                                    kr <- f d (env { hEnvLemmas = union ls (hEnvLemmas env) })
+                                    runKureM (\ (HermitMResult c ls' a) ->
+                                                    let ls'' = difference ls' ls
+                                                    in return $ return $ HermitMResult c ls'' a)
+                                             (return . fail) kr
 
-    getLemmas = HermitM $ \ _ env -> return $ return $ mkResultEnv env (hEnvLemmas env)
+-- | Insert or replace a lemma.
+insertLemma :: (HasLemmas m, Monad m) => LemmaName -> Lemma -> m ()
+insertLemma nm l = getLemmas >>= putLemmas . insert nm l
 
 -- | Only adds a lemma if doesn't already exist.
 addLemma :: (HasLemmas m, Monad m) => LemmaName -> Lemma -> m ()
@@ -276,6 +228,15 @@
     ls <- getLemmas
     maybe (insertLemma nm l) (\ _ -> return ()) (lookup nm ls)
 
+-- | Find a lemma by name. Fails if lemma does not exist.
+findLemma :: (HasLemmas m, Monad m) => LemmaName -> m Lemma
+findLemma nm = do
+    r <- liftM (lookup nm) getLemmas
+    maybe (fail $ "lemma does not exist: " ++ show nm) return r
+
+deleteLemma :: (HasLemmas m, Monad m) => LemmaName -> m ()
+deleteLemma nm = getLemmas >>= putLemmas . delete nm
+
 ----------------------------------------------------------------------------
 
 class Monad m => LiftCoreM m where
@@ -283,14 +244,14 @@
     liftCoreM :: CoreM a -> m a
 
 instance LiftCoreM HermitM where
-    liftCoreM coreM = HermitM $ \ _ env -> coreM >>= return . return . mkResultEnv env
+    liftCoreM coreM = HermitM $ \ _ env -> coreM >>= return . return . mkResult env
 
 ----------------------------------------------------------------------------
 
 -- | A message packet.
 data DebugMessage :: * where
-    DebugTick ::                                       String                -> DebugMessage
-    DebugCore :: (ReadBindings c, ReadPath c Crumb) => String -> c -> CoreTC -> DebugMessage
+    DebugTick ::                                       String                 -> DebugMessage
+    DebugCore :: (ReadBindings c, ReadPath c Crumb) => String -> c -> LCoreTC -> DebugMessage
 
 ----------------------------------------------------------------------------
 
diff --git a/src/HERMIT/Name.hs b/src/HERMIT/Name.hs
--- a/src/HERMIT/Name.hs
+++ b/src/HERMIT/Name.hs
@@ -33,6 +33,7 @@
     , newCoVarH
     , newVarH
     , cloneVarH
+    , cloneVarFSH
       -- * Name Lookup
     , findId
     , findVar
@@ -99,7 +100,7 @@
 -- like GHC's 'RdrName', but without specifying which 'NameSpace'
 -- the name is found in.
 data HermitName = HermitName { hnModuleName  :: Maybe ModuleName
-                             , hnUnqualified :: String
+                             , hnUnqualified :: FastString
                              }
     deriving (Eq, Typeable)
 
@@ -123,16 +124,16 @@
     | Just mn <- hm
     , Just m  <- nameModule_maybe n = (mn == moduleName m) && sameOccName
     | otherwise     = sameOccName
-    where sameOccName = nm == unqualifiedName n
+    where sameOccName = nm == occNameFS (getOccName n)
 
 -- | Make a qualified HermitName from a String representing the module name
 -- and a String representing the occurrence name.
 mkQualified :: String -> String -> HermitName
-mkQualified mnm nm = HermitName (Just $ mkModuleName mnm) nm
+mkQualified mnm = HermitName (Just $ mkModuleName mnm) . mkFastString
 
 -- | Make an unqualified HermitName from a String.
 mkUnqualified :: String -> HermitName
-mkUnqualified = HermitName Nothing
+mkUnqualified = HermitName Nothing . mkFastString
 
 -- | Parse a HermitName from a String.
 parseName :: String -> HermitName
@@ -149,18 +150,18 @@
 
 -- | Turn a HermitName into a (possibly fully-qualified) String.
 showName :: HermitName -> String
-showName (HermitName mnm nm) = maybe id (\ m n -> moduleNameString m ++ ('.' : n)) mnm nm
+showName (HermitName mnm nm) = maybe id (\ m n -> moduleNameString m ++ ('.' : n)) mnm $ unpackFS nm
 
 -- | Make a HermitName from a RdrName
 fromRdrName :: RdrName -> HermitName
 fromRdrName nm = case isQual_maybe nm of
-                    Nothing         -> HermitName Nothing    (occNameString $ rdrNameOcc nm)
-                    Just (mnm, onm) -> HermitName (Just mnm) (occNameString onm)
+                    Nothing         -> HermitName Nothing    (occNameFS $ rdrNameOcc nm)
+                    Just (mnm, onm) -> HermitName (Just mnm) (occNameFS onm)
 
 -- | Make a RdrName for the given NameSpace and HermitName
 toRdrName :: NameSpace -> HermitName -> RdrName
 toRdrName ns (HermitName mnm nm) = maybe (mkRdrUnqual onm) (flip mkRdrQual onm) mnm
-    where onm = mkOccName ns nm
+    where onm = mkOccNameFS ns nm
 
 -- | Make a RdrName for each given NameSpace.
 toRdrNames :: [NameSpace] -> HermitName -> [RdrName]
@@ -327,33 +328,25 @@
               | isTyVarName n   = fail "nameToNamed: impossible, TyVars are not exported and cannot be looked up."
               | otherwise       = fail "nameToNamed: unknown name type"
 
--- Someday, when Applicative is a superclass of monad, we can uncomment the
--- nicer applicative definitions. For now, we don't want the extra constraint.
-
 -- | Make a 'Name' from a string.
 newName :: MonadUnique m => String -> m Name
-newName nm = getUniqueM >>= return . flip mkSystemVarName (mkFastString nm)
--- newName nm = mkSystemVarName <$> getUniqueM <*> pure (mkFastString nm)
+newName nm = mkSystemVarName <$> getUniqueM <*> return (mkFastString nm)
 
 -- | Make a unique global identifier for a specified type, using a provided name.
 newGlobalIdH :: MonadUnique m => String -> Type -> m Id
-newGlobalIdH nm ty = newName nm >>= return . flip mkVanillaGlobal ty
--- newGlobalIdH nm ty = mkVanillaGlobal <$> newName nm <*> pure ty
+newGlobalIdH nm ty = mkVanillaGlobal <$> newName nm <*> return ty
 
 -- | Make a unique identifier for a specified type, using a provided name.
 newIdH :: MonadUnique m => String -> Type -> m Id
-newIdH nm ty = newName nm >>= return . flip mkLocalId ty
--- newIdH nm ty = mkLocalId <$> newName nm <*> pure ty
+newIdH nm ty = mkLocalId <$> newName nm <*> return ty
 
 -- | Make a unique type variable for a specified kind, using a provided name.
 newTyVarH :: MonadUnique m => String -> Kind -> m TyVar
-newTyVarH nm k = newName nm >>= return . flip mkTyVar k
--- newTyVarH nm k = mkTyVar <$> newName nm <*> pure k
+newTyVarH nm k = mkTyVar <$> newName nm <*> return k
 
 -- | Make a unique coercion variable for a specified type, using a provided name.
 newCoVarH :: MonadUnique m => String -> Type -> m TyVar
-newCoVarH nm ty = newName nm >>= return . flip mkCoVar ty
--- newCoVarH nm ty = mkCoVar <$> newName nm <*> pure ty
+newCoVarH nm ty = mkCoVar <$> newName nm <*> return ty
 
 -- TODO: not sure if the predicates are correct.
 -- | Experimental, use at your own risk.
@@ -370,4 +363,14 @@
                     | otherwise = fail "If this variable isn't a type, coercion or identifier, then what is it?"
   where
     name = nameMod (unqualifiedName v)
+    ty   = varType v
+
+-- | Make a new variable of the same type, with a modified textual name.
+cloneVarFSH :: MonadUnique m => (FastString -> FastString) -> Var -> m Var
+cloneVarFSH nameMod v | isTyVar v = newTyVarH name ty
+                      | isCoVar v = newCoVarH name ty
+                      | isId v    = newIdH name ty
+                      | otherwise = fail "If this variable isn't a type, coercion or identifier, then what is it?"
+  where
+    name = unpackFS $ nameMod $ occNameFS $ getOccName v
     ty   = varType v
diff --git a/src/HERMIT/ParserCore.y b/src/HERMIT/ParserCore.y
--- a/src/HERMIT/ParserCore.y
+++ b/src/HERMIT/ParserCore.y
@@ -1,5 +1,6 @@
 {
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
 module HERMIT.ParserCore
     ( parseCore
     , parseCoreExprT
@@ -17,6 +18,7 @@
 import Control.Arrow
 import Control.Monad.Reader
 import Data.Char (isSpace, isDigit)
+import qualified Data.Map as M
 
 import HERMIT.Context
 import HERMIT.External
@@ -168,27 +170,35 @@
 
 ---------------------------------------------
 
-parseCore :: BoundVars c => CoreString -> c -> HermitM CoreExpr
+parseCore :: ReadBindings c => CoreString -> c -> HermitM CoreExpr
 parseCore (CoreString s) c =
     case lexer s of
         Left msg -> fail msg
-        Right tokens -> runReaderT (parser tokens) (boundVars c)
+        Right tokens ->
+            -- Since we are comparing occurrence names, only take the
+            -- most recently defined (deepest) when variables shadow each other.
+            let comb v1@(_,d1) v2@(_,d2) = if d1 > d2 then v1 else v2
+                vars = mkVarSet . map fst . M.elems
+                     $ M.mapKeysWith comb getOccString
+                     $ M.mapWithKey (\k -> (k,) . hbDepth)
+                     $ hermitBindings c
+            in runReaderT (parser tokens) vars
 
 ---------------------------------------------
 
 -- These should probably go somewhere else.
 
 -- | Parse a 'CoreString' to a 'CoreExpr', using the current context.
-parseCoreExprT :: (BoundVars c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m)
+parseCoreExprT :: (ReadBindings c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m)
                => CoreString -> Transform c m a CoreExpr
 parseCoreExprT cs = contextonlyT $ embedHermitM . parseCore cs
 
-parse2BeforeT :: (BoundVars c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m)
+parse2BeforeT :: (ReadBindings c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m)
               => (CoreExpr -> CoreExpr -> Translate c m a b)
               -> CoreString -> CoreString -> Translate c m a b
 parse2BeforeT f s1 s2 = parseCoreExprT s1 &&& parseCoreExprT s2 >>= uncurry f
 
-parse3BeforeT :: (BoundVars c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, HasStash m, LiftCoreM m)
+parse3BeforeT :: (ReadBindings c, HasDebugChan m, HasHermitMEnv m, HasLemmas m, LiftCoreM m)
               => (CoreExpr -> CoreExpr -> CoreExpr -> Translate c m a b)
               -> CoreString -> CoreString -> CoreString -> Translate c m a b
 parse3BeforeT f s1 s2 s3 = (parseCoreExprT s1 &&& parseCoreExprT s2) &&& parseCoreExprT s3 >>= (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,4 +1,5 @@
-{-# LANGUAGE KindSignatures, GADTs, FlexibleContexts, GeneralizedNewtypeDeriving, LambdaCase, CPP #-}
+{-# LANGUAGE KindSignatures, GADTs, FlexibleContexts, GeneralizedNewtypeDeriving, LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 module HERMIT.Plugin
     ( -- * The HERMIT Plugin
       hermitPlugin
@@ -31,21 +32,19 @@
 import Control.Applicative
 import Control.Arrow
 import Control.Concurrent.STM
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except hiding (guard)
-#else
-import Control.Monad.Error hiding (guard)
-#endif
+import Control.Monad (when)
+import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Operational
-import Control.Monad.State hiding (guard)
+import Control.Monad.State (gets, modify)
+import Control.Monad.Trans.Class (MonadTrans(..))
 
-import Data.Monoid
+import Data.IORef
 import qualified Data.Map as M
+import Data.Monoid
 
 import HERMIT.Dictionary
 import HERMIT.External hiding (Query, Shell)
-import HERMIT.Kernel (KernelEnv)
-import HERMIT.Kernel.Scoped
+import HERMIT.Kernel
 import HERMIT.Context
 import HERMIT.Kure
 import HERMIT.GHC hiding (singleton, liftIO, display, (<>))
@@ -64,13 +63,14 @@
 import Prelude hiding (until)
 
 hermitPlugin :: ([CommandLineOption] -> HPM ()) -> Plugin
-hermitPlugin f = buildPlugin $ \ passInfo -> runHPM passInfo . f
+hermitPlugin f = buildPlugin $ \ store passInfo -> runHPM store passInfo . f
 
-defPS :: SAST -> ScopedKernel -> PassInfo -> IO PluginState
-defPS initSAST kernel passInfo = do
+defPS :: AST -> Kernel -> PassInfo -> IO PluginState
+defPS initAST kernel passInfo = do
     emptyTick <- liftIO $ atomically $ newTVar M.empty
     return $ PluginState
-                { ps_cursor         = initSAST
+                { ps_cursor         = initAST
+                , ps_focus          = mempty
                 , ps_pretty         = Clean.pretty
                 , ps_render         = unicodeConsole
                 , ps_tick           = emptyTick
@@ -91,17 +91,22 @@
 newtype HPM a = HPM { unHPM :: ProgramT HPMInst PluginM a }
     deriving (Functor, Applicative, Monad, MonadIO)
 
-runHPM :: PassInfo -> HPM () -> ModGuts -> CoreM ModGuts
-runHPM passInfo hpass = scopedKernel $ \ kernel initSAST -> do
-    ps <- defPS initSAST kernel passInfo
+lpName :: PassInfo -> String
+lpName pInfo = case passesDone pInfo of
+                    [] -> "-- front end" -- comment format in case these appear in dumped script
+                    ps -> "-- GHC - " ++ show (last ps)
+
+runHPM :: IORef (Maybe (AST, ASTMap)) -> PassInfo -> HPM () -> ModGuts -> CoreM ModGuts
+runHPM store passInfo hpass = hermitKernel store (lpName passInfo) $ \ kernel initAST -> do
+    ps <- defPS initAST kernel passInfo
     (r,st) <- hpmToIO ps hpass
-    let cleanup sast = do
-            if sast /= initSAST -- only do this if we actually changed the AST
-            then applyS kernel occurAnalyseAndDezombifyR (mkKernelEnv st) sast >>= resumeS kernel
-            else resumeS kernel sast
-    either (\case PAbort       -> abortS kernel
-                  PResume sast -> cleanup sast
-                  PError  err  -> putStrLn err >> abortS kernel)
+    let cleanup ast = do
+            if ast /= initAST -- only do this if we actually changed the AST
+            then applyK kernel (extractR (occurAnalyseAndDezombifyR :: RewriteH Core)) Never (mkKernelEnv st) ast >>= resumeK kernel
+            else resumeK kernel ast
+    either (\case PAbort      -> abortK kernel
+                  PResume ast -> cleanup ast
+                  PError  err -> putStrLn err >> abortK kernel)
            (\ _ -> cleanup $ ps_cursor st) r
 
 hpmToIO :: PluginState -> HPM a -> IO (Either PException a, PluginState)
@@ -109,63 +114,37 @@
 
 eval :: ProgramT HPMInst PluginM a -> PluginM a
 eval comp = do
-    (kernel, env) <- gets $ ps_kernel &&& mkKernelEnv
+    (kernel, (env, path)) <- gets $ ps_kernel &&& mkKernelEnv &&& ps_focus
     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 interpShellCommand os es)
-            _ <- resetScoping env
-            restoreScoping env paths
-            eval $ k ()
+        Return x           -> return x
+        RR rr       :>>= k -> runS (applyK kernel (extractR $ localPathR path rr) Never env) >>= eval . k
+        Query tr    :>>= k -> runQ (queryK kernel (extractT $ localPathT path tr) Never env) >>= eval . k
+        Shell es os :>>= k -> clm (commandLine os es) >>= eval . k
         Guard p (HPM m)  :>>= k  -> gets (p . ps_pass) >>= \ 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
+            p <- runQ (queryK kernel (extractT tp) Never env)  -- run the pathfinding translation
+            old_p <- gets ps_focus
+            modify $ \st -> st { ps_focus = old_p <> p }
             r <- eval m             	      -- run the focused computation
-            runS $ endScopeS kernel           -- endscope on it, so we go back to where we started
+            modify $ \st -> st { ps_focus = old_p }
             eval $ k r
 
 ------------------------- Shell-related helpers --------------------------------------
 
-resetScoping :: KernelEnv -> 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 :: KernelEnv -> [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
+-- | Run a kernel function on the current AST
+runK :: (AST -> 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
+-- | Run a kernel function on the current AST and update ps_cursor
+runS :: (AST -> PluginM AST) -> PluginM ()
+runS f = runQ (fmap (,()) . f)
+
+runQ :: (AST -> PluginM (AST, a)) -> PluginM a
+runQ f = do
+    (sast, r) <- runK f
     modify $ \st -> st { ps_cursor = sast }
+    return r
 
 interactive :: [External] -> [CommandLineOption] -> HPM ()
 interactive es os = HPM . singleton $ Shell (externals ++ es) os
@@ -215,7 +194,7 @@
 getPassInfo = HPM $ lift $ gets ps_pass
 
 display :: HPM ()
-display = HPM $ lift $ Display.display Nothing
+display = HPM $ lift $ Display.display Nothing Nothing
 
 modifyCLS :: (PluginState -> PluginState) -> HPM ()
 modifyCLS = HPM . modify
diff --git a/src/HERMIT/Plugin/Builder.hs b/src/HERMIT/Plugin/Builder.hs
--- a/src/HERMIT/Plugin/Builder.hs
+++ b/src/HERMIT/Plugin/Builder.hs
@@ -2,7 +2,7 @@
 
 module HERMIT.Plugin.Builder
     ( -- * The HERMIT Plugin
-      PluginPass
+      HERMITPass
     , buildPlugin
     , CorePass(..)
     , getCorePass
@@ -11,16 +11,19 @@
     , getPassFlag
     )  where
 
+import Data.IORef
 import Data.List
-import System.IO
 
 import HERMIT.GHC
+import HERMIT.Kernel
 
+import System.IO
+
 -- | Given a list of 'CommandLineOption's, produce the 'ModGuts' to 'ModGuts' function required to build a plugin.
-type PluginPass = PassInfo -> [CommandLineOption] -> ModGuts -> CoreM ModGuts
+type HERMITPass = IORef (Maybe (AST, ASTMap)) -> PassInfo -> [CommandLineOption] -> ModGuts -> CoreM ModGuts
 
 -- | Build a plugin. This mainly handles the per-module options.
-buildPlugin :: PluginPass -> Plugin
+buildPlugin :: HERMITPass -> Plugin
 buildPlugin hp = defaultPlugin { installCoreToDos = install }
     where
         install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
@@ -36,36 +39,50 @@
             liftIO initStaticOpts
 #endif
 
+            store <- liftIO $ newIORef (Nothing :: Maybe (ModuleName, IORef (Maybe (AST, ASTMap))))
             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 (PassInfo n ps ps') opts
+                mkPass n ps ps' = CoreDoPluginPass ("HERMIT" ++ show n)
+                                $ modFilter store hp (PassInfo n ps ps') opts
 
             return allPasses
 
--- | Determine whether to act on this module, choose plugin pass.
+-- | Determine whether to act on this module, selecting global store.
 -- NB: we have the ability to stick module info in the pass info here
-modFilter :: PluginPass -> PluginPass
-modFilter hp pInfo opts guts
+modFilter :: IORef (Maybe (ModuleName, IORef (Maybe (AST, ASTMap)))) -- global store
+          -> HERMITPass
+          -> PassInfo
+          -> [CommandLineOption]
+          -> ModGuts -> CoreM ModGuts
+modFilter store 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
+    | otherwise                    = do mb <- liftIO $ readIORef store
+                                        modStore <- case mb of
+                                                        Just (nm,ref) | nm == modName -> return ref
+                                                        _ -> liftIO $ do
+                                                            ref <- newIORef Nothing
+                                                            writeIORef store $ Just (modName, ref)
+                                                            return ref
+                                        hp modStore pInfo (h_opts ++ filter notNull modOpts) guts
+    where modOpts = filterOpts m_opts modName
           (m_opts, h_opts) = partition (isInfixOf ":") opts
+          modName = moduleName $ mg_module guts
 
 -- | 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
+filterOpts :: [CommandLineOption] -> ModuleName -> [CommandLineOption]
+filterOpts opts mname = [ 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 mname
+          len = lengthFS (moduleNameFS mname) + 1 -- for the colon
 
 -- | An enumeration type for GHC's passes.
 data CorePass = FloatInwards
diff --git a/src/HERMIT/Plugin/Display.hs b/src/HERMIT/Plugin/Display.hs
--- a/src/HERMIT/Plugin/Display.hs
+++ b/src/HERMIT/Plugin/Display.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 module HERMIT.Plugin.Display
     ( display
-    , getFocusPath
     , ps_putStr
     , ps_putStrLn
     ) where
@@ -9,28 +8,25 @@
 import Control.Monad.State
 
 import Data.Maybe (fromMaybe)
+import Data.Monoid
 
-import HERMIT.Kernel (queryK)
-import HERMIT.Kernel.Scoped
+import HERMIT.Kernel (queryK, CommitMsg(..))
 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
+display :: Maybe Handle -> Maybe PathH -> PluginM ()
+display mbh window = do
     st <- get
-    focusPath <- getFocusPath
-    let skernel = ps_kernel st
-        ppOpts = (pOptions $ ps_pretty st) { po_focus = Just focusPath }
-    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 $ pCoreTC $ ps_pretty st) (mkKernelEnv st))
+    let k = ps_kernel st
+        ast = ps_cursor st
+        ppOpts = pOptions $ ps_pretty st
+        h = fromMaybe stdout mbh
+    d <- queryK k (extractT $ pathT (fromMaybe mempty window) $ liftPrettyH ppOpts $ pCoreTC $ ps_pretty st)
+                Never (mkKernelEnv st) ast
+    liftIO $ ps_render st h ppOpts $ Right $ snd d -- discard new AST, assuming pretty printer won't create one
 
 ps_putStr :: (MonadIO m, MonadState PluginState m) => String -> m ()
 ps_putStr str = do
diff --git a/src/HERMIT/Plugin/Renderer.hs b/src/HERMIT/Plugin/Renderer.hs
--- a/src/HERMIT/Plugin/Renderer.hs
+++ b/src/HERMIT/Plugin/Renderer.hs
@@ -25,10 +25,10 @@
 import System.Process
 
 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 }
+changeRenderer renderer =
+    case lookup renderer shellRenderers of
+        Nothing -> fail "bad renderer option."
+        Just r  -> modify $ \ st -> st { ps_render = r }
 
 shellRenderers :: [(String,Handle -> PrettyOptions -> Either String DocH -> IO ())]
 shellRenderers = [ ("unicode-terminal", unicodeConsole) ]
diff --git a/src/HERMIT/Plugin/Types.hs b/src/HERMIT/Plugin/Types.hs
--- a/src/HERMIT/Plugin/Types.hs
+++ b/src/HERMIT/Plugin/Types.hs
@@ -1,45 +1,42 @@
 {-# LANGUAGE TypeFamilies, DeriveDataTypeable, FlexibleContexts,
              LambdaCase, GADTs, GeneralizedNewtypeDeriving,
-             ScopedTypeVariables, FlexibleInstances, CPP #-}
+             ScopedTypeVariables, FlexibleInstances #-}
 module HERMIT.Plugin.Types where
 
 import Control.Applicative
 import Control.Concurrent.STM
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except
-#else
-import Control.Monad.Error
-#endif
-import Control.Monad.State
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.State (MonadState(..), StateT(..))
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 
 import Data.Dynamic
 import qualified Data.Map as M
 
+import HERMIT.Core (Crumb)
 import HERMIT.Kure
 import HERMIT.External
-import HERMIT.Kernel (KernelEnv(..))
-import HERMIT.Kernel.Scoped
+import HERMIT.Kernel
 import HERMIT.Monad
 import HERMIT.Plugin.Builder
 import HERMIT.PrettyPrinter.Common
+import HERMIT.Dictionary.Reasoning
 
 import System.IO
 
 type PluginM = PluginT IO
-#if MIN_VERSION_mtl(2,2,1)
 newtype PluginT m a = PluginT { unPluginT :: ExceptT PException (StateT PluginState m) a }
-#else
-newtype PluginT m a = PluginT { unPluginT :: ErrorT PException (StateT PluginState m) a }
-#endif
-    deriving (Functor, Applicative, Monad, MonadIO, MonadError PException, MonadState PluginState)
+    deriving (Functor, Applicative, MonadIO, MonadError PException, MonadState PluginState)
 
 runPluginT :: PluginState -> PluginT m a -> m (Either PException a, PluginState)
-#if MIN_VERSION_mtl(2,2,1)
 runPluginT ps = flip runStateT ps . runExceptT . unPluginT
-#else
-runPluginT ps = flip runStateT ps . runErrorT . unPluginT
-#endif
 
+instance Monad m => Monad (PluginT m) where
+    return = PluginT . return
+    PluginT m >>= k = PluginT (m >>= unPluginT . k)
+    fail = PluginT . throwError . PError
+
 instance MonadTrans PluginT where
     lift = PluginT . lift . lift
 
@@ -57,7 +54,8 @@
 
 -- Session-local issues; things that are never saved.
 data PluginState = PluginState
-    { ps_cursor         :: SAST                                     -- ^ the current AST
+    { ps_cursor         :: AST                                      -- ^ the current AST
+    , ps_focus          :: AbsolutePath Crumb                       -- ^ current focused path
     , ps_pretty         :: PrettyPrinter                            -- ^ which pretty printer to use
     , ps_render         :: Handle -> PrettyOptions -> Either String DocH -> IO () -- ^ the way of outputing to the screen
     , ps_tick           :: TVar (M.Map String Int)                  -- ^ the list of ticked messages
@@ -65,15 +63,11 @@
     , 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_kernel         :: Kernel
     , ps_pass           :: PassInfo
     } deriving (Typeable)
 
-data PException = PAbort | PResume SAST | PError String
-
-#if !(MIN_VERSION_mtl(2,2,1))
-instance Error PException where strMsg = PError
-#endif
+data PException = PAbort | PResume AST | PError String
 
 newtype PSBox = PSBox PluginState deriving Typeable
 instance Extern PluginState where
@@ -100,16 +94,7 @@
                 DebugTick    msg'      -> do
                         c <- liftIO $ tick (ps_tick st) msg'
                         out $ "<" ++ show c ++ "> " ++ msg'
-                DebugCore  msg' cxt core -> do
+                DebugCore  msg' cxt qc -> do
                         out $ "[" ++ msg' ++ "]"
-                        doc :: DocH <- applyT (pCoreTC pp) (liftPrettyC (pOptions pp) cxt) (inject core)
+                        doc :: DocH <- applyT (ppLCoreTCT pp) (liftPrettyC (pOptions pp) cxt) qc
                         liftIO $ ps_render st stdout (pOptions pp) (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
@@ -3,7 +3,8 @@
 -- | Output the raw Expr constructors. Helpful for writing pattern matching rewrites.
 module HERMIT.PrettyPrinter.AST
   ( -- * HERMIT's AST Pretty-Printer for GHC Core
-    pretty
+    externals
+  , pretty
   , ppCoreTC
   , ppModGuts
   , ppCoreProg
@@ -19,14 +20,13 @@
 import Control.Arrow hiding ((<+>))
 
 import Data.Char (isSpace)
-import Data.Default
+import Data.Default.Class
 
+import HERMIT.Core
+import HERMIT.External
 import HERMIT.GHC hiding (($$), (<+>), (<>), ($+$), cat, nest, parens, text, empty, hsep)
 import HERMIT.Kure
-import HERMIT.Core
 
-import HERMIT.Dictionary (dynFlagsT)
-
 import HERMIT.PrettyPrinter.Common
 
 import Text.PrettyPrint.MarkedHughesPJ as PP
@@ -41,11 +41,14 @@
 
 ---------------------------------------------------------------------------
 
+externals :: [External]
+externals = [ external "ast" pretty ["AST pretty printer."] ]
+
 pretty :: PrettyPrinter
 pretty = PP { pForall = ppForallQuantification
             , pCoreTC = ppCoreTC
             , pOptions = def
-            } 
+            }
 
 -- | Pretty print a fragment of GHC Core using HERMIT's \"AST\" pretty printer.
 --   This displays the tree of constructors using nested indentation.
@@ -63,7 +66,7 @@
 -- Use for any GHC structure, the 'showSDoc' prefix is to remind us
 -- that we are eliding infomation here.
 ppSDoc :: Outputable a => PrettyH a
-ppSDoc =  do dynFlags   <- dynFlagsT
+ppSDoc =  do dynFlags   <- constT getDynFlags
              hideNotes  <- (po_notes . prettyC_options) ^<< contextT
              arr (toDoc . (if hideNotes then id else ("showSDoc: " ++)) . showPpr dynFlags)
     where toDoc s | any isSpace s = parens (text s)
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
@@ -2,7 +2,8 @@
 
 module HERMIT.PrettyPrinter.Clean
     ( -- * HERMIT's Clean Pretty-Printer for GHC Core
-      pretty
+      externals
+    , pretty
     , ppCoreTC
     , ppModGuts
     , ppCoreProg
@@ -12,18 +13,18 @@
     , ppKindOrType
     , ppCoercion
     , ppForallQuantification
+    , symbol -- should be in Common
     ) where
 
 import Control.Arrow hiding ((<+>))
-import Control.Applicative ((<$>))
 
 import Data.Char (isSpace)
-import Data.Default
+import Data.Default.Class
 import Data.Monoid (mempty)
 
 import HERMIT.Context
 import HERMIT.Core
-import HERMIT.Dictionary (dynFlagsT)
+import HERMIT.External
 import HERMIT.GHC hiding ((<+>), (<>), ($$), ($+$), cat, sep, fsep, hsep, empty, nest, vcat, char, text, keyword, hang)
 import HERMIT.Kure
 import HERMIT.Monad
@@ -34,6 +35,9 @@
 
 ------------------------------------------------------------------------------------------------
 
+externals :: [External]
+externals = [ external "clean" pretty ["Clean pretty printer."] ]
+
 pretty :: PrettyPrinter
 pretty = PP { pForall = ppForallQuantification
             , pCoreTC = ppCoreTC
@@ -215,7 +219,7 @@
 
 -- Use for any GHC structure
 ppSDoc :: Outputable a => PrettyH a
-ppSDoc = do dynFlags <- dynFlagsT
+ppSDoc = do dynFlags <- constT getDynFlags
             p        <- absPathT
             doc      <- arr (showPpr dynFlags)
             if any isSpace doc
@@ -263,6 +267,12 @@
 ppTyConCo :: PrettyH TyCon
 ppTyConCo = getName ^>> ppName CoercionColor
 
+ppDetailedVar :: PrettyH Var
+ppDetailedVar = do
+    p <- absPathT
+    (v,ty) <- ppVar &&& (varType ^>> ppKindOrType)
+    return $ cleanParens p $ v <+> typeOfSymbol p <+> ty
+
 -- binders are vars that is bound by lambda or case, etc.
 -- depending on the mode, they might not be displayed
 ppBinderMode :: PrettyH Var
@@ -273,15 +283,19 @@
                      | isTyVar v -> case po_exprTypes opts of
                                                            Omit     -> return empty
                                                            Abstract -> return (typeBindSymbol p)
+                                                           Detailed -> ppDetailedVar
                                                            _        -> ppVar
                      | isCoVar v -> case po_coercions opts of
                                                            Omit     -> return empty
                                                            Abstract -> return (coercionBindSymbol p)
+                                                           Detailed -> ppDetailedVar
                                                            Show     -> ppVar
                                                            Kind     -> do pCoKind <- ppCoKind <<^ CoVarCo
                                                                           return $ cleanParens p (coercionBindSymbol p <+> typeOfSymbol p <+> pCoKind)
                                                           -- TODO: refactor this to be more systematic.  It should be possible to request type sigs for all type bindings.
-                     | otherwise       -> ppVar
+                     | otherwise -> case po_exprTypes opts of
+                                        Detailed -> ppDetailedVar
+                                        _        -> ppVar
 
 ppModGuts :: PrettyH ModGuts
 ppModGuts = do p    <- absPathT
@@ -409,7 +423,7 @@
   do vs <- mapT ppBinderMode
      if null vs
      then return empty
-     else return $ specialSymbol mempty ForallSymbol <+> hsep vs <> symbol mempty '.'
+     else return $ specialSymbol mempty ForallSymbol <+> sep vs <> symbol mempty '.'
 
 --------------------------------------------------------------------
 
@@ -422,8 +436,8 @@
                      case po_coercions opts of
                        Omit     -> return RetEmpty
                        Abstract -> return (RetAtom $ coercionSymbol p)
-                       Show     -> ppCoercionR
                        Kind     -> ppCoKind >>^ (\ k -> RetExpr (coercionSymbol p <+> coTypeSymbol p <+> k))
+                       _        -> ppCoercionR
 
 ppCoercionR :: Transform PrettyC HermitM Coercion RetExpr
 ppCoercionR = absPathT >>= ppCoercionPR
diff --git a/src/HERMIT/PrettyPrinter/Common.hs b/src/HERMIT/PrettyPrinter/Common.hs
--- a/src/HERMIT/PrettyPrinter/Common.hs
+++ b/src/HERMIT/PrettyPrinter/Common.hs
@@ -6,6 +6,7 @@
     , Attr(..)
     , attrP
     , HTML(..)
+    , ASCII(..)
       -- ** Colors
     , coercionColor
     , idColor
@@ -28,12 +29,14 @@
       -- * Pretty Printer Traversals
     , PrettyPrinter(..)
     , PrettyH
+    , PrettyHLCoreBox(..)
+    , PrettyHLCoreTCBox(..)
+    , TransformLCoreDocHBox(..)
+    , TransformLCoreTCDocHBox(..)
     , liftPrettyH
     , PrettyC(..)
     , initPrettyC
     , liftPrettyC
-    , TransformDocH(..)
-    , TransformCoreTCDocHBox(..)
       -- * Pretty Printer Options
     , PrettyOptions(..)
     , updateCoShowOption
@@ -47,7 +50,7 @@
     ) where
 
 import Data.Char
-import Data.Default
+import Data.Default.Class
 import Data.Monoid hiding ((<>))
 import qualified Data.Map as M
 import Data.Typeable
@@ -69,16 +72,6 @@
 -- A HERMIT document
 type DocH = MDoc HermitMark
 
--- newtype wrapper for proper instance selection
-newtype TransformDocH a = TransformDocH { unTransformDocH :: PrettyC -> PrettyH a -> TransformH a DocH }
-
-data TransformCoreTCDocHBox = TransformCoreTCDocHBox (TransformDocH CoreTC) deriving Typeable
-
-instance Extern (TransformDocH CoreTC) where
-    type Box (TransformDocH CoreTC) = TransformCoreTCDocHBox
-    box = TransformCoreTCDocHBox
-    unbox (TransformCoreTCDocHBox i) = i
-
 -- These are the zero-width marks on the document
 data HermitMark
         = PushAttr Attr
@@ -133,10 +126,46 @@
                         , pCoreTC  :: PrettyH CoreTC
                         , pOptions :: PrettyOptions
                         }
+    deriving Typeable
 
+instance Extern PrettyPrinter where
+    type Box PrettyPrinter = PrettyPrinter
+    box i = i
+    unbox i = i
+
 type PrettyH a = Transform PrettyC HermitM a DocH
 -- TODO: change monads to something more restricted?
 
+data PrettyHLCoreBox = PrettyHLCoreBox (PrettyH LCore) deriving Typeable
+
+instance Extern (PrettyH LCore) where
+    type Box (PrettyH LCore) = PrettyHLCoreBox
+    box = PrettyHLCoreBox
+    unbox (PrettyHLCoreBox i) = i
+
+data TransformLCoreDocHBox = TransformLCoreDocHBox (TransformH LCore DocH) deriving Typeable
+
+instance Extern (TransformH LCore DocH) where
+    type Box (TransformH LCore DocH) = TransformLCoreDocHBox
+    box = TransformLCoreDocHBox
+    unbox (TransformLCoreDocHBox i) = i
+
+data PrettyHLCoreTCBox = PrettyHLCoreTCBox (PrettyH LCoreTC) deriving Typeable
+
+instance Extern (PrettyH LCoreTC) where
+    type Box (PrettyH LCoreTC) = PrettyHLCoreTCBox
+    box = PrettyHLCoreTCBox
+    unbox (PrettyHLCoreTCBox i) = i
+
+data TransformLCoreTCDocHBox = TransformLCoreTCDocHBox (TransformH LCoreTC DocH) deriving Typeable
+
+instance Extern (TransformH LCoreTC DocH) where
+    type Box (TransformH LCoreTC DocH) = TransformLCoreTCDocHBox
+    box = TransformLCoreTCDocHBox
+    unbox (TransformLCoreTCDocHBox i) = i
+
+-------------------------------------------------------------------------------
+
 -- | Context for PrettyH translations.
 data PrettyC = PrettyC { prettyC_path    :: AbsolutePathH
                        , prettyC_vars    :: M.Map Var AbsolutePathH
@@ -176,7 +205,7 @@
 
 ------------------------------------------------------------------------
 
-liftPrettyH :: (ReadBindings c, ReadPath c Crumb) => PrettyOptions -> PrettyH a -> Transform c HermitM a DocH
+liftPrettyH :: (ReadBindings c, ReadPath c Crumb) => PrettyOptions -> Transform PrettyC HermitM a b -> Transform c HermitM a b
 liftPrettyH = liftContext . liftPrettyC
 
 liftPrettyC :: (ReadBindings c, ReadPath c Crumb) => PrettyOptions -> c -> PrettyC
@@ -206,7 +235,7 @@
         , po_width           :: Int
         } deriving Show
 
-data ShowOption = Show | Abstract | Omit | Kind deriving (Eq, Ord, Show, Read)
+data ShowOption = Show | Abstract | Detailed | Omit | Kind deriving (Eq, Ord, Show, Read)
 
 -- Types don't have a Kind showing option.
 updateTypeShowOption :: ShowOption -> PrettyOptions -> PrettyOptions
@@ -282,7 +311,7 @@
         renderSpecial CoercionBindSymbol  = ASCII "~#"   -- <<coercion binding>>>
         renderSpecial TypeSymbol          = ASCII "*"    -- <<type>>>
         renderSpecial TypeBindSymbol      = ASCII "*"    -- <<type binding>>>
-        renderSpecial ForallSymbol        = ASCII "\\/"
+        renderSpecial ForallSymbol        = ASCII "forall"
 
 newtype Unicode = Unicode Char
 
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
@@ -1,7 +1,8 @@
 -- | Output the raw Expr constructors. Helpful for writing pattern matching rewrites.
 module HERMIT.PrettyPrinter.GHC
   ( -- * GHC's standard Pretty-Printer for GHC Core
-    pretty
+    externals
+  , pretty
   , ppCoreTC
   , ppModGuts
   , ppCoreProg
@@ -17,16 +18,21 @@
 import Control.Arrow hiding ((<+>))
 
 import Data.Char (isSpace)
-import Data.Default
+import Data.Default.Class
 
-import HERMIT.Kure
 import HERMIT.Core
+import HERMIT.External
 import HERMIT.GHC hiding ((<+>), (<>), char, text, parens, hsep, empty)
+import HERMIT.Kure
+
 import HERMIT.PrettyPrinter.Common
 
 import Text.PrettyPrint.MarkedHughesPJ as PP
 
 ---------------------------------------------------------------------------
+
+externals :: [External]
+externals = [ external "ghc" pretty ["GHC pretty printer."] ]
 
 pretty :: PrettyPrinter
 pretty = PP { pForall = ppForallQuantification
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
@@ -1,9 +1,17 @@
-{-# LANGUAGE ConstraintKinds, CPP, FlexibleContexts, GADTs, LambdaCase, ScopedTypeVariables, TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module HERMIT.Shell.Command
     ( -- * The HERMIT Command-line Shell
       commandLine
-    , interpShellCommand
+    , interpShell
     , unicodeConsole
     , diffDocH
     , diffR
@@ -11,7 +19,6 @@
     , performQuery
     , cl_kernel_env
     , getFocusPath
-    , shellComplete
     , evalScript
     ) where
 
@@ -25,11 +32,9 @@
 import HERMIT.Context
 import HERMIT.External
 import qualified HERMIT.GHC as GHC
-import HERMIT.Kernel.Scoped hiding (abortS, resumeS)
 import HERMIT.Kure
 import HERMIT.Parser
 
-import HERMIT.Plugin.Display
 import HERMIT.Plugin.Renderer
 
 import HERMIT.PrettyPrinter.Common
@@ -92,27 +97,19 @@
 
 -- | The first argument includes a list of files to load.
 commandLine :: forall m. (MonadCatch m, MonadException m, CLMonad m)
-            => [Interp m ()] -> [GHC.CommandLineOption] -> [External] -> m ()
-commandLine intp opts exts = do
+            => [GHC.CommandLineOption] -> [External] -> m ()
+commandLine opts exts = do
     let (flags, filesToLoad) = partition (isPrefixOf "-") opts
-        ws_complete = " ()"
-
-    modify $ \ st -> st { cl_externals = shell_externals ++ exts }
-
-    let loop :: InputT m ()
-        loop = do
-            st <- lift get
-            let SAST n = cl_cursor st
-            mLine <- if cl_nav st
-                     then liftIO getNavCmd
-                     else getInputLine $ "hermit<" ++ show n ++ "> "
+        ws_complete = " ()" -- treated as 'whitespace' by completer
+        safeMode = "-safety=strict" `elem` flags
+        unsafeMode = "-safety=unsafe" `elem` flags
+        safetyMode = if | unsafeMode -> NoSafety
+                        | safeMode   -> StrictSafety
+                        | otherwise  -> NormalSafety
 
-            case mLine of
-                Nothing          -> lift $ performShellEffect Resume
-                Just ('-':'-':_) -> loop
-                Just line        -> if all isSpace line
-                                    then loop
-                                    else lift (evalScript intp line `catchFailHard` cl_putStrLn) >> loop
+    modify $ \ st -> st { cl_externals = filterSafety safetyMode $ shell_externals ++ exts
+                        , cl_safety = safetyMode
+                        }
 
     -- Display the banner
     if any (`elem` ["-v0", "-v1"]) flags
@@ -129,57 +126,87 @@
     -- Load and run any scripts
     setRunningScript $ Just []
     sequence_ [ case fileName of
-                 "abort"  -> performShellEffect Abort
-                 "resume" -> performShellEffect Resume
-                 _        -> performScriptEffect (runExprH intp) $ loadAndRun fileName
+                 "abort"  -> parseScriptCLT "abort" >>= pushScript
+                 "resume" -> parseScriptCLT "resume" >>= pushScript
+                 _        -> fileToScript fileName >>= pushScript
               | fileName <- reverse filesToLoad
               , not (null fileName)
               ] `catchFailHard` \ msg -> cl_putStrLn $ "Booting Failure: " ++ msg
-    setRunningScript Nothing
 
+    let -- Main proof input loop
+        loop :: InputT m ()
+        loop = do
+            el <- lift $ do tryM () announceProven
+                            tryM () forceProofs
+                            attemptM currentLemma
+            let prompt = either (const "hermit") (const "proof") el
+            mExpr <- lift popScriptLine
+            case mExpr of
+                Nothing -> do -- no script running
+                    lift $ ifM isRunningScript (return ()) (showWindow Nothing)
+                            `catchFailHard` (cl_putStrLn . ("cannot showWindow: " ++))
+                    st <- lift get
+                    mLine <- if cl_nav st
+                             then liftIO getNavCmd
+                             else getInputLine $ prompt ++ "<" ++ show (cl_cursor st) ++ "> "
+
+                    case mLine of
+                        Nothing          -> lift $ performShellEffect Resume
+                        Just ('-':'-':_) -> loop
+                        Just line        -> if all isSpace line
+                                            then loop
+                                            else lift (evalScript line `catchFailHard` cl_putStrLn) >> loop
+                Just e -> lift (runExprH e `catchFailHard` (\ msg -> setRunningScript Nothing >> cl_putStrLn msg)) >> loop
+
     -- Start the CLI
-    showWindow
-    let settings = setComplete (completeWordWithPrev Nothing ws_complete shellComplete) defaultSettings
+    let settings = setComplete (completeWordWithPrev Nothing ws_complete completer) defaultSettings
     runInputT settings loop
 
 -- | Like 'catchM', but checks the 'cl_failhard' setting and does so if needed.
 catchFailHard :: (MonadCatch m, CLMonad m) => m () -> (String -> m ()) -> m ()
-catchFailHard m failure = catchM m $ \ msg -> ifM (gets cl_failhard) (performQuery Display (CmdName "display") >> cl_putStrLn msg >> abort) (failure msg)
+catchFailHard m failure =
+    catchM m $ \ msg -> ifM (gets cl_failhard)
+                            (do pp <- gets cl_pretty
+                                performQuery (QueryPrettyH $ pCoreTC pp) (CmdName "display")
+                                cl_putStrLn msg
+                                abort)
+                            (failure msg)
 
-evalScript :: (MonadCatch m, CLMonad m) => [Interp m ()] -> String -> m ()
-evalScript intp = parseScriptCLT >=> mapM_ (runExprH intp)
+evalScript :: (MonadCatch m, CLMonad m) => String -> m ()
+evalScript = parseScriptCLT >=> mapM_ runExprH
 
-runExprH :: (MonadCatch m, CLMonad m) => [Interp m ()] -> ExprH -> m ()
-runExprH intp expr = prefixFailMsg ("Error in expression: " ++ unparseExprH expr ++ "\n") $ interpExprH intp expr
+runExprH :: (MonadCatch m, CLMonad m) => ExprH -> m ()
+runExprH expr = prefixFailMsg ("Error in expression: " ++ unparseExprH expr ++ "\n") $ do
+    ps <- getProofStackEmpty
+    (if null ps then id else withProofExternals) $ interpExprH interpShell expr
 
 -- | Interpret a boxed thing as one of the four possible shell command types.
-interpShellCommand :: (MonadCatch m, MonadException m, CLMonad m) => [Interp m ()]
-interpShellCommand =
-  [ interpEM $ \ (RewriteCoreBox rr)           -> applyRewrite rr
-  , interpEM $ \ (RewriteCoreTCBox rr)         -> applyRewrite rr
-  , interpEM $ \ (BiRewriteCoreBox br)         -> applyRewrite $ whicheverR br
-  , interpEM $ \ (CrumbBox cr)                 -> setPath (return (mempty @@ cr) :: TransformH CoreTC LocalPathH)
-  , interpEM $ \ (PathBox p)                   -> setPath (return p :: TransformH CoreTC LocalPathH)
-  , interpEM $ \ (TransformCorePathBox tt)     -> setPath tt
-  , interpEM $ \ (TransformCoreTCPathBox tt)   -> setPath tt
-  , interpEM $ \ (StringBox str)               -> performQuery (message str)
-  , interpEM $ \ (TransformCoreStringBox tt)   -> performQuery (QueryString tt)
-  , interpEM $ \ (TransformCoreTCStringBox tt) -> performQuery (QueryString tt)
-  , interpEM $ \ (TransformCoreTCDocHBox tt)   -> performQuery (QueryDocH $ unTransformDocH tt)
-  , interpEM $ \ (TransformCoreCheckBox tt)    -> performQuery (CorrectnessCritera tt)
-  , interpEM $ \ (TransformCoreTCCheckBox tt)  -> performQuery (CorrectnessCritera tt)
-  , interpEM $ \ (effect :: KernelEffect)      -> flip performKernelEffect effect
-  , interpM  $ \ (effect :: ShellEffect)       -> performShellEffect effect
-  , interpM  $ \ (effect :: ScriptEffect)      -> performScriptEffect (runExprH interpShellCommand) effect
-  , interpEM $ \ (query :: QueryFun)           -> performQuery query
-  , interpM  $ \ (cmd :: ProofCommand)         -> performProofCommand cmd
+interpShell :: (MonadCatch m, CLMonad m) => [Interp m ()]
+interpShell =
+  [ interpEM $ \ (CrumbBox cr)                  -> setPath (return (mempty @@ cr) :: TransformH LCoreTC LocalPathH)
+  , interpEM $ \ (PathBox p)                    -> setPath (return p :: TransformH LCoreTC LocalPathH)
+  , interpEM $ \ (StringBox str)                -> performQuery (message str)
+  , interpEM $ \ (effect :: KernelEffect)       -> flip performKernelEffect effect
+  , interpM  $ \ (effect :: ShellEffect)        -> performShellEffect effect
+  , interpM  $ \ (effect :: ScriptEffect)       -> performScriptEffect effect
+  , interpEM $ \ (query :: QueryFun)            -> performQuery query
+  , interpEM $ \ (t :: UserProofTechnique)      -> performProofShellCommand $ PCUser t
+  , interpEM $ \ (cmd :: ProofShellCommand)     -> performProofShellCommand cmd
+  , interpEM $ \ (TransformLCoreStringBox tt)   -> performQuery (QueryString tt)
+  , interpEM $ \ (TransformLCoreTCStringBox tt) -> performQuery (QueryString tt)
+  , interpEM $ \ (TransformLCoreUnitBox tt)     -> performQuery (QueryUnit tt)
+  , interpEM $ \ (TransformLCoreTCUnitBox tt)   -> performQuery (QueryUnit tt)
+  , interpEM $ \ (TransformLCorePathBox tt)     -> setPath tt
+  , interpEM $ \ (TransformLCoreTCPathBox tt)   -> setPath tt
+  , interpEM $ \ (TransformLCoreDocHBox t)      -> performQuery (QueryDocH t)
+  , interpEM $ \ (TransformLCoreTCDocHBox t)      -> performQuery (QueryDocH t)
+  , interpEM $ \ (RewriteLCoreBox rr)           -> applyRewrite $ promoteLCoreR rr
+  , interpEM $ \ (RewriteLCoreTCBox rr)         -> applyRewrite rr
+  , interpEM $ \ (BiRewriteLCoreBox br)         -> applyRewrite $ promoteLCoreR $ whicheverR br
+  , interpEM $ \ (BiRewriteLCoreTCBox br)       -> applyRewrite $ whicheverR br
+  , interpEM $ \ (PrettyHLCoreBox t)            -> performQuery (QueryPrettyH t)
+  , interpEM $ \ (PrettyHLCoreTCBox t)          -> performQuery (QueryPrettyH t)
   ]
-
--------------------------------------------------------------------------------
-
--- TODO: This can be refactored. We always showWindow. Also, Perhaps return a modifier, not ()
---   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.
 
 -------------------------------------------------------------------------------
 
diff --git a/src/HERMIT/Shell/Completion.hs b/src/HERMIT/Shell/Completion.hs
--- a/src/HERMIT/Shell/Completion.hs
+++ b/src/HERMIT/Shell/Completion.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase #-}
-module HERMIT.Shell.Completion (shellComplete) where
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+module HERMIT.Shell.Completion (completer) where
 
 import Control.Applicative
 import Control.Arrow
@@ -7,14 +9,13 @@
 
 import Data.Dynamic
 import Data.List (isPrefixOf, nub)
-import Data.Map (keys)
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 
 import HERMIT.Kure
 import HERMIT.External
 import qualified HERMIT.GHC as GHC
-import HERMIT.Kernel.Scoped
-import HERMIT.Monad
+import HERMIT.Kernel
 import HERMIT.Parser
 
 import HERMIT.Dictionary.Inline
@@ -23,13 +24,21 @@
 import HERMIT.Dictionary.Rules
 
 import HERMIT.Shell.Interpreter
+import HERMIT.Shell.Proof
 import HERMIT.Shell.Types
 
 import System.Console.Haskeline hiding (catch, display)
 
 ----------------------------------------------------------------------------------
 
-shellComplete :: (MonadCatch m, MonadIO m, MonadState CommandLineState m) => String -> String -> m [Completion]
+completer :: (MonadCatch m, CLMonad m) => String -> String -> m [Completion]
+completer rPrev so_far = do
+    ps <- getProofStackEmpty
+    case ps of
+        [] -> shellComplete rPrev so_far
+        _  -> withProofExternals $ shellComplete rPrev so_far
+
+shellComplete :: (MonadCatch m, CLMonad m) => String -> String -> m [Completion]
 shellComplete rPrev so_far = do
     let (partial, _) = toUnmatched rPrev
     if null partial
@@ -46,15 +55,14 @@
                                              , not (null args) ]
                         completionsFor so_far $ filterUnknowns $ map (completionType.show) ts
 
-completionsFor :: (MonadCatch m, MonadIO m, MonadState CommandLineState m)
+completionsFor :: (MonadCatch m, CLMonad m)
                => String -> [CompletionType] -> m [Completion]
 completionsFor so_far cts = do
     qs <- mapM completionQuery cts
-    (k,(env,sast)) <- gets (cl_kernel &&& cl_kernel_env &&& cl_cursor)
-    cls <- forM qs $ \ q -> catchM (queryS k q env sast) (\_ -> return [])
+    cls <- forM qs $ \ q -> queryInContext q Never `catchM` (\_ -> return [])
     return $ map simpleCompletion $ nub $ filter (so_far `isPrefixOf`) $ concat cls
 
-data CompletionType = ConsiderC       -- considerable constructs and (deprecated) bindingOfT
+data CompletionType = ConsiderC       -- considerable constructs
                     | BindingOfC      -- bindingOfT
                     | BindingGroupOfC -- bindingGroupOfT
                     | RhsOfC          -- rhsOfT
@@ -66,7 +74,6 @@
                     | CoreC           -- complete with opening Core fragment bracket [|
                     | NothingC        -- no completion
                     | RuleC           -- complete with GHC rewrite rule name
-                    | StashC          -- complete with remembered labels
                     | StringC         -- complete with open quotes
                     | UnknownC String -- unknown Extern instance (empty completion)
 
@@ -79,7 +86,6 @@
               , ("IntBox"        , NothingC)
               , ("LemmaName"     , LemmaC)
               , ("OccurrenceName", OccurrenceOfC)
-              , ("RememberedName", StashC)
               , ("RewriteCoreBox", CommandC) -- be more specific than CommandC?
               , ("RhsOfName"     , RhsOfC)
               , ("RuleName"      , RuleC)
@@ -90,18 +96,23 @@
 filterUnknowns l = if null l' then l else l'
     where l' = filter (\case UnknownC _ -> False ; _ -> True) l
 
-completionQuery :: (MonadIO m, MonadState CommandLineState m) => CompletionType -> m (TransformH CoreTC [String])
+completionQuery :: (MonadIO m, MonadState CommandLineState m) => CompletionType -> m (TransformH LCoreTC [String])
 completionQuery ConsiderC       = return $ pure $ map fst considerables
-completionQuery OccurrenceOfC   = return $ occurrenceOfTargetsT    >>^ GHC.varSetToStrings >>^ map ('\'':)
-completionQuery BindingOfC      = return $ bindingOfTargetsT       >>^ GHC.varSetToStrings >>^ map ('\'':)
-completionQuery BindingGroupOfC = return $ bindingGroupOfTargetsT  >>^ GHC.varSetToStrings >>^ map ('\'':)
-completionQuery RhsOfC          = return $ rhsOfTargetsT           >>^ GHC.varSetToStrings >>^ map ('\'':)
-completionQuery InlineC         = return $ promoteT inlineTargetsT >>^                         map ('\'':)
+completionQuery OccurrenceOfC   = return $ occurrenceOfTargetsT   >>^ GHC.varSetToStrings >>^ map ('\'':)
+completionQuery BindingOfC      = return $ bindingOfTargetsT      >>^ GHC.varSetToStrings >>^ map ('\'':)
+completionQuery BindingGroupOfC = return $ bindingGroupOfTargetsT >>^ GHC.varSetToStrings >>^ map ('\'':)
+completionQuery RhsOfC          = return $ rhsOfTargetsT          >>^ GHC.varSetToStrings >>^ map ('\'':)
+completionQuery InlineC         = return $ promoteLCoreT inlineTargetsT >>^                   map ('\'':)
 completionQuery InScopeC        = return $ pure ["'"] -- TODO
-completionQuery LemmaC          = return $ liftM (map show . keys) $ getLemmasT
+completionQuery LemmaC          = do
+    let findTemps [] = []
+        findTemps (pt@(Unproven {}) : _) = map (show . fst) (ptAssumed pt)
+        findTemps (_ : r) = findTemps r
+    cur <- gets cl_cursor
+    tempLemmas <- gets (findTemps . fromMaybe [] . M.lookup cur . cl_proofstack)
+    return $ liftM ((tempLemmas ++) . map show . M.keys) $ getLemmasT
 completionQuery NothingC        = return $ pure []
 completionQuery RuleC           = return $ liftM (map (show . fst)) $ getHermitRulesT
-completionQuery StashC          = return $ liftM (map show . keys) $ constT getStash
 completionQuery StringC         = return $ pure ["\""]
 completionQuery CommandC        = gets cl_externals >>= return . pure . map externName
 completionQuery CoreC           = return $ pure ["[|"]
@@ -124,4 +135,3 @@
           go n acc (')':cs) = go (n+1) (')':acc) cs
           go n acc (c:cs)   = go n     (c:acc)   cs
           go _ acc []       = (acc, [])
-
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
@@ -2,21 +2,25 @@
 
 module HERMIT.Shell.Externals where
 
-import Control.Applicative
+import Control.Arrow
+import Control.Monad (liftM)
 
+import Data.Dynamic (fromDynamic)
 import Data.List (intercalate)
 import qualified Data.Map as M
-import Control.Monad (liftM)
-import Data.Dynamic (fromDynamic)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (mempty)
 
-import HERMIT.Context
-import HERMIT.Kure
 import HERMIT.External
-import HERMIT.Kernel.Scoped
+import HERMIT.Kernel
+import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Parser
 import HERMIT.Plugin.Renderer
 import HERMIT.PrettyPrinter.Common
 
+import HERMIT.Dictionary.Reasoning
+
 import HERMIT.Shell.Dictionary
 import HERMIT.Shell.KernelEffect
 import HERMIT.Shell.Proof as Proof
@@ -28,221 +32,220 @@
 
 shell_externals :: [External]
 shell_externals = map (.+ Shell)
-   [
-     external "resume"          Resume    -- HERMIT Kernel Exit
-       [ "stops HERMIT; resumes compile" ]
-   , external "abort"           Abort     -- UNIX Exit
-       [ "hard UNIX-style exit; does not return to GHC; does not save" ]
-   , external "continue"        Continue  -- Shell Exit, but not HERMIT
-       [ "exits shell; resumes HERMIT" ]
-   , external "gc"              (Delete . SAST)
-       [ "garbage-collect a given AST; does not remove from command log" ]
-   , external "gc"              (CLSModify gc)
-       [ "garbage-collect all ASTs except for the initial and current AST" ]
-   , external "display"         Display
-       [ "redisplays current state" ]
-   , external "left"            (Direction L)
-       [ "move to the next child"]
-   , external "right"           (Direction R)
-       [ "move to the previous child"]
-   , external "up"              (Direction U)
-       [ "move to the parent node"]
-   , external "down"            (deprecatedIntToPathT 0 :: TransformH Core LocalPathH) -- TODO: short-term solution
-       [ "move to the first child"]
-   , external "navigate"        (CLSModify $ \ st -> return $ st { cl_nav = True })
-       [ "switch to navigate mode" ]
-   , external "command-line"    (CLSModify $ \ st -> return $ st { cl_nav = False })
-       [ "switch to command line mode" ]
-   , external "set-window"      (CLSModify setWindow)
-       [ "fix the window to the current focus" ]
-   , external "top"             (Direction T)
-       [ "move to root of current scope" ]
-   , external "back"            (CLSModify $ versionCmd Back)
-       [ "go back in the derivation" ]                                          .+ VersionControl
-   , external "log"             (Inquiry showDerivationTree)
-       [ "go back in the derivation" ]                                          .+ VersionControl
-   , external "step"            (CLSModify $ versionCmd Step)
-       [ "step forward in the derivation" ]                                     .+ VersionControl
-   , external "goto"            (CLSModify . versionCmd . Goto)
-       [ "goto a specific step in the derivation" ]                             .+ VersionControl
-   , external "goto"            (CLSModify . versionCmd . GotoTag)
-       [ "goto a named step in the derivation" ]
-   , external "tag"             (CLSModify . versionCmd . AddTag)
-       [ "tag <label> names the current AST with a label" ]                     .+ VersionControl
-   , external "diff"            (\ s1 s2 -> Diff (SAST s1) (SAST s2))
-       [ "show diff of two ASTs" ]                                              .+ VersionControl
-   , external "set-pp-diffonly" (\ bStr -> CLSModify $ \ st ->
+    [ external "resume"          Resume    -- HERMIT Kernel Exit
+        [ "stops HERMIT; resumes compile" ]
+    , external "abort"           Abort     -- UNIX Exit
+        [ "hard UNIX-style exit; does not return to GHC; does not save" ]
+    , external "continue"        Continue  -- Shell Exit, but not HERMIT
+        [ "exits shell; resumes HERMIT" ]
+    , external "gc"              Delete
+        [ "garbage-collect a given AST" ]
+    , external "gc"              (CLSModify $ liftM Right . gc)
+        [ "garbage-collect all ASTs except for the initial and current AST" ]
+    , external "display"         (CLSModify $ \ st -> do (er,st') <- runCLT st (showWindow Nothing)
+                                                         return $ fmap (const st') er)
+        [ "redisplays current state" ]
+    , external "up"              (Direction U)
+        [ "move to the parent node"]
+    , external "navigate"        (CLSModify $ \ st -> return $ Right $ st { cl_nav = True })
+        [ "switch to navigate mode" ]
+    , external "command-line"    (CLSModify $ \ st -> return $ Right $ st { cl_nav = False })
+        [ "switch to command line mode" ]
+    , external "set-window"      (CLSModify setWindow)
+        [ "fix the window to the current focus" ]
+    , external "top"             (Direction T)
+        [ "move to root of current scope" ]
+    , external "log"             (Inquiry showDerivationTree)
+        [ "go back in the derivation" ]                                          .+ VersionControl
+    , external "back"            (CLSModify $ versionCmd Back)
+        [ "go back in the derivation" ]                                          .+ VersionControl
+    , external "step"            (CLSModify $ versionCmd Step)
+        [ "step forward in the derivation" ]                                     .+ VersionControl
+    , external "goto"            (CLSModify . versionCmd . Goto)
+        [ "goto a specific step in the derivation" ]                             .+ VersionControl
+    , external "goto"            (CLSModify . versionCmd . GotoTag)
+        [ "goto a specific step in the derivation by tag name" ]                 .+ VersionControl
+    , external "tag"             (CLSModify . versionCmd . Tag)
+        [ "name the current step in the derivation" ]                            .+ VersionControl
+    , external "diff"            Diff
+        [ "show diff of two ASTs" ]                                              .+ VersionControl
+    , external "set-pp-diffonly" (\ bStr -> CLSModify $ \ st ->
         case reads bStr of
-            [(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 ->
+            [(b,"")] -> return $ Right $ setDiffOnly st b
+            _        -> return $ Left $ CLError "valid arguments are True and False" )
+        [ "set-pp-diffonly <True|False>; False by default"
+        , "print diffs rather than full code after a rewrite" ]
+    , external "set-fail-hard"   (\ bStr -> CLSModify $ \ st ->
         case reads bStr of
-            [(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 ->
+            [(b,"")] -> return $ Right $ setFailHard st b
+            _        -> return $ Left $ CLError "valid arguments are True and False" )
+        [ "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 $ 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 ->
-       case M.lookup name pp_dictionary of
-         Nothing -> do
-            putStrLn $ "List of Pretty Printers: " ++ intercalate ", " (M.keys pp_dictionary)
-            return st
-         Just pp -> return $ flip setPrettyOpts (cl_pretty_opts st) $ setPretty st pp) -- careful to preserve the current options
-       [ "set the pretty printer"
-       , "use 'set-pp ls' to list available pretty printers" ]
-   , external "set-pp-renderer"    (PluginComp . changeRenderer)
-       [ "set the output renderer mode"]
-   , external "set-pp-renderer"    showRenderers
-       [ "set the output renderer mode"]
-   , external "dump" (Dump (\st -> liftPrettyH (cl_pretty_opts st) $ pCoreTC $ cl_pretty st))
-       [ "dump <filename> <renderer> <width>"]
-   , external "set-pp-width" (\ w -> CLSModify $ \ st ->
-        return $ setPrettyOpts st (updateWidthOption w (cl_pretty_opts st)))
-       ["set the width of the screen"]
-   , external "set-pp-type" (\ str -> CLSModify $ \ st ->
+            [(b,"")] -> return $ Right $ setCoreLint st b
+            _        -> return $ Left $ CLError "valid arguments are True and False" )
+        [ "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 ->
+        case M.lookup name pp_dictionary of
+            Nothing -> return $ Left $ CLError $ "List of Pretty Printers: " ++ intercalate ", " (M.keys pp_dictionary)
+            Just pp -> return $ Right $ flip setPrettyOpts (cl_pretty_opts st) $ setPretty st pp) -- careful to preserve the current options
+        [ "set the pretty printer"
+        , "use 'set-pp ls' to list available pretty printers" ]
+    , external "set-pp-renderer"    (PluginComp . changeRenderer)
+        [ "set the output renderer mode"]
+    , external "set-pp-renderer"    showRenderers
+        [ "set the output renderer mode"]
+    , -- DEPRECATED - this dump behavior uses the current pretty printer selected in the shell
+      external "dump" (\pp fp r w -> CLSModify (dump fp pp r w))
+        [ "dump <filename> <renderer> <width> - DEPRECATED"]
+    , external "dump" (\fp pp r w -> CLSModify (dump fp pp r w))
+        [ "dump <filename> <pretty-printer> <renderer> <width>"]
+    , external "dump-lemma" ((\nm fp pp r w -> getLemmaByNameT nm >>> liftPrettyH (pOptions pp) (ppLemmaT pp nm) >>> dumpT fp pp r w) :: LemmaName -> FilePath -> PrettyPrinter -> String -> Int -> TransformH LCoreTC ())
+        [ "Dump named lemma to a file."
+        , "dump-lemma <lemma-name> <filename> <pretty-printer> <renderer> <width>" ]
+    , external "dump-lemma" ((\pp nm fp r w -> getLemmaByNameT nm >>> liftPrettyH (pOptions pp) (ppLemmaT pp nm) >>> dumpT fp pp r w) :: PrettyPrinter -> LemmaName -> FilePath -> String -> Int -> TransformH LCoreTC ())
+        [ "Dump named lemma to a file."
+        , "dump-lemma <lemma-name> <filename> <pretty-printer> <renderer> <width>" ]
+    , external "set-pp-width" (\ w -> CLSModify $ \ st ->
+            return $ Right $ 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 $ 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 ->
+            [(opt,"")] -> return $ Right $ setPrettyOpts st (updateTypeShowOption opt (cl_pretty_opts st))
+            _          -> return $ Left $ CLError "valid arguments are Show, Abstract, and Omit")
+        ["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 $ setPrettyOpts st (updateCoShowOption opt (cl_pretty_opts st))
-            _          -> return st)
-       ["set how to show coercions (Show|Abstact|Omit)"]
-   , external "set-pp-uniques" (\ str -> CLSModify $ \ st ->
+            [(opt,"")] -> return $ Right $ setPrettyOpts st (updateCoShowOption opt (cl_pretty_opts st))
+            _          -> return $ Left $ CLError "valid arguments are Show, Abstract, and Omit")
+        ["set how to show coercions (Show|Abstact|Omit)"]
+    , external "set-pp-uniques" (\ str -> CLSModify $ \ st ->
         case reads str of
-            [(b,"")] -> return $ setPrettyOpts st ((cl_pretty_opts st) { po_showUniques = b } )
-            _        -> return st)
-       ["set whether uniques are printed with variable names"]
-   , external "{"   BeginScope
-       ["push current lens onto a stack"]       -- tag as internal
-   , external "}"   EndScope
-       ["pop a lens off a stack"]               -- tag as internal
-   , external "load"  LoadFile
-       ["load <script-name> <file-name> : load a HERMIT script from a file and save it under the specified name."]
-   , external "load-and-run"  loadAndRun
-       ["load-and-run <file-name> : load a HERMIT script from a file and run it immediately."]
-   , external "save"  SaveFile
-       ["save <filename> : save the current complete derivation into a file."]
-   , external "save-script" SaveScript
-       ["save-script <filename> <script name> : save a loaded or manually defined script to a file." ]
-   , external "load-as-rewrite" (\ rewriteName fileName -> SeqMeta [LoadFile rewriteName fileName, ScriptToRewrite rewriteName rewriteName])
-       ["load-as-rewrite <rewrite-name> <filepath> : load a HERMIT script from a file, and convert it to a rewrite."
-       ,"Note that there are significant limitations on the commands the script may contain."] .+ Experiment .+ TODO
-   , external "script-to-rewrite" ScriptToRewrite
-       ["script-to-rewrite <rewrite-name> <script-name> : create a new rewrite from a pre-loaded (or manually defined) HERMIT script."
-       ,"Note that there are significant limitations on the commands the script may contain."] .+ Experiment .+ TODO
-   , external "define-script" DefineScript
-       ["Define a new HERMIT script and bind it to a name."
-       ,"Note that any names in the script will not be resolved until the script is *run*."
-       ,"Example usage: define-script \"MyScriptName\" \"any-td beta-reduce ; let-subst ; bash\""]
-   , external "define-rewrite" (\ name str -> SeqMeta [DefineScript name str, ScriptToRewrite name name])
-       ["Define a new HERMIT rewrite and bind it to a name."
-       ,"Note that this also saves the input script under the same name."
-       ,"Example usage: define-rewrite \"MyRewriteName\" \"let-subst >>> bash\""]
-   , external "run-script" RunScript
-       ["Run a pre-loaded (or manually defined) HERMIT script."
-       ,"Note that any names in the script will not be resolved until the script is *run*." ]
-   , external "display-scripts" displayScripts
-       ["Display all loaded scripts."]
-   , external "stop-script" (CLSModify $ \st -> return $ st { cl_running_script = Nothing })
-       [ "Stop running the current script." ]
-   --, external "test-rewrites" (testRewrites :: [(ExternalName,RewriteH Core)] -> TransformH Core String) ["Test a given set of rewrites to see if they succeed"] .+ Experiment
-   , external "possible-rewrites" (testAllT:: CommandLineState-> TransformH Core String) ["Test all given set of rewrites to see if they succeed"] .+ Experiment
-     -- TODO: maybe add a "list-scripts" as well that just lists the names of loaded scripts?
-   ] ++ Proof.externals
+            [(b,"")] -> return $ Right $ setPrettyOpts st ((cl_pretty_opts st) { po_showUniques = b } )
+            _        -> return $ Left $ CLError "valid arguments are True and False")
+        ["set whether uniques are printed with variable names"]
+    , external "{"   BeginScope
+        ["push current lens onto a stack"]       -- tag as internal
+    , external "}"   EndScope
+        ["pop a lens off a stack"]               -- tag as internal
+    , external "load"  LoadFile
+        ["load <script-name> <file-name> : load a HERMIT script from a file and save it under the specified name."]
+    , external "load-and-run"  loadAndRun
+        ["load-and-run <file-name> : load a HERMIT script from a file and run it immediately."]
+    , external "save"  (SaveFile False)
+        ["save <filename> : save the current complete derivation into a file."]
+    , external "save-verbose"  (SaveFile True)
+        ["save-verbose <filename> : save the current complete derivation into a file,"
+        ,"including output of each command as a comment."]
+    , external "save-script" SaveScript
+        ["save-script <filename> <script name> : save a loaded or manually defined script to a file." ]
+    , external "load-as-rewrite" (\ rewriteName fileName -> SeqMeta [LoadFile rewriteName fileName, ScriptToRewrite rewriteName rewriteName])
+        ["load-as-rewrite <rewrite-name> <filepath> : load a HERMIT script from a file, and convert it to a rewrite."
+        ,"Note that there are significant limitations on the commands the script may contain."] .+ Experiment .+ TODO
+    , external "script-to-rewrite" ScriptToRewrite
+        ["script-to-rewrite <rewrite-name> <script-name> : create a new rewrite from a pre-loaded (or manually defined) HERMIT script."
+        ,"Note that there are significant limitations on the commands the script may contain."] .+ Experiment .+ TODO
+    , external "define-script" DefineScript
+        ["Define a new HERMIT script and bind it to a name."
+        ,"Note that any names in the script will not be resolved until the script is *run*."
+        ,"Example usage: define-script \"MyScriptName\" \"any-td beta-reduce ; let-subst ; bash\""]
+    , external "define-rewrite" (\ name str -> SeqMeta [DefineScript name str, ScriptToRewrite name name])
+        ["Define a new HERMIT rewrite and bind it to a name."
+        ,"Note that this also saves the input script under the same name."
+        ,"Example usage: define-rewrite \"MyRewriteName\" \"let-subst >>> bash\""]
+    , external "run-script" RunScript
+        ["Run a pre-loaded (or manually defined) HERMIT script."
+        ,"Note that any names in the script will not be resolved until the script is *run*." ]
+    , external "display-scripts" displayScripts
+        ["Display all loaded scripts."]
+    , external "stop-script" (CLSModify $ \st -> return $ Right $ st { cl_running_script = Nothing })
+        [ "Stop running the current script." ]
+    --, external "test-rewrites" (testRewrites :: [(ExternalName,RewriteH Core)] -> TransformH Core String)
+    --  ["Test a given set of rewrites to see if they succeed"] .+ Experiment
+    , external "possible-rewrites" (testAllT:: CommandLineState -> TransformH LCore String)
+        ["Test all given set of rewrites to see if they succeed"] .+ Experiment
+    -- 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
     let k = cl_kernel st
         cursor = cl_cursor st
-        initSAST = cl_initSAST st
-    asts <- listS k
-    mapM_ (deleteS k) [ sast | sast <- asts, sast `notElem` [cursor, initSAST] ]
+    asts <- listK k
+    mapM_ (deleteK k) [ ast | (ast,_,_) <- asts, ast `notElem` [cursor, firstAST] ]
     return st
 
 ----------------------------------------------------------------------------------
 
-setWindow :: CommandLineState -> IO CommandLineState
+setWindow :: CommandLineState -> IO (Either CLException CommandLineState)
 setWindow st = do
-    paths <- concat <$> pathS (cl_kernel st) (cl_cursor st)
-    return $ st { cl_window = paths }
+    let ps = fromMaybe ([],mempty) (M.lookup (cl_cursor st) (cl_foci st))
+    return $ Right $ st { cl_window = pathStack2Path ps }
 
 showRenderers :: QueryFun
 showRenderers = message $ "set-renderer " ++ show (map fst shellRenderers)
 
 --------------------------------------------------------
 
-versionCmd :: VersionCmd -> CommandLineState -> IO CommandLineState
-versionCmd whereTo st =
+versionCmd :: VersionCmd -> CommandLineState -> IO (Either CLException CommandLineState)
+versionCmd whereTo st = do
+    all_asts <- listK (cl_kernel st)
     case whereTo of
-        Goto n -> do
-            all_nds <- listS (cl_kernel st)
-            if SAST n `elem` all_nds
-                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 $ setCursor st sast
-                        Nothing   -> fail $ "Cannot find tag " ++ show tag ++ "."
+        Goto ast ->
+            if ast `elem` [ ast' | (ast',_,_) <- all_asts ]
+                then return $ Right $ setCursor ast st
+                else return $ Left $ CLError $ "Cannot find AST #" ++ show ast ++ "."
+        GotoTag nm ->
+            case [ ast | (ast,nms) <- M.toList (cl_tags st), nm `elem` nms ] of
+                [] -> return $ Left $ CLError $ "No tag named: " ++ nm
+                (ast:_) -> return $ Right $ setCursor ast st
+        Tag nm ->
+            return $ Right $ st { cl_tags = M.insertWith (++) (cl_cursor st) [nm] (cl_tags st) }
         Step -> do
-            let ns = [ edge | edge@(s,_,_) <- vs_graph (cl_version st), s == cl_cursor st ]
+            let ns = [ (fromMaybe "unknown" msg, ast) | (ast,msg,Just p) <- all_asts, p == cl_cursor st ]
             case ns of
-                [] -> fail "Cannot step forward (no more steps)."
-                [(_,cmd,d) ] -> do
-                    putStrLn $ "step : " ++ unparseExprH cmd
-                    return $ setCursor st d
-                _ -> fail "Cannot step forward (multiple choices)"
+                [] -> return $ Left $ CLError "Cannot step forward (no more steps)."
+                [(cmd,ast)] -> do
+                    putStrLn $ "step : " ++ cmd
+                    return $ Right $ setCursor ast st
+                _ -> return $ Left $ CLError $ "Cannot step forward (multiple choices), use goto {"
+                                                ++ intercalate "," (map (show.snd) ns) ++ "}"
         Back -> do
-            let ns = [ edge | edge@(_,_,d) <- vs_graph (cl_version st), d == cl_cursor st ]
+            let ns = [ (fromMaybe "unknown" msg, p) | (ast,msg,Just p) <- all_asts, ast == cl_cursor st ]
             case ns of
-                []         -> fail "Cannot step backwards (no more steps)."
-                [(s,cmd,_) ] -> do
-                    putStrLn $ "back, unstepping : " ++ unparseExprH cmd
-                    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) }}
+                [] -> return $ Left $ CLError "Cannot step backwards (no more steps)."
+                [(cmd,ast)] -> do
+                    putStrLn $ "back, unstepping : " ++ cmd
+                    return $ Right $ setCursor ast st
+                _ -> return $ Left $ CLError "Cannot step backwards (multiple choices, impossible!)."
 
 -------------------------------------------------------------------------------
 
 showDerivationTree :: CommandLineState -> IO String
-showDerivationTree st = return $ unlines $ showRefactorTrail graph tags start me
-  where
-          graph = [ (a,[unparseExprH b],c) | (SAST a,b,SAST c) <- vs_graph (cl_version st) ]
-          tags  = [ (n,nm) | (nm,SAST n) <- vs_tags (cl_version st) ]
-          SAST me = cl_cursor st
-          SAST start = cl_initSAST st
+showDerivationTree st = do
+    all_asts <- listK (cl_kernel st)
+    let graph = [ (a,[fromMaybe "-- command missing!" b],c) | (c,b,Just a) <- all_asts ]
+    return $ unlines $ showRefactorTrail graph firstAST (cl_cursor st)
 
-showRefactorTrail :: (Eq a, Show a) => [(a,[String],a)] -> [(a,String)] -> a -> a -> [String]
-showRefactorTrail db tags a me =
+showRefactorTrail :: (Eq a, Show a) => [(a,[String],a)] -> a -> a -> [String]
+showRefactorTrail db a me =
         case [ (b,c) | (a0,b,c) <- db, a == a0 ] of
-           [] -> [show' 3 a ++ " " ++ dot ++ tags_txt]
+           [] -> [show' 3 a ++ " " ++ dot]
            ((b,c):bs) ->
-                      [show' 3 a ++ " " ++ dot ++ (if not (null bs) then "->" else "") ++ tags_txt ] ++
+                      [show' 3 a ++ " " ++ dot ++ (if not (null bs) then "->" else "") ] ++
                       ["    " ++ "| " ++ txt | txt <- b ] ++
-                      showRefactorTrail db tags c me ++
+                      showRefactorTrail db c me ++
                       if null bs
                       then []
                       else [] :
                           showRefactorTrail [ (a',b',c') | (a',b',c') <- db
-                                                          , not (a == a' && c == c')
-                                                          ]  tags a me
-
-  where
-          dot = if a == me then "*" else "o"
-          show' n x = replicate (n - length (show a)) ' ' ++ show x
-          tags_txt = concat [ ' ' : txt
-                            | (n,txt) <- tags
-                            , n == a
-                            ]
+                                                         , not (a == a' && c == c')
+                                                         ] a me
 
+  where dot = if a == me then "*" else "o"
+        show' n x = replicate (n - length (show a)) ' ' ++ show x
 
 -------------------------------------------------------------------------------
 
@@ -253,14 +256,14 @@
 showScripts = concatMap (\ (name,script) -> name ++ ": " ++ unparseScript script ++ "\n\n")
 
 -------------------------------------------------------------------------------
-testAllT :: CommandLineState -> TransformH Core String
+testAllT :: CommandLineState -> TransformH LCore String
 testAllT st = do
                 let es  = cl_externals st
-                    mbs = map (\d -> (externName d, fromDynamic (externDyn d) :: Maybe RewriteCoreBox)) es
+                    mbs = map (\d -> (externName d, fromDynamic (externDyn d) :: Maybe RewriteLCoreBox)) es
                     namedRewrites = [(name ,unbox boxedR) | (name, Just boxedR) <- mbs]
                 testRewrites False namedRewrites
 
-testRewrites :: Bool-> [(ExternalName, RewriteH Core)] -> TransformH Core String
+testRewrites :: Bool-> [(ExternalName, RewriteH LCore)] -> TransformH LCore String
 testRewrites debug rewrites = case debug of
                        True -> let list =  mapM (\ (n,r) -> liftM (f n) (testM r)) rewrites
                                in  liftM unlines list
diff --git a/src/HERMIT/Shell/Interpreter.hs b/src/HERMIT/Shell/Interpreter.hs
--- a/src/HERMIT/Shell/Interpreter.hs
+++ b/src/HERMIT/Shell/Interpreter.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ConstraintKinds, KindSignatures, GADTs, InstanceSigs,
-             FlexibleContexts, ScopedTypeVariables, CPP #-}
+             FlexibleContexts, ScopedTypeVariables #-}
 
 module HERMIT.Shell.Interpreter
     ( -- * The HERMIT Interpreter
@@ -11,20 +11,17 @@
     , exprToDyns
     ) where
 
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except
-#else
-import Control.Monad.Error
-#endif
-import Control.Monad.State
+import Control.Monad (liftM, liftM2)
+import Control.Monad.State (MonadState(get), gets)
 
 import Data.Char
 import Data.Dynamic
 import qualified Data.Map as M
 
 import HERMIT.External
+import HERMIT.Kernel (AST)
 import HERMIT.Kure
-import HERMIT.Monad
+import HERMIT.Lemma
 import HERMIT.Name
 import HERMIT.Parser
 
@@ -87,19 +84,18 @@
     return $    toBoxedList dyns StringListBox
              ++ toBoxedList dyns (PathBox . pathToSnocPath)
                 -- ugly hack.  The whole dynamic stuff could do with overhauling.
-             ++ toBoxedList dyns (TransformCorePathBox . return . pathToSnocPath)
+             ++ toBoxedList dyns (TransformLCorePathBox . return . pathToSnocPath)
              ++ toBoxedList dyns IntListBox
              ++ toBoxedList dyns OccurrenceNameListBox
-             ++ toBoxedList dyns RewriteCoreListBox
              ++ toBoxedList dyns RuleNameListBox
+             ++ toBoxedList dyns RewriteLCoreListBox
 
 exprToDyns' rhs (CmdName str)
     | all isDigit str = do
         let i = read str
-        return [ -- An Int is either a Path, or will be interpreted specially later.
+        return [ -- An Int is either an AST, or will be interpreted specially later.
                  toDyn $ IntBox i
-                 -- TODO: Find a better long-term solution.
-               , toDyn $ TransformCorePathBox (deprecatedIntToPathT i)
+               , toDyn $ (read str :: AST)
                ]
     | otherwise = do
         dict <- gets (mkDictionary . cl_externals)
@@ -112,20 +108,21 @@
             Nothing | rhs       -> let f = maybe id ((:) . toDyn) $ string2considerable str
                                    in return $ f [ toDyn $ StringBox str
                                                  , toDyn $ LemmaName str
-                                                 , toDyn $ RememberedName str
                                                  , toDyn $ RuleName str]
                     | otherwise -> fail $ "User error, unrecognised HERMIT command: " ++ show str
 exprToDyns' _ (AppH e1 e2) = liftM2 dynCrossApply (exprToDyns' False e1) (exprToDyns' True e2)
 
--- We treat externals of the type 'CommandLineState -> b' specially,
--- providing them the shell state here, so they don't need a monadic return type
+-- We treat externals of the type 'CommandLineState -> b' and 'PrettyPrinter -> b' specially,
+-- providing their arguments from 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
+        Nothing -> case dynApply dyn (toDyn $ box $ cl_pretty st) of
+                    Just d' -> return d'
+                    Nothing -> return dyn
 
 -- Cross product of possible applications.
 dynCrossApply :: [Dynamic] -> [Dynamic] -> [Dynamic]
diff --git a/src/HERMIT/Shell/KernelEffect.hs b/src/HERMIT/Shell/KernelEffect.hs
--- a/src/HERMIT/Shell/KernelEffect.hs
+++ b/src/HERMIT/Shell/KernelEffect.hs
@@ -1,43 +1,37 @@
 {-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, LambdaCase, TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module HERMIT.Shell.KernelEffect
     ( KernelEffect(..)
     , performKernelEffect
     , applyRewrite
     , setPath
-    , goDirection
-    , beginScope
-    , endScope
-    , deleteSAST
     ) where
 
+import Control.Arrow
 import Control.Monad.State
 
+import qualified Data.Map as M
 import Data.Monoid
 import Data.Typeable
 
 import HERMIT.Context
 import HERMIT.Dictionary
 import HERMIT.External
-import qualified HERMIT.GHC as GHC
-import HERMIT.Kernel (queryK)
-import HERMIT.Kernel.Scoped hiding (abortS, resumeS)
+import HERMIT.Kernel
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Parser
 
-import HERMIT.Plugin.Renderer
-
-import HERMIT.PrettyPrinter.Common
-
 import HERMIT.Shell.Types
 
 -------------------------------------------------------------------------------
 
 -- | KernelEffects are things that affect the state of the Kernel
-data KernelEffect = Direction  Direction -- Change the currect location using directions.
-                  | BeginScope           -- Begin scope.
-                  | EndScope             -- End scope.
-                  | Delete     SAST      -- Delete an AST
+data KernelEffect = Direction Direction -- Move up or top.
+                  | BeginScope          -- Begin scope.
+                  | EndScope            -- End scope.
+                  | Delete AST          -- Delete an AST
    deriving Typeable
 
 instance Extern KernelEffect where
@@ -47,71 +41,89 @@
 
 performKernelEffect :: (MonadCatch m, CLMonad m) => ExprH -> KernelEffect -> m ()
 performKernelEffect e = \case
-                            Direction dir -> goDirection dir e
-                            BeginScope    -> beginScope e
-                            EndScope      -> endScope e
-                            Delete sast   -> deleteSAST sast
+                            Direction d -> goUp d e
+                            BeginScope  -> beginScope e
+                            EndScope    -> endScope e
+                            Delete sast -> deleteAST sast
 
 -------------------------------------------------------------------------------
 
-applyRewrite :: (Injection GHC.ModGuts g, Walker HermitC g, MonadCatch m, CLMonad m)
-             => RewriteH g -> ExprH -> m ()
+applyRewrite :: (MonadCatch m, CLMonad m) => RewriteH LCoreTC -> ExprH -> m ()
 applyRewrite rr expr = do
-    st <- get
-
-    let sk = cl_kernel st
-        kEnv = cl_kernel_env st
-        sast = cl_cursor st
-        ppOpts = cl_pretty_opts st
-        pp = pCoreTC $ cl_pretty st
+    ps <- getProofStackEmpty
+    let str = unparseExprH expr
+    case ps of
+        todo@(Unproven {}) : todos -> do
+            q' <- queryInFocus (inProofFocusR todo (promoteR rr) >>> (contextfreeT (applyT lintQuantifiedT (ptContext todo)) >> idR) :: TransformH Core Quantified) (Always str)
+            let todo' = todo { ptLemma = (ptLemma todo) { lemmaQ = q' } }
+            modify $ \ st -> st { cl_proofstack = M.insert (cl_cursor st) (todo':todos) (cl_proofstack st) }
+        _ -> do
+            (k,(kEnv,(ast,cl))) <- gets (cl_kernel &&& cl_kernel_env &&& cl_cursor &&& cl_corelint)
 
-    sast' <- prefixFailMsg "Rewrite failed: " $ applyS sk rr kEnv sast
+            rr' <- addFocusR (extractR rr :: RewriteH CoreTC)
+            ast' <- prefixFailMsg "Rewrite failed:" $ applyK k rr' (Always str) kEnv ast
 
-    let commit = put (newSAST expr sast' st) >> showResult
-        showResult = if cl_diffonly st then showDiff else showWindow
-        showDiff = do doc1 <- queryS sk (liftPrettyH ppOpts pp) kEnv sast
-                      doc2 <- queryS sk (liftPrettyH ppOpts pp) kEnv sast'
-                      diffDocH (cl_pretty st) doc1 doc2 >>= cl_putStr
+            when cl $ do
+                warns <- liftM snd (queryK k lintModuleT Never kEnv ast')
+                            `catchM` (\ errs -> deleteK k ast' >> fail errs)
+                putStrToConsole warns
 
-    if cl_corelint st
-        then do ast' <- toASTS sk sast'
-                liftIO (queryK (kernelS sk) ast' lintModuleT kEnv)
-                >>= runKureM (\ warns -> putStrToConsole warns >> commit)
-                             (\ errs  -> liftIO (deleteS sk sast') >> fail errs)
-        else commit
+            addAST ast'
 
-setPath :: (Injection GHC.ModGuts g, Walker HermitC g, MonadCatch m, CLMonad m)
-        => TransformH g LocalPathH -> ExprH -> m ()
+setPath :: (Injection a LCoreTC, MonadCatch m, CLMonad m) => TransformH a LocalPathH -> ExprH -> m ()
 setPath t expr = do
-    st <- get
-    -- An extension to the Path
-    p <- prefixFailMsg "Cannot find path: " $ queryS (cl_kernel st) t (cl_kernel_env st) (cl_cursor st)
-    ast <- prefixFailMsg "Path is invalid: " $ modPathS (cl_kernel st) (<> p) (cl_kernel_env st) (cl_cursor st)
-    put $ newSAST expr ast st
-    showWindow
+    p <- prefixFailMsg "Cannot find path: " $ queryInContext (promoteT t) Never
+    modifyLocalPath (<> p) expr
 
-goDirection :: (MonadCatch m, CLMonad m) => Direction -> ExprH -> m ()
-goDirection dir expr = do
-    st <- get
-    ast <- prefixFailMsg "Invalid move: " $ modPathS (cl_kernel st) (moveLocally dir) (cl_kernel_env st) (cl_cursor st)
-    put $ newSAST expr ast st
-    showWindow
+goUp :: (MonadCatch m, CLMonad m) => Direction -> ExprH -> m ()
+goUp T expr = modifyLocalPath (const mempty) expr
+goUp U expr = do
+    (_,rel) <- getPathStack
+    case rel of
+        SnocPath [] -> fail "cannot move up, at root of scope."
+        SnocPath (_:cs) -> modifyLocalPath (const $ SnocPath cs) expr
 
 beginScope :: (MonadCatch m, CLMonad m) => ExprH -> m ()
 beginScope expr = do
-    st <- get
-    ast <- beginScopeS (cl_kernel st) (cl_cursor st)
-    put $ newSAST expr ast st
-    showWindow
+    ps <- getProofStackEmpty
+    let logExpr = do
+            (k,ast) <- gets (cl_kernel &&& cl_cursor)
+            tellK k (unparseExprH expr) ast
+    case ps of
+        [] -> do
+            (base, rel) <- getPathStack
+            addAST =<< logExpr
+            modify $ \ st -> st { cl_foci = M.insert (cl_cursor st) (rel : base, mempty) (cl_foci st) }
+        Unproven nm l c ls (base,p) : todos -> do
+            addAST =<< logExpr
+            let todos' = Unproven nm l c ls (p : base, mempty) : todos
+            modify $ \ st -> st { cl_proofstack = M.insert (cl_cursor st) todos' (cl_proofstack st) }
+        _ -> fail "beginScope: impossible case!"
 
 endScope :: (MonadCatch m, CLMonad m) => ExprH -> m ()
 endScope expr = do
-    st <- get
-    ast <- endScopeS (cl_kernel st) (cl_cursor st)
-    put $ newSAST expr ast st
-    showWindow
+    ps <- getProofStackEmpty
+    let logExpr = do
+            (k,ast) <- gets (cl_kernel &&& cl_cursor)
+            tellK k (unparseExprH expr) ast
+    case ps of
+        [] -> do
+            (base, _) <- getPathStack
+            case base of
+                [] -> fail "no scope to end."
+                (rel:base') -> do
+                    addAST =<< logExpr
+                    modify $ \ st -> st { cl_foci = M.insert (cl_cursor st) (base', rel) (cl_foci st) }
+        Unproven nm l c ls (base,_) : todos -> do
+            case base of
+                [] -> fail "no scope to end."
+                (p:base') -> do
+                    addAST =<< logExpr
+                    let todos' = Unproven nm l c ls (base', p) : todos
+                    modify $ \ st -> st { cl_proofstack = M.insert (cl_cursor st) todos' (cl_proofstack st) }
+        _ -> fail "endScope: impossible case!"
 
-deleteSAST :: (MonadCatch m, CLMonad m) => SAST -> m ()
-deleteSAST sast = gets cl_kernel >>= flip deleteS sast
+deleteAST :: (MonadCatch m, CLMonad m) => AST -> m ()
+deleteAST ast = gets cl_kernel >>= flip deleteK ast
 
 -------------------------------------------------------------------------------
diff --git a/src/HERMIT/Shell/Proof.hs b/src/HERMIT/Shell/Proof.hs
--- a/src/HERMIT/Shell/Proof.hs
+++ b/src/HERMIT/Shell/Proof.hs
@@ -1,322 +1,322 @@
-{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, LambdaCase,
-             MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeSynonymInstances, CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module HERMIT.Shell.Proof
     ( externals
-    , ProofCommand(..)
-    , performProofCommand
     , UserProofTechnique
     , userProofTechnique
-    , ppLemmaT
+    , withProofExternals
+    , performProofShellCommand
+    , forceProofs
+    , ProofShellCommand(PCUser)
     ) where
 
 import Control.Arrow hiding (loop, (<+>))
-import Control.Concurrent
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except
-#else
-import Control.Monad.Error
-#endif
-import Control.Monad.State
+import Control.Monad (forM, forM_, liftM, unless)
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.State (MonadState, modify, gets)
 
-import Data.Char (isSpace)
 import Data.Dynamic
-import Data.List (delete, isInfixOf)
-import Data.Map (filterWithKey, toList)
+import Data.List (delete, zipWith4)
+import qualified Data.Map as M
+import Data.Monoid
 import Data.String (fromString)
 
+import HERMIT.Context
 import HERMIT.Core
 import HERMIT.External
 import HERMIT.GHC hiding (settings, (<>), text, sep, (<+>), ($+$), nest)
-import HERMIT.Kernel.Scoped
+import HERMIT.Kernel
 import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Monad
+import HERMIT.Name
 import HERMIT.Parser
+import HERMIT.Syntax
 import HERMIT.Utilities
 
-import HERMIT.Dictionary.GHC hiding (externals)
 import HERMIT.Dictionary.Induction
+import HERMIT.Dictionary.Local.Case hiding (externals)
 import HERMIT.Dictionary.Reasoning hiding (externals)
-
-import HERMIT.Plugin.Types
-import HERMIT.PrettyPrinter.Common
+import HERMIT.Dictionary.Undefined hiding (externals)
 
-import HERMIT.Shell.Completion
-import HERMIT.Shell.Interpreter
-import HERMIT.Shell.KernelEffect
-import HERMIT.Shell.ScriptToRewrite
 import HERMIT.Shell.ShellEffect
 import HERMIT.Shell.Types
 
-import System.Console.Haskeline hiding (catch, display)
-import System.IO
-
-import Text.PrettyPrint.MarkedHughesPJ as PP
-
 --------------------------------------------------------------------------------------------------------
 
--- | Externals that get us into the prover shell, or otherwise deal with lemmas.
--- TODO: InteractiveProof is the only one that should be here, rest in Reasoning
+-- | Externals that get us into the prover shell.
 externals :: [External]
 externals = map (.+ Proof)
-    [ external "show-lemma" (ShowLemmas . Just)
-        [ "List lemmas whose names match search string." ]
-    , external "show-lemmas" (ShowLemmas Nothing)
-        [ "List lemmas." ]
-    , external "prove-lemma" InteractiveProof
+    [ external "prove-lemma" (CLSModify . interactiveProofIO)
         [ "Proof a lemma interactively." ]
-    , external "dump-lemma" DumpLemma
-        [ "Dump named lemma to a file."
-        , "dump-lemma <lemma-name> <filename> <renderer> <width>" ]
     ]
 
 -- | Externals that are added to the dictionary only when in interactive proof mode.
 proof_externals :: [External]
 proof_externals = map (.+ Proof)
-    [ external "induction" (PCInduction . cmpString2Var :: String -> ProofShellCommand)
+    [ external "lemma" (PCEnd . Right . (Obligation,))
+        [ "Prove lemma by asserting it is alpha-equivalent to an already proven lemma." ]
+    , external "lemma-unsafe" (PCEnd . Right . (UnsafeUsed,))
+        [ "Prove lemma by asserting it is alpha-equivalent to an already proven lemma." ] .+ Unsafe
+    , external "induction" (PCInduction . cmpString2Var :: String -> ProofShellCommand)
         [ "Perform induction on given universally quantified variable."
-        , "Each constructor case will generate a new equality to be proven."
+        , "Each constructor case will generate a new lemma to be proven."
         ]
-    , external "dump" PCDump
-        [ "dump <filename> <renderer> <width>" ]
-    , external "end-proof" PCEnd
+    , external "prove-by-cases" (PCByCases . cmpString2Var :: String -> ProofShellCommand)
+        [ "Case split on given universally quantified variable."
+        , "Each constructor case will generate a new lemma to be proven."
+        ]
+    , external "prove-consequent" PCConsequent
+        [ "Prove the consequent of an implication by assuming the antecedent." ]
+    , external "prove-conjunction" PCConjunction
+        [ "Prove a conjunction by proving both sides of it." ]
+    , external "inst-assumed" (\ i nm cs -> PCInstAssumed i (cmpHN2Var nm) cs)
+        [ "Split an assumed lemma which is a conjunction/disjunction." ]
+    , external "split-assumed" PCSplitAssumed
+        [ "Split an assumed lemma which is a conjunction/disjunction." ]
+    , external "end-proof" (PCEnd (Left False))
         [ "check for alpha-equality, marking the lemma as proven" ]
-    , external "end-case" PCEnd
+    , external "end-case" (PCEnd (Left False))
         [ "check for alpha-equality, marking the proof case as proven" ]
+    , external "assume" (PCEnd (Left True))
+        [ "mark lemma as assumed" ]
     ]
 
 --------------------------------------------------------------------------------------------------------
 
-data ProofCommand
-    = InteractiveProof LemmaName
-    | ShowLemmas (Maybe LemmaName)
-    | DumpLemma LemmaName String String Int
-    deriving (Typeable)
-
-instance Extern ProofCommand where
-    type Box ProofCommand = ProofCommand
-    box i = i
-    unbox i = i
-
---------------------------------------------------------------------------------------------------------
-
-performProofCommand :: (MonadCatch m, MonadException m, CLMonad m) => ProofCommand -> m ()
-
-performProofCommand (InteractiveProof nm) = do
-    st <- gets cl_pstate
-    l <- queryS (ps_kernel st) (getLemmaByNameT nm :: TransformH Core Lemma) (mkKernelEnv st) (ps_cursor st)
-    interactiveProof True False (nm,l)
-
-performProofCommand (DumpLemma nm fn r w) = dump (\ st -> getLemmaByNameT nm >>> ppLemmaT (cl_pretty st) nm) fn r w
-
-performProofCommand (ShowLemmas mnm) = do
-    st <- gets cl_pstate
-    ls <- queryS (ps_kernel st) (getLemmasT :: TransformH Core Lemmas) (mkKernelEnv st) (ps_cursor st)
-    mapM_ printLemma $ toList $ filterWithKey (maybe (\ _ _ -> True) (\ nm n _ -> show nm `isInfixOf` show n) mnm) ls
-
---------------------------------------------------------------------------------------------------------
-
-
-printLemma :: (MonadCatch m, MonadError CLException m, MonadIO m, MonadState CommandLineState m)
-           => (LemmaName,Lemma) -> m ()
-printLemma (nm,lem) = do
-    st <- get
-    doc <- queryS (cl_kernel st) (return lem >>> ppLemmaT (cl_pretty st) nm :: TransformH Core DocH) (cl_kernel_env st) (cl_cursor st)
-    liftIO $ cl_render st stdout (cl_pretty_opts st) (Right doc)
-
-ppLemmaT :: PrettyPrinter -> LemmaName -> TransformH Lemma DocH
-ppLemmaT pp nm = do
-    Lemma eq p u <- idR
-    eqDoc <- return eq >>> ppEqualityT pp
-    let hDoc = text (show nm) <+> text (if p then "(Proven)" else "(Not Proven)")
-                              <+> text (if u then "(Used)"   else "(Not Used)")
-    return $ hDoc $+$ nest 2 eqDoc
-
---------------------------------------------------------------------------------------------------------
-
-type NamedLemma = (LemmaName, Lemma)
-
-interactiveProof :: forall m. (MonadCatch m, MonadException m, CLMonad m) => Bool -> Bool -> NamedLemma -> m ()
-interactiveProof topLevel isTemporary lem@(nm,_) = do
-    origSt <- get
-    origEs <- addProofExternals topLevel
-
-    let ws_complete = " ()"
-
-        -- Main proof input loop
-        loop :: NamedLemma -> InputT m ()
-        loop l = do
-            mExpr <- lift popScriptLine
-            case mExpr of
-                Nothing -> do
-                    lift $ printLemma l
-                    mLine <- getInputLine $ "proof> "
-                    case mLine of
-                        Nothing          -> fail "proof aborted (input: Nothing)"
-                        Just ('-':'-':_) -> loop l
-                        Just line        -> if all isSpace line
-                                            then loop l
-                                            else lift (evalProofScript l line `catchM` (\msg -> cl_putStrLn msg >> return l)) >>= loop
-                Just e -> lift (runExprH l e `catchM` (\msg -> setRunningScript Nothing >> cl_putStrLn msg >> return l)) >>= loop
-
-    -- Display a proof banner?
-
-    -- Start the CLI
-    let settings = setComplete (completeWordWithPrev Nothing ws_complete shellComplete) defaultSettings
-        cleanup s = put (s { cl_externals = origEs })
-    catchError (runInputT settings (loop lem))
-               (\case
-                    CLAbort        -> cleanup origSt >> unless topLevel abort -- abandon proof attempt, bubble out to regular shell
-                    CLContinue st' -> do
-                        cl_putStrLn $ "Successfully proven: " ++ show nm
-                        if isTemporary
-                        then cleanup st'    -- successfully proven
-                        else do sast <- applyS (cl_kernel st')
-                                               (modifyLemmaR nm id idR (const True) id :: RewriteH Core)
-                                               (mkKernelEnv $ cl_pstate st')
-                                               (cl_cursor st')
-                                cleanup $ newSAST (CmdName "proven") sast st'
-
-                    CLError msg    -> fail $ "Prover error: " ++ msg
-                    _              -> fail "unsupported exception in interactive prover")
+-- | Top level entry point!
+interactiveProofIO :: LemmaName -> CommandLineState -> IO (Either CLException CommandLineState)
+interactiveProofIO nm s = do
+    (r,st) <- runCLT s $ do
+                ps <- getProofStackEmpty
+                let t :: TransformH x (HermitC,Lemma)
+                    t = contextT &&& getLemmaByNameT nm
+                (c,l) <- case ps of
+                            [] -> queryInFocus (t :: TransformH Core (HermitC,Lemma))
+                                               (Always $ "prove-lemma " ++ quoteShow nm)
+                            todo : _ -> queryInFocus (inProofFocusT todo t) Never
+                pushProofStack $ Unproven nm l c [] mempty
+    return $ fmap (const st) r
 
-addProofExternals :: MonadState CommandLineState m => Bool -> m [External]
-addProofExternals topLevel = do
-    st <- get
-    let es = cl_externals st
+withProofExternals :: (MonadError CLException m, MonadState CommandLineState m) => m a -> m a
+withProofExternals comp = do
+    (es,sf) <- gets (cl_externals &&& cl_safety)
+    let pes = filterSafety sf proof_externals
         -- commands with same same in proof_externals will override those in normal externals
-        newEs = proof_externals ++ filter ((`notElem` (map externName proof_externals)) . externName) es
-    when topLevel $ modify $ \ s -> s { cl_externals = newEs }
-    return es
-
-evalProofScript :: (MonadCatch m, MonadException m, CLMonad m) => NamedLemma -> String -> m NamedLemma
-evalProofScript lem = parseScriptCLT >=> foldM runExprH lem
+        newEs = pes ++ filter ((`notElem` (map externName pes)) . externName) es
+        reset s = s { cl_externals = es }
+    modify $ \ s -> s { cl_externals = newEs }
+    r <- comp `catchError` (\case CLContinue s -> continue (reset s)
+                                  other        -> modify reset >> throwError other)
+    modify reset
+    return r
 
-runExprH :: (MonadCatch m, MonadException m, CLMonad m) => NamedLemma -> ExprH -> m NamedLemma
-runExprH lem expr = prefixFailMsg ("Error in expression: " ++ unparseExprH expr ++ "\n")
-                  $ interpExprH interpProof expr >>= performProofShellCommand lem
+forceProofs :: (MonadCatch m, CLMonad m) => m ()
+forceProofs = do
+    (c,nls) <- queryInFocus (contextT &&& getObligationNotProvenT :: TransformH Core (HermitC, [NamedLemma])) Never
+    todos <- getProofStackEmpty
+    let already = map ptName todos
+        nls' = [ nl | nl@(nm,_) <- nls, not (nm `elem` already) ]
+    if null nls'
+    then return ()
+    else do
+        c' <- case todos of
+                todo : _ -> queryInFocus (inProofFocusT todo contextT) Never
+                _        -> return c
+        forM_ nls' $ \ (nm,l) -> pushProofStack (Unproven nm l c' [] mempty)
 
 -- | Verify that the lemma has been proven. Throws an exception if it has not.
-endProof :: (MonadCatch m, MonadError CLException m, MonadIO m, MonadState CommandLineState m) => NamedLemma -> m ()
-endProof (nm, Lemma eq _ _) = do
-    st <- get
+endProof :: (MonadCatch m, CLMonad m) => Either Bool (Used,LemmaName) -> ExprH -> m ()
+endProof reason expr = do
+    Unproven nm (Lemma q _ _ temp) c ls _ : _ <- getProofStack
+    let msg = "The two sides of " ++ quoteShow nm ++ " are not alpha-equivalent."
+        deleteOr tr = if temp then constT (deleteLemma nm) else tr
+        t = case reason of
+                Left assumed
+                    | assumed   -> deleteOr (markLemmaAssumedT True nm)
+                    | otherwise -> setFailMsg msg verifyQuantifiedT >> deleteOr (markLemmaProvedT nm)
+                Right (u,nm') -> verifyEquivalentT u nm' >> deleteOr (markLemmaProvedT nm)
+    queryInFocus (constT (withLemmas (M.fromList ls) $ applyT t c q) :: TransformH Core ())
+                 (Always $ unparseExprH expr ++ " -- proven " ++ quoteShow nm)
+    _ <- popProofStack
+    cl_putStrLn $ "Successfully proven: " ++ show nm
 
-    let sk = cl_kernel st
-        kEnv = cl_kernel_env st
-        sast = cl_cursor st
+-- Note [Query]
+-- We want to do our proof in the current context of the shell, whatever that is,
+-- so we run them using queryInFocus below. This has the benefit that proof commands
+-- can generate additional lemmas, and add to the version history.
+performProofShellCommand :: (MonadCatch m, CLMonad m)
+                         => ProofShellCommand -> ExprH -> m ()
+performProofShellCommand cmd expr = go cmd
+    where str = unparseExprH expr
+          go (PCInduction idPred) = performInduction (Always str) idPred
+          go (PCByCases idPred)   = proveByCases (Always str) idPred
+          go PCConsequent         = proveConsequent str
+          go PCConjunction        = proveConjunction str
+          go (PCInstAssumed i v cs) = instAssumed i v cs str
+          go (PCSplitAssumed i)   = splitAssumed i str
+          go (PCUser prf)         = do
+                let UserProofTechnique t = prf -- may add more constructors later
+                -- note: we assume that if 't' completes without failing,
+                -- the lemma is proved, we don't actually check
+                todo : _ <- getProofStack
+                queryInFocus (inProofFocusT todo t >> unless (lemmaT $ ptLemma todo) (markLemmaProvedT (ptName todo)))
+                             (Changed str)
+                _ <- popProofStack
+                cl_putStrLn $ "Successfully proven: " ++ show (ptName todo)
+          go (PCEnd why)          = endProof why expr
 
-    -- Why do a query? We want to do our proof in the current context of the shell, whatever that is.
-    b <- (queryS sk (return eq >>> testM verifyEqualityT :: TransformH Core Bool) kEnv sast)
-    if b then continue st else fail $ "The two sides of " ++ show nm ++ " are not alpha-equivalent."
+proveConsequent :: (MonadCatch m, CLMonad m) => String -> m ()
+proveConsequent expr = do
+    todo : _ <- getProofStack
+    (c, Impl ante con) <- setFailMsg "not an implication" $
+                          queryInFocus (inProofFocusT todo (contextT &&& projectT)) Never
+    let nm = ptName todo
+        ls = (nm <> "-antecedent", Lemma ante (Assumed False) NotUsed True) : ptAssumed todo
+    (k,ast) <- gets (cl_kernel &&& cl_cursor)
+    addAST =<< tellK k expr ast
+    _ <- popProofStack
+    pushProofStack $ MarkProven nm (lemmaT (ptLemma todo)) -- proving the consequent proves the lemma
+    pushProofStack $ Unproven (nm <> "-consequent") (Lemma con NotProven Obligation True) c ls mempty
 
-performProofShellCommand :: (MonadCatch m, MonadException m, CLMonad m) => NamedLemma -> ProofShellCommand -> m NamedLemma
-performProofShellCommand lem@(nm, Lemma eq p u) = go
-    where go (PCRewrite rr)         = do
-                st <- get
-                let sk = cl_kernel st
-                    kEnv = cl_kernel_env st
-                    sast = cl_cursor st
+proveConjunction :: (MonadCatch m, CLMonad m) => String -> m ()
+proveConjunction expr = do
+    Unproven nm (Lemma (Quantified bs cl) p u t) c ls _ : _ <- getProofStack
+    case cl of
+        Conj (Quantified lbs lcl) (Quantified rbs rcl) -> do
+            (k,ast) <- gets (cl_kernel &&& cl_cursor)
+            addAST =<< tellK k expr ast
+            _ <- popProofStack
+            pushProofStack $ MarkProven nm t
+            pushProofStack $ Unproven (nm <> "-r") (Lemma (Quantified (bs++rbs) rcl) p u True) c ls mempty
+            pushProofStack $ Unproven (nm <> "-l") (Lemma (Quantified (bs++lbs) lcl) p u True) c ls mempty
+        _ -> fail "not a conjunction."
 
-                -- Why do a query? We want to do our proof in the current context of the shell, whatever that is.
-                -- TODO: query doesn't save side effects, which are needed for stash/lemmas
-                eq' <- queryS sk (return eq >>> rr >>> (bothT lintExprT >> idR) :: TransformH Core Equality) kEnv sast
-                return (nm, Lemma eq' p u)
-          go (PCTransform t)      = do
-                st <- get
-                let sk = cl_kernel st
-                    kEnv = cl_kernel_env st
-                    sast = cl_cursor st
+splitAssumed :: (MonadCatch m, CLMonad m) => Int -> String -> m ()
+splitAssumed i expr = do
+    Unproven nm lem c ls ps : _ <- getProofStack
+    (b, (n, Lemma q p u t):a) <- getIth i ls
+    qs <- splitQuantified q
+    let nls = [ (n <> fromString (show j), Lemma q' p u t) | (j::Int,q') <- zip [0..] qs ]
+    (k,ast) <- gets (cl_kernel &&& cl_cursor)
+    addAST =<< tellK k expr ast
+    _ <- popProofStack
+    pushProofStack $ Unproven nm lem c (b ++ nls ++ a) ps
 
-                -- Why do a query? See above.
-                res <- queryS sk (return eq >>> t :: TransformH Core String) kEnv sast
-                cl_putStrLn res
-                return lem
-          go (PCInduction idPred) = performInduction lem idPred
-          go (PCShell effect)     = performShellEffect effect >> return lem
-          go (PCScript effect)    = do
-                lemVar <- liftIO $ newMVar lem -- couldn't resist that name
-                let lemHack e = liftIO (takeMVar lemVar) >>= flip runExprH e >>= \l -> liftIO (putMVar lemVar l)
-                performScriptEffect lemHack effect
-                liftIO $ takeMVar lemVar
-          go (PCQuery query)      = performQuery query (error "PCQuery ExprH") >> return lem
-          go (PCProofCommand cmd) = performProofCommand cmd >> return lem
-          go (PCUser prf)         = let UserProofTechnique t = prf in -- may add more constructors later
-             do
-                st <- get
-                -- Why do a query? We want to do our proof in the current context of the shell, whatever that is.
-                queryS (cl_kernel st) (return eq >>> t :: TransformH Core ()) (cl_kernel_env st) (cl_cursor st)
-                continue st -- note: we assume that if 't' completes without failing, the lemma is proved, we don't actually check
-                return lem       -- never reached
-          go (PCDump fName r w)   = dump (\ st -> return (snd lem) >>> ppLemmaT (cl_pretty st) (fst lem)) fName r w >> return lem
-          go PCEnd                = endProof lem >> return lem
-          go (PCUnsupported s)    = cl_putStrLn (s ++ " command unsupported in proof mode.") >> return lem
+instAssumed :: (MonadCatch m, CLMonad m) => Int -> (Var -> Bool) -> CoreString -> String -> m ()
+instAssumed i pr cs expr = do
+    todo : _ <- getProofStack
+    (b, orig@(n, Lemma q p u t):a) <- getIth i $ ptAssumed todo
+    q' <- queryInFocus (inProofFocusT todo $ return q >>> instantiateQuantifiedVarR pr cs) Never
+    (k,ast) <- gets (cl_kernel &&& cl_cursor)
+    addAST =<< tellK k expr ast
+    _ <- popProofStack
+    pushProofStack $ todo { ptAssumed = b ++ orig:(n <> "'", Lemma q' p u t):a }
 
-performInduction :: (MonadCatch m, MonadException m, CLMonad m) => NamedLemma -> (Id -> Bool) -> m NamedLemma
-performInduction lem@(nm, Lemma eq@(Equality bs lhs rhs) _ _) idPred = do
-    st <- get
-    let sk = cl_kernel st
-        kEnv = cl_kernel_env st
-        sast = cl_cursor st
+getIth :: MonadCatch m => Int -> [a] -> m ([a],[a])
+getIth _ [] = fail "getIth: out of range"
+getIth n (x:xs) = go n x xs []
+    where go 0 y ys zs = return (reverse zs, y:ys)
+          go _ _ [] _  = fail "getIth: out of range"
+          go i z (y:ys) zs = go (i-1) y ys (z:zs)
 
-    i <- setFailMsg "specified identifier is not universally quantified in this equality lemma." $ soleElement (filter idPred bs)
+-- | Always returns non-empty list, or fails.
+splitQuantified :: MonadCatch m => Quantified -> m [Quantified]
+splitQuantified (Quantified bs cl) = do
+    case cl of
+        Conj (Quantified lbs lcl) (Quantified rbs rcl) ->
+            return [Quantified (bs++lbs) lcl, Quantified (bs++rbs) rcl]
+        Disj (Quantified lbs lcl) (Quantified rbs rcl) ->
+            return [Quantified (bs++lbs) lcl, Quantified (bs++rbs) rcl]
+        Impl (Quantified lbs lcl) (Quantified rbs rcl) ->
+            return [Quantified (bs++lbs) lcl, Quantified (bs++rbs) rcl]
+        _ -> fail "equalities cannot be split!"
+
+performInduction :: (MonadCatch m, CLMonad m)
+                 => CommitMsg -> (Id -> Bool) -> m ()
+performInduction cm idPred = do
+    (nm, Lemma q@(Quantified bs (Equiv lhs rhs)) _ _ temp, ctxt, ls, _) <- currentLemma
+    i <- setFailMsg "specified identifier is not universally quantified in this equality lemma." $
+         soleElement (filter idPred bs)
+
     -- Why do a query? We want to do our proof in the current context of the shell, whatever that is.
-    cases <- queryS sk (inductionCaseSplit bs i lhs rhs :: TransformH Core [(Maybe DataCon,[Var],CoreExpr,CoreExpr)]) kEnv sast
+    cases <- queryInContext
+                (inductionCaseSplit bs i lhs rhs :: TransformH LCoreTC [(Maybe DataCon, [Var], CoreExpr, CoreExpr)])
+                cm
 
-    forM_ cases $ \ (mdc,vs,lhsE,rhsE) -> do
+    -- replace the current lemma with the three subcases
+    -- proving them will prove this case automatically
+    _ <- popProofStack
+    pushProofStack $ MarkProven nm temp
+    forM_ (reverse cases) $ \ (mdc,vs,lhsE,rhsE) -> do
 
         let vs_matching_i_type = filter (typeAlphaEq (varType i) . varType) vs
+            caseName = maybe "undefined" unqualifiedName mdc
 
         -- Generate list of specialized induction hypotheses for the recursive cases.
-        eqs <- forM vs_matching_i_type $ \ i' ->
-                    liftM discardUniVars $ instantiateEqualityVar (==i) (Var i') [] eq
+        qs <- forM vs_matching_i_type $ \ i' -> do
+                liftM discardUniVars $ instQuantified (boundVars ctxt) (==i) (Var i') q
+                -- TODO rethink the discardUniVars
 
         let nms = [ fromString ("ind-hyp-" ++ show n) | n :: Int <- [0..] ]
-            hypLemmas = zip nms $ zipWith3 Lemma eqs (repeat True) (repeat False)
-            lemmaName = fromString $ show nm ++ "-induction-on-"
-                                             ++ unqualifiedName i ++ "-case-"
-                                             ++ maybe "undefined" unqualifiedName mdc
-            caseLemma = Lemma (Equality (delete i bs ++ vs) lhsE rhsE) False False
+            hypLemmas = zip nms $ zipWith4 Lemma qs (repeat (Assumed False)) (repeat NotUsed) (repeat True)
+            lemmaName = fromString $ show nm ++ "-induction-case-" ++ caseName
+            caseLemma = Lemma (mkQuantified (delete i bs ++ vs) lhsE rhsE) NotProven Obligation True
 
-        -- this is pretty hacky
-        sast' <- addLemmas hypLemmas  -- add temporary lemmas
-        interactiveProof False True (lemmaName,caseLemma) -- recursion!
-        modify $ flip setCursor sast' -- discard temporary lemmas
+        pushProofStack $ Unproven lemmaName caseLemma ctxt (hypLemmas ++ ls) mempty
 
-    get >>= continue
-    return lem -- this is never reached, but the type says we need it.
+proveByCases :: (MonadCatch m, CLMonad m)
+             => CommitMsg -> (Id -> Bool) -> m ()
+proveByCases cm idPred = do
+    (nm, Lemma (Quantified bs cl) _ _ temp, ctxt, ls, _) <- currentLemma
+    guardMsg (any idPred bs) "specified identifier is not universally quantified in this lemma."
+    let (as,b:bs') = break idPred bs -- safe because above guard
+    guardMsg (not (any idPred bs')) "multiple matching quantifiers."
 
-addLemmas :: (MonadCatch m, MonadError CLException m, MonadIO m, MonadState CommandLineState m)
-          => [NamedLemma] -> m SAST
-addLemmas lems = do
-    ifM isRunningScript (return ()) $ forM_ lems printLemma
-    let addAllAtOnceR :: RewriteH Core
-        addAllAtOnceR = sideEffectR $ \ _ _ -> forM_ lems $ \ (nm,l) -> insertLemma nm l
+    cases <- queryInContext (do ue <- mkUndefinedValT (varType b)
+                                liftM (ue:) (constT (caseExprsForM (varToCoreExpr b)))) cm
 
-    st <- get
-    sast <- applyS (cl_kernel st) addAllAtOnceR (mkKernelEnv $ cl_pstate st) (cl_cursor st)
-    put $ newSAST (CmdName "adding lemmas") sast st
+    -- replace the current lemma with the three subcases
+    -- proving them will prove the overall lemma automatically
+    _ <- popProofStack
+    pushProofStack $ MarkProven nm temp
+    forM_ (zip [(0::Int)..] $ reverse cases) $ \ (i,e) -> do
 
-    -- return original SAST
-    return $ cl_cursor st
+        let lemmaName = fromString $ show nm ++ "-case-" ++ show i
+            Quantified bs'' cl' = substQuantified b e $ Quantified bs' cl
+            fvs = varSetElems $ localFreeVarsExpr e
+            caseLemma = Lemma (Quantified (as++fvs++bs'') cl') NotProven Obligation True
 
+        pushProofStack $ Unproven lemmaName caseLemma ctxt ls mempty
+
 data ProofShellCommand
-    = PCRewrite (RewriteH Equality)
-    | PCTransform (TransformH Equality String)
-    | PCInduction (Id -> Bool)
-    | PCShell ShellEffect
-    | PCScript ScriptEffect
-    | PCQuery QueryFun
-    | PCProofCommand ProofCommand
+    = PCInduction (Id -> Bool)
+    | PCByCases (Id -> Bool)
+    | PCConsequent
+    | PCConjunction
+    | PCSplitAssumed Int
+    | PCInstAssumed Int (Var -> Bool) CoreString
     | PCUser UserProofTechnique
-    | PCDump String String Int
-    | PCEnd
-    | PCUnsupported String
+    | PCEnd (Either Bool (Used,LemmaName)) -- ^ Left True = assume this lemma
+                                           --   Left False = check for alpha-equivalence
+                                           --   Right (u,nm) = try to prove with given lemma, marking it u
     deriving Typeable
 
 -- keep abstract to avoid breaking things if we modify this later
-newtype UserProofTechnique = UserProofTechnique (TransformH Equality ())
+newtype UserProofTechnique = UserProofTechnique (TransformH LCoreTC ())
+    deriving Typeable
 
-userProofTechnique :: TransformH Equality () -> UserProofTechnique
+userProofTechnique :: TransformH LCoreTC () -> UserProofTechnique
 userProofTechnique = UserProofTechnique
 
 instance Extern ProofShellCommand where
@@ -324,36 +324,7 @@
     box i = i
     unbox i = i
 
-data UserProofTechniqueBox = UserProofTechniqueBox UserProofTechnique deriving Typeable
-
 instance Extern UserProofTechnique where
-    type Box UserProofTechnique = UserProofTechniqueBox
-    box = UserProofTechniqueBox
-    unbox (UserProofTechniqueBox t) = t
-
-interpProof :: Monad m => [Interp m ProofShellCommand]
-interpProof =
-  [ interp $ \ (RewriteCoreBox rr)            -> PCRewrite $ bothR $ extractR rr
-  , interp $ \ (RewriteCoreTCBox rr)          -> PCRewrite $ bothR $ extractR rr
-  , interp $ \ (BiRewriteCoreBox br)          -> PCRewrite $ bothR $ (extractR (forwardT br) <+ extractR (backwardT br))
-  , interp $ \ (effect :: ShellEffect)        -> PCShell effect
-  , interp $ \ (effect :: ScriptEffect)       -> PCScript effect
-  , interp $ \ (StringBox str)                -> PCQuery (message str)
-  , interp $ \ (query :: QueryFun)            -> PCQuery query
-  , interp $ \ (cmd :: ProofCommand)          -> PCProofCommand cmd
-  , interp $ \ (RewriteEqualityBox r)         -> PCRewrite r
-  , interp $ \ (TransformEqualityStringBox t) -> PCTransform t
-  , interp $ \ (UserProofTechniqueBox t)      -> PCUser t
-  , interp $ \ (cmd :: ProofShellCommand)     -> cmd
-  , interp $ \ (CrumbBox _cr)                 -> PCUnsupported "CrumbBox"
-  , interp $ \ (PathBox _p)                   -> PCUnsupported "PathBox"
-  , interp $ \ (TransformCorePathBox _tt)     -> PCUnsupported "TransformCorePathBox"
-  , interp $ \ (TransformCoreTCPathBox _tt)   -> PCUnsupported "TransformCoreTCPathBox"
-  , interp $ \ (TransformCoreStringBox _tt)   -> PCUnsupported "TransformCoreStringBox"
-  , interp $ \ (TransformCoreTCStringBox _tt) -> PCUnsupported "TransformCoreTCStringBox"
-  , interp $ \ (TransformCoreTCDocHBox _tt)   -> PCUnsupported "TransformCoreTCDocHBox"
-  , interp $ \ (TransformCoreCheckBox _tt)    -> PCUnsupported "TransformCoreCheckBox"
-  , interp $ \ (TransformCoreTCCheckBox _tt)  -> PCUnsupported "TransformCoreTCCheckBox"
-  , interp $ \ (_effect :: KernelEffect)      -> PCUnsupported "KernelEffect"
-  ]
-
+    type Box UserProofTechnique = UserProofTechnique
+    box i = i
+    unbox i = i
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,5 +1,5 @@
 {-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, LambdaCase,
-             MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, CPP #-}
+             MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies #-}
 
 module HERMIT.Shell.ScriptToRewrite
     ( -- * Converting Scripts to Rewrites
@@ -9,36 +9,39 @@
     , parseScriptCLT
     , performScriptEffect
     , popScriptLine
+    , pushScriptLine
+    , pushScript
     , runScript
+    , fileToScript
     , scriptToRewrite
-    , setRunningScript
     , ScriptEffect(..)
     ) where
 
 import Control.Arrow
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except
-#else
-import Control.Monad.Error
-#endif
-import Control.Monad.State
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State (MonadState, gets, modify)
 import Control.Exception hiding (catch)
 
 import Data.Dynamic
+import qualified Data.Map as M
 
 import HERMIT.Context(LocalPathH)
-import HERMIT.Kernel.Scoped
-import HERMIT.Kure
 import HERMIT.External
+import HERMIT.Kernel
+import HERMIT.Kure
+import HERMIT.Lemma
 import HERMIT.Parser(Script, ExprH, unparseExprH, parseScript, unparseScript)
-
-import HERMIT.PrettyPrinter.Common(TransformCoreTCDocHBox(..))
+import HERMIT.Dictionary.Reasoning
+import HERMIT.PrettyPrinter.Common
+import qualified HERMIT.PrettyPrinter.Clean as Clean
 
 import HERMIT.Shell.KernelEffect
 import HERMIT.Shell.Interpreter
 import HERMIT.Shell.ShellEffect
 import HERMIT.Shell.Types
 
+import qualified Text.PrettyPrint.MarkedHughesPJ as PP
 ------------------------------------
 
 type RewriteName = String
@@ -47,7 +50,7 @@
     = DefineScript ScriptName String
     | LoadFile ScriptName FilePath  -- load a file on top of the current node
     | RunScript ScriptName
-    | SaveFile FilePath
+    | SaveFile Bool FilePath        -- Bool = whether to dump code/lemma between commands
     | SaveScript FilePath ScriptName
     | ScriptToRewrite RewriteName ScriptName
     | SeqMeta [ScriptEffect]
@@ -68,27 +71,74 @@
     where go = popScriptLine >>= maybe (return ()) (\e -> run e >> go)
 
 popScriptLine :: MonadState CommandLineState m => m (Maybe ExprH)
-popScriptLine = gets cl_running_script >>= maybe (return Nothing) (\case []     -> setRunningScript Nothing >> return Nothing
-                                                                         (e:es) -> setRunningScript (Just es) >> return (Just e))
+popScriptLine = gets cl_running_script >>= maybe (return Nothing)
+                                                 (\case []     -> setRunningScript Nothing >> return Nothing
+                                                        (e:es) -> setRunningScript (Just es) >> return (Just e))
 
-performScriptEffect :: (MonadCatch m, CLMonad m) => (ExprH -> m ()) -> ScriptEffect -> m ()
-performScriptEffect runner = go
+pushScriptLine :: MonadState CommandLineState m => ExprH -> m ()
+pushScriptLine = pushScript . (:[])
+
+pushScript :: MonadState CommandLineState m => Script -> m ()
+pushScript es = modify $ \ st -> st { cl_running_script = Just $ maybe es (++es) (cl_running_script st) }
+
+getFragment :: (MonadCatch m, CLMonad m) => Bool -> AST -> m String
+getFragment False _  = return ""
+getFragment True ast = do
+    (now,opts) <- gets (cl_cursor &&& cl_pretty_opts)
+    modify $ setCursor ast
+    ps <- getProofStackEmpty
+    let discardProvens [] = []
+        discardProvens r@(Unproven{} : _) = r
+        discardProvens (_:r) = discardProvens r
+    doc <- case discardProvens ps of
+            Unproven _ (Lemma q _ _ _) _ ls p : _ -> do
+                as <- case ls of
+                        [] -> return []
+                        _  -> liftM (PP.text "Assumed lemmas: " :) $
+                                queryInFocus ((liftPrettyH opts $
+                                                forM ls $ \(n',l') ->
+                                                    return l' >>> ppLemmaT Clean.pretty n'
+                                              ) :: TransformH Core [DocH]) Never
+                d <- queryInFocus (liftPrettyH opts $
+                                    return q >>> extractT (pathT (pathStack2Path p) (ppLCoreTCT Clean.pretty)) :: TransformH Core DocH) Never
+                return $ PP.vcat $ as ++ [PP.text "Goal:", d]
+            _                             -> queryInFocus (liftPrettyH opts $ pCoreTC Clean.pretty) Never
+    let ASCII str = renderCode opts doc
+        str' = unlines $ ("" :) $ map ("-- " ++) $ lines str
+    modify $ setCursor now
+    return str'
+
+fileToScript :: CLMonad m => FilePath -> m Script
+fileToScript fileName = do
+    putStrToConsole $ "Loading \"" ++ fileName ++ "\"..."
+    res <- liftIO $ try (readFile fileName)
+    case res of
+        Left (err :: IOException) -> fail ("IO error: " ++ show err)
+        Right str -> parseScriptCLT str
+
+performScriptEffect :: (MonadCatch m, CLMonad m) => ScriptEffect -> m ()
+performScriptEffect = go
     where go (SeqMeta ms) = mapM_ go ms
           go (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 <- parseScriptCLT str
-                    modify $ \ st -> st {cl_scripts = (scriptName,script) : cl_scripts st}
-                    putStrToConsole ("Script \"" ++ scriptName ++ "\" loaded successfully from \"" ++ fileName ++ "\".")
+            script <- fileToScript fileName
+            modify $ \ st -> st {cl_scripts = (scriptName,script) : cl_scripts st}
+            putStrToConsole ("Script \"" ++ scriptName ++ "\" loaded successfully from \"" ++ fileName ++ "\".")
 
-          go (SaveFile fileName) = do
-            version <- gets cl_version
+          go (SaveFile verb fileName) = do
             putStrToConsole $ "[saving " ++ fileName ++ "]"
+            (k,cur) <- gets (cl_kernel &&& cl_cursor)
+            all_asts <- listK k
+            let m = M.fromList [ (ast,(msg,p)) | (ast,msg,p) <- all_asts ]
+                follow ast
+                    | Just (msg, p) <- M.lookup ast m = do
+                        f <- getFragment verb ast
+                        (ls,lastFrag) <- maybe (return ([],"")) follow p
+                        let g = if f == lastFrag then id else (f:)
+                        return (g $ maybe (maybe id (const ("-- missing command!":)) p) (:) msg ls, f)
+                    | otherwise = return ([],"")
             -- no checks to see if you are clobering; be careful
-            liftIO $ writeFile fileName $ showGraph (vs_graph version) (vs_tags version) (SAST 0)
+            ls <- fst <$> follow cur
+            liftIO $ writeFile fileName $ unlines $ reverse ls
 
           go (ScriptToRewrite rewriteName scriptName) = do
             script <- lookupScript scriptName
@@ -103,11 +153,9 @@
           go (RunScript scriptName) = do
             script <- lookupScript scriptName
             running_script_st <- gets cl_running_script
-            setRunningScript $ Just script
-            runScript runner `catchError` (\ err -> setRunningScript running_script_st >> throwError err)
-            setRunningScript running_script_st
-            putStrToConsole ("Script \"" ++ scriptName ++ "\" ran successfully.")
-            showWindow
+            setRunningScript $ case running_script_st of
+                                Nothing -> Just script
+                                Just es -> Just (script ++ es)
 
           go (SaveScript fileName scriptName) = do
             script <- lookupScript scriptName
@@ -137,9 +185,9 @@
               | ScriptPrimSc ExprH PrimScriptR
 
 data PrimScriptR
-       = ScriptRewriteHCore (RewriteH Core)
+       = ScriptRewriteHCore (RewriteH LCore)
        | ScriptPath PathH
-       | ScriptTransformHCorePath (TransformH Core LocalPathH)
+       | ScriptTransformHCorePath (TransformH LCore LocalPathH)
 
 
 -- TODO: Hacky parsing, needs cleaning up
@@ -171,28 +219,27 @@
 
 interpScriptR :: Monad m => [Interp m UnscopedScriptR]
 interpScriptR =
-  [ interp (\ (RewriteCoreBox r)           -> ScriptPrimUn $ ScriptRewriteHCore r)
-  , interp (\ (RewriteCoreTCBox _)         -> ScriptUnsupported "rewrite that traverses types and coercions") -- TODO
-  , interp (\ (BiRewriteCoreBox br)        -> ScriptPrimUn $ ScriptRewriteHCore $ whicheverR br)
-  , interp (\ (CrumbBox cr)                -> ScriptPrimUn $ ScriptPath [cr])
-  , interp (\ (PathBox p)                  -> ScriptPrimUn $ ScriptPath (snocPathToPath p))
-  , interp (\ (TransformCorePathBox t)     -> ScriptPrimUn $ ScriptTransformHCorePath t)
-  , interp (\ (effect :: KernelEffect)     -> case effect of
+  [ interp (\ (RewriteLCoreBox r)           -> ScriptPrimUn $ ScriptRewriteHCore r)
+  , interp (\ (RewriteLCoreTCBox _)         -> ScriptUnsupported "rewrite that traverses types and coercions") -- TODO
+  , interp (\ (BiRewriteLCoreBox br)        -> ScriptPrimUn $ ScriptRewriteHCore $ whicheverR br)
+  , interp (\ (CrumbBox cr)                 -> ScriptPrimUn $ ScriptPath [cr])
+  , interp (\ (PathBox p)                   -> ScriptPrimUn $ ScriptPath (snocPathToPath p))
+  , interp (\ (TransformLCorePathBox t)     -> ScriptPrimUn $ ScriptTransformHCorePath t)
+  , interp (\ (effect :: KernelEffect)      -> case effect of
                                                 BeginScope -> ScriptBeginScope
                                                 EndScope   -> ScriptEndScope
                                                 _          -> ScriptUnsupported "Kernel effect" )
-  , interp (\ (_ :: ShellEffect)           -> ScriptUnsupported "shell effect")
-  , interp (\ (_ :: QueryFun)              -> ScriptUnsupported "query")
-  , interp (\ (TransformCoreStringBox _)   -> ScriptUnsupported "query")
-  , interp (\ (TransformCoreTCStringBox _) -> ScriptUnsupported "query")
-  , interp (\ (TransformCoreTCDocHBox _)   -> ScriptUnsupported "query")
-  , interp (\ (TransformCoreCheckBox _)    -> ScriptUnsupported "predicate")
-  , interp (\ (StringBox _)                -> ScriptUnsupported "message")
+  , interp (\ (_ :: ShellEffect)            -> ScriptUnsupported "shell effect")
+  , interp (\ (_ :: QueryFun)               -> ScriptUnsupported "query")
+  , interp (\ (TransformLCoreStringBox _)   -> ScriptUnsupported "query")
+  , interp (\ (TransformLCoreTCStringBox _) -> ScriptUnsupported "query")
+  , interp (\ (TransformLCoreUnitBox _)     -> ScriptUnsupported "predicate")
+  , interp (\ (StringBox _)                 -> ScriptUnsupported "message")
   ]
 
 -----------------------------------
 
-scopedScriptsToRewrite :: [ScopedScriptR] -> RewriteH Core
+scopedScriptsToRewrite :: [ScopedScriptR] -> RewriteH LCore
 scopedScriptsToRewrite []        = idR
 scopedScriptsToRewrite (x : xs)  = let rest = scopedScriptsToRewrite xs
                                        failWith e = prefixFailMsg ("Error in script expression: " ++ unparseExprH e ++ "\n")
@@ -206,7 +253,7 @@
 
 -----------------------------------
 
-scriptToRewrite :: CLMonad m => Script -> m (RewriteH Core)
+scriptToRewrite :: CLMonad m => Script -> m (RewriteH LCore)
 scriptToRewrite scr = do
     unscoped <- mapM (interpExprH interpScriptR) scr
     scoped   <- unscopedToScopedScriptR $ zip scr unscoped
@@ -225,9 +272,3 @@
 
 -----------------------------------
 
--- I find it annoying that Functor is not a superclass of Monad.
-(<$>) :: Monad m => (a -> b) -> m a -> m b
-(<$>) = liftM
-{-# INLINE (<$>) #-}
-
------------------------------------
diff --git a/src/HERMIT/Shell/ShellEffect.hs b/src/HERMIT/Shell/ShellEffect.hs
--- a/src/HERMIT/Shell/ShellEffect.hs
+++ b/src/HERMIT/Shell/ShellEffect.hs
@@ -1,25 +1,29 @@
-{-# LANGUAGE CPP, KindSignatures, GADTs, FlexibleContexts, TypeFamilies,
-             DeriveDataTypeable, GeneralizedNewtypeDeriving, LambdaCase,
-             MultiParamTypeClasses, ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module HERMIT.Shell.ShellEffect
     ( ShellEffect(..)
     , performShellEffect
+    , dumpT
     , dump
     ) where
 
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except
-#else
-import Control.Monad.Error
-#endif
-import Control.Monad.State
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.State (MonadState(..), gets)
 
 import Data.Typeable
 
 import HERMIT.External
 import HERMIT.Kure
-import HERMIT.Kernel.Scoped
 import HERMIT.PrettyPrinter.Common
 
 import HERMIT.Plugin.Renderer
@@ -31,13 +35,12 @@
 
 ----------------------------------------------------------------------------------
 
-data ShellEffect
-    = Abort -- ^ Abort GHC
-    | CLSModify (CommandLineState -> IO CommandLineState) -- ^ Modify shell state
-    | PluginComp (PluginM ())
-    | Continue -- ^ exit the shell, but don't abort/resume
-    | Dump (CommandLineState -> TransformH CoreTC DocH) String String Int
-    | Resume
+data ShellEffect :: * where
+    Abort      :: ShellEffect
+    CLSModify  :: (CommandLineState -> IO (Either CLException CommandLineState)) -> ShellEffect
+    PluginComp :: PluginM () -> ShellEffect
+    Continue   :: ShellEffect
+    Resume     :: ShellEffect
     deriving Typeable
 
 instance Extern ShellEffect where
@@ -47,22 +50,31 @@
 
 ----------------------------------------------------------------------------------
 
-performShellEffect :: (MonadCatch m, MonadError CLException m, MonadIO m, MonadState CommandLineState m) => ShellEffect -> m ()
+performShellEffect :: (MonadCatch m, CLMonad m) => ShellEffect -> m ()
 performShellEffect Abort  = abort
-performShellEffect Resume = gets cl_cursor >>= resume
-performShellEffect Continue = get >>= continue
-performShellEffect (Dump pp fileName renderer width) = dump pp fileName renderer width
+performShellEffect Resume = announceUnprovens >> gets cl_cursor >>= resume
+performShellEffect Continue = announceUnprovens >> get >>= continue
 
-performShellEffect (CLSModify f) = get >>= liftAndCatchIO . f >>= put >> showWindow
+performShellEffect (CLSModify f)  = get >>= liftAndCatchIO . f >>= either throwError put
 
-performShellEffect (PluginComp m) = pluginM m >> showWindow
+performShellEffect (PluginComp m) = pluginM m
 
-dump :: (MonadCatch m, MonadIO m, MonadState CommandLineState m) => (CommandLineState -> TransformH CoreTC DocH) -> String -> String -> Int -> m ()
-dump pp fileName renderer width = do
-    st <- get
+dumpT :: FilePath -> PrettyPrinter -> String -> Int -> TransformH DocH ()
+dumpT fileName pp renderer width = do
     case lookup renderer shellRenderers of
-      Just r -> do doc <- prefixFailMsg "Bad renderer option: " $ queryS (cl_kernel st) (pp st) (cl_kernel_env st) (cl_cursor st)
+      Just r -> do doc <- idR
                    liftIO $ do h <- openFile fileName WriteMode
-                               r h ((cl_pretty_opts st) { po_width = width }) (Right doc)
+                               r h ((pOptions pp) { po_width = width }) (Right doc)
                                hClose h
-      _ -> fail "dump: bad pretty-printer or renderer option"
+      _ -> fail "dump: bad renderer option"
+
+dump :: FilePath -> PrettyPrinter -> String -> Int -> CommandLineState -> IO (Either CLException CommandLineState)
+dump fileName pp renderer width st = do
+    let st' = setPrettyOpts (setPretty st pp) $ (cl_pretty_opts st) { po_width = width }
+    (r, _st'') <- runCLT st' $ do
+        pluginM (changeRenderer renderer)
+        h <- liftIO $ openFile fileName WriteMode
+        showWindow (Just h)
+        liftIO $ hClose h
+    return $ fmap (const st) r
+
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,33 +1,47 @@
-{-# LANGUAGE ConstraintKinds, CPP, KindSignatures, GADTs, FlexibleContexts, DeriveDataTypeable,
-             FunctionalDependencies, GeneralizedNewtypeDeriving, InstanceSigs,
-             LambdaCase, RankNTypes, ScopedTypeVariables, TypeFamilies #-}
-
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module HERMIT.Shell.Types where
 
 import Control.Applicative
+import Control.Arrow
 import Control.Concurrent.STM
-import Control.Monad.State
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except
-#else
-import Control.Monad.Error
-#endif
+import Control.Monad (liftM, unless, when, forM_)
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.State (MonadState(..), StateT(..), gets, modify)
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
 
 import Data.Dynamic
-import Data.List (intercalate)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust)
-import Data.Monoid (mempty)
+import Data.Monoid (mempty, (<>))
+import Data.String (fromString)
 
 import HERMIT.Context
 import HERMIT.Core
-import HERMIT.Kure
+import HERMIT.Dictionary.Reasoning hiding (externals)
 import HERMIT.External
 import qualified HERMIT.GHC as GHC
-import HERMIT.Kernel (AST, queryK, KernelEnv)
-import HERMIT.Kernel.Scoped
+import HERMIT.Kernel
+import HERMIT.Kure
+import HERMIT.Lemma
+import HERMIT.Monad
 import HERMIT.Parser
 import HERMIT.PrettyPrinter.Common
+import HERMIT.Syntax
 
 import HERMIT.Plugin.Display
 import HERMIT.Plugin.Renderer
@@ -42,16 +56,17 @@
 import System.Console.Terminfo (setupTermFromEnv, getCapability, termColumns, termLines)
 #endif
 
+import qualified Text.PrettyPrint.MarkedHughesPJ as PP
+
 ----------------------------------------------------------------------------------
 
 data QueryFun :: * where
-   QueryString   :: (Injection GHC.ModGuts g, Walker HermitC g)
-                 => TransformH g String                                   -> QueryFun
-   QueryDocH     :: (PrettyC -> PrettyH CoreTC -> TransformH CoreTC DocH) -> QueryFun
-   Diff          :: SAST -> SAST                                          -> QueryFun
-   Display       ::                                                          QueryFun
-   Inquiry       :: (CommandLineState -> IO String)                       -> QueryFun
-   CorrectnessCritera :: (Injection GHC.ModGuts g, Walker HermitC g) => TransformH g () -> QueryFun
+   QueryString  :: Injection a LCoreTC => TransformH a String       -> QueryFun
+   QueryDocH    :: Injection a LCoreTC => TransformH a DocH         -> QueryFun
+   QueryPrettyH :: Injection a LCoreTC => PrettyH a                 -> QueryFun
+   Diff         :: AST -> AST                                       -> QueryFun
+   Inquiry      :: (CommandLineState -> IO String)                  -> QueryFun
+   QueryUnit    :: Injection a LCoreTC => TransformH a ()           -> QueryFun
    deriving Typeable
 
 message :: String -> QueryFun
@@ -63,91 +78,85 @@
    unbox i = i
 
 performQuery :: (MonadCatch m, CLMonad m) => QueryFun -> ExprH -> m ()
-
-performQuery (QueryString q) _ = do
-    st <- get
-    str <- prefixFailMsg "Query failed: " $ queryS (cl_kernel st) q (cl_kernel_env st) (cl_cursor st)
-    putStrToConsole str
+performQuery qf expr = go qf
+    where cm = Changed $ unparseExprH expr
+          go (QueryString q) =
+            putStrToConsole =<< prefixFailMsg "Query failed: " (queryInContext (promoteT q) cm)
 
-performQuery (QueryDocH q) _ = do
-    st <- get
-    doc <- prefixFailMsg "Query failed: " $ queryS (cl_kernel st) (q (initPrettyC $ cl_pretty_opts st) $ pCoreTC $ cl_pretty st) (cl_kernel_env st) (cl_cursor st)
-    liftIO $ cl_render st stdout (cl_pretty_opts st) (Right doc)
+          go (QueryDocH q) = do
+            doc <- prefixFailMsg "Query failed: " $ queryInContext (promoteT q) cm
+            st <- get
+            liftIO $ cl_render st stdout (cl_pretty_opts st) (Right doc)
 
-performQuery (Inquiry f) _ = get >>= liftIO . f >>= putStrToConsole
+          go (QueryPrettyH q) = do
+            st <- get
+            doc <- prefixFailMsg "Query failed: " $ queryInContext (liftPrettyH (pOptions (cl_pretty st)) $ promoteT q) cm
+            liftIO $ cl_render st stdout (cl_pretty_opts st) (Right doc)
 
-performQuery (Diff s1 s2) _ = do
-    st <- get
+          go (Inquiry f) = get >>= liftIO . f >>= putStrToConsole
 
-    ast1 <- toASTS (cl_kernel st) s1
-    ast2 <- toASTS (cl_kernel st) s2
-    let getCmds sast | sast == s1 = []
-                     | otherwise = case [ (f,c) | (f,c,to) <- vs_graph (cl_version st), to == sast ] of
-                                    [(sast',cmd)] -> unparseExprH cmd : getCmds sast'
-                                    _ -> ["error: history broken!"] -- should be impossible
+          go (Diff ast1 ast2) = do
+            st <- get
+            all_asts <- listK (cl_kernel st)
 
-    cl_putStrLn "Commands:"
-    cl_putStrLn "========="
-    cl_putStrLn $ unlines $ reverse $ getCmds s2
+            let getCmds ast
+                    | ast == ast1 = []
+                    | otherwise   = case [ (p,msg) | (to,msg,Just p) <- all_asts, to == ast ] of
+                                            [(ast',msg)] -> fromMaybe "-- unknown command!" msg : getCmds ast'
+                                            _ -> ["error: history broken!"] -- should be impossible
 
-    doc1 <- ppWholeProgram ast1
-    doc2 <- ppWholeProgram ast2
+            cl_putStrLn "Commands:"
+            cl_putStrLn "========="
+            cl_putStrLn $ unlines $ reverse $ getCmds ast2
 
-    r <- diffDocH (cl_pretty st) doc1 doc2
+            doc1 <- ppWholeProgram ast1
+            doc2 <- ppWholeProgram ast2
 
-    cl_putStrLn "Diff:"
-    cl_putStrLn "====="
-    cl_putStr r
+            r <- diffDocH (cl_pretty st) doc1 doc2
 
--- Explicit calls to display should work no matter what the loading state is.
-performQuery Display _ = do
-    running_script_st <- gets cl_running_script
-    setRunningScript Nothing
-    showWindow
-    setRunningScript running_script_st
+            cl_putStrLn "Diff:"
+            cl_putStrLn "====="
+            cl_putStr r
 
-performQuery (CorrectnessCritera q) expr = do
-    st <- get
-    -- TODO: Again, we may want a quiet version of the kernel_env
-    modFailMsg (\ err -> unparseExprH expr ++ " [exception: " ++ err ++ "]")
-        $ queryS (cl_kernel st) q (cl_kernel_env st) (cl_cursor st)
-    putStrToConsole $ unparseExprH expr ++ " [correct]"
+          go (QueryUnit q) = do
+            -- TODO: Again, we may want a quiet version of the kernel_env
+            let str = unparseExprH expr
+            modFailMsg (\ err -> str ++ " [exception: " ++ err ++ "]") $ queryInContext (promoteT q) cm
+            putStrToConsole $ str ++ " [correct]"
 
-ppWholeProgram :: (MonadIO m, MonadState CommandLineState m) => AST -> m DocH
+ppWholeProgram :: (CLMonad m, MonadCatch m) => AST -> m DocH
 ppWholeProgram ast = do
     st <- get
-    liftIO (queryK (kernelS $ cl_kernel st)
-            ast
-            (extractT $ pathT [ModGuts_Prog] $ liftPrettyH (cl_pretty_opts st) $ pCoreTC $ cl_pretty st)
-            (cl_kernel_env st)) >>= runKureM return fail
+    d <- queryK (cl_kernel st)
+                (extractT $ pathT [ModGuts_Prog] $ liftPrettyH (cl_pretty_opts st) $ pCoreTC $ cl_pretty st)
+                Never
+                (cl_kernel_env st) ast
+    return $ snd d -- discard new AST, assuming pp won't create one
 
 ----------------------------------------------------------------------------------
 
-data VersionCmd = Back                  -- back (up) the derivation tree
-                | Step                  -- down one step; assumes only one choice
-                | Goto Int              -- goto a specific node, if possible
-                | GotoTag String        -- goto a specific named tag
-                | AddTag String         -- add a tag
+type TagName = String
+data VersionCmd = Back            -- back (up) the derivation tree
+                | Step            -- down one step; assumes only one choice
+                | Goto AST        -- goto a specific AST
+                | GotoTag TagName -- goto a specific AST, by tag name
+                | Tag TagName     -- tag the current AST with a name
         deriving Show
 
 ----------------------------------------------------------------------------------
 
 data CLException = CLAbort
-                 | CLResume SAST
+                 | CLResume AST
                  | CLContinue CommandLineState -- TODO: needed?
                  | CLError String
 
-#if !(MIN_VERSION_mtl(2,2,1))
-instance Error CLException where strMsg = CLError
-#endif
-
-abort :: MonadError CLException m => m ()
+abort :: MonadError CLException m => m a
 abort = throwError CLAbort
 
-resume :: MonadError CLException m => SAST -> m ()
+resume :: MonadError CLException m => AST -> m a
 resume = throwError . CLResume
 
-continue :: MonadError CLException m => CommandLineState -> m ()
+continue :: MonadError CLException m => CommandLineState -> m a
 continue = throwError . CLContinue
 
 rethrowCLE :: CLException -> PluginM a
@@ -171,20 +180,14 @@
 -- management in the command line code.
 --
 -- NB: an alternative to monad transformers, like Oleg's Extensible Effects, might be useful here.
-#if MIN_VERSION_mtl(2,2,1)
 newtype CLT m a = CLT { unCLT :: ExceptT CLException (StateT CommandLineState m) a }
-#else
-newtype CLT m a = CLT { unCLT :: ErrorT CLException (StateT CommandLineState m) a }
-#endif
     deriving (Functor, Applicative, MonadIO, MonadError CLException, MonadState CommandLineState)
 
 -- Adapted from System.Console.Haskeline.MonadException, which hasn't provided an instance for ExceptT yet
-#if MIN_VERSION_mtl(2,2,1)
 instance MonadException m => MonadException (ExceptT e m) where
     controlIO f = ExceptT $ controlIO $ \(RunIO run) -> let
                     run' = RunIO (fmap ExceptT . run . runExceptT)
                     in fmap runExceptT $ f run'
-#endif
 
 instance MonadException m => MonadException (CLT m) where
     controlIO f = CLT $ controlIO $ \(RunIO run) -> let run' = RunIO (fmap CLT . run . unCLT)
@@ -214,11 +217,7 @@
 
 -- | Run a CLT computation.
 runCLT :: CommandLineState -> CLT m a -> m (Either CLException a, CommandLineState)
-#if MIN_VERSION_mtl(2,2,1)
 runCLT s = flip runStateT s . runExceptT . unCLT
-#else
-runCLT s = flip runStateT s . runErrorT . unCLT
-#endif
 
 -- | Lift a CLT IO computation into a CLT computation over an arbitrary MonadIO.
 clm2clt :: MonadIO m => CLT IO a -> CLT m a
@@ -259,20 +258,6 @@
 
 ----------------------------------------------------------------------------------
 
-data VersionStore = VersionStore
-    { vs_graph       :: [(SAST,ExprH,SAST)]
-    , vs_tags        :: [(String,SAST)]
-    }
-
-newSAST :: ExprH -> SAST -> CommandLineState -> CommandLineState
-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 (except the PluginState).
 data CommandLineState = CommandLineState
     { cl_pstate         :: PluginState            -- ^ Access to the enclosing plugin state. This is propagated back
@@ -281,14 +266,37 @@
     , cl_height         :: Int                    -- ^ console height, in lines
     , cl_scripts        :: [(ScriptName,Script)]
     , cl_nav            :: Bool                   -- ^ keyboard input the nav panel
-    , cl_version        :: VersionStore
+    , cl_foci           :: M.Map AST PathStack    -- ^ focus assigned to each AST
+    , cl_tags           :: M.Map AST [String]     -- ^ list of tags on an AST
+    , cl_proofstack     :: M.Map AST [ProofTodo]  -- ^ stack of todos for the proof shell
     , cl_window         :: PathH                  -- ^ path to beginning of window, always a prefix of focus path in kernel
     , cl_externals      :: [External]             -- ^ Currently visible externals
     , cl_running_script :: Maybe Script           -- ^ Nothing = no script running, otherwise the remaining script commands
-    -- this should be in a reader
-    , cl_initSAST       :: SAST
+    , cl_safety         :: Safety                 -- ^ which level of safety we are running in
     } deriving (Typeable)
 
+type PathStack = ([LocalPathH], LocalPathH)
+
+data ProofTodo = Unproven
+                    { ptName    :: LemmaName    -- ^ lemma we are proving
+                    , ptLemma   :: Lemma
+                    , ptContext :: HermitC      -- ^ context in which lemma is being proved
+                    , ptAssumed :: [NamedLemma] -- ^ temporary lemmas in scope
+                    , ptPath    :: PathStack    -- ^ path into lemma to focus on
+                    }
+               | MarkProven { ptName :: LemmaName, ptTemp :: Bool } -- ^ lemma successfully proven, temporary status
+
+data Safety = StrictSafety | NormalSafety | NoSafety
+
+filterSafety :: Safety -> [External] -> [External]
+filterSafety NoSafety     = id
+filterSafety NormalSafety = filter ((Unsafe `notElem`) . externTags)
+filterSafety StrictSafety = filter ((`notElem` ["assume"]) . externName) . filterSafety NormalSafety
+-- TODO: currently, we only prevent assuming proofs in strict mode
+-- it would probably be better to explicitly tag every command allowed
+-- in strict safety mode with the 'Safe' tag, then change this to:
+-- filterSafety StrictSafety = filter ((Safe `elem`) . externTags)
+
 -- To ease the pain of nested records, define some boilerplate here.
 cl_corelint :: CommandLineState -> Bool
 cl_corelint = ps_corelint . cl_pstate
@@ -296,11 +304,11 @@
 setCoreLint :: CommandLineState -> Bool -> CommandLineState
 setCoreLint st b = st { cl_pstate = (cl_pstate st) { ps_corelint = b } }
 
-cl_cursor :: CommandLineState -> SAST
+cl_cursor :: CommandLineState -> AST
 cl_cursor = ps_cursor . cl_pstate
 
-setCursor :: CommandLineState -> SAST -> CommandLineState
-setCursor st sast = st { cl_pstate = (cl_pstate st) { ps_cursor = sast } }
+setCursor :: AST -> CommandLineState -> CommandLineState
+setCursor sast st = st { cl_pstate = (cl_pstate st) { ps_cursor = sast } }
 
 cl_diffonly :: CommandLineState -> Bool
 cl_diffonly = ps_diffonly . cl_pstate
@@ -314,7 +322,7 @@
 setFailHard :: CommandLineState -> Bool -> CommandLineState
 setFailHard st b = st { cl_pstate = (cl_pstate st) { ps_failhard = b } }
 
-cl_kernel :: CommandLineState -> ScopedKernel
+cl_kernel :: CommandLineState -> Kernel
 cl_kernel = ps_kernel . cl_pstate
 
 cl_kernel_env :: CommandLineState -> KernelEnv
@@ -345,11 +353,13 @@
                               , cl_height         = h
                               , cl_scripts        = []
                               , cl_nav            = False
-                              , cl_version        = VersionStore { vs_graph = [] , vs_tags = [] }
+                              , cl_foci           = M.empty
+                              , cl_tags           = M.empty
+                              , cl_proofstack     = M.empty
                               , cl_window         = mempty
                               , cl_externals      = [] -- Note, empty dictionary.
                               , cl_running_script = Nothing
-                              , cl_initSAST       = ps_cursor ps
+                              , cl_safety         = NormalSafety
                               }
     return $ setPrettyOpts st $ (cl_pretty_opts st) { po_width = w }
 
@@ -401,32 +411,230 @@
 
 ------------------------------------------------------------------------------
 
+pathStack2Path :: ([LocalPath crumb], LocalPath crumb) -> Path crumb
+pathStack2Path (ps,p) = concat $ reverse (map snocPathToPath (p:ps))
+
+-- | A primitive means of denoting navigation of a tree (within a local scope).
+data Direction = U -- ^ Up
+               | T -- ^ Top
+               deriving (Eq,Show)
+
+pathStackToLens :: (Injection a g, Walker HermitC g) => [LocalPathH] -> LocalPathH -> LensH a g
+pathStackToLens ps p = injectL >>> pathL (pathStack2Path (ps,p))
+
+getPathStack :: CLMonad m => m ([LocalPathH], LocalPathH)
+getPathStack = do
+    st <- get
+    return $ fromMaybe ([],mempty) (M.lookup (cl_cursor st) (cl_foci st))
+
+getFocusPath :: CLMonad m => m PathH
+getFocusPath = liftM pathStack2Path getPathStack
+
+addFocusT :: (Injection a g, Walker HermitC g, CLMonad m) => TransformH g b -> m (TransformH a b)
+addFocusT t = do
+    (base, rel) <- getPathStack
+    return $ focusT (pathStackToLens base rel) t
+
+addFocusR :: (Injection a g, Walker HermitC g, CLMonad m) => RewriteH g -> m (RewriteH a)
+addFocusR r = do
+    (base, rel) <- getPathStack
+    return $ focusR (pathStackToLens base rel) r
+
+------------------------------------------------------------------------------
+
+addAST :: CLMonad m => AST -> m ()
+addAST ast = do
+    copyProofStack ast
+    copyPathStack ast
+    modify $ setCursor ast
+
+modifyLocalPath :: (MonadCatch m, CLMonad m) => (LocalPathH -> LocalPathH) -> ExprH -> m ()
+modifyLocalPath f expr = do
+    ps <- getProofStackEmpty
+    (k,(kEnv,ast)) <- gets (cl_kernel &&& cl_kernel_env &&& cl_cursor)
+    case ps of
+        todo@(Unproven _ (Lemma q _ _ _) c _ _) : todos -> do
+            let (base, rel) = ptPath todo
+                rel' = f rel
+            requireDifferent rel rel'
+            (ast',()) <- queryK k (constT
+                                    (applyT
+                                      (setFailMsg "invalid path."
+                                        (focusT (pathStackToLens base rel' :: LensH Quantified LCoreTC) successT))
+                                      c q))
+                                  (Always $ unparseExprH expr) kEnv ast
+            addAST ast'
+            let todo' = todo { ptPath = (base, rel') }
+            modify $ \ st -> st { cl_proofstack = M.insert (cl_cursor st) (todo':todos) (cl_proofstack st) }
+        _ -> do
+            (base, rel) <- getPathStack
+            let rel' = f rel
+            requireDifferent rel rel'
+            -- we are testing paths, so the sum type matters
+            (ast',()) <- queryK k (setFailMsg "invalid path."
+                                    (focusT (pathStackToLens base rel' :: LensH GHC.ModGuts CoreTC) successT))
+                                  (Always $ unparseExprH expr) kEnv ast
+            addAST ast'
+            modify $ \ st -> st { cl_foci = M.insert (cl_cursor st) (base, rel') (cl_foci st) }
+
+requireDifferent :: Monad m => LocalPathH -> LocalPathH -> m ()
+requireDifferent p1 p2 = when (p1 == p2) $ fail "path unchanged, nothing to do."
+
+copyPathStack :: CLMonad m => AST -> m ()
+copyPathStack ast = do
+    (base, rel) <- getPathStack
+    modify $ \ st -> st { cl_foci = M.insert ast (base, rel) (cl_foci st) }
+
+copyProofStack :: CLMonad m => AST -> m ()
+copyProofStack ast = modify $ \ st -> let newStack = fromMaybe [] $ M.lookup (cl_cursor st) (cl_proofstack st)
+                                      in st { cl_proofstack = M.insert ast newStack (cl_proofstack st) }
+
+pushProofStack :: CLMonad m => ProofTodo -> m ()
+pushProofStack todo = modify $ \ st -> st { cl_proofstack = M.insertWith (++) (cl_cursor st) [todo] (cl_proofstack st) }
+
+popProofStack :: CLMonad m => m ProofTodo
+popProofStack = do
+    t : ts <- getProofStack
+    modify $ \ st -> st { cl_proofstack = M.insert (cl_cursor st) ts (cl_proofstack st) }
+    return t
+
+currentLemma :: CLMonad m => m (LemmaName, Lemma, HermitC, [NamedLemma], PathStack)
+currentLemma = do
+    todo : _ <- getProofStack
+
+    case todo of
+        Unproven nm l c ls p -> return (nm, l, c, ls, p)
+        _ -> fail "currentLemma: unproven lemma not on top of stack!"
+
+announceProven :: (MonadCatch m, CLMonad m) => m ()
+announceProven = getProofStack >>= go
+    where go (MarkProven nm temp : r) = do
+            queryInFocus (if temp then constT (deleteLemma nm) else modifyLemmaT nm id idR (const Proven) id :: TransformH Core ())
+                         (Always $ "-- proven " ++ quoteShow nm) -- comment in script
+            -- take it off the stack for the new AST
+            modify $ \ st -> st { cl_proofstack = M.insert (cl_cursor st) r (cl_proofstack st) }
+            cl_putStrLn ("Successfully proven: " ++ show nm) >> go r
+          go _ = return ()
+
+announceUnprovens :: (MonadCatch m, CLMonad m) => m ()
+announceUnprovens = do
+    (c,m) <- queryInFocus (contextT &&& getLemmasT :: TransformH LCore (HermitC,Lemmas)) Never
+    sf <- gets cl_safety
+    case sf of
+        StrictSafety -> do
+            let ls = [ nl | nl@(_,Lemma _ p u _) <- M.toList m, p `elem` [NotProven, Assumed True], u /= NotUsed ]
+            forM_ ls $ \ nl@(nm,_) -> do
+                cl_putStrLn $ "Fatal: Lemma " ++ show nm ++ " has not been proven, but was used."
+                printLemma stdout c mempty nl
+            unless (null ls) abort -- don't finish if this happens
+        NormalSafety -> do
+            let np = [ nl | nl@(_,Lemma _ NotProven u _) <- M.toList m, u /= NotUsed ]
+            forM_ np $ \ nl@(nm,_) -> do
+                cl_putStrLn $ "Fatal: Lemma " ++ show nm ++ " has not been proven, but was used."
+                printLemma stdout c mempty nl
+            unless (null np) abort -- don't finish if this happens
+            let as = [ nl | nl@(_,Lemma _ (Assumed True) u _) <- M.toList m, u /= NotUsed ]
+            forM_ as $ \ nl@(nm,_) -> do
+                cl_putStrLn $ "Warning: Lemma " ++ show nm ++ " was assumed but not proven."
+                printLemma stdout c mempty nl
+        NoSafety -> return ()
+
+-- | Always returns a non-empty list.
+getProofStack :: CLMonad m => m [ProofTodo]
+getProofStack = do
+    todos <- getProofStackEmpty
+    case todos of
+        [] -> fail "No lemma currently being proved."
+        _ -> return todos
+
+getProofStackEmpty :: CLMonad m => m [ProofTodo]
+getProofStackEmpty = do
+    (ps, ast) <- gets (cl_proofstack &&& cl_cursor)
+
+    maybe (return []) return $ M.lookup ast ps
+
+------------------------------------------------------------------------------
+
 fixWindow :: CLMonad m => m ()
 fixWindow = do
-    st <- get
     -- check to make sure new path is still inside window
-    focusPath <- pluginM getFocusPath
+    focusPath <- 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)
     {- when (not (isPrefixOf (cl_window st) focusPath) || null (cl_window st))
        $ put $ st { cl_window = focusPath } -}
-    put $ st { cl_window = focusPath } -- TODO: temporary until we figure out a better highlight interface
+    modify $ \ st -> st { cl_window = focusPath  } -- TODO: temporary until we figure out a better highlight interface
 
-showWindow :: CLMonad m => m ()
-showWindow = ifM isRunningScript (return ()) $ fixWindow >> gets cl_window >>= pluginM . display . Just
+showWindow :: (MonadCatch m, CLMonad m) => Maybe Handle -> m ()
+showWindow mbh = do
+    (ps,(ast,(pp,render))) <- gets (cl_proofstack &&& cl_cursor &&& cl_pretty &&& (ps_render . cl_pstate))
+    let h = fromMaybe stdout mbh
+        pStr = render h (pOptions pp) . Left
+    case M.lookup ast ps of
+        Just (Unproven _ l c ls p : _)  -> do
+            unless (null ls) $ do
+                liftIO $ pStr "Assumed lemmas:\n"
+                mapM_ (printLemma h c mempty)
+                      [ (fromString (show i) <> ": " <> n, lem)
+                      | (i::Int,(n,lem)) <- zip [0..] ls ]
+            printLemma h c p ("Goal:",l)
+        _ -> do st <- get
+                if cl_diffonly st
+                then do
+                    let k = cl_kernel st
 
-------------------------------------------------------------------------------
+                    all_asts <- listK k
 
-showGraph :: [(SAST,ExprH,SAST)] -> [(String,SAST)] -> SAST -> String
-showGraph graph tags this@(SAST n) =
-        (if length paths > 1 then "tag " ++ show n ++ "\n" else "") ++
-        concat (intercalate
-                ["goto " ++ show n ++ "\n"]
-                [ [ unparseExprH b ++ "\n" ++ showGraph graph tags c ]
-                | (b,c) <- paths
-                ])
-  where
-          paths = [ (b,c) | (a,b,c) <- graph, a == this ]
+                    let kEnv = cl_kernel_env st
+                        ast' = head $ [ cur | (cur, _, Just p) <- all_asts, p == ast ] ++ [ast]
+                        ppOpts = cl_pretty_opts st
 
+                    q <- addFocusT $ liftPrettyH ppOpts $ pCoreTC pp
+                    (_,doc1) <- queryK k q Never kEnv ast
+                    (_,doc2) <- queryK k q Never kEnv ast'
+                    diffDocH pp doc1 doc2 >>= liftIO . pStr -- TODO
+                else fixWindow >> gets cl_window >>= pluginM . display mbh . Just --TODO
+
+printLemma :: (MonadCatch m, MonadError CLException m, MonadIO m, MonadState CommandLineState m)
+           => Handle -> HermitC -> PathStack -> (LemmaName,Lemma) -> m ()
+printLemma h c p (nm,Lemma q _ _ _) = do -- TODO
+    pp <- gets cl_pretty
+    doc <- queryInFocus ((constT $ applyT (extractT (liftPrettyH (pOptions pp) (pathT (pathStack2Path p) (ppLCoreTCT pp)))) c q) :: TransformH Core DocH) Never
+    let doc' = PP.text (show nm) PP.$+$ PP.nest 2 doc
+    st <- get
+    liftIO $ cl_render st h (cl_pretty_opts st) (Right doc')
+
 ------------------------------------------------------------------------------
+
+queryInFocus :: (Walker HermitC g, Injection GHC.ModGuts g, MonadCatch m, CLMonad m)
+             => TransformH g b -> CommitMsg -> m b
+queryInFocus t msg = do
+    q <- addFocusT t
+    st <- get
+    (ast', r) <- queryK (cl_kernel st) q msg (cl_kernel_env st) (cl_cursor st)
+    addAST ast'
+    return r
+
+-- meant to be used inside queryInFocus
+inProofFocusT :: ProofTodo -> TransformH LCoreTC b -> TransformH Core b
+inProofFocusT (Unproven _ (Lemma q _ _ _) c ls ps) t =
+    contextfreeT $ withLemmas (M.fromList ls) . applyT (return q >>> extractT (pathT (pathStack2Path ps) t)) c
+inProofFocusT _ _ = fail "no proof in progress."
+
+inProofFocusR :: ProofTodo -> RewriteH LCoreTC -> TransformH Core Quantified
+inProofFocusR (Unproven _ (Lemma q _ _ _) c ls ps) rr =
+    contextfreeT $ withLemmas (M.fromList ls) . applyT (return q >>> extractR (pathR (pathStack2Path ps) rr)) c
+inProofFocusR _ _ = fail "no proof in progress."
+
+withLemmasInScope :: HasLemmas m => [(LemmaName,Lemma)] -> Transform c m a b -> Transform c m a b
+withLemmasInScope ls t = transform $ \ c -> withLemmas (M.fromList ls) . applyT t c
+
+-- TODO: better name
+queryInContext :: forall b m. (MonadCatch m, CLMonad m) => TransformH LCoreTC b -> CommitMsg -> m b
+queryInContext tr cm = do
+    ps <- getProofStackEmpty
+    case ps of
+        todo@(Unproven {}) : _
+          -> {- GHC.trace "in proof context" $  -}  queryInFocus (inProofFocusT todo tr) cm
+        _ -> {- GHC.trace "in modguts context" $ -} queryInFocus (extractT tr :: TransformH CoreTC b) cm
diff --git a/src/HERMIT/Syntax.hs b/src/HERMIT/Syntax.hs
--- a/src/HERMIT/Syntax.hs
+++ b/src/HERMIT/Syntax.hs
@@ -1,6 +1,6 @@
 module HERMIT.Syntax
-   (
-      -- * Utility Predicates for lexing Identifiers
+    ( -- * Utility Predicates for lexing Identifiers
+      quoteShow,
       -- ** Lexing HERMIT Scripts
       isScriptIdFirstChar,
       isScriptIdChar,
@@ -9,8 +9,7 @@
       isCoreIdFirstChar,
       isCoreIdChar,
       isCoreInfixIdChar
-   )
-where
+    ) where
 
 import Data.Char (isAlphaNum, isAlpha)
 
@@ -57,3 +56,7 @@
 infixOperatorSymbols = "!£$%^&*-+=@#<>?/.:|"
 
 ---------------------------------------------------------------------
+
+quoteShow :: Show a => a -> String
+quoteShow x = if all isScriptIdChar s then s else show s
+    where s = show x
diff --git a/src/HERMIT/Win32/IO.hsc b/src/HERMIT/Win32/IO.hsc
--- a/src/HERMIT/Win32/IO.hsc
+++ b/src/HERMIT/Win32/IO.hsc
@@ -25,11 +25,7 @@
 import Data.Char (ord)
 import Data.Typeable
 
-#if MIN_VERSION_base(4,7,0)
 import Foreign
-#else
-import Foreign hiding (unsafePerformIO)
-#endif
 import Foreign.C.Types
 
 import GHC.IO.FD (FD(..)) -- A wrapper around an Int32