diff --git a/.github/workflows/ci-idris2-and-libs.yml b/.github/workflows/ci-idris2-and-libs.yml
index c757ccab2fd..1d537efa189 100644
--- a/.github/workflows/ci-idris2-and-libs.yml
+++ b/.github/workflows/ci-idris2-and-libs.yml
@@ -120,6 +120,8 @@ jobs:
       - name: Build current version
         run: |
           make && make install
+      - name: Test
+        run: make ci-ubuntu-test INTERACTIVE=''
       - name: Artifact Idris2 from previous version
         uses: actions/upload-artifact@v4
         with:
diff --git a/idris2api.ipkg b/idris2api.ipkg
index a0f4831fe16..4d6d33a526d 100644
--- a/idris2api.ipkg
+++ b/idris2api.ipkg
@@ -52,7 +52,6 @@ modules =
     Core.Binary.Prims,
     Core.Case.CaseBuilder,
     Core.Case.CaseTree,
-    Core.Case.CaseTree.Pretty,
     Core.Case.Util,
     Core.CompileExpr,
     Core.CompileExpr.Pretty,
@@ -62,12 +61,18 @@ modules =
     Core.Context.Log,
     Core.Context.Pretty,
     Core.Context.TTC,
+    Core.Evaluate,
+    Core.Evaluate.Convert,
+    Core.Evaluate.Expand,
+    Core.Evaluate.Normalise,
+    Core.Evaluate.Value,
+    Core.Evaluate.Quote,
     Core.Core,
     Core.Coverage,
     Core.Directory,
     Core.Env,
+    Core.Erase,
     Core.FC,
-    Core.GetType,
     Core.Hash,
     Core.InitPrimitives,
     Core.LinearCheck,
@@ -76,16 +81,11 @@ modules =
     Core.Name.CompatibleVars,
     Core.Name.Namespace,
     Core.Name.Scoped,
-    Core.Normalise,
-    Core.Normalise.Convert,
-    Core.Normalise.Eval,
-    Core.Normalise.Quote,
     Core.Options,
     Core.Options.Log,
     Core.Ord,
     Core.Primitives,
     Core.Reflect,
-    Core.SchemeEval,
     Core.Termination.CallGraph,
     Core.Termination.SizeChange,
     Core.Termination.Positivity,
@@ -104,15 +104,8 @@ modules =
     Core.TTC,
     Core.Unify,
     Core.UnifyState,
-    Core.Value,
     Core.WithData,
 
-    Core.SchemeEval.Builtins,
-    Core.SchemeEval.Compile,
-    Core.SchemeEval.Evaluate,
-    Core.SchemeEval.Quote,
-    Core.SchemeEval.ToScheme,
-
     IdrisPaths,
 
     Idris.CommandLine,
@@ -198,6 +191,7 @@ modules =
     Libraries.Data.SnocList.HasLength,
     Libraries.Data.SnocList.LengthMatch,
     Libraries.Data.SnocList.SizeOf,
+    Libraries.Data.SnocList.Quantifiers.Extra,
     Libraries.Data.Span,
     Libraries.Data.SparseMatrix,
     Libraries.Data.String,
@@ -273,7 +267,6 @@ modules =
     TTImp.Elab,
     TTImp.Impossible,
     TTImp.Parser,
-    TTImp.PartialEval,
     TTImp.ProcessBuiltin,
     TTImp.ProcessData,
     TTImp.ProcessDecls,
diff --git a/libs/contrib/Data/List/TailRec.idr b/libs/contrib/Data/List/TailRec.idr
index a29033e685e..e84d025f138 100644
--- a/libs/contrib/Data/List/TailRec.idr
+++ b/libs/contrib/Data/List/TailRec.idr
@@ -196,8 +196,7 @@ partitionOnto_ext : (lfts, rgts : List a) -> (p : a -> Bool) -> (xs : List a) ->
 partitionOnto_ext  lfts rgts p [] = Refl
 partitionOnto_ext  lfts rgts p (x::xs) with (@@(p x), @@(List.partition p xs))
  partitionOnto_ext lfts rgts p (x::xs) | ((True **px_tru), ((dl_l, dl_r)**dl_pf))
-   = rewrite px_tru in
-     rewrite dl_pf  in
+   = rewrite dl_pf  in
      rewrite px_tru in
      let u = partitionOnto_ext (x :: lfts) rgts p xs in
      coe (\u => (reverseOnto (x :: fst u) lfts
@@ -205,8 +204,7 @@ partitionOnto_ext  lfts rgts p (x::xs) with (@@(p x), @@(List.partition p xs))
                 = partitionOnto (x :: lfts) rgts p xs) dl_pf u
 
  partitionOnto_ext lfts rgts p (x::xs) | ((False**px_fls), ((dl_l, dl_r)**dl_pf))
-   = rewrite px_fls in
-     rewrite dl_pf  in
+   = rewrite dl_pf  in
      rewrite px_fls in
      let u = partitionOnto_ext lfts (x :: rgts) p xs in
      coe (\u => (reverseOnto (     fst u) lfts
diff --git a/libs/test/Test/Golden.idr b/libs/test/Test/Golden.idr
index 7fa08dc684f..e6a6489f965 100644
--- a/libs/test/Test/Golden.idr
+++ b/libs/test/Test/Golden.idr
@@ -230,8 +230,10 @@ runTest opts testPath = do
   start <- clockTime UTC
   let cg = maybe "" (" --cg " ++) (codegen opts)
   let exe = "\"" ++ exeUnderTest opts ++ cg ++ "\""
+  putStrLn $ "Running " ++ testPath
+  fflush stdout
   ignore $ system $ "cd " ++ escapeArg testPath ++ " && " ++
-    "sh ./run " ++ exe ++ " | tr -d '\\r' > output"
+    "timeout 120s sh ./run " ++ exe ++ " | tr -d '\\r' > output"
   end <- clockTime UTC
 
   Right out <- readFile $ testPath ++ "/output"
diff --git a/src/Algebra/Semiring.idr b/src/Algebra/Semiring.idr
index f1fcdca94fa..5d5768c0fb8 100644
--- a/src/Algebra/Semiring.idr
+++ b/src/Algebra/Semiring.idr
@@ -56,3 +56,7 @@ branchOne yes no rig = if isLinear rig then yes else no
 export
 branchVal : (Semiring a, Eq a) => Lazy b -> Lazy b -> a -> b
 branchVal yes no rig = if isRigOther rig then yes else no
+
+export
+presence : Semiring a => Eq a => a -> a
+presence = elimSemi erased linear (const linear)
diff --git a/src/Compiler/ANF.idr b/src/Compiler/ANF.idr
index e5b25a3d750..69e76250ff3 100644
--- a/src/Compiler/ANF.idr
+++ b/src/Compiler/ANF.idr
@@ -4,10 +4,15 @@ import Compiler.LambdaLift
 
 import Core.CompileExpr
 import Core.Context
+import Core.Context.Log
 
+import Data.SnocList.Quantifiers
+import Data.String
 import Data.SortedSet
 import Data.Vect
 
+import Libraries.Data.SnocList.Extra
+
 %default covering
 
 -- Convert the lambda lifted form to ANF, with variable names made explicit.
@@ -82,26 +87,26 @@ mutual
   Show ANF where
     show (AV _ v) = show v
     show (AAppName fc lazy n args)
-        = show n ++ showLazy lazy ++ "(" ++ showSep ", " (map show args) ++ ")"
+        = show n ++ showLazy lazy ++ "(" ++ joinBy ", " (map show args) ++ ")"
     show (AUnderApp fc n m args)
         = "<" ++ show n ++ " underapp " ++ show m ++ ">(" ++
-          showSep ", " (map show args) ++ ")"
+          joinBy ", " (map show args) ++ ")"
     show (AApp fc lazy c arg)
         = show c ++ showLazy lazy ++ " @ (" ++ show arg ++ ")"
     show (ALet fc x val sc)
         = "%let v" ++ show x ++ " = (" ++ show val ++ ") in (" ++ show sc ++ ")"
     show (ACon fc n _ t args)
-        = "%con " ++ show n ++ "(" ++ showSep ", " (map show args) ++ ")"
+        = "%con " ++ show n ++ "(" ++ joinBy ", " (map show args) ++ ")"
     show (AOp fc lazy op args)
-        = "%op " ++ show op ++ showLazy lazy ++ "(" ++ showSep ", " (toList (map show args)) ++ ")"
+        = "%op " ++ show op ++ showLazy lazy ++ "(" ++ joinBy ", " (toList (map show args)) ++ ")"
     show (AExtPrim fc lazy p args)
-        = "%extprim " ++ show p ++ showLazy lazy ++ "(" ++ showSep ", " (map show args) ++ ")"
+        = "%extprim " ++ show p ++ showLazy lazy ++ "(" ++ joinBy ", " (map show args) ++ ")"
     show (AConCase fc sc alts def)
         = "%case " ++ show sc ++ " of { "
-             ++ showSep "| " (map show alts) ++ " " ++ show def ++ " }"
+             ++ joinBy "| " (map show alts) ++ " " ++ show def ++ " }"
     show (AConstCase fc sc alts def)
         = "%case " ++ show sc ++ " of { "
-             ++ showSep "| " (map show alts) ++ " " ++ show def ++ " }"
+             ++ joinBy "| " (map show alts) ++ " " ++ show def ++ " }"
     show (APrimVal _ x) = show x
     show (AErased _) = "___"
     show (ACrash _ x) = "%CRASH(" ++ show x ++ ")"
@@ -111,7 +116,7 @@ mutual
   Show AConAlt where
     show (MkAConAlt n _ t args sc)
         = "%conalt " ++ show n ++
-             "(" ++ showSep ", " (map showArg args) ++ ") => " ++ show sc
+             "(" ++ joinBy ", " (map showArg args) ++ ") => " ++ show sc
       where
         showArg : Int -> String
         showArg i = "v" ++ show i
@@ -136,6 +141,12 @@ Show ANFDef where
 AVars : Scope -> Type
 AVars = All (\_ => Int)
 
+namespace AVars
+  public export
+  empty : AVars Scope.empty
+  empty = [<]
+
+
 data Next : Type where
 
 nextVar : {auto v : Ref Next Int} ->
@@ -145,10 +156,6 @@ nextVar
          put Next (i + 1)
          pure i
 
-lookup : {idx : _} -> (0 p : IsVar x idx vs) -> AVars vs -> Int
-lookup First (x :: xs) = x
-lookup (Later p) (x :: xs) = lookup p xs
-
 bindArgs : {auto v : Ref Next Int} ->
            List ANF -> Core (List (AVar, Maybe ANF))
 bindArgs [] = pure []
@@ -183,6 +190,15 @@ mlet fc val sc
     = do i <- nextVar
          pure $ ALet fc i val (sc (ALocal i))
 
+bindAsFresh :
+  {auto v : Ref Next Int} ->
+  (args : List Name) -> AVars vars' ->
+  Core (List Int, AVars (Scope.ext vars' args))
+bindAsFresh [] vs = pure ([], vs)
+bindAsFresh (n :: ns) vs
+    = do i <- nextVar
+         mapFst (i ::) <$> bindAsFresh ns (vs :< i)
+
 mutual
   anfArgs : {auto v : Ref Next Int} ->
             FC -> AVars vars ->
@@ -193,7 +209,7 @@ mutual
 
   anf : {auto v : Ref Next Int} ->
         AVars vars -> Lifted vars -> Core ANF
-  anf vs (LLocal fc p) = pure $ AV fc (ALocal (lookup p vs))
+  anf vs (LLocal fc p) = pure $ AV fc (ALocal (lookup vs p))
   anf vs (LAppName fc lazy n args)
       = anfArgs fc vs args (AAppName fc lazy n)
   anf vs (LUnderApp fc n m args)
@@ -205,7 +221,7 @@ mutual
                   _ => ACrash fc "Can't happen (AApp)"
   anf vs (LLet fc x val sc)
       = do i <- nextVar
-           let vs' = i :: vs
+           let vs' = vs :< i
            pure $ ALet fc i !(anf vs val) !(anf vs' sc)
   anf vs (LCon fc n ci t args)
       = anfArgs fc vs args (ACon fc n ci t)
@@ -231,19 +247,20 @@ mutual
   anf vs (LErased fc) = pure $ AErased fc
   anf vs (LCrash fc err) = pure $ ACrash fc err
 
+  anfConScope : {auto v : Ref Next Int} ->
+                AVars vars -> LiftedCaseScope vars ->
+                Core (List Int, ANF)
+  anfConScope vs (LRHS sc) = pure ([], !(anf vs sc))
+  anfConScope vs (LArg x sc)
+      = do i <- nextVar
+           (args, sc') <- anfConScope (vs :< i) sc
+           pure (i :: args, sc')
+
   anfConAlt : {auto v : Ref Next Int} ->
               AVars vars -> LiftedConAlt vars -> Core AConAlt
-  anfConAlt vs (MkLConAlt n ci t args sc)
-      = do (is, vs') <- bindArgs args vs
-           pure $ MkAConAlt n ci t is !(anf vs' sc)
-    where
-      bindArgs : (args : List Name) -> AVars vars' ->
-                 Core (List Int, AVars (args ++ vars'))
-      bindArgs [] vs = pure ([], vs)
-      bindArgs (n :: ns) vs
-          = do i <- nextVar
-               (is, vs') <- bindArgs ns vs
-               pure (i :: is, i :: vs')
+  anfConAlt vs (MkLConAlt n ci t sc)
+      = do (args, sc') <- anfConScope vs sc
+           pure $ MkAConAlt n ci t args sc'
 
   anfConstAlt : {auto v : Ref Next Int} ->
                 AVars vars -> LiftedConstAlt vars -> Core AConstAlt
@@ -251,28 +268,23 @@ mutual
       = pure $ MkAConstAlt c !(anf vs sc)
 
 export
-toANF : LiftedDef -> Core ANFDef
+toANF : {auto c : Ref Ctxt Defs} -> LiftedDef -> Core ANFDef
 toANF (MkLFun args scope sc)
     = do v <- newRef Next (the Int 0)
-         (iargs, vsNil) <- bindArgs args []
-         let vs : AVars args = rewrite sym (appendNilRightNeutral args) in
-                                      vsNil
-         (iargs', vs) <- bindArgs scope vs
-         pure $ MkAFun (iargs ++ reverse iargs') !(anf vs sc)
-  where
-    bindArgs : {auto v : Ref Next Int} ->
-               (args : List Name) -> AVars vars' ->
-               Core (List Int, AVars (args ++ vars'))
-    bindArgs [] vs = pure ([], vs)
-    bindArgs (n :: ns) vs
-        = do i <- nextVar
-             (is, vs') <- bindArgs ns vs
-             pure (i :: is, i :: vs')
+         log "compile.execute" 40 $ "toANF args: \{show $ toList args}, scope: \{show $ asList scope}, lifted: \{show sc}"
+         (iargs, vsNil) <- bindAsFresh args AVars.empty
+         (iargs', vs) <- bindAsFresh (toList scope) vsNil
+         sc' <- anf vs $
+            do rewrite fishAsSnocAppend (cast args) (toList scope)
+               rewrite castToList scope
+               sc
+         log "compile.execute" 40 $ "toANF iargs: \{show iargs}, iargs': \{show iargs'}, lifted: \{show sc'}"
+         pure $ MkAFun (iargs ++ iargs') sc'
 toANF (MkLCon t a ns) = pure $ MkACon t a ns
 toANF (MkLForeign ccs fargs t) = pure $ MkAForeign ccs fargs t
 toANF (MkLError err)
     = do v <- newRef Next (the Int 0)
-         pure $ MkAError !(anf [] err)
+         pure $ MkAError !(anf AVars.empty err)
 
 export
 freeVariables : ANF -> SortedSet AVar
diff --git a/src/Compiler/CaseOpts.idr b/src/Compiler/CaseOpts.idr
index be40e389eff..1297d7c10fb 100644
--- a/src/Compiler/CaseOpts.idr
+++ b/src/Compiler/CaseOpts.idr
@@ -5,9 +5,13 @@ module Compiler.CaseOpts
 import Core.CompileExpr
 import Core.Context
 
+import Data.List
+import Data.SnocList
 import Data.Vect
 
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 %default covering
 
@@ -29,38 +33,38 @@ case t of
 
 shiftUnder : {args : _} ->
              {idx : _} ->
-             (0 p : IsVar n idx (x :: args ++ vars)) ->
-             NVar n (args ++ x :: vars)
+             (0 p : IsVar n idx (Scope.addInner vars (Scope.bind args x))) ->
+             NVar n (Scope.addInner (Scope.bind vars x) args)
 shiftUnder First = weakenNVar (mkSizeOf args) (MkNVar First)
 shiftUnder (Later p) = insertNVar (mkSizeOf args) (MkNVar p)
 
-shiftVar : {outer : Scope} -> {args : List Name} ->
-           NVar n (outer ++ (x :: args ++ vars)) ->
-           NVar n (outer ++ (args ++ x :: vars))
+shiftVar : {inner : Scope} -> {args : List Name} ->
+           NVar n ((vars <>< args :< x) ++ inner) ->
+           NVar n ((vars :< x <>< args) ++ inner)
 shiftVar nvar
-  = let out = mkSizeOf outer in
-    case locateNVar out nvar of
-      Left nvar => embed nvar
-      Right (MkNVar p) => weakenNs out (shiftUnder p)
+  = let inn = mkSizeOf inner in
+    case locateNVar inn nvar of
+      Left (MkNVar p) => weakenNs inn (shiftUndersN (mkSizeOf _) p)
+      Right nvar => embed nvar
 
 mutual
-  shiftBinder : {outer, args : _} ->
+  shiftBinder : {inner, args : _} ->
                 (new : Name) ->
-                CExp (outer ++ old :: (args ++ vars)) ->
-                CExp (outer ++ (args ++ new :: vars))
+                CExp (((vars <>< args) :< old) ++ inner) ->
+                CExp ((vars :< new <>< args) ++ inner)
   shiftBinder new (CLocal fc p)
       = case shiftVar (MkNVar p) of
              MkNVar p' => CLocal fc (renameVar p')
     where
-      renameVar : IsVar x i (outer ++ (args ++ (old :: rest))) ->
-                  IsVar x i (outer ++ (args ++ (new :: rest)))
+      renameVar : IsVar x i ((vars :< old <>< args) ++ local) ->
+                  IsVar x i ((vars :< new <>< args) ++ local)
       renameVar = believe_me -- it's the same index, so just the identity at run time
   shiftBinder new (CRef fc n) = CRef fc n
-  shiftBinder {outer} new (CLam fc n sc)
-      = CLam fc n $ shiftBinder {outer = n :: outer} new sc
+  shiftBinder {inner} new (CLam fc n sc)
+      = CLam fc n $ shiftBinder {inner = inner :< n} new sc
   shiftBinder new (CLet fc n inlineOK val sc)
       = CLet fc n inlineOK (shiftBinder new val)
-                           $ shiftBinder {outer = n :: outer} new sc
+                           $ shiftBinder {inner = inner :< n} new sc
   shiftBinder new (CApp fc f args)
       = CApp fc (shiftBinder new f) $ map (shiftBinder new) args
   shiftBinder new (CCon fc ci c tag args)
@@ -82,46 +86,78 @@ mutual
   shiftBinder new (CErased fc) = CErased fc
   shiftBinder new (CCrash fc msg) = CCrash fc msg
 
-  shiftBinderConAlt : {outer, args : _} ->
+  shiftBinderConScope : {inner, args : _} ->
+                        (new : Name) ->
+                        CCaseScope (((vars <>< args) :< old) ++ inner) ->
+                        CCaseScope ((vars :< new <>< args) ++ inner)
+  shiftBinderConScope new (CRHS tm) = CRHS (shiftBinder new tm)
+  shiftBinderConScope new (CArg x sc)
+      = CArg x (shiftBinderConScope {inner = inner :< x} new sc)
+
+  shiftBinderConAlt : {inner, args : _} ->
                 (new : Name) ->
-                CConAlt (outer ++ (x :: args ++ vars)) ->
-                CConAlt (outer ++ (args ++ new :: vars))
-  shiftBinderConAlt new (MkConAlt n ci t args' sc)
-      = let sc' : CExp ((args' ++ outer) ++ (x :: args ++ vars))
-                = rewrite sym (appendAssociative args' outer (x :: args ++ vars)) in sc in
-        MkConAlt n ci t args' $
-           rewrite (appendAssociative args' outer (args ++ new :: vars))
-             in shiftBinder new {outer = args' ++ outer} sc'
-
-  shiftBinderConstAlt : {outer, args : _} ->
+                CConAlt (((vars <>< args) :< old) ++ inner) ->
+                CConAlt ((vars :< new <>< args) ++ inner)
+  shiftBinderConAlt new (MkConAlt n ci t cscope)
+      = MkConAlt n ci t (shiftBinderConScope new cscope)
+
+  shiftBinderConstAlt : {inner, args : _} ->
                 (new : Name) ->
-                CConstAlt (outer ++ (x :: args ++ vars)) ->
-                CConstAlt (outer ++ (args ++ new :: vars))
+                CConstAlt (((vars <>< args) :< old) ++ inner) ->
+                CConstAlt ((vars :< new <>< args) ++ inner)
   shiftBinderConstAlt new (MkConstAlt c sc) = MkConstAlt c $ shiftBinder new sc
 
 -- If there's a lambda inside a case, move the variable so that it's bound
 -- outside the case block so that we can bind it just once outside the block
 liftOutLambda : {args : _} ->
                 (new : Name) ->
-                CExp (old :: args ++ vars) ->
-                CExp (args ++ new :: vars)
-liftOutLambda = shiftBinder {outer = Scope.empty}
+                CExp (Scope.bind (Scope.ext vars args) old) ->
+                CExp (Scope.ext (Scope.bind vars new) args)
+liftOutLambda = shiftBinder {inner = Scope.empty}
+
+rewSc : CCaseScope ((vars <>< args) :< x) -> CCaseScope (vars <>< (args ++ [x]))
+rewSc sc' = do rewrite fishAsSnocAppend vars (args ++ [x])
+               rewrite castListAppend args [x]
+               rewrite sym $ fishAsSnocAppend vars args
+               sc'
+
+rewSc' : CCaseScope (vars <>< (args ++ [x])) -> CCaseScope ((vars <>< args) :< x)
+rewSc' sc' = do rewrite fishAsSnocAppend vars args
+                rewrite castListAppend' args x
+                rewrite sym $ fishAsSnocAppend vars (args ++ [x])
+                sc'
+  where
+    castListAppend' : (args : List Name) -> (x : Name) -> vars ++ (cast args ++ [<x]) = vars ++ cast (args ++ [x])
+    castListAppend' args' x' = do rewrite castListAppend args' [x']
+                                  Refl
+
+tryLiftOutScope : {args : _} ->
+                  (new : Name) ->
+                  CCaseScope (vars <>< args) ->
+                  Maybe (CCaseScope ((vars :< new) <>< args))
+tryLiftOutScope new (CRHS (CLam fc x sc))
+    = let sc' = liftOutLambda new sc in
+          pure (CRHS sc')
+tryLiftOutScope new (CArg x sc)
+    = do sc' <- tryLiftOutScope new (rewSc sc)
+         pure (CArg x (rewSc' sc'))
+    where
+tryLiftOutScope _ _ = Nothing
 
 -- If all the alternatives start with a lambda, we can have a single lambda
 -- binding outside
 tryLiftOut : (new : Name) ->
              List (CConAlt vars) ->
-             Maybe (List (CConAlt (new :: vars)))
+             Maybe (List (CConAlt (Scope.bind vars new)))
 tryLiftOut new [] = Just []
-tryLiftOut new (MkConAlt n ci t args (CLam fc x sc) :: as)
-    = do as' <- tryLiftOut new as
-         let sc' = liftOutLambda new sc
-         pure (MkConAlt n ci t args sc' :: as')
-tryLiftOut _ _ = Nothing
+tryLiftOut new (MkConAlt n ci t sc :: as)
+    = do sc' <- tryLiftOutScope {args = []} new sc
+         as' <- tryLiftOut new as
+         pure (MkConAlt n ci t sc' :: as')
 
 tryLiftOutConst : (new : Name) ->
                   List (CConstAlt vars) ->
-                  Maybe (List (CConstAlt (new :: vars)))
+                  Maybe (List (CConstAlt (Scope.bind vars new)))
 tryLiftOutConst new [] = Just []
 tryLiftOutConst new (MkConstAlt c (CLam fc x sc) :: as)
     = do as' <- tryLiftOutConst new as
@@ -131,7 +167,7 @@ tryLiftOutConst _ _ = Nothing
 
 tryLiftDef : (new : Name) ->
              Maybe (CExp vars) ->
-             Maybe (Maybe (CExp (new :: vars)))
+             Maybe (Maybe (CExp (Scope.bind vars new)))
 tryLiftDef new Nothing = Just Nothing
 tryLiftDef new (Just (CLam fc x sc))
    = let sc' = liftOutLambda {args = []} new sc in
@@ -140,9 +176,15 @@ tryLiftDef _ _ = Nothing
 
 allLams : List (CConAlt vars) -> Bool
 allLams [] = True
-allLams (MkConAlt n ci t args (CLam {}) :: as)
-   = allLams as
-allLams _ = False
+allLams (MkConAlt n ci t sc :: as)
+   = if isLam sc
+        then allLams as
+        else False
+  where
+    isLam : forall vars . CCaseScope vars -> Bool
+    isLam (CRHS (CLam{})) = True
+    isLam (CRHS _) = False
+    isLam (CArg x sc) = isLam sc
 
 allLamsConst : List (CConstAlt vars) -> Bool
 allLamsConst [] = True
@@ -235,10 +277,15 @@ mutual
   -- All the others, no recursive case so just return the input
   caseLam x = pure x
 
+  caseLamConScope : {auto n : Ref NextName Int} ->
+                    CCaseScope vars -> Core (CCaseScope vars)
+  caseLamConScope (CRHS tm) = CRHS <$> caseLam tm
+  caseLamConScope (CArg x sc) = CArg x <$> caseLamConScope sc
+
   caseLamConAlt : {auto n : Ref NextName Int} ->
                   CConAlt vars -> Core (CConAlt vars)
-  caseLamConAlt (MkConAlt n ci tag args sc)
-      = MkConAlt n ci tag args <$> caseLam sc
+  caseLamConAlt (MkConAlt n ci tag sc)
+      = MkConAlt n ci tag <$> caseLamConScope sc
 
   caseLamConstAlt : {auto n : Ref NextName Int} ->
                     CConstAlt vars -> Core (CConstAlt vars)
@@ -306,12 +353,18 @@ doCaseOfCase : FC ->
 doCaseOfCase fc x xalts xdef alts def
     = CConCase fc x (map updateAlt xalts) (map updateDef xdef)
   where
+    updateScope : {args : SnocList Name} ->
+                  CCaseScope (Scope.addInner vars args) -> CCaseScope (Scope.addInner vars args)
+    updateScope {args} (CRHS tm)
+        = CRHS $ CConCase fc tm
+                   (map (weakenNs (mkSizeOf args)) alts)
+                   (map (weakenNs (mkSizeOf args)) def)
+    updateScope (CArg x sc)
+        = CArg x (updateScope {args = args :< x} sc)
+
     updateAlt : CConAlt vars -> CConAlt vars
-    updateAlt (MkConAlt n ci t args sc)
-        = MkConAlt n ci t args $
-              CConCase fc sc
-                       (map (weakenNs (mkSizeOf args)) alts)
-                       (map (weakenNs (mkSizeOf args)) def)
+    updateAlt (MkConAlt n ci t sc)
+        = MkConAlt n ci t (updateScope {args = Scope.empty} sc)
 
     updateDef : CExp vars -> CExp vars
     updateDef sc = CConCase fc sc alts def
@@ -345,8 +398,12 @@ tryCaseOfCase (CConCase fc (CConCase fc' x xalts xdef) alts def)
     isCon _ = False
 
     conCase : CConAlt vars -> Bool
-    conCase (MkConAlt _ _ _ _ (CCon {})) = True
-    conCase _ = False
+    conCase (MkConAlt _ _ _ sc) = isCon sc
+      where
+        isCon : forall vars . CCaseScope vars -> Bool
+        isCon (CRHS (CCon _ _ _ _ _)) = True
+        isCon (CRHS _) = False
+        isCon (CArg x sc) = isCon sc
 
     canCaseOfCase : List (CConAlt vars) -> Maybe (CExp vars) -> Bool
     canCaseOfCase [] _ = True
diff --git a/src/Compiler/Common.idr b/src/Compiler/Common.idr
index a64bdc7744d..3a61818e5fa 100644
--- a/src/Compiler/Common.idr
+++ b/src/Compiler/Common.idr
@@ -334,6 +334,8 @@ getCompileDataWith exports doLazyAnnots phase_in tm_in
 
          (cseDefs, csetm) <- logTime 2 "CSE" $ cse rcns compiledtm
 
+         for_ cseDefs $ \(n, _, def) => log "compile.execute" 40 $ "getCompileDataWith cseDefs: \{show (n, def)}"
+
          -- Add intrinsic constructors (see Compiler.Opts.Constructor)
          let cseDefs = intrinsicCons ++ cseDefs
 
@@ -348,7 +350,7 @@ getCompileDataWith exports doLazyAnnots phase_in tm_in
                               traverse (lambdaLift doLazyAnnots) cseDefs
                          else pure []
 
-         let lifted = (mainname, MkLFun Scope.empty Scope.empty liftedtm) ::
+         let lifted = (mainname, MkLFun [] Scope.empty liftedtm) ::
                       (ldefs ++ concat lifted_in)
 
          anf <- if phase >= ANF
@@ -362,18 +364,22 @@ getCompileDataWith exports doLazyAnnots phase_in tm_in
          whenJust (dumpcases sopts) $ \ f =>
             do coreLift $ putStrLn $ "Dumping case trees to " ++ f
                dumpIR f (map (\(n, _, def) => (n, def)) namedDefs)
+         for_ namedDefs $ \(n, _, def) => log "compile.execute" 40 $ "getCompileDataWith namedDefs: \{show (n, def)}"
 
          whenJust (dumplifted sopts) $ \ f =>
             do coreLift $ putStrLn $ "Dumping lambda lifted defs to " ++ f
                dumpIR f lifted
+         for_ lifted $ \(n, def) => log "compile.execute" 40 $ "getCompileDataWith lifted: \{show (n, def)}"
 
          whenJust (dumpanf sopts) $ \ f =>
             do coreLift $ putStrLn $ "Dumping ANF defs to " ++ f
                dumpIR f anf
+         for_ anf $ \(n, def) => log "compile.execute" 40 $ "getCompileDataWith anf: \{show (n, def)}"
 
          whenJust (dumpvmcode sopts) $ \ f =>
             do coreLift $ putStrLn $ "Dumping VM defs to " ++ f
                dumpIR f vmcode
+         for_ vmcode $ \(n, def) => log "compile.execute" 40 $ "getCompileDataWith vmcode: \{show (n, def)}"
 
          -- We're done with our minimal context now, so put it back the way
          -- it was. Back ends shouldn't look at the global context, because
diff --git a/src/Compiler/CompileExpr.idr b/src/Compiler/CompileExpr.idr
index cd6e07463b6..3baad4eeea4 100644
--- a/src/Compiler/CompileExpr.idr
+++ b/src/Compiler/CompileExpr.idr
@@ -1,19 +1,25 @@
 module Compiler.CompileExpr
 
 import Compiler.Opts.Constructor
-import Core.Case.CaseTree
 import public Core.CompileExpr
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
 import Core.Options
-import Core.Value
 
-import Data.List.HasLength
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+
+import Data.SnocList
+import Data.SnocList.Quantifiers
 import Data.Vect
 
 import Libraries.Data.NatSet
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.HasLength
+import Libraries.Data.SnocList.Extra
 
 %default covering
 
@@ -30,16 +36,21 @@ numArgs defs (Ref _ _ n)
     = do Just gdef <- lookupCtxtExact n (gamma defs)
               | Nothing => pure (Arity 0)
          case definition gdef of
-           DCon _ arity Nothing => pure (EraseArgs arity (eraseArgs gdef))
-           DCon _ arity (Just (_, pos)) => pure (NewTypeBy arity pos)
-           PMDef _ args _ _ _ => pure (EraseArgs (length args) (eraseArgs gdef))
+           DCon di _ arity =>
+               case newTypeArg di of
+                    Nothing => pure (EraseArgs arity (eraseArgs gdef))
+                    Just (_, pos) => pure (NewTypeBy arity pos)
+           Function _ def _ _ => pure (EraseArgs (countArgs def) (eraseArgs gdef))
            ExternDef arity => pure (Arity arity)
            ForeignDef arity _ => pure (Arity arity)
-           Builtin {arity} f => pure (Arity arity)
            _ => pure (Arity 0)
+  where
+    countArgs : forall vars . Term vars -> Nat
+    countArgs (Bind _ _ (Lam {}) sc) = S (countArgs sc)
+    countArgs _ = 0
 numArgs _ tm = pure (Arity 0)
 
-weakenVar : Var ns -> Var (a :: ns)
+weakenVar : Var ns -> Var (ns :< a)
 weakenVar (MkVar p) = (MkVar (Later p))
 
 etaExpand : Int -> Nat -> CExp vars -> List (Var vars) -> CExp vars
@@ -57,7 +68,7 @@ etaExpand i Z exp args = mkApp exp (map (mkLocal (getFC exp)) (reverse args))
 etaExpand i (S k) exp args
     = CLam (getFC exp) (MN "eta" i)
              (etaExpand (i + 1) k (weaken exp)
-                  (first :: map weakenVar args))
+                  (first :: map later args))
 
 export
 expandToArity : Nat -> CExp vars -> List (CExp vars) -> CExp vars
@@ -111,16 +122,18 @@ eraseConArgs arity epos fn args
              then fn'
              else dropPos epos fn' -- fn' might be lambdas, after eta expansion
 
-mkDropSubst : Nat -> NatSet ->
-              (rest : List Name) ->
-              (vars : List Name) ->
-              (vars' ** Thin (vars' ++ rest) (vars ++ rest))
-mkDropSubst i es rest [] = ([] ** Refl)
-mkDropSubst i es rest (x :: xs)
-    = let (vs ** sub) = mkDropSubst (1 + i) es rest xs in
-          if i `elem` es
-             then (vs ** Drop sub)
-             else (x :: vs ** Keep sub)
+mkDropSubst : NatSet ->
+              (vars : Scope) ->
+              (args : Scope) ->
+              (SizeOf args) ->
+              (args' ** Thin (Scope.addInner vars args') (Scope.addInner vars args))
+mkDropSubst es rest l s with (sizedView s)
+    mkDropSubst _ _ _ _ | Z = ([<] ** Refl)
+    mkDropSubst es rest (xs :< x) _ | (S s@(MkSizeOf i _))
+        = let (vs ** sub) = mkDropSubst es rest xs s in
+            if i `elem` es
+                then (vs ** Drop sub)
+                else (vs :< x ** Keep sub)
 
 -- See if the constructor is a special constructor type, e.g a nil or cons
 -- shaped thing.
@@ -139,13 +152,165 @@ dconFlag n
     ciFlags def (ConType ci :: xs) = ci
     ciFlags def (x :: xs) = ciFlags def xs
 
-toCExpTm : {auto c : Ref Ctxt Defs} ->
-           Name -> Term vars ->
-           Core (CExp vars)
 toCExp : {auto c : Ref Ctxt Defs} ->
+         {auto s : Ref NextMN Int} ->
          Name -> Term vars ->
          Core (CExp vars)
 
+toCExpScope : {auto c : Ref Ctxt Defs} ->
+              {auto s : Ref NextMN Int} ->
+              Name -> Nat -> NatSet ->
+              CaseScope vars -> Core (CCaseScope vars)
+toCExpScope n i es (RHS _ tm) = pure $ CRHS !(toCExp n tm)
+toCExpScope n i es (Arg c x sc)
+    = if i `elem` es
+            then pure $ shrinkCScope (Drop Refl) $
+                        !(toCExpScope n (S i) es sc)
+            else pure $ CArg x !(toCExpScope n (S i) es sc)
+
+conCases : {auto c : Ref Ctxt Defs} ->
+           {auto s : Ref NextMN Int} ->
+           Name -> List (CaseAlt vars) ->
+           Core (List (CConAlt vars))
+conCases n [] = pure []
+conCases n (ConCase fc x tag sc :: ns)
+    = do defs <- get Ctxt
+         Just gdef <- lookupCtxtExact x (gamma defs)
+              | Nothing => -- primitive type match
+                   do xn <- getFullName x
+                      pure $ MkConAlt xn TYCON Nothing !(toCExpScope n 0 NatSet.empty sc)
+                               :: !(conCases n ns)
+         let nt = case definition gdef of
+                       DCon di _ arity => newTypeArg di
+                       _ => Nothing
+         case nt of
+              Just pos => conCases n ns -- skip it
+              _ => do xn <- getFullName x
+                      sc' <- toCExpScope n 0 (eraseArgs gdef) sc
+                      ns' <- conCases n ns
+                      if dcon (definition gdef)
+                         then pure $ MkConAlt xn !(dconFlag xn) (Just tag) sc' :: ns'
+                         else pure $ MkConAlt xn !(dconFlag xn) Nothing sc' :: ns'
+  where
+    dcon : Def -> Bool
+    dcon (DCon _ _ _) = True
+    dcon _ = False
+
+conCases n (_ :: ns) = conCases n ns
+
+constCases : {auto c : Ref Ctxt Defs} ->
+             {auto s : Ref NextMN Int} ->
+             Name -> List (CaseAlt vars) ->
+             Core (List (CConstAlt vars))
+constCases n [] = pure []
+constCases n (ConstCase _ WorldVal sc :: ns)
+    = constCases n ns
+constCases n (ConstCase _ x sc :: ns)
+    = pure $ MkConstAlt x !(toCExp n sc) ::
+                  !(constCases n ns)
+constCases n (_ :: ns) = constCases n ns
+
+getDef : {auto c : Ref Ctxt Defs} ->
+         {auto s : Ref NextMN Int} ->
+         Name -> List (CaseAlt vars) ->
+         Core (Maybe (CExp vars))
+getDef n [] = pure Nothing
+getDef n (DefaultCase fc sc :: ns)
+    = pure $ Just !(toCExp n sc)
+getDef n (ConstCase fc WorldVal sc :: ns)
+    = pure $ Just !(toCExp n sc)
+getDef n (_ :: ns) = getDef n ns
+
+-- If there's a case which matches on a 'newtype', return the RHS
+-- without matching.
+-- Take some care if the newtype involves a WorldVal - in that case we
+-- still need to let bind the scrutinee to ensure it's evaluated exactly
+-- once.
+getNewType : {auto c : Ref Ctxt Defs} ->
+             {auto s : Ref NextMN Int} ->
+             FC -> CExp vars ->
+             Name -> List (CaseAlt vars) ->
+             Core (Maybe (CExp vars))
+getNewType fc scr n [] = pure Nothing
+getNewType fc scr n (DefaultCase _ sc :: ns)
+    = pure $ Nothing
+getNewType fc scr n (ConCase _ x tag sc :: ns)
+    = do defs <- get Ctxt
+         Just (DCon di t a) <- lookupDefExact x (gamma defs)
+              | _ => pure Nothing
+         let Just (noworld, pos) = newTypeArg di
+              | _ => pure Nothing
+         if noworld
+            then substScr 0 pos scr Lin sc
+            else substLetScr 0 pos scr Lin sc
+  where
+    -- no %World, so substitute diretly
+    substScr : {args : _} ->
+               Nat -> Nat -> CExp vars ->
+               SubstCEnv args vars ->
+               CaseScope (vars ++ args) ->
+               Core (Maybe (CExp vars))
+    substScr i pos x env (RHS _ tm)
+        = do tm' <- toCExp n tm
+             pure $ Just (substs (mkSizeOf args) env tm')
+    substScr i pos x env (Arg c n sc)
+        = if i == pos
+             then substScr (S i) pos x (env :< x) sc
+             else substScr (S i) pos x (env :< CErased fc) sc
+
+    -- When we find the scrutinee, let bind it and substitute the name into
+    -- the RHS, so the thing still gets evaluated if it's an action on %World
+    substLetScr : {args : _} ->
+               Nat -> Nat -> CExp vars ->
+               SubstCEnv args (vars :< MN "eff" 0) ->
+               CaseScope (vars ++ args) ->
+               Core (Maybe (CExp vars))
+    substLetScr i pos x env (RHS _ tm)
+        = do tm' <- toCExp n tm
+             let tm' = insertNames {outer = vars} {inner = args} {middle = [<MN "eff" 0]}
+                            (mkSizeOf _) (mkSizeOf _) tm'
+             let rettm = CLet fc (MN "eff" 0) NotInline x
+                       (substs (mkSizeOf args) env tm')
+             pure $ Just rettm
+    substLetScr i pos x env (Arg c n sc)
+        = if i == pos
+             then substLetScr (S i) pos x (env :< CLocal fc First) sc
+             else substLetScr (S i) pos x (env :< CErased fc) sc
+
+getNewType fc scr n (_ :: ns) = getNewType fc scr n ns
+
+toCExpCase : {auto c : Ref Ctxt Defs} ->
+             {auto s : Ref NextMN Int} ->
+             Name -> FC -> CExp vars -> List (CaseAlt vars) ->
+             Core (CExp vars)
+toCExpCase n fc x (DelayCase _ ty arg sc :: rest)
+    = pure $
+          CLet fc ty YesInline (CErased fc) $
+          CLet fc arg YesInline (CForce fc LInf (weaken x)) $
+               !(toCExp n sc)
+toCExpCase n fc sc alts@(ConCase _ _ _ _ :: _)
+    = do Nothing <- getNewType fc sc n alts
+             | Just def => pure def
+         defs <- get Ctxt
+         cases <- conCases n alts
+         def <- getDef n alts
+         if isNil cases
+            then pure (fromMaybe (CErased fc) def)
+            else pure (CConCase fc sc cases def)
+toCExpCase n fc sc alts@(ConstCase _ _ _ :: _)
+    = do cases <- constCases n alts
+         def <- getDef n alts
+         if isNil cases
+            then pure (fromMaybe (CErased fc) def)
+            else pure $ CConstCase fc sc cases def
+toCExpCase n fc _ alts@(DefaultCase _ tm :: _) = toCExp n tm
+toCExpCase n fc sc []
+      = pure $ CCrash fc $ "Missing case tree in " ++ show n
+
+toCExpTm : {auto c : Ref Ctxt Defs} ->
+           {auto s : Ref NextMN Int} ->
+           Name -> Term vars ->
+           Core (CExp vars)
 toCExpTm n (Local fc _ _ prf)
     = pure $ CLocal fc prf
 toCExpTm n (Ref fc (DataCon tag arity) fn)
@@ -160,7 +325,7 @@ toCExpTm n (Ref fc _ fn)
              -- ^ For readability of output code, and the Nat hack,
          pure $ CApp fc (CRef fc full) []
 toCExpTm n (Meta fc mn i args)
-    = pure $ CApp fc (CRef fc mn) !(traverse (toCExp n) args)
+    = pure $ CApp fc (CRef fc mn) !(traverse (toCExp n) (map snd args))
 toCExpTm n (Bind fc x (Lam {}) sc)
     = pure $ CLam fc x !(toCExp n sc)
 toCExpTm n (Bind fc x (Let _ rig val _) sc)
@@ -174,11 +339,13 @@ toCExpTm n (Bind fc x (Pi _ c e ty) sc)
                      , CLam fc x !(toCExp n sc)]
 toCExpTm n (Bind fc x b tm) = pure $ CErased fc
 -- We'd expect this to have been dealt with in toCExp, but for completeness...
-toCExpTm n (App fc tm arg)
+toCExpTm n (App fc tm _ arg)
     = pure $ CApp fc !(toCExp n tm) [!(toCExp n arg)]
 -- This shouldn't be in terms any more, but here for completeness
 toCExpTm n (As _ _ _ p) = toCExpTm n p
 -- TODO: Either make sure 'Delayed' is always Rig0, or add to typecase
+toCExpTm n (Case fc _ _ sc _ alts)
+    = toCExpCase n fc !(toCExp n sc) alts
 toCExpTm n (TDelayed fc _ _) = pure $ CErased fc
 toCExpTm n (TDelay fc lr _ arg)
     = pure (CDelay fc lr !(toCExp n arg))
@@ -186,7 +353,10 @@ toCExpTm n (TForce fc lr arg)
     = pure (CForce fc lr !(toCExp n arg))
 toCExpTm n (PrimVal fc $ PrT c) = pure $ CCon fc (UN $ Basic $ show c) TYCON Nothing [] -- Primitive type constant
 toCExpTm n (PrimVal fc c) = pure $ CPrimVal fc c -- Non-type constant
+toCExpTm n (PrimOp {arity} fc fn args)
+    = pure $ COp fc fn !(traverseVect (toCExp n) args)
 toCExpTm n (Erased fc _) = pure $ CErased fc
+toCExpTm n (Unmatched fc str) = pure $ CCrash fc str
 toCExpTm n (TType fc _) = pure $ CCon fc (UN (Basic "Type")) TYCON Nothing []
 
 toCExp n tm
@@ -203,164 +373,6 @@ toCExp n tm
                       Arity a =>
                         pure $ expandToArity a f' args'
 
-mutual
-  conCases : {vars : _} ->
-             {auto c : Ref Ctxt Defs} ->
-             Name -> List (CaseAlt vars) ->
-             Core (List (CConAlt vars))
-  conCases n [] = pure []
-  conCases {vars} n (ConCase x tag args sc :: ns)
-      = do defs <- get Ctxt
-           Just gdef <- lookupCtxtExact x (gamma defs)
-                | Nothing => -- primitive type match
-                     do xn <- getFullName x
-                        pure $ MkConAlt xn TYCON Nothing args !(toCExpTree n sc)
-                                  :: !(conCases n ns)
-           case (definition gdef) of
-                DCon _ arity (Just pos) => conCases n ns -- skip it
-                _ => do xn <- getFullName x
-                        let (args' ** sub)
-                            = mkDropSubst 0 (eraseArgs gdef) vars args
-                        sc' <- toCExpTree n sc
-                        ns' <- conCases n ns
-                        if dcon (definition gdef)
-                           then pure $ MkConAlt xn !(dconFlag xn) (Just tag) args' (shrinkCExp sub sc') :: ns'
-                           else pure $ MkConAlt xn !(dconFlag xn) Nothing args' (shrinkCExp sub sc') :: ns'
-    where
-      dcon : Def -> Bool
-      dcon (DCon {}) = True
-      dcon _ = False
-  conCases n (_ :: ns) = conCases n ns
-
-  constCases : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               Name -> List (CaseAlt vars) ->
-               Core (List (CConstAlt vars))
-  constCases n [] = pure []
-  constCases n (ConstCase WorldVal sc :: ns)
-      = constCases n ns
-  constCases n (ConstCase x sc :: ns)
-      = pure $ MkConstAlt x !(toCExpTree n sc) ::
-                    !(constCases n ns)
-  constCases n (_ :: ns) = constCases n ns
-
-  -- If there's a case which matches on a 'newtype', return the RHS
-  -- without matching.
-  -- Take some care if the newtype involves a WorldVal - in that case we
-  -- still need to let bind the scrutinee to ensure it's evaluated exactly
-  -- once.
-  getNewType : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               FC -> CExp vars ->
-               Name -> List (CaseAlt vars) ->
-               Core (Maybe (CExp vars))
-  getNewType fc scr n [] = pure Nothing
-  getNewType fc scr n (DefaultCase sc :: ns)
-      = pure $ Nothing
-  getNewType {vars} fc scr n (ConCase x tag args sc :: ns)
-      = do defs <- get Ctxt
-           case !(lookupDefExact x (gamma defs)) of
-                -- If the flag is False, we still take the
-                -- default, but need to evaluate the scrutinee of the
-                -- case anyway - if the data structure contains a %World,
-                -- that we've erased, it means it has interacted with the
-                -- outside world, so we need to evaluate to keep the
-                -- side effect.
-                Just (DCon _ arity (Just (noworld, pos))) =>
--- FIXME: We don't need the commented out bit *for now* because io_bind
--- isn't being inlined, but it does need to be a little bit cleverer to
--- get the best performance.
--- I'm (edwinb) keeping it visible here because I plan to put it back in
--- more or less this form once case inlining works better and the whole thing
--- works in a nice principled way.
-                     if noworld -- just substitute the scrutinee into
-                                -- the RHS
-                        then
-                             let (s, env) : (SizeOf args, SubstCEnv args vars)
-                                     = mkSubst 0 scr pos args in
-                              do log "compiler.newtype.world" 50 "Inlining case on \{show n} (no world)"
-                                 pure $ Just (substs s env !(toCExpTree n sc))
-                        else -- let bind the scrutinee, and substitute the
-                             -- name into the RHS
-                             let (s, env) : (_, SubstCEnv args (MN "eff" 0 :: vars))
-                                     = mkSubst 0 (CLocal fc First) pos args in
-                             do sc' <- toCExpTree n sc
-                                let scope = insertNames {outer=args}
-                                                        {inner=vars}
-                                                        {ns = [MN "eff" 0]}
-                                                        (mkSizeOf _) (mkSizeOf _) sc'
-                                let tm = CLet fc (MN "eff" 0) NotInline scr (substs s env scope)
-                                log "compiler.newtype.world" 50 "Kept the scrutinee \{show tm}"
-                                pure (Just tm)
-                _ => pure Nothing -- there's a normal match to do
-    where
-      mkSubst : Nat -> CExp vs ->
-                Nat -> (args : List Name) -> (SizeOf args, SubstCEnv args vs)
-      mkSubst _ _ _ [] = (zero, Subst.empty)
-      mkSubst i scr pos (a :: as)
-          = let (s, env) = mkSubst (1 + i) scr pos as in
-            if i == pos
-               then (suc s, scr :: env)
-               else (suc s, CErased fc :: env)
-  getNewType fc scr n (_ :: ns) = getNewType fc scr n ns
-
-  getDef : {vars : _} ->
-           {auto c : Ref Ctxt Defs} ->
-           Name -> List (CaseAlt vars) ->
-           Core (Maybe (CExp vars))
-  getDef n [] = pure Nothing
-  getDef n (DefaultCase sc :: ns)
-      = pure $ Just !(toCExpTree n sc)
-  getDef n (ConstCase WorldVal sc :: ns)
-      = pure $ Just !(toCExpTree n sc)
-  getDef n (_ :: ns) = getDef n ns
-
-  toCExpTree : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               Name -> CaseTree vars ->
-               Core (CExp vars)
-  toCExpTree n alts@(Case _ x scTy (DelayCase ty arg sc :: rest))
-      = let fc = getLoc scTy in
-            pure $
-              CLet fc arg YesInline (CForce fc LInf (CLocal (getLoc scTy) x)) $
-              CLet fc ty YesInline (CErased fc)
-                   !(toCExpTree n sc)
-  toCExpTree n alts
-      = toCExpTree' n alts
-
-  toCExpTree' : {vars : _} ->
-                {auto c : Ref Ctxt Defs} ->
-                Name -> CaseTree vars ->
-                Core (CExp vars)
-  toCExpTree' n (Case _ x scTy alts@(ConCase _ _ _ _ :: _))
-      = let fc = getLoc scTy in
-            do Nothing <- getNewType fc (CLocal fc x) n alts
-                   | Just def => pure def
-               defs <- get Ctxt
-               cases <- conCases n alts
-               def <- getDef n alts
-               if isNil cases
-                  then pure $ fromMaybe (CErased fc) def
-                  else pure $ CConCase fc (CLocal fc x) cases def
-  toCExpTree' n (Case _ x scTy alts@(DelayCase _ _ _ :: _))
-      = throw (InternalError "Unexpected DelayCase")
-  toCExpTree' n (Case fc x scTy alts@(ConstCase _ _ :: _))
-      = let fc = getLoc scTy in
-            do cases <- constCases n alts
-               def <- getDef n alts
-               if isNil cases
-                  then pure (fromMaybe (CErased fc) def)
-                  else pure $ CConstCase fc (CLocal fc x) cases def
-  toCExpTree' n (Case _ x scTy alts@(DefaultCase sc :: _))
-      = toCExpTree n sc
-  toCExpTree' n (Case _ x scTy [])
-      = pure $ CCrash (getLoc scTy) $ "Missing case tree in " ++ show n
-  toCExpTree' n (STerm _ tm) = toCExp n tm
-  toCExpTree' n (Unmatched msg)
-      = pure $ CCrash emptyFC msg
-  toCExpTree' n Impossible
-      = pure $ CCrash emptyFC ("Impossible case encountered in " ++ show n)
-
 -- Need this for ensuring that argument list matches up to operator arity for
 -- builtins
 ArgList : Nat -> Scope -> Type
@@ -369,44 +381,39 @@ ArgList = HasLength
 mkArgList : Int -> (n : Nat) -> (ns ** ArgList n ns)
 mkArgList i Z = (_ ** Z)
 mkArgList i (S k)
-    = let (ns ** rec) = mkArgList (i + 1) k in
-          ((MN "arg" i) :: ns ** S rec)
-
--- TODO has quadratic runtime
-getVars : ArgList k ns -> Vect k (Var ns)
-getVars Z = []
-getVars (S rest) = first :: map weakenVar (getVars rest)
+    = let (ns ** rec) = mkArgList (i - 1) k in
+          (ns :< (MN "arg" (i - 1)) ** S rec)
 
 data NArgs : Type where
-     User : Name -> List ClosedClosure -> NArgs
-     Struct : String -> List (String, ClosedClosure) -> NArgs
+     User : Name -> List (Glued [<]) -> NArgs
+     Struct : String -> List (String, Glued [<]) -> NArgs
      NUnit : NArgs
      NPtr : NArgs
      NGCPtr : NArgs
      NBuffer : NArgs
      NForeignObj : NArgs
-     NIORes : ClosedClosure -> NArgs
+     NIORes : Glued [<] -> NArgs
 
 getPArgs : {auto c : Ref Ctxt Defs} ->
-           Defs -> ClosedClosure -> Core (String, ClosedClosure)
+           Defs -> Glued [<] -> Core (String, Glued [<])
 getPArgs defs cl
-    = do NDCon fc _ _ _ args <- evalClosure defs cl
+    = do VDCon fc _ _ _ args <- expand cl
              | nf => throw (GenericMsg (getLoc nf) "Badly formed struct type")
-         case reverse (map snd args) of
-              (tydesc :: n :: _) =>
-                  do NPrimVal _ (Str n') <- evalClosure defs n
+         case !(traverseSnocList value args) of
+              (_ :< n :< tydesc) =>
+                  do VPrimVal _ (Str n') <- expand n
                          | nf => throw (GenericMsg (getLoc nf) "Unknown field name")
                      pure (n', tydesc)
               _ => throw (GenericMsg fc "Badly formed struct type")
 
 getFieldArgs : {auto c : Ref Ctxt Defs} ->
-               Defs -> ClosedClosure -> Core (List (String, ClosedClosure))
+               Defs -> Glued [<] -> Core (List (String, Glued [<]))
 getFieldArgs defs cl
-    = do NDCon fc _ _ _ args <- evalClosure defs cl
+    = do VDCon fc _ _ _ args <- expand cl
              | nf => throw (GenericMsg (getLoc nf) "Badly formed struct type")
-         case map snd args of
+         case !(traverseSnocList value args) of
               -- cons
-              [_, t, rest] =>
+              [< _, t, rest] =>
                   do rest' <- getFieldArgs defs rest
                      (n, ty) <- getPArgs defs t
                      pure ((n, ty) :: rest')
@@ -414,7 +421,7 @@ getFieldArgs defs cl
               _ => pure []
 
 getNArgs : {auto c : Ref Ctxt Defs} ->
-           Defs -> Name -> List ClosedClosure -> Core NArgs
+           Defs -> Name -> List (Glued [<]) -> Core NArgs
 getNArgs defs (NS _ (UN $ Basic "IORes")) [arg] = pure $ NIORes arg
 getNArgs defs (NS _ (UN $ Basic "Ptr")) [arg] = pure NPtr
 getNArgs defs (NS _ (UN $ Basic "AnyPtr")) [] = pure NPtr
@@ -424,7 +431,7 @@ getNArgs defs (NS _ (UN $ Basic "Buffer")) [] = pure NBuffer
 getNArgs defs (NS _ (UN $ Basic "ForeignObj")) [] = pure NForeignObj
 getNArgs defs (NS _ (UN $ Basic "Unit")) [] = pure NUnit
 getNArgs defs (NS _ (UN $ Basic "Struct")) [n, args]
-    = do NPrimVal _ (Str n') <- evalClosure defs n
+    = do VPrimVal _ (Str n') <- expand n
              | nf => throw (GenericMsg (getLoc nf) "Unknown name for struct")
          pure (Struct n' !(getFieldArgs defs args))
 getNArgs defs n args = pure $ User n args
@@ -432,42 +439,42 @@ getNArgs defs n args = pure $ User n args
 -- The order of the arguments have a big effect on case-tree size
 nfToCFType : {auto c : Ref Ctxt Defs} ->
              FC -> ClosedNF -> (inStruct : Bool) -> Core CFType
-nfToCFType _ (NPrimVal _ $ PrT IntType) _ = pure CFInt
-nfToCFType _ (NPrimVal _ $ PrT IntegerType) _ = pure CFInteger
-nfToCFType _ (NPrimVal _ $ PrT Bits8Type) _ = pure CFUnsigned8
-nfToCFType _ (NPrimVal _ $ PrT Bits16Type) _ = pure CFUnsigned16
-nfToCFType _ (NPrimVal _ $ PrT Bits32Type) _ = pure CFUnsigned32
-nfToCFType _ (NPrimVal _ $ PrT Bits64Type) _ = pure CFUnsigned64
-nfToCFType _ (NPrimVal _ $ PrT Int8Type) _ = pure CFInt8
-nfToCFType _ (NPrimVal _ $ PrT Int16Type) _ = pure CFInt16
-nfToCFType _ (NPrimVal _ $ PrT Int32Type) _ = pure CFInt32
-nfToCFType _ (NPrimVal _ $ PrT Int64Type) _ = pure CFInt64
-nfToCFType _ (NPrimVal _ $ PrT StringType) False = pure CFString
-nfToCFType fc (NPrimVal _ $ PrT StringType) True
+nfToCFType _ (VPrimVal _ $ PrT IntType) _ = pure CFInt
+nfToCFType _ (VPrimVal _ $ PrT IntegerType) _ = pure CFInteger
+nfToCFType _ (VPrimVal _ $ PrT Bits8Type) _ = pure CFUnsigned8
+nfToCFType _ (VPrimVal _ $ PrT Bits16Type) _ = pure CFUnsigned16
+nfToCFType _ (VPrimVal _ $ PrT Bits32Type) _ = pure CFUnsigned32
+nfToCFType _ (VPrimVal _ $ PrT Bits64Type) _ = pure CFUnsigned64
+nfToCFType _ (VPrimVal _ $ PrT Int8Type) _ = pure CFInt8
+nfToCFType _ (VPrimVal _ $ PrT Int16Type) _ = pure CFInt16
+nfToCFType _ (VPrimVal _ $ PrT Int32Type) _ = pure CFInt32
+nfToCFType _ (VPrimVal _ $ PrT Int64Type) _ = pure CFInt64
+nfToCFType _ (VPrimVal _ $ PrT StringType) False = pure CFString
+nfToCFType fc (VPrimVal _ $ PrT StringType) True
     = throw (GenericMsg fc "String not allowed in a foreign struct")
-nfToCFType _ (NPrimVal _ $ PrT DoubleType) _ = pure CFDouble
-nfToCFType _ (NPrimVal _ $ PrT CharType) _ = pure CFChar
-nfToCFType _ (NPrimVal _ $ PrT WorldType) _ = pure CFWorld
-nfToCFType _ (NBind fc _ (Pi _ _ _ ty) sc) False
+nfToCFType _ (VPrimVal _ $ PrT DoubleType) _ = pure CFDouble
+nfToCFType _ (VPrimVal _ $ PrT CharType) _ = pure CFChar
+nfToCFType _ (VPrimVal _ $ PrT WorldType) _ = pure CFWorld
+nfToCFType _ (VBind fc _ (Pi _ _ _ ty) sc) False
     = do defs <- get Ctxt
-         sty <- nfToCFType fc !(evalClosure defs ty) False
-         sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+         sty <- nfToCFType fc !(expand ty) False
+         sc' <- expand !(sc (pure (VErased fc Placeholder)))
          tty <- nfToCFType fc sc' False
          pure (CFFun sty tty)
-nfToCFType _ (NBind fc _ _ _) True
+nfToCFType _ (VBind fc _ _ _) True
     = throw (GenericMsg fc "Function types not allowed in a foreign struct")
-nfToCFType _ (NTCon fc n_in _ args) s
+nfToCFType _ (VTCon fc n_in _ args) s
     = do defs <- get Ctxt
          n <- toFullNames n_in
-         case !(getNArgs defs n $ map snd args) of
+         case !(getNArgs defs n $ cast !(traverseSnocList value args)) of
               User un uargs =>
-                do nargs <- traverse (evalClosure defs) uargs
+                do nargs <- traverse expand uargs
                    cargs <- traverse (\ arg => nfToCFType fc arg s) nargs
                    pure (CFUser n cargs)
               Struct n fs =>
                 do fs' <- traverse
                              (\ (n, ty) =>
-                                    do tynf <- evalClosure defs ty
+                                    do tynf <- expand ty
                                        tycf <- nfToCFType fc tynf False
                                        pure (n, tycf)) fs
                    pure (CFStruct n fs')
@@ -477,16 +484,16 @@ nfToCFType _ (NTCon fc n_in _ args) s
               NBuffer => pure CFBuffer
               NForeignObj => pure CFForeignObj
               NIORes uarg =>
-                do narg <- evalClosure defs uarg
+                do narg <- expand uarg
                    carg <- nfToCFType fc narg s
                    pure (CFIORes carg)
-nfToCFType _ (NType {}) s
+nfToCFType _ (VType {}) s
     = pure (CFUser (UN (Basic "Type")) [])
-nfToCFType _ (NErased {}) s
+nfToCFType _ (VErased {}) s
     = pure (CFUser (UN (Basic "__")) [])
 nfToCFType fc t s
     = do defs <- get Ctxt
-         ty <- quote defs Env.empty t
+         ty <- quote Env.empty t
          throw (GenericMsg (getLoc t)
                        ("Can't marshal type for foreign call " ++
                                       show !(toFullNames ty)))
@@ -494,29 +501,29 @@ nfToCFType fc t s
 getCFTypes : {auto c : Ref Ctxt Defs} ->
              List CFType -> ClosedNF ->
              Core (List CFType, CFType)
-getCFTypes args (NBind fc _ (Pi _ _ _ ty) sc)
+getCFTypes args (VBind fc _ (Pi _ _ _ ty) sc)
     = do defs <- get Ctxt
-         aty <- nfToCFType fc !(evalClosure defs ty) False
-         sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+         aty <- nfToCFType fc !(expand ty) False
+         sc' <- expand !(sc (pure (VErased fc Placeholder)))
          getCFTypes (aty :: args) sc'
 getCFTypes args t
     = pure (reverse args, !(nfToCFType (getLoc t) t False))
 
 lamRHSenv : Int -> FC -> (ns : Scope) -> (SizeOf ns, SubstCEnv ns Scope.empty)
-lamRHSenv i fc [] = (zero, Subst.empty)
-lamRHSenv i fc (n :: ns)
+lamRHSenv i fc [<] = (zero, Subst.empty {tm = CExp})
+lamRHSenv i fc (ns :< n)
     = let (s, env) = lamRHSenv (i + 1) fc ns in
-      (suc s, CRef fc (MN "x" i) :: env)
+      (suc s, env :< CRef fc (MN "x" i))
 
 mkBounds : (xs : _) -> Bounds xs
-mkBounds [] = None
-mkBounds (x :: xs) = Add x x (mkBounds xs)
+mkBounds [<] = None
+mkBounds (xs :< x) = Add x x (mkBounds xs)
 
 getNewArgs : {done : _} ->
              SubstCEnv done args -> Scope
-getNewArgs [] = []
-getNewArgs (CRef _ n :: xs) = n :: getNewArgs xs
-getNewArgs {done = x :: xs} (_ :: sub) = x :: getNewArgs sub
+getNewArgs [<] = [<]
+getNewArgs (xs :< CRef _ n) = getNewArgs xs :< n
+getNewArgs {done = xs :< x} (sub :< _) = getNewArgs sub :< x
 
 -- If a name is declared in one module and defined in another,
 -- we have to assume arity 0 for incremental compilation because
@@ -525,48 +532,68 @@ getNewArgs {done = x :: xs} (_ :: sub) = x :: getNewArgs sub
 lamRHS : (ns : Scope) -> CExp ns -> ClosedCExp
 lamRHS ns tm
     = let (s, env) = lamRHSenv 0 (getFC tm) ns
-          tmExp = substs s env (rewrite appendNilRightNeutral ns in tm)
-          newArgs = reverse $ getNewArgs env
+          tmExp = substs s env (rewrite appendLinLeftNeutral ns in tm)
+          newArgs = getNewArgs env
           bounds = mkBounds newArgs
-          expLocs = mkLocals zero {vars = Scope.empty} bounds tmExp in
+          expLocs = mkLocals bounds zero {inner = Scope.empty} tmExp in
           lamBind (getFC tm) _ expLocs
   where
     lamBind : FC -> (ns : Scope) -> CExp ns -> ClosedCExp
-    lamBind fc [] tm = tm
-    lamBind fc (n :: ns) tm = lamBind fc ns (CLam fc n tm)
+    lamBind fc [<] tm = tm
+    lamBind fc (ns :< n) tm = lamBind fc ns (CLam fc n tm)
 
 toArgExp : (Var ns) -> CExp ns
 toArgExp (MkVar p) = CLocal emptyFC p
 
-toCDef : Ref Ctxt Defs => Ref NextMN Int =>
+-- Move any lambdas in the body of the definition into the lhs list of vars.
+-- Annoyingly, the indices will need fixing up because the order in the top
+-- level definition goes left to right (i.e. first argument has lowest index,
+-- not the highest, as you'd expect if they were all lambdas).
+export
+mergeLambdas : (args : SnocList Name) -> CExp args -> (args' ** CExp args')
+mergeLambdas args (CLam fc x sc)
+    = mergeLambdas (args :< x) sc
+mergeLambdas args exp = (args ** exp)
+
+toCDef : {auto c : Ref Ctxt Defs} ->
          Name -> ClosedTerm -> NatSet -> Def ->
          Core CDef
 toCDef n ty _ None
     = pure $ MkError $ CCrash emptyFC ("Encountered undefined name " ++ show !(getFullName n))
-toCDef n ty erased (PMDef pi args _ tree _)
-    = do let (args' ** p) = fromNatSet erased args
-         comptree <- toCExpTree n tree
-         pure $ toLam (externalDecl pi) $ if isEmpty erased
-            then MkFun args comptree
-            else MkFun args' (shrinkCExp p comptree)
+toCDef n ty erased (Function fi _ tree _)
+    = do log "compiler.newtype.world" 25 "toCDef Function ty: \{show ty}, n: \{show n}, erased: \{show erased}, tree: \{show tree}"
+         s <- newRef NextMN 0
+         t <- toCExp n tree
+         let (args ** comptree) = mergeLambdas [<] t
+         let (args' ** p) = fromNatSet erased args
+         log "compiler.newtype.world" 25 "toCDef Function comptree \{show comptree}, p: \{show p}, is_ext: \{show $ (externalDecl fi)}"
+         let lam = toLam (externalDecl fi) $
+            if NatSet.isEmpty erased
+                then MkFun args comptree
+                else MkFun (cast args') (shrinkCExp p comptree)
+         log "compiler.newtype.world" 25 "toCDef Function is_erased: \{show $ NatSet.isEmpty erased}, lam \{show lam}, args': \{show $ Prelude.toList args'}"
+         pure lam
   where
     toLam : Bool -> CDef -> CDef
     toLam True (MkFun args rhs) = MkFun Scope.empty (lamRHS args rhs)
     toLam _ d = d
 toCDef n ty _ (ExternDef arity)
     = let (ns ** args) = mkArgList 0 arity in
-          pure $ MkFun _ (CExtPrim emptyFC !(getFullName n) (map toArgExp (toList $ getVars args)))
+          -- Reverse the args since we build them in the wrong order (most
+          -- recently bound lambda is last argument to primitive)
+          pure $ MkFun _ (CExtPrim emptyFC !(getFullName n)
+                             (reverse (map toArgExp (getVars args))))
+    where
+        getVars : ArgList k ns -> List (Var ns)
+        getVars Z = []
+        getVars (S rest) = first :: map later (getVars rest)
 
 toCDef n ty _ (ForeignDef arity cs)
     = do defs <- get Ctxt
-         (atys, retty) <- getCFTypes [] !(nf defs Env.empty ty)
+         (atys, retty) <- getCFTypes [] !(expand !(nf Env.empty ty))
          pure $ MkForeign cs atys retty
-toCDef n ty _ (Builtin {arity} op)
-    = let (ns ** args) = mkArgList 0 arity in
-          pure $ MkFun _ (COp emptyFC op (map toArgExp (getVars args)))
-
-toCDef n _ _ (DCon tag arity pos)
-    = do let nt = snd <$> pos
+toCDef n _ _ (DCon pos tag arity)
+    = do let nt = snd <$> (newTypeArg pos)
          defs <- get Ctxt
          args <- numArgs {vars = Scope.empty} defs (Ref EmptyFC (DataCon tag arity) n)
          let arity' = case args of
@@ -615,8 +642,9 @@ compileDef n
            -- traversing everything from the main expression.
            -- For now, consider it an incentive not to have cycles :).
             then recordWarning (GenericWarn emptyFC ("Compiling hole " ++ show n))
-            else do s <- newRef NextMN 0
-                    ce <- toCDef n (type gdef) (eraseArgs gdef)
+            else do log "compiler.newtype.world" 25 "compileDef name \{show n}, type gdef: \{show $ type gdef}"
+                    s <- newRef NextMN 0
+                    ce <- logDepth $ toCDef n (type gdef) (eraseArgs gdef)
                            !(toFullNames (definition gdef))
                     ce <- constructorCDef ce
                     setCompiled n ce
diff --git a/src/Compiler/ES/Ast.idr b/src/Compiler/ES/Ast.idr
index 6a69346dd90..1bb2a72de6b 100644
--- a/src/Compiler/ES/Ast.idr
+++ b/src/Compiler/ES/Ast.idr
@@ -7,6 +7,8 @@ import Data.Vect
 
 %default total
 
+%hide Core.TT.Term.Tag
+
 public export
 data Tag : Type where
   ||| A data constructor. Use the tag to dispatch / construct.
diff --git a/src/Compiler/ES/Codegen.idr b/src/Compiler/ES/Codegen.idr
index e86df834748..826758683fe 100644
--- a/src/Compiler/ES/Codegen.idr
+++ b/src/Compiler/ES/Codegen.idr
@@ -1,11 +1,10 @@
 module Compiler.ES.Codegen
 
-import Compiler.Common
 import Core.CompileExpr
 import Core.Directory
 import Core.Env
-import Data.String
-import Data.SortedMap
+
+import Compiler.Common
 import Compiler.ES.Ast
 import Compiler.ES.Doc
 import Compiler.ES.ToAst
@@ -13,14 +12,19 @@ import Compiler.ES.TailRec
 import Compiler.ES.State
 import Compiler.NoMangle
 import Protocol.Hex
-import Libraries.Data.String.Extra
 
 import Idris.Pretty.Annotations
 import Idris.Syntax
 import Idris.Doc.String
 
+import Data.String
+import Data.SortedMap
 import Data.Vect
 
+import Libraries.Data.String.Extra
+
+%hide Core.TT.Term.Tag
+
 --------------------------------------------------------------------------------
 --          Utilities
 --------------------------------------------------------------------------------
@@ -834,6 +838,6 @@ compileToES c s cg tm ccTypes = do
 
   -- complete preamble, including content from additional
   -- support files (if any)
-  let pre = showSep "\n" $ static_preamble :: (values $ preamble st)
+  let pre = joinBy "\n" $ static_preamble :: (values $ preamble st)
 
   pure $ fastUnlines [pre,allDecls,main]
diff --git a/src/Compiler/ES/TailRec.idr b/src/Compiler/ES/TailRec.idr
index 8361a466862..c304ba5b4ba 100644
--- a/src/Compiler/ES/TailRec.idr
+++ b/src/Compiler/ES/TailRec.idr
@@ -117,6 +117,7 @@
 module Compiler.ES.TailRec
 
 import Data.List1
+import Data.SnocList
 import Data.SortedSet
 import Data.SortedMap as M
 import Libraries.Data.Graph
diff --git a/src/Compiler/ES/ToAst.idr b/src/Compiler/ES/ToAst.idr
index f4937ae7f46..cb6e8b9a8d9 100644
--- a/src/Compiler/ES/ToAst.idr
+++ b/src/Compiler/ES/ToAst.idr
@@ -3,11 +3,14 @@
 module Compiler.ES.ToAst
 
 import Data.Vect
+import Data.SnocList
 import Core.CompileExpr
 import Core.Context
 import Compiler.ES.Ast
 import Compiler.ES.State
 
+%hide Core.TT.Term.Tag
+
 --------------------------------------------------------------------------------
 --          Converting NamedCExp
 --------------------------------------------------------------------------------
diff --git a/src/Compiler/Inline.idr b/src/Compiler/Inline.idr
index fe8530ebb25..560105e6697 100644
--- a/src/Compiler/Inline.idr
+++ b/src/Compiler/Inline.idr
@@ -10,24 +10,42 @@ import Core.Context.Log
 import Core.Hash
 import Core.Options
 
-import Data.List.Quantifiers
+import Data.SnocList
+import Data.SnocList.Quantifiers
 import Data.Vect
 
-import Libraries.Data.List.LengthMatch
 import Libraries.Data.NameMap
 import Libraries.Data.WithDefault
 import Libraries.Data.List.SizeOf
+import Libraries.Data.List.LengthMatch
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 %default covering
 
-EEnv : Scope -> Scope -> Type
-EEnv free = All (\_ => CExp free)
-
-extend : EEnv free vars -> (args : List (CExp free)) -> (args' : List Name) ->
-         LengthMatch args args' -> EEnv free (Scope.addInner vars args')
+public export
+EEnv : Scope -> Scoped
+EEnv free ds = Subst CExp ds free
+
+namespace EEnv
+  public export
+  empty : EEnv free Scope.empty
+  empty = [<]
+
+public export
+covering
+[ShowEEnv] {free, vars : _} -> Show (EEnv free vars) where
+    show x = "EEnv [" ++ showAll x ++ "]{vars = " ++ show (asList vars) ++ ", free = " ++ show (toList free) ++ "}"
+        where
+            showAll : {free, vars : _} -> EEnv free vars -> String
+            showAll Lin = ""
+            showAll (Lin :< x) = show x
+            showAll (xx :< x) = show x ++ ", " ++ showAll xx
+
+extend : EEnv free vars -> (args : List Name) -> (args' : List (CExp free)) ->
+         LengthMatch args args' -> EEnv free (Scope.ext vars args)
 extend env [] [] NilMatch = env
-extend env (a :: xs) (n :: ns) (ConsMatch w)
-    = a :: extend env xs ns w
+extend env (_ :: ns) (v :: vs) (ConsMatch w) = extend (env :< v) ns vs w
 
 Stack : Scoped
 Stack vars = List (CExp vars)
@@ -45,13 +63,28 @@ getArity (MkCon _ arity _) = arity
 getArity (MkForeign _ args _) = length args
 getArity (MkError _) = 0
 
+getArgsFromStack : Stack free -> (args : Scope) ->
+                   List (CExp free) ->
+                   Maybe (List (CExp free), Stack free)
+getArgsFromStack (e :: es) (as :< a) acc
+    = getArgsFromStack es as (e :: acc)
+getArgsFromStack stk [<] acc = Just (acc, stk)
+getArgsFromStack _ _ _ = Nothing
+
+takeArgs : EEnv free vars -> List (CExp free) -> (args : Scope) ->
+           Maybe (EEnv free (Scope.addInner vars args))
+takeArgs env (e :: es) (as :< a)
+  = do env' <- takeArgs env es as
+       pure (env' :< e)
+takeArgs env stk [<] = pure env
+takeArgs env [] args = Nothing
+
 takeFromStack : EEnv free vars -> Stack free -> (args : Scope) ->
                 Maybe (EEnv free (Scope.addInner vars args), Stack free)
-takeFromStack env (e :: es) (a :: as)
-  = do (env', stk') <- takeFromStack env es as
-       pure (e :: env', stk')
-takeFromStack env stk [] = pure (env, stk)
-takeFromStack env [] args = Nothing
+takeFromStack env es as
+    = do (args, stk') <- getArgsFromStack es as []
+         env' <- takeArgs env args as
+         pure (env', stk')
 
 data LVar : Type where
 
@@ -62,9 +95,12 @@ genName n
          put LVar (i + 1)
          pure (MN n i)
 
-refToLocal : Name -> (x : Name) -> CExp vars -> CExp (x :: vars)
+refToLocal : Name -> (x : Name) -> CExp vars -> CExp (vars :< x)
 refToLocal x new tm = refsToLocals (Add new x None) tm
 
+refToLocalScope : Name -> (x : Name) -> CCaseScope vars -> CCaseScope (vars :< x)
+refToLocalScope x new tm = refsToLocalsScope (Add new x None) tm
+
 largest : Ord a => a -> List a -> a
 largest x [] = x
 largest x (y :: ys)
@@ -98,11 +134,15 @@ mutual
           largest (maybe 0 (used n) def) (map (usedConst n) alts)
   used _ tm = 0
 
+  usedCaseScope : {free : _} ->
+            {idx : Nat} -> (0 p : IsVar n idx free) -> CCaseScope free -> Int
+  usedCaseScope n (CRHS rhs) = used n rhs
+  usedCaseScope n (CArg x sc) = usedCaseScope (Later n) sc
+
   usedCon : {free : _} ->
             {idx : Nat} -> (0 p : IsVar n idx free) -> CConAlt free -> Int
-  usedCon n (MkConAlt _ _ _ args sc)
-      = let MkVar n' = weakenNs (mkSizeOf args) (MkVar n) in
-            used n' sc
+  usedCon n (MkConAlt _ _ _ sc)
+      = usedCaseScope n sc
 
   usedConst : {free : _} ->
               {idx : Nat} -> (0 p : IsVar n idx free) -> CConstAlt free -> Int
@@ -114,16 +154,19 @@ mutual
               {auto l : Ref LVar Int} ->
               FC -> List Name -> Stack free ->
               EEnv free vars ->
-              {idx : Nat} -> (0 p : IsVar x idx (vars ++ free)) ->
+              {idx : Nat} -> (0 p : IsVar x idx (Scope.addInner free vars)) ->
               Core (CExp free)
-  evalLocal {vars = []} fc rec stk env p
-      = pure $ unload stk (CLocal fc p)
-  evalLocal {vars = x :: xs} fc rec stk (v :: env) First
-      = case stk of
+  evalLocal {vars = [<]} fc rec stk env p
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to evalLocal-1, stk: \{show stk}, p: \{show $ nameAt p}, env: \{show env}"
+           pure $ unload stk (CLocal fc p)
+  evalLocal {vars = xs :< x} fc rec stk (env :< v) First
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to evalLocal-2, stk: \{show stk}, p: First, v: \{show v}, env: \{show @{ShowEEnv} env}"
+           case stk of
              [] => pure v
              _ => eval rec env stk (weakenNs (mkSizeOf xs) v)
-  evalLocal {vars = x :: xs} fc rec stk (_ :: env) (Later p)
-      = evalLocal fc rec stk env p
+  evalLocal {vars = xs :< x} fc rec stk (env :< _) (Later p)
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to evalLocal-3, stk: \{show stk}, p: Later \{show $ nameAt p}, env: \{show @{ShowEEnv} env}"
+           logDepth $ evalLocal fc rec stk env p
 
   tryApply : {vars, free : _} ->
              {auto c : Ref Ctxt Defs} ->
@@ -131,11 +174,14 @@ mutual
              List Name -> Stack free -> EEnv free vars -> CDef ->
              Core (Maybe (CExp free))
   tryApply {free} {vars} rec stk env (MkFun args exp)
-      = do let Just (env', stk') = takeFromStack env stk args
+      = do log "compiler.inline.io_bind" 50 $ "tryApply args: \{show $ toList args}, exp: \{show exp}, stk: \{show stk}, env: \{show @{ShowEEnv} env}"
+           let Just (env', stk')
+               : Maybe (EEnv free (vars ++ args), List (CExp free))
+               = (takeFromStack env stk args)
                | Nothing => pure Nothing
-           res <- eval rec env' stk'
-                     (rewrite sym (appendAssociative args vars free) in
-                              embed {outer = vars ++ free} exp)
+           let exp' : CExp (free ++ (vars ++ args)) = (embed $ embed exp)
+           log "compiler.inline.io_bind" 50 $ "tryApply stk': \{show stk'}, env': \{show @{ShowEEnv} env'}, rec: \{show rec}, exp': \{show exp'}"
+           res <- eval rec env' stk' exp'
            pure (Just res)
   tryApply rec stk env _ = pure Nothing
 
@@ -143,22 +189,25 @@ mutual
          {auto c : Ref Ctxt Defs} ->
          {auto l : Ref LVar Int} ->
          List Name -> -- TODO should be a set
-         EEnv free vars -> Stack free -> CExp (vars ++ free) ->
+         EEnv free vars -> Stack free -> CExp (Scope.addInner free vars) ->
          Core (CExp free)
-  eval rec env stk (CLocal fc p) = evalLocal fc rec stk env p
+  eval rec env stk (CLocal fc p) =
+    do log "compiler.inline.io_bind" 50 $ "Attempting to CLocal, env: \{show @{ShowEEnv} env}, stk: \{show stk}, p: \{show $ nameAt p}"
+       evalLocal fc rec stk env p
   -- This is hopefully a temporary hack, giving a special case for io_bind.
   -- Currently the elaborator is a bit cautious about inlining case blocks
   -- in case they duplicate work. We should fix that, to decide more accurately
   -- whether they're safe to inline, but until then this gives such a huge
   -- boost by removing unnecessary lambdas that we'll keep the special case.
   eval rec env stk (CRef fc n) = do
+        log "compiler.inline.io_bind" 50 $ "Attempting to CRef, rec: \{show rec}, env: \{show @{ShowEEnv} env}, stk: \{show stk}, n: \{show n}"
         when (n == NS primIONS (UN $ Basic "io_bind")) $
           log "compiler.inline.io_bind" 50 $
             "Attempting to inline io_bind, its stack is: \{show stk}"
         case (n == NS primIONS (UN $ Basic "io_bind"), stk) of
           (True, act :: cont :: world :: stk) =>
                  do xn <- genName "act"
-                    sc <- eval rec [] [] (CApp fc cont [CRef fc xn, world])
+                    sc <- eval rec EEnv.empty [] (CApp fc cont [CRef fc xn, world])
                     pure $ unload stk $
                              CLet fc xn NotInline
                                (CApp fc act [world])
@@ -167,7 +216,7 @@ mutual
                  do wn <- genName "world"
                     xn <- genName "act"
                     let world : forall vars. CExp vars := CRef fc wn
-                    sc <- eval rec [] [] (CApp fc cont [CRef fc xn, world])
+                    sc <- eval rec EEnv.empty [] (CApp fc cont [CRef fc xn, world])
                     pure $ CLam fc wn
                          $ refToLocal wn wn
                          $ CLet fc xn NotInline (CApp fc act [world])
@@ -182,19 +231,24 @@ mutual
                 let arity = getArity def
                 let gdefFlags = flags gdef
                 if (Inline `elem` gdefFlags)
-                    && (not (n `elem` rec))
+                    && (not (n `elem` rec)) -- requires putting function name at `eval rec env stk (CApp fc f@(CRef nfc n) args)` to make it work
+                                            -- for mutually recursive invocations
                     && (not (NoInline `elem` gdefFlags))
-                   then do ap <- tryApply (n :: rec) stk env def
+                   then do log "compiler.inline.io_bind" 50 $ "Attempting to CRef Inline Apply, def: \{show def}, n: \{show n}, rec: \{show rec}"
+                           ap <- tryApply (n :: rec) stk env def
+                           log "compiler.inline.io_bind" 50 $ "Attempting to CRef Inline Apply, ap: \{show ap}"
                            pure $ fromMaybe (unloadApp arity stk (CRef fc n)) ap
                    else pure $ unloadApp arity stk (CRef fc n)
   eval {vars} {free} rec env [] (CLam fc x sc)
-      = do xn <- genName "lamv"
-           sc' <- eval rec (CRef fc xn :: env) [] sc
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to CLam, rec: \{show rec}, env: \{show @{ShowEEnv} env}, x: \{show x}, sc: \{show sc}"
+           xn <- genName "lamv"
+           sc' <- logDepth $ eval rec (env :< CRef fc xn) [] sc
+           log "compiler.inline.io_bind" 50 $ "Attempting to CLam, sc': \{show sc'}"
            pure $ CLam fc x (refToLocal xn x sc')
-  eval rec env (e :: stk) (CLam fc x sc) = eval rec (e :: env) stk sc
+  eval rec env (e :: stk) (CLam fc x sc) = eval rec (env :< e) stk sc
   eval {vars} {free} rec env stk (CLet fc x NotInline val sc)
       = do xn <- genName "letv"
-           sc' <- eval rec (CRef fc xn :: env) [] sc
+           sc' <- eval rec (env :< CRef fc xn) [] sc
            val' <- eval rec env [] val
            pure (unload stk $ CLet fc x NotInline val' (refToLocal xn x sc'))
   eval {vars} {free} rec env stk (CLet fc x YesInline val sc)
@@ -203,9 +257,9 @@ mutual
                     -- are guaranteed not to duplicate work. (We don't know
                     -- that yet).
               then do val' <- eval rec env [] val
-                      eval rec (val' :: env) stk sc
+                      eval rec (env :< val') stk sc
               else do xn <- genName "letv"
-                      sc' <- eval rec (CRef fc xn :: env) stk sc
+                      sc' <- eval rec (env :< CRef fc xn) stk sc
                       val' <- eval rec env [] val
                       pure (CLet fc x YesInline val' (refToLocal xn x sc'))
   eval rec env stk (CApp fc f@(CRef nfc n) args)
@@ -213,103 +267,133 @@ mutual
            -- a name from another module where the job is already done
            defs <- get Ctxt
            Just gdef <- lookupCtxtExact n (gamma defs)
-                | Nothing => do args' <- traverse (eval rec env []) args
+                | Nothing => do log "compiler.inline.io_bind" 50 $ "Attempting to CApp CRef Nothing, rec: \{show rec}, env: \{show @{ShowEEnv} env}, args: \{show args}"
+                                -- Passing function name as `n` to determine recursive inlining
+                                args' <- logDepth $ traverse (eval (n :: rec) env []) args
+                                log "compiler.inline.io_bind" 50 $ "Attempting to CApp CRef Nothing, stk: \{show stk}, n: \{show n}, args': \{show args'}"
                                 pure (unload stk
                                           (CApp fc (CRef nfc n) args'))
-           eval rec env (!(traverse (eval rec env []) args) ++ stk) f
+           log "compiler.inline.io_bind" 50 $ "Attempting to CApp CRef, rec: \{show rec}, env: \{show @{ShowEEnv} env}, args: \{show args}"
+           -- Passing function name as `n` to determine recursive inlining
+           args' <- logDepth $ traverse (eval (n :: rec) env []) args
+           log "compiler.inline.io_bind" 50 $ "Attempting to CApp CRef, env: \{show @{ShowEEnv} env}, args': \{show args'}, stk: \{show stk}, f: \{show f}"
+           eval rec env (args' ++ stk) f
   eval rec env stk (CApp fc f args)
-      = eval rec env (!(traverse (eval rec env []) args) ++ stk) f
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to CApp, f: \{show f}, args: \{show args}"
+           stk' <- logDepth $ traverse (eval rec env []) args
+           log "compiler.inline.io_bind" 50 $ "Attempting to CApp, stk': \{show stk'}, stk: \{show stk}"
+           eval rec env (stk' ++ stk) f
   eval rec env stk (CCon fc n ci t args)
-      = pure $ unload stk $ CCon fc n ci t !(traverse (eval rec env []) args)
+      = pure $ unload stk $ CCon fc n ci t !(logDepth $ traverse (eval rec env []) args)
   eval rec env stk (COp fc p args)
-      = pure $ unload stk $ COp fc p !(traverseVect (eval rec env []) args)
+      = pure $ unload stk $ COp fc p !(logDepth $ traverseVect (eval rec env []) args)
   eval rec env stk (CExtPrim fc p args)
-      = pure $ unload stk $ CExtPrim fc p !(traverse (eval rec env []) args)
+      = pure $ unload stk $ CExtPrim fc p !(logDepth $ traverse (eval rec env []) args)
   eval rec env stk (CForce fc lr e)
       = case !(eval rec env [] e) of
-             CDelay _ _ e' => eval rec [] stk e'
+             CDelay _ _ e' => eval rec EEnv.empty stk e'
              res => pure $ unload stk (CForce fc lr res) -- change this to preserve laziness semantics
   eval rec env stk (CDelay fc lr e)
       = pure $ unload stk (CDelay fc lr !(eval rec env [] e))
   eval rec env stk (CConCase fc sc alts def)
-      = do sc' <- eval rec env [] sc
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to con case, env: \{show @{ShowEEnv} env}, sc: \{show sc}"
+           sc' <- logDepth $ eval rec env [] sc
            let env' = update sc env sc'
+           log "compiler.inline.io_bind" 50 $ "Attempting to con case, env': \{show @{ShowEEnv} env'}, stk: \{show stk}, sc': \{show sc'}, alts: \{show alts}, def: \{show def}"
            Nothing <- pickAlt rec env' stk sc' alts def | Just val => pure val
            def' <- traverseOpt (eval rec env' stk) def
-           pure $ caseOfCase $ CConCase fc sc'
-                     !(traverse (evalAlt fc rec env' stk) alts)
-                     def'
+           log "compiler.inline.io_bind" 50 $ "Attempting to con case, env': \{show @{ShowEEnv} env'}, stk: \{show stk}, alts: \{show alts}"
+           alts' <- logDepth $ traverse (evalAlt fc rec env' stk) alts
+           log "compiler.inline.io_bind" 50 $ "Attempting to con case, sc': \{show sc'}, alts': \{show alts'}, def': \{show def'}"
+           pure $ caseOfCase $ CConCase fc sc' alts' def'
     where
       updateLoc : {idx, vs : _} ->
-                  (0 p : IsVar x idx (vs ++ free)) ->
+                  (0 p : IsVar x idx (Scope.addInner free vs)) ->
                   EEnv free vs -> CExp free -> EEnv free vs
-      updateLoc {vs = []} p env val = env
-      updateLoc {vs = (x::xs)} First (e :: env) val = val :: env
-      updateLoc {vs = (y::xs)} (Later p) (e :: env) val = e :: updateLoc p env val
+      updateLoc {vs = [<]} p env val = env
+      updateLoc {vs = (xs :< x)} First (env :< e) val = env :< val
+      updateLoc {vs = (xs :< y)} (Later p) (env :< e) val = updateLoc p env val :< e
 
       update : {vs : _} ->
-               CExp (vs ++ free) -> EEnv free vs -> CExp free -> EEnv free vs
+               CExp (Scope.addInner free vs) -> EEnv free vs -> CExp free -> EEnv free vs
       update (CLocal _ p) env sc = updateLoc p env sc
       update _ env _ = env
 
   eval rec env stk (CConstCase fc sc alts def)
-      = do sc' <- eval rec env [] sc
+      = do sc' <- logDepth $ eval rec env [] sc
            Nothing <- pickConstAlt rec env stk sc' alts def | Just val => pure val
            def' <- traverseOpt (eval rec env stk) def
            pure $ caseOfCase $ CConstCase fc sc'
-                         !(traverse (evalConstAlt rec env stk) alts)
+                         !(logDepth $ traverse (evalConstAlt rec env stk) alts)
                          def'
   eval rec env stk (CPrimVal fc c) = pure $ unload stk $ CPrimVal fc c
   eval rec env stk (CErased fc) = pure $ unload stk $ CErased fc
   eval rec env stk (CCrash fc str) = pure $ unload stk $ CCrash fc str
 
-  extendLoc : {auto l : Ref LVar Int} ->
-              FC -> EEnv free vars -> (args' : List Name) ->
-              Core (Bounds args', EEnv free (args' ++ vars))
-  extendLoc fc env [] = pure (None, env)
-  extendLoc fc env (n :: ns)
+  evalScope : {vars, free : _} ->
+            {auto c : Ref Ctxt Defs} ->
+            {auto l : Ref LVar Int} ->
+            FC -> List Name -> EEnv free vars -> Stack free ->
+            CCaseScope (free ++ vars) ->
+            Core (CCaseScope free)
+  evalScope fc rec env stk (CRHS tm) = pure $ CRHS !(eval rec env stk tm)
+  evalScope fc rec env stk (CArg x sc)
+      = do xn <- genName "cv"
+           let env' = env :< CRef fc xn
+           sc' <- evalScope fc rec env' stk sc
+           pure (CArg x (refToLocalScope xn x sc'))
+
+  extendLoc : {vars, free : _} ->
+              {auto l : Ref LVar Int} ->
+              FC -> EEnv free vars -> (args' : Scope) ->
+              Core (Bounds args', EEnv free (Scope.addInner vars args'))
+  extendLoc fc env [<] = pure (None, env)
+  extendLoc fc env (ns :< n)
       = do xn <- genName "cv"
            (bs', env') <- extendLoc fc env ns
-           pure (Add n xn bs', CRef fc xn :: env')
+           pure (Add n xn bs', env' :< CRef fc xn)
 
   evalAlt : {vars, free : _} ->
             {auto c : Ref Ctxt Defs} ->
             {auto l : Ref LVar Int} ->
-            FC -> List Name -> EEnv free vars -> Stack free -> CConAlt (vars ++ free) ->
+            FC -> List Name -> EEnv free vars -> Stack free -> CConAlt (Scope.addInner free vars) ->
             Core (CConAlt free)
-  evalAlt {free} {vars} fc rec env stk (MkConAlt n ci t args sc)
-      = do (bs, env') <- extendLoc fc env args
-           scEval <- eval rec env' stk
-                          (rewrite sym (appendAssociative args vars free) in sc)
-           pure $ MkConAlt n ci t args (refsToLocals bs scEval)
+  evalAlt {free} {vars} fc rec env stk (MkConAlt n ci t sc)
+      = do log "compiler.inline.io_bind" 50 $ "Attempting to evalAlt, env: \{show @{ShowEEnv} env}, sc: \{show sc}"
+           pure $ MkConAlt n ci t !(evalScope fc rec env stk sc)
 
   evalConstAlt : {vars, free : _} ->
                  {auto c : Ref Ctxt Defs} ->
                  {auto l : Ref LVar Int} ->
-                 List Name -> EEnv free vars -> Stack free -> CConstAlt (vars ++ free) ->
+                 List Name -> EEnv free vars -> Stack free -> CConstAlt (Scope.addInner free vars) ->
                  Core (CConstAlt free)
   evalConstAlt rec env stk (MkConstAlt c sc)
       = MkConstAlt c <$> eval rec env stk sc
 
+  evalPickedAlt : {vars, free : _} ->
+            {auto c : Ref Ctxt Defs} ->
+            {auto l : Ref LVar Int} ->
+            List Name -> EEnv free vars -> Stack free ->
+            (args : List (CExp free)) ->
+            CCaseScope (free ++ vars) ->
+            Core (Maybe (CExp free))
+  evalPickedAlt rec env stk [] (CRHS tm) = pure $ Just !(eval rec env stk tm)
+  evalPickedAlt rec env stk (a :: args) (CArg x sc)
+      = evalPickedAlt rec (env :< a) stk args sc
+  evalPickedAlt rec env stk _ _ = pure Nothing
+
   pickAlt : {vars, free : _} ->
             {auto c : Ref Ctxt Defs} ->
             {auto l : Ref LVar Int} ->
             List Name -> EEnv free vars -> Stack free ->
-            CExp free -> List (CConAlt (vars ++ free)) ->
-            Maybe (CExp (vars ++ free)) ->
+            CExp free -> List (CConAlt (Scope.addInner free vars)) ->
+            Maybe (CExp (Scope.addInner free vars)) ->
             Core (Maybe (CExp free))
   pickAlt rec env stk (CCon fc n ci t args) [] def
       = traverseOpt (eval rec env stk) def
-  pickAlt {vars} {free} rec env stk con@(CCon fc n ci t args) (MkConAlt n' _ t' args' sc :: alts) def
+  pickAlt {vars} {free} rec env stk con@(CCon fc n ci t args) (MkConAlt n' _ t' sc :: alts) def
       = if matches n t n' t'
-           then case checkLengthMatch args args' of
-                     Nothing => pure Nothing
-                     Just m =>
-                         do let env' : EEnv free (args' ++ vars)
-                                   = extend env args args' m
-                            pure $ Just !(eval rec env' stk
-                                    (rewrite sym (appendAssociative args' vars free) in
-                                             sc))
+           then evalPickedAlt rec env stk args sc
            else pickAlt rec env stk con alts def
     where
       matches : Name -> Maybe Int -> Name -> Maybe Int -> Bool
@@ -322,15 +406,15 @@ mutual
                  {auto c : Ref Ctxt Defs} ->
                  {auto l : Ref LVar Int} ->
                  List Name -> EEnv free vars -> Stack free ->
-                 CExp free -> List (CConstAlt (vars ++ free)) ->
-                 Maybe (CExp (vars ++ free)) ->
+                 CExp free -> List (CConstAlt (Scope.addInner free vars)) ->
+                 Maybe (CExp (Scope.addInner free vars)) ->
                  Core (Maybe (CExp free))
   pickConstAlt rec env stk (CPrimVal fc c) [] def
       = traverseOpt (eval rec env stk) def
   pickConstAlt {vars} {free} rec env stk (CPrimVal fc c) (MkConstAlt c' sc :: alts) def
       = if c == c'
            then Just <$> eval rec env stk sc
-           else pickConstAlt rec env stk (CPrimVal fc c) alts def
+           else logDepth $ pickConstAlt rec env stk (CPrimVal fc c) alts def
   pickConstAlt rec env stk _ _ _ = pure Nothing
 
 -- Inlining may have messed with function arity (e.g. by adding lambdas to
@@ -381,9 +465,13 @@ fixArityTm (CConCase fc sc alts def) args
                            !(traverse fixArityAlt alts)
                            !(traverseOpt (\tm => fixArityTm tm []) def)) args
   where
+    fixArityScope : forall vars . CCaseScope vars -> Core (CCaseScope vars)
+    fixArityScope (CRHS tm) = pure $ CRHS !(fixArityTm tm [])
+    fixArityScope (CArg x sc) = pure $ CArg x !(fixArityScope sc)
+
     fixArityAlt : CConAlt vars -> Core (CConAlt vars)
-    fixArityAlt (MkConAlt n ci t a sc)
-        = pure $ MkConAlt n ci t a !(fixArityTm sc [])
+    fixArityAlt (MkConAlt n ci t sc)
+        = pure $ MkConAlt n ci t !(fixArityScope sc)
 fixArityTm (CConstCase fc sc alts def) args
     = pure $ expandToArity Z
               (CConstCase fc !(fixArityTm sc [])
@@ -409,36 +497,22 @@ fixArity d = pure d
 
 -- TODO: get rid of this `done` by making the return `args'` runtime irrelevant?
 getLams : {done : _} -> SizeOf done ->
-          Int -> SubstCEnv done args -> CExp (done ++ args) ->
-          (args' ** (SizeOf args', SubstCEnv args' args, CExp (args' ++ args)))
+          Int -> SubstCEnv done args -> CExp (Scope.addInner args done) ->
+          (args' ** (SizeOf args', SubstCEnv args' args, CExp (Scope.addInner args args')))
 getLams {done} d i env (CLam fc x sc)
-    = getLams {done = x :: done} (suc d) (i + 1) (CRef fc (MN "ext" i) :: env) sc
+    = getLams {done = done :< x} (suc d) (i + 1) (env :< CRef fc (MN "ext" i)) sc
 getLams {done} d i env sc = (done ** (d, env, sc))
 
 mkBounds : (xs : _) -> Bounds xs
-mkBounds [] = None
-mkBounds (x :: xs) = Add x x (mkBounds xs)
+mkBounds [<] = None
+mkBounds (xs :< x) = Add x x (mkBounds xs)
 
 -- TODO `getNewArgs` is always used in reverse, revisit!
 getNewArgs : {done : _} ->
              SubstCEnv done args -> Scope
-getNewArgs [] = []
-getNewArgs (CRef _ n :: xs) = n :: getNewArgs xs
-getNewArgs {done = x :: xs} (_ :: sub) = x :: getNewArgs sub
-
--- Move any lambdas in the body of the definition into the lhs list of vars.
--- Annoyingly, the indices will need fixing up because the order in the top
--- level definition goes left to right (i.e. first argument has lowest index,
--- not the highest, as you'd expect if they were all lambdas).
-mergeLambdas : (args : Scope) -> CExp args -> (args' ** CExp args')
-mergeLambdas args (CLam fc x sc)
-    = let (args' ** (s, env, exp')) = getLams zero 0 Subst.empty (CLam fc x sc)
-          expNs = substs s env exp'
-          newArgs = reverse $ getNewArgs env
-          expLocs = mkLocals (mkSizeOf args) {vars = []} (mkBounds newArgs)
-                             (rewrite appendNilRightNeutral args in expNs) in
-          (_ ** expLocs)
-mergeLambdas args exp = (args ** exp)
+getNewArgs [<] = [<]
+getNewArgs (xs :< CRef _ n) = getNewArgs xs :< n
+getNewArgs {done = xs :< x} (sub :< _) = getNewArgs sub :< x
 
 ||| Inline all inlinable functions into the given expression.
 ||| @ n the function name
@@ -448,8 +522,8 @@ doEval : {args : _} ->
          (n : Name) -> (exp : CExp args) -> Core (CExp args)
 doEval n exp
     = do l <- newRef LVar (the Int 0)
-         log "compiler.inline.eval" 10 (show n ++ ": " ++ show exp)
-         exp' <- eval [] [] [] exp
+         log "compiler.inline.eval" 10 ("Origin: " ++ show n ++ " args: " ++ show (toList args) ++ " exp: " ++ show exp)
+         exp' <- logDepth $ eval [] EEnv.empty [] exp
          log "compiler.inline.eval" 10 ("Inlined: " ++ show exp')
          pure exp'
 
@@ -463,7 +537,9 @@ inline n d = pure d
 mergeLam : {auto c : Ref Ctxt Defs} ->
            CDef -> Core CDef
 mergeLam (MkFun args def)
-    = do let (args' ** exp') = mergeLambdas args def
+    = do log "compiler.inline.io_bind" 50 "mergeLam, args: \{show $ toList args}, def: \{show def}"
+         let (args' ** exp') = mergeLambdas args def
+         log "compiler.inline.io_bind" 50 "mergeLam, args': \{show $ toList args'}, exp': \{show exp'}"
          pure $ MkFun args' exp'
 mergeLam d = pure d
 
@@ -490,10 +566,14 @@ mutual
   addRefsArgs ds [] = ds
   addRefsArgs ds (a :: as) = addRefsArgs (addRefs ds a) as
 
+  addRefsScope : NameMap Bool -> CCaseScope vars -> NameMap Bool
+  addRefsScope ds (CRHS tm) = addRefs ds tm
+  addRefsScope ds (CArg x sc) = addRefsScope ds sc
+
   addRefsConAlts : NameMap Bool -> List (CConAlt vars) -> NameMap Bool
   addRefsConAlts ds [] = ds
-  addRefsConAlts ds (MkConAlt n _ _ _ sc :: rest)
-      = addRefsConAlts (addRefs (insert n False ds) sc) rest
+  addRefsConAlts ds (MkConAlt _ _ _ sc :: rest)
+      = addRefsConAlts (addRefsScope ds sc) rest
 
   addRefsConstAlts : NameMap Bool -> List (CConstAlt vars) -> NameMap Bool
   addRefsConstAlts ds [] = ds
@@ -540,7 +620,7 @@ mergeLamDef n
     = do defs <- get Ctxt
          Just def <- lookupCtxtExact n (gamma defs)
               | Nothing => pure ()
-         let PMDef pi _ _ _ _ = definition def
+         let Function pi _ _ _ = definition def
               | _ => pure ()
          if not (isNil (incrementalCGs !getSession)) &&
                 externalDecl pi -- better keep it at arity 0
@@ -569,17 +649,17 @@ compileAndInlineAll
          let ns = keys (toIR defs)
          cns <- filterM nonErased ns
 
-         traverse_ compileDef cns
-         traverse_ rewriteIdentityFlag cns
+         traverse_ (logDepthWrap compileDef) cns
+         traverse_ (logDepthWrap rewriteIdentityFlag) cns
          transform 3 cns -- number of rounds to run transformations.
                          -- This seems to be the point where not much useful
                          -- happens any more.
-         traverse_ updateCallGraph cns
+         traverse_ (logDepthWrap updateCallGraph) cns
          -- in incremental mode, add the arity of the definitions to the hash,
          -- because if these change we need to recompile dependencies
          -- accordingly
          unless (isNil (incrementalCGs !getSession)) $
-           traverse_ addArityHash cns
+           traverse_ (logDepthWrap addArityHash) cns
   where
     transform : Nat -> List Name -> Core ()
     transform Z cns = pure ()
diff --git a/src/Compiler/Interpreter/VMCode.idr b/src/Compiler/Interpreter/VMCode.idr
index b5d816aab9f..c5ed2b1c85a 100644
--- a/src/Compiler/Interpreter/VMCode.idr
+++ b/src/Compiler/Interpreter/VMCode.idr
@@ -1,7 +1,7 @@
 module Compiler.Interpreter.VMCode
 
 import Core.Primitives
-import Core.Value
+import Core.Evaluate.Value
 
 import Compiler.Common
 import Compiler.VMCode
@@ -10,6 +10,7 @@ import Idris.Syntax
 
 import Data.IOArray
 import Data.Vect
+
 import Libraries.Data.NameMap
 
 public export
@@ -26,14 +27,14 @@ showType (Const {}) = "Constant"
 showType Null = "Null"
 
 mutual
-    showSep : Nat -> List Object -> String
-    showSep k [] = ""
-    showSep k [o] = showDepth k o
-    showSep k (o :: os) = showDepth k o ++ ", " ++ showSep k os
+    joinBy : Nat -> List Object -> String
+    joinBy k [] = ""
+    joinBy k [o] = showDepth k o
+    joinBy k (o :: os) = showDepth k o ++ ", " ++ joinBy k os
 
     showDepth : Nat -> Object -> String
-    showDepth (S k) (Closure mis args fn) = show fn ++ "-" ++ show mis ++ "(" ++ showSep k (args <>> []) ++ ")"
-    showDepth (S k) (Constructor (Left t) args) = "tag" ++ show t ++ "(" ++ showSep k args ++ ")"
+    showDepth (S k) (Closure mis args fn) = show fn ++ "-" ++ show mis ++ "(" ++ joinBy k (args <>> []) ++ ")"
+    showDepth (S k) (Constructor (Left t) args) = "tag" ++ show t ++ "(" ++ joinBy k args ++ ")"
     showDepth (S k) (Const c) = show c
     showDepth _ obj = showType obj
 
@@ -108,8 +109,8 @@ indexMaybe (x :: xs) idx = if idx <= 0 then Just x else indexMaybe xs (idx - 1)
 callPrim : Ref State InterpState => Stack -> PrimFn ar -> Vect ar Object -> Core Object
 callPrim stk BelieveMe [_, _, obj] = pure obj
 callPrim stk fn args = case the (Either Object (Vect ar Constant)) $ traverse getConst args of
-    Right args' => case getOp {vars=Scope.empty} fn (NPrimVal EmptyFC <$> args') of
-        Just (NPrimVal _ res) => pure $ Const res
+    Right args' => case getOp {vars=Scope.empty} fn (VPrimVal EmptyFC <$> args') of
+        Just (VPrimVal _ res) => pure $ Const res
         _ => interpError stk $ "OP: Error calling " ++ show (opName fn) ++ " with operands: " ++ show args'
     Left obj => interpError stk $ "OP: Expected Constant, found " ++ showType obj
   where
diff --git a/src/Compiler/LambdaLift.idr b/src/Compiler/LambdaLift.idr
index d035f661a95..9f2060694b3 100644
--- a/src/Compiler/LambdaLift.idr
+++ b/src/Compiler/LambdaLift.idr
@@ -12,10 +12,15 @@ module Compiler.LambdaLift
 
 import Core.CompileExpr
 import Core.Context
+import Core.Context.Log
 
+import Data.String
 import Data.Vect
+import Data.SnocList.Operations
 
+import Libraries.Data.List.SizeOf
 import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 %default covering
 
@@ -91,7 +96,7 @@ mutual
        ||| @ expr is the expression to bind `x` to.
        ||| @ body is the expression to evaluate after binding.
        LLet : FC -> (x : Name) -> (expr : Lifted vars) ->
-              (body : Lifted (x :: vars)) -> Lifted vars
+              (body : Lifted (Scope.bind vars x)) -> Lifted vars
 
        ||| Use of a constructor to construct a compound data type value.
        |||
@@ -163,6 +168,11 @@ mutual
        |||   debugging.
        LCrash : FC -> (msg : String) -> Lifted vars
 
+  public export
+  data LiftedCaseScope : Scoped where
+       LRHS : Lifted vars -> LiftedCaseScope vars
+       LArg : (x : Name) -> LiftedCaseScope (vars :< x) -> LiftedCaseScope vars
+
   ||| A branch of an "LCon" (constructor tag) case statement.
   |||
   ||| @ vars is the list of names accessible within the current scope of the
@@ -180,13 +190,10 @@ mutual
        ||| @ tag is a tag value, present if the type of the value
        |||   inspected is an algebraic data type (this can be matched against
        |||   instead of the constructor's name, if preferable).
-       ||| @ args is a list of new names that are bound to the inspected value's
-       |||   members before evaluation of this branch's body (this is similar
-       |||   to using a let binding for each member of the value).
-       ||| @ body is the expression that is evaluated as the consequence of
-       |||   this branch matching.
+       ||| @ scope is the scope of the case alternative, consisting of its
+       |||   arguments and right hand side
        MkLConAlt : (n : Name) -> (info : ConInfo) -> (tag : Maybe Int) ->
-                   (args : List Name) -> (body : Lifted (args ++ vars)) ->
+                   (body : LiftedCaseScope vars) ->
                    LiftedConAlt vars
 
   ||| A branch of an "LConst" (constant expression) case statement.
@@ -223,8 +230,8 @@ data LiftedDef : Type where
      -- (Sorry for the awkward API - it's to do with how the indices are
      -- arranged for the variables, and it could be expensive to reshuffle them!
      -- See Compiler.ANF for an example of how they get resolved to names)
-     MkLFun : (args : Scope) -> (scope : Scope) ->
-              (body : Lifted (Scope.addInner args scope)) -> LiftedDef
+     MkLFun : (args : List Name) -> (scope : Scope) ->
+              (body : Lifted (Scope.addInner (cast args) scope)) -> LiftedDef
 
      ||| Constructs a definition of a constructor for a compound data type.
      |||
@@ -268,36 +275,42 @@ mutual
   {vs : _} -> Show (Lifted vs) where
     show (LLocal {idx} _ p) = "!" ++ show (nameAt p)
     show (LAppName fc lazy n args)
-        = show n ++ showLazy lazy ++ "(" ++ showSep ", " (map show args) ++ ")"
+        = show n ++ showLazy lazy ++ "(" ++ joinBy ", " (map show args) ++ ")"
     show (LUnderApp fc n m args)
         = "<" ++ show n ++ " underapp " ++ show m ++ ">(" ++
-          showSep ", " (map show args) ++ ")"
+          joinBy ", " (map show args) ++ ")"
     show (LApp fc lazy c arg)
         = show c ++ showLazy lazy ++ " @ (" ++ show arg ++ ")"
     show (LLet fc x val sc)
         = "%let " ++ show x ++ " = " ++ show val ++ " in " ++ show sc
     show (LCon fc n _ t args)
-        = "%con " ++ show n ++ "(" ++ showSep ", " (map show args) ++ ")"
+        = "%con " ++ show n ++ "(" ++ joinBy ", " (map show args) ++ ")"
     show (LOp fc lazy op args)
-        = "%op " ++ show op ++ showLazy lazy ++ "(" ++ showSep ", " (toList (map show args)) ++ ")"
+        = "%op " ++ show op ++ showLazy lazy ++ "(" ++ joinBy ", " (toList (map show args)) ++ ")"
     show (LExtPrim fc lazy p args)
-        = "%extprim " ++ show p ++ showLazy lazy ++ "(" ++ showSep ", " (map show args) ++ ")"
+        = "%extprim " ++ show p ++ showLazy lazy ++ "(" ++ joinBy ", " (map show args) ++ ")"
     show (LConCase fc sc alts def)
         = "%case " ++ show sc ++ " of { "
-             ++ showSep "| " (map show alts) ++ " " ++ show def
+             ++ joinBy "| " (map show alts) ++ " " ++ show def
     show (LConstCase fc sc alts def)
         = "%case " ++ show sc ++ " of { "
-             ++ showSep "| " (map show alts) ++ " " ++ show def
+             ++ joinBy "| " (map show alts) ++ " " ++ show def
     show (LPrimVal _ x) = show x
     show (LErased _) = "___"
     show (LCrash _ x) = "%CRASH(" ++ show x ++ ")"
 
+  export
+  covering
+  {vs : _} -> Show (LiftedCaseScope vs) where
+    show (LRHS rhs) = ") => " ++ show rhs
+    show (LArg x sc) = show x ++ " " ++ show sc
+
   export
   covering
   {vs : _} -> Show (LiftedConAlt vs) where
-    show (MkLConAlt n _ t args sc)
+    show (MkLConAlt n _ t sc)
         = "%conalt " ++ show n ++
-             "(" ++ showSep ", " (map show args) ++ ") => " ++ show sc
+             "(" ++ show sc ++ ")"
 
   export
   covering
@@ -363,19 +376,34 @@ lengthDistributesOverAppend [] ys = Refl
 lengthDistributesOverAppend (x :: xs) ys =
   cong S $ lengthDistributesOverAppend xs ys
 
-weakenUsed : {outer : _} -> Used vars -> Used (outer ++ vars)
+weakenUsed : {outer : _} -> Used vars -> Used (Scope.addInner vars outer)
 weakenUsed {outer} (MkUsed xs) =
-  MkUsed (rewrite lengthDistributesOverAppend outer vars in
-         (replicate (length outer) False ++ xs))
-
-contractUsed : (Used (x::vars)) -> Used vars
+  MkUsed (rewrite lengthHomomorphism vars outer in
+          rewrite plusCommutative (length vars) (length outer) in
+          replicate (length outer) False ++ xs)
+
+weakenUsedFish : {outer : _} -> Used vars -> Used (Scope.ext vars outer)
+weakenUsedFish {outer} (MkUsed xs) =
+    do rewrite fishAsSnocAppend vars outer
+       MkUsed $ do rewrite lengthHomomorphism vars (cast outer)
+                   rewrite Extra.lengthDistributesOverFish [<] outer
+                   rewrite plusCommutative (length vars) (length outer)
+                   replicate (length outer) False ++ xs
+
+contractUsed : (Used (Scope.bind vars x)) -> Used vars
 contractUsed (MkUsed xs) = MkUsed (tail xs)
 
 contractUsedMany : {remove : _} ->
-                   (Used (remove ++ vars)) ->
+                   (Used (Scope.addInner vars remove)) ->
+                   Used vars
+contractUsedMany {remove=[<]} x = x
+contractUsedMany {remove=(rs :< r)} x = contractUsedMany {remove=rs} (contractUsed x)
+
+contractUsedManyFish : {remove : _} ->
+                   (Used (vars <>< remove)) ->
                    Used vars
-contractUsedMany {remove=[]} x = x
-contractUsedMany {remove=(r::rs)} x = contractUsedMany {remove=rs} (contractUsed x)
+contractUsedManyFish {remove=[]} x = x
+contractUsedManyFish {remove=(r :: rs)} x = contractUsed $ contractUsedManyFish {remove=rs} x
 
 markUsed : {vars : _} ->
            (idx : Nat) ->
@@ -385,13 +413,9 @@ markUsed : {vars : _} ->
 markUsed {vars} {prf} idx (MkUsed us) =
   let newUsed = replaceAt (finIdx prf) True us in
   MkUsed newUsed
-    where
-    finIdx : {vars : _} -> {idx : _} ->
-             (0 prf : IsVar x idx vars) ->
-             Fin (length vars)
-    finIdx {idx=Z} First = FZ
-    finIdx {idx=S x} (Later l) = FS (finIdx l)
 
+-- TODO replace ``Vect (length vars) Bool`` by data structure indexed by `vars` so we can erase `vars`
+-- TODO this is morally a thinning
 getUnused : Used vars ->
             Vect (length vars) Bool
 getUnused (MkUsed uv) = map not uv
@@ -400,9 +424,9 @@ total
 dropped : (vars : Scope) ->
           (drop : Vect (length vars) Bool) ->
           Scope
-dropped [] _ = []
-dropped (x::xs) (False::us) = x::(dropped xs us)
-dropped (x::xs) (True::us) = dropped xs us
+dropped [<] _ = Scope.empty
+dropped (xs :< x) (False::us) = dropped xs us :< x
+dropped (xs :< x) (True::us) = dropped xs us
 
 usedVars : {vars : _} ->
            {auto l : Ref Lifts LDefs} ->
@@ -431,10 +455,16 @@ usedVars used (LConCase fc sc alts def) =
         scDefUsed = usedVars defUsed sc in
         foldl usedConAlt scDefUsed alts
   where
+    usedConScope : {vars : _} ->
+                   {default Nothing lazy : Maybe LazyReason} ->
+                   Used vars -> LiftedCaseScope vars -> Used vars
+    usedConScope used (LRHS tm) = usedVars used tm
+    usedConScope used (LArg x sc)
+      = contractUsed $ usedConScope (weakenUsed {outer=[<x]} used) sc
+
     usedConAlt : {default Nothing lazy : Maybe LazyReason} ->
                   Used vars -> LiftedConAlt vars -> Used vars
-    usedConAlt used (MkLConAlt n ci tag args sc) =
-      contractUsedMany {remove=args} (usedVars (weakenUsed used) sc)
+    usedConAlt used (MkLConAlt n ci tag sc) = usedConScope used sc
 
 usedVars used (LConstCase fc sc alts def) =
     let defUsed = maybe used (usedVars used {vars}) def
@@ -444,84 +474,102 @@ usedVars used (LConstCase fc sc alts def) =
     usedConstAlt : {default Nothing lazy : Maybe LazyReason} ->
                     Used vars -> LiftedConstAlt vars -> Used vars
     usedConstAlt used (MkLConstAlt c sc) = usedVars used sc
-usedVars used (LPrimVal {}) = used
-usedVars used (LErased {})  = used
-usedVars used (LCrash {})   = used
+usedVars used (LPrimVal _ _) = used
+usedVars used (LErased _) = used
+usedVars used (LCrash _ _) = used
+
+unsafeDropVar :
+  (vars : _) ->
+  (unused : Vect (length vars) Bool) ->
+  Var vars ->
+  Var (dropped vars unused)
+unsafeDropVar [<] unused v = v
+unsafeDropVar (sx :< x) (False :: us) (MkVar First) = MkVar First
+unsafeDropVar (sx :< x) (False :: us) (MkVar (Later idx)) = later $ unsafeDropVar sx us (MkVar idx)
+unsafeDropVar (sx :< x) (True :: us) (MkVar First) = assert_total $
+  idris_crash "INTERNAL ERROR: Referenced variable marked as unused"
+unsafeDropVar (sx :< x) (True :: us) (MkVar (Later idx)) = unsafeDropVar sx us (MkVar idx)
+
 
 dropIdx : {vars : _} ->
           {idx : _} ->
-          (outer : Scope) ->
+          SizeOf inner ->
           (unused : Vect (length vars) Bool) ->
-          (0 p : IsVar x idx (outer ++ vars)) ->
-          Var (outer ++ (dropped vars unused))
-dropIdx [] (False::_) First = first
-dropIdx [] (True::_) First = assert_total $
-  idris_crash "INTERNAL ERROR: Referenced variable marked as unused"
-dropIdx [] (False::rest) (Later p) = Var.later $ dropIdx Scope.empty rest p
-dropIdx [] (True::rest) (Later p) = dropIdx Scope.empty rest p
-dropIdx (_::xs) unused First = first
-dropIdx (_::xs) unused (Later p) = Var.later $ dropIdx xs unused p
-
-dropUnused : {vars : _} ->
-             {auto _ : Ref Lifts LDefs} ->
-             {outer : Scope} ->
-             (unused : Vect (length vars) Bool) ->
-             (l : Lifted (outer ++ vars)) ->
-             Lifted (outer ++ (dropped vars unused))
-dropUnused _ (LPrimVal fc val) = LPrimVal fc val
-dropUnused _ (LErased fc) = LErased fc
-dropUnused _ (LCrash fc msg) = LCrash fc msg
-dropUnused {outer} unused (LLocal fc p) =
-  let (MkVar p') = dropIdx outer unused p in LLocal fc p'
-dropUnused unused (LCon fc n ci tag args) =
-  let args' = map (dropUnused unused) args in
+          (0 p : IsVar x idx (Scope.addInner vars inner)) ->
+          Var (Scope.addInner (dropped vars unused) inner)
+dropIdx inn unused p =
+  case locateVar inn (MkVar p) of
+    Left v => weakenNs inn (unsafeDropVar _ unused v)
+    Right v => embed v
+
+-- TODO this is morally a `Shrinkable`. Replace!
+0 DropUnused : Scoped -> Type
+DropUnused tm =
+  {auto _ : Ref Lifts LDefs} ->
+  {vars : _} ->
+  {0 inner : _}->
+  SizeOf inner ->
+  (unused : Vect (length vars) Bool) ->
+  tm (Scope.addInner vars inner) ->
+  tm (Scope.addInner (dropped vars unused) inner)
+
+dropUnused : DropUnused Lifted
+dropConCase : DropUnused LiftedConAlt
+dropConstCase : DropUnused LiftedConstAlt
+dropScope : DropUnused LiftedCaseScope
+
+dropUnused inn _ (LPrimVal fc val) = LPrimVal fc val
+dropUnused inn _ (LErased fc) = LErased fc
+dropUnused inn _ (LCrash fc msg) = LCrash fc msg
+dropUnused inn unused (LLocal fc p) =
+  let (MkVar p') = dropIdx inn unused p in LLocal fc p'
+dropUnused inn unused (LCon fc n ci tag args) =
+  let args' = map (dropUnused inn unused) args in
       LCon fc n ci tag args'
-dropUnused {outer} unused (LLet fc n val sc) =
-  let val' = dropUnused unused val
-      sc' = dropUnused {outer=n::outer} (unused) sc in
+dropUnused inn unused (LLet fc n val sc) =
+  let val' = dropUnused inn unused val
+      sc' = dropUnused (suc inn) (unused) sc in
       LLet fc n val' sc'
-dropUnused unused (LApp fc lazy c arg) =
-  let c' = dropUnused unused c
-      arg' = dropUnused unused arg in
+dropUnused inn unused (LApp fc lazy c arg) =
+  let c' = dropUnused inn unused c
+      arg' = dropUnused inn unused arg in
       LApp fc lazy c' arg'
-dropUnused unused (LOp fc lazy fn args) =
-  let args' = map (dropUnused unused) args in
+dropUnused inn unused (LOp fc lazy fn args) =
+  let args' = map (dropUnused inn unused) args in
       LOp fc lazy fn args'
-dropUnused unused (LExtPrim fc lazy n args) =
-  let args' = map (dropUnused unused) args in
+dropUnused inn unused (LExtPrim fc lazy n args) =
+  let args' = map (dropUnused inn unused) args in
       LExtPrim fc lazy n args'
-dropUnused unused (LAppName fc lazy n args) =
-  let args' = map (dropUnused unused) args in
+dropUnused inn unused (LAppName fc lazy n args) =
+  let args' = map (dropUnused inn unused) args in
       LAppName fc lazy n args'
-dropUnused unused (LUnderApp fc n miss args) =
-  let args' = map (dropUnused unused) args in
+dropUnused inn unused (LUnderApp fc n miss args) =
+  let args' = map (dropUnused inn unused) args in
       LUnderApp fc n miss args'
-dropUnused {vars} {outer} unused (LConCase fc sc alts def) =
-  let alts' = map dropConCase alts in
-      LConCase fc (dropUnused unused sc) alts' (map (dropUnused unused) def)
-  where
-    dropConCase : LiftedConAlt (outer ++ vars) ->
-                  LiftedConAlt (outer ++ (dropped vars unused))
-    dropConCase (MkLConAlt n ci t args sc) =
-      let sc' = (rewrite sym $ appendAssociative args outer vars in sc)
-          droppedSc = dropUnused {vars=vars} {outer=args++outer} unused sc' in
-      MkLConAlt n ci t args (rewrite appendAssociative args outer (dropped vars unused) in droppedSc)
-dropUnused {vars} {outer} unused (LConstCase fc sc alts def) =
-  let alts' = map dropConstCase alts in
-      LConstCase fc (dropUnused unused sc) alts' (map (dropUnused unused) def)
-  where
-    dropConstCase : LiftedConstAlt (outer ++ vars) ->
-                    LiftedConstAlt (outer ++ (dropped vars unused))
-    dropConstCase (MkLConstAlt c val) = MkLConstAlt c (dropUnused unused val)
+dropUnused inn unused (LConCase fc sc alts def) =
+  let alts' = map (dropConCase inn unused) alts in
+      LConCase fc (dropUnused inn unused sc) alts' (map (dropUnused inn unused) def)
+dropUnused inn unused (LConstCase fc sc alts def) =
+  let alts' = map (dropConstCase inn unused) alts in
+      LConstCase fc (dropUnused inn unused sc) alts' (map (dropUnused inn unused) def)
+
+dropConCase inn unused (MkLConAlt n ci t sc) =
+  MkLConAlt n ci t (dropScope inn unused sc)
+
+dropConstCase inn unused (MkLConstAlt c val) = MkLConstAlt c (dropUnused inn unused val)
+
+dropScope inn unused (LRHS sc) = LRHS (dropUnused inn unused sc)
+dropScope {vars} inn unused (LArg x sc) = LArg x (dropScope (suc inn) unused sc)
 
 mutual
   makeLam : {vars : _} ->
+            {auto c : Ref Ctxt Defs} ->
             {auto l : Ref Lifts LDefs} ->
             {doLazyAnnots : Bool} ->
             {default Nothing lazy : Maybe LazyReason} ->
             FC -> (bound : Scope) ->
-            CExp (bound ++ vars) -> Core (Lifted vars)
-  makeLam fc bound (CLam _ x sc') = makeLam fc {doLazyAnnots} {lazy} (x :: bound) sc'
+            CExp (Scope.addInner vars bound) -> Core (Lifted vars)
+  makeLam fc bound (CLam _ x sc') = makeLam fc {doLazyAnnots} {lazy} (bound :< x) sc'
   makeLam {vars} fc bound sc
       = do scl <- liftExp {doLazyAnnots} {lazy} sc
            -- Find out which variables aren't used in the new definition, and
@@ -529,28 +577,30 @@ mutual
            let scUsedL = usedVars initUsed scl
                unusedContracted = contractUsedMany {remove=bound} scUsedL
                unused = getUnused unusedContracted
-               scl' = dropUnused {outer=bound} unused scl
+               scl' = dropUnused (mkSizeOf bound) unused scl
            n <- genName
-           update Lifts { defs $= ((n, MkLFun (dropped vars unused) bound scl') ::) }
-           pure $ LUnderApp fc n (length bound) (allVars fc vars unused)
+           log "compile.execute" 40 $ "LambdaLift.makeLam \{show scl} |=>| \{show scl'}"
+           let scl'' : Lifted ((cast (toList $ dropped vars unused)) ++ bound)
+                     := rewrite castToList (dropped vars unused) in scl'
+           update Lifts { defs $= ((n, MkLFun (toList $ dropped vars unused) bound scl'') ::) }
+           pure $  LUnderApp fc n (length bound) (reverse $ allVars fc vars unused)
     where
 
-        allPrfs : (vs : Scope) -> SizeOf seen ->
-                  (unused : Vect (length vs) Bool) ->
-                  List (Var (seen <>> vs))
-        allPrfs [] _ _ = []
-        allPrfs (v :: vs) p (False::uvs) = mkVarChiply p :: allPrfs vs (p :< _) uvs
-        allPrfs (v :: vs) p (True::uvs) = allPrfs vs (p :< _) uvs
+        allPrfs : (vs : Scope) -> SizeOf inner -> (unused : Vect (length vs) Bool) -> List (Var (vs <>< inner))
+        allPrfs [<] inn _ = []
+        allPrfs (vs :< v) inn (False::uvs) = mkVarFishily inn :: allPrfs vs (suc inn) uvs
+        allPrfs (vs :< v) inn (True::uvs) = allPrfs vs (suc inn) uvs
 
-        -- apply to all the variables. 'First' will be first in the last, which
+        -- apply to all the variables. 'First' will be first in the list, which
         -- is good, because the most recently bound name is the first argument to
         -- the resulting function
         allVars : FC -> (vs : Scope) -> (unused : Vect (length vs) Bool) -> List (Lifted vs)
-        allVars fc vs unused = map (\ (MkVar p) => LLocal fc p) (allPrfs vs [<] unused)
+        allVars fc vs unused = map (\ (MkVar p) => LLocal fc p) (allPrfs vs zero unused)
 
 -- if doLazyAnnots = True then annotate function application with laziness
 -- otherwise use old behaviour (thunk is a function)
   liftExp : {vars : _} ->
+            {auto c : Ref Ctxt Defs} ->
             {auto l : Ref Lifts LDefs} ->
             {doLazyAnnots : Bool} ->
             {default Nothing lazy : Maybe LazyReason} ->
@@ -581,9 +631,16 @@ mutual
       = pure $ LConCase fc !(liftExp {doLazyAnnots} sc) !(traverse (liftConAlt {lazy}) alts)
                            !(traverseOpt (liftExp {doLazyAnnots}) def)
     where
+      liftCaseScope : {vars : _} ->
+                      {default Nothing lazy : Maybe LazyReason} ->
+                      CCaseScope vars -> Core (LiftedCaseScope vars)
+      liftCaseScope (CRHS tm) = pure $ LRHS !(liftExp {doLazyAnnots} tm)
+      liftCaseScope (CArg x sc) = pure $ LArg x !(liftCaseScope sc)
+
       liftConAlt : {default Nothing lazy : Maybe LazyReason} ->
                    CConAlt vars -> Core (LiftedConAlt vars)
-      liftConAlt (MkConAlt n ci t args sc) = pure $ MkLConAlt n ci t args !(liftExp {doLazyAnnots} {lazy} sc)
+      liftConAlt (MkConAlt n ci t sc)
+          = pure $ MkLConAlt n ci t !(liftCaseScope {lazy} sc)
   liftExp (CConstCase fc sc alts def)
       = pure $ LConstCase fc !(liftExp {doLazyAnnots} sc) !(traverse liftConstAlt alts)
                              !(traverseOpt (liftExp {doLazyAnnots}) def)
@@ -596,19 +653,20 @@ mutual
   liftExp (CCrash fc str) = pure $ LCrash fc str
 
 export
-liftBody : {vars : _} -> {doLazyAnnots : Bool} ->
+liftBody : {auto c : Ref Ctxt Defs} -> {vars : _} -> {doLazyAnnots : Bool} ->
            Name -> CExp vars -> Core (Lifted vars, List (Name, LiftedDef))
 liftBody n tm
     = do l <- newRef Lifts (MkLDefs n [] 0)
          tml <- liftExp {doLazyAnnots} {l} tm
+         log "compile.execute" 40 $ "LambdaLift.liftBody \{show n}: \{show tm} |->| \{show tml}"
          ldata <- get Lifts
          pure (tml, defs ldata)
 
 export
-lambdaLiftDef : (doLazyAnnots : Bool) -> Name -> CDef -> Core (List (Name, LiftedDef))
+lambdaLiftDef : {auto c : Ref Ctxt Defs} -> (doLazyAnnots : Bool) -> Name -> CDef -> Core (List (Name, LiftedDef))
 lambdaLiftDef doLazyAnnots n (MkFun args exp)
     = do (expl, defs) <- liftBody {doLazyAnnots} n exp
-         pure ((n, MkLFun args Scope.empty expl) :: defs)
+         pure ((n, MkLFun (toList args) Scope.empty (rewrite castToList args in expl)) :: defs)
 lambdaLiftDef _ n (MkCon t a nt) = pure [(n, MkLCon t a nt)]
 lambdaLiftDef _ n (MkForeign ccs fargs ty) = pure [(n, MkLForeign ccs fargs ty)]
 lambdaLiftDef doLazyAnnots n (MkError exp)
@@ -621,7 +679,7 @@ lambdaLiftDef doLazyAnnots n (MkError exp)
 -- An empty list an error, because on success you will always get at least
 -- one definition, the lifted definition for the given name.
 export
-lambdaLift :  (doLazyAnnots : Bool)
+lambdaLift : {auto c : Ref Ctxt Defs} -> (doLazyAnnots : Bool)
            -> (Name,FC,CDef)
            -> Core (List (Name, LiftedDef))
 lambdaLift doLazyAnnots (n,_,def) = lambdaLiftDef doLazyAnnots n def
diff --git a/src/Compiler/NoMangle.idr b/src/Compiler/NoMangle.idr
index cb79970c9ba..5e6ecaa775f 100644
--- a/src/Compiler/NoMangle.idr
+++ b/src/Compiler/NoMangle.idr
@@ -2,6 +2,9 @@
 module Compiler.NoMangle
 
 import Core.Context
+
+import Data.String
+
 import Libraries.Data.NameMap
 import Libraries.Data.NameMap.Traversable
 
@@ -29,8 +32,8 @@ initNoMangle backends valid = do
             let Just (backend, expName) = lookupBackend backends exps
                 | Nothing => throw (GenericMsg EmptyFC """
                     No valid %export specifier for \{show name}
-                      Supported backends: \{showSep ", " backends}
-                      Given backends: \{showSep ", " (fst <$> exps)}
+                      Supported backends: \{joinBy ", " backends}
+                      Given backends: \{joinBy ", " (fst <$> exps)}
                     """)
             let True = valid expName
                 | False => throw (GenericMsg EmptyFC "\"\{expName}\" is not a valid name on \{backend} backend")
diff --git a/src/Compiler/Opts/CSE.idr b/src/Compiler/Opts/CSE.idr
index 3d35ee6156b..506d06db207 100644
--- a/src/Compiler/Opts/CSE.idr
+++ b/src/Compiler/Opts/CSE.idr
@@ -37,7 +37,8 @@ import Data.SortedMap
 import Data.Vect
 
 import Libraries.Data.Erased
-import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 ||| Maping from a pairing of closed terms together with
 ||| their size (for efficiency) to the number of
@@ -117,11 +118,11 @@ store sz exp =
 
 dropVar : SizeOf inner
         -> {n : Nat}
-        -> (0 p : IsVar x n (inner ++ outer))
+        -> (0 p : IsVar x n (Scope.addInner outer inner))
         -> Maybe (Erased (IsVar x n inner))
 dropVar inn p = case locateIsVar inn p of
-  Left p => Just p
-  Right p => Nothing
+  Right p => Just p
+  Left p => Nothing
 
 
 -- Tries to 'strengthen' an expression by removing an `outer` context.
@@ -131,7 +132,7 @@ dropVar inn p = case locateIsVar inn p of
 Drop tm
   = {0 inner, outer : Scope} ->
     SizeOf inner ->
-    tm (inner ++ outer) ->
+    tm (Scope.addInner outer inner) ->
     Maybe (tm inner)
 
 
@@ -164,11 +165,12 @@ mutual
   dropCExp inn (CErased fc) = Just $ CErased fc
   dropCExp inn (CCrash fc x) = Just $ CCrash fc x
 
+  dropCaseScope : Drop CCaseScope
+  dropCaseScope inn (CRHS z) = CRHS <$> dropCExp inn z
+  dropCaseScope inn (CArg x sc) = CArg x <$> dropCaseScope (suc inn) sc
+
   dropConAlt : Drop CConAlt
-  dropConAlt inn (MkConAlt x y tag args z) =
-    MkConAlt x y tag args <$>
-        dropCExp (mkSizeOf args + inn)
-        (replace {p = CExp} (appendAssociative args inner outer) z)
+  dropConAlt inn (MkConAlt x y t z) = MkConAlt x y t <$> dropCaseScope inn z
 
   dropConstAlt : Drop CConstAlt
   dropConstAlt inn (MkConstAlt x y) = MkConstAlt x <$> dropCExp inn y
@@ -286,12 +288,22 @@ mutual
   analyzeSubExp c@(CErased {})  = pure (1, c)
   analyzeSubExp c@(CCrash {})   = pure (1, c)
 
+  analyzeCaseScope :  { auto c : Ref Sts St }
+                -> CCaseScope ns
+                -> Core (Integer, CCaseScope ns)
+  analyzeCaseScope (CRHS tm)
+      = do (sz, tm') <- analyze tm
+           pure (sz, CRHS tm')
+  analyzeCaseScope (CArg x sc)
+      = do (sz, sc') <- analyzeCaseScope sc
+           pure (sz, CArg x sc')
+
   analyzeConAlt :  { auto c : Ref Sts St }
                 -> CConAlt ns
                 -> Core (Integer, CConAlt ns)
-  analyzeConAlt (MkConAlt n c t as z) = do
-    (sz, z') <- analyze z
-    pure (sz + 1, MkConAlt n c t as z')
+  analyzeConAlt (MkConAlt n c t z) = do
+    (sz, z') <- analyzeCaseScope z
+    pure (sz + 1, MkConAlt n c t z')
 
   analyzeConstAlt : Ref Sts St => CConstAlt ns -> Core (Integer, CConstAlt ns)
   analyzeConstAlt (MkConstAlt c y) = do
@@ -448,13 +460,20 @@ mutual
   replaceExp _ c@(CErased {})  = pure c
   replaceExp _ c@(CCrash {})   = pure c
 
+  replaceCaseScope :  Ref ReplaceMap ReplaceMap
+                => Ref Ctxt Defs
+                => (parentCount : Integer)
+                -> CCaseScope ns
+                -> Core (CCaseScope ns)
+  replaceCaseScope pc (CRHS tm) = CRHS <$> replaceExp pc tm
+  replaceCaseScope pc (CArg x sc) = CArg x <$> replaceCaseScope pc sc
+
   replaceConAlt :  Ref ReplaceMap ReplaceMap
                 => Ref Ctxt Defs
                 => (parentCount : Integer)
                 -> CConAlt ns
                 -> Core (CConAlt ns)
-  replaceConAlt pc (MkConAlt n c t as z) =
-    MkConAlt n c t as <$> replaceExp pc z
+  replaceConAlt pc (MkConAlt n c t z) = MkConAlt n c t <$> replaceCaseScope pc z
 
   replaceConstAlt :  Ref ReplaceMap ReplaceMap
                   => Ref Ctxt Defs
diff --git a/src/Compiler/Opts/ConstantFold.idr b/src/Compiler/Opts/ConstantFold.idr
index 4c038ab0e75..6edb65a19d0 100644
--- a/src/Compiler/Opts/ConstantFold.idr
+++ b/src/Compiler/Opts/ConstantFold.idr
@@ -3,12 +3,15 @@ module Compiler.Opts.ConstantFold
 import Core.CompileExpr
 import Core.Context.Log
 import Core.Primitives
-import Core.Value
+import Core.Evaluate.Value
+
 import Data.Vect
+import Data.SnocList
 
-import Data.List.HasLength
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
 
+import Core.Evaluate.Value
 
 findConstAlt : Constant -> List (CConstAlt vars) ->
                Maybe (CExp vars) -> Maybe (CExp vars)
@@ -25,39 +28,49 @@ foldableOp (Cast from to)   = isJust (intKind from) && isJust (intKind to)
 foldableOp _                = True
 
 
-data Subst : Scope -> Scoped where
-  Nil  : Subst Scope.empty vars
-  (::) : CExp vars -> Subst ds vars -> Subst (d :: ds) vars
-  Wk   : SizeOf ws -> Subst ds vars -> Subst (ws ++ ds) (ws ++ vars)
+data Subst : Scope -> Scope -> Type where
+  Lin  : Subst Scope.empty vars
+  (:<) : Subst ds vars -> CExp vars -> Subst (Scope.bind ds d) vars
+  Wk   : Subst ds vars -> SizeOf ws -> Subst (Scope.addInner ds ws) (Scope.addInner vars ws)
 
 namespace Subst
   public export
   empty : Subst Scope.empty vars
-  empty = []
+  empty = [<]
+
+  public export
+  bind : Subst ds vars -> CExp vars -> Subst (Scope.bind ds d) vars
+  bind = (:<)
 
 initSubst : (vars : Scope) -> Subst vars vars
-initSubst [] = Subst.empty
+initSubst [<] = Subst.empty
 initSubst vars
-  = rewrite sym $ appendNilRightNeutral vars in
-    Wk (mkSizeOf vars) Subst.empty
-
-wk : SizeOf out -> Subst ds vars -> Subst (out ++ ds) (out ++ vars)
-wk sout (Wk {ws, ds, vars} sws rho)
-  = rewrite appendAssociative out ws ds in
-    rewrite appendAssociative out ws vars in
-    Wk (sout + sws) rho
-wk ws rho = Wk ws rho
+  = rewrite sym $ appendLinLeftNeutral vars in
+    Wk Subst.empty (mkSizeOf vars)
+
+wk : SizeOf out -> Subst ds vars -> Subst (Scope.addInner ds out) (Scope.addInner vars out)
+wk sout (Wk {ws, ds, vars} rho sws)
+  = rewrite sym $ appendAssociative ds ws out in
+    rewrite sym $ appendAssociative vars ws out in
+    Wk rho (sws + sout)
+wk ws rho = Wk rho ws
+
+wksN : Subst ds vars -> SizeOf out -> Subst (Scope.ext ds out) (Scope.ext vars out)
+wksN s s'
+  = rewrite fishAsSnocAppend ds out in
+    rewrite fishAsSnocAppend vars out in
+    wk (zero <>< s') s
 
 record WkCExp (vars : Scope) where
   constructor MkWkCExp
   {0 outer, supp : Scope}
   size : SizeOf outer
-  0 prf : vars === outer ++ supp
+  0 prf : vars === Scope.addInner supp outer
   expr : CExp supp
 
 Weaken WkCExp where
-  weakenNs s' (MkWkCExp {outer, supp} s Refl e)
-    = MkWkCExp (s' + s) (appendAssociative ns outer supp)  e
+  weakenNs s' (MkWkCExp {supp, outer} s Refl e)
+    = MkWkCExp (s + s') (sym $ appendAssociative supp outer inner) e
 
 lookup : FC -> Var ds -> Subst ds vars -> CExp vars
 lookup fc (MkVar p) rho = case go p rho of
@@ -68,13 +81,13 @@ lookup fc (MkVar p) rho = case go p rho of
 
   go : {i : Nat} -> {0 ds, vars : _} -> (0 _ : IsVar n i ds) ->
        Subst ds vars -> Either (Var vars) (WkCExp vars)
-  go First     (val :: rho) = Right (MkWkCExp zero Refl val)
-  go (Later p) (val :: rho) = go p rho
-  go p         (Wk ws  rho) = case sizedView ws of
+  go First     (rho :< val) = Right (MkWkCExp zero Refl val)
+  go (Later p) (rho :< val) = go p rho
+  go p         (Wk rho  ws) = case sizedView ws of
     Z => go p rho
     S ws' => case i of
       Z => Left first
-      S i' => bimap later weaken (go (dropLater p) (Wk ws' rho))
+      S i' => bimap later weaken (go (dropLater p) (Wk rho ws'))
 
 replace : CExp vars -> Bool
 replace (CLocal {})   = True
@@ -101,7 +114,7 @@ constFold rho (CLam fc x y)
 constFold rho (CLet fc x inl y z) =
     let val := constFold rho y
      in case replace val of
-          True  => constFold (val::rho) z
+          True  => constFold (Subst.bind rho val) z
           False => case constFold (wk (mkSizeOf (Scope.single x)) rho) z of
             CLocal {idx = 0} _ _ => val
             body                 => CLet fc x inl val body
@@ -132,11 +145,11 @@ constFold rho (COp {arity} fc fn xs) =
     toNF (CPrimVal fc (I _)) = Nothing
     toNF (CPrimVal fc (Db _)) = Nothing
     -- Fold the rest
-    toNF (CPrimVal fc c) = Just $ NPrimVal fc c
+    toNF (CPrimVal fc c) = Just $ VPrimVal fc c
     toNF _ = Nothing
 
     fromNF : NF vars' -> Maybe (CExp vars')
-    fromNF (NPrimVal fc c) = Just $ CPrimVal fc c
+    fromNF (VPrimVal fc c) = Just $ CPrimVal fc c
     fromNF _ = Nothing
 
     commutative : PrimType -> Bool
@@ -161,9 +174,14 @@ constFold rho (CDelay fc x y) = CDelay fc x $ constFold rho y
 constFold rho (CConCase fc sc xs x)
   = CConCase fc (constFold rho sc) (foldAlt <$> xs) (constFold rho <$> x)
   where
+    foldScope : forall vars . {vars' : _} ->
+                Subst vars vars' -> CCaseScope vars -> CCaseScope vars'
+    foldScope rho (CRHS tm) = CRHS (constFold rho tm)
+    foldScope rho (CArg x sc) = CArg x (foldScope (wk (mkSizeOf [<x]) rho) sc)
+
     foldAlt : CConAlt vars -> CConAlt vars'
-    foldAlt (MkConAlt n ci t xs e)
-      = MkConAlt n ci t xs $ constFold (wk (mkSizeOf xs) rho) e
+    foldAlt (MkConAlt n ci t sc)
+      = MkConAlt n ci t (foldScope rho sc)
 
 constFold rho (CConstCase fc sc xs x) =
     let sc' = constFold rho sc
diff --git a/src/Compiler/Opts/Constructor.idr b/src/Compiler/Opts/Constructor.idr
index 9b62c89318d..aee61789951 100644
--- a/src/Compiler/Opts/Constructor.idr
+++ b/src/Compiler/Opts/Constructor.idr
@@ -94,21 +94,22 @@ natHack =
     ]
 
 -- get all builtin transformations
+export
 builtinMagic : forall vars. CExp vars -> Maybe (CExp vars)
 builtinMagic = magic natHack
 
 natBranch :  CConAlt vars -> Bool
-natBranch (MkConAlt n ZERO _ _ _) = True
-natBranch (MkConAlt n SUCC _ _ _) = True
+natBranch (MkConAlt n ZERO _ _) = True
+natBranch (MkConAlt n SUCC _ _) = True
 natBranch _ = False
 
 trySBranch : CExp vars -> CConAlt vars -> Maybe (CExp vars)
-trySBranch n (MkConAlt nm SUCC _ [arg] sc)
+trySBranch n (MkConAlt nm SUCC _ (CArg arg (CRHS sc)))
     = Just (CLet (getFC n) arg YesInline (magic__natUnsuc (getFC n) (getFC n) [n]) sc)
 trySBranch _ _ = Nothing
 
 tryZBranch : CConAlt vars -> Maybe (CExp vars)
-tryZBranch (MkConAlt n ZERO _ [] sc) = Just sc
+tryZBranch (MkConAlt n ZERO _ (CRHS sc)) = Just sc
 tryZBranch _ = Nothing
 
 getSBranch : CExp vars -> List (CConAlt vars) -> Maybe (CExp vars)
@@ -120,6 +121,7 @@ getZBranch [] = Nothing
 getZBranch (x :: xs) = tryZBranch x <|> getZBranch xs
 
 -- Rewrite case trees on Nat to be case trees on Integer
+export
 nat : {auto s : Ref NextMN Int} -> CExp vars -> Core (Maybe (CExp vars))
 nat (CCon fc _ ZERO _ []) = pure $ Just $ CPrimVal fc (BI 0)
 nat (CCon fc _ SUCC _ [x]) = pure $ Just $ COp fc (Add IntegerType) [CPrimVal fc (BI 1), x]
@@ -144,12 +146,14 @@ nat _ = pure Nothing
 =========
 -}
 
+export
 enumTag : Nat -> Int -> Constant
 enumTag k i =
   if      k <= 0xff   then B8 (cast i)
   else if k <= 0xffff then B16 (cast i)
   else                     B32 (cast i)
 
+export
 enum : CExp vars -> Maybe (CExp vars)
 enum (CCon fc _ (ENUM n) (Just tag) []) = Just (CPrimVal fc (enumTag n tag))
 enum (CConCase fc sc alts def) = do
@@ -157,7 +161,7 @@ enum (CConCase fc sc alts def) = do
     Just $ CConstCase fc sc alts' def
   where
     toEnum : CConAlt vars -> Maybe (CConstAlt vars)
-    toEnum (MkConAlt nm (ENUM n) (Just tag) [] sc)
+    toEnum (MkConAlt nm (ENUM n) (Just tag) (CRHS sc))
         = pure $ MkConstAlt (enumTag n tag) sc
     toEnum _ = Nothing
 enum t = Nothing
@@ -168,9 +172,11 @@ enum t = Nothing
 ========
 -}
 
+-- remove pattern matches on unit
+export
 unitTree : Ref NextMN Int => CExp vars -> Core (Maybe (CExp vars))
 unitTree exp@(CConCase fc sc alts def) =
-    let [MkConAlt _ UNIT _ [] e] = alts
+    let [MkConAlt _ UNIT _ (CRHS e)] = alts
             | _ => pure Nothing
     in case sc of -- TODO: Check scrutinee has no effect, and skip let binding
         CLocal {} => pure $ Just e
@@ -217,8 +223,8 @@ tryIntrinsic (CConCase fc e alts def) =
         <&> \alts => CConCase fc e alts def
   where
     go : CConAlt vars -> Maybe (CConAlt vars)
-    go (MkConAlt _ ci _ as e) =
-        conInfoNameTag ci <&> \(n, tag) => MkConAlt n ci (Just tag) as e
+    go (MkConAlt _ ci _ e) =
+        conInfoNameTag ci <&> \(n, tag) => MkConAlt n ci (Just tag) e
 tryIntrinsic _ = Nothing
 
 parameters (try : forall vars. CExp vars -> Core (CExp vars))
@@ -228,6 +234,7 @@ parameters (try : forall vars. CExp vars -> Core (CExp vars))
 
     rewriteCConAlt : CConAlt vars -> Core (CConAlt vars)
     rewriteCConstAlt : CConstAlt vars -> Core (CConstAlt vars)
+    rewriteScope : CCaseScope vars -> Core (CCaseScope vars)
 
     rewriteCExp exp = do
         exp' <- rewriteSub exp
@@ -261,9 +268,14 @@ parameters (try : forall vars. CExp vars -> Core (CExp vars))
             <*> traverseOpt rewriteCExp def
     rewriteSub e = pure e
 
-    rewriteCConAlt (MkConAlt n ci t as e) = MkConAlt n ci t as <$> rewriteCExp e
+    rewriteScope (CRHS tm) = pure $ CRHS !(rewriteCExp tm)
+    rewriteScope (CArg x sc)
+        = pure $ CArg x !(rewriteScope sc)
+
+    rewriteCConAlt (MkConAlt n ci t e) = MkConAlt n ci t <$> rewriteScope e
     rewriteCConstAlt (MkConstAlt x e) = MkConstAlt x <$> rewriteCExp e
 
+export
 sequence : List (forall vars. CExp vars -> Core (Maybe (CExp vars))) -> CExp vars -> Core (CExp vars)
 sequence [] e = pure e
 sequence (x :: xs) e = do
diff --git a/src/Compiler/Opts/Identity.idr b/src/Compiler/Opts/Identity.idr
index 714a99b332a..e2e72ee3c22 100644
--- a/src/Compiler/Opts/Identity.idr
+++ b/src/Compiler/Opts/Identity.idr
@@ -2,17 +2,20 @@ module Compiler.Opts.Identity
 
 import Core.CompileExpr
 import Core.Context.Log
+
 import Data.Vect
+import Data.SnocList
 
 import Libraries.Data.List.SizeOf
 
-makeArgs : (args : Scope) -> List (Var (args ++ vars))
-makeArgs args = embed @{ListFreelyEmbeddable} (Var.allVars args)
+makeArgz : (args : List Name) -> List (Var (Scope.ext vars args))
+makeArgz args
+  = embedFishily @{ListFreelyEmbeddable} $ Var.List.allVars args
 
 parameters (fn1 : Name) (idIdx : Nat)
   mutual
     -- special case for matching on 'Nat'-shaped things
-    isUnsucc : Var vars -> CExp vars -> Maybe (Constant, Var (x :: vars))
+    isUnsucc : Var vars -> CExp vars -> Maybe (Constant, Var (Scope.bind vars x))
     isUnsucc var (COp _ (Sub _) [CLocal _ p, CPrimVal _ c]) =
         if var == MkVar p
             then Just (c, first)
@@ -77,14 +80,19 @@ parameters (fn1 : Name) (idIdx : Nat)
         && all altEq xs
         && maybeVarEq var con const x
       where
+        scopeEq : forall vars .
+                  (args : SnocList Name) ->
+                  Name ->
+                  Var (vars ++ args) ->
+                  List (Var (vars ++ args)) ->
+                  CCaseScope (vars ++ args) -> Bool
+        scopeEq args y var vs (CRHS tm)
+            = cexpIdentity var (Just (y, vs)) const tm
+        scopeEq args y var vs (CArg x sc)
+            = scopeEq (args :< x) y (weaken var) (MkVar First :: map weaken vs) sc
 
         altEq : CConAlt vars -> Bool
-        altEq (MkConAlt y _ _ args exp) =
-            cexpIdentity
-                (weakenNs (mkSizeOf args) var)
-                (Just (y, makeArgs args))
-                const
-                exp
+        altEq (MkConAlt y _ _ sc) = scopeEq [<] y var [] sc
     cexpIdentity var con const (CConstCase fc sc xs x) =
         cexpIdentity var Nothing Nothing sc
         && all altEq xs
@@ -102,20 +110,20 @@ parameters (fn1 : Name) (idIdx : Nat)
     maybeVarEq _ _ _ Nothing = True
     maybeVarEq var con const (Just exp) = cexpIdentity var con const exp
 
-checkIdentity : (fullName : Name) -> List (Var vars) -> CExp vars -> Nat -> Maybe Nat
-checkIdentity _ [] _ _ = Nothing
-checkIdentity fn (v :: vs) exp idx = if cexpIdentity fn idx v Nothing Nothing exp
+checkIdentity : (fullName : Name) -> Scopeable (Var vars) -> CExp vars -> Nat -> Maybe Nat
+checkIdentity _ [<] _ _ = Nothing
+checkIdentity fn (vs :< v) exp idx = if cexpIdentity fn idx v Nothing Nothing exp
     then Just idx
     else checkIdentity fn vs exp (S idx)
 
 calcIdentity : (fullName : Name) -> CDef -> Maybe Nat
-calcIdentity fn (MkFun args exp) = checkIdentity fn (Var.allVars args) exp Z
+calcIdentity fn (MkFun args exp) = checkIdentity fn (Var.SnocList.allVars args) exp Z
 calcIdentity _ _ = Nothing
 
 getArg : FC -> Nat -> (args : Scope) -> Maybe (CExp args)
-getArg _ _ [] = Nothing
-getArg fc Z (a :: _) = Just $ CLocal fc First
-getArg fc (S k) (_ :: as) = weaken <$> getArg fc k as
+getArg _ _ [<] = Nothing
+getArg fc Z (_ :< a) = Just $ CLocal fc First
+getArg fc (S k) (as :< _) = weaken <$> getArg fc k as
 
 idCDef : Nat -> CDef -> Maybe CDef
 idCDef idx (MkFun args exp) = MkFun args <$> getArg (getFC exp) idx args
diff --git a/src/Compiler/Opts/ToplevelConstants.idr b/src/Compiler/Opts/ToplevelConstants.idr
index 135078111bf..39ff7d375d2 100644
--- a/src/Compiler/Opts/ToplevelConstants.idr
+++ b/src/Compiler/Opts/ToplevelConstants.idr
@@ -97,6 +97,7 @@ checkCrash : Ref SortTag SortST => (Name, FC, NamedDef) -> Core ()
 checkCrash (n, _, MkNmError _) = update SortTag $ { nonconst $= insert n }
 checkCrash (n, _, MkNmFun args (NmCrash {})) = update SortTag $ { nonconst $= insert n }
 checkCrash (n, _, MkNmFun args (NmOp _ Crash _)) = update SortTag $ { nonconst $= insert n }
+checkCrash (n, _, MkNmFun args (NmExtPrim _ _ _)) = update SortTag $ { nonconst $= insert n }
 checkCrash (n, _, def) = do
   st <- get SortTag
   when (any (flip contains st.nonconst) !(getCalls n)) $
diff --git a/src/Compiler/RefC/RefC.idr b/src/Compiler/RefC/RefC.idr
index fb4b56569b8..655cb9e0c15 100644
--- a/src/Compiler/RefC/RefC.idr
+++ b/src/Compiler/RefC/RefC.idr
@@ -1,7 +1,6 @@
 module Compiler.RefC.RefC
 
 import Compiler.RefC.CC
-
 import Compiler.Common
 import Compiler.CompileExpr
 import Compiler.ANF
@@ -11,15 +10,16 @@ import Core.Directory
 
 import Idris.Syntax
 
-import Libraries.Data.DList
 import Data.SortedSet
 import Data.SortedMap
 import Data.Vect
+import Data.String
 
 import System
 import System.File
 
 import Protocol.Hex
+import Libraries.Data.DList
 import Libraries.Utils.Path
 
 %default covering
@@ -179,7 +179,7 @@ cOp StrAppend     [x, y]    = "strAppend(" ++ x ++ ", " ++ y ++ ")"
 cOp StrSubstr     [x, y, z] = "strSubstr(" ++ x ++ ", " ++ y  ++ ", " ++ z ++ ")"
 cOp BelieveMe     [_, _, x] = "idris2_newReference(" ++ x ++ ")"
 cOp Crash         [_, msg]  = "idris2_crash(" ++ msg ++ ");"
-cOp fn args = show fn ++ "(" ++ (showSep ", " $ toList args) ++ ")"
+cOp fn args = show fn ++ "(" ++ (joinBy ", " $ toList args) ++ ")"
 
 varName : AVar -> String
 varName (ALocal i) = "var_" ++ (show i)
@@ -561,7 +561,7 @@ mutual
                unless (elem pn prims) $ throw $ InternalError $ "[refc] Unknown primitive: " ++ cName p
             _ => throw $ InternalError $ "[refc] Unknown primitive: " ++ cName p
         emit fc $ "// call to external primitive " ++ cName p
-        pure $ "idris2_\{cName p}("++ showSep ", " (map varName args) ++")"
+        pure $ "idris2_\{cName p}("++ joinBy ", " (map varName args) ++")"
 
     cStatementsFromANF (AConCase fc sc alts mDef) tailPosition = do
         let sc' = varName sc
@@ -816,7 +816,7 @@ createCFunctions n (MkAFun args anf) = do
     let fn = "Value *\{cName !(getFullName n)}"
             ++ (if nargs == 0 then "(void)"
                else if nargs > MaxExtractFunArgs then "(Value *var_arglist[\{show nargs}])"
-               else ("\n(\n" ++ (showSep "\n" $ addCommaToList (map (\i =>  "  Value * var_" ++ (show i)) args))) ++ "\n)")
+               else ("\n(\n" ++ (joinBy "\n" $ addCommaToList (map (\i =>  "  Value * var_" ++ (show i)) args))) ++ "\n)")
     update FunctionDefinitions $ \otherDefs => (fn ++ ";\n") :: otherDefs
 
     let argsVars = fromList $ ALocal <$> args
@@ -865,7 +865,7 @@ createCFunctions n (MkAForeign ccs fargs ret) = do
                       [lib, header] => update HeaderFiles $ insert header
                       _ => pure ()
              else emit EmptyFC $ additionalFFIStub fctName fargs ret
-          let fnDef = "Value *" ++ (cName n) ++ "(" ++ showSep ", " (replicate (length fargs) "Value *") ++ ");"
+          let fnDef = "Value *" ++ (cName n) ++ "(" ++ joinBy ", " (replicate (length fargs) "Value *") ++ ");"
           update FunctionDefinitions $ \otherDefs => (fnDef ++ "\n") :: otherDefs
           typeVarNameArgList <- createFFIArgList fargs
 
@@ -878,21 +878,21 @@ createCFunctions n (MkAForeign ccs fargs ret) = do
               CFIORes CFUnit => do
                   emit EmptyFC $ cName fctName
                               ++ "("
-                              ++ showSep ", " (map (\(_, vn, vt) => extractValue cLang vt vn) (discardLastArgument typeVarNameArgList))
+                              ++ joinBy ", " (map (\(_, vn, vt) => extractValue cLang vt vn) (discardLastArgument typeVarNameArgList))
                               ++ ");"
                   removeVarsArgList
                   emit EmptyFC "return NULL;"
               CFIORes ret => do
                   emit EmptyFC $ cTypeOfCFType ret ++ " retVal = " ++ cName fctName
                               ++ "("
-                              ++ showSep ", " (map (\(_, vn, vt) => extractValue cLang vt vn) (discardLastArgument typeVarNameArgList))
+                              ++ joinBy ", " (map (\(_, vn, vt) => extractValue cLang vt vn) (discardLastArgument typeVarNameArgList))
                               ++ ");"
                   removeVarsArgList
                   emit EmptyFC $ "return (Value*)" ++ packCFType ret "retVal" ++ ";"
               _ => do
                   emit EmptyFC $ cTypeOfCFType ret ++ " retVal = " ++ cName fctName
                               ++ "("
-                              ++ showSep ", " (map (\(_, vn, vt) => extractValue cLang vt vn) typeVarNameArgList)
+                              ++ joinBy ", " (map (\(_, vn, vt) => extractValue cLang vt vn) typeVarNameArgList)
                               ++ ");"
                   removeVarsArgList
                   emit EmptyFC $ "return (Value*)" ++ packCFType ret "retVal" ++ ";"
@@ -1005,6 +1005,8 @@ compileExpr ANF c s _ outputDir tm outfile =
      cdata <- getCompileData False ANF tm
      let defs = anf cdata
 
+     for_ defs $ \d => log "compiler.refc" 10 $ "compileExpr def: \{show d}"
+
      generateCSourceFile defs outn
      Just _ <- compileCObjectFile outn outobj
        | Nothing => pure Nothing
diff --git a/src/Compiler/Scheme/Chez.idr b/src/Compiler/Scheme/Chez.idr
index 467d76f303a..d3dd30b77b4 100644
--- a/src/Compiler/Scheme/Chez.idr
+++ b/src/Compiler/Scheme/Chez.idr
@@ -8,22 +8,22 @@ import Compiler.Scheme.Common
 
 import Core.Directory
 import Protocol.Hex
-import Libraries.Utils.Path
-import Libraries.Data.String.Builder
+
+import Idris.Env
+import Idris.Syntax
 
 import Data.Maybe
 import Data.SortedSet
 import Data.String
 
-import Idris.Env
-import Idris.Syntax
-
 import System
 import System.Directory
 import System.Info
 
 import Libraries.Data.Version
 import Libraries.Utils.String
+import Libraries.Utils.Path
+import Libraries.Data.String.Builder
 
 %default covering
 
@@ -93,7 +93,7 @@ schHeader chez libs whole
       [(i3nt ti3nt a6nt ta6nt) (load-shared-object "msvcrt.dll")]
       [else (load-shared-object "libc.so")])
 
-    \{ showSep "\n" (map (\x => "(load-shared-object \"" ++ escapeStringChez x ++ "\")") libs) }
+    \{ joinBy "\n" (map (\x => "(load-shared-object \"" ++ escapeStringChez x ++ "\")") libs) }
 
     \{ ifThenElse whole
                   "(let ()"
diff --git a/src/Compiler/Scheme/Common.idr b/src/Compiler/Scheme/Common.idr
index 6543af09990..7de517ab42b 100644
--- a/src/Compiler/Scheme/Common.idr
+++ b/src/Compiler/Scheme/Common.idr
@@ -11,6 +11,7 @@ import Compiler.CompileExpr
 import Core.Context
 
 import Libraries.Data.String.Builder
+import Data.SnocList
 
 import Data.SortedSet
 import Data.Vect
diff --git a/src/Compiler/Scheme/Racket.idr b/src/Compiler/Scheme/Racket.idr
index 9ee5537704b..c31c8d4a38f 100644
--- a/src/Compiler/Scheme/Racket.idr
+++ b/src/Compiler/Scheme/Racket.idr
@@ -8,20 +8,21 @@ import Compiler.Scheme.Common
 
 import Core.Directory
 import Protocol.Hex
-import Libraries.Data.String.Builder
-import Libraries.Utils.Path
+
+import Idris.Env
+import Idris.Syntax
 
 import Data.Maybe
 import Data.String
 import Data.SortedSet
 
-import Idris.Env
-import Idris.Syntax
-
 import System
 import System.Directory
 import System.Info
 
+import Libraries.Data.String.Builder
+import Libraries.Utils.Path
+
 %default covering
 
 findRacket : IO String
@@ -161,7 +162,7 @@ getLibVers libspec
                         (root, rest) => (root, "")
            (fn :: vers) =>
                (fst (span (/='.') fn),
-                  "'(" ++ showSep " " (map show vers) ++ " #f)" )
+                  "'(" ++ joinBy " " (map show vers) ++ " #f)" )
 
 cToRkt : CFType -> Builder -> Builder
 cToRkt CFChar op = "(integer->char " ++ op ++ ")"
diff --git a/src/Compiler/Separate.idr b/src/Compiler/Separate.idr
index f9f828b6198..71c63bf09ef 100644
--- a/src/Compiler/Separate.idr
+++ b/src/Compiler/Separate.idr
@@ -17,6 +17,7 @@ import Data.List
 import Data.List1
 import Data.Vect
 import Data.Maybe
+import Data.SnocList
 
 %default covering
 
@@ -150,9 +151,14 @@ mutual
     nsRefs (LErased fc) = SortedSet.empty
     nsRefs (LCrash fc msg) = SortedSet.empty
 
+  export
+  HasNamespaces (LiftedCaseScope vars) where
+    nsRefs (LRHS vars) = nsRefs vars
+    nsRefs (LArg n sc) = nsRefs sc
+
   export
   HasNamespaces (LiftedConAlt vars) where
-    nsRefs (MkLConAlt n ci tag args rhs) = nsRefs rhs
+    nsRefs (MkLConAlt n ci tag rhs) = nsRefs rhs
 
   export
   HasNamespaces (LiftedConstAlt vars) where
diff --git a/src/Compiler/VMCode.idr b/src/Compiler/VMCode.idr
index 0f9f7cdef71..6e530ba54fc 100644
--- a/src/Compiler/VMCode.idr
+++ b/src/Compiler/VMCode.idr
@@ -5,9 +5,11 @@ import Compiler.ANF
 import Core.CompileExpr
 import Core.TT
 
-import Libraries.Data.IntMap
 import Data.List
 import Data.Vect
+import Data.String
+
+import Libraries.Data.IntMap
 
 %default covering
 
@@ -73,21 +75,21 @@ Show VMInst where
   show (ASSIGN r v) = show r ++ " := " ++ show v
   show (MKCON r t args)
       = show r ++ " := MKCON " ++ show t ++ " (" ++
-                  showSep ", " (map show args) ++ ")"
+                  joinBy ", " (map show args) ++ ")"
   show (MKCLOSURE r n m args)
       = show r ++ " := MKCLOSURE " ++ show n ++ " " ++ show m ++ " (" ++
-                  showSep ", " (map show args) ++ ")"
+                  joinBy ", " (map show args) ++ ")"
   show (MKCONSTANT r c) = show r ++ " := MKCONSTANT " ++ show c
   show (APPLY r f a) = show r ++ " := " ++ show f ++ " @ " ++ show a
   show (CALL r t n args)
       = show r ++ " := " ++ (if t then "TAILCALL " else "CALL ") ++
-        show n ++ "(" ++ showSep ", " (map show args) ++ ")"
+        show n ++ "(" ++ joinBy ", " (map show args) ++ ")"
   show (OP r op args)
       = show r ++ " := " ++ "OP " ++
-        show op ++ "(" ++ showSep ", " (map show (toList args)) ++ ")"
+        show op ++ "(" ++ joinBy ", " (map show (toList args)) ++ ")"
   show (EXTPRIM r n args)
       = show r ++ " := " ++ "EXTPRIM " ++
-        show n ++ "(" ++ showSep ", " (map show args) ++ ")"
+        show n ++ "(" ++ joinBy ", " (map show args) ++ ")"
 
   show (CASE scr alts def)
       = "CASE " ++ show scr ++ " " ++ show alts ++ " {default: " ++ show def ++ "}"
diff --git a/src/Core/AutoSearch.idr b/src/Core/AutoSearch.idr
index 6668e69e074..06f5fc426f1 100644
--- a/src/Core/AutoSearch.idr
+++ b/src/Core/AutoSearch.idr
@@ -2,15 +2,21 @@ module Core.AutoSearch
 
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Convert
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Data.Either
 import Data.Maybe
+import Data.SnocList
 
 import Libraries.Data.NatSet
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
 import Libraries.Data.WithDefault
 
 %default covering
@@ -37,7 +43,7 @@ tryNoDefaultsFirst : {auto c : Ref Ctxt Defs} ->
 tryNoDefaultsFirst f = tryUnifyUnambig {preferLeftError=True} (f False) (f True)
 
 SearchEnv : Scoped
-SearchEnv vars = List (NF vars, Closure vars)
+SearchEnv vars = List (NF vars, Glued vars)
 
 searchType : {vars : _} ->
              {auto c : Ref Ctxt Defs} ->
@@ -54,10 +60,13 @@ record ArgInfo (vars : Scope) where
   constructor MkArgInfo
   holeID : Int
   argRig : RigCount
-  plicit : PiInfo (Closure vars)
-  metaApp : Term vars
+  plicit : PiInfo (Glued vars)
+  metaApp : (RigCount, Term vars)
   argType : Term vars
 
+{vars: _} -> Show (ArgInfo vars) where
+    show x = "{ArgInfo holeId: \{show $ holeID x}, argRig: \{show $ argRig x}, plicit: \{assert_total $ show $ plicit x}, metaApp: \{assert_total $ show $ metaApp x}, argType: \{assert_total $ show $ argType x}}"
+
 export
 mkArgs : {vars : _} ->
          {auto c : Ref Ctxt Defs} ->
@@ -65,18 +74,17 @@ mkArgs : {vars : _} ->
          FC -> RigCount ->
          Env Term vars -> NF vars ->
          Core (List (ArgInfo vars), NF vars)
-mkArgs fc rigc env (NBind nfc x (Pi fc' c p ty) sc)
+mkArgs fc rigc env (VBind nfc x (Pi fc' c p ty) sc)
     = do defs <- get Ctxt
-         empty <- clearDefs defs
          nm <- genName "sa"
-         argTy <- quote empty env ty
+         argTy <- quote env ty
          let argRig = rigMult rigc c
          (idx, arg) <- newMeta fc' argRig env nm argTy
                                (Hole (length env) (holeInit False)) False
+         argVal <- nf env arg
          setInvertible fc (Resolved idx)
-         (rest, restTy) <- mkArgs fc rigc env
-                              !(sc defs (toClosure defaultOpts env arg))
-         pure (MkArgInfo idx argRig p arg argTy :: rest, restTy)
+         (rest, restTy) <- mkArgs fc rigc env !(expand !(sc (pure argVal)))
+         pure (MkArgInfo idx argRig p (c, arg) argTy :: rest, restTy)
 mkArgs fc rigc env ty = pure ([], ty)
 
 export
@@ -110,17 +118,17 @@ searchIfHole fc defaults trying ispair (S depth) def top env arg
          let Hole _ _ = definition gdef
               | _ => pure () -- already solved
          top' <- if ispair
-                    then normaliseScope defs Env.empty (type gdef)
+                    then normaliseScope Env.empty (type gdef)
                     else pure top
 
          argdef <- searchType fc rig defaults trying depth def False top' env
-                              !(normaliseScope defs env (argType arg))
+                              !(normaliseScope env (argType arg))
          logTermNF "auto" 5 "Solved arg" env argdef
-         logTermNF "auto" 5 "Arg meta" env (metaApp arg)
-         ok <- solveIfUndefined env (metaApp arg) argdef
+         logTermNF "auto" 5 "Arg meta" env (snd $ metaApp arg)
+         ok <- solveIfUndefined env (snd $ metaApp arg) argdef
          if ok
             then pure ()
-            else do vs <- unify inTerm fc env (metaApp arg) argdef
+            else do vs <- unify inTerm fc env (snd $ metaApp arg) argdef
                     let [] = constraints vs
                         | _ => throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
                     pure ()
@@ -185,11 +193,11 @@ exactlyOne {vars} fc env top target all
                        commit
                        pure res
               [] => throw (CantSolveGoal fc (gamma !(get Ctxt)) Env.empty top Nothing)
-              rs => throw (AmbiguousSearch fc env !(quote !(get Ctxt) env target)
+              rs => throw (AmbiguousSearch fc env !(quote env target)
                              !(traverse normRes rs))
   where
     normRes : (Term vars, Defs, UState) -> Core (Term vars)
-    normRes (tm, defs, _) = normaliseHoles defs env tm
+    normRes (tm, defs, _) = normaliseHoles env tm
 
 -- We can only resolve things which are at unrestricted multiplicity. Expression
 -- search happens before linearity checking and we can't guarantee that just
@@ -200,17 +208,17 @@ getUsableEnv : FC -> RigCount ->
                SizeOf done ->
                Env Term vars ->
                -- TODO this will be `vars <>< done` after refactoring
-               List (Term (done ++ vars), Term (done ++ vars))
-getUsableEnv fc rigc p [] = []
-getUsableEnv {vars = v :: vs} {done} fc rigc p (b :: env)
-   = let rest = getUsableEnv fc rigc (sucR p) env in
+               List (Term (Scope.addInner vars done), Term (Scope.addInner vars done))
+getUsableEnv fc rigc p [<] = []
+getUsableEnv {vars = vs :< v} {done} fc rigc p (env :< b)
+   = let rest = getUsableEnv fc rigc (sucL p) env in
          if (multiplicity b == top || isErased rigc)
             then let 0 var = mkIsVar (hasLength p) in
                      (Local (binderLoc b) Nothing _ var,
-                       rewrite appendAssociative done (Scope.single v) vs in
-                          weakenNs (sucR p) (binderType b)) ::
-                               rewrite appendAssociative done (Scope.single v) vs in rest
-            else rewrite appendAssociative done (Scope.single v) vs in rest
+                       rewrite sym (appendAssociative vs (Scope.single v) done) in
+                          weakenNs (sucL p) (binderType b)) ::
+                               rewrite sym (appendAssociative vs (Scope.single v) done) in rest
+            else rewrite sym (appendAssociative vs (Scope.single v) done) in rest
 
 -- A local is usable if it contains no holes in a determining argument position
 usableLocal : {vars : _} ->
@@ -218,41 +226,37 @@ usableLocal : {vars : _} ->
               FC -> (defaults : Bool) ->
               Env Term vars -> (locTy : NF vars) -> Core Bool
 -- pattern variables count as concrete things!
-usableLocal loc defaults env (NApp fc (NMeta (PV {}) _ _) args)
+usableLocal loc defaults env (VMeta fc (PV {}) _ _ _ _)
     = pure True
-usableLocal loc defaults env (NApp fc (NMeta {}) args)
+usableLocal loc defaults env (VMeta {})
     = pure False
-usableLocal {vars} loc defaults env (NTCon _ n _ args)
+usableLocal {vars} loc defaults env (VTCon _ n _ args)
     = do sd <- getSearchData loc (not defaults) n
-         usableLocalArg 0 (detArgs sd) (map snd args)
+         usableLocalArg 0 (detArgs sd) (cast !(traverseSnocList value args))
   -- usable if none of the determining arguments of the local's type are
   -- holes
   where
-    usableLocalArg : Nat -> NatSet -> List (Closure vars) -> Core Bool
+    usableLocalArg : Nat -> NatSet -> List (Glued vars) -> Core Bool
     usableLocalArg i dets [] = pure True
-    usableLocalArg i dets (c :: cs)
+    usableLocalArg i dets (arg :: args)
         = if i `elem` dets
              then do defs <- get Ctxt
-                     u <- usableLocal loc defaults env !(evalClosure defs c)
+                     u <- usableLocal loc defaults env !(expand arg)
                      if u
-                        then usableLocalArg (1 + i) dets cs
+                        then usableLocalArg (1 + i) dets args
                         else pure False
-             else usableLocalArg (1 + i) dets cs
-usableLocal loc defaults env (NDCon _ n _ _ args)
-    = do defs <- get Ctxt
-         us <- traverse (usableLocal loc defaults env)
-                        !(traverse (evalClosure defs) $ map snd args)
+             else usableLocalArg (1 + i) dets args
+usableLocal loc defaults env (VDCon _ n _ _ args)
+    = do us <- traverseSnocList (usableLocal loc defaults env)
+                        !(traverseSnocList spineVal args)
          pure (all id us)
-usableLocal loc defaults env (NApp _ (NLocal {}) args)
-    = do defs <- get Ctxt
-         us <- traverse (usableLocal loc defaults env)
-                        !(traverse (evalClosure defs) $ map snd args)
+usableLocal loc defaults env (VLocal _ _ _ args)
+    = do us <- traverseSnocList (usableLocal loc defaults env)
+                        !(traverseSnocList spineVal args)
          pure (all id us)
-usableLocal loc defaults env (NBind fc x (Pi {}) sc)
-    = do defs <- get Ctxt
-         usableLocal loc defaults env
-                !(sc defs (toClosure defaultOpts env (Erased fc Placeholder)))
-usableLocal loc defaults env (NErased {}) = pure False
+usableLocal loc defaults env (VBind fc x (Pi {}) sc)
+    = usableLocal loc defaults env !(expand !(sc (pure (VErased fc Placeholder))))
+usableLocal loc defaults env (VErased {}) = pure False
 usableLocal loc _ _ _ = pure True
 
 searchLocalWith : {vars : _} ->
@@ -266,14 +270,13 @@ searchLocalWith : {vars : _} ->
                   (target : NF vars) -> Core (Term vars)
 searchLocalWith {vars} fc rigc defaults trying depth def top env (prf, ty) target
     = do defs <- get Ctxt
-         nty <- nf defs env ty
-         findPos defs pure nty target
+         findPos defs prf pure !(expand !(nf env ty)) target
   where
     clearEnvType : {idx : Nat} -> (0 p : IsVar nm idx vs) ->
                    FC -> Env Term vs -> Env Term vs
-    clearEnvType First fc (b :: env)
-        = Lam (binderLoc b) (multiplicity b) Explicit (Erased fc Placeholder) :: env
-    clearEnvType (Later p) fc (b :: env) = b :: clearEnvType p fc env
+    clearEnvType First fc (env :< b)
+        = env :< Lam (binderLoc b) (multiplicity b) Explicit (Erased fc Placeholder)
+    clearEnvType (Later p) fc (env :< b) = Env.bind (clearEnvType p fc env) b
 
     clearEnv : Term vars -> Env Term vars -> Env Term vars
     clearEnv (Local fc _ idx p) env
@@ -281,17 +284,21 @@ searchLocalWith {vars} fc rigc defaults trying depth def top env (prf, ty) targe
     clearEnv _ env = env
 
     findDirect : Defs ->
+                 Term vars ->
                  (Term vars -> Core (Term vars)) ->
                  NF vars ->  -- local's type
                  (target : NF vars) ->
                  Core (Term vars)
-    findDirect defs f ty target
+    findDirect defs p f ty target
         = do (args, appTy) <- mkArgs fc rigc env ty
+             log "auto" 10 $ "findDirect args" ++ show args
+             logNF "auto" 10 "findDirect appTy" env appTy
              fprf <- f prf
              logTermNF "auto" 10 "Trying" env fprf
              logNF "auto" 10 "Type" env ty
              logNF "auto" 10 "For target" env target
              ures <- unify inTerm fc env target appTy
+             log "auto" 10 $ "findDirect ures: " ++ show ures
              let [] = constraints ures
                  | _ => throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
              -- We can only use the local if its type is not an unsolved hole
@@ -311,12 +318,13 @@ searchLocalWith {vars} fc rigc defaults trying depth def top env (prf, ty) targe
                         throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
 
     findPos : Defs ->
+              Term vars ->
               (Term vars -> Core (Term vars)) ->
               NF vars ->  -- local's type
               (target : NF vars) ->
               Core (Term vars)
-    findPos defs f nty@(NTCon pfc pn _ [(_, xty), (_, yty)]) target
-        = tryUnifyUnambig (findDirect defs f nty target) $
+    findPos defs p f nty@(VTCon pfc pn _ [< MkSpineEntry _ xc xty, MkSpineEntry _ yc yty]) target
+        = tryUnifyUnambig (findDirect defs prf f nty target) $
              do fname <- maybe (throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing))
                                pure
                                !fstName
@@ -324,27 +332,30 @@ searchLocalWith {vars} fc rigc defaults trying depth def top env (prf, ty) targe
                                pure
                                !sndName
                 if !(isPairType pn)
-                   then do empty <- clearDefs defs
-                           xtytm <- quote empty env xty
-                           ytytm <- quote empty env yty
+                   then do xty' <- xty
+                           yty' <- yty
+                           xtytm <- quote env xty'
+                           ytytm <- quote env yty'
                            exactlyOne fc env top target
-                            [(do xtynf <- evalClosure defs xty
-                                 findPos defs
-                                     (\arg => normalise defs env $ apply fc (Ref fc Func fname)
-                                                        [xtytm,
-                                                         ytytm,
-                                                         !(f arg)])
+                            [(do xtynf <- expand xty'
+                                 findPos defs p
+                                     (\arg => normalise env $
+                                                apply fc (Ref fc Func fname)
+                                                         [(erased, xtytm),
+                                                          (erased, ytytm),
+                                                          (Preorder.top, !(f arg))])
                                      xtynf target),
-                             (do ytynf <- evalClosure defs yty
-                                 findPos defs
-                                     (\arg => normalise defs env $ apply fc (Ref fc Func sname)
-                                                        [xtytm,
-                                                         ytytm,
-                                                         !(f arg)])
+                             (do ytynf <- expand yty'
+                                 findPos defs p
+                                     (\arg => normalise env $
+                                                apply fc (Ref fc Func sname)
+                                                         [(erased, xtytm),
+                                                          (erased, ytytm),
+                                                          (Preorder.top, !(f arg))])
                                      ytynf target)]
                    else throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
-    findPos defs f nty target
-        = findDirect defs f nty target
+    findPos defs p f nty target
+        = findDirect defs p f nty target
 
 searchLocalVars : {vars : _} ->
                   {auto c : Ref Ctxt Defs} ->
@@ -362,12 +373,13 @@ searchLocalVars fc rig defaults trying depth def top env target
          exactlyOne fc env top target elabs
 
 isPairNF : {auto c : Ref Ctxt Defs} ->
-           Env Term vars -> NF vars -> Defs -> Core Bool
-isPairNF env (NTCon _ n _ _) defs
+           {vars: _} ->
+           Env Term vars -> NF vars -> Core Bool
+isPairNF env (VTCon _ n _ _)
     = isPairType n
-isPairNF env (NBind fc b (Pi {}) sc) defs
-    = isPairNF env !(sc defs (toClosure defaultOpts env (Erased fc Placeholder))) defs
-isPairNF _ _ _ = pure False
+isPairNF env (VBind fc b (Pi {}) sc)
+    = isPairNF env !(expand !(sc (pure (VErased fc Placeholder))))
+isPairNF _ _ = pure False
 
 searchName : {vars : _} ->
              {auto c : Ref Ctxt Defs} ->
@@ -389,15 +401,17 @@ searchName fc rigc defaults trying depth def top env target (n, ndef)
 
          let ty = type ndef
          when (isErased ty) $
-            throw (CantSolveGoal fc (gamma defs) [] top Nothing)
+            throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
 
-         nty <- nf defs env (embed ty)
-         logNF "auto" 10 ("Searching Name " ++ show n) env nty
+         nty <- expand !(nf env (embed ty))
+         logNF "auto" 10 ("Searching Name " ++ show !(toFullNames n)) env nty
+         logNF "auto" 10 "For target" env target
          (args, appTy) <- mkArgs fc rigc env nty
+         logNF "auto" 10 "appTy" env appTy
          ures <- unify inTerm fc env target appTy
          let [] = constraints ures
              | _ => throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
-         ispair <- isPairNF env nty defs
+         ispair <- isPairNF env nty
          let candidate = apply fc (Ref fc (getDefNameType ndef) n) (map metaApp args)
          logTermNF "auto" 10 "Candidate " env candidate
          -- Work right to left, because later arguments may solve earlier
@@ -437,69 +451,75 @@ searchNames fc rigc defaults trying depth defining topty env ambig (n :: ns) tar
 
 concreteDets : {vars : _} ->
                {auto c : Ref Ctxt Defs} ->
+               {auto u : Ref UST UState} ->
                FC -> Bool ->
                Env Term vars -> (top : ClosedTerm) ->
                (pos : Nat) -> (dets : NatSet) ->
-               (args : List (Closure vars)) ->
+               (args : List (Glued vars)) ->
                Core ()
 concreteDets fc defaults env top pos dets [] = pure ()
 concreteDets {vars} fc defaults env top pos dets (arg :: args)
     = do when (pos `elem` dets) $ do
-           defs <- get Ctxt
-           argnf <- evalClosure defs arg
+           argnf <- expand arg
            logNF "auto.determining" 10
              "Checking that the following argument is concrete"
              env argnf
-           concrete defs argnf True
+           concrete argnf True
          concreteDets fc defaults env top (1 + pos) dets args
   where
-    concrete : Defs -> NF vars -> (atTop : Bool) -> Core ()
-    concrete defs (NBind nfc x b sc) atTop
-        = do scnf <- sc defs (toClosure defaultOpts env (Erased nfc Placeholder))
-             concrete defs scnf False
-    concrete defs (NTCon nfc n a args) atTop
+    concrete : NF vars -> (atTop : Bool) -> Core ()
+    concrete (VBind nfc x b sc) atTop
+        = do scnf <- expand !(sc (pure (VErased nfc Placeholder)))
+             logDepth $ concrete scnf False
+    concrete (VTCon nfc n a args) atTop
         = do sd <- getSearchData nfc False n
-             let args' = NatSet.take (detArgs sd) args
-             traverse_ (\ parg => do argnf <- evalClosure defs parg
-                                     concrete defs argnf False) (map snd args')
-    concrete defs (NDCon nfc n t a args) atTop
-        = do traverse_ (\ parg => do argnf <- evalClosure defs parg
-                                     concrete defs argnf False) (map snd args)
-    concrete defs (NApp _ (NMeta n i _) _) True
-        = do Just (Hole _ b) <- lookupDefExact n (gamma defs)
+             let args' = NatSet.take (detArgs sd) (toList args)
+             traverse_ (\ parg => do argnf <- expand parg
+                                     logDepth $ concrete argnf False) !(traverse value args')
+    concrete (VDCon nfc n t a args) atTop
+        = do traverse_ (\ parg => do argnf <- expand parg
+                                     logDepth $ concrete argnf False)
+                       !(Core.Core.traverse value (toList args))
+    concrete (VMeta _ n i _ _ _) True
+        = do defs <- get Ctxt
+             Just (Hole _ b) <- lookupDefExact n (gamma defs)
                   | _ => throw (DeterminingArg fc n i Env.empty top)
              unless (implbind b) $
                   throw (DeterminingArg fc n i Env.empty top)
-    concrete defs (NApp _ (NMeta n i _) _) False
-        = do Just (Hole _ b) <- lookupDefExact n (gamma defs)
+    concrete (VMeta _ n i _ _ _) False
+        = do defs <- get Ctxt
+             Just (Hole _ b) <- lookupDefExact n (gamma defs)
                   | def => throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
              unless (implbind b) $
                   throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
-    concrete defs tm atTop = pure ()
+    concrete tm atTop = pure ()
 
 checkConcreteDets : {vars : _} ->
                     {auto c : Ref Ctxt Defs} ->
+                    {auto u : Ref UST UState} ->
                     FC -> Bool ->
                     Env Term vars -> (top : ClosedTerm) ->
                     NF vars ->
                     Core ()
-checkConcreteDets fc defaults env top (NTCon tfc tyn a args)
+checkConcreteDets fc defaults env top (VTCon tfc tyn a args)
     = do defs <- get Ctxt
          if !(isPairType tyn)
             then case args of
-                      [(_, aty), (_, bty)] =>
-                          do anf <- evalClosure defs aty
-                             bnf <- evalClosure defs bty
+                      [< MkSpineEntry _ _ aty, MkSpineEntry _ _ bty] =>
+                          do anf <- expand !aty
+                             bnf <- expand !bty
                              checkConcreteDets fc defaults env top anf
                              checkConcreteDets fc defaults env top bnf
                       _ => do sd <- getSearchData fc defaults tyn
-                              concreteDets fc defaults env top 0 (detArgs sd) (map snd args)
+                              concreteDets fc defaults env top 0 (detArgs sd)
+                                  (cast !(traverseSnocList value args))
             else
               do sd <- getSearchData fc defaults tyn
                  log "auto.determining" 10 $
                    "Determining arguments for " ++ show !(toFullNames tyn)
                    ++ " " ++ show (detArgs sd)
-                 concreteDets fc defaults env top 0 (detArgs sd) (map snd args)
+                 concreteDets fc defaults env top 0 (detArgs sd)
+                     (cast !(traverseSnocList value args))
 checkConcreteDets fc defaults env top _
     = pure ()
 
@@ -510,7 +530,7 @@ abandonIfCycle : {vars : _} ->
 abandonIfCycle env tm [] = pure ()
 abandonIfCycle env tm (ty :: tys)
     = do defs <- get Ctxt
-         if !(convert defs env tm ty)
+         if !(convert env tm ty)
             then throw (InternalError "Cycle in search")
             else abandonIfCycle env tm tys
 
@@ -518,33 +538,37 @@ abandonIfCycle env tm (ty :: tys)
 searchType fc rigc defaults trying depth def checkdets top env (Bind nfc x b@(Pi fc' c p ty) sc)
     = pure (Bind nfc x (Lam fc' c p ty)
              !(searchType fc rigc defaults [] depth def checkdets top
-                          (b :: env) sc))
+                          (Env.bind env b) sc))
 searchType fc rigc defaults trying depth def checkdets top env (Bind nfc x b@(Let fc' c val ty) sc)
     = pure (Bind nfc x b
              !(searchType fc rigc defaults [] depth def checkdets top
-                          (b :: env) sc))
+                          (Env.bind env b) sc))
 searchType {vars} fc rigc defaults trying depth def checkdets top env target
     = do defs <- get Ctxt
          abandonIfCycle env target trying
          let trying' = target :: trying
-         nty <- nf defs env target
+         nty <- expand !(nf env target)
+         logDepth $ logNF "auto" 3 "searchType-3 nty" env nty
          case nty of
-              NTCon tfc tyn a args =>
+              VTCon tfc tyn a args =>
                   if a == length args
-                     then do logNF "auto" 10 "Next target" env nty
+                     then do logNF "auto" 10 "Next target NTCon" env nty
                              sd <- getSearchData fc defaults tyn
+                             log "auto" 10 $ "Next target NTCon search result detArgs: " ++ show (detArgs sd) ++ ", hintGroups: " ++ show !(traverse (\(x, y) => pure (x, !(Core.Core.traverse toFullNames y))) (hintGroups sd))
                              -- Check determining arguments are okay for 'args'
                              when checkdets $
                                  checkConcreteDets fc defaults env top
-                                                   (NTCon tfc tyn a args)
+                                                   (VTCon tfc tyn a args)
                              if defaults && checkdets
                                 then tryGroups Nothing nty (hintGroups sd)
                                 else tryUnifyUnambig
                                        (searchLocalVars fc rigc defaults trying' depth def top env nty)
                                        (tryGroups Nothing nty (hintGroups sd))
                      else throw (CantSolveGoal fc (gamma defs) Env.empty top Nothing)
-              _ => do logNF "auto" 10 "Next target: " env nty
-                      searchLocalVars fc rigc defaults trying' depth def top env nty
+              _ => do logNF "auto" 10 "Next target other: " env nty
+                      result <- searchLocalVars fc rigc defaults trying' depth def top env nty
+                      logTerm "auto" 10 "Next target other result" result
+                      pure result
   where
     -- Take the earliest error message (that's when we look inside pairs,
     -- typically, and it's best to be more precise)
@@ -572,9 +596,9 @@ searchType {vars} fc rigc defaults trying depth def checkdets top env target
 --          (defining : Name) -> (topTy : Term vars) -> Env Term vars ->
 --          Core (Term vars)
 Core.Unify.search fc rigc defaults depth def top env
-    = do logTermNF "auto" 3 "Initial target: " env top
-         log "auto" 3 $ "Running search with defaults " ++ show defaults
-         tm <- searchType fc rigc defaults [] depth def
+    = do log "auto" 3 $ "Running search with defaults " ++ show defaults
+         logDepth $ logTermNF "auto" 3 "Initial target: " env top
+         tm <- logDepth $ searchType fc rigc defaults [] depth def
                           True (abstractEnvType fc env top) env
                           top
          logTermNF "auto" 3 "Result" env tm
diff --git a/src/Core/Binary.idr b/src/Core/Binary.idr
index 002559cd55b..4943fef9401 100644
--- a/src/Core/Binary.idr
+++ b/src/Core/Binary.idr
@@ -58,17 +58,6 @@ record TTCFile extra where
   foreignExports : List (Name, (List (String, String)))
   extraData : extra
 
-HasNames a => HasNames (List a) where
-  full c ns = full_aux c [] ns
-    where full_aux : Context -> List a -> List a -> Core (List a)
-          full_aux c res [] = pure (reverse res)
-          full_aux c res (n :: ns) = full_aux c (!(full c n):: res) ns
-
-
-  resolved c ns = resolved_aux c [] ns
-    where resolved_aux : Context -> List a -> List a -> Core (List a)
-          resolved_aux c res [] = pure (reverse res)
-          resolved_aux c res (n :: ns) = resolved_aux c (!(resolved c n) :: res) ns
 HasNames (Int, FC, Name) where
   full c (i, fc, n) = pure (i, fc, !(full c n))
   resolved c (i, fc, n) = pure (i, fc, !(resolved c n))
@@ -276,12 +265,10 @@ getSaveDefs modns (n :: ns) acc defs
     = do Just gdef <- lookupCtxtExact n (gamma defs)
               | Nothing => getSaveDefs modns ns acc defs -- 'n' really should exist though!
          -- No need to save builtins
-         case definition gdef of
-              Builtin _ => getSaveDefs modns ns acc defs
-              _ => do bin <- initBinaryS 16384
-                      toBuf (trimNS modns !(full (gamma defs) gdef))
-                      b <- get Bin
-                      getSaveDefs modns ns ((trimName (fullname gdef), b) :: acc) defs
+         bin <- initBinaryS 16384
+         toBuf (trimNS modns !(full (gamma defs) gdef))
+         b <- get Bin
+         getSaveDefs modns ns ((trimName (fullname gdef), b) :: acc) defs
   where
     trimName : Name -> Name
     trimName n@(NS defns d) = if defns == modns then d else n
diff --git a/src/Core/Case/CaseBuilder.idr b/src/Core/Case/CaseBuilder.idr
index cb88ae857cc..9c96e4fae5e 100644
--- a/src/Core/Case/CaseBuilder.idr
+++ b/src/Core/Case/CaseBuilder.idr
@@ -4,27 +4,32 @@ import Core.Case.CaseTree
 import Core.Case.Util
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
 import Core.Options
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.Pretty.Annotations
 
 import Data.DPair
-import Data.List.Quantifiers
+import Data.SnocList.Quantifiers
 import Data.SortedSet
 import Data.String
 import Data.Vect
-import Libraries.Data.IMaybe
-import Libraries.Data.List.SizeOf
+import Data.List.HasLength
+
 import Libraries.Data.List.LengthMatch
 import Libraries.Data.List01
 import Libraries.Data.List01.Quantifiers
+import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.Quantifiers.Extra as Lib
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Text.PrettyPrint.Prettyprinter
 
 import Decidable.Equality
 
-import Libraries.Text.PrettyPrint.Prettyprinter
-
 %default covering
 
 %hide Symbols.equals
@@ -64,6 +69,7 @@ record PatInfo (pvar : Name) (vars : Scope) where
   constructor MkInfo
   {idx : Nat}
   {name : Name}
+  multiplicity : RigCount -- Cached for using in the 'Case' block
   pat : Pat
   0 loc : IsVar name idx vars
   argType : ArgType vars -- Type of the argument being inspected (i.e.
@@ -74,15 +80,15 @@ covering
   show pi = show (pat pi) ++ " : " ++ show (argType pi)
 
 HasNames (PatInfo n vars) where
-  full gam (MkInfo pat loc argType)
+  full gam (MkInfo c pat loc argType)
      = do pat <- full gam pat
           argType <- full gam argType
-          pure $ MkInfo pat loc argType
+          pure $ MkInfo c pat loc argType
 
-  resolved gam (MkInfo pat loc argType)
+  resolved gam (MkInfo c pat loc argType)
      = do pat <- resolved gam pat
           argType <- resolved gam argType
-          pure $ MkInfo pat loc argType
+          pure $ MkInfo c pat loc argType
 
 {-
 NamedPats is a list of patterns on the LHS of a clause. Each entry in
@@ -95,7 +101,17 @@ NamedPats always have the same 'Elem' proof, though this isn't expressed in
 a type anywhere.
 -}
 
-data NamedPats : List Name -> -- the pattern variables still to process, in order
+-- TODO: All
+-- NamedPats : List Name -> -- the pattern variables still to process,
+--                          -- in order
+--             Scoped
+-- NamedPats vars
+--   = All (\pvar => PatInfo pvar vars)
+--                -- ^ a pattern, where its variable appears in the vars list,
+--                -- and its type. The type has no variable names; any names it
+--                -- refers to are explicit
+data NamedPats : List Name -> -- the pattern variables still to process,
+                              -- in order
                  Scoped where
      Nil : NamedPats [] vars
      (::) : PatInfo pvar vars ->
@@ -113,20 +129,21 @@ updatePats : {vars, todo : _} ->
              Env Term vars ->
              NF vars -> NamedPats todo vars -> Core (NamedPats todo vars)
 updatePats env nf [] = pure []
-updatePats {todo = pvar :: ns} env (NBind fc _ (Pi _ c _ farg) fsc) (p :: ps)
+updatePats {todo = pvar :: ns} env (VBind fc _ (Pi _ c _ farg) fsc) (p :: ps)
   = case argType p of
          Unknown =>
             do defs <- get Ctxt
                empty <- clearDefs defs
-               pure ({ argType := Known c !(quote empty env farg) } p
-                          :: !(updatePats env !(fsc defs (toClosure defaultOpts env (Ref fc Bound pvar))) ps))
+               fsc' <- expand !(fsc (pure (vRef fc Bound pvar)))
+               pure ({ argType := Known c !(quote env farg) } p
+                          :: !(updatePats env fsc' ps))
          _ => pure (p :: ps)
 updatePats env nf (p :: ps)
   = case argType p of
          Unknown =>
             do defs <- get Ctxt
                empty <- clearDefs defs
-               pure ({ argType := Stuck !(quote empty env nf) } p :: ps)
+               pure ({ argType := Stuck !(quote env nf) } p :: ps)
          _ => pure (p :: ps)
 
 substInPatInfo : {pvar, vars, todo : _} ->
@@ -134,26 +151,34 @@ substInPatInfo : {pvar, vars, todo : _} ->
                  FC -> Name -> Term vars -> PatInfo pvar vars ->
                  NamedPats todo vars ->
                  Core (PatInfo pvar vars, NamedPats todo vars)
-substInPatInfo fc n tm p ps
+substInPatInfo {pvar} {vars} fc n tm p ps
     = case argType p of
            Known c ty =>
                 do defs <- get Ctxt
-                   tynf <- nf defs (mkEnv fc vars) ty
+                   logTerm "compile.casetree" 25 "substInPatInfo-Known-tm" tm
+                   logTerm "compile.casetree" 25 "substInPatInfo-Known-ty" ty
+                   log "compile.casetree" 25 $ "n: " ++ show n
+                   -- let env = mkEnv fc vars
+                   --  logEnvRev "compile.casetree" 25 "substInPatInfo env" env
+                   tynf <- nf (mkEnv fc _) ty
                    case tynf of
-                        NApp {} =>
-                           pure ({ argType := Known c (substName n tm ty) } p, ps)
+                        VApp{} =>
+                           pure ({ argType := Known c (substName zero n tm ty) } p, ps)
+                        VMeta{} =>
+                           pure ({ argType := Known c (substName zero n tm ty) } p, ps)
+                        VLocal{} =>
+                           pure ({ argType := Known c (substName zero n tm ty) } p, ps)
                         -- Got a concrete type, and that's all we need, so stop
                         _ => pure (p, ps)
            Stuck fty =>
              do defs <- get Ctxt
                 empty <- clearDefs defs
                 let env = mkEnv fc vars
-                case !(nf defs env (substName n tm fty)) of
-                     NBind pfc _ (Pi _ c _ farg) fsc =>
-                       pure ({ argType := Known c !(quote empty env farg) } p,
-                                 !(updatePats env
-                                       !(fsc defs (toClosure defaultOpts env
-                                             (Ref pfc Bound pvar))) ps))
+                case !(nf env (substName zero n tm fty)) of
+                     VBind pfc _ (Pi _ c _ farg) fsc =>
+                       do fsc' <- expand !(fsc (pure (vRef pfc Bound pvar)))
+                          pure ({ argType := Known c !(quote env farg) } p,
+                                 !(updatePats env fsc' ps))
                      _ => pure (p, ps)
            Unknown => pure (p, ps)
 
@@ -169,13 +194,13 @@ substInPats fc n tm (p :: ps)
          pure (p' :: !(substInPats fc n tm ps'))
 
 getPat : {idx : Nat} ->
-         (0 el : IsVar nm idx ps) -> NamedPats ps ns -> PatInfo nm ns
+         (0 el : IsVarL nm idx ps) -> NamedPats ps ns -> PatInfo nm ns
 getPat First (x :: xs) = x
 getPat (Later p) (x :: xs) = getPat p xs
 
 dropPat : {idx : Nat} ->
-          (0 el : IsVar nm idx ps) ->
-          NamedPats ps ns -> NamedPats (dropIsVar ps el) ns
+          (0 el : IsVarL nm idx ps) ->
+          NamedPats ps ns -> NamedPats (dropIsVarL ps el) ns
 dropPat First (x :: xs) = xs
 dropPat (Later p) (x :: xs) = x :: dropPat p xs
 
@@ -216,8 +241,13 @@ Weaken ArgType where
   weakenNs s (Stuck fty) = Stuck (weakenNs s fty)
   weakenNs s Unknown = Unknown
 
+GenWeaken ArgType where
+  genWeakenNs p q Unknown = Unknown
+  genWeakenNs p q (Known c ty) = Known c $ genWeakenNs p q ty
+  genWeakenNs p q (Stuck fty) = Stuck $ genWeakenNs p q fty
+
 Weaken (PatInfo p) where
-  weakenNs s (MkInfo p el fty) = MkInfo p (weakenIsVar s el) (weakenNs s fty)
+  weaken (MkInfo c p el fty) = MkInfo c p (Later el) (weaken fty)
 
 Weaken (NamedPats todo) where
   weaken [] = []
@@ -226,6 +256,27 @@ Weaken (NamedPats todo) where
   weakenNs ns [] = []
   weakenNs ns (p :: ps) = weakenNs ns p :: weakenNs ns ps
 
+FreelyEmbeddable (PatInfo p) where
+
+FreelyEmbeddable (NamedPats todo) where
+  embed [] = []
+  embed (x :: xs) = embed x :: embed xs
+
+FreelyEmbeddable ArgType where
+  embed Unknown = Unknown
+  embed (Stuck t) = Stuck (embed t)
+  embed (Known c t) = Known c (embed t)
+
+GenWeaken (PatInfo p) where
+  genWeakenNs p q (MkInfo c pat loc at) = do
+    let MkNVar loc' = genWeakenNs p q $ MkNVar loc
+    let at' = genWeakenNs p q at
+    MkInfo c pat loc' at'
+
+GenWeaken (NamedPats todo) where
+  genWeakenNs p q [] = []
+  genWeakenNs p q  (pi :: np) = genWeakenNs p q pi :: genWeakenNs p q np
+
 (++) : NamedPats ms vars -> NamedPats ns vars -> NamedPats (ms ++ ns) vars
 (++) [] ys = ys
 (++) (x :: xs) ys = x :: xs ++ ys
@@ -233,71 +284,119 @@ Weaken (NamedPats todo) where
 tail : NamedPats (p :: ps) vars -> NamedPats ps vars
 tail (x :: xs) = xs
 
+-- If a pattern variable appears more than once, it means there will be some
+-- forced equalities between variables bound in case branches, so record the
+-- equalities as we go
+record PMappings vars where
+  constructor MkPMappings
+  pvars : List (Name, Var vars) -- What each pattern variable matched
+  pforced : List (Var vars, Term vars) -- Forced equalities
+
+Weaken PMappings where
+  weakenNs s
+      = { pvars $= map (\ (n, t) => (n, weakenNs s t)),
+          pforced $= map (\ (l, r) => (weakenNs s l, weakenNs s r)) }
+
+-- Substitute all the pattern variables into the right terms in the forced
+-- equalities
+substForced : List (Name, Var vars) -> List (Var vars, Term vars) ->
+              List (Var vars, Term vars)
+substForced [] eqs = eqs
+substForced ((n, MkVar v) :: ns) eqs
+    = let eqs' = map (substInForced n (Local EmptyFC Nothing _ v)) eqs in
+          substForced ns eqs'
+  where
+    substInForced : Name -> Term vars -> (Var vars, Term vars) ->
+                    (Var vars, Term vars)
+    substInForced n ptm (v, tm) = (v, substName zero n ptm tm)
+
+covering
+{vars : _} -> Show (PMappings vars) where
+  show pmaps
+      = "Pattern variables: " ++ joinBy ", " (map showPVar (pvars pmaps)) ++ "\t" ++
+        "Forced equalities: " ++ joinBy ", " (map showForced (pforced pmaps))
+    where
+      showPVar : (Name, Var vars) -> String
+      showPVar (n, MkVar v) = show n ++ ": " ++ show (Local EmptyFC Nothing _ v)
+
+      showForced : (Var vars, Term vars) -> String
+      showForced (MkVar v, tm) = show (Local EmptyFC Nothing _ v) ++ " = " ++ show tm
+
+HasNames (PMappings vars) where
+  full gam (MkPMappings pvars pforced)
+     = pure $ MkPMappings pvars
+                  !(traverse (\ (n, t) => pure (n, !(full gam t))) pforced)
+  resolved gam (MkPMappings pvars pforced)
+     = pure $ MkPMappings pvars
+                  !(traverse (\ (n, t) => pure (n, !(resolved gam t))) pforced)
+
+initPMap : PMappings vars
+initPMap = MkPMappings [] []
+
 data PatClause : (todo : List Name) -> Scoped where
      MkPatClause : List Name -> -- names matched so far (from original lhs)
+                   PMappings vars ->
                    NamedPats todo vars ->
                    Int -> (rhs : Term vars) -> PatClause todo vars
 
 getNPs : PatClause todo vars -> NamedPats todo vars
-getNPs (MkPatClause _ lhs pid rhs) = lhs
+getNPs (MkPatClause _ _ lhs pid rhs) = lhs
 
 covering
 {vars : _} -> {todo : _} -> Show (PatClause todo vars) where
-  show (MkPatClause _ ps pid rhs)
-     = show ps ++ " => " ++ show rhs
+  show (MkPatClause _ pmaps ps pid rhs)
+     = show ps ++ " => " ++ show pmaps ++ " " ++ show rhs
 
 {vars : _} -> {todo : _} -> Pretty IdrisSyntax (PatClause todo vars) where
-  pretty (MkPatClause _ ps _ rhs)
+  pretty (MkPatClause _ _ ps _ rhs)
      = pretty ps <++> fatArrow <++> byShow rhs
 
 HasNames (PatClause todo vars) where
-  full gam (MkPatClause ns nps i rhs)
-     = [| MkPatClause (traverse (full gam) ns) (full gam nps) (pure i) (full gam rhs) |]
-
-  resolved gam (MkPatClause ns nps i rhs)
-     = [| MkPatClause (traverse (resolved gam) ns) (resolved gam nps) (pure i) (resolved gam rhs) |]
+  full gam (MkPatClause ns pmaps nps i rhs)
+     = [| MkPatClause (traverse (full gam) ns)
+                      (full gam pmaps)
+                      (full gam nps) (pure i) (full gam rhs) |]
 
-0 IsConClause : PatClause (a :: todo) vars -> Type
-IsConClause (MkPatClause _ (MkInfo pat _ _ :: _) _ _) = IsConPat pat
+  resolved gam (MkPatClause ns pmaps nps i rhs)
+     = [| MkPatClause (traverse (resolved gam) ns)
+                      (resolved gam pmaps)
+                      (resolved gam nps) (pure i) (resolved gam rhs) |]
 
 substInClause : {a, vars, todo : _} ->
                 {auto c : Ref Ctxt Defs} ->
-                FC -> Subset (PatClause (a :: todo) vars) IsConClause ->
-                Core (Subset (PatClause (a :: todo) vars) IsConClause)
-substInClause fc (Element (MkPatClause pvars (MkInfo pat pprf fty :: pats) pid rhs) isCons)
-    = do pats' <- substInPats fc a (mkTerm vars pat) pats
-         pure $ Element (MkPatClause pvars (MkInfo pat pprf fty :: pats') pid rhs) isCons
-
-data Partitions : List01 ne (PatClause (a :: todo) vars) -> Type where
-     ConClauses : {a, todo, vars : _} ->
-                  {ps : List01 ne   (PatClause (a :: todo) vars)} ->
-                  (cs : List01 True (PatClause (a :: todo) vars )) ->
-                  (0 isCons : All IsConClause cs) =>
+                FC -> PatClause (a :: todo) vars ->
+                Core (PatClause (a :: todo) vars)
+substInClause {vars} {a} fc (MkPatClause pvars pmaps (MkInfo c pat pprf fty :: pats) pid rhs)
+    = do let tm = mkTerm vars pat
+         log "compile.casetree.subst" 50 "Substituting \{show tm} for \{show a} in \{show pat}"
+         pats' <- substInPats fc a tm pats
+         pure (MkPatClause pvars pmaps (MkInfo c pat pprf fty :: pats') pid rhs)
+
+data Partitions : List (PatClause todo vars) -> Type where
+     ConClauses : {todo, vars, ps : _} ->
+                  (cs : List (PatClause todo vars)) ->
                   Partitions ps -> Partitions (cs ++ ps)
-     VarClauses : {a, todo, vars : _} ->
-                  {ps : List01 ne   (PatClause (a :: todo) vars)} ->
-                  (vs : List01 True (PatClause (a :: todo) vars)) ->
+     VarClauses : {todo, vars, ps : _} ->
+                  (vs : List (PatClause todo vars)) ->
                   Partitions ps -> Partitions (vs ++ ps)
      NoClauses : Partitions []
 
 covering
 {ps : _} -> Show (Partitions ps) where
   show (ConClauses cs rest)
-    = unlines ("CON" :: map (("  " ++) . show) (forget cs))
+    = unlines ("CON" :: map (("  " ++) . show) cs)
     ++ "\n, " ++ show rest
   show (VarClauses vs rest)
-    = unlines ("VAR" :: map (("  " ++) . show) (forget vs))
+    = unlines ("VAR" :: map (("  " ++) . show) vs)
     ++ "\n, " ++ show rest
   show NoClauses = "NONE"
 
-data ClauseType : PatClause (a :: todo) vars -> Type where
-     ConClause : (0 isCon : IsConClause p) => ClauseType p
-     VarClause : ClauseType p
+data ClauseType = ConClause | VarClause
 
 namesIn : List Name -> Pat -> Bool
 namesIn pvars (PAs _ n p) = (n `elem` pvars) && namesIn pvars p
-namesIn pvars (PCon _ _ _ _ ps) = all (namesIn pvars) ps
-namesIn pvars (PTyCon _ _ _ ps) = all (namesIn pvars) ps
+namesIn pvars (PCon _ _ _ _ ps) = all (namesIn pvars) (map snd ps)
+namesIn pvars (PTyCon _ _ _ ps) = all (namesIn pvars) (map snd ps)
 namesIn pvars (PArrow _ _ s t) = namesIn pvars s && namesIn pvars t
 namesIn pvars (PDelay _ _ t p) = namesIn pvars t && namesIn pvars p
 namesIn pvars (PLoc _ n) = n `elem` pvars
@@ -305,61 +404,62 @@ namesIn pvars _ = True
 
 namesFrom : Pat -> List Name
 namesFrom (PAs _ n p) = n :: namesFrom p
-namesFrom (PCon _ _ _ _ ps) = concatMap namesFrom ps
-namesFrom (PTyCon _ _ _ ps) = concatMap namesFrom ps
+namesFrom (PCon _ _ _ _ ps) = concatMap namesFrom (map snd ps)
+namesFrom (PTyCon _ _ _ ps) = concatMap namesFrom (map snd ps)
 namesFrom (PArrow _ _ s t) = namesFrom s ++ namesFrom t
 namesFrom (PDelay _ _ t p) = namesFrom t ++ namesFrom p
 namesFrom (PLoc _ n) = [n]
 namesFrom _ = []
 
-clauseType : Phase -> (p : PatClause (a :: as) vars) -> ClauseType p
+clauseType : Phase -> PatClause (a :: as) vars -> ClauseType
 -- If it's irrelevant, a constructor, and there's no names we haven't seen yet
 -- and don't see later, treat it as a variable
 -- Or, if we're compiling for runtime we won't be able to split on it, so
 -- also treat it as a variable
 -- Or, if it's an under-applied constructor then do NOT attempt to split on it!
-clauseType phase (MkPatClause pvars (MkInfo arg _ ty :: rest) pid rhs)
-    = maybe VarClause (\isCon => ConClause @{isCon}) $ getClauseType phase arg ty
+clauseType phase (MkPatClause pvars pmaps (MkInfo _ arg _ ty :: rest) pid rhs)
+    = getClauseType phase arg ty
   where
     -- used when we are tempted to split on a constructor: is
     -- this actually a fully applied one?
-    splitCon : Nat -> List Pat -> Maybe (So True)
-    splitCon arity xs = toMaybe (arity == length xs) Oh
+    splitCon : Nat -> SnocList (RigCount, Pat) -> ClauseType
+    splitCon arity xs
+      = if arity == length xs then ConClause else VarClause
 
     -- used to get the remaining clause types
-    clauseType' : (p : Pat) -> Maybe (IsConPat p)
+    clauseType' : Pat -> ClauseType
     clauseType' (PCon _ _ _ a xs) = splitCon a xs
     clauseType' (PTyCon _ _ a xs) = splitCon a xs
-    clauseType' (PConst _ x)      = Just Oh
-    clauseType' (PArrow _ _ s t)  = Just Oh
-    clauseType' (PDelay {})       = Just Oh
-    clauseType' _                 = Nothing
+    clauseType' (PConst _ x)      = ConClause
+    clauseType' (PArrow _ _ s t)  = ConClause
+    clauseType' (PDelay _ _ _ _)  = ConClause
+    clauseType' _                 = VarClause
 
-    getClauseType : Phase -> (p : Pat) -> ArgType vars -> Maybe (IsConPat p)
+    getClauseType : Phase -> Pat -> ArgType vars -> ClauseType
     getClauseType (CompileTime cr) (PCon _ _ _ a xs) (Known r t)
         = if (isErased r && not (isErased cr) &&
-             all (namesIn (pvars ++ concatMap namesFrom (getPatInfo rest))) xs)
-             then Nothing
+             all (namesIn (pvars ++ concatMap namesFrom (getPatInfo rest))) (map snd xs))
+             then VarClause
              else splitCon a xs
     getClauseType phase (PAs _ _ p) t = getClauseType phase p t
     getClauseType phase l (Known r t) = if isErased r
-      then Nothing
+      then VarClause
       else clauseType' l
     getClauseType phase l _ = clauseType' l
 
 partition : {a, as, vars : _} ->
-            Phase -> (ps : List01 ne (PatClause (a :: as) vars)) -> Partitions ps
+            Phase -> (ps : List (PatClause (a :: as) vars)) -> Partitions ps
 partition phase [] = NoClauses
 partition phase (x :: xs) with (partition phase xs)
-  partition phase (x :: .(cs ++ ps)) | (ConClauses cs rest)
+  partition phase (x :: (cs ++ ps)) | (ConClauses cs rest)
         = case clauseType phase x of
                ConClause => ConClauses (x :: cs) rest
                VarClause => VarClauses [x] (ConClauses cs rest)
-  partition phase (x :: .(vs ++ ps)) | (VarClauses vs rest)
+  partition phase (x :: (vs ++ ps)) | (VarClauses vs rest)
         = case clauseType phase x of
                ConClause => ConClauses [x] (VarClauses vs rest)
                VarClause => VarClauses (x :: vs) rest
-  partition phase [x] | NoClauses
+  partition phase (x :: []) | NoClauses
         = case clauseType phase x of
                ConClause => ConClauses [x] NoClauses
                VarClause => VarClauses [x] NoClauses
@@ -373,43 +473,45 @@ data Group : List Name -> -- pattern variables still to process
              Scoped where
      ConGroup : {newargs : _} ->
                 Name -> (tag : Int) ->
-                List01 True (PatClause (newargs ++ todo) (newargs ++ vars)) ->
+                List RigCount -> -- Cached from constructor type
+                List (PatClause (newargs ++ todo) (vars <>< newargs)) ->
                 Group todo vars
      DelayGroup : {tyarg, valarg : _} ->
-                  List01 True (PatClause (tyarg :: valarg :: todo)
-                                         (tyarg :: valarg :: vars)) ->
+                  List (PatClause (tyarg :: valarg :: todo)
+                                  (vars :< tyarg :< valarg)) ->
                   Group todo vars
-     ConstGroup : Constant -> List01 True (PatClause todo vars) ->
+     ConstGroup : Constant -> List (PatClause todo vars) ->
                   Group todo vars
 
 covering
 {vars : _} -> {todo : _} -> Show (Group todo vars) where
-  show (ConGroup c t cs) = "Con " ++ show c ++ ": " ++ show cs
+  show (ConGroup c t _ cs) = "Con " ++ show c ++ ": " ++ show cs
   show (DelayGroup cs) = "Delay: " ++ show cs
   show (ConstGroup c cs) = "Const " ++ show c ++ ": " ++ show cs
 
-data GroupMatch : ConType -> List Pat -> Group todo vars -> Type where
-     ConMatch : {tag : Int} -> LengthMatch ps newargs ->
-                GroupMatch (CName n tag) ps
-                  (ConGroup {newargs} n tag (MkPatClause pvs pats pid rhs :: rest))
-     DelayMatch : GroupMatch CDelay []
-                    (DelayGroup {tyarg} {valarg} (MkPatClause pvs pats pid rhs :: rest))
-     ConstMatch : GroupMatch (CConst c) []
-                    (ConstGroup c (MkPatClause pvs pats pid rhs :: rest))
-     NoMatch : GroupMatch ct ps g
-
-checkGroupMatch : (c : ConType) -> (ps : List Pat) -> (g : Group todo vars) ->
+data GroupMatch : ConType -> List (RigCount, Pat) -> Group todo vars -> Type where
+  ConMatch : {tag : Int} -> (0 _ : LengthMatch ps newargs) ->
+             GroupMatch (CName n tag) ps
+               (ConGroup {newargs} n tag rigs (MkPatClause pvs pmaps pats pid rhs :: rest))
+  DelayMatch : GroupMatch CDelay []
+               (DelayGroup {tyarg} {valarg} (MkPatClause pvs pmaps pats pid rhs :: rest))
+  ConstMatch : GroupMatch (CConst c) []
+                  (ConstGroup c (MkPatClause pvs pmaps pats pid rhs :: rest))
+  NoMatch : GroupMatch ct ps g
+
+checkGroupMatch : (c : ConType) -> (ps : List (RigCount, Pat)) -> (g : Group todo vars) ->
                   GroupMatch c ps g
-checkGroupMatch (CName x tag) ps (ConGroup {newargs} x' tag' (MkPatClause pvs pats pid rhs :: rest))
+checkGroupMatch (CName x tag) ps (ConGroup {newargs} x' tag' rigs
+                                           (MkPatClause pvs pmaps pats pid rhs :: rest))
     = case checkLengthMatch ps newargs of
            Nothing => NoMatch
            Just prf => case (nameEq x x', decEq tag tag') of
                             (Just Refl, Yes Refl) => ConMatch prf
                             _ => NoMatch
 checkGroupMatch (CName x tag) ps _ = NoMatch
-checkGroupMatch CDelay [] (DelayGroup (MkPatClause pvs pats pid rhs :: rest))
+checkGroupMatch CDelay [] (DelayGroup (MkPatClause pvs pmaps pats pid rhs :: rest))
     = DelayMatch
-checkGroupMatch (CConst c) [] (ConstGroup c' (MkPatClause pvs pats pid rhs :: rest))
+checkGroupMatch (CConst c) [] (ConstGroup c' (MkPatClause pvs pmaps pats pid rhs :: rest))
     = case constantEq c c' of
            Nothing => NoMatch
            Just Refl => ConstMatch
@@ -424,44 +526,59 @@ nextName root
          put PName (x + 1)
          pure (MN root x)
 
+getArgTys : {vars : _} ->
+            {auto c : Ref Ctxt Defs} ->
+            Env Term vars -> List Name -> NF vars -> Core (List (ArgType vars))
+getArgTys env (n :: ns) (VBind pfc _ (Pi _ c _ farg) fsc)
+    = do rest <- getArgTys env ns !(expand !(fsc (pure (vRef pfc Bound n))))
+         pure (Known c !(quote env farg) :: rest)
+getArgTys env (n :: ns) t
+      -- pad with 'Unknown' so we have the right arity
+    = pure (Stuck !(quote env t) :: map (const Unknown) ns)
+getArgTys _ _ _ = pure []
+
+nextNames' : RigCount ->
+             (pats : List (RigCount, Pat)) ->
+             (ns : List Name) ->
+             (0 _ : LengthMatch pats ns) ->
+             List (ArgType vars) ->
+             (args ** (SizeOf args, NamedPats args (vars <>< args)))
+nextNames' rig [] [] NilMatch _ = ([] ** (zero, []))
+nextNames' rig ((c, p) :: pats) (n :: ns) (ConsMatch prf) as
+  = do let (ty, as) : (ArgType (vars :< n), List (ArgType vars))
+           := case as of
+                [] => (Unknown, [])
+                (a :: as) => (weaken a, as)
+       let (args ** (l, ps)) = nextNames' rig pats ns prf as
+       (n :: args ** (suc l, weakensN l (MkInfo (rigMult rig c) p First ty) :: genWeakenFishily l ps))
+
 nextNames : {vars : _} ->
             {auto i : Ref PName Int} ->
             {auto c : Ref Ctxt Defs} ->
-            FC -> String -> List Pat -> Maybe (NF vars) ->
-            Core (args ** (SizeOf args, NamedPats args (args ++ vars)))
-nextNames fc root [] fty = pure ([] ** (zero, []))
-nextNames fc root (p :: pats) fty
-     = do defs <- get Ctxt
-          empty <- clearDefs defs
-          n <- nextName root
+            RigCount -> FC -> String -> List (RigCount, Pat) -> NF vars ->
+            Core (args ** (SizeOf args, NamedPats args (Scope.ext vars args)))
+nextNames _ _ _ [] _ = pure ([] ** (zero, []))
+nextNames {vars} rig fc root pats nty
+     = do (Element args p) <- mkNames pats
           let env = mkEnv fc vars
-          fa_tys <- the (Core (Maybe (NF vars), ArgType vars)) $
-              case fty of
-                   Nothing => pure (Nothing, Unknown)
-                   Just (NBind pfc _ (Pi _ c _ fargc) fsc) =>
-                      do farg <- evalClosure defs fargc
-                         case farg of
-                              NErased {} =>
-                                pure (Just !(fsc defs (toClosure defaultOpts env (Ref pfc Bound n))),
-                                      Unknown)
-                              _ => pure (Just !(fsc defs (toClosure defaultOpts env (Ref pfc Bound n))),
-                                         Known c !(quote empty env farg))
-                   Just t =>
-                      pure (Nothing, Stuck !(quote empty env t))
-          (args ** (l, ps)) <- nextNames fc root pats (fst fa_tys)
-          let argTy = case snd fa_tys of
-                           Unknown => Unknown
-                           Known rig t => Known rig (weakenNs (suc l) t)
-                           Stuck t => Stuck (weakenNs (suc l) t)
-          pure (n :: args ** (suc l, MkInfo p First argTy :: weaken ps))
+          argTys <- logQuiet $ getArgTys env args nty
+          pure $ nextNames' rig pats args p argTys
+  where
+    mkNames : (vars : List a) -> Core $ Subset (List Name) (LengthMatch vars)
+    mkNames [] = pure (Element [] NilMatch)
+    mkNames (x :: xs)
+        = do n <- nextName root
+             (Element ns p) <- mkNames xs
+             pure $ Element (n :: ns) (ConsMatch p)
 
 -- replace the prefix of patterns with 'pargs'
-newPats : (pargs : List Pat) -> LengthMatch pargs ns ->
+newPats : (pargs : List (RigCount, Pat)) -> (0 _ : LengthMatch pargs ns) ->
           NamedPats (ns ++ todo) vars ->
           NamedPats ns vars
 newPats [] NilMatch rest = []
-newPats (newpat :: xs) (ConsMatch w) (pi :: rest)
-  = { pat := newpat } pi :: newPats xs w rest
+newPats ((c, newpat) :: xs) (ConsMatch w) (pi :: rest)
+  = { multiplicity := c
+    , pat := newpat } pi :: newPats xs w rest
 
 updateNames : List (Name, Pat) -> List (Name, Name)
 updateNames = mapMaybe update
@@ -480,8 +597,8 @@ updatePatNames ns (pi :: ps)
         = case lookup n ns of
                Nothing => PAs fc n (update p)
                Just n' => PAs fc n' (update p)
-    update (PCon fc n i a ps) = PCon fc n i a (map update ps)
-    update (PTyCon fc n a ps) = PTyCon fc n a (map update ps)
+    update (PCon fc n i a ps) = PCon fc n i a (map @{Compose} update ps)
+    update (PTyCon fc n a ps) = PTyCon fc n a (map @{Compose} update ps)
     update (PArrow fc x s t) = PArrow fc x (update s) (update t)
     update (PDelay fc r t p) = PDelay fc r (update t) (update p)
     update (PLoc fc n)
@@ -495,51 +612,60 @@ groupCons : {a, vars, todo : _} ->
             {auto ct : Ref Ctxt Defs} ->
             FC -> Name ->
             List Name ->
-            (cs : List01 True (PatClause (a :: todo) vars)) ->
-            (0 isCons : All IsConClause cs) =>
-            Core (List01 True (Group todo vars))
-groupCons fc fn pvars (x :: xs) {isCons = p :: ps}
-    = foldlC (uncurry . gc) !(gc [] x p) $ pushIn xs ps
+            List (PatClause (a :: todo) vars) ->
+            Core (List (Group todo vars))
+groupCons fc fn pvars cs
+     = gc [] cs
   where
     addConG : {vars', todo' : _} ->
-              Name -> (tag : Int) ->
-              List Pat -> NamedPats todo' vars' ->
-              Int -> (rhs : Term vars') ->
-              (acc : List01 ne (Group todo' vars')) ->
-              Core (List01 True (Group todo' vars'))
+              RigCount -> Name -> (tag : Int) ->
+              List (RigCount, Pat) -> NamedPats todo' vars' ->
+              PMappings vars' -> Int -> (rhs : Term vars') ->
+              (acc : List (Group todo' vars')) ->
+              Core (List (Group todo' vars'))
     -- Group all the clauses that begin with the same constructor, and
     -- add new pattern arguments for each of that constructor's arguments.
     -- The type of 'ConGroup' ensures that we refer to the arguments by
     -- the same name in each of the clauses
-    addConG n tag pargs pats pid rhs []
+    addConG {vars'} {todo'} rig n tag pargs pats pmaps pid rhs []
         = do cty <- if n == UN (Basic "->")
-                      then pure $ NBind fc (MN "_" 0) (Pi fc top Explicit (MkNFClosure defaultOpts (mkEnv fc vars') (NType fc (MN "top" 0)))) $
-                              (\d, a => pure $ NBind fc (MN "_" 1) (Pi fc top Explicit (MkNFClosure defaultOpts (mkEnv fc vars') (NErased fc Placeholder)))
-                                (\d, a => pure $ NType fc (MN "top" 0)))
+                      then pure $ VBind fc (MN "_" 0) (Pi fc top Explicit (VType fc (MN "top" 0))) $
+                              (\a => pure $ VBind fc (MN "_" 1) (Pi fc top Explicit (VErased fc Placeholder))
+                                (\a => pure $ VType fc (MN "top" 0)))
                       else do defs <- get Ctxt
                               Just t <- lookupTyExact n (gamma defs)
-                                   | Nothing => pure (NErased fc Placeholder)
-                              nf defs (mkEnv fc vars') (embed t)
-             (patnames ** (l, newargs)) <- nextNames fc "e" pargs (Just cty)
+                                   | Nothing => pure (VErased fc Placeholder)
+                              expand !(nf (mkEnv fc vars') (embed t))
+             (patnames ** (l, newargs)) <- logDepth $ do
+                log "compile.casetree" 25 $ "addConG nextNames for " ++ show pargs
+                logNF "compile.casetree" 25 "addConG nextNames cty" (mkEnv fc vars') cty
+                nextNames {vars=vars'} rig fc "e" pargs cty
+             log "compile.casetree" 25 $ "addConG patnames  " ++ show patnames
+             log "compile.casetree" 25 $ "addConG newargs  " ++ show newargs
              -- Update non-linear names in remaining patterns (to keep
              -- explicit dependencies in types accurate)
-             let pats' = updatePatNames (updateNames (zip patnames pargs))
-                                        (weakenNs l pats)
-             let clause = MkPatClause pvars (newargs ++ pats') pid (weakenNs l rhs)
-             pure [ConGroup n tag [clause]]
-    addConG n tag pargs pats pid rhs (g :: gs) with (checkGroupMatch (CName n tag) pargs g)
-      addConG n tag pargs pats pid rhs
-              (ConGroup n tag (MkPatClause pvars ps tid tm :: rest) :: gs) | ConMatch {newargs} lprf
+             let pats' = updatePatNames (updateNames (zip patnames (map snd pargs)))
+                                        (weakensN l pats)
+             let clause = MkPatClause pvars (weakensN l pmaps)
+                                      (newargs ++ pats') pid (weakensN l rhs)
+             pure [ConGroup n tag (map fst pargs) [clause]]
+    addConG {vars'} {todo'} rig n tag pargs pats pmaps pid rhs (g :: gs) with (checkGroupMatch (CName n tag) pargs g)
+      addConG {vars'} {todo'} _ n tag pargs pats pmaps pid rhs
+              ((ConGroup {newargs} n tag rigs ((MkPatClause pvars pmaps' ps tid tm) :: rest)) :: gs)
+                   | (ConMatch {newargs} lprf)
         = do let newps = newPats pargs lprf ps
              let l = mkSizeOf newargs
-             let pats' = updatePatNames (updateNames (zip newargs pargs))
-                                        (weakenNs l pats)
-             let newclause = MkPatClause pvars (newps ++ pats') pid (weakenNs l rhs)
+             let pats' = updatePatNames (updateNames (zip newargs (map snd pargs)))
+                                        (weakensN l pats)
+             let newclause = MkPatClause pvars (weakensN l pmaps)
+                                         (newps ++ pats') pid (weakensN l rhs)
              -- put the new clause at the end of the group, since we
              -- match the clauses top to bottom.
-             pure $ ConGroup n tag (MkPatClause pvars ps tid tm :: rest ++ [newclause]) :: gs
-      addConG n tag pargs pats pid rhs (g :: gs) | NoMatch
-        = (g ::) <$> addConG n tag pargs pats pid rhs gs
+             pure ((ConGroup n tag rigs (MkPatClause pvars pmaps' ps tid tm :: rest ++ [newclause]))
+                         :: gs)
+      addConG rig n tag pargs pats pmaps pid rhs (g :: gs) | NoMatch
+        = do gs' <- addConG rig n tag pargs pats pmaps pid rhs gs
+             pure (g :: gs')
 
     -- This rather ugly special case is to deal with laziness, where Delay
     -- is like a constructor, but with a special meaning that it forces
@@ -547,85 +673,94 @@ groupCons fc fn pvars (x :: xs) {isCons = p :: ps}
     -- and compiler)
     addDelayG : {vars', todo' : _} ->
                 Pat -> Pat -> NamedPats todo' vars' ->
-                Int -> (rhs : Term vars') ->
-                (acc : List01 ne (Group todo' vars')) ->
-                Core (List01 True (Group todo' vars'))
-    addDelayG pty parg pats pid rhs []
-        = do let dty = NBind fc (MN "a" 0) (Pi fc erased Explicit (MkNFClosure defaultOpts (mkEnv fc vars') (NType fc (MN "top" 0)))) $
-                        (\d, a =>
-                            do a' <- evalClosure d a
-                               pure (NBind fc (MN "x" 0) (Pi fc top Explicit a)
-                                       (\dv, av => pure (NDelayed fc LUnknown a'))))
-             ([tyname, argname] ** (l, newargs)) <- nextNames fc "e" [pty, parg]
-                                                  (Just dty)
+                PMappings vars' -> Int -> (rhs : Term vars') ->
+                (acc : List (Group todo' vars')) ->
+                Core (List (Group todo' vars'))
+    addDelayG {vars'} {todo'} pty parg pats pmaps pid rhs []
+        = do let dty = VBind fc (MN "a" 0) (Pi fc erased Explicit (VType fc (MN "top" 0))) $
+                        (\a => do a'<- a
+                                  pure (VBind fc (MN "x" 0) (Pi fc top Explicit a')
+                                           (\av => pure (VDelayed fc LUnknown a'))))
+             ([tyname, argname] ** (l, newargs)) <- nextNames {vars=vars'} top fc "e" [(top, pty), (top, parg)] dty
                 | _ => throw (InternalError "Error compiling Delay pattern match")
-             let pats' = updatePatNames (updateNames [(tyname, pty),
-                                                      (argname, parg)])
-                                        (weakenNs l pats)
-             let clause = MkPatClause pvars (newargs ++ pats') pid (weakenNs l rhs)
+             let pats' = updatePatNames (updateNames [(tyname, pty), (argname, parg)])
+                                        (weakensN l pats)
+             let clause = MkPatClause pvars (weakensN l pmaps)
+                                      (newargs ++ pats') pid (weakensN l rhs)
              pure [DelayGroup [clause]]
-    addDelayG pty parg pats pid rhs (g :: gs) with (checkGroupMatch CDelay [] g)
-      addDelayG pty parg pats pid rhs
-          (DelayGroup (MkPatClause pvars ps tid tm :: rest) :: gs) | DelayMatch {tyarg} {valarg}
-        = do let l = mkSizeOf [tyarg, valarg]
-             let newps = newPats [pty, parg] (ConsMatch (ConsMatch NilMatch)) ps
-             let pats' = updatePatNames (updateNames [(tyarg, pty),
-                                                      (valarg, parg)])
-                                        (weakenNs l pats)
-             let newclause = MkPatClause pvars (newps ++ pats') pid (weakenNs l rhs)
-             pure $ DelayGroup (MkPatClause pvars ps tid tm :: rest ++ [newclause]) :: gs
-      addDelayG pty parg pats pid rhs (g :: gs) | NoMatch
-        = (g ::) <$> addDelayG pty parg pats pid rhs gs
+    addDelayG {vars'} {todo'} pty parg pats pmaps pid rhs (g :: gs) with (checkGroupMatch CDelay [] g)
+      addDelayG {vars'} {todo'} pty parg pats pmaps pid rhs
+          ((DelayGroup {tyarg} {valarg} ((MkPatClause pvars pmaps' ps tid tm) :: rest)) :: gs)
+                 | (DelayMatch {tyarg} {valarg})
+         = do let l = mkSizeOf [tyarg, valarg]
+              let newps = newPats [(top, pty), (top, parg)] (ConsMatch (ConsMatch NilMatch)) ps
+              let pats' = updatePatNames (updateNames [(valarg, parg), (tyarg, pty)])
+                                         (weakensN l pats)
+              let newclause : PatClause (tyarg :: valarg :: todo')
+                                        (vars' :< tyarg :< valarg)
+                    = MkPatClause pvars (weakensN l pmaps) (newps ++ pats') pid
+                                        (weakensN l rhs)
+              pure ((DelayGroup (MkPatClause pvars pmaps' ps tid tm :: rest ++ [newclause]))
+                         :: gs)
+      addDelayG pty parg pats pmaps pid rhs (g :: gs) | NoMatch
+         = do gs' <- addDelayG pty parg pats pmaps pid rhs gs
+              pure (g :: gs')
 
     addConstG : {vars', todo' : _} ->
                 Constant -> NamedPats todo' vars' ->
-                Int -> (rhs : Term vars') ->
-                (acc : List01 ne (Group todo' vars')) ->
-                Core (List01 True (Group todo' vars'))
-    addConstG c pats pid rhs []
-          = pure [ConstGroup c [MkPatClause pvars pats pid rhs]]
-    addConstG c pats pid rhs (g :: gs) with (checkGroupMatch (CConst c) [] g)
-      addConstG c pats pid rhs
-              (ConstGroup c (MkPatClause pvars ps tid tm :: rest) :: gs) | ConstMatch
-        = do let newclause = MkPatClause pvars pats pid rhs
-             pure $ ConstGroup c (MkPatClause pvars ps tid tm :: rest ++ [newclause]) :: gs
-      addConstG c pats pid rhs (g :: gs) | NoMatch
-        = (g ::) <$> addConstG c pats pid rhs gs
+                PMappings vars' -> Int -> (rhs : Term vars') ->
+                (acc : List (Group todo' vars')) ->
+                Core (List (Group todo' vars'))
+    addConstG c pats pmaps pid rhs []
+        = pure [ConstGroup c [MkPatClause pvars pmaps pats pid rhs]]
+    addConstG {todo'} {vars'} c pats pmaps pid rhs (g :: gs) with (checkGroupMatch (CConst c) [] g)
+      addConstG {todo'} {vars'} c pats pmaps pid rhs
+              ((ConstGroup c ((MkPatClause pvars pmaps' ps tid tm) :: rest)) :: gs) | ConstMatch
+          = let newclause : PatClause todo' vars'
+                  = MkPatClause pvars pmaps pats pid rhs in
+                pure ((ConstGroup c
+                      (MkPatClause pvars pmaps' ps tid tm :: rest ++ [newclause])) :: gs)
+      addConstG c pats pmaps pid rhs (g :: gs) | NoMatch
+          = do gs' <- addConstG c pats pmaps pid rhs gs
+               pure (g :: gs')
 
     addGroup : {vars, todo, idx : _} ->
-               (pat : Pat) -> (0 _ : IsConPat pat) =>
-               (0 p : IsVar nm idx vars) ->
-               NamedPats todo vars -> Int -> Term vars ->
-               List01 ne (Group todo vars) ->
-               Core (List01 True (Group todo vars))
+               RigCount -> Pat -> (0 p : IsVar nm idx vars) ->
+               NamedPats todo vars ->
+               PMappings vars -> Int -> Term vars ->
+               List (Group todo vars) ->
+               Core (List (Group todo vars))
     -- In 'As' replace the name on the RHS with a reference to the
     -- variable we're doing the case split on
-    addGroup (PAs fc n p) pprf pats pid rhs acc
-         = addGroup p pprf pats pid (substName n (Local fc (Just True) idx pprf) rhs) acc
-    addGroup (PCon cfc n t a pargs) pprf pats pid rhs acc
+    addGroup rig (PAs fc n p) pprf pats pmaps pid rhs acc
+         = addGroup rig p pprf pats pmaps pid (substName zero n (Local fc (Just True) _ pprf) rhs) acc
+    addGroup rig (PCon cfc n t a pargs) pprf pats pmaps pid rhs acc
          = if a == length pargs
-              then addConG n t pargs pats pid rhs acc
+              then addConG rig n t (cast pargs) pats pmaps pid rhs acc
               else throw (CaseCompile cfc fn (NotFullyApplied n))
-    addGroup (PTyCon cfc n a pargs) pprf pats pid rhs acc
+    addGroup rig (PTyCon cfc n a pargs) pprf pats pmaps pid rhs acc
          = if a == length pargs
-           then addConG n 0 pargs pats pid rhs acc
+           then addConG rig n 0 (cast pargs) pats pmaps pid rhs acc
            else throw (CaseCompile cfc fn (NotFullyApplied n))
-    addGroup (PArrow _ _ s t) pprf pats pid rhs acc
-         = addConG (UN $ Basic "->") 0 [s, t] pats pid rhs acc
+    addGroup rig (PArrow _ _ s t) pprf pats pmaps pid rhs acc
+         = addConG rig (UN $ Basic "->") 0 [(top, s), (top, t)] pats pmaps pid rhs acc
     -- Go inside the delay; we'll flag the case as needing to force its
     -- scrutinee (need to check in 'caseGroups below)
-    addGroup (PDelay _ _ pty parg) pprf pats pid rhs acc
-         = addDelayG pty parg pats pid rhs acc
-    addGroup (PConst _ c) pprf pats pid rhs acc
-         = addConstG c pats pid rhs acc
+    addGroup _ (PDelay _ _ pty parg) pprf pats pmaps pid rhs acc
+         = addDelayG pty parg pats pmaps pid rhs acc
+    addGroup _ (PConst _ c) pprf pats pmaps pid rhs acc
+         = addConstG c pats pmaps pid rhs acc
+    addGroup _ _ pprf pats pmaps pid rhs acc = pure acc -- Can't happen, not a constructor
+           -- FIXME: Is this possible to rule out with a type? Probably.
 
     gc : {a, vars, todo : _} ->
-         List01 ne (Group todo vars) ->
-         (p : PatClause (a :: todo) vars) ->
-         (0 _ : IsConClause p) ->
-         Core (List01 True (Group todo vars))
-    gc acc (MkPatClause _ (MkInfo pat pprf _ :: pats) pid rhs) isCon
-        = addGroup pat pprf pats pid rhs acc
+         List (Group todo vars) ->
+         List (PatClause (a :: todo) vars) ->
+         Core (List (Group todo vars))
+    gc acc [] = pure acc
+    gc {a} acc ((MkPatClause _ pmaps (MkInfo c pat pprf _ :: pats) pid rhs) :: cs)
+        = do acc' <- addGroup c pat pprf pats pmaps pid rhs acc
+             gc acc' cs
 
 getFirstPat : NamedPats (p :: ps) ns -> Pat
 getFirstPat (p :: _) = pat p
@@ -636,82 +771,96 @@ getFirstArgType (p :: _) = argType p
 ||| Store scores alongside rows of named patterns. These scores are used to determine
 ||| which column of patterns to switch on first. One score per column.
 data ScoredPats : List Name -> Scoped where
-     Scored : List01 True (NamedPats (p :: ps) ns) -> Vect (length (p :: ps)) Int -> ScoredPats (p :: ps) ns
+     Scored : List (NamedPats (p :: ps) ns) -> Vect (length (p :: ps)) Int -> ScoredPats (p :: ps) ns
 
 {ps : _} -> Show (ScoredPats ps ns) where
   show (Scored xs ys) = (show ps) ++ "//" ++ (show ys)
 
-zeroedScore : {ps : _} -> List01 True (NamedPats (p :: ps) ns) -> ScoredPats (p :: ps) ns
+zeroedScore : {ps : _} -> List (NamedPats (p :: ps) ns) -> ScoredPats (p :: ps) ns
 zeroedScore nps = Scored nps (replicate (S $ length ps) 0)
 
+||| Proof that a value `v` inserted in the middle of a list with
+||| prefix `ps` and suffix `qs` can equivalently be snoced with
+||| `ps` or consed with `qs` before appending `qs` to `ps`.
+elemInsertedMiddle : (v : a) -> (ps,qs : List a) -> (ps ++ (v :: qs)) = ((ps `snoc` v) ++ qs)
+elemInsertedMiddle v [] qs = Refl
+elemInsertedMiddle v (x :: xs) qs = rewrite elemInsertedMiddle v xs qs in Refl
+
 ||| Helper to find a single highest scoring name (or none at all) while
 ||| retaining the context of all names processed.
 highScore : {prev : List Name} ->
-            (names : Scope) ->
+            (names : List Name) ->
             (scores : Vect (length names) Int) ->
             (highVal : Int) ->
-            (highIdx : (n ** NVar n (prev ++ names))) -> -- TODO should be `names <>< prev`
+            (highIdx : (n ** NVarL n (prev ++ names))) ->
             (duped : Bool) ->
-            Maybe (n ** NVar n (prev ++ names))
+            Maybe (n ** NVarL n (prev ++ names))
 highScore [] [] high idx True = Nothing
 highScore [] [] high idx False = Just idx
 highScore (x :: xs) (y :: ys) high idx duped =
   let next = highScore {prev = prev `snoc` x} xs ys
-      prf = appendAssociative prev [x] xs
+      prf = elemInsertedMiddle x prev xs
   in  rewrite prf in
         case compare y high of
              LT => next high (rewrite sym $ prf in idx) duped
              EQ => next high (rewrite sym $ prf in idx) True
-             GT => next y (x ** rewrite sym $ prf in weakenNVar (mkSizeOf prev) (MkNVar First)) False
+             GT => next y (x ** rewrite sym $ prf in weakenNVarL (mkSizeOf prev) (MkNVarL First)) False
 
 ||| Get the index of the highest scoring column if there is one.
 ||| If no column has a higher score than all other columns then
 ||| the result is Nothing indicating we need to apply more scoring
 ||| to break the tie.
 ||| Suggested heuristic application order: f, b, a.
-highScoreIdx : {p : _} -> {ps : _} -> ScoredPats (p :: ps) ns -> Maybe (n ** NVar n (p :: ps))
-highScoreIdx (Scored xs (y :: ys)) = highScore {prev = []} (p :: ps) (y :: ys) (y - 1) (p ** MkNVar First) False
+highScoreIdx : {p : _} -> {ps : _} -> ScoredPats (p :: ps) ns -> Maybe (n ** NVarL n (p :: ps))
+highScoreIdx (Scored xs (y :: ys)) = highScore {prev = []} (p :: ps) (y :: ys) (y - 1) (p ** MkNVarL First) False
 
 ||| Apply the penalty function to the head constructor's
 ||| arity. Produces 0 for all non-head-constructors.
 headConsPenalty : (penality : Nat -> Int) -> Pat -> Int
-headConsPenalty p (PAs _ _ w)             = headConsPenalty p w
+headConsPenalty p (PAs _ _ w)        = headConsPenalty p w
 headConsPenalty p (PCon _ n _ arity pats) = p arity
 headConsPenalty p (PTyCon _ _ arity _)    = p arity
-headConsPenalty _ (PConst {})             = 0
-headConsPenalty _ (PArrow {})             = 0
-headConsPenalty p (PDelay _ _ _ w)        = headConsPenalty p w
-headConsPenalty _ (PLoc {})               = 0
-headConsPenalty _ (PUnmatchable {})       = 0
-
-splitColumn : (nps : List01 True (NamedPats (p :: ps) ns)) -> (Vect (length nps) (PatInfo p ns), List01 True (NamedPats ps ns))
-splitColumn [(w :: ws)] = ([w], [ws])
-splitColumn ((w :: ws) :: nps@(_ :: _)) = bimap (w ::) (ws ::) $ splitColumn nps
+headConsPenalty _ (PConst _ _)       = 0
+headConsPenalty _ (PArrow _ _ _ _)   = 0
+headConsPenalty p (PDelay _ _ _ w)   = headConsPenalty p w
+headConsPenalty _ (PLoc _ _)         = 0
+headConsPenalty _ (PUnmatchable _ _) = 0
 
 ||| Apply the given function that scores a pattern to all patterns and then
 ||| sum up the column scores and add to the ScoredPats passed in.
 consScoreHeuristic : {ps : _} -> (scorePat : Pat -> Int) -> ScoredPats ps ns -> ScoredPats ps ns
+consScoreHeuristic _ sps@(Scored [] _) = sps -- can't update scores without any patterns
 consScoreHeuristic scorePat (Scored xs ys) =
-  let columnScores = scoreColumns xs
+  let columnScores = sum <$> scoreColumns xs
       ys' = zipWith (+) ys columnScores
   in  Scored xs ys'
   where
-    scoreColumns : {ps' : _} -> (nps : List01 True (NamedPats ps' ns)) -> Vect (length ps') Int
+    -- also returns NamePats of remaining columns while its in there
+    -- scoring the first column.
+    scoreFirstColumn : (nps : List (NamedPats (p' :: ps') ns)) ->
+                       (res : List (NamedPats ps' ns) ** (LengthMatch nps res, Vect (length nps) Int))
+    scoreFirstColumn [] = ([] ** (NilMatch, []))
+    scoreFirstColumn ((w :: ws) :: nps) =
+      let (ws' ** (prf, scores)) = scoreFirstColumn nps
+      in  (ws :: ws' ** (ConsMatch prf, scorePat (pat w) :: scores))
+
+    scoreColumns : {ps' : _} -> (nps : List (NamedPats ps' ns)) -> Vect (length ps') (Vect (length nps) Int)
     scoreColumns {ps' = []} nps = []
-    scoreColumns {ps' = w :: ws} nps =
-      let (col, nps') = splitColumn nps
-       in sum (scorePat . pat <$> col) :: scoreColumns nps'
+    scoreColumns {ps' = (w :: ws)} nps =
+      let (rest ** (prf, firstColScore)) = scoreFirstColumn nps
+      in  firstColScore :: (rewrite lengthsMatch prf in scoreColumns rest)
 
 ||| Add 1 to each non-default pat in the first row.
 ||| This favors constructive matching first and reduces tree depth on average.
 heuristicF : {ps : _} -> ScoredPats (p :: ps) ns -> ScoredPats (p :: ps) ns
+heuristicF sps@(Scored [] _) = sps
 heuristicF (Scored (x :: xs) ys) =
   let columnScores = scores x
       ys' = zipWith (+) ys columnScores
   in  Scored (x :: xs) ys'
   where
     isBlank : Pat -> Bool
-    isBlank (PLoc {}) = True
+    isBlank (PLoc _ _) = True
     isBlank _ = False
 
     scores : NamedPats ps' ns' -> Vect (length ps') Int
@@ -732,7 +881,7 @@ applyHeuristics : {p : _} ->
                   {ps : _} ->
                   ScoredPats (p :: ps) ns ->
                   List (ScoredPats (p :: ps) ns -> ScoredPats (p :: ps) ns) ->
-                  Maybe (n ** NVar n (p :: ps))
+                  Maybe (n ** NVarL n (p :: ps))
 applyHeuristics x [] = highScoreIdx x
 applyHeuristics x (f :: fs) = highScoreIdx x <|> applyHeuristics (f x) fs
 
@@ -745,12 +894,12 @@ nextIdxByScore : {p : _} ->
                  {ps : _} ->
                  (useHeuristics : Bool) ->
                  Phase ->
-                 List01 True (NamedPats (p :: ps) ns) ->
-                 (n ** NVar n (p :: ps))
-nextIdxByScore False _ _            = (_ ** (MkNVar First))
-nextIdxByScore _ (CompileTime _) _  = (_ ** (MkNVar First))
+                 List (NamedPats (p :: ps) ns) ->
+                 (n ** NVarL n (p :: ps))
+nextIdxByScore False _ _            = (_ ** (MkNVarL First))
+nextIdxByScore _ (CompileTime _) _  = (_ ** (MkNVarL First))
 nextIdxByScore True RunTime xs      =
-  fromMaybe (_ ** (MkNVar First)) $
+  fromMaybe (_ ** (MkNVarL First)) $
     applyHeuristics (zeroedScore xs) [heuristicF, heuristicB, heuristicA]
 
 -- Check whether all the initial patterns have the same concrete, known
@@ -759,14 +908,14 @@ nextIdxByScore True RunTime xs      =
 sameType : {ns : _} ->
            {auto c : Ref Ctxt Defs} ->
            FC -> Phase -> Name ->
-           Env Term ns -> List01 ne (NamedPats (p :: ps) ns) ->
+           Env Term ns -> List (NamedPats (p :: ps) ns) ->
            Core ()
 sameType fc phase fn env [] = pure ()
 sameType {ns} fc phase fn env (p :: xs)
     = do defs <- get Ctxt
          case getFirstArgType p of
               Known _ t => sameTypeAs phase
-                                      !(nf defs env t)
+                                      !(expand !(nf env t))
                                       (map getFirstArgType xs)
               ty => throw (CaseCompile fc fn DifferingTypes)
   where
@@ -774,29 +923,31 @@ sameType {ns} fc phase fn env (p :: xs)
     firstPat (pinf :: _) = pat pinf
 
     headEq : NF ns -> NF ns -> Phase -> Bool
-    headEq (NBind _ _ (Pi {}) _) (NBind _ _ (Pi {}) _) _ = True
-    headEq (NTCon _ n _ _) (NTCon _ n' _ _) _ = n == n'
-    headEq (NPrimVal _ c) (NPrimVal _ c') _ = c == c'
-    headEq (NType {}) (NType {}) _ = True
-    headEq (NApp _ (NRef _ n) _) (NApp _ (NRef _ n') _) RunTime = n == n'
-    headEq (NErased _ (Dotted x)) y ph = headEq x y ph
-    headEq x (NErased _ (Dotted y)) ph = headEq x y ph
-    headEq (NErased {}) _ RunTime = True
-    headEq _ (NErased {}) RunTime = True
+    headEq (VBind _ _ (Pi _ _ _ _) _) (VBind _ _ (Pi _ _ _ _) _) _ = True
+    headEq (VTCon _ n _ _) (VTCon _ n' _ _) _ = n == n'
+    headEq (VCase _ _ _ sc _ _) (VCase _ _ _ sc' _ _) phase = headEq sc sc' phase
+    headEq (VPrimVal _ c) (VPrimVal _ c') _ = c == c'
+    headEq (VType _ _) (VType _ _) _ = True
+    headEq (VApp _ _ n _ _) (VApp _ _ n' _ _) RunTime = n == n'
+    headEq (VErased _ (Dotted x)) y ph = headEq x y ph
+    headEq x (VErased _ (Dotted y)) ph = headEq x y ph
+    headEq (VErased _ _) _ RunTime = True
+    headEq _ (VErased _ _) RunTime = True
     headEq _ _ _ = False
 
-    sameTypeAs : forall ne. Phase -> NF ns -> List01 ne (ArgType ns) -> Core ()
+    sameTypeAs : Phase -> NF ns -> List (ArgType ns) -> Core ()
     sameTypeAs _ ty [] = pure ()
     sameTypeAs ph ty (Known r t :: xs) =
          do defs <- get Ctxt
-            if headEq ty !(nf defs env t) phase
+            if headEq ty !(expand !(nf env t)) phase
                then sameTypeAs ph ty xs
                else throw (CaseCompile fc fn DifferingTypes)
     sameTypeAs p ty _ = throw (CaseCompile fc fn DifferingTypes)
 
 -- Check whether all the initial patterns are the same, or are all a variable.
 -- If so, we'll match it to refine later types and move on
-samePat : List01 True (NamedPats (p :: ps) ns) -> Bool
+samePat : List (NamedPats (p :: ps) ns) -> Bool
+samePat [] = True
 samePat (pi :: xs)
     = samePatAs (dropAs (getFirstPat pi))
                 (map (dropAs . getFirstPat) xs)
@@ -805,7 +956,7 @@ samePat (pi :: xs)
     dropAs (PAs _ _ p) = p
     dropAs p = p
 
-    samePatAs : Pat -> List01 ne Pat -> Bool
+    samePatAs : Pat -> List Pat -> Bool
     samePatAs p [] = True
     samePatAs (PTyCon fc n a args) (PTyCon _ n' _ _ :: ps)
         = n == n' && samePatAs (PTyCon fc n a args) ps
@@ -820,47 +971,115 @@ samePat (pi :: xs)
     samePatAs (PLoc fc n) (PLoc _ _ :: ps) = samePatAs (PLoc fc n) ps
     samePatAs x y = False
 
+getFirstCon : NamedPats (p :: ps) ns -> Pat
+getFirstCon (p :: _) = pat p
+
+-- Count the number of distinct constructors in the initial pattern
+countDiff : List (NamedPats (p :: ps) ns) -> Nat
+countDiff xs = length (distinct [] (map getFirstCon xs))
+  where
+    isVar : Pat -> Bool
+    isVar (PAs _ _ p) = isVar p
+    isVar (PCon _ _ _ _ _) = False
+    isVar (PTyCon _ _ _ _) = False
+    isVar (PConst _ _) = False
+    isVar (PArrow _ _ _ _) = False
+    isVar (PDelay _ _ _ p) = False
+    isVar _ = True
+
+    -- Return whether two patterns would lead to the same match
+    sameCase : Pat -> Pat -> Bool
+    sameCase (PAs _ _ p) p' = sameCase p p'
+    sameCase p (PAs _ _ p') = sameCase p p'
+    sameCase (PCon _ _ t _ _) (PCon _ _ t' _ _) = t == t'
+    sameCase (PTyCon _ t _ _) (PTyCon _ t' _ _) = t == t'
+    sameCase (PConst _ c) (PConst _ c') = c == c'
+    sameCase (PArrow _ _ _ _) (PArrow _ _ _ _) = True
+    sameCase (PDelay _ _ _ _) (PDelay _ _ _ _) = True
+    sameCase x y = isVar x && isVar y
+
+    distinct : List Pat -> List Pat -> List Pat
+    distinct acc [] = acc
+    distinct acc (p :: ps)
+       = if elemBy sameCase p acc
+            then distinct acc ps
+            else distinct (p :: acc) ps
+
 getScore : {ns : _} ->
            {auto c : Ref Ctxt Defs} ->
            FC -> Phase -> Name ->
-           List01 True (NamedPats (p :: ps) ns) ->
+           List (NamedPats (p :: ps) ns) ->
            Core (Either CaseError ())
 getScore fc phase name npss
-    = catch (Right () <$ sameType fc phase name (mkEnv fc ns) npss)
-            $ \case
-              CaseCompile _ _ err => pure $ Left err
-              err => throw err
+    = do catch (do sameType fc phase name (mkEnv fc ns) npss
+                   pure (Right ()))
+               $ \case
+                 CaseCompile _ _ err => pure $ Left err
+                 err => throw err
 
 ||| Pick the leftmost matchable thing with all constructors in the
 ||| same family, or all variables, or all the same type constructor.
 pickNextViable : {p, ns, ps : _} ->
-                 {auto c : Ref Ctxt Defs} ->
-                 FC -> Phase -> Name -> List01 True (NamedPats (p :: ps) ns) ->
-                 Core (n ** NVar n (p :: ps))
+           {auto c : Ref Ctxt Defs} ->
+           FC -> Phase -> Name -> List (NamedPats (p :: ps) ns) ->
+           Core (n ** NVarL n (p :: ps))
 -- last possible variable
 pickNextViable {ps = []} fc phase fn npss
     = if samePat npss
-         then pure (_ ** MkNVar First)
+         then pure (_ ** MkNVarL First)
          else do Right () <- getScore fc phase fn npss
                        | Left err => throw (CaseCompile fc fn err)
-                 pure (_ ** MkNVar First)
+                 pure (_ ** MkNVarL First)
 pickNextViable {ps = q :: qs} fc phase fn npss
     = if samePat npss
-         then pure (_ ** MkNVar First)
-         else case !(getScore fc phase fn npss) of
-                   Right () => pure (_ ** MkNVar First)
-                   _ => do (_ ** MkNVar var) <- pickNextViable fc phase fn (map tail npss)
-                           pure (_ ** MkNVar (Later var))
-
-moveFirst : {idx : Nat} -> (0 el : IsVar nm idx ps) -> NamedPats ps ns ->
-            NamedPats (nm :: dropIsVar ps el) ns
+         then pure (_ ** MkNVarL First)
+         else  case !(getScore fc phase fn npss) of
+                    Right () => pure (_ ** MkNVarL First)
+                    _ => do (_ ** MkNVarL var) <- pickNextViable fc phase fn (map tail npss)
+                            pure (_ ** MkNVarL (Later var))
+
+moveFirst : {idx : Nat} -> (0 el : IsVarL nm idx ps) -> NamedPats ps ns ->
+            NamedPats (nm :: dropIsVarL ps el) ns
 moveFirst el nps = getPat el nps :: dropPat el nps
 
-shuffleVars : {idx : Nat} -> (0 el : IsVar nm idx todo) -> PatClause todo vars ->
-              PatClause (nm :: dropIsVar todo el) vars
-shuffleVars First orig@(MkPatClause pvars lhs pid rhs) = orig -- no-op
-shuffleVars el (MkPatClause pvars lhs pid rhs)
-    = MkPatClause pvars (moveFirst el lhs) pid rhs
+shuffleVars : {idx : Nat} -> (0 el : IsVarL nm idx todo) -> PatClause todo vars ->
+              PatClause (nm :: dropIsVarL todo el) vars
+shuffleVars First orig@(MkPatClause pvars pmaps lhs pid rhs) = orig -- no-op
+shuffleVars el (MkPatClause pvars pmaps lhs pid rhs)
+    = MkPatClause pvars pmaps (moveFirst el lhs) pid rhs
+
+addForced : {vars : _} -> Var vars -> Pat -> PMappings vars -> PMappings vars
+addForced n p pmaps
+    = { pforced $= ((n, mkTerm vars (pvars pmaps) p) ::) } pmaps
+  where
+    mkTerm : (vars : SnocList Name) -> List (Name, Var vars) -> Pat -> Term vars
+    mkTerm vars ps (PAs fc x y) = mkTerm vars ps y
+    mkTerm vars ps (PCon fc x tag arity xs)
+        = applySpine fc (Ref fc (DataCon tag arity) x)
+                   (map (\ (c, t) => (c, mkTerm vars ps t)) xs)
+    mkTerm vars ps (PTyCon fc x arity xs)
+        = applySpine fc (Ref fc (TyCon arity) x)
+                   (map (\ (c, t) => (c, mkTerm vars ps t)) xs)
+    mkTerm vars ps (PConst fc c) = PrimVal fc c
+    mkTerm vars ps (PArrow fc x s t)
+        = Bind fc x (Pi fc top Explicit (mkTerm vars ps s))
+                    (mkTerm (vars :< x) (map (\ (n, tm) => (n, weaken tm)) ps) t)
+    mkTerm vars ps (PDelay fc r ty p)
+        = TDelay fc r (mkTerm vars ps ty) (mkTerm vars ps p)
+    mkTerm vars ps (PLoc fc n)
+        = case isVar n vars of
+               Just (MkVar prf) => Local fc Nothing _ prf
+               _ => case lookup n ps of
+                         Nothing => Ref fc Bound n
+                         Just (MkVar prf) => Local fc Nothing _ prf
+    mkTerm vars ps (PUnmatchable fc tm) = embed tm
+
+addPVarMap : FC -> Name -> Var vars -> PMappings vars -> PMappings vars
+addPVarMap fc n var pmaps
+    = case lookup n (pvars pmaps) of
+           Nothing => { pvars $= ((n, var) ::) } pmaps
+           Just (MkVar var') =>
+                { pforced $= ((var, Local fc Nothing _ var') :: ) } pmaps
 
 mutual
   {- 'PatClause' contains a list of patterns still to process (that's the
@@ -873,131 +1092,188 @@ mutual
           {auto i : Ref PName Int} ->
           {auto c : Ref Ctxt Defs} ->
           FC -> Name -> Phase ->
-          List01 True (PatClause todo vars) ->
-          IMaybe ne (CaseTree vars) ->
+          List (PatClause todo vars) -> (err : Maybe (CaseTree vars)) ->
           Core (CaseTree vars)
   -- Before 'partition', reorder the arguments so that the one we
   -- inspect next has a concrete type that is the same in all cases, and
   -- has the most distinct constructors (via pickNextViable)
-  match {todo = _ :: _} fc fn phase clauses err
+  match {todo = (_ :: _)} fc fn phase clauses err
       = do let nps = getNPs <$> clauses
-           let (_ ** (MkNVar next)) = nextIdxByScore (caseTreeHeuristics !getSession) phase nps
+           let (_ ** (MkNVarL next)) = nextIdxByScore (caseTreeHeuristics !getSession) phase nps
            let prioritizedClauses = shuffleVars next <$> clauses
-           (n ** MkNVar next') <- pickNextViable fc phase fn (getNPs <$> prioritizedClauses)
+           (n ** MkNVarL next') <- pickNextViable fc phase fn (getNPs <$> prioritizedClauses)
+           log "compile.casetree" 25 $ "Clauses " ++ show clauses
+           log "compile.casetree" 25 $ "Err " ++ show err
            log "compile.casetree.pick" 25 $ "Picked " ++ show n ++ " as the next split"
            let clauses' = shuffleVars next' <$> prioritizedClauses
            log "compile.casetree.clauses" 25 $
-             unlines ("Using clauses:" :: map (("  " ++) . show) (forget clauses'))
+             unlines ("Using clauses:" :: map (("  " ++) . show) clauses')
            let ps = partition phase clauses'
            log "compile.casetree.partition" 25 $ "Got Partition:\n" ++ show ps
-           Just mix <- mixture fc fn phase ps err
-           log "compile.casetree.intermediate" 25 $ "match: new case tree " ++ show mix
-           pure mix
-  match {todo = []} fc fn phase (MkPatClause pvars [] pid (Erased _ Impossible) :: _) err
-       = pure Impossible
-  match {todo = []} fc fn phase (MkPatClause pvars [] pid rhs :: _) err
-       = pure $ STerm pid rhs
+           mix <- mixture fc fn phase ps err
+           case mix of
+             Nothing =>
+               do log "compile.casetree.intermediate" 25 "match: No clauses"
+                  pure (TUnmatched fc "No clauses in \{show fn}")
+             Just m =>
+               do log "compile.casetree.intermediate" 25 $ "match: new case tree " ++ show m
+                  Core.pure m
+  match {todo = []} fc fn phase [] err
+       = maybe (pure (TUnmatched fc "No patterns in \{show fn}"))
+               pure err
+  match {todo = []} fc fn phase ((MkPatClause _ pmaps [] pid (Erased _ Impossible)) :: _) err
+       = pure (TImpossible fc)
+  match {todo = []} fc fn phase ((MkPatClause _ pmaps [] pid rhs) :: _) err
+       = do log "compile.casetree" 5 ("PMappings at RHS: " ++ show pmaps)
+            pure $ STerm pid (mapMaybe notPV (pvars pmaps) ++
+                              substForced (pvars pmaps) (pforced pmaps)) rhs
+    where
+      -- It's also a forced equality if it appears in the 'pvars' as an
+      -- equality between bound locals, but hasn't found its way into pforced
+      notPV : (Name, Var vars) -> Maybe (Var vars, Term vars)
+      notPV (n, var)
+          = case isVar n vars of
+                 Just (MkVar prf) => Just (var, Local fc Nothing _ prf)
+                 _ => Nothing
 
   caseGroups : {pvar, vars, todo : _} ->
                {auto i : Ref PName Int} ->
                {auto c : Ref Ctxt Defs} ->
-               FC -> Name -> Phase ->
+               FC -> Name -> Phase -> RigCount ->
                {idx : Nat} -> (0 p : IsVar pvar idx vars) -> Term vars ->
-               List01 True (Group todo vars) -> IMaybe ne (CaseTree vars) ->
+               List (Group todo vars) -> Maybe (CaseTree vars) ->
                Core (CaseTree vars)
-  caseGroups fc fn phase el ty gs errorCase
-      = Case idx el (resolveNames vars ty) <$> altGroups gs
+  caseGroups {vars} fc fn phase c el ty gs errorCase
+      = do g <- altGroups gs
+           log "compile.casetree" 50 $ "Making case with " ++ show gs
+           log "compile.casetree" 50 $ "Makes " ++ show g
+           pure (TCase fc c _ el (resolveNames vars ty) g)
     where
-      altGroups : forall ne. List01 ne (Group todo vars) -> Core (List (CaseAlt vars))
-      altGroups [] = pure $ toList $ DefaultCase <$> errorCase
-      altGroups (ConGroup {newargs} cn tag rest :: cs)
-          = do crest <- match fc fn phase rest (map (weakenNs (mkSizeOf newargs)) errorCase)
+      mkScope : forall vars . (vs : SnocList Name) ->
+                              (ms : SnocList RigCount) ->
+                              TCaseScope (vars ++ vs) ->
+                TCaseScope vars
+      mkScope [<] _ rhs = rhs
+      mkScope (sx :< y) (ms :< c) rhs = mkScope sx ms (TArg c y rhs)
+      mkScope (sx :< y) _ rhs = mkScope sx [<] (TArg top y rhs)
+
+      altGroups : List (Group todo vars) -> Core (List (TCaseAlt vars))
+      altGroups [] = maybe (pure [])
+                           (\e => pure [TDefaultCase fc e])
+                           errorCase
+      altGroups (ConGroup {newargs} cn tag rigs rest :: cs)
+          = do crest <- match fc fn phase rest (map (weakensN (mkSizeOf newargs)) errorCase)
                cs' <- altGroups cs
-               pure (ConCase cn tag newargs crest :: cs')
+               pure (TConCase fc cn tag (mkScope (cast newargs) (cast rigs) (rewrite sym $ fishAsSnocAppend vars newargs in TRHS crest)) :: cs')
       altGroups (DelayGroup {tyarg} {valarg} rest :: cs)
-          = do crest <- match fc fn phase rest (map (weakenNs (mkSizeOf [tyarg, valarg])) errorCase)
+          = do crest <- match fc fn phase rest (map (weakenNs (mkSizeOf [<tyarg, valarg])) errorCase)
                cs' <- altGroups cs
-               pure (DelayCase tyarg valarg crest :: cs')
+               pure (TDelayCase fc tyarg valarg crest :: cs')
       altGroups (ConstGroup c rest :: cs)
           = do crest <- match fc fn phase rest errorCase
                cs' <- altGroups cs
-               pure (ConstCase c crest :: cs')
+               pure (TConstCase fc c crest :: cs')
 
   conRule : {a, vars, todo : _} ->
             {auto i : Ref PName Int} ->
             {auto c : Ref Ctxt Defs} ->
             FC -> Name -> Phase ->
-            (cs : List01 True (PatClause (a :: todo) vars)) ->
-            (0 isCons : All IsConClause cs) =>
-            IMaybe ne (CaseTree vars) ->
+            List (PatClause (a :: todo) vars) ->
+            Maybe (CaseTree vars) ->
             Core (CaseTree vars)
+  conRule fc fn phase [] err = maybe (pure (TUnmatched fc "No constructor clauses in \{show fn}")) pure err
   -- ASSUMPTION, not expressed in the type, that the patterns all have
   -- the same variable (pprf) for the first argument. If not, the result
   -- will be a broken case tree... so we should find a way to express this
   -- in the type if we can.
-  conRule {a} fc fn phase cs@(MkPatClause pvars (MkInfo pat pprf fty :: pats) pid rhs :: rest) err
-      = do Element refinedcs _ <- pullOut <$> traverseList01 (substInClause fc) (pushIn cs isCons)
+  conRule {a} fc fn phase cs@(MkPatClause pvars pmaps (MkInfo c pat pprf fty :: pats) pid rhs :: rest) err
+      = do refinedcs <- traverse (substInClause fc) cs
+           log "compile.casetree" 5 $ "conRule refinedcs: " ++ show refinedcs
            groups <- groupCons fc fn pvars refinedcs
+           log "compile.casetree" 5 $ "conRule groups: " ++
+                    show a ++ ", " ++ show groups ++ " , " ++ show cs
            ty <- case fty of
                       Known _ t => pure t
-                      _ => throw (CaseCompile fc fn UnknownType)
-           caseGroups fc fn phase pprf ty groups err
+                      Stuck tm => do logTerm "compile.casetree" 25 "Stuck" tm
+                                     throw (CaseCompile fc fn UnknownType)
+                      _ => do log "compile.casetree" 25 "Unknown type"
+                              throw (CaseCompile fc fn UnknownType)
+           -- The 'pmaps' carry on being propagated through the rest of the
+           -- tree (via 'groups') so we don't use them here
+           caseGroups fc fn phase c pprf ty groups err
 
   varRule : {a, vars, todo : _} ->
             {auto i : Ref PName Int} ->
             {auto c : Ref Ctxt Defs} ->
             FC -> Name -> Phase ->
-            List01 True (PatClause (a :: todo) vars) ->
-            IMaybe ne (CaseTree vars) ->
+            List (PatClause (a :: todo) vars) ->
+            Maybe (CaseTree vars) ->
             Core (CaseTree vars)
-  varRule fc fn phase cs err
-      = do alts' <- traverseList01 updateVar cs
+  varRule {vars} {a} fc fn phase cs err
+      = do alts' <- traverse updateVar cs
            match fc fn phase alts' err
     where
       updateVar : PatClause (a :: todo) vars -> Core (PatClause todo vars)
       -- replace the name with the relevant variable on the rhs
-      updateVar (MkPatClause pvars (MkInfo (PLoc pfc n) prf fty :: pats) pid rhs)
-          = pure $ MkPatClause (n :: pvars)
+      updateVar (MkPatClause pvars pmaps (MkInfo {idx} {name} _ (PLoc pfc n) prf fty :: pats) pid rhs)
+          = do log "compile.casetree.updateVar" 50
+                  "Replacing \{show n} with \{show name}[\{show idx}] in \{show rhs}"
+               log "compile.casetree" 5 $ "Var update " ++
+                    show a ++ ", " ++ show n ++ ", vars: " ++ show (toList vars) ++ " ==> " ++ show !(toFullNames rhs)
+               let pmaps' = addPVarMap pfc n (MkVar prf) pmaps
+               let rhs' = substName zero n (Local pfc (Just False) _ prf) rhs
+               logTerm "compile.casetree" 5 "updateVar-2 rhs'" rhs'
+               pure $ MkPatClause (n :: pvars) pmaps'
                         !(substInPats fc a (Local pfc (Just False) _ prf) pats)
-                        pid (substName n (Local pfc (Just False) _ prf) rhs)
+                        pid (substName zero n (Local pfc (Just False) _ prf) rhs)
       -- If it's an as pattern, replace the name with the relevant variable on
       -- the rhs then continue with the inner pattern
-      updateVar (MkPatClause pvars (MkInfo (PAs pfc n pat) prf fty :: pats) pid rhs)
-          = do pats' <- substInPats fc a (mkTerm _ pat) pats
-               let rhs' = substName n (Local pfc (Just True) _ prf) rhs
-               updateVar (MkPatClause pvars (MkInfo pat prf fty :: pats') pid rhs')
+      updateVar (MkPatClause pvars pmaps (MkInfo c (PAs pfc n pat) prf fty :: pats) pid rhs)
+          = do log "compile.casetree" 5 $ "Var replace " ++
+                    show a ++ ", " ++ show n ++ ", vars: " ++ show (toList vars) ++ " ==> " ++ show !(toFullNames rhs)
+               pats' <- substInPats fc a (mkTerm _ pat) pats
+               let rhs' = substName zero n (Local pfc (Just True) _ prf) rhs
+               logTerm "compile.casetree" 5 "updateVar-3 rhs'" rhs'
+               updateVar (MkPatClause pvars pmaps (MkInfo c pat prf fty :: pats') pid rhs')
       -- match anything, name won't appear in rhs but need to update
       -- LHS pattern types based on what we've learned
-      updateVar (MkPatClause pvars (MkInfo pat prf fty :: pats) pid rhs)
-          = pure $ MkPatClause pvars
-                        !(substInPats fc a (mkTerm vars pat) pats) pid rhs
+      updateVar (MkPatClause pvars pmaps (MkInfo _ pat prf fty :: pats) pid rhs)
+          = do log "compile.casetree" 5 $ "Forced Var update " ++
+                     show a ++ ", vars: " ++ show (toList vars) ++ ", " ++ show !(toFullNames pat) ++ " ==> "
+                     ++ show !(toFullNames rhs)
+               let pmaps' = addForced (MkVar prf) pat pmaps
+               let ptm = mkTerm vars pat
+               pure $ MkPatClause pvars pmaps'
+                        !(substInPats fc a ptm pats) pid rhs
 
   mixture : {a, vars, todo : _} ->
             {auto i : Ref PName Int} ->
             {auto c : Ref Ctxt Defs} ->
-            {ps : List01 ne (PatClause (a :: todo) vars)} ->
+            {ps : List (PatClause (a :: todo) vars)} ->
             FC -> Name -> Phase ->
             Partitions ps ->
-            IMaybe neErr (CaseTree vars) ->
-            Core (IMaybe (ne || neErr) (CaseTree vars))
+            Maybe (CaseTree vars) ->
+            Core (Maybe (CaseTree vars))
   mixture fc fn phase (ConClauses cs rest) err
-      = do fallthrough <- mixture fc fn phase rest err
-           Just <$> conRule fc fn phase cs fallthrough
+      = do log "compile.casetree" 25 $ "Mixture ConClauses Rest: " ++ show rest ++ ", cs: " ++ show cs
+           fallthrough <- mixture fc fn phase rest err
+           pure (Just !(conRule fc fn phase cs fallthrough))
   mixture fc fn phase (VarClauses vs rest) err
-      = do fallthrough <- mixture fc fn phase rest err
-           Just <$> varRule fc fn phase vs fallthrough
-  mixture fc fn phase NoClauses err
+      = do log "compile.casetree" 25 $ "Mixture VarClauses Rest: " ++ show rest ++ ", vs: " ++ show vs
+           fallthrough <- mixture fc fn phase rest err
+           pure (Just !(varRule fc fn phase vs fallthrough))
+  mixture fc fn {a} {todo} phase NoClauses err
       = pure err
 
 export
 mkPat : {auto c : Ref Ctxt Defs} ->
-        (matchable : Bool) -> List Pat -> ClosedTerm -> ClosedTerm -> Core Pat
+        (matchable : Bool) -> List (RigCount, Pat) -> ClosedTerm -> ClosedTerm -> Core Pat
 mkPat _ [] orig (Ref fc Bound n) = pure $ PLoc fc n
-mkPat True args orig (Ref fc (DataCon t a) n) = pure $ PCon fc n t a args
-mkPat True args orig (Ref fc (TyCon a) n) = pure $ PTyCon fc n a args
+mkPat True args orig (Ref fc (DataCon t a) n) = pure $ PCon fc n t a (cast args)
+mkPat True args orig (Ref fc (TyCon a) n) = pure $ PTyCon fc n a (cast args)
 mkPat True args orig (Ref fc Func n)
   = do prims <- getPrimitiveNames
-       mtm <- normalisePrims (const True) isPConst True prims n args orig Env.empty
+       mtm <- normalisePrims (const True) isPConst True prims n (cast $ map snd args) orig Env.empty
        case mtm of
          Just tm => if tm /= orig -- check we made progress; if there's an
                                   -- unresolved interface, we might be stuck
@@ -1012,11 +1288,12 @@ mkPat True args orig (Ref fc Func n)
 mkPat True args orig (Bind fc x (Pi _ _ _ s) t)
     -- For (b:Nat) -> b, the codomain looks like b [__], but we want `b` as the pattern
     = case subst (Erased fc Placeholder) t of
-        App _ t'@(Ref fc Bound n) (Erased {}) => pure $ PArrow fc x !(mkPat True [] s s) !(mkPat False [] t' t')
+        App _ t'@(Ref fc Bound n) _ (Erased {}) => pure $ PArrow fc x !(mkPat True [] s s) !(mkPat False [] t' t')
         t' => pure $ PArrow fc x !(mkPat True [] s s) !(mkPat False [] t' t')
-mkPat True args orig (App fc fn arg)
+mkPat True args orig (App fc fn c@_ arg)
     = do parg <- mkPat True [] arg arg
-         mkPat True (parg :: args) orig fn
+         mkPat True ((c, parg) :: args) orig fn
+-- Assumption is that clauses are converted to explicit names
 mkPat True args orig (As fc _ (Ref _ Bound n) ptm)
     = pure $ PAs fc n !(mkPat True [] ptm ptm)
 mkPat True args orig (As fc _ _ ptm)
@@ -1024,100 +1301,108 @@ mkPat True args orig (As fc _ _ ptm)
 mkPat True args orig (TDelay fc r ty p)
     = pure $ PDelay fc r !(mkPat True [] orig ty) !(mkPat True [] orig p)
 mkPat True args orig (PrimVal fc $ PrT c) -- Primitive type constant
-    = pure $ PTyCon fc (UN (Basic $ show c)) 0 []
+    = pure $ PTyCon fc (UN (Basic $ show c)) 0 [<]
 mkPat True args orig (PrimVal fc c) = pure $ PConst fc c -- Non-type constant
-mkPat True args orig (TType fc _) = pure $ PTyCon fc (UN $ Basic "Type") 0 []
+mkPat True args orig (TType fc _) = pure $ PTyCon fc (UN $ Basic "Type") 0 [<]
 mkPat _ args orig tm
    = do log "compile.casetree" 10 $
           "Catchall: marking " ++ show tm ++ " as unmatchable"
         pure $ PUnmatchable (getLoc orig) orig
 
 export
-argToPat : {auto c : Ref Ctxt Defs} -> ClosedTerm -> Core Pat
-argToPat tm = mkPat True [] tm tm
+argToPat : {auto c : Ref Ctxt Defs} -> (RigCount, ClosedTerm) -> Core (RigCount, Pat)
+argToPat = traversePair $ \tm => mkPat True [] tm tm
 
 mkPatClause : {auto c : Ref Ctxt Defs} ->
               FC -> Name ->
-              (args : Scope) -> ClosedTerm ->
-              Int -> (List Pat, ClosedTerm) ->
-              Core (PatClause args args)
-mkPatClause fc fn args ty pid (ps, rhs)
+              (args : List Name) -> SizeOf args -> ClosedTerm ->
+              Int -> (List (RigCount, Pat), ClosedTerm) ->
+              Core (PatClause args (cast args))
+mkPatClause fc fn args s ty pid (ps, rhs)
     = maybe (throw (CaseCompile fc fn DifferingArgNumbers))
             (\eq =>
                do defs <- get Ctxt
-                  nty <- nf defs Env.empty ty
-                  ns <- mkNames args ps eq (Just nty)
+                  logTerm "compile.casetree" 20 "mkPatClause ty" ty
+                  nty <- expand !(nf Env.empty ty)
+                  logNF "compile.casetree" 20 "mkPatClause nty: " Env.empty nty
+                  -- The arguments are in reverse order, so we need to
+                  -- read what we know off 'nty', and reverse it
+                  argTys <- getArgTys Env.empty args nty
+                  log "compile.casetree" 20 $ "mkPatClause args: " ++ show args ++ ", argTys: " ++ show argTys
+                  ns <- logQuiet $ mkNames args ps eq s.hasLength argTys
                   log "compile.casetree" 20 $
                     "Make pat clause for names " ++ show ns
                      ++ " in LHS " ++ show ps
-                  pure (MkPatClause [] ns pid
-                          (rewrite sym (appendNilRightNeutral args) in
-                                   (weakenNs (mkSizeOf args) rhs))))
+                  pure (MkPatClause [] initPMap ns pid (weakensN s rhs)))
             (checkLengthMatch args ps)
   where
-    mkNames : (vars : Scope) -> (ps : List Pat) ->
-              LengthMatch vars ps -> Maybe (NF []) ->
-              Core (NamedPats vars vars)
-    mkNames [] [] NilMatch fty = pure []
-    mkNames (arg :: args) (p :: ps) (ConsMatch eq) fty
-        = do defs <- get Ctxt
-             empty <- clearDefs defs
-             fa_tys <- the (Core (Maybe _, ArgType _)) $
-                case fty of
-                     Nothing => pure (Nothing, CaseBuilder.Unknown)
-                     Just (NBind pfc _ (Pi _ c _ farg) fsc) =>
-                        pure (Just !(fsc defs (toClosure defaultOpts [] (Ref pfc Bound arg))),
-                              Known c (embed !(quote empty [] farg)))
-                     Just t =>
-                        pure (Nothing, Stuck (embed !(quote empty [] t)))
-             pure (MkInfo p First (Builtin.snd fa_tys)
-                      :: weaken !(mkNames args ps eq (Builtin.fst fa_tys)))
+    mkNames : (vars : List Name) -> (ps : List (RigCount, Pat)) ->
+              (0 _ : LengthMatch vars ps) ->
+              {n : _} -> (0 _ : HasLength n vars) ->
+              List (ArgType [<]) ->
+              Core (NamedPats vars (cast vars))
+    mkNames [] [] NilMatch _ _ = pure []
+    mkNames (r :: args) ((c, p) :: ps) (ConsMatch eq) (S h) as
+      = do let (ty, as) : (ArgType ([<r] <>< args), List (ArgType [<]))
+               := case as of
+                      [] => (Unknown, [])
+                      (a :: as) => (embed a, as)
+           let info = MkInfo {name=r} c p (isVarFishily {outer=[<]} h) ty
+           rest <- mkNames args ps eq h as
+           pure (info :: rewrite fishAsSnocAppend [<r] args in embed rest)
 
 export
 patCompile : {auto c : Ref Ctxt Defs} ->
              FC -> Name -> Phase ->
-             ClosedTerm -> List01 True (List Pat, ClosedTerm) ->
+             ClosedTerm -> List (List (RigCount, Pat), ClosedTerm) ->
+             Maybe (CaseTree Scope.empty) ->
              Core (args ** CaseTree args)
-patCompile fc fn phase ty (p :: ps)
-    = do let (ns ** n) = getNames 0 (fst p)
-         pats <- mkPatClausesFrom 0 ns (p :: ps)
+patCompile fc fn phase ty [] def
+    = maybe (pure (Scope.empty ** TUnmatched fc "\{show fn} not defined"))
+            (\e => pure (Scope.empty ** e))
+            def
+patCompile fc fn phase ty (p :: ps) def
+    = do let ns = getNames 0 (fst p)
+         log "compile.casetree" 25 $ "ns: " ++ show ns
+         pats <- mkPatClausesFrom 0 ns (mkSizeOf ns) (p :: ps)
          -- low verbosity level: pretty print fully resolved names
          logC "compile.casetree" 5 $ do
-           pats <- traverse toFullNames $ forget pats
+           pats <- traverse toFullNames pats
            pure $ "Pattern clauses:\n"
                 ++ show (indent 2 $ vcat $ pretty <$> pats)
+         log "compile.casetree" 25 $ "Def " ++ show def
          -- higher verbosity: dump the raw data structure
-         log "compile.casetree" 10 $ show pats
+         log "compile.casetree" 10 $ "pats " ++ show pats
          i <- newRef PName (the Int 0)
-         cases <- match fc fn phase pats Nothing
+         cases <- match fc fn phase pats (embed @{MaybeFreelyEmbeddable} def)
          pure (_ ** cases)
   where
-    mkPatClausesFrom : Int -> (args : Scope) ->
-                       List01 ne (List Pat, ClosedTerm) ->
-                       Core (List01 ne (PatClause args args))
-    mkPatClausesFrom i ns [] = pure []
-    mkPatClausesFrom i ns (p :: ps)
-        = do p' <- mkPatClause fc fn ns ty i p
-             ps' <- mkPatClausesFrom (i + 1) ns ps
+    mkPatClausesFrom : Int -> (args : List Name) -> SizeOf args ->
+                       List (List (RigCount, Pat), ClosedTerm) ->
+                       Core (List (PatClause args (cast args)))
+    mkPatClausesFrom _ _ _ [] = pure []
+    mkPatClausesFrom i ns s (p :: ps)
+        = do p' <- mkPatClause fc fn ns s ty i p
+             ps' <- mkPatClausesFrom (i + 1) ns s ps
              pure (p' :: ps')
 
-    getNames : Int -> List Pat -> (ns : Scope ** SizeOf ns)
-    getNames i [] = ([] ** zero)
-    getNames i (x :: xs) =
-      let (ns ** n) = getNames (i + 1) xs
-      in (MN "arg" i :: ns ** suc n)
+    getNames : Int -> List (RigCount, Pat) -> List Name
+    getNames i [] = []
+    getNames i (_ :: xs) = MN "arg" i :: getNames (i + 1) xs
 
 toPatClause : {auto c : Ref Ctxt Defs} ->
               FC -> Name -> (ClosedTerm, ClosedTerm) ->
-              Core (List Pat, ClosedTerm)
+              Core (List (RigCount, Pat), ClosedTerm)
 toPatClause fc n (lhs, rhs)
-    = case getFnArgs lhs of
+    = case getFnArgsWithCounts lhs of
            (Ref ffc Func fn, args)
               => do defs <- get Ctxt
                     (np, _) <- getPosition n (gamma defs)
                     (fnp, _) <- getPosition fn (gamma defs)
                     if np == fnp
-                       then pure (!(traverse argToPat args), rhs)
+                       then do pats <- traverse argToPat args
+                               log "compile.casetree" 10 $ "toPatClause args: " ++ show args ++ ", pats: " ++ show pats
+                               pure (pats, rhs)
                        else throw (GenericMsg ffc ("Wrong function name in pattern LHS " ++ show (n, fn)))
            (f, args) => throw (GenericMsg fc "Not a function name in pattern LHS")
 
@@ -1126,29 +1411,34 @@ toPatClause fc n (lhs, rhs)
 -- the names of the top level variables we created are returned in 'args'
 export
 simpleCase : {auto c : Ref Ctxt Defs} ->
-             FC -> Phase -> Name -> ClosedTerm ->
-             (clauses : List01 True (ClosedTerm, ClosedTerm)) ->
+             FC -> Phase -> Name -> ClosedTerm -> (def : Maybe (CaseTree Scope.empty)) ->
+             (clauses : List (ClosedTerm, ClosedTerm)) ->
              Core (args ** CaseTree args)
-simpleCase fc phase fn ty clauses
+simpleCase fc phase fn ty def clauses
     = do logC "compile.casetree" 5 $
-                do cs <- traverse (\ (c,d) => [| MkPair (toFullNames c) (toFullNames d) |]) (forget clauses)
+                do cs <- traverse (\ (c,d) => [| MkPair (toFullNames c) (toFullNames d) |]) clauses
                    pure $ "simpleCase: Clauses:\n" ++ show (
                      indent 2 $ vcat $ flip map cs $ \ lrhs =>
                        byShow (fst lrhs) <++> pretty "=" <++> byShow (snd lrhs))
-         ps <- traverseList01 (toPatClause fc fn) clauses
+         ps <- traverse (toPatClause fc fn) clauses
          defs <- get Ctxt
-         patCompile fc fn phase ty ps
+         log "compile.casetree" 5 $ "ps: " ++ show ps
+         patCompile fc fn phase ty ps def
 
 mutual
-  findReachedAlts : CaseAlt ns' -> List Int
-  findReachedAlts (ConCase _ _ _ t) = findReached t
-  findReachedAlts (DelayCase _ _ t) = findReached t
-  findReachedAlts (ConstCase _ t) = findReached t
-  findReachedAlts (DefaultCase t) = findReached t
+  findReachedAlts : TCaseAlt ns' -> List Int
+  findReachedAlts (TConCase _ _ _ t) = findReachedCaseScope t
+  findReachedAlts (TDelayCase _ _ _ t) = findReached t
+  findReachedAlts (TConstCase _ _ t) = findReached t
+  findReachedAlts (TDefaultCase _ t) = findReached t
+
+  findReachedCaseScope : TCaseScope a -> List Int
+  findReachedCaseScope (TRHS tm) = findReached tm
+  findReachedCaseScope (TArg _ _ cs) = findReachedCaseScope cs
 
   findReached : CaseTree ns -> List Int
-  findReached (Case _ _ _ alts) = concatMap findReachedAlts alts
-  findReached (STerm i _) = [i]
+  findReached (TCase _ _ _ _ _ alts) = concatMap findReachedAlts alts
+  findReached (STerm i _ _) = [i]
   findReached _ = []
 
 -- Replace a default case with explicit branches for the constructors.
@@ -1158,12 +1448,12 @@ mutual
 -- followed by a removal of duplicate cases there is one _fewer_ total case alts.
 identifyUnreachableDefaults : {auto c : Ref Ctxt Defs} ->
                               {vars : _} ->
-                              FC -> Defs -> NF vars -> List (CaseAlt vars) ->
+                              FC -> Defs -> NF vars -> List (TCaseAlt vars) ->
                               Core (SortedSet Int)
 -- Leave it alone if it's a primitive type though, since we need the catch
 -- all case there
-identifyUnreachableDefaults fc defs (NPrimVal {}) cs = pure empty
-identifyUnreachableDefaults fc defs (NType {}) cs = pure empty
+identifyUnreachableDefaults fc defs (VPrimVal _ _) cs = pure empty
+identifyUnreachableDefaults fc defs (VType _ _) cs = pure empty
 identifyUnreachableDefaults fc defs nfty cs
     = do cs' <- traverse rep cs
          let (cs'', extraClauseIdxs) = dropRep (concat cs') empty
@@ -1178,15 +1468,15 @@ identifyUnreachableDefaults fc defs nfty cs
              "Marking the following clause indices as unreachable under the current branch of the tree: " ++ (show extraClauseIdxs')
          pure extraClauseIdxs'
   where
-    rep : CaseAlt vars -> Core (List (CaseAlt vars))
-    rep (DefaultCase sc)
+    rep : TCaseAlt vars -> Core (List (TCaseAlt vars))
+    rep (TDefaultCase _ sc)
         = do allCons <- getCons defs nfty
              pure (map (mkAlt fc sc) allCons)
     rep c = pure [c]
 
-    dropRep : List (CaseAlt vars) -> SortedSet Int -> (List (CaseAlt vars), SortedSet Int)
+    dropRep : List (TCaseAlt vars) -> SortedSet Int -> (List (TCaseAlt vars), SortedSet Int)
     dropRep [] extra = ([], extra)
-    dropRep (c@(ConCase n t args sc) :: rest) extra
+    dropRep (c@(TConCase _ n t sc) :: rest) extra
           -- assumption is that there's no defaultcase in 'rest' because
           -- we've just removed it
         = let (filteredClauses, extraCases) = partition (not . tagIs t) rest
@@ -1206,55 +1496,63 @@ identifyUnreachableDefaults fc defs nfty cs
 ||| superfluous (it will never be reached).
 findExtraDefaults : {auto c : Ref Ctxt Defs} ->
                     {vars : _} ->
-                    FC -> Defs -> CaseTree vars ->
+                    Defs -> CaseTree vars ->
                     Core (List Int)
-findExtraDefaults fc defs (Case idx el ty altsIn)
-  = do let fenv = mkEnv fc vars
-       nfty <- nf defs fenv ty
+findExtraDefaults defs ctree@(TCase fc _ idx el ty altsIn)
+  = do let fenv = mkEnv fc _
+       nfty <- expand !(nf fenv ty)
        extraCases <- identifyUnreachableDefaults fc defs nfty altsIn
        extraCases' <- concat <$> traverse findExtraAlts altsIn
        pure (Prelude.toList extraCases ++ extraCases')
   where
-    findExtraAlts : CaseAlt vars -> Core (List Int)
-    findExtraAlts (ConCase x tag args ctree) = findExtraDefaults fc defs ctree
-    findExtraAlts (DelayCase x arg ctree) = findExtraDefaults fc defs ctree
-    findExtraAlts (ConstCase x ctree) = findExtraDefaults fc defs ctree
+    findExtraAltsScope : {vars : _} -> TCaseScope vars -> Core (List Int)
+    findExtraAltsScope (TRHS tm) = findExtraDefaults defs tm
+    findExtraAltsScope (TArg c x sc) = findExtraAltsScope sc
+
+    findExtraAlts : TCaseAlt vars -> Core (List Int)
+    findExtraAlts (TConCase _ x tag ctree') = findExtraAltsScope ctree'
+    findExtraAlts (TDelayCase _ x arg ctree') = findExtraDefaults defs ctree'
+    findExtraAlts (TConstCase _ x ctree') = findExtraDefaults defs ctree'
     -- already handled defaults by elaborating them to all possible cons
-    findExtraAlts (DefaultCase ctree) = pure []
+    findExtraAlts (TDefaultCase _ ctree') = pure []
 
-findExtraDefaults fc defs ctree = pure []
+findExtraDefaults defs ctree = pure []
 
--- Returns the case tree, and a list of the clauses that aren't reachable
-export
-getPMDef : {auto c : Ref Ctxt Defs} ->
-           FC -> Phase -> Name -> ClosedTerm -> List Clause ->
-           Core (args ** (CaseTree args, List Clause))
+-- Returns the case tree under the yet-to-be-bound lambdas,
+-- and a list of the clauses that aren't reachable
+makePMDef : {auto c : Ref Ctxt Defs} ->
+            FC -> CaseType -> Phase -> Name -> ClosedTerm -> List Clause ->
+            Core (args ** (Term args, List Clause))
 -- If there's no clauses, make a definition with the right number of arguments
 -- for the type, which we can use in coverage checking to ensure that one of
 -- the arguments has an empty type
-getPMDef fc phase fn ty []
+makePMDef fc ct phase fn ty []
     = do log "compile.casetree.getpmdef" 20 "getPMDef: No clauses!"
          defs <- get Ctxt
-         pure (!(getArgs 0 !(nf defs Env.empty ty)) ** (Unmatched "No clauses in \{show fn}", []))
+         pure (!(getArgs 0 !(expand !(nf Env.empty ty))) ** (Unmatched fc "No clauses", []))
   where
-    getArgs : Int -> ClosedNF -> Core (List Name)
-    getArgs i (NBind fc x (Pi {}) sc)
+    getArgs : Int -> ClosedNF -> Core (SnocList Name)
+    getArgs i (VBind fc x (Pi _ _ _ _) sc)
         = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             pure (MN "arg" i :: !(getArgs i sc'))
-    getArgs i _ = pure []
-getPMDef fc phase fn ty clauses@(_ :: _)
-    = do defs <- get Ctxt
-         let cs = map (toClosed defs) (labelPat 0 $ fromList clauses)
-         (_ ** t) <- simpleCase fc phase fn ty cs
+             sc' <- expand !(sc (pure (VErased fc Placeholder)))
+             pure (!(getArgs i sc') :< MN "arg" i)
+    getArgs i _ = pure [<]
+makePMDef fc ct phase fn ty clauses
+    = do let cs = map toClosed (labelPat 0 clauses)
+         (args' ** t) <- simpleCase fc phase fn ty Nothing cs
+         let treeTm = mkTerm ct t
          logC "compile.casetree.getpmdef" 20 $
-           pure $ "Compiled to: " ++ show !(toFullNames t)
-         let reached = findReached t
+           do t <- toFullNames treeTm
+              pure $ "Compiled to: " ++ show t ++ "\nWith " ++ show args'
+         let allRHS = findReached t
+         log "compile.casetree.clauses" 25 $
+           "All RHSes: " ++ (show allRHS)
+         defs <- get Ctxt
+         extraDefaults <- findExtraDefaults defs t
          log "compile.casetree.clauses" 25 $
-           "Reached clauses: " ++ (show reached)
-         extraDefaults <- findExtraDefaults fc defs t
-         let unreachable = getUnreachable 0 (reached \\ extraDefaults) clauses
-         pure (_ ** (t, unreachable))
+           "Extra defaults: " ++ (show extraDefaults)
+         let unreachable = getUnreachable 0 (allRHS \\ extraDefaults) clauses
+         pure (_ ** (treeTm, unreachable))
   where
     getUnreachable : Int -> List Int -> List Clause -> List Clause
     getUnreachable i is [] = []
@@ -1263,10 +1561,54 @@ getPMDef fc phase fn ty clauses@(_ :: _)
              then getUnreachable (i + 1) is cs
              else c :: getUnreachable (i + 1) is cs
 
-    labelPat : Int -> List01 ne a -> List01 ne (String, a)
+    labelPat : Int -> List a -> List (String, a)
     labelPat i [] = []
     labelPat i (x :: xs) = ("pat" ++ show i ++ ":", x) :: labelPat (i + 1) xs
 
-    toClosed : Defs -> (String, Clause) -> (ClosedTerm, ClosedTerm)
-    toClosed defs (pname, MkClause env lhs rhs)
-          = (close fc pname env lhs, close fc pname env rhs)
+    mkSubstEnv : Int -> String -> Env Term vars -> SubstEnv vars [<]
+    mkSubstEnv i pname [<] = Lin
+    mkSubstEnv i pname (vs :< v)
+        = mkSubstEnv (i + 1) pname vs :< Ref fc Bound (MN pname i)
+
+    close : {vars : _} ->
+            Env Term vars -> String -> Term vars -> ClosedTerm
+    close {vars} env pname tm
+        = substs (mkSizeOf vars) (mkSubstEnv 0 pname env)
+                                 (rewrite appendLinLeftNeutral vars in tm)
+
+    toClosed :  (String, Clause) -> (ClosedTerm, ClosedTerm)
+    toClosed  (pname, MkClause env lhs rhs)
+        = (close env pname lhs, close env pname rhs)
+
+-- Returns the case tree, and a list of the clauses that aren't reachable
+export
+getPMDef : {auto c : Ref Ctxt Defs} ->
+           FC -> CaseType -> Phase -> Name -> ClosedTerm -> List Clause ->
+           Core (ClosedTerm, List Clause)
+getPMDef fc ct p n ty cs
+    = do (args ** (tree, missing)) <- makePMDef fc ct p n ty cs
+         -- We need to bind lambdas, and we can only do that if we know
+         -- the types of the function arguments, so normalise the type just
+         -- enough to get that
+--       Commented in Yaffle for performance:
+--       https://github.com/edwinb/Yaffle/commit/f660b94a66da385ae6f3568998473a12a4cd769d
+--          nty <- normaliseBinders [<] ty
+--          let (tyargs ** env) = mkEnv [<] nty
+--          let Just lenOK = areVarsCompatible args tyargs
+         let tm = bindLams _ tree
+--              | Nothing => throw (CaseCompile fc n CantResolveType)
+         pure (tm, missing)
+   where
+     mkEnv : {vars : _} -> Env Term vars -> Term vars ->
+             (args ** Env Term args)
+     mkEnv env (Bind _ x b@(Pi pfc c p ty) sc) = mkEnv (env :< b) sc
+     mkEnv env tm = (_ ** env)
+
+     bindLams : (args' : _) ->
+                Term args' -> Term [<]
+     bindLams [<] tree = tree
+     bindLams (as :< a) tree
+         = bindLams as (Bind fc _
+                           (Lam fc top
+                                Explicit
+                                (Erased fc Placeholder)) tree)
diff --git a/src/Core/Case/CaseTree.idr b/src/Core/Case/CaseTree.idr
index 2c7b1d07044..5c8dc92b36c 100644
--- a/src/Core/Case/CaseTree.idr
+++ b/src/Core/Case/CaseTree.idr
@@ -2,107 +2,107 @@ module Core.Case.CaseTree
 
 import Core.TT
 
-import Data.List
+import Idris.Pretty.Annotations
+
 import Data.So
 import Data.String
-import Idris.Pretty.Annotations
 
 import Libraries.Data.NameMap
 import Libraries.Text.PrettyPrint.Prettyprinter
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 %default covering
 
-mutual
-  ||| Case trees in A-normal forms
-  ||| i.e. we may only dispatch on variables, not expressions
-  public export
-  data CaseTree : Scoped where
+public export
+data TCaseAlt : SnocList Name -> Type
+
+||| Case trees in A-normal forms
+||| i.e. we may only dispatch on variables, not expressions
+public export
+data CaseTree : Scoped where
        ||| case x return scTy of { p1 => e1 ; ... }
-       Case : {name : _} ->
+       TCase : {name : _} ->
+              FC -> RigCount ->
               (idx : Nat) ->
               (0 p : IsVar name idx vars) ->
-              (scTy : Term vars) -> List (CaseAlt vars) ->
+              (scTy : Term vars) -> List (TCaseAlt vars) ->
               CaseTree vars
-       ||| RHS: no need for further inspection
+       ||| TRHS: no need for further inspection
        ||| The Int is a clause id that allows us to see which of the
        ||| initial clauses are reached in the tree
-       STerm : Int -> Term vars -> CaseTree vars
+       ||| Also record forced patterns (i.e. what we know variables are equal
+       ||| to based on other matches)
+       STerm : Int -> List (Var vars, Term vars) ->
+               Term vars -> CaseTree vars
        ||| error from a partial match
-       Unmatched : (msg : String) -> CaseTree vars
+       TUnmatched : FC -> (msg : String) -> CaseTree vars
        ||| Absurd context
-       Impossible : CaseTree vars
+       TImpossible : FC -> CaseTree vars
 
-  ||| Case alternatives. Unlike arbitrary patterns, they can be at most
-  ||| one constructor deep.
-  public export
-  data CaseAlt : Scoped where
+public export
+data TCaseScope : SnocList Name -> Type where
+  TRHS : CaseTree vars -> TCaseScope vars
+  TArg : RigCount -> (x : Name) -> TCaseScope (vars :< x) -> TCaseScope vars
+
+||| Case alternatives. Unlike arbitrary patterns, they can be at most
+||| one constructor deep.
+public export
+data TCaseAlt : Scoped where
        ||| Constructor for a data type; bind the arguments and subterms.
-       ConCase : Name -> (tag : Int) -> (args : List Name) ->
-                 CaseTree (Scope.addInner vars args) -> CaseAlt vars
+       TConCase : FC -> Name -> (tag : Int) -> TCaseScope vars -> TCaseAlt vars
        ||| Lazy match for the Delay type use for codata types
-       DelayCase : (ty : Name) -> (arg : Name) ->
-                   CaseTree (Scope.addInner vars [ty, arg]) -> CaseAlt vars
-                   -- TODO `arg` and `ty` should be swapped, as in Yaffle
+       TDelayCase : FC -> (ty : Name) -> (arg : Name) ->
+                   CaseTree (Scope.addInner vars [<ty, arg]) -> TCaseAlt vars
        ||| Match against a literal
-       ConstCase : Constant -> CaseTree vars -> CaseAlt vars
+       TConstCase : FC -> Constant -> CaseTree vars -> TCaseAlt vars
        ||| Catch-all case
-       DefaultCase : CaseTree vars -> CaseAlt vars
+       TDefaultCase : FC -> CaseTree vars -> TCaseAlt vars
 
 export
 FreelyEmbeddable CaseTree where
 
-mutual
-  public export
-  measure : CaseTree vars -> Nat
-  measure (Case idx p scTy xs) = sum $ measureAlts <$> xs
-  measure (STerm x y) = 0
-  measure (Unmatched msg) = 0
-  measure Impossible = 0
-
-  measureAlts : CaseAlt vars -> Nat
-  measureAlts (ConCase x tag args y) = 1 + (measure y)
-  measureAlts (DelayCase ty arg x) = 1 + (measure x)
-  measureAlts (ConstCase x y) = 1 + (measure y)
-  measureAlts (DefaultCase x) = 1 + (measure x)
-
-export
-isDefault : CaseAlt vars -> Bool
-isDefault (DefaultCase _) = True
-isDefault _ = False
-
 mutual
   export
   StripNamespace (CaseTree vars) where
-    trimNS ns (Case idx p scTy xs)
-        = Case idx p (trimNS ns scTy) (map (trimNS ns) xs)
-    trimNS ns (STerm x t) = STerm x (trimNS ns t)
+    trimNS ns (TCase fc c idx p scTy xs)
+        = TCase fc c idx p (trimNS ns scTy) (map (trimNS ns) xs)
+    trimNS ns (STerm x fs t) = STerm x fs (trimNS ns t)
     trimNS ns c = c
 
-    restoreNS ns (Case idx p scTy xs)
-        = Case idx p (restoreNS ns scTy) (map (restoreNS ns) xs)
-    restoreNS ns (STerm x t) = STerm x (restoreNS ns t)
+    restoreNS ns (TCase fc c idx p scTy xs)
+        = TCase fc c idx p (restoreNS ns scTy) (map (restoreNS ns) xs)
+    restoreNS ns (STerm x fs t) = STerm x fs (restoreNS ns t)
     restoreNS ns c = c
 
   export
-  StripNamespace (CaseAlt vars) where
-    trimNS ns (ConCase x tag args t) = ConCase x tag args (trimNS ns t)
-    trimNS ns (DelayCase ty arg t) = DelayCase ty arg (trimNS ns t)
-    trimNS ns (ConstCase x t) = ConstCase x (trimNS ns t)
-    trimNS ns (DefaultCase t) = DefaultCase (trimNS ns t)
+  StripNamespace (TCaseScope vars) where
+    trimNS ns (TRHS ct) = TRHS (trimNS ns ct)
+    trimNS ns (TArg ty arg t) = TArg ty arg (trimNS ns t)
 
-    restoreNS ns (ConCase x tag args t) = ConCase x tag args (restoreNS ns t)
-    restoreNS ns (DelayCase ty arg t) = DelayCase ty arg (restoreNS ns t)
-    restoreNS ns (ConstCase x t) = ConstCase x (restoreNS ns t)
-    restoreNS ns (DefaultCase t) = DefaultCase (restoreNS ns t)
+    restoreNS ns (TRHS ct) = TRHS (restoreNS ns ct)
+    restoreNS ns (TArg ty arg t) = TArg ty arg (restoreNS ns t)
+
+  export
+  StripNamespace (TCaseAlt vars) where
+    trimNS ns (TConCase fc n t sc) = TConCase fc n t (trimNS ns sc)
+    trimNS ns (TDelayCase fc ty arg t) = TDelayCase fc ty arg (trimNS ns t)
+    trimNS ns (TConstCase fc x t) = TConstCase fc x (trimNS ns t)
+    trimNS ns (TDefaultCase fc t) = TDefaultCase fc (trimNS ns t)
+
+    restoreNS ns (TConCase fc n t sc) = TConCase fc n t (restoreNS ns sc)
+    restoreNS ns (TDelayCase fc ty arg t) = TDelayCase fc ty arg (restoreNS ns t)
+    restoreNS ns (TConstCase fc x t) = TConstCase fc x (restoreNS ns t)
+    restoreNS ns (TDefaultCase fc t) = TDefaultCase fc (restoreNS ns t)
 
 
 public export
 data Pat : Type where
      PAs : FC -> Name -> Pat -> Pat
      PCon : FC -> Name -> (tag : Int) -> (arity : Nat) ->
-            List Pat -> Pat
-     PTyCon : FC -> Name -> (arity : Nat) -> List Pat -> Pat
+            SnocList (RigCount, Pat) -> Pat
+     PTyCon : FC -> Name -> (arity : Nat) -> SnocList (RigCount, Pat) -> Pat
      PConst : FC -> (c : Constant) -> Pat
      PArrow : FC -> (x : Name) -> Pat -> Pat -> Pat
      PDelay : FC -> LazyReason -> Pat -> Pat -> Pat
@@ -115,6 +115,27 @@ isPConst : Pat -> Maybe Constant
 isPConst (PConst _ c) = Just c
 isPConst _ = Nothing
 
+export
+mkCaseAlt : CaseType -> TCaseAlt vars -> CaseAlt vars
+
+export
+mkTerm : CaseType -> CaseTree vars -> Term vars
+mkTerm ct (TCase fc c idx p scTy xs)
+   = Case fc ct c (Local fc  Nothing idx p) scTy (map (mkCaseAlt ct) xs)
+mkTerm _ (STerm i _ tm) = tm
+mkTerm _ (TUnmatched fc msg) = Unmatched fc msg
+mkTerm _ (TImpossible fc) = Erased fc Impossible
+
+mkCaseScope : CaseType -> TCaseScope vars -> CaseScope vars
+mkCaseScope ct (TRHS (STerm _ fs tm)) = RHS fs tm
+mkCaseScope ct (TRHS tm) = RHS [] (mkTerm ct tm)
+mkCaseScope ct (TArg c x sc) = Arg c x (mkCaseScope ct sc)
+
+mkCaseAlt ct (TConCase fc x tag sc) = ConCase fc x tag (mkCaseScope ct sc)
+mkCaseAlt ct (TDelayCase fc ty arg tm) = DelayCase fc ty arg (mkTerm ct tm)
+mkCaseAlt ct (TConstCase fc c tm) = ConstCase fc c (mkTerm ct tm)
+mkCaseAlt ct (TDefaultCase fc tm) = DefaultCase fc (mkTerm ct tm)
+
 public export
 0 isConPat : Pat -> Bool
 isConPat (PAs _ _ p) = isConPat p
@@ -130,28 +151,40 @@ public export
 IsConPat = So . isConPat
 
 showCT : {vars : _} -> (indent : String) -> CaseTree vars -> String
-showCA : {vars : _} -> (indent : String) -> CaseAlt vars  -> String
+showCA : {vars : _} -> (indent : String) -> TCaseAlt vars  -> String
 
-showCT indent (Case {name} idx prf ty alts)
+showCT indent (TCase {name} _ _ idx prf ty alts)
   = "case " ++ show name ++ "[" ++ show idx ++ "] : " ++ show ty ++ " of"
   ++ "\n" ++ indent ++ " { "
-  ++ showSep ("\n" ++ indent ++ " | ")
+  ++ joinBy ("\n" ++ indent ++ " | ")
              (assert_total (map (showCA ("  " ++ indent)) alts))
   ++ "\n" ++ indent ++ " }"
-showCT indent (STerm i tm) = "[" ++ show i ++ "] " ++ show tm
-showCT indent (Unmatched msg) = "Error: " ++ show msg
-showCT indent Impossible = "Impossible"
-
-showCA indent (ConCase n tag args sc)
-        = showSep " " (map show (n :: args)) ++ " => " ++
-          showCT indent sc
-showCA indent (DelayCase _ arg sc)
+showCT indent (STerm i fs tm)
+  = "[" ++ show i ++ ": " ++ joinBy "," (map showForced fs) ++ "] " ++ show tm
+  where
+    showForced : (Var vars, Term vars) -> String
+    showForced (MkVar v, tm) = show (Local EmptyFC Nothing _ v) ++ " = " ++ show tm
+showCT indent (TUnmatched _ msg) = "Error: " ++ show msg
+showCT indent (TImpossible _) = "Impossible"
+
+showCA indent (TConCase _ n tag sc)
+        = show n ++ " " ++ showScope sc
+  where
+    showScope : {vars : _} -> TCaseScope vars -> String
+    showScope (TRHS tm) = " => " ++ showCT indent tm
+    showScope (TArg c x sc) = show x ++ " " ++ showScope sc
+showCA indent (TDelayCase _ _ arg sc)
         = "Delay " ++ show arg ++ " => " ++ showCT indent sc
-showCA indent (ConstCase c sc)
+showCA indent (TConstCase _ c sc)
         = "Constant " ++ show c ++ " => " ++ showCT indent sc
-showCA indent (DefaultCase sc)
+showCA indent (TDefaultCase _ sc)
         = "_ => " ++ showCT indent sc
 
+export
+{vars : _} -> Show (TCaseScope vars) where
+    show (TRHS rhs) = " => rhs" --++ showCT "" rhs
+    show (TArg r nm sc) = " " ++ show nm ++ show sc
+
 export
 covering
 {vars : _} -> Show (CaseTree vars) where
@@ -159,29 +192,34 @@ covering
 
 export
 covering
-{vars : _} -> Show (CaseAlt vars) where
+{vars : _} -> Show (TCaseAlt vars) where
   show = showCA ""
 
 mutual
   export
   eqTree : CaseTree vs -> CaseTree vs' -> Bool
-  eqTree (Case i _ _ alts) (Case i' _ _ alts')
+  eqTree (TCase _ _ i _ _ alts) (TCase _ _ i' _ _ alts')
       = i == i'
        && length alts == length alts'
        && all (uncurry eqAlt) (zip alts alts')
-  eqTree (STerm _ t) (STerm _ t') = eqTerm t t'
-  eqTree (Unmatched _) (Unmatched _) = True
-  eqTree Impossible Impossible = True
+  eqTree (STerm _ _ t) (STerm _ _ t') = eqTerm t t'
+  eqTree (TUnmatched _ _) (TUnmatched _ _) = True
+  eqTree (TImpossible _) (TImpossible _) = True
   eqTree _ _ = False
 
-  eqAlt : CaseAlt vs -> CaseAlt vs' -> Bool
-  eqAlt (ConCase n t args tree) (ConCase n' t' args' tree')
-      = n == n' && eqTree tree tree' -- assume arities match, since name does
-  eqAlt (DelayCase _ _ tree) (DelayCase _ _ tree')
+  eqScope : forall vs, vs' . TCaseScope vs -> TCaseScope vs' -> Bool
+  eqScope (TRHS tm) (TRHS tm') = eqTree tm tm'
+  eqScope (TArg _ _ sc) (TArg _ _ sc') = eqScope sc sc'
+  eqScope _ _ = False
+
+  eqAlt : TCaseAlt vs -> TCaseAlt vs' -> Bool
+  eqAlt (TConCase _ n t sc) (TConCase _ n' t' sc')
+      = n == n' && eqScope sc sc' -- assume arities match, since name does
+  eqAlt (TDelayCase _ _ _ tree) (TDelayCase _ _ _ tree')
       = eqTree tree tree'
-  eqAlt (ConstCase c tree) (ConstCase c' tree')
+  eqAlt (TConstCase _ c tree) (TConstCase _ c' tree')
       = c == c' && eqTree tree tree'
-  eqAlt (DefaultCase tree) (DefaultCase tree')
+  eqAlt (TDefaultCase _ tree) (TDefaultCase _ tree')
       = eqTree tree tree'
   eqAlt _ _ = False
 
@@ -189,8 +227,8 @@ export
 covering
 Show Pat where
   show (PAs _ n p) = show n ++ "@(" ++ show p ++ ")"
-  show (PCon _ n i _ args) = show n ++ " " ++ show i ++ " " ++ assert_total (show args)
-  show (PTyCon _ n _ args) = "<TyCon>" ++ show n ++ " " ++ assert_total (show args)
+  show (PCon _ n i _ args) = show n ++ " " ++ show i ++ " " ++ assert_total (show $ toList args)
+  show (PTyCon _ n _ args) = "<TyCon>" ++ show n ++ " " ++ assert_total (show $ toList args)
   show (PConst _ c) = show c
   show (PArrow _ x s t) = "(" ++ show s ++ " -> " ++ show t ++ ")"
   show (PDelay _ _ _ p) = "(Delay " ++ show p ++ ")"
@@ -201,9 +239,9 @@ export
 Pretty IdrisSyntax Pat where
   prettyPrec d (PAs _ n p) = pretty0 n <++> keyword "@" <+> parens (pretty p)
   prettyPrec d (PCon _ n _ _ args) =
-    parenthesise (d > Open) $ hsep (pretty0 n :: map (prettyPrec App) args)
+    parenthesise (d > Open) $ hsep (pretty0 n :: map (prettyPrec App . snd) (toList args))
   prettyPrec d (PTyCon _ n _ args) =
-    parenthesise (d > Open) $ hsep (pretty0 n :: map (prettyPrec App) args)
+    parenthesise (d > Open) $ hsep (pretty0 n :: map (prettyPrec App . snd) (toList args))
   prettyPrec d (PConst _ c) = pretty c
   prettyPrec d (PArrow _ _ p q) =
     parenthesise (d > Open) $ pretty p <++> arrow <++> pretty q
@@ -212,39 +250,42 @@ Pretty IdrisSyntax Pat where
   prettyPrec d (PUnmatchable _ tm) = keyword "." <+> parens (byShow tm)
 
 mutual
-  insertCaseNames : SizeOf outer ->
-                    SizeOf ns ->
-                    CaseTree (outer ++ inner) ->
-                    CaseTree (outer ++ (ns ++ inner))
-  insertCaseNames outer ns (Case idx prf scTy alts)
-      = let MkNVar prf' = insertNVarNames outer ns (MkNVar prf) in
-            Case _ prf' (insertNames outer ns scTy)
-                (map (insertCaseAltNames outer ns) alts)
-  insertCaseNames outer ns (STerm i x) = STerm i (insertNames outer ns x)
-  insertCaseNames _ _ (Unmatched msg) = Unmatched msg
-  insertCaseNames _ _ Impossible = Impossible
-
-  insertCaseAltNames : SizeOf outer ->
-                       SizeOf ns ->
-                       CaseAlt (outer ++ inner) ->
-                       CaseAlt (outer ++ (ns ++ inner))
-  insertCaseAltNames p q (ConCase x tag args ct)
-      = ConCase x tag args
-           (rewrite appendAssociative args outer (ns ++ inner) in
-                    insertCaseNames (mkSizeOf args + p) q {inner}
-                        (rewrite sym (appendAssociative args outer inner) in
-                                 ct))
-  insertCaseAltNames outer ns (DelayCase tyn valn ct)
-      = DelayCase tyn valn
-                  (insertCaseNames (suc (suc outer)) ns ct)
-  insertCaseAltNames outer ns (ConstCase x ct)
-      = ConstCase x (insertCaseNames outer ns ct)
-  insertCaseAltNames outer ns (DefaultCase ct)
-      = DefaultCase (insertCaseNames outer ns ct)
+  insertCaseNames : GenWeakenable CaseTree
+  insertCaseNames mid inn (TCase fc c idx prf scTy alts)
+      = let MkNVar prf' = insertNVarNames mid inn (MkNVar prf) in
+            TCase fc c _ prf' (insertNames mid inn scTy)
+                 (map (insertCaseAltNames mid inn) alts)
+  insertCaseNames mid inn (STerm i vs x)
+    = STerm i (map ( \(v, t) => (insertVarNames mid inn v,
+                                 insertNames mid inn t)) vs)
+              (insertNames mid inn x)
+  insertCaseNames _ _ (TUnmatched fc msg) = TUnmatched fc msg
+  insertCaseNames _ _ (TImpossible fc) = TImpossible fc
+
+  insertCaseScopeNames : GenWeakenable TCaseScope
+  insertCaseScopeNames mid inn (TRHS tm) = TRHS (insertCaseNames mid inn tm)
+  insertCaseScopeNames mid inn (TArg c x sc)
+      = TArg c x (insertCaseScopeNames mid (suc inn) sc)
+
+  insertCaseAltNames : GenWeakenable TCaseAlt
+  insertCaseAltNames mid inn (TConCase fc n t sc)
+      = TConCase fc n t (insertCaseScopeNames mid inn sc)
+
+  insertCaseAltNames mid inn (TDelayCase fc tyn valn ct)
+      = TDelayCase fc tyn valn
+                  (insertCaseNames mid (suc (suc inn)) ct)
+  insertCaseAltNames mid inn (TConstCase fc x ct)
+      = TConstCase fc x (insertCaseNames mid inn ct)
+  insertCaseAltNames mid inn (TDefaultCase fc ct)
+      = TDefaultCase fc (insertCaseNames mid inn ct)
 
 export
 Weaken CaseTree where
-  weakenNs ns t = insertCaseNames zero ns t
+  weakenNs ns t = insertCaseNames ns zero t
+
+export
+Weaken TCaseScope where
+  weakenNs ns t = insertCaseScopeNames ns zero t
 
 total
 getNames : (forall vs . NameMap Bool -> Term vs -> NameMap Bool) ->
@@ -252,50 +293,44 @@ getNames : (forall vs . NameMap Bool -> Term vs -> NameMap Bool) ->
 getNames add ns sc = getSet ns sc
   where
     mutual
-      getAltSet : NameMap Bool -> CaseAlt vs -> NameMap Bool
-      getAltSet ns (ConCase n t args sc) = getSet ns sc
-      getAltSet ns (DelayCase t a sc) = getSet ns sc
-      getAltSet ns (ConstCase i sc) = getSet ns sc
-      getAltSet ns (DefaultCase sc) = getSet ns sc
+      getAltSet : NameMap Bool -> TCaseAlt vs -> NameMap Bool
+      getAltSet ns (TConCase _ n t sc) = getScope ns sc
+      getAltSet ns (TDelayCase _ t a sc) = getSet ns sc
+      getAltSet ns (TConstCase _ i sc) = getSet ns sc
+      getAltSet ns (TDefaultCase _ sc) = getSet ns sc
 
-      getAltSets : NameMap Bool -> List (CaseAlt vs) -> NameMap Bool
+      getScope : NameMap Bool -> TCaseScope vs -> NameMap Bool
+      getScope ns (TRHS tm) = getSet ns tm
+      getScope ns (TArg _ x sc) = getScope ns sc
+
+      getAltSets : NameMap Bool -> List (TCaseAlt vs) -> NameMap Bool
       getAltSets ns [] = ns
       getAltSets ns (a :: as) = getAltSets (getAltSet ns a) as
 
       getSet : NameMap Bool -> CaseTree vs -> NameMap Bool
-      getSet ns (Case _ x ty xs) = getAltSets ns xs
-      getSet ns (STerm i tm) = add ns tm
-      getSet ns (Unmatched msg) = ns
-      getSet ns Impossible = ns
-
-export
-getRefs : (aTotal : Name) -> CaseTree vars -> NameMap Bool
-getRefs at = getNames (addRefs False at) empty
-
-export
-addRefs : (aTotal : Name) -> NameMap Bool -> CaseTree vars -> NameMap Bool
-addRefs at ns = getNames (addRefs False at) ns
+      getSet ns (TCase _ _ _ x ty []) = ns
+      getSet ns (TCase _ _ _ x ty (a :: as)) = getAltSets (getAltSet ns a) as
+      getSet ns (STerm _ _ tm) = add ns tm
+      getSet ns (TUnmatched _ msg) = ns
+      getSet ns (TImpossible _) = ns
 
-export
-getMetas : CaseTree vars -> NameMap Bool
-getMetas = getNames (addMetas False) empty
-
-export
-mkTerm : (vars : Scope) -> Pat -> Term vars
-mkTerm vars (PAs fc x y) = mkTerm vars y
-mkTerm vars (PCon fc x tag arity xs)
-    = apply fc (Ref fc (DataCon tag arity) x)
-               (map (mkTerm vars) xs)
-mkTerm vars (PTyCon fc x arity xs)
-    = apply fc (Ref fc (TyCon arity) x)
-               (map (mkTerm vars) xs)
-mkTerm vars (PConst fc c) = PrimVal fc c
-mkTerm vars (PArrow fc x s t)
-    = Bind fc x (Pi fc top Explicit (mkTerm vars s)) (mkTerm (x :: vars) t)
-mkTerm vars (PDelay fc r ty p)
-    = TDelay fc r (mkTerm vars ty) (mkTerm vars p)
-mkTerm vars (PLoc fc n)
-    = case isVar n vars of
-           Just (MkVar prf) => Local fc Nothing _ prf
-           _ => Ref fc Bound n
-mkTerm vars (PUnmatchable fc tm) = embed tm
+namespace Pattern
+  export
+  mkTerm : (vars : Scope) -> Pat -> Term vars
+  mkTerm vars (PAs fc x y) = mkTerm vars y
+  mkTerm vars (PCon fc x tag arity xs)
+      = applySpine fc (Ref fc (DataCon tag arity) x)
+                      (map @{Compose} (mkTerm vars) xs)
+  mkTerm vars (PTyCon fc x arity xs)
+      = applySpine fc (Ref fc (TyCon arity) x)
+                      (map @{Compose} (mkTerm vars) xs)
+  mkTerm vars (PConst fc c) = PrimVal fc c
+  mkTerm vars (PArrow fc x s t)
+      = Bind fc x (Pi fc top Explicit (mkTerm vars s)) (mkTerm (Scope.bind vars x) t)
+  mkTerm vars (PDelay fc r ty p)
+      = TDelay fc r (mkTerm vars ty) (mkTerm vars p)
+  mkTerm vars (PLoc fc n)
+      = case isVar n vars of
+            Just (MkVar prf) => Local fc Nothing _ prf
+            _ => Ref fc Bound n
+  mkTerm vars (PUnmatchable fc tm) = embed tm
diff --git a/src/Core/Case/CaseTree/Pretty.idr b/src/Core/Case/CaseTree/Pretty.idr
deleted file mode 100644
index a2aab79e369..00000000000
--- a/src/Core/Case/CaseTree/Pretty.idr
+++ /dev/null
@@ -1,101 +0,0 @@
-module Core.Case.CaseTree.Pretty
-
-import Core.Case.CaseTree
-import Core.Env
-import Idris.Syntax
-import Idris.Pretty
-import Idris.Resugar
-
-import Data.String
-import Libraries.Text.PrettyPrint.Prettyprinter
-
-namespace Raw
-
-  export
-  prettyTree : {vars : _} -> CaseTree vars -> Doc IdrisSyntax
-  prettyAlt : {vars : _} -> CaseAlt vars -> Doc IdrisSyntax
-
-  prettyTree (Case {name} idx prf ty alts)
-      = let ann = case ty of
-                    Erased {} => ""
-                    _ => space <+> keyword ":" <++> byShow ty
-        in case_ <++> annotate Bound (pretty0 name) <+> ann <++> of_
-         <+> nest 2 (hardline
-         <+> vsep (assert_total (map prettyAlt alts)))
-  prettyTree (STerm i tm) = byShow tm
-  prettyTree (Unmatched msg) = "Error:" <++> pretty0 msg
-  prettyTree Impossible = "Impossible"
-
-  prettyAlt (ConCase n tag args sc)
-      = hsep (annotate (DCon (Just n)) (pretty0 n) ::  map pretty0 args)
-        <++> fatArrow
-        <+> let sc = prettyTree sc in
-            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-  prettyAlt (DelayCase _ arg sc) =
-        keyword "Delay" <++> pretty0 arg
-        <++> fatArrow
-        <+> let sc = prettyTree sc in
-            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-  prettyAlt (ConstCase c sc) =
-        pretty c
-        <++> fatArrow
-        <+> let sc = prettyTree sc in
-            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-  prettyAlt (DefaultCase sc) =
-        keyword "_"
-        <++> fatArrow
-        <+> let sc = prettyTree sc in
-            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-
-namespace Resugared
-
-  prettyName : {auto c : Ref Ctxt Defs} ->
-               Name -> Core (Doc IdrisSyntax)
-  prettyName nm
-    = pure $ ifThenElse (fullNamespace !(getPPrint))
-               (pretty0 nm)
-               (cast $ prettyOp True $ dropNS nm)
-
-  export
-  prettyTree : {vars : _} ->
-    {auto c : Ref Ctxt Defs} ->
-    {auto s : Ref Syn SyntaxInfo} ->
-    Env Term vars -> CaseTree vars -> Core (Doc IdrisSyntax)
-  prettyAlt : {vars : _} ->
-    {auto c : Ref Ctxt Defs} ->
-    {auto s : Ref Syn SyntaxInfo} ->
-    Env Term vars -> CaseAlt vars -> Core (Doc IdrisSyntax)
-
-  prettyTree env (Case {name} idx prf ty alts) = do
-    ann <- case ty of
-             Erased {} => pure ""
-             _ => do ty <- resugar env ty
-                     pure (space <+> keyword ":" <++> pretty ty)
-    alts <- assert_total (traverse (prettyAlt env) alts)
-    pure $ case_ <++> pretty0 name <+> ann <++> of_
-       <+> nest 2 (hardline <+> vsep alts)
-  prettyTree env (STerm i tm) = pretty <$> resugar env tm
-  prettyTree env (Unmatched msg) = pure ("Error:" <++> pretty0 msg)
-  prettyTree env Impossible = pure "Impossible"
-
-  prettyAlt env (ConCase n tag args sc) = do
-    con <- prettyName n
-    sc <- prettyTree (mkEnvOnto emptyFC args env) sc
-    pure $ hsep (annotate (DCon (Just n)) con ::  map pretty0 args)
-     <++> fatArrow
-      <+> Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-  prettyAlt env (DelayCase _ arg sc) = do
-    sc <- prettyTree (mkEnvOnto emptyFC [_,_] env) sc
-    pure $ keyword "Delay" <++> pretty0 arg
-        <++> fatArrow
-        <+> Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-  prettyAlt env (ConstCase c sc) = do
-    sc <- prettyTree env sc
-    pure $ pretty c
-        <++> fatArrow
-        <+> Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
-  prettyAlt env (DefaultCase sc) = do
-    sc <- prettyTree env sc
-    pure $ keyword "_"
-        <++> fatArrow
-        <+> Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
diff --git a/src/Core/Case/Util.idr b/src/Core/Case/Util.idr
index d5a9d659930..b57e61c5b8b 100644
--- a/src/Core/Case/Util.idr
+++ b/src/Core/Case/Util.idr
@@ -2,9 +2,14 @@ module Core.Case.Util
 
 import Core.Case.CaseTree
 import Core.Context
-import Core.Value
+import Core.Evaluate.Value
 
-import Libraries.Data.List.SizeOf
+import Parser.Rule.Source
+
+import Data.SnocList
+
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 public export
 record DataCon where
@@ -12,48 +17,102 @@ record DataCon where
   name  : Name
   tag   : Int
   arity : Nat
+  quantities : List RigCount
 
 ||| Given a normalised type, get all the possible constructors for that
 ||| type family, with their type, name, tag, and arity.
 export
 getCons : Defs -> NF vars -> Core (List DataCon)
-getCons defs (NTCon _ tn _ _)
-    = case !(lookupDefExact tn (gamma defs)) of
-           Just (TCon _ _ _ _ _ cons _) =>
-                do cs' <- traverse addTy (fromMaybe [] cons)
-                   pure (catMaybes cs')
-           _ => throw (InternalError "Called `getCons` on something that is not a Type constructor")
+getCons defs (VTCon fc tn _ _)
+    = if is_primitive
+        then -- This a primitive type, so nothing to add (we
+             -- can't generate all the possibilities after all!)
+             pure []
+        else
+          case !(lookupDefExact tn (gamma defs)) of
+              Just (TCon _ _ _ _ _ cons _) =>
+                    do cs' <- traverse addTy (fromMaybe [] cons)
+                       pure (catMaybes cs')
+              x => throw (InternalError "Called `getCons` on something that is not a Type constructor: \{show tn} of \{show x}")
   where
+    is_primitive : Bool
+    is_primitive = case tn of
+      UN (Basic n) => elem n reservedNames
+      _ => False
+
     addTy : Name -> Core (Maybe DataCon)
     addTy cn
         = do Just gdef <- lookupCtxtExact cn (gamma defs)
                   | _ => pure Nothing
              case (gdef.definition, gdef.type) of
-                  (DCon t arity _, ty) =>
-                        pure . Just $ MkDataCon cn t arity
+                  (DCon di t arity, ty) =>
+                        pure . Just $ MkDataCon cn t arity (quantities di)
                   _ => pure Nothing
 getCons defs _ = pure []
 
 emptyRHS : FC -> CaseTree vars -> CaseTree vars
-emptyRHS fc (Case idx el sc alts) = Case idx el sc (map emptyRHSalt alts)
+emptyRHS _ (TCase cfc c idx el sc alts) = TCase cfc c idx el sc (map emptyRHSalt alts)
+  where
+    emptyRHSscope : forall vars . FC -> TCaseScope vars -> TCaseScope vars
+    emptyRHSscope fc (TRHS tm) = TRHS (emptyRHS fc tm)
+    emptyRHSscope fc (TArg c x sc) = TArg c x (emptyRHSscope fc sc)
+
+    emptyRHSalt : TCaseAlt vars -> TCaseAlt vars
+    emptyRHSalt (TConCase fc n t sc) = TConCase fc n t (emptyRHSscope fc sc)
+    emptyRHSalt (TDelayCase fc c arg sc) = TDelayCase fc c arg (emptyRHS fc sc)
+    emptyRHSalt (TConstCase fc c sc) = TConstCase fc c (emptyRHS fc sc)
+    emptyRHSalt (TDefaultCase fc sc) = TDefaultCase fc (emptyRHS fc sc)
+emptyRHS fc (STerm i fs s) = STerm i fs (Erased fc Placeholder)
+emptyRHS _ sc = sc
+
+export
+mkAlt : FC -> CaseTree vars -> DataCon -> TCaseAlt vars
+mkAlt fc sc (MkDataCon cn t ar qs)
+    = TConCase fc cn t (mkScope qs (map (MN "m") (take ar [0..])))
+  where
+    mkScope : List RigCount -> SnocList Name -> TCaseScope vars
+    mkScope _ [<] = TRHS (emptyRHS fc sc)
+    mkScope [] (vs :< v) = TArg top v (weaken (mkScope [] vs))
+    mkScope (q :: qs) (vs :< v) = TArg q v (weaken (mkScope qs vs))
+
+emptyRHSTm : FC -> Term vars -> Term vars
+emptyRHSTm fc (Case cfc ct c sc scTy alts)
+    = Case cfc ct c sc scTy (map emptyRHSalt alts)
+  where
+    emptyRHSscope : forall vars . FC -> CaseScope vars -> CaseScope vars
+    emptyRHSscope fc (RHS fs tm) = RHS fs (emptyRHSTm fc tm)
+    emptyRHSscope fc (Arg c x sc) = Arg c x (emptyRHSscope fc sc)
+
+    emptyRHSalt : forall vars . CaseAlt vars -> CaseAlt vars
+    emptyRHSalt (ConCase fc n t sc) = ConCase fc n t (emptyRHSscope fc sc)
+    emptyRHSalt (DelayCase fc c arg sc) = DelayCase fc c arg (emptyRHSTm fc sc)
+    emptyRHSalt (ConstCase fc c sc) = ConstCase fc c (emptyRHSTm fc sc)
+    emptyRHSalt (DefaultCase fc sc) = DefaultCase fc (emptyRHSTm fc sc)
+emptyRHSTm fc tm@(Unmatched _ _) = tm
+emptyRHSTm fc _ = Erased fc Placeholder
+
+export
+mkAltTm : {vars : _} ->
+        FC -> Term vars -> DataCon -> CaseAlt vars
+mkAltTm fc sc (MkDataCon cn t ar qs)
+    = ConCase fc cn t (mkScope zero qs (map (MN "m") (take ar [0..])))
   where
-    emptyRHSalt : CaseAlt vars -> CaseAlt vars
-    emptyRHSalt (ConCase n t args sc) = ConCase n t args (emptyRHS fc sc)
-    emptyRHSalt (DelayCase c arg sc) = DelayCase c arg (emptyRHS fc sc)
-    emptyRHSalt (ConstCase c sc) = ConstCase c (emptyRHS fc sc)
-    emptyRHSalt (DefaultCase sc) = DefaultCase (emptyRHS fc sc)
-emptyRHS fc (STerm i s) = STerm i (Erased fc Placeholder)
-emptyRHS fc sc = sc
+    mkScope : SizeOf more -> List RigCount -> SnocList Name ->
+              CaseScope (vars ++ more)
+    mkScope s _ [<] = RHS [] (weakenNs s (emptyRHSTm fc sc))
+    mkScope s [] (vs :< v) = Arg top v (mkScope (suc s) [] vs)
+    mkScope s (q :: qs) (vs :< v) = Arg q v (mkScope (suc s) qs vs)
 
 export
-mkAlt : FC -> CaseTree vars -> DataCon -> CaseAlt vars
-mkAlt fc sc (MkDataCon cn t ar)
-    = ConCase cn t (map (MN "m") (take ar [0..]))
-              (weakenNs (map take) (emptyRHS fc sc))
+tagIs : Int -> TCaseAlt vars -> Bool
+tagIs t (TConCase _ _ t' _) = t == t'
+tagIs t (TConstCase _ _ _) = False
+tagIs t (TDelayCase _ _ _ _) = False
+tagIs t (TDefaultCase _ _) = True
 
 export
-tagIs : Int -> CaseAlt vars -> Bool
-tagIs t (ConCase _ t' _ _) = t == t'
-tagIs t (ConstCase {}) = False
-tagIs t (DelayCase {}) = False
-tagIs t (DefaultCase _) = True
+tagIsTm : Int -> CaseAlt vars -> Bool
+tagIsTm t (ConCase _ _ t' _) = t == t'
+tagIsTm t (ConstCase _ {}) = False
+tagIsTm t (DelayCase _ {}) = False
+tagIsTm t (DefaultCase _ _) = True
diff --git a/src/Core/CompileExpr.idr b/src/Core/CompileExpr.idr
index ab125936c9e..f79103d23a1 100644
--- a/src/Core/CompileExpr.idr
+++ b/src/Core/CompileExpr.idr
@@ -4,11 +4,13 @@ module Core.CompileExpr
 
 import Core.TT
 
-import Data.List
+import Data.String
 import Data.Vect
+import Data.SnocList.Quantifiers
 
 import Libraries.Data.List.SizeOf
 import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
 
 %default covering
 
@@ -74,11 +76,11 @@ mutual
        CLocal : {idx : Nat} -> FC -> (0 p : IsVar x idx vars) -> CExp vars
        CRef : FC -> Name -> CExp vars
        -- Lambda expression
-       CLam : FC -> (x : Name) -> CExp (x :: vars) -> CExp vars
+       CLam : FC -> (x : Name) -> CExp (Scope.bind vars x) -> CExp vars
        -- Let bindings
        CLet : FC -> (x : Name) ->
               InlineOk -> -- Don't inline if set
-              CExp vars -> CExp (x :: vars) -> CExp vars
+              CExp vars -> CExp (Scope.bind vars x) -> CExp vars
        -- Application of a defined function. The length of the argument list is
        -- exactly the same length as expected by its definition (so saturate with
        -- lambdas if necessary, or overapply with additional CApps)
@@ -107,12 +109,17 @@ mutual
        -- Some sort of crash?
        CCrash : FC -> String -> CExp vars
 
+  public export
+  data CCaseScope : Scoped where
+       CRHS : CExp vars -> CCaseScope vars
+       CArg : (x : Name) -> CCaseScope (vars :< x) -> CCaseScope vars
+
   public export
   data CConAlt : Scoped where
        -- If no tag, then match by constructor name. Back ends might want to
        -- convert names to a unique integer for performance.
-       MkConAlt : Name -> ConInfo -> (tag : Maybe Int) -> (args : List Name) ->
-                  CExp (args ++ vars) -> CConAlt vars
+       MkConAlt : Name -> ConInfo -> (tag : Maybe Int) ->
+                  CCaseScope vars -> CConAlt vars
 
   public export
   data CConstAlt : Scoped where
@@ -120,7 +127,7 @@ mutual
 
 public export
 ClosedCExp : Type
-ClosedCExp = CExp []
+ClosedCExp = CExp Scope.empty
 
 mutual
   ||| NamedCExp - as above, but without the name index, so with explicit
@@ -251,9 +258,9 @@ mutual
     show (NmForce _ lr x) = "(%force " ++ show lr ++ " " ++ show x ++ ")"
     show (NmDelay _ lr x) = "(%delay " ++ show lr ++ " " ++ show x ++ ")"
     show (NmConCase _ sc xs def)
-        = assert_total $ "(%case " ++ show sc ++ " " ++ show xs ++ " " ++ show def ++ ")"
+        = assert_total $ "(%case con " ++ show sc ++ " " ++ show xs ++ " " ++ show def ++ ")"
     show (NmConstCase _ sc xs def)
-        = assert_total $ "(%case " ++ show sc ++ " " ++ show xs ++ " " ++ show def ++ ")"
+        = assert_total $ "(%case const " ++ show sc ++ " " ++ show xs ++ " " ++ show def ++ ")"
     show (NmPrimVal _ x) = show x
     show (NmErased _) = "___"
     show (NmCrash _ x) = "(CRASH " ++ show x ++ ")"
@@ -274,13 +281,17 @@ mutual
          = "(%constcase " ++ show x ++ " " ++ show exp ++ ")"
 
 export
-data Names : Scoped where
-     Nil : Names []
-     (::) : Name -> Names xs -> Names (x :: xs)
+Names : Scoped
+Names = All (\_ => Name)
+
+namespace Names
+  public export
+  empty : Names Scope.empty
+  empty = [<]
 
 elem : Name -> Names xs -> Bool
-elem n [] = False
-elem n (x :: xs) = n == x || elem n xs
+elem n [<] = False
+elem n (xs :< x) = n == x || elem n xs
 
 tryNext : Name -> Name
 tryNext (UN n) = MN (displayUserName n) 0
@@ -294,31 +305,45 @@ uniqueName s ns =
        else s
 
 export
-getLocName : (idx : Nat) -> Names vars -> (0 p : IsVar name idx vars) -> Name
-getLocName Z (x :: xs) First = x
-getLocName (S k) (x :: xs) (Later p) = getLocName k xs p
+addLocz : (args : Scope) -> Names vars -> Names (Scope.addInner vars args)
+addLocz [<] ns = ns
+addLocz (xs :< x) ns
+  = let rec = addLocz xs ns in
+    rec :< uniqueName x rec
+
+export
+initLocs : (vars : Scope) -> Names vars
+initLocs vars
+  = rewrite sym $ appendLinLeftNeutral vars in
+    addLocz vars [<]
 
 export
-addLocs : (args : List Name) -> Names vars -> Names (args ++ vars)
+addLocs : (args : List Name) -> Names vars -> Names (Scope.ext vars args)
 addLocs [] ns = ns
 addLocs (x :: xs) ns
-    = let rec = addLocs xs ns in
-          uniqueName x rec :: rec
+    = let n = uniqueName x ns in
+      addLocs xs (ns :< n)
 
-conArgs : (args : List Name) -> Names (args ++ vars) -> List Name
-conArgs [] ns = []
-conArgs (a :: as) (n :: ns) = n :: conArgs as ns
+conArgz : (args : SnocList Name) -> Names (Scope.addInner vars args) -> SnocList Name
+conArgz [<] ns = [<]
+conArgz (as :< a) (ns :< n) = conArgz as ns :< n
+
+conArgs : (args : List Name) -> Names (Scope.ext vars args) -> List Name
+conArgs args ns
+  = let ns' : Names (vars ++ cast args)
+      := rewrite sym $ fishAsSnocAppend vars args in ns
+    in toList $ conArgz (cast {to=Scope} args) ns'
 
 mutual
   forgetExp : Names vars -> CExp vars -> NamedCExp
-  forgetExp locs (CLocal fc p) = NmLocal fc (getLocName _ locs p)
+  forgetExp locs (CLocal fc p) = NmLocal fc (lookup locs p)
   forgetExp locs (CRef fc n) = NmRef fc n
   forgetExp locs (CLam fc x sc)
       = let locs' = addLocs [x] locs in
-            NmLam fc (getLocName _ locs' First) (forgetExp locs' sc)
+            NmLam fc (lookup locs' First) (forgetExp locs' sc)
   forgetExp locs (CLet fc x _ val sc)
       = let locs' = addLocs [x] locs in
-            NmLet fc (getLocName _ locs' First)
+            NmLet fc (lookup locs' First)
                      (forgetExp locs val)
                      (forgetExp locs' sc)
   forgetExp locs (CApp fc f args)
@@ -343,9 +368,15 @@ mutual
   forgetExp locs (CErased fc) = NmErased fc
   forgetExp locs (CCrash fc msg) = NmCrash fc msg
 
+  getConScope : CCaseScope vars -> (ns : List Name ** CExp (Scope.ext vars ns))
+  getConScope (CRHS tm) = ([] ** tm)
+  getConScope (CArg c sc)
+      = let (args ** sc') = getConScope sc in ((c :: args) ** sc')
+
   forgetConAlt : Names vars -> CConAlt vars -> NamedConAlt
-  forgetConAlt locs (MkConAlt n ci t args exp)
-      = let args' = addLocs args locs in
+  forgetConAlt locs (MkConAlt n ci t sc)
+      = let (args ** exp) = getConScope sc
+            args' = addLocs args locs in
             MkNConAlt n ci t (conArgs args args') (forgetExp args' exp)
 
   forgetConstAlt : Names vars -> CConstAlt vars -> NamedConstAlt
@@ -354,16 +385,14 @@ mutual
 
 export
 forget : {vars : _} -> CExp vars -> NamedCExp
-forget {vars} exp
-    = forgetExp (addLocs vars [])
-                (rewrite appendNilRightNeutral vars in exp)
+forget exp = forgetExp (initLocs vars) exp
 
 export
 forgetDef : CDef -> NamedDef
 forgetDef (MkFun args def)
-    = let ns = addLocs args []
-          args' = conArgs {vars = Scope.empty} args ns in
-          MkNmFun args' (forget def)
+    = let ns = addLocz args Names.empty
+          args' = conArgz {vars = Scope.empty} args ns in
+          MkNmFun (cast args') (forget def)
 forgetDef (MkCon t a nt) = MkNmCon t a nt
 forgetDef (MkForeign ccs fargs ty) = MkNmForeign ccs fargs ty
 forgetDef (MkError err) = MkNmError (forget err)
@@ -373,6 +402,16 @@ covering
 {vars : _} -> Show (CExp vars) where
   show exp = show (forget exp)
 
+public export
+{vars : _} -> Show (CCaseScope vars) where
+    show (CRHS rhs) = " => " ++ (assert_total $ show rhs)
+    show (CArg r nm) = " " ++ show nm
+
+public export
+covering
+{vars : _} -> Show (CConAlt vars) where
+    show (MkConAlt name ci t ccasescope) = "{MkConAlt name: \{show name}, ci: \{show ci}, t: \{show t}, ccasescope: \{show ccasescope}}"
+
 export
 covering
 Show CFType where
@@ -397,13 +436,13 @@ Show CFType where
   show CFWorld = "%World"
   show (CFFun s t) = show s ++ " -> " ++ show t
   show (CFIORes t) = "IORes " ++ show t
-  show (CFStruct n args) = "struct " ++ show n ++ " " ++ showSep " " (map show args)
-  show (CFUser n args) = show n ++ " " ++ showSep " " (map show args)
+  show (CFStruct n args) = "struct " ++ show n ++ " " ++ joinBy " " (map show args)
+  show (CFUser n args) = show n ++ " " ++ joinBy " " (toList $ map show args)
 
 export
 covering
 Show CDef where
-  show (MkFun args exp) = show args ++ ": " ++ show exp
+  show (MkFun args exp) = show (toList args) ++ ": " ++ show exp
   show (MkCon tag arity pos)
       = "Constructor tag " ++ show tag ++ " arity " ++ show arity ++
         maybe "" (\n => " (newtype by " ++ show n ++ ")") pos
@@ -426,55 +465,47 @@ Show NamedDef where
 
 mutual
   export
-  insertNames : SizeOf outer ->
-                SizeOf ns ->
-                CExp (outer ++ inner) ->
-                CExp (outer ++ (ns ++ inner))
-  insertNames outer ns (CLocal fc prf)
-      = let MkNVar var' = insertNVarNames outer ns (MkNVar prf) in
+  insertNames : GenWeakenable CExp
+  insertNames mid inn (CLocal fc prf)
+      = let MkNVar var' = insertNVarNames mid inn (MkNVar prf) in
             CLocal fc var'
   insertNames _ _ (CRef fc x) = CRef fc x
-  insertNames outer ns (CLam fc x sc)
-      = let sc' = insertNames (suc outer) ns sc in
+  insertNames mid inn (CLam fc x sc)
+      = let sc' = insertNames mid (suc inn) sc in
             CLam fc x sc'
-  insertNames outer ns (CLet fc x inl val sc)
-      = let sc' = insertNames (suc outer) ns sc in
-            CLet fc x inl (insertNames outer ns val) sc'
-  insertNames outer ns (CApp fc x xs)
-      = CApp fc (insertNames outer ns x) (assert_total (map (insertNames outer ns) xs))
-  insertNames outer ns (CCon fc ci x tag xs)
-      = CCon fc ci x tag (assert_total (map (insertNames outer ns) xs))
-  insertNames outer ns (COp fc x xs)
-      = COp fc x (assert_total (map (insertNames outer ns) xs))
-  insertNames outer ns (CExtPrim fc p xs)
-      = CExtPrim fc p (assert_total (map (insertNames outer ns) xs))
-  insertNames outer ns (CForce fc lr x) = CForce fc lr (insertNames outer ns x)
-  insertNames outer ns (CDelay fc lr x) = CDelay fc lr (insertNames outer ns x)
-  insertNames outer ns (CConCase fc sc xs def)
-      = CConCase fc (insertNames outer ns sc) (assert_total (map (insertNamesConAlt outer ns) xs))
-                 (assert_total (map (insertNames outer ns) def))
-  insertNames outer ns (CConstCase fc sc xs def)
-      = CConstCase fc (insertNames outer ns sc) (assert_total (map (insertNamesConstAlt outer ns) xs))
-                   (assert_total (map (insertNames outer ns) def))
+  insertNames mid inn (CLet fc x inl val sc)
+      = let sc' = insertNames mid (suc inn) sc in
+            CLet fc x inl (insertNames mid inn val) sc'
+  insertNames mid inn (CApp fc x xs)
+      = CApp fc (insertNames mid inn x) (assert_total (map (insertNames mid inn) xs))
+  insertNames mid inn (CCon fc ci x tag xs)
+      = CCon fc ci x tag (assert_total (map (insertNames mid inn) xs))
+  insertNames mid inn (COp fc x xs)
+      = COp fc x (assert_total (map (insertNames mid inn) xs))
+  insertNames mid inn (CExtPrim fc p xs)
+      = CExtPrim fc p (assert_total (map (insertNames mid inn) xs))
+  insertNames mid inn (CForce fc lr x) = CForce fc lr (insertNames mid inn x)
+  insertNames mid inn (CDelay fc lr x) = CDelay fc lr (insertNames mid inn x)
+  insertNames mid inn (CConCase fc sc xs def)
+      = CConCase fc (insertNames mid inn sc) (assert_total (map (insertNamesConAlt mid inn) xs))
+                 (assert_total (map (insertNames mid inn) def))
+  insertNames mid inn (CConstCase fc sc xs def)
+      = CConstCase fc (insertNames mid inn sc) (assert_total (map (insertNamesConstAlt mid inn) xs))
+                   (assert_total (map (insertNames mid inn) def))
   insertNames _ _ (CPrimVal fc x) = CPrimVal fc x
   insertNames _ _ (CErased fc) = CErased fc
   insertNames _ _ (CCrash fc x) = CCrash fc x
 
-  insertNamesConAlt : SizeOf outer ->
-                      SizeOf ns ->
-                      CConAlt (outer ++ inner) ->
-                      CConAlt (outer ++ (ns ++ inner))
-  insertNamesConAlt {outer} {ns} p q (MkConAlt x ci tag args sc)
-        = let sc' : CExp ((args ++ outer) ++ inner)
-                  = rewrite sym (appendAssociative args outer inner) in sc in
-              MkConAlt x ci tag args
-               (rewrite appendAssociative args outer (ns ++ inner) in
-                        insertNames (mkSizeOf args + p) q sc')
-
-  insertNamesConstAlt : SizeOf outer ->
-                        SizeOf ns ->
-                        CConstAlt (outer ++ inner) ->
-                        CConstAlt (outer ++ (ns ++ inner))
+  insertNamesCScope : GenWeakenable CCaseScope
+  insertNamesCScope mid inn (CRHS tm) = CRHS (insertNames mid inn tm)
+  insertNamesCScope mid inn (CArg x sc)
+      = CArg x (insertNamesCScope mid (suc inn) sc)
+
+  insertNamesConAlt : GenWeakenable CConAlt
+  insertNamesConAlt mid inn (MkConAlt x ci tag sc)
+        = MkConAlt x ci tag (insertNamesCScope mid inn sc)
+
+  insertNamesConstAlt : GenWeakenable CConstAlt
   insertNamesConstAlt outer ns (MkConstAlt x sc) = MkConstAlt x (insertNames outer ns sc)
 
 export
@@ -518,35 +549,51 @@ mutual
   shrinkCExp _ (CErased fc) = CErased fc
   shrinkCExp _ (CCrash fc x) = CCrash fc x
 
+  export
+  shrinkCScope : Thin newvars vars -> CCaseScope vars -> CCaseScope newvars
+  shrinkCScope p (CRHS tm) = CRHS (shrinkCExp p tm)
+  shrinkCScope p (CArg x sc)
+      = CArg x (shrinkCScope (Keep p) sc)
+
   shrinkConAlt : Thin newvars vars -> CConAlt vars -> CConAlt newvars
-  shrinkConAlt sub (MkConAlt x ci tag args sc)
-        = MkConAlt x ci tag args (shrinkCExp (keeps args sub) sc)
+  shrinkConAlt sub (MkConAlt x ci tag sc)
+        = MkConAlt x ci tag (shrinkCScope sub sc)
 
   shrinkConstAlt : Thin newvars vars -> CConstAlt vars -> CConstAlt newvars
   shrinkConstAlt sub (MkConstAlt x sc) = MkConstAlt x (shrinkCExp sub sc)
 
 export
 Weaken CExp where
-  weakenNs ns tm = insertNames zero ns tm
+  weakenNs ns tm = insertNames ns zero tm
 
 export
 Weaken CConAlt where
-  weakenNs ns tm = insertNamesConAlt zero ns tm
+  weakenNs ns tm = insertNamesConAlt ns zero tm
 
 public export
 SubstCEnv : Scope -> Scoped
 SubstCEnv = Subst CExp
 
+public export
+covering
+[ShowSubstCEnv] {dropped, vars : _} -> Show (SubstCEnv dropped vars) where
+    show x = "SubstCEnv [" ++ showAll x ++ "]{vars = " ++ show (toList vars) ++ ", dropped = " ++ show (toList dropped) ++ "}"
+        where
+            showAll : {dropped, vars : _} -> SubstCEnv dropped vars -> String
+            showAll Lin = ""
+            showAll (Lin :< x) = show x
+            showAll (xx :< x) = showAll xx ++ ", " ++ show x
+
 mutual
   substEnv : Substitutable CExp CExp
   substEnv outer dropped env (CLocal fc prf)
       = find (\ (MkVar p) => CLocal fc p) outer dropped (MkVar prf) env
   substEnv _ _ _ (CRef fc x) = CRef fc x
   substEnv outer dropped env (CLam fc x sc)
-      = let sc' = substEnv (suc outer) dropped env sc in
+      = let sc' = substEnv outer (suc dropped) env sc in
             CLam fc x sc'
   substEnv outer dropped env (CLet fc x inl val sc)
-      = let sc' = substEnv (suc outer) dropped env sc in
+      = let sc' = substEnv outer (suc dropped) env sc in
             CLet fc x inl (substEnv outer dropped env val) sc'
   substEnv outer dropped env (CApp fc x xs)
       = CApp fc (substEnv outer dropped env x) (assert_total (map (substEnv outer dropped env) xs))
@@ -570,86 +617,95 @@ mutual
   substEnv _ _ _ (CErased fc) = CErased fc
   substEnv _ _ _ (CCrash fc x) = CCrash fc x
 
+  substCScope : Substitutable CExp CCaseScope
+  substCScope outer dropped env (CRHS tm) = CRHS (substEnv outer dropped env tm)
+  substCScope outer dropped env (CArg x sc) = CArg x (substCScope outer (suc dropped) env sc)
+
   substConAlt : Substitutable CExp CConAlt
-  substConAlt {vars} {outer} {dropped} p q env (MkConAlt x ci tag args sc)
-      = MkConAlt x ci tag args
-           (rewrite appendAssociative args outer vars in
-                    substEnv (mkSizeOf args + p) q env
-                      (rewrite sym (appendAssociative args outer (dropped ++ vars)) in
-                               sc))
+  substConAlt {outer} {dropped} {inner} drp inn env (MkConAlt x ci tag sc)
+    = MkConAlt x ci tag (substCScope drp inn env sc)
 
   substConstAlt : Substitutable CExp CConstAlt
   substConstAlt outer dropped env (MkConstAlt x sc) = MkConstAlt x (substEnv outer dropped env sc)
 
 export
-substs : {dropped, vars : _} ->
+substs : {0 dropped, vars : _} ->
          SizeOf dropped ->
-         SubstCEnv dropped vars -> CExp (dropped ++ vars) -> CExp vars
-substs = substEnv zero
+         SubstCEnv dropped vars -> CExp (Scope.addInner vars dropped) -> CExp vars
+substs drp = substEnv drp zero
 
 mutual
   export
-  mkLocals : SizeOf outer ->
-             Bounds bound ->
-             CExp (outer ++ vars) ->
-             CExp (outer ++ (bound ++ vars))
-  mkLocals later bs (CLocal {idx} {x} fc p)
-      = let MkNVar p' = addVars later bs (MkNVar p) in CLocal {x} fc p'
-  mkLocals later bs (CRef fc var)
+  mkLocals : Bounds bound ->
+             SizeOf inner ->
+             CExp (Scope.addInner outer inner) ->
+             CExp ((outer ++ bound) ++ inner)
+  mkLocals bs inn (CLocal {idx} {x} fc p)
+      = let MkNVar p' = addVars bs inn (MkNVar p) in CLocal {x} fc p'
+  mkLocals bs inn (CRef fc var)
       = fromMaybe (CRef fc var) $ do
-          MkVar p <- resolveRef later [<] bs fc var
+          MkVar p <- resolveRef var bs inn
           pure (CLocal fc p)
-  mkLocals later bs (CLam fc x sc)
-      = let sc' = mkLocals (suc later) bs sc in
+  mkLocals bs inn (CLam fc x sc)
+      = let sc' = mkLocals bs (suc inn) sc in
             CLam fc x sc'
-  mkLocals later bs (CLet fc x inl val sc)
-      = let sc' = mkLocals (suc later) bs sc in
-            CLet fc x inl (mkLocals later bs val) sc'
-  mkLocals later bs (CApp fc f xs)
-      = CApp fc (mkLocals later bs f) (assert_total (map (mkLocals later bs) xs))
-  mkLocals later bs (CCon fc ci x tag xs)
-      = CCon fc ci x tag (assert_total (map (mkLocals later bs) xs))
-  mkLocals later bs (COp fc x xs)
-      = COp fc x (assert_total (map (mkLocals later bs) xs))
-  mkLocals later bs (CExtPrim fc x xs)
-      = CExtPrim fc x (assert_total (map (mkLocals later bs) xs))
-  mkLocals later bs (CForce fc lr x)
-      = CForce fc lr (mkLocals later bs x)
-  mkLocals later bs (CDelay fc lr x)
-      = CDelay fc lr (mkLocals later bs x)
-  mkLocals later bs (CConCase fc sc xs def)
-      = CConCase fc (mkLocals later bs sc)
-                 (assert_total (map (mkLocalsConAlt later bs) xs))
-                 (assert_total (map (mkLocals later bs) def))
-  mkLocals later bs (CConstCase fc sc xs def)
-      = CConstCase fc (mkLocals later bs sc)
-                 (assert_total (map (mkLocalsConstAlt later bs) xs))
-                 (assert_total (map (mkLocals later bs) def))
-  mkLocals later bs (CPrimVal fc x) = CPrimVal fc x
-  mkLocals later bs (CErased fc) = CErased fc
-  mkLocals later bs (CCrash fc x) = CCrash fc x
-
-  mkLocalsConAlt : SizeOf outer ->
-                   Bounds bound ->
-                   CConAlt (outer ++ vars) ->
-                   CConAlt (outer ++ (bound ++ vars))
-  mkLocalsConAlt {bound} {outer} {vars} p bs (MkConAlt x ci tag args sc)
-        = let sc' : CExp ((args ++ outer) ++ vars)
-                  = rewrite sym (appendAssociative args outer vars) in sc in
-              MkConAlt x ci tag args
-               (rewrite appendAssociative args outer (bound ++ vars) in
-                        mkLocals (mkSizeOf args + p) bs sc')
-
-  mkLocalsConstAlt : SizeOf outer ->
-                     Bounds bound ->
-                     CConstAlt (outer ++ vars) ->
-                     CConstAlt (outer ++ (bound ++ vars))
-  mkLocalsConstAlt later bs (MkConstAlt x sc) = MkConstAlt x (mkLocals later bs sc)
+  mkLocals bs inn (CLet fc x inl val sc)
+      = let sc' = mkLocals bs (suc inn) sc in
+            CLet fc x inl (mkLocals bs inn val) sc'
+  mkLocals bs inn (CApp fc f xs)
+      = CApp fc (mkLocals bs inn f) (assert_total (map (mkLocals bs inn) xs))
+  mkLocals bs inn (CCon fc ci x tag xs)
+      = CCon fc ci x tag (assert_total (map (mkLocals bs inn) xs))
+  mkLocals bs inn (COp fc x xs)
+      = COp fc x (assert_total (map (mkLocals bs inn) xs))
+  mkLocals bs inn (CExtPrim fc x xs)
+      = CExtPrim fc x (assert_total (map (mkLocals bs inn) xs))
+  mkLocals bs inn (CForce fc lr x)
+      = CForce fc lr (mkLocals bs inn x)
+  mkLocals bs inn (CDelay fc lr x)
+      = CDelay fc lr (mkLocals bs inn x)
+  mkLocals bs inn (CConCase fc sc xs def)
+      = CConCase fc (mkLocals bs inn sc)
+                 (assert_total (map (mkLocalsConAlt bs inn) xs))
+                 (assert_total (map (mkLocals bs inn) def))
+  mkLocals bs inn (CConstCase fc sc xs def)
+      = CConstCase fc (mkLocals bs inn sc)
+                 (assert_total (map (mkLocalsConstAlt bs inn) xs))
+                 (assert_total (map (mkLocals bs inn) def))
+  mkLocals bs inn (CPrimVal fc x) = CPrimVal fc x
+  mkLocals bs inn (CErased fc) = CErased fc
+  mkLocals bs inn (CCrash fc x) = CCrash fc x
+
+  mkLocalsCScope : Bounds bound ->
+                   SizeOf inner ->
+                   CCaseScope (Scope.addInner outer inner) ->
+                   CCaseScope ((outer ++ bound) ++ inner)
+  mkLocalsCScope bs inn (CRHS tm) = CRHS (mkLocals bs inn tm)
+  mkLocalsCScope bs inn (CArg x sc)
+      = CArg x (mkLocalsCScope bs (suc inn) sc)
+
+  mkLocalsConAlt : Bounds bound ->
+                   SizeOf inner ->
+                   CConAlt (Scope.addInner outer inner) ->
+                   CConAlt ((outer ++ bound) ++ inner)
+  mkLocalsConAlt bs inn (MkConAlt x ci tag sc)
+      =  MkConAlt x ci tag (mkLocalsCScope bs inn sc)
+
+  mkLocalsConstAlt : Bounds bound ->
+                     SizeOf inner ->
+                     CConstAlt (outer ++ inner) ->
+                     CConstAlt ((outer ++ bound) ++ inner)
+  mkLocalsConstAlt bs inn (MkConstAlt x sc) = MkConstAlt x (mkLocals bs inn sc)
 
 export
-refsToLocals : Bounds bound -> CExp vars -> CExp (bound ++ vars)
+refsToLocals : Bounds bound -> CExp vars -> CExp (Scope.addInner vars bound)
 refsToLocals None tm = tm
-refsToLocals bs y = mkLocals zero bs y
+refsToLocals bs y = mkLocals bs zero y
+
+export
+refsToLocalsScope : Bounds bound -> CCaseScope vars -> CCaseScope (Scope.addInner vars bound)
+refsToLocalsScope None sc = sc
+refsToLocalsScope bs y = mkLocalsCScope bs zero y
 
 export
 getFC : CExp args -> FC
diff --git a/src/Core/CompileExpr/Pretty.idr b/src/Core/CompileExpr/Pretty.idr
index 5c17674585b..0faf2f27a72 100644
--- a/src/Core/CompileExpr/Pretty.idr
+++ b/src/Core/CompileExpr/Pretty.idr
@@ -16,13 +16,9 @@ import Idris.Doc.Annotations
 
 %hide Core.Name.prettyOp
 
-%hide CompileExpr.(::)
-%hide CompileExpr.Nil
 %hide String.(::)
 %hide String.Nil
 %hide Doc.Nil
-%hide Subst.(::)
-%hide Subst.Nil
 %hide CList.(::)
 %hide CList.Nil
 %hide Stream.(::)
@@ -114,7 +110,7 @@ prettyCExp : {args : _} -> CExp args -> Doc IdrisSyntax
 prettyCExp = prettyNamedCExp . forget
 
 prettyCDef : CDef -> Doc IdrisDocAnn
-prettyCDef (MkFun [] exp) = reAnnotate Syntax $ prettyCExp exp
+prettyCDef (MkFun [<] exp) = reAnnotate Syntax $ prettyCExp exp
 prettyCDef (MkFun args exp) = reAnnotate Syntax $
   keyword "\\" <++> concatWith (\ x, y => x <+> keyword "," <++> y) (map prettyName $ toList args)
        <++> fatArrow <++> prettyCExp exp
diff --git a/src/Core/Context.idr b/src/Core/Context.idr
index d71acaa0610..43d3fcd35ff 100644
--- a/src/Core/Context.idr
+++ b/src/Core/Context.idr
@@ -11,17 +11,21 @@ import        Core.Options
 import public Core.Options.Log
 import public Core.TT
 
-import Libraries.Utils.Binary
-import Libraries.Utils.Path
-import Libraries.Utils.Scheme
-import Libraries.Text.PrettyPrint.Prettyprinter
-
 import Idris.Syntax.Pragmas
 
 import Data.Either
 import Data.IOArray
 import Data.List1
 import Data.Nat
+import Data.String
+
+import System.Clock
+import System.Directory
+
+import Libraries.Utils.Binary
+import Libraries.Utils.Path
+import Libraries.Utils.Scheme
+import Libraries.Text.PrettyPrint.Prettyprinter
 import Libraries.Data.IntMap
 import Libraries.Data.NameMap
 import Libraries.Data.NatSet
@@ -30,9 +34,6 @@ import Libraries.Data.UserNameMap
 import Libraries.Data.WithDefault
 import Libraries.Text.Distance.Levenshtein
 
-import System.Clock
-import System.Directory
-
 %default covering
 
 export
@@ -165,7 +166,7 @@ returnDef : Bool -> Int -> GlobalDef -> Maybe (Int, GlobalDef)
 returnDef False idx def = Just (idx, def)
 returnDef True idx def
     = case definition def of
-           PMDef pi _ _ _ _ =>
+           Function pi _ _ _ =>
                  if alwaysReduce pi
                     then Just (idx, def)
                     else Nothing
@@ -393,6 +394,37 @@ interface HasNames a where
   full : Context -> a -> Core a
   resolved : Context -> a -> Core a
 
+export
+HasNames a => HasNames (List a) where
+  full c ns = full_aux c [] ns
+    where full_aux : Context -> List a -> List a -> Core (List a)
+          full_aux c res [] = pure (reverse res)
+          full_aux c res (n :: ns) = full_aux c (!(full c n):: res) ns
+
+  resolved c ns = resolved_aux c [] ns
+    where resolved_aux : Context -> List a -> List a -> Core (List a)
+          resolved_aux c res [] = pure (reverse res)
+          resolved_aux c res (n :: ns) = resolved_aux c (!(resolved c n) :: res) ns
+
+export
+HasNames a => HasNames (SnocList a) where
+  full c ns = full_aux c [<] ns
+    where full_aux : Context -> SnocList a -> SnocList a -> Core (SnocList a)
+          full_aux c res [<] = pure (reverse res)
+          full_aux c res (ns :< n) = full_aux c (res :< !(full c n)) ns
+
+  resolved c ns = resolved_aux c [<] ns
+    where resolved_aux : Context -> SnocList a -> SnocList a -> Core (SnocList a)
+          resolved_aux c res [<] = pure (reverse res)
+          resolved_aux c res (ns :< n) = resolved_aux c (res :< !(resolved c n)) ns
+
+export
+HasNames a => HasNames (Maybe a) where
+  full gam Nothing = pure Nothing
+  full gam (Just x) = pure $ Just !(full gam x)
+  resolved gam Nothing = pure Nothing
+  resolved gam (Just x) = pure $ Just !(resolved gam x)
+
 export
 HasNames Name where
   full gam (Resolved i)
@@ -426,6 +458,55 @@ HasNames UConstraint where
       = do x' <- resolved gam x; y' <- resolved gam y
            pure (ULE x' y')
 
+export
+HasNames a => HasNames (RigCount, a) where
+  full gam (c, t) = pure $ (c, !(full gam t))
+  resolved gam (c, t) = pure $ (c, !(resolved gam t))
+
+export
+HasNames CaseType where
+  full gam PatMatch = pure PatMatch
+  full gam (CaseBlock n) = pure $ CaseBlock !(full gam n)
+
+  resolved gam PatMatch = pure PatMatch
+  resolved gam (CaseBlock n) = pure $ CaseBlock !(resolved gam n)
+
+export
+HasNames (Term vars)
+
+export
+HasNames (Var vars, Term vars) where
+  full gam (v, tm) = pure (v, !(full gam tm))
+  resolved gam (v, tm) = pure (v, !(resolved gam tm))
+
+export
+HasNames (CaseScope vars) where
+  full gam (RHS fs x) = pure (RHS !(full gam fs) !(full gam x))
+  full gam (Arg c x sc) = pure (Arg c x !(full gam sc))
+
+  resolved gam (RHS fs x) = pure (RHS !(resolved gam fs) !(resolved gam x))
+  resolved gam (Arg c x sc) = pure (Arg c x !(resolved gam sc))
+
+export
+HasNames (CaseAlt vars) where
+  full gam (ConCase fc x tag y)
+      = pure (ConCase fc !(full gam x) tag !(full gam y))
+  full gam (DelayCase fc ty arg x)
+      = pure (DelayCase fc ty arg !(full gam x))
+  full gam (ConstCase fc c x)
+      = pure (ConstCase fc c !(full gam x))
+  full gam (DefaultCase fc x)
+      = pure (DefaultCase fc !(full gam x))
+
+  resolved gam (ConCase fc x tag y)
+      = pure (ConCase fc !(resolved gam x) tag !(resolved gam y))
+  resolved gam (DelayCase fc ty arg x)
+      = pure (DelayCase fc ty arg !(resolved gam x))
+  resolved gam (ConstCase fc c x)
+      = pure (ConstCase fc c !(resolved gam x))
+  resolved gam (DefaultCase fc x)
+      = pure (DefaultCase fc !(resolved gam x))
+
 export
 HasNames (Term vars) where
   full gam (Ref fc x (Resolved i))
@@ -439,10 +520,12 @@ HasNames (Term vars) where
              Just gdef => Meta fc (fullname gdef) i xs
   full gam (Bind fc x b scope)
       = pure (Bind fc x !(traverse (full gam) b) !(full gam scope))
-  full gam (App fc fn arg)
-      = pure (App fc !(full gam fn) !(full gam arg))
+  full gam (App fc fn c arg)
+      = pure (App fc !(full gam fn) c !(full gam arg))
   full gam (As fc s p tm)
       = pure (As fc s !(full gam p) !(full gam tm))
+  full gam (Case fc t c sc scTy alts)
+      = pure (Case fc !(full gam t) c !(full gam sc) !(full gam scTy) !(full gam alts))
   full gam (TDelayed fc x y)
       = pure (TDelayed fc x !(full gam y))
   full gam (TDelay fc x t y)
@@ -468,10 +551,12 @@ HasNames (Term vars) where
            pure (Meta fc x i xs')
   resolved gam (Bind fc x b scope)
       = pure (Bind fc x !(traverse (resolved gam) b) !(resolved gam scope))
-  resolved gam (App fc fn arg)
-      = pure (App fc !(resolved gam fn) !(resolved gam arg))
+  resolved gam (App fc fn c arg)
+      = pure (App fc !(resolved gam fn) c !(resolved gam arg))
   resolved gam (As fc s p tm)
       = pure (As fc s !(resolved gam p) !(resolved gam tm))
+  resolved gam (Case fc t c sc scTy alts)
+      = pure (Case fc !(resolved gam t) c !(resolved gam sc) !(resolved gam scTy) !(resolved gam alts))
   resolved gam (TDelayed fc x y)
       = pure (TDelayed fc x !(resolved gam y))
   resolved gam (TDelay fc x t y)
@@ -516,56 +601,15 @@ HasNames Pat where
   resolved gam (PLoc fc n) = PLoc fc <$> resolved gam n
   resolved gam (PUnmatchable fc t) = PUnmatchable fc <$> resolved gam t
 
-mutual
-  export
-  HasNames (CaseTree vars) where
-    full gam (Case i v ty alts)
-        = pure $ Case i v !(full gam ty) !(traverse (full gam) alts)
-    full gam (STerm i tm)
-        = pure $ STerm i !(full gam tm)
-    full gam t = pure t
-
-    resolved gam (Case i v ty alts)
-        = pure $ Case i v !(resolved gam ty) !(traverse (resolved gam) alts)
-    resolved gam (STerm i tm)
-        = pure $ STerm i !(resolved gam tm)
-    resolved gam t = pure t
-
-  export
-  HasNames (CaseAlt vars) where
-    full gam (ConCase n t args sc)
-        = do sc' <- full gam sc
-             Just gdef <- lookupCtxtExact n gam
-                | Nothing => pure (ConCase n t args sc')
-             pure $ ConCase (fullname gdef) t args sc'
-    full gam (DelayCase ty arg sc)
-        = pure $ DelayCase ty arg !(full gam sc)
-    full gam (ConstCase c sc)
-        = pure $ ConstCase c !(full gam sc)
-    full gam (DefaultCase sc)
-        = pure $ DefaultCase !(full gam sc)
-
-    resolved gam (ConCase n t args sc)
-        = do sc' <- resolved gam sc
-             let Just i = getNameID n gam
-                | Nothing => pure (ConCase n t args sc')
-             pure $ ConCase (Resolved i) t args sc'
-    resolved gam (DelayCase ty arg sc)
-        = pure $ DelayCase ty arg !(resolved gam sc)
-    resolved gam (ConstCase c sc)
-        = pure $ ConstCase c !(resolved gam sc)
-    resolved gam (DefaultCase sc)
-        = pure $ DefaultCase !(resolved gam sc)
-
 export
 HasNames (Env Term vars) where
-  full gam [] = pure Env.empty
-  full gam (b :: bs)
-      = pure $ !(traverse (full gam) b) :: !(full gam bs)
+  full gam [<] = pure Env.empty
+  full gam (bs :< b)
+      = pure $ !(full gam bs) :< !(traverse (full gam) b)
 
-  resolved gam [] = pure Env.empty
-  resolved gam (b :: bs)
-      = pure $ !(traverse (resolved gam) b) :: !(resolved gam bs)
+  resolved gam [<] = pure Env.empty
+  resolved gam (bs :< b)
+      = pure $ !(resolved gam bs) :< !(traverse (resolved gam) b)
 
 export
 HasNames Clause where
@@ -578,15 +622,8 @@ HasNames Clause where
 
 export
 HasNames Def where
-  full gam (PMDef r args ct rt pats)
-      = pure $ PMDef r args !(full gam ct) !(full gam rt)
-                     !(traverse fullNamesPat pats)
-    where
-      fullNamesPat : (vs ** (Env Term vs, Term vs, Term vs)) ->
-                     Core (vs ** (Env Term vs, Term vs, Term vs))
-      fullNamesPat (_ ** (env, lhs, rhs))
-          = pure $ (_ ** (!(full gam env),
-                          !(full gam lhs), !(full gam rhs)))
+  full gam (Function x ctm rtm cs)
+      = pure $ Function x !(full gam ctm) !(full gam rtm) !(full gam cs)
   full gam (TCon a ps ds u ms mcs det)
       = pure $ TCon a ps ds u !(traverse (full gam) ms)
                                 !(traverseOpt (traverse (full gam)) mcs) det
@@ -596,15 +633,8 @@ HasNames Def where
       = pure $ Guess !(full gam tm) b cs
   full gam t = pure t
 
-  resolved gam (PMDef r args ct rt pats)
-      = pure $ PMDef r args !(resolved gam ct) !(resolved gam rt)
-                     !(traverse resolvedNamesPat pats)
-    where
-      resolvedNamesPat : (vs ** (Env Term vs, Term vs, Term vs)) ->
-                         Core (vs ** (Env Term vs, Term vs, Term vs))
-      resolvedNamesPat (_ ** (env, lhs, rhs))
-          = pure $ (_ ** (!(resolved gam env),
-                          !(resolved gam lhs), !(resolved gam rhs)))
+  resolved gam (Function x ctm rtm cs)
+      = pure $ Function x !(resolved gam ctm) !(resolved gam rtm) !(resolved gam cs)
   resolved gam (TCon a ps ds u ms mcs det)
       = pure $ TCon a ps ds u !(traverse (resolved gam) ms)
                                 !(traverseOpt (traverse (full gam)) mcs) det
@@ -614,24 +644,22 @@ HasNames Def where
       = pure $ Guess !(resolved gam tm) b cs
   resolved gam t = pure t
 
+export
+StripNamespace Clause where
+  trimNS gam (MkClause env lhs rhs)
+     = MkClause env (trimNS gam lhs) (trimNS gam rhs)
+
+  restoreNS gam (MkClause env lhs rhs)
+    = MkClause env (restoreNS gam lhs) (restoreNS gam rhs)
+
 export
 StripNamespace Def where
-  trimNS ns (PMDef i args ct rt pats)
-      = PMDef i args (trimNS ns ct) rt (map trimNSpat pats)
-    where
-      trimNSpat : (vs ** (Env Term vs, Term vs, Term vs)) ->
-                  (vs ** (Env Term vs, Term vs, Term vs))
-      trimNSpat (vs ** (env, lhs, rhs))
-          = (vs ** (env, trimNS ns lhs, trimNS ns rhs))
+  trimNS ns (Function x ctm rtm cs)
+      = Function x (trimNS ns ctm) rtm (trimNS ns cs)
   trimNS ns d = d
 
-  restoreNS ns (PMDef i args ct rt pats)
-      = PMDef i args (restoreNS ns ct) rt (map restoreNSpat pats)
-    where
-      restoreNSpat : (vs ** (Env Term vs, Term vs, Term vs)) ->
-                  (vs ** (Env Term vs, Term vs, Term vs))
-      restoreNSpat (vs ** (env, lhs, rhs))
-          = (vs ** (env, restoreNS ns lhs, restoreNS ns rhs))
+  restoreNS ns (Function x ctm rtm cs)
+      = Function x (restoreNS ns ctm) rtm (restoreNS ns cs)
   restoreNS ns d = d
 
 export
@@ -755,6 +783,7 @@ HasNames Error where
   full gam ImpossibleCase = pure ImpossibleCase
   full gam (LinearUsed fc k n) = LinearUsed fc k <$> full gam n
   full gam (LinearMisuse fc n x y) = LinearMisuse fc <$> full gam n <*> pure x <*> pure y
+  full gam (InconsistentUse fc ns) = InconsistentUse fc <$> traverse (traversePair $ traverse $ full gam) ns
   full gam (BorrowPartial fc rho s t) = BorrowPartial fc <$> full gam rho <*> full gam s <*> full gam t
   full gam (BorrowPartialType fc rho s) = BorrowPartialType fc <$> full gam rho <*> full gam s
   full gam (AmbiguousName fc xs) = AmbiguousName fc <$> traverse (full gam) xs
@@ -854,6 +883,7 @@ HasNames Error where
   resolved gam ImpossibleCase = pure ImpossibleCase
   resolved gam (LinearUsed fc k n) = LinearUsed fc k <$> resolved gam n
   resolved gam (LinearMisuse fc n x y) = LinearMisuse fc <$> resolved gam n <*> pure x <*> pure y
+  resolved gam (InconsistentUse fc ns) = InconsistentUse fc <$> traverse (traversePair $ traverse $ resolved gam) ns
   resolved gam (BorrowPartial fc rho s t) = BorrowPartial fc <$> resolved gam rho <*> resolved gam s <*> resolved gam t
   resolved gam (BorrowPartialType fc rho s) = BorrowPartialType fc <$> resolved gam rho <*> resolved gam s
   resolved gam (AmbiguousName fc xs) = AmbiguousName fc <$> traverse (resolved gam) xs
@@ -941,13 +971,6 @@ HasNames SCCall where
   full gam sc = pure $ { fnCall := !(full gam (fnCall sc)) } sc
   resolved gam sc = pure $ { fnCall := !(resolved gam (fnCall sc)) } sc
 
-export
-HasNames a => HasNames (Maybe a) where
-  full gam Nothing = pure Nothing
-  full gam (Just x) = pure $ Just !(full gam x)
-  resolved gam Nothing = pure Nothing
-  resolved gam (Just x) = pure $ Just !(resolved gam x)
-
 export
 HasNames GlobalDef where
   full gam def
@@ -992,6 +1015,7 @@ record Defs where
   constructor MkDefs
   gamma : Context
   mutData : List Name -- Currently declared but undefined data types
+  uconstraints : List UConstraint
   currentNS : Namespace -- namespace for current definitions
   nestedNS : List Namespace -- other nested namespaces we can look in
   options : Options
@@ -1033,7 +1057,7 @@ record Defs where
   cgdirectives : List (CG, String)
      -- ^ Code generator directives, which are free form text and thus to
      -- be interpreted however the specific code generator requires
-  toCompileCase : List Name
+  toCompileCase : List (CaseType, Name)
      -- ^ Names which need to be compiled to run time case trees
   incData : List (CG, String, List String)
      -- ^ What we've compiled incrementally for this module: codegen,
@@ -1082,6 +1106,7 @@ initDefs
          pure $ MkDefs
            { gamma = gam
            , mutData = []
+           , uconstraints = []
            , currentNS = mainNS
            , nestedNS = []
            , options = opts
@@ -1192,7 +1217,7 @@ showSimilarNames ns nm str kept
       | _ => pure (full ++ adj)
     Nothing
 
-
+export
 getVisibility : {auto c : Ref Ctxt Defs} ->
                 FC -> Name -> Core (WithDefault Visibility Private)
 getVisibility fc n
@@ -1201,6 +1226,24 @@ getVisibility fc n
               | Nothing => throw (UndefinedName fc n)
          pure $ visibility def
 
+export
+getVisibilityWeaked : {auto c : Ref Ctxt Defs} ->
+                FC -> Name -> Core (WithDefault Visibility Private)
+getVisibilityWeaked fc n
+    = catch (getVisibility fc n) $ \e =>
+        case e of
+          UndefinedName _ _ => pure defaulted
+          x => throw x
+
+export
+getMultiplicityWeaked : {auto c : Ref Ctxt Defs} ->
+                  FC -> Name -> Core (Maybe RigCount)
+getMultiplicityWeaked fc n
+    = do defs <- get Ctxt
+         Just def <- lookupCtxtExact n (gamma defs)
+              | Nothing => pure Nothing
+         pure $ Just $ multiplicity def
+
 maybeMisspelling : {auto c : Ref Ctxt Defs} ->
                    Error -> Name -> Core a
 maybeMisspelling err nm = do
@@ -1340,39 +1383,6 @@ addContextAlias alias full
          gam' <- newAlias alias full (gamma defs)
          put Ctxt ({ gamma := gam' } defs)
 
-export
-addBuiltin : {arity : _} ->
-             {auto x : Ref Ctxt Defs} ->
-             Name -> ClosedTerm -> Totality ->
-             PrimFn arity -> Core ()
-addBuiltin n ty tot op
-   = do ignore $
-       addDef n $ MkGlobalDef
-         { location = emptyFC
-         , fullname = n
-         , type = ty
-         , eraseArgs = NatSet.empty
-         , safeErase = NatSet.empty
-         , specArgs = NatSet.empty
-         , inferrable = NatSet.empty
-         , multiplicity = top
-         , localVars = Scope.empty
-         , visibility = specified Public
-         , totality = tot
-         , isEscapeHatch = False
-         , flags = [Inline]
-         , refersToM = Nothing
-         , refersToRuntimeM = Nothing
-         , invertible = False
-         , noCycles = False
-         , linearChecked = True
-         , definition = Builtin op
-         , compexpr = Nothing
-         , namedcompexpr = Nothing
-         , sizeChange = []
-         , schemeExpr = Nothing
-         }
-
 export
 updateDef : {auto c : Ref Ctxt Defs} ->
             Name -> (Def -> Maybe Def) -> Core ()
@@ -1817,7 +1827,7 @@ setDetermining fc tyn args
              else getPos (1 + i) ns sc
     getPos _ [] _ = pure NatSet.empty
     getPos _ ns ty = throw (GenericMsg fc ("Unknown determining arguments: "
-                           ++ showSep ", " (map show ns)))
+                           ++ joinBy ", " (map show ns)))
 
 export
 setDetags : {auto c : Ref Ctxt Defs} ->
diff --git a/src/Core/Context/Context.idr b/src/Core/Context/Context.idr
index d6b803f9cbb..f27e7ac6319 100644
--- a/src/Core/Context/Context.idr
+++ b/src/Core/Context/Context.idr
@@ -51,6 +51,10 @@ export
 defaultPI : PMDefInfo
 defaultPI = MkPMDefInfo NotHole False False
 
+export
+reducePI : PMDefInfo
+reducePI = MkPMDefInfo NotHole True False
+
 public export
 record TypeFlags where
   constructor MkTypeFlags
@@ -61,6 +65,25 @@ export
 defaultFlags : TypeFlags
 defaultFlags = MkTypeFlags False False
 
+public export
+record DataConInfo where
+  constructor MkDataConInfo
+  quantities : List RigCount
+               -- Quantities on arguments
+  newTypeArg : Maybe (Bool, Nat)
+               -- if it's the only constructor, and only one argument is
+               -- non-Rig0, flag it here.
+               -- The Nat is the unerased argument position.
+               -- The Bool is 'True' if there is no %World token in the
+               -- structure, which means it is safe to completely erase
+               -- when pattern matching (otherwise we still have to ensure
+               -- that the value is inspected, to make sure external effects
+               -- happen)
+
+export
+defaultDataConInfo : List RigCount -> DataConInfo
+defaultDataConInfo qs = MkDataConInfo qs Nothing
+
 public export
 record HoleFlags where
   constructor MkHoleFlags
@@ -71,35 +94,28 @@ export
 holeInit : Bool -> HoleFlags
 holeInit b = MkHoleFlags b False
 
+public export
+data Clause : Type where
+     MkClause : {vars : _} ->
+                (env : Env Term vars) ->
+                (lhs : Term vars) -> (rhs : Term vars) -> Clause
+
+%name Clause cl
+
 public export
 data Def : Type where
     None : Def -- Not yet defined
-    PMDef : (pminfo : PMDefInfo) ->
-            (args : Scope) ->
-            (treeCT : CaseTree args) ->
-            (treeRT : CaseTree args) ->
-            (pats : List (vs : Scope ** (Env Term vs, Term vs, Term vs))) ->
-                -- original checked patterns (LHS/RHS) with the names in
-                -- the environment. Used for display purposes, for helping
-                -- find size changes in termination checking, and for
-                -- generating specialised definitions (so needs to be the
-                -- full, non-erased, term)
-            Def -- Ordinary function definition
+    Function : (pminfo : PMDefInfo) ->
+               (compileTime : ClosedTerm) ->
+               (runTime : ClosedTerm) ->
+               Maybe (List Clause) -> -- initial definition, if known
+               Def -- normal function
     ExternDef : (arity : Nat) -> Def
     ForeignDef : (arity : Nat) ->
                  List String -> -- supported calling conventions,
                                 -- e.g "C:printf,libc,stdlib.h", "scheme:display", ...
                  Def
-    Builtin : {arity : Nat} -> PrimFn arity -> Def
-    DCon : (tag : Int) -> (arity : Nat) ->
-           (newtypeArg : Maybe (Bool, Nat)) ->
-               -- if only constructor, and only one argument is non-Rig0,
-               -- flag it here. The Nat is the unerased argument position.
-               -- The Bool is 'True' if there is no %World token in the
-               -- structure, which means it is safe to completely erase
-               -- when pattern matching (otherwise we still have to ensure
-               -- that the value is inspected, to make sure external effects
-               -- happen)
+    DCon : DataConInfo -> (tag : Tag) -> (arity : Nat) ->
            Def -- data constructor
     TCon : (arity : Nat) ->
            (parampos : NatSet) -> -- parameters
@@ -133,11 +149,10 @@ data Def : Type where
 export
 defNameType : Def -> Maybe NameType
 defNameType None = Nothing
-defNameType (PMDef {}) = Just Func
+defNameType (Function {}) = Just Func
 defNameType (ExternDef {}) = Just Func
 defNameType (ForeignDef {}) = Just Func
-defNameType (Builtin {}) = Just Func
-defNameType (DCon tag ar _) = Just (DataCon tag ar)
+defNameType (DCon _ tag ar) = Just (DataCon tag ar)
 defNameType (TCon ar _ _ _ _ _ _) = Just (TyCon ar)
 defNameType (Hole {}) = Just Func
 defNameType (BySearch {}) = Nothing
@@ -150,14 +165,12 @@ export
 covering
 Show Def where
   show None = "undefined"
-  show (PMDef _ args ct rt pats)
-      = unlines [ show args ++ ";"
-                , "Compile time tree: " ++ show ct
-                , "Run time tree: " ++ show rt
-                ]
-  show (DCon t a nt)
+  show (Function _ tm tm' _)
+      = "Function " ++ show tm ++ "\n\tRuntime: " ++ show tm'
+  show (DCon di t a)
       = "DataCon " ++ show t ++ " " ++ show a
-           ++ maybe "" (\n => " (newtype by " ++ show n ++ ")") nt
+           ++ maybe "" (\n => " (newtype by " ++ show n ++ ")")
+                    (newTypeArg di)
   show (TCon a ps ds u ms cons det)
       = "TyCon " ++ show a ++ " params: " ++ show ps ++
         " constructors: " ++ show cons ++
@@ -166,7 +179,6 @@ Show Def where
   show (ExternDef arity) = "<external def with arity " ++ show arity ++ ">"
   show (ForeignDef a cs) = "<foreign def with arity " ++ show a ++
                            " " ++ show cs ++">"
-  show (Builtin {arity} _) = "<builtin with arith " ++ show arity ++ ">"
   show (Hole _ p) = "Hole" ++ if implbind p then " [impl]" else ""
   show (BySearch c depth def) = "Search in " ++ show def
   show (Guess tm _ cs) = "Guess " ++ show tm ++ " when " ++ show cs
@@ -187,18 +199,11 @@ data DataDef : Type where
      MkData : (tycon : Constructor) -> (datacons : List Constructor) ->
               DataDef
 
-public export
-data Clause : Type where
-     MkClause : {vars : _} ->
-                (env : Env Term vars) ->
-                (lhs : Term vars) -> (rhs : Term vars) -> Clause
-%name Clause cl
-
 export
 covering
 Show Clause where
   show (MkClause {vars} env lhs rhs)
-      = show vars ++ ": " ++ show lhs ++ " = " ++ show rhs
+      = show (asList vars) ++ ": " ++ show lhs ++ " = " ++ show rhs
 
 public export
 data DefFlag
@@ -217,6 +222,10 @@ data DefFlag
          -- (otherwise they look potentially non terminating) so use with
          -- care!
     | SetTotal TotalReq
+    | BlockReduce -- Don't reduce when quoting/replacing. Used for interface
+                  -- dictionaries to prevent infinite reduction. This is a
+                  -- bit of a hack, to work around dictionaries not being
+                  -- strictly notal
     | BlockedHint -- a hint, but blocked for the moment (so don't use)
     | Macro
     | PartialEval (List (Name, Nat)) -- Partially evaluate on completing defintion.
@@ -244,6 +253,7 @@ Eq DefFlag where
     (==) Overloadable Overloadable = True
     (==) TCInline TCInline = True
     (==) (SetTotal x) (SetTotal y) = x == y
+    (==) BlockReduce BlockReduce = True
     (==) BlockedHint BlockedHint = True
     (==) Macro Macro = True
     (==) (PartialEval x) (PartialEval y) = x == y
@@ -261,6 +271,7 @@ Show DefFlag where
   show Overloadable = "overloadable"
   show TCInline = "tcinline"
   show (SetTotal x) = show x
+  show BlockReduce = "blockreduce"
   show BlockedHint = "blockedhint"
   show Macro = "macro"
   show (PartialEval _) = "partialeval"
@@ -304,7 +315,7 @@ record GlobalDef where
   location : FC
   fullname : Name -- original unresolved name
   type : ClosedTerm
-  eraseArgs : NatSet -- which argument positions to erase at runtime
+  eraseArgs : NatSet -- which argument positions to erase at runtime, integers are de Bruijn levels
   safeErase : NatSet -- which argument positions are safe to assume
                        -- erasable without 'dotting', because their types
                        -- are collapsible relative to non-erased arguments
diff --git a/src/Core/Context/Data.idr b/src/Core/Context/Data.idr
index 12f02198831..c899c9c1aa2 100644
--- a/src/Core/Context/Data.idr
+++ b/src/Core/Context/Data.idr
@@ -3,7 +3,12 @@
 module Core.Context.Data
 
 import Core.Context.Log
-import Core.Normalise
+import Core.Env
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+import Core.Evaluate
+
+import Data.String
 
 import Libraries.Data.NatSet
 import Libraries.Data.WithDefault
@@ -36,7 +41,7 @@ updateParams Nothing args = dropReps <$> traverse couldBeParam args
   where
     couldBeParam : Term vars -> Core (Maybe (Term vars))
     couldBeParam tm = pure $ case !(etaContract tm) of
-      Local fc r v p => Just (Local fc r v p)
+      Local fc i v p => Just (Local fc i v p)
       _ => Nothing
 updateParams (Just args) args' = pure $ dropReps $ zipWith mergeArg args args'
   where
@@ -111,12 +116,20 @@ addData vars vis tidx (MkData con datacons)
     conVisibility Export = Private
     conVisibility x = x
 
+    readQs : NF [<] -> Core (List RigCount)
+    readQs (VBind fc x (Pi _ c _ _) sc)
+        = do rest <- readQs !(expand !(sc (pure (VErased fc Placeholder))))
+             pure (c :: rest)
+    readQs _ = pure []
+
     addDataConstructors : (tag : Int) -> List Constructor ->
                           Context -> Core Context
     addDataConstructors tag [] gam = pure gam
     addDataConstructors tag (con :: cs) gam
-        = do let conName = con.name.val
-             let condef = newDef con.fc conName top vars con.val (specified $ conVisibility vis) (DCon tag con.arity Nothing)
+        = do qs <- readQs !(expand !(nf Env.empty con.val))
+             let conName = con.name.val
+             let condef = newDef con.fc conName top vars con.val (specified $ conVisibility vis)
+                                 (DCon (defaultDataConInfo qs) tag con.arity)
              -- Check 'n' is undefined
              Nothing <- lookupCtxtExact conName gam
                  | Just gdef => throw (AlreadyDefined con.fc conName)
diff --git a/src/Core/Context/Log.idr b/src/Core/Context/Log.idr
index b9e8e7bf6a4..1282e35ecb6 100644
--- a/src/Core/Context/Log.idr
+++ b/src/Core/Context/Log.idr
@@ -4,28 +4,77 @@ import public Core.Context
 import Core.Options
 
 import Data.String
+import Data.List1
 import Libraries.Data.StringMap
 
 import System.Clock
 
 %default covering
 
+padLeft : Nat -> String -> String
+padLeft pl str =
+    let whitespace = replicate (pl * 2) ' '
+    in joinBy "\n" $ toList $ map (\r => whitespace ++ r) $ split (== '\n') str
+
 -- if this function is called, then logging must be enabled.
 %inline
 export
-logString : String -> Nat -> String -> Core ()
-logString "" n msg = coreLift $ putStrLn
-    $ "LOG " ++ show n ++ ": " ++ msg
-logString str n msg = coreLift $ putStrLn
-    $ "LOG " ++ str ++ ":" ++ show n ++ ": " ++ msg
+logString : Nat -> String -> Nat -> String -> Core ()
+logString depth "" n msg = coreLift $ putStrLn
+    $ padLeft depth $ "LOG " ++ show n ++ ": " ++ msg
+logString depth str n msg = coreLift $ putStrLn
+    $ padLeft depth $ "LOG " ++ str ++ ":" ++ show n ++ ": " ++ msg
 
 %inline
 export
-logString' : LogLevel -> String -> Core ()
-logString' lvl =
-  logString (fastConcat (intersperse "." (topics lvl)) ++ ":")
+logString' : Nat -> LogLevel -> String -> Core ()
+logString' depth lvl =
+  logString depth (fastConcat (intersperse "." (topics lvl)) ++ ":")
             (verbosity lvl)
 
+export
+getDepth : {auto c : Ref Ctxt Defs} ->
+             Core Nat
+getDepth
+    = do defs <- get Ctxt
+         let treeLikeOutput = (logTreeEnabled $ session (options defs))
+         pure $ if treeLikeOutput then (logDepth $ session (options defs)) else 0
+
+export
+logDepthIncrease : {auto c : Ref Ctxt Defs} -> Core ()
+logDepthIncrease
+    = do depth <- getDepth
+         update Ctxt { options->session->logDepth := depth + 1 }
+
+export
+logDepthDecrease : {auto c : Ref Ctxt Defs} -> Core a -> Core a
+logDepthDecrease r
+    = do r' <- r
+         depth <- getDepth
+         update Ctxt { options->session->logDepth := depth `minus` 1 }
+         pure r'
+
+export
+logDepth : {auto c : Ref Ctxt Defs} -> Core a -> Core a
+logDepth r
+    = do logDepthIncrease
+         logDepthDecrease r
+
+export
+logQuiet : {auto c : Ref Ctxt Defs} -> Core a -> Core a
+logQuiet r
+    = do opts <- getSession
+         update Ctxt { options->session->logEnabled := False }
+         r' <- r
+         update Ctxt { options->session->logEnabled := (logEnabled opts) }
+         pure r'
+
+export
+logDepthWrap : {auto c : Ref Ctxt Defs} -> (a -> Core b) -> a -> Core b
+logDepthWrap fn p
+    = do logDepthIncrease
+         logDepthDecrease (fn p)
+
 export
 logging' : {auto c : Ref Ctxt Defs} ->
            LogLevel -> Core Bool
@@ -54,15 +103,34 @@ logTerm : {vars : _} ->
           LogTopic -> Nat -> Lazy String -> Term vars -> Core ()
 logTerm s n msg tm
     = when !(logging s n)
-        $ do tm' <- toFullNames tm
-             logString s.topic n $ msg ++ ": " ++ show tm'
+        $ do depth <- getDepth
+             tm' <- toFullNames tm
+             logString depth s.topic n $ msg ++ ": " ++ show tm'
+
+-- export
+-- logLocalEnv : {free, vars : _} ->
+--          {auto c : Ref Ctxt Defs} ->
+--          LogTopic -> Nat -> String -> LocalEnv free vars -> Core ()
+-- logLocalEnv s n msg env
+--     = when !(logging s n) $
+--         do depth <- getDepth
+--            logString depth s.topic n msg
+--            dumpEnv s env
+--   where
+--     dumpEnv : {free, vs : SnocList Name} -> LogTopic -> LocalEnv free vs -> Core ()
+--     dumpEnv _ [<] = pure ()
+--     dumpEnv {vs = _ :< x} s (bs :< closure)
+--         = do depth <- getDepth
+--              logString depth s.topic n $ msg ++ ": " ++ show x ++ " :: " ++ show closure
+--              dumpEnv s bs
 
 export
 log' : {auto c : Ref Ctxt Defs} ->
        LogLevel -> Lazy String -> Core ()
 log' lvl msg
     = when !(logging' lvl)
-        $ logString' lvl msg
+        $ do depth <- getDepth
+             logString' depth lvl msg
 
 ||| Log a message with the given log level. Use increasingly
 ||| high log level numbers for more granular logging.
@@ -77,15 +145,17 @@ log : {auto c : Ref Ctxt Defs} ->
       LogTopic -> Nat -> Lazy String -> Core ()
 log s n msg
     = when !(logging s n)
-        $ logString s.topic n msg
+        $ do depth <- getDepth
+             logString depth s.topic n msg
 
 export
 unverifiedLogC : {auto c : Ref Ctxt Defs} ->
                  String -> Nat -> Core String -> Core ()
 unverifiedLogC str n cmsg
     = when !(unverifiedLogging str n)
-        $ do msg <- cmsg
-             logString str n msg
+        $ do depth <- getDepth
+             msg <- cmsg
+             logString depth str n msg
 
 %inline
 export
diff --git a/src/Core/Context/Pretty.idr b/src/Core/Context/Pretty.idr
index 132f3880a6d..debcae4943b 100644
--- a/src/Core/Context/Pretty.idr
+++ b/src/Core/Context/Pretty.idr
@@ -7,25 +7,20 @@ import Idris.Doc.Annotations
 
 import Idris.Syntax
 import Idris.Pretty
-
-import Core.Case.CaseTree.Pretty
+import Idris.Resugar
 
 import Libraries.Data.NatSet
 
-%hide Env.(::)
-%hide Env.Nil
+%hide Env.Lin
 %hide String.(::)
 %hide String.Nil
 %hide Doc.Nil
-%hide Subst.(::)
-%hide Subst.Nil
 %hide CList.(::)
 %hide CList.Nil
 %hide Stream.(::)
 %hide Symbols.equals
 %hide String.indent
 %hide List1.(++)
--- %hide SnocList.(++)
 %hide String.(++)
 %hide Pretty.Syntax
 %hide List1.forget
@@ -33,20 +28,52 @@ import Libraries.Data.NatSet
 %default covering
 
 namespace Raw
+  export
+  prettyTree : {vars : _} -> Term vars -> Doc IdrisSyntax
+  prettyAlt : {vars : _} -> CaseAlt vars -> Doc IdrisSyntax
+  prettyScope : {vars : _} -> CaseScope vars -> Doc IdrisSyntax
+
+  prettyTree (Case fc ct c sc ty alts)
+      = let ann = case ty of
+                    Erased _ _ => ""
+                    _ => space <+> keyword ":" <++> byShow ty
+        in case_ <++> annotate Bound (byShow sc) <+> ann <++> of_
+         <+> nest 2 (hardline
+         <+> vsep (assert_total (map prettyAlt alts)))
+  prettyTree tm = byShow tm
+
+  prettyScope (RHS _ tm) = fatArrow <++> byShow tm
+  prettyScope (Arg c x sc) = annotate Bound (pretty0 x) <++> prettyScope sc
+
+  prettyAlt (ConCase _ n tag sc)
+      = annotate (DCon (Just n)) (pretty0 n) <++> prettyScope sc
+  prettyAlt (DelayCase _ _ arg sc) =
+        keyword "Delay" <++> pretty0 arg
+        <++> fatArrow
+        <+> let sc = prettyTree sc in
+            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
+  prettyAlt (ConstCase _ c sc) =
+        pretty c
+        <++> fatArrow
+        <+> let sc = prettyTree sc in
+            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
+  prettyAlt (DefaultCase _ sc) =
+        keyword "_"
+        <++> fatArrow
+        <+> let sc = prettyTree sc in
+            Union (spaces 1 <+> sc) (nest 2 (hardline <+> sc))
+
   export
   prettyDef : Def -> Doc IdrisDocAnn
   prettyDef None = "undefined"
-  prettyDef (PMDef _ args ct _ pats) =
+  prettyDef (Function _ ct _ pats) =
        let ct = prettyTree ct in
-       vcat
-        [ "Arguments" <++> cast (prettyList $ toList args)
-        , header "Compile time tree" <++> reAnnotate Syntax ct
-        ]
-  prettyDef (DCon tag arity nt) =
+       header "Compile time tree" <++> reAnnotate Syntax ct
+  prettyDef (DCon nt tag arity) =
       vcat $ header "Data constructor" :: map (indent 2)
           ([ "tag:" <++> byShow tag
            , "arity:" <++> byShow arity
-           ] ++ maybe [] (\ n => ["newtype by:" <++> byShow n]) nt)
+           ] ++ maybe [] (\ n => ["newtype by:" <++> byShow n]) (newTypeArg nt))
   prettyDef (TCon arity ps ds u ms cons det) =
         let enum = hsep . punctuate "," in
         vcat $ header "Type constructor" :: map (indent 2)
@@ -62,9 +89,6 @@ namespace Raw
      vcat $ header "Foreign definition" :: map (indent 2)
           [ "arity:" <++> byShow arity
           , "bindings:" <++> byShow calls ]
-  prettyDef (Builtin {arity} _) =
-        vcat $ header "Builtin" :: map (indent 2)
-          [ "arity:" <++> byShow arity ]
   prettyDef (Hole numlocs hf) =
         vcat $ header "Hole" :: map (indent 2)
           ("Implicitly bound name" <$ guard (implbind hf))
@@ -81,23 +105,67 @@ namespace Raw
   prettyDef Delayed = "Delayed"
 
 namespace Resugared
+  export
+  prettyTree : {vars : _} ->
+    {auto c : Ref Ctxt Defs} ->
+    {auto s : Ref Syn SyntaxInfo} ->
+    Env Term vars -> Term vars -> Core (Doc IdrisSyntax)
+  prettyAlt : {vars : _} ->
+    {auto c : Ref Ctxt Defs} ->
+    {auto s : Ref Syn SyntaxInfo} ->
+    Env Term vars -> CaseAlt vars -> Core (Doc IdrisSyntax)
+  prettyScope : {vars : _} ->
+    {auto c : Ref Ctxt Defs} ->
+    {auto s : Ref Syn SyntaxInfo} ->
+    Env Term vars -> CaseScope vars -> Core (Doc IdrisSyntax)
+
+  prettyScope env (RHS _ tm) = do
+      tm <- prettyTree env tm
+      pure $ fatArrow <++> tm
+  prettyScope env (Arg c x sc) = do
+      sc <- prettyScope (env :< PVar emptyFC top Explicit (Erased emptyFC Placeholder)) sc
+      pure $ annotate Bound (pretty0 x) <++> sc
+
+  prettyAlt env (ConCase _ n tag sc) = do
+      sc <- prettyScope env sc
+      pure $ annotate (DCon (Just n)) (pretty0 n) <++> sc
+  prettyAlt env (DelayCase _ _ arg tm) = do
+      tm <- prettyTree (mkEnvOnto emptyFC [_,_] env) tm
+      pure $ keyword "Delay" <++> pretty0 arg
+        <++> fatArrow
+        <+> Union (spaces 1 <+> tm) (nest 2 (hardline <+> tm))
+  prettyAlt env (ConstCase _ c tm) = do
+      tm <- prettyTree env tm
+      pure $ pretty c <++> fatArrow <+>
+            Union (spaces 1 <+> tm) (nest 2 (hardline <+> tm))
+  prettyAlt env (DefaultCase _ tm) = do
+      tm <- prettyTree env tm
+      pure $ keyword "_" <++> fatArrow <+>
+            Union (spaces 1 <+> tm) (nest 2 (hardline <+> tm))
+
+  prettyTree env (Case fc ct c sc ty alts) = do
+      ann <- case ty of
+                  Erased _ _ => pure ""
+                  _ => do ty <- resugar env ty
+                          pure (space <+> keyword ":" <++> pretty ty)
+      alts <- assert_total (traverse (prettyAlt env) alts)
+      pure $ case_ <++> byShow sc <+> ann <++> of_
+         <+> nest 2 (hardline <+> vsep alts)
+  prettyTree env tm = pretty <$> resugar env tm
 
   export
   prettyDef : {auto c : Ref Ctxt Defs} ->
               {auto s : Ref Syn SyntaxInfo} ->
               Def -> Core (Doc IdrisDocAnn)
   prettyDef None = pure "undefined"
-  prettyDef (PMDef _ args ct _ pats) = do
-      ct <- prettyTree (mkEnv emptyFC _) ct
-      pure $ vcat
-        [ "Arguments" <++> cast (prettyList $ toList args)
-        , header "Compile time tree" <++> reAnnotate Syntax ct
-        ]
-  prettyDef (DCon tag arity nt) = pure $
+  prettyDef (Function _ ct _ pats) = do
+        ct <- prettyTree (mkEnv emptyFC _) ct
+        pure $ header "Compile time tree" <++> reAnnotate Syntax ct
+  prettyDef (DCon nt tag arity) = pure $
       vcat $ header "Data constructor" :: map (indent 2)
           ([ "tag:" <++> byShow tag
            , "arity:" <++> byShow arity
-           ] ++ maybe [] (\ n => ["newtype by:" <++> byShow n]) nt)
+           ] ++ maybe [] (\ n => ["newtype by:" <++> byShow n]) (newTypeArg nt))
   prettyDef (TCon arity ps ds u ms cons det) = pure $
         let enum = hsep . punctuate "," in
         vcat $ header "Type constructor" :: map (indent 2)
@@ -113,9 +181,6 @@ namespace Resugared
      vcat $ header "Foreign definition" :: map (indent 2)
           [ "arity:" <++> byShow arity
           , "bindings:" <++> byShow calls ]
-  prettyDef (Builtin {arity} _) = pure $
-        vcat $ header "Builtin" :: map (indent 2)
-          [ "arity:" <++> byShow arity ]
   prettyDef (Hole numlocs hf) = pure $
         vcat $ header "Hole" :: map (indent 2)
           ("Implicitly bound name" <$ guard (implbind hf))
diff --git a/src/Core/Core.idr b/src/Core/Core.idr
index f9ec03b7506..1b0314343b9 100644
--- a/src/Core/Core.idr
+++ b/src/Core/Core.idr
@@ -6,6 +6,7 @@ import public Core.WithData
 
 import Data.List1
 import Data.SnocList
+import Data.String
 import Data.Vect
 
 import Libraries.Data.List01
@@ -117,6 +118,7 @@ data Error : Type where
         -- (e.g. pattern match against an empty type).
      LinearUsed : FC -> Nat -> Name -> Error
      LinearMisuse : FC -> Name -> RigCount -> RigCount -> Error
+     InconsistentUse : FC -> List (FC, List Name) -> Error
      BorrowPartial : {vars : _} ->
                      FC -> Env Term vars -> Term vars -> Term vars -> Error
      BorrowPartialType : {vars : _} ->
@@ -265,11 +267,11 @@ Show Error where
             case cov of
                  IsCovering => "Oh yes it is (Internal error!)"
                  MissingCases cs => "Missing cases:\n\t" ++
-                                           showSep "\n\t" (map show cs)
+                                           joinBy "\n\t" (map show cs)
                  NonCoveringCall ns => "Calls non covering function"
                                            ++ (case ns of
                                                    [fn] => " " ++ show fn
-                                                   _ => "s: " ++ showSep ", " (map show ns))
+                                                   _ => "s: " ++ joinBy ", " (map show ns))
 
   show (NotTotal fc n r)
        = show fc ++ ":" ++ show n ++ " is not total"
@@ -292,6 +294,9 @@ Show Error where
          "irrelevant"
          "relevant"
          (const "non-linear")
+  show (InconsistentUse fc ns)
+      = show fc ++ ":Inconsistent use of variables in case branches " ++
+        show ns
   show (BorrowPartial fc env t arg)
       = show fc ++ ":" ++ show t ++ " borrows argument " ++ show arg ++
                    " so must be fully applied"
@@ -315,12 +320,12 @@ Show Error where
   show (NotRecordType fc ty)
       = show fc ++ ":" ++ show ty ++ " is not a record type"
   show (IncompatibleFieldUpdate fc flds)
-      = show fc ++ ":Field update " ++ showSep "->" flds ++ " not compatible with other updates"
+      = show fc ++ ":Field update " ++ joinBy "->" flds ++ " not compatible with other updates"
   show (InvalidArgs fc env ns tm)
      = show fc ++ ":" ++ show ns ++ " are not valid arguments in " ++ show tm
   show (TryWithImplicits fc env imps)
      = show fc ++ ":Need to bind implicits "
-          ++ showSep "," (map (\x => show (fst x) ++ " : " ++ show (snd x)) imps)
+          ++ joinBy "," (map (\x => show (fst x) ++ " : " ++ show (snd x)) imps)
           ++ "\n(The front end should probably have done this for you. Please report!)"
   show (BadUnboundImplicit fc env n ty)
       = show fc ++ ":Can't bind name " ++ nameRoot n ++
@@ -380,7 +385,7 @@ Show Error where
   show (ModuleNotFound fc ns)
       = show fc ++ ":" ++ show ns ++ " not found"
   show (CyclicImports ns)
-      = "Module imports form a cycle: " ++ showSep " -> " (map show ns)
+      = "Module imports form a cycle: " ++ joinBy " -> " (map show ns)
   show ForceNeeded = "Internal error when resolving implicit laziness"
   show (InternalError str) = "INTERNAL ERROR: " ++ str
   show (UserError str) = "Error: " ++ str
@@ -411,7 +416,7 @@ Show Error where
   show (MaybeMisspelling err ns)
        = show err ++ "\nDid you mean" ++ case ns of
            (n ::: []) => ": " ++ n ++ "?"
-           _ => " any of: " ++ showSep ", " (map show (forget ns)) ++ "?"
+           _ => " any of: " ++ joinBy ", " (map show (forget ns)) ++ "?"
   show (WarningAsError w) = show w
   show (OperatorBindingMismatch fc (DeclaredFixity expected) actual opName rhs _)
        = show fc ++ ": Operator " ++ show opName ++ " is " ++ show expected
@@ -448,6 +453,7 @@ getErrorLoc (NotTotal loc _ _) = Just loc
 getErrorLoc ImpossibleCase = Nothing
 getErrorLoc (LinearUsed loc _ _) = Just loc
 getErrorLoc (LinearMisuse loc _ _ _) = Just loc
+getErrorLoc (InconsistentUse loc _) = Just loc
 getErrorLoc (BorrowPartial loc _ _ _) = Just loc
 getErrorLoc (BorrowPartialType loc _ _) = Just loc
 getErrorLoc (AmbiguousName loc _) = Just loc
@@ -541,6 +547,7 @@ killErrorLoc ImpossibleCase = ImpossibleCase
 killErrorLoc (NotTotal fc x y) = NotTotal emptyFC x y
 killErrorLoc (LinearUsed fc k x) = LinearUsed emptyFC k x
 killErrorLoc (LinearMisuse fc x y z) = LinearMisuse emptyFC x y z
+killErrorLoc (InconsistentUse fc x) = InconsistentUse emptyFC x
 killErrorLoc (BorrowPartial fc x y z) = BorrowPartial emptyFC x y z
 killErrorLoc (BorrowPartialType fc x y) = BorrowPartialType emptyFC x y
 killErrorLoc (AmbiguousName fc xs) = AmbiguousName emptyFC xs
@@ -776,14 +783,14 @@ traverse f xs = traverse' f xs []
 namespace SnocList
   -- Traversable (specialised)
   traverse' : (a -> Core b) -> SnocList a -> SnocList b -> Core (SnocList b)
-  traverse' f [<] acc = pure acc
+  traverse' f [<] acc = pure (reverse acc)
   traverse' f (xs :< x) acc
       = traverse' f xs (acc :< !(f x))
 
   %inline
   export
   traverse : (a -> Core b) -> SnocList a -> Core (SnocList b)
-  traverse f xs = traverse' f (reverse xs) [<]
+  traverse f xs = traverse' f xs [<]
 
 export
 mapMaybeM : (a -> Core (Maybe b)) -> List a -> Core (List b)
@@ -867,7 +874,7 @@ namespace SnocList
 
   export
   traverse_ : (a -> Core b) -> SnocList a -> Core ()
-  traverse_ f xs = traverse_' f (reverse xs)
+  traverse_ f xs = traverse_' f xs
 
 namespace WithData
   %inline export
@@ -905,15 +912,35 @@ mapTermM f = goTerm where
     goTerm : {vars : _} -> Term vars -> Core (Term vars)
     goTerm tm@(Local {}) = f tm
     goTerm tm@(Ref {}) = f tm
-    goTerm (Meta fc n i args) = f =<< Meta fc n i <$> traverse goTerm args
+    goTerm (Meta fc n i args) = f =<< Meta fc n i <$> traverse (traversePair goTerm) args
     goTerm (Bind fc x bd sc) = f =<< Bind fc x <$> traverse goTerm bd <*> goTerm sc
-    goTerm (App fc fn arg) = f =<< App fc <$> goTerm fn <*> goTerm arg
+    goTerm (App fc fn c arg) = f =<< App fc <$> goTerm fn <*> pure c <*> goTerm arg
     goTerm (As fc u as pat) = f =<< As fc u <$> goTerm as <*> goTerm pat
+    goTerm (Case fc t c sc sct alts)
+        = f =<< Case fc t c <$> goTerm sc <*> goTerm sct <*> traverse goAlt alts
+      where
+        goForced : {vars : _} -> (Var vars, Term vars) ->
+                   Core (Var vars, Term vars)
+        goForced (v, tm) = pure (v, !(goTerm tm))
+
+        goScope : {vars : _} -> CaseScope vars -> Core (CaseScope vars)
+        goScope (RHS fs tm)
+          = pure $ RHS !(traverse goForced fs) !(goTerm tm)
+        goScope (Arg c x sc) = pure $ Arg c x !(goScope sc)
+
+        goAlt : {vars : _} -> CaseAlt vars -> Core (CaseAlt vars)
+        goAlt (ConCase fc n t sc) = pure $ ConCase fc n t !(goScope sc)
+        goAlt (DelayCase fc t a sc) = pure $ DelayCase fc t a !(goTerm sc)
+        goAlt (ConstCase fc c tm) = pure $ ConstCase fc c !(goTerm tm)
+        goAlt (DefaultCase fc tm) = pure $ DefaultCase fc !(goTerm tm)
     goTerm (TDelayed fc la d) = f =<< TDelayed fc la <$> goTerm d
     goTerm (TDelay fc la ty arg) = f =<< TDelay fc la <$> goTerm ty <*> goTerm arg
     goTerm (TForce fc la t) = f =<< TForce fc la <$> goTerm t
     goTerm tm@(PrimVal {}) = f tm
+    goTerm tm@(PrimOp fc op args)
+        = f =<< PrimOp fc op <$> (traverseVect goTerm args)
     goTerm tm@(Erased {}) = f tm
+    goTerm tm@(Unmatched _ _) = f tm
     goTerm tm@(TType {}) = f tm
 
 
@@ -935,7 +962,7 @@ namespace SnocList
 
   export
   anyM : (a -> Core Bool) -> SnocList a -> Core Bool
-  anyM f xs = anyM' f (reverse xs)
+  anyM f xs = anyM' f xs
 
 export
 allM : (a -> Core Bool) -> List a -> Core Bool
@@ -945,6 +972,15 @@ allM f (x :: xs)
          then allM f xs
          else pure False
 
+namespace SnocList
+  export
+  allM : (a -> Core Bool) -> SnocList a -> Core Bool
+  allM f [<] = pure True
+  allM f (xs :< x)
+      = if !(f x)
+         then allM f xs
+         else pure False
+
 export
 filterM : (a -> Core Bool) -> List a -> Core (List a)
 filterM p [] = pure []
diff --git a/src/Core/Coverage.idr b/src/Core/Coverage.idr
index f597fab5b70..9e00c780f3f 100644
--- a/src/Core/Coverage.idr
+++ b/src/Core/Coverage.idr
@@ -1,19 +1,23 @@
 module Core.Coverage
 
-import Core.Case.CaseTree
 import Core.Case.Util
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
+import Core.Evaluate
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Data.Maybe
+import Data.SnocList
 import Data.String
 
 import Libraries.Data.NameMap
 import Libraries.Data.NatSet
 import Libraries.Data.String.Extra
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
 import Libraries.Text.PrettyPrint.Prettyprinter
 
 %default covering
@@ -80,18 +84,18 @@ conflict defs env nfty n
               | Nothing => pure False
          case (definition gdef, type gdef) of
               (DCon t arity _, dty)
-                  => do Nothing <- conflictNF 0 nfty !(nf defs Env.empty dty)
+                  => do Nothing <- conflictNF 0 nfty !(expand !(nf Env.empty dty))
                             | Just ms => pure $ conflictMatch ms
                         pure True
               _ => pure False
   where
     mutual
-      conflictArgs : Int -> List (Closure vars) -> List ClosedClosure ->
+      conflictArgs : Int -> SnocList (Glued vars) -> SnocList (Glued [<]) ->
                      Core (Maybe (List (Name, Term vars)))
-      conflictArgs _ [] [] = pure (Just [])
-      conflictArgs i (c :: cs) (c' :: cs')
-          = do cnf <- evalClosure defs c
-               cnf' <- evalClosure defs c'
+      conflictArgs _ [<] [<] = pure (Just [])
+      conflictArgs i (cs :< c) (cs' :< c')
+          = do cnf <- expand c
+               cnf' <- expand c'
                Just ms <- conflictNF i cnf cnf'
                     | Nothing => pure Nothing
                Just ms' <- conflictArgs i cs cs'
@@ -107,24 +111,28 @@ conflict defs env nfty n
       -- conflictNF returns the list of matches, for checking
       conflictNF : Int -> NF vars -> ClosedNF ->
                    Core (Maybe (List (Name, Term vars)))
-      conflictNF i t (NBind fc x b sc)
+      conflictNF i t (VBind fc x b sc)
           -- invent a fresh name, in case a user has bound the same name
           -- twice somehow both references appear in the result it's unlikely
           -- put possible
           = let x' = MN (show x) i in
                 conflictNF (i + 1) t
-                       !(sc defs (toClosure defaultOpts Env.empty (Ref fc Bound x')))
-      conflictNF i nf (NApp _ (NRef Bound n) [])
-          = pure (Just [(n, !(quote defs env nf))])
-      conflictNF i (NDCon _ n t a args) (NDCon _ n' t' a' args')
+                       !(expand !(sc (pure (vRef fc Bound x'))))
+      conflictNF i nf (VApp _ Bound n [<] _)
+          = pure (Just [(n, !(quote env nf))])
+      conflictNF i (VDCon _ n t a args) (VDCon _ n' t' a' args')
           = if t == t'
-               then conflictArgs i (map snd args) (map snd args')
+               then conflictArgs i
+                       !(traverseSnocList value args)
+                       !(traverseSnocList value args')
                else pure Nothing
-      conflictNF i (NTCon _ n a args) (NTCon _ n' a' args')
+      conflictNF i (VTCon _ n a args) (VTCon _ n' a' args')
           = if n == n'
-               then conflictArgs i (map snd args) (map snd args')
+               then conflictArgs i
+                      !(traverseSnocList value args)
+                      !(traverseSnocList value args')
                else pure Nothing
-      conflictNF i (NPrimVal _ c) (NPrimVal _ c')
+      conflictNF i (VPrimVal _ c) (VPrimVal _ c')
           = if c == c'
                then pure (Just [])
                else pure Nothing
@@ -136,23 +144,23 @@ export
 isEmpty : {vars : _} ->
           {auto c : Ref Ctxt Defs} ->
           Defs -> Env Term vars -> NF vars -> Core Bool
-isEmpty defs env (NTCon fc n a args)
+isEmpty defs env (VTCon fc n a args)
   = do Just nty <- lookupDefExact n (gamma defs)
          | _ => pure False
        case nty of
             TCon _ _ _ flags _ Nothing _ => pure False
             TCon _ _ _ flags _ (Just cons) _
                  => if not (external flags)
-                       then allM (conflict defs env (NTCon fc n a args)) cons
+                       then allM (conflict defs env (VTCon fc n a args)) cons
                        else pure False
             _ => pure False
 isEmpty defs env _ = pure False
 
 altMatch : CaseAlt vars -> CaseAlt vars -> Bool
-altMatch _ (DefaultCase _) = True
-altMatch (DelayCase _ _ t) (DelayCase _ _ t') = True
-altMatch (ConCase n t _ _) (ConCase n' t' _ _) = t == t'
-altMatch (ConstCase c _) (ConstCase c' _) = c == c'
+altMatch _ (DefaultCase _ _) = True
+altMatch (DelayCase _ _ _ t) (DelayCase _ _ _ t') = True
+altMatch (ConCase _ n t _) (ConCase _ n' t' _) = t == t'
+altMatch (ConstCase _ c _) (ConstCase _ c' _) = c == c'
 altMatch _ _ = False
 
 -- Given a type and a list of case alternatives, return the
@@ -163,29 +171,28 @@ getMissingAlts : {auto c : Ref Ctxt Defs} ->
                  Core (List (CaseAlt vars))
 -- If it's a primitive other than WorldVal, there's too many to reasonably
 -- check, so require a catch all
-getMissingAlts fc defs (NPrimVal _ $ PrT WorldType) alts
+getMissingAlts fc defs (VPrimVal _ $ PrT WorldType) alts
     = if isNil alts
-         then pure [DefaultCase (Unmatched "Coverage check")]
+         then pure [DefaultCase fc (Unmatched fc "Coverage check")]
          else pure []
-getMissingAlts fc defs (NPrimVal _ c) alts
+getMissingAlts fc defs (VPrimVal _ c) alts
   = do log "coverage.missing" 50 $ "Looking for missing alts at type " ++ show c
        if any isDefault alts
          then do log "coverage.missing" 20 "Found default"
                  pure []
-         else pure [DefaultCase (Unmatched "Coverage check")]
+         else pure [DefaultCase fc (Unmatched fc "Coverage check")]
 -- Similarly for types
-getMissingAlts fc defs (NType {}) alts
+getMissingAlts fc defs (VType {}) alts
     = do log "coverage.missing" 50 "Looking for missing alts at type Type"
          if any isDefault alts
            then do log "coverage.missing" 20 "Found default"
                    pure []
-           else pure [DefaultCase (Unmatched "Coverage check")]
+           else pure [DefaultCase fc (Unmatched fc "Coverage check")]
 getMissingAlts fc defs nfty alts
-    = do log "coverage.missing" 50 $ "Getting constructors for: " ++ show nfty
-         logNF "coverage.missing" 20 "Getting constructors for" (mkEnv fc _) nfty
+    = do logNF "coverage.missing" 20 "Getting constructors for" (mkEnv fc _) nfty
          allCons <- getCons defs nfty
          pure (filter (noneOf alts)
-                 (map (mkAlt fc (Unmatched "Coverage check")) allCons))
+                 (map (mkAltTm fc (Unmatched fc "Coverage check")) allCons))
   where
     -- Return whether the alternative c matches none of the given cases in alts
     noneOf : List (CaseAlt vars) -> CaseAlt vars -> Bool
@@ -195,6 +202,10 @@ getMissingAlts fc defs nfty alts
 KnownVars : Scope -> Type -> Type
 KnownVars vars a = List (Var vars, a)
 
+getName : {idx : Nat} -> {vars : Scope} -> (0 p : IsVar n idx vars) -> Name
+getName {vars = _ :< v} First = v
+getName (Later p) = getName p
+
 showK : {ns : _} ->
         Show a => KnownVars ns a -> String
 showK {a} xs = show (map aString xs)
@@ -204,11 +215,16 @@ showK {a} xs = show (map aString xs)
     aString (MkVar v, t) = (nameAt v, t)
 
 -- TODO re-use `Thinnable`
-weakenNs : SizeOf args -> KnownVars vars a -> KnownVars (args ++ vars) a
+weakenNs : SizeOf args -> KnownVars vars a -> KnownVars (Scope.addInner vars args) a
 weakenNs args [] = []
 weakenNs args ((v, t) :: xs)
   = (weakenNs args v, t) :: weakenNs args xs
 
+weaken : KnownVars vars a -> KnownVars (vars :< n) a
+weaken [] = []
+weaken ((v, t) :: xs)
+  = (weaken v, t) :: weaken xs
+
 findTag : {idx, vars : _} ->
           (0 p : IsVar n idx vars) -> KnownVars vars a -> Maybe a
 findTag v [] = Nothing
@@ -227,10 +243,10 @@ addNot v t ((v', ts) :: xs)
          else ((v', ts) :: addNot v t xs)
 
 tagIsNot : List Int -> CaseAlt vars -> Bool
-tagIsNot ts (ConCase _ t' _ _) = not (t' `elem` ts)
-tagIsNot ts (ConstCase {}) = True
-tagIsNot ts (DelayCase {}) = True
-tagIsNot ts (DefaultCase _) = False
+tagIsNot ts (ConCase _ _ t' _) = not (t' `elem` ts)
+tagIsNot ts (ConstCase _ {}) = True
+tagIsNot ts (DelayCase _ {}) = True
+tagIsNot ts (DefaultCase _ _) = False
 
 -- Replace a default case with explicit branches for the constructors.
 -- This is easier than checking whether a default is needed when traversing
@@ -241,24 +257,24 @@ replaceDefaults : {auto c : Ref Ctxt Defs} ->
                   Core (List (CaseAlt vars))
 -- Leave it alone if it's a primitive type though, since we need the catch
 -- all case there
-replaceDefaults fc defs (NPrimVal {}) cs = pure cs
-replaceDefaults fc defs (NType {}) cs = pure cs
+replaceDefaults fc defs (VPrimVal {}) cs = pure cs
+replaceDefaults fc defs (VType {}) cs = pure cs
 replaceDefaults fc defs nfty cs
     = do cs' <- traverse rep cs
          pure (dropRep (concat cs'))
   where
     rep : CaseAlt vars -> Core (List (CaseAlt vars))
-    rep (DefaultCase sc)
+    rep (DefaultCase _ sc)
         = do allCons <- getCons defs nfty
-             pure (map (mkAlt fc sc) allCons)
+             pure (map (mkAltTm fc sc) allCons)
     rep c = pure [c]
 
     dropRep : List (CaseAlt vars) -> List (CaseAlt vars)
     dropRep [] = []
-    dropRep (c@(ConCase n t args sc) :: rest)
+    dropRep (c@(ConCase _ n t sc) :: rest)
           -- assumption is that there's no defaultcase in 'rest' because
           -- we've just removed it
-        = c :: dropRep (filter (not . tagIs t) rest)
+        = c :: dropRep (filter (not . tagIsTm t) rest)
     dropRep (c :: rest) = c :: dropRep rest
 
 -- Traverse a case tree and refine the arguments while matching, so that
@@ -267,65 +283,81 @@ replaceDefaults fc defs nfty cs
 -- The returned patterns are those arising from the *missing* cases
 buildArgs : {auto c : Ref Ctxt Defs} ->
             {vars : _} ->
-            FC -> Defs ->
+            Defs ->
             KnownVars vars Int -> -- Things which have definitely match
             KnownVars vars (List Int) -> -- Things an argument *can't* be
                                     -- (because a previous case matches)
-            List ClosedTerm -> -- ^ arguments, with explicit names
-            CaseTree vars -> Core (List (List ClosedTerm))
-buildArgs fc defs known not ps cs@(Case {name = var} idx el ty altsIn)
+            SnocList (RigCount, ClosedTerm) ->  -- ^ arguments, with explicit names
+            Term vars -> Core (List (SnocList (RigCount, ClosedTerm)))
+-- Coming from the case tree builder, we'll always be splitting on a
+-- variable, so coverage checking has to happen at that point, i.e. before
+-- any inlining
+-- Case blocks appear under lambdas. We only need the case block itself to
+-- be able to construct the application, so we'll only see these at the
+-- top level
+buildArgs defs known not ps (Bind fc x (Lam lfc c p ty) sc)
+    = buildArgs defs (weaken known) (weaken not) (ps :< (c, Ref fc Bound x)) sc
+buildArgs defs known not ps cs@(Case fc PatMatch c (Local lfc _ idx el) ty altsIn)
   -- If we've already matched on 'el' in this branch, restrict the alternatives
   -- to the tag we already know. Otherwise, add missing cases and filter out
   -- the ones it can't possibly be (the 'not') because a previous case
   -- has matched.
     = do let fenv = mkEnv fc _
-         nfty <- nf defs fenv ty
+         nfty <- expand !(nf fenv ty)
          alts <- replaceDefaults fc defs nfty altsIn
          let alts' = alts ++ !(getMissingAlts fc defs nfty alts)
-         let altsK = maybe alts' (\t => filter (tagIs t) alts')
+         let altsK = maybe alts' (\t => filter (tagIsTm t) alts')
                               (findTag el known)
          let altsN = maybe altsK (\ts => filter (tagIsNot ts) altsK)
                               (findTag el not)
-         buildArgsAlt not altsN
+         let var = nameAt el
+         buildArgsAlt var not altsN
   where
-    buildArgAlt : KnownVars vars (List Int) ->
-                  CaseAlt vars -> Core (List (List ClosedTerm))
-    buildArgAlt not' (ConCase n t args sc)
-        = do let l = mkSizeOf args
-             let con = Ref fc (DataCon t (size l)) n
-             let ps' = map (substName var
-                             (apply fc
-                                    con (map (Ref fc Bound) args))) ps
-             buildArgs fc defs (weakenNs l ((MkVar el, t) :: known))
-                               (weakenNs l not') ps' sc
-    buildArgAlt not' (DelayCase t a sc)
-        = let l = mkSizeOf [t, a]
-              ps' = map (substName var (TDelay fc LUnknown
-                                             (Ref fc Bound t)
-                                             (Ref fc Bound a))) ps in
-              buildArgs fc defs (weakenNs l known) (weakenNs l not')
-                                ps' sc
-    buildArgAlt not' (ConstCase c sc)
-        = do let ps' = map (substName var (PrimVal fc c)) ps
-             buildArgs fc defs known not' ps' sc
-    buildArgAlt not' (DefaultCase sc)
-        = buildArgs fc defs known not' ps sc
-
-    buildArgsAlt : KnownVars vars (List Int) -> List (CaseAlt vars) ->
-                   Core (List (List ClosedTerm))
-    buildArgsAlt not' [] = pure []
-    buildArgsAlt not' (c@(ConCase _ t _ _) :: cs)
-        = pure $ !(buildArgAlt not' c) ++
-                 !(buildArgsAlt (addNot el t not') cs)
-    buildArgsAlt not' (c :: cs)
-        = pure $ !(buildArgAlt not' c) ++ !(buildArgsAlt not' cs)
-
-buildArgs fc defs known not ps (STerm _ vs)
-    = pure [] -- matched, so return nothing
-buildArgs fc defs known not ps (Unmatched msg)
+    buildArgSc : {vars, more : _} ->
+                 SizeOf more ->
+                 FC -> Name ->
+                 KnownVars vars Int -> KnownVars vars (List Int) ->
+                 Name -> Int -> SnocList (RigCount, Name) ->
+                 CaseScope (vars ++ more) -> Core (List (SnocList (RigCount, ClosedTerm)))
+    buildArgSc s fc var known not' n t args (RHS _ tm)
+        = do let con = Ref {vars=[<]} fc (DataCon t (length args)) n
+             let app = applySpine fc con
+                             (map @{Compose} (Ref fc Bound) args)
+             let ps' = map @{Compose} (substName [<] var app) ps
+             buildArgs defs (weakenNs s known) (weakenNs s not') ps' tm
+    buildArgSc s fc var known not' n t args (Arg c x sc)
+        = buildArgSc (suc s) fc var known not' n t (args :< (c, x)) sc
+
+    buildArgAlt : Name -> KnownVars vars (List Int) ->
+                  CaseAlt vars -> Core (List (SnocList (RigCount, ClosedTerm)))
+    buildArgAlt var not' (ConCase cfc n t sc)
+        = buildArgSc zero cfc var ((MkVar el, t) :: known) not' n t [<] sc
+    buildArgAlt var not' (DelayCase _ t a sc)
+        = let l = mkSizeOf [< t, a]
+              ps' = map @{Compose} (substName [<] var
+                                              (TDelay fc LUnknown
+                                                      (Ref fc Bound t)
+                                                      (Ref fc Bound a))) ps in
+              buildArgs defs (weakenNs l known) (weakenNs l not') ps' sc
+    buildArgAlt var not' (ConstCase _ i sc)
+        = do let ps' = map @{Compose} (substName [<] var (PrimVal fc i)) ps
+             buildArgs defs known not' ps' sc
+    buildArgAlt var not' (DefaultCase _ sc)
+        = buildArgs defs known not' ps sc
+
+    buildArgsAlt : Name -> KnownVars vars (List Int) -> List (CaseAlt vars) ->
+                   Core (List (SnocList (RigCount, ClosedTerm)))
+    buildArgsAlt var not' [] = pure []
+    buildArgsAlt var not' (c@(ConCase _ _ t _) :: cs)
+        = pure $ !(buildArgAlt var not' c) ++
+                 !(buildArgsAlt var (addNot el t not') cs)
+    buildArgsAlt var not' (c :: cs)
+        = pure $ !(buildArgAlt var not' c) ++ !(buildArgsAlt var not' cs)
+
+buildArgs defs known not ps (Unmatched _ msg)
     = pure [ps] -- unmatched, so return it
-buildArgs fc defs known not ps Impossible
-    = pure [] -- not a possible match, so return nothing
+buildArgs defs known not ps _
+    = pure [] -- matched, or not possible, so return nothing
 
 -- Traverse a case tree and return pattern clauses which are not
 -- matched. These might still be invalid patterns, or patterns which are covered
@@ -335,24 +367,23 @@ export
 getMissing : {vars : _} ->
              {auto c : Ref Ctxt Defs} ->
              FC -> Name -> ClosedTerm ->
-             CaseTree vars ->
+             Term vars ->
              Core (List ClosedTerm)
 getMissing fc n ty ctree
    = do defs <- get Ctxt
-        let psIn = map (Ref fc Bound) vars
-        pats <- buildArgs fc defs [] [] psIn ctree
-        pats <- for pats $ trimArgs defs [<] !(nf defs Env.empty ty)
+        let psIn = map ((top,) . Ref fc Bound) vars
+        pats <- buildArgs defs [] [] psIn ctree
+        pats <- for pats $ trimArgs [<] !(expand !(nf Env.empty ty)) . toList
         unless (null pats) $
           logC "coverage.missing" 20 $ map unlines $
             for pats $ map show . traverse toFullNames
         pure (map (apply fc (Ref fc Func n)) pats)
   where
-    trimArgs : Defs ->
-               SnocList ClosedTerm -> ClosedNF ->
-               List ClosedTerm -> Core (List ClosedTerm)
-    trimArgs defs acc (NBind _ n (Pi {}) sc) (x :: xs)
-        = trimArgs defs (acc :< x) !(sc defs $ toClosure defaultOpts Env.empty x) xs
-    trimArgs _ acc _ _ = pure $ toList acc
+    trimArgs : SnocList (ZeroOneOmega, ClosedTerm) -> ClosedNF ->
+               List (ZeroOneOmega, ClosedTerm) -> Core (List (ZeroOneOmega, ClosedTerm))
+    trimArgs acc (VBind _ n (Pi {}) sc) ((c, x) :: xs)
+        = trimArgs (acc :< (c, x)) !(expand !(sc (pure (VErased fc Placeholder)))) xs
+    trimArgs acc _ _ = pure $ toList acc
 
 -- For the given name, get the names it refers to which are not themselves
 -- covering.
@@ -366,18 +397,9 @@ getNonCoveringRefs fc n
         Just d <- lookupCtxtExact n (gamma defs)
            | Nothing => undefinedName fc n
         let ds = mapMaybe noAssert (toList (refersTo d))
-        let cases = filter isCase !(traverse toFullNames ds)
 
-        -- Case blocks aren't recursive, so we're safe!
-        cbad <- traverse (getNonCoveringRefs fc) cases
-        topbad <- filterM (notCovering defs) ds
-        pure (topbad ++ concat cbad)
+        filterM (notCovering defs) ds
   where
-    isCase : Name -> Bool
-    isCase (NS _ n) = isCase n
-    isCase (CaseBlock {}) = True
-    isCase _ = False
-
     noAssert : (Name, Bool) -> Maybe Name
     noAssert (n, True) = Nothing
     noAssert (n, False) = Just n
@@ -397,7 +419,7 @@ match : Term vs -> Term vs -> Bool
 match (Local _ _ i _) _ = True
 match (Ref _ Bound n) _ = True
 match (Ref _ _ n) (Ref _ _ n') = n == n'
-match (App _ f a) (App _ f' a') = match f f' && match a a'
+match (App _ f _ a) (App _ f' _ a') = match f f' && match a a'
 match (As _ _ _ p) (As _ _ _ p') = match p p'
 match (As _ _ _ p) p' = match p p'
 match (TDelayed _ _ t) (TDelayed _ _ t') = match t t'
@@ -415,19 +437,19 @@ match _ _ = False
 eraseApps : {auto c : Ref Ctxt Defs} ->
             Term vs -> Core (Term vs)
 eraseApps {vs} tm
-    = case getFnArgs tm of
+    = case getFnArgsSpine tm of
            (Ref fc Bound n, args) =>
-                do args' <- traverse eraseApps args
-                   pure (apply fc (Ref fc Bound n) args')
+                do args' <- traverseSnocList (traversePair eraseApps) args
+                   pure (applySpine fc (Ref fc Bound n) args')
            (Ref fc nt n, args) =>
                 do defs <- get Ctxt
                    mgdef <- lookupCtxtExact n (gamma defs)
                    let eargs = maybe NatSet.empty eraseArgs mgdef
-                   args' <- traverse eraseApps (NatSet.overwrite (Erased fc Placeholder) eargs args)
-                   pure (apply fc (Ref fc nt n) args')
+                   args' <- traverseSnocList (traversePair eraseApps) (NatSet.overwrite (erased, Erased fc Placeholder) eargs args)
+                   pure (applySpine fc (Ref fc nt n) args')
            (tm, args) =>
-                do args' <- traverse eraseApps args
-                   pure (apply (getLoc tm) tm args')
+                do args' <- traverseSnocList (traversePair eraseApps) args
+                   pure (applySpine (getLoc tm) tm args')
 
 -- if tm would be matched by trylhs, then it's not an impossible case
 -- because we've already got it. Ignore anything in erased position.
diff --git a/src/Core/Env.idr b/src/Core/Env.idr
index 4a24d5d03bd..b5355c47973 100644
--- a/src/Core/Env.idr
+++ b/src/Core/Env.idr
@@ -1,78 +1,86 @@
 module Core.Env
 
 import Core.TT
-import Data.List
+import Core.Name.CompatibleVars
 
-import Libraries.Data.List.SizeOf
+import Data.SnocList
+import Data.SnocList.Quantifiers
 
 import Libraries.Data.VarSet
-
 import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Extra
+import Libraries.Data.List.SizeOf
+import public Libraries.Data.VarSet as VarSet
 
 %default total
 
 -- Environment containing types and values of local variables
 public export
 data Env : (tm : Scoped) -> Scope -> Type where
-     Nil : Env tm Scope.empty
-     (::) : Binder (tm vars) -> Env tm vars -> Env tm (x :: vars)
+     Lin : Env tm Scope.empty
+     (:<) : Env tm vars -> Binder (tm vars) -> Env tm (Scope.bind vars x)
 
 %name Env rho
 
-public export
-empty : Env tm Scope.empty
-empty = []
+namespace Env
+  public export
+  empty : Env tm Scope.empty
+  empty = [<]
+
+  public export
+  bind : Env tm vars -> Binder (tm vars) -> Env tm (Scope.bind vars x)
+  bind vars n = vars :< n
 
 export
-extend : (x : Name) -> Binder (tm vars) -> Env tm vars -> Env tm (x :: vars)
-extend x = (::) {x}
+extend : (x : Name) -> Env tm vars -> Binder (tm vars) -> Env tm (Scope.bind vars x)
+extend x = (:<) {x}
 
 export
-(++) : {ns : _} -> Env Term ns -> Env Term vars -> Env Term (ns ++ vars)
-(++) (b :: bs) e = extend _ (map embed b) (bs ++ e)
-(++) [] e = e
+(++) : {ns : _} -> Env Term ns -> Env Term vars -> Env Term (Scope.addInner vars ns)
+(++) {ns = ns :< n} (bs :< b) e = extend _ (bs ++ e) (map embed b)
+(++) [<] e = e
 
 export
 length : Env tm xs -> Nat
-length [] = 0
-length (_ :: xs) = S (length xs)
+length [<] = 0
+length (xs :< _) = S (length xs)
 
 export
 lengthNoLet : Env tm xs -> Nat
-lengthNoLet [] = 0
-lengthNoLet (Let _ _ _ _ :: xs) = lengthNoLet xs
-lengthNoLet (_ :: xs) = S (lengthNoLet xs)
+lengthNoLet [<] = 0
+lengthNoLet (xs :< Let _ _ _ _) = lengthNoLet xs
+lengthNoLet (xs :< _) = S (lengthNoLet xs)
 
 export
 lengthExplicitPi : Env tm xs -> Nat
-lengthExplicitPi [] = 0
-lengthExplicitPi (Pi _ _ Explicit _ :: rho) = S (lengthExplicitPi rho)
-lengthExplicitPi (_ :: rho) = lengthExplicitPi rho
+lengthExplicitPi [<] = 0
+lengthExplicitPi (rho :< Pi _ _ Explicit _) = S (lengthExplicitPi rho)
+lengthExplicitPi (rho :< _) = lengthExplicitPi rho
 
 export
-namesNoLet : {xs : _} -> Env tm xs -> List Name
-namesNoLet [] = []
-namesNoLet (Let _ _ _ _ :: xs) = namesNoLet xs
-namesNoLet {xs = x :: _} (_ :: env) = x :: namesNoLet env
+namesNoLet : {xs : _} -> Env tm xs -> SnocList Name
+namesNoLet [<] = [<]
+namesNoLet {xs = _ :< _} (xs :< Let _ _ _ _) = namesNoLet xs
+namesNoLet {xs = _ :< x} (env :< _) = namesNoLet env :< x
 
 export
 eraseLinear : Env tm vs -> Env tm vs
-eraseLinear [] = Env.empty
-eraseLinear (b :: bs)
+eraseLinear [<] = Env.empty
+eraseLinear (bs :< b)
     = if isLinear (multiplicity b)
-         then setMultiplicity b erased :: eraseLinear bs
-         else b :: eraseLinear bs
+         then eraseLinear bs :< setMultiplicity b erased
+         else eraseLinear bs :< b
 
 export
-getErased : {0 vs : _} -> Env tm vs -> List (Var vs)
-getErased env = go env [<] where
+getErased : {0 vs : _} -> Env tm vs -> VarSet vs
+getErased env = go env zero where
 
-  go : Env tm vars -> SizeOf seen -> List (Var (seen <>> vars))
-  go [] p = []
-  go (b :: bs) p
-    = if isErased (multiplicity b)
-         then mkVarChiply p :: go bs (p :< _)
-         else go bs (p :< _)
+  go : Env tm vars -> SizeOf seen -> VarSet (vars <>< seen)
+  go [<] p = VarSet.empty
+  go {seen} {vars = vs :< v} (bs :< b) p
+      = if isErased (multiplicity b)
+          then VarSet.insert (mkVarFishily {inner=seen} p) (go bs (suc p))
+          else go bs (suc p)
 
 public export
 data IsDefined : Name -> Scope -> Type where
@@ -83,8 +91,8 @@ export
 defined : {vars : _} ->
           (n : Name) -> Env Term vars ->
           Maybe (IsDefined n vars)
-defined n [] = Nothing
-defined {vars = x :: xs} n (b :: env)
+defined n [<] = Nothing
+defined {vars = xs :< x} n (env :< b)
     = case nameEq n x of
            Nothing => do MkIsDefined rig prf <- defined n env
                          pure (MkIsDefined rig (Later prf))
@@ -94,20 +102,13 @@ defined {vars = x :: xs} n (b :: env)
 -- outer environment
 export
 bindEnv : {vars : _} -> FC -> Env Term vars -> (tm : Term vars) -> ClosedTerm
-bindEnv loc [] tm = tm
-bindEnv loc (b :: env) tm
+bindEnv loc [<] tm = tm
+bindEnv {vars = _ :< _} loc (env :< b) tm
     = bindEnv loc env (Bind loc _ (PVar (binderLoc b)
                                         (multiplicity b)
                                         Explicit
                                         (binderType b)) tm)
 
-revOnto : (xs, vs : List a) -> reverseOnto xs vs = reverse vs ++ xs
-revOnto xs [] = Refl
-revOnto xs (v :: vs)
-    = rewrite revOnto (v :: xs) vs in
-        rewrite appendAssociative (reverse vs) [v] xs in
-          rewrite revOnto [v] vs in Refl
-
 
 -- Weaken by all the names at once at the end, to save multiple traversals
 -- in big environments
@@ -118,10 +119,12 @@ getBinderUnder : Weaken tm =>
                  (ns : Scope) ->
                  (0 p : IsVar x idx vars) -> Env tm vars ->
                  Binder (tm (reverseOnto vars ns))
-getBinderUnder {idx = Z} {vars = v :: vs} ns First (b :: env)
-    = rewrite revOnto vs (v :: ns) in map (weakenNs (reverse (mkSizeOf (v :: ns)))) b
-getBinderUnder {idx = S k} {vars = v :: vs} ns (Later lp) (b :: env)
-    = getBinderUnder (v :: ns) lp env
+getBinderUnder {idx = Z} {vars = vs :< v} ns First (env :< b)
+    = rewrite Extra.revOnto (Scope.bind vs x) ns in
+        rewrite sym $ appendAssociative vs [<v] (reverse ns) in
+                map (weakenNs (sucL (reverse (mkSizeOf ns)))) b
+getBinderUnder {idx = S k} {vars = vs :< v} ns (Later lp) (env :< b)
+    = getBinderUnder (Scope.bind ns v) lp env
 
 export
 getBinder : Weaken tm =>
@@ -133,8 +136,28 @@ getBinder el env = getBinderUnder Scope.empty el env
 -- needlessly weaken stuff;
 export
 getBinderLoc : {vars : _} -> {idx : Nat} -> (0 p : IsVar x idx vars) -> Env tm vars -> FC
-getBinderLoc {idx = Z}   First     (b :: _)   = binderLoc b
-getBinderLoc {idx = S k} (Later p) (_ :: env) = getBinderLoc p env
+getBinderLoc                 {idx = Z}   First     (_ :< b)   = binderLoc b
+getBinderLoc {vars = _ :< _} {idx = S k} (Later p) (env :< _) = getBinderLoc p env
+
+getLetUnder : {idx : Nat} ->
+                 (0 ns : SnocList Name) ->
+                 SizeOf ns ->
+                 (0 p : IsVar x idx vars) -> Env Term vars ->
+                 Maybe (Term (reverseOnto vars ns))
+getLetUnder {idx = Z} {vars = vs :< v} ns w First (env :< Let _ _ val _)
+    = rewrite Extra.revOnto (Scope.bind vs x) ns in
+        rewrite sym $ appendAssociative vs [<v] (reverse ns) in
+                Just $ weakenNs (sucL (reverse w)) val
+getLetUnder {idx = S k} {vars = vs :< v} ns w (Later lp) (env :< b)
+    = getLetUnder (ns :< v) (suc w) lp env
+getLetUnder _ _ _ _ = Nothing
+
+-- as getBinder but only return result if it's a let bound name
+-- to save unnecessary weakening
+export
+getLet : {idx : Nat} ->
+         (0 p : IsVar x idx vars) -> Env Term vars -> Maybe (Term vars)
+getLet el env = getLetUnder [<] zero el env
 
 -- Make a type which abstracts over an environment
 -- Don't include 'let' bindings, since they have a concrete value and
@@ -142,12 +165,12 @@ getBinderLoc {idx = S k} (Later p) (_ :: env) = getBinderLoc p env
 export
 abstractEnvType : {vars : _} ->
                   FC -> Env Term vars -> (tm : Term vars) -> ClosedTerm
-abstractEnvType fc [] tm = tm
-abstractEnvType fc (Let fc' c val ty :: env) tm
+abstractEnvType fc [<] tm = tm
+abstractEnvType {vars = _ :< _} fc (env :< Let fc' c val ty) tm
     = abstractEnvType fc env (Bind fc _ (Let fc' c val ty) tm)
-abstractEnvType fc (Pi fc' c e ty :: env) tm
+abstractEnvType {vars = _ :< _} fc (env :< Pi fc' c e ty) tm
     = abstractEnvType fc env (Bind fc _ (Pi fc' c e ty) tm)
-abstractEnvType fc (b :: env) tm
+abstractEnvType {vars = _ :< _} fc (env :< b) tm
     = let bnd = Pi (binderLoc b) (multiplicity b) Explicit (binderType b)
        in abstractEnvType fc env (Bind fc _ bnd tm)
 
@@ -155,10 +178,10 @@ abstractEnvType fc (b :: env) tm
 export
 abstractEnv : {vars : _} ->
               FC -> Env Term vars -> (tm : Term vars) -> ClosedTerm
-abstractEnv fc [] tm = tm
-abstractEnv fc (Let fc' c val ty :: env) tm
+abstractEnv fc [<] tm = tm
+abstractEnv {vars = _ :< _} fc (env :< Let fc' c val ty) tm
     = abstractEnv fc env (Bind fc _ (Let fc' c val ty) tm)
-abstractEnv fc (b :: env) tm
+abstractEnv {vars = _ :< _} fc (env :< b) tm
     = let bnd = Lam (binderLoc b) (multiplicity b) Explicit (binderType b)
       in abstractEnv fc env (Bind fc _ bnd tm)
 
@@ -166,24 +189,24 @@ abstractEnv fc (b :: env) tm
 export
 abstractFullEnvType : {vars : _} ->
                       FC -> Env Term vars -> (tm : Term vars) -> ClosedTerm
-abstractFullEnvType fc [] tm = tm
-abstractFullEnvType fc (Pi fc' c e ty :: env) tm
+abstractFullEnvType fc [<] tm = tm
+abstractFullEnvType {vars = _ :< _} fc (env :< Pi fc' c e ty) tm
     = abstractFullEnvType fc env (Bind fc _ (Pi fc' c e ty) tm)
-abstractFullEnvType fc (b :: env) tm
+abstractFullEnvType {vars = _ :< _} fc (env :< b) tm
     = let bnd = Pi fc (multiplicity b) Explicit (binderType b)
       in abstractFullEnvType fc env (Bind fc _ bnd tm)
 
 export
 mkExplicit : Env Term vs -> Env Term vs
-mkExplicit [] = Env.empty
-mkExplicit (Pi fc c _ ty :: env) = Pi fc c Explicit ty :: mkExplicit env
-mkExplicit (b :: env) = b :: mkExplicit env
+mkExplicit [<] = Env.empty
+mkExplicit (env :< Pi fc c _ ty) = Env.bind (mkExplicit env) (Pi fc c Explicit ty)
+mkExplicit (env :< b) = Env.bind (mkExplicit env) b
 
 export
 letToLam : Env Term vars -> Env Term vars
-letToLam [] = []
-letToLam (Let fc c val ty :: env) = Lam fc c Explicit ty :: letToLam env
-letToLam (b :: env) = b :: letToLam env
+letToLam [<] = [<]
+letToLam (env :< Let fc c val ty) = Env.bind (letToLam env) $ Lam fc c Explicit ty
+letToLam (env :< b) = Env.bind (letToLam env) b
 
 mutual
   findUsed : {vars : _} ->
@@ -195,7 +218,7 @@ mutual
            else assert_total (findUsedInBinder env (VarSet.insert v used)
                                                (getBinder p env))
   findUsed env used (Meta _ _ _ args)
-      = findUsedArgs env used args
+      = assert_total $ findUsedArgs env used $ map snd args
     where
       findUsedArgs : Env Term vars -> VarSet vars -> List (Term vars) -> VarSet vars
       findUsedArgs env u [] = u
@@ -203,10 +226,10 @@ mutual
           = findUsedArgs env (findUsed env u a) as
   findUsed env used (Bind fc x b tm)
       = assert_total $
-          VarSet.dropFirst (findUsed (b :: env)
+          VarSet.dropFirst (findUsed (Env.bind env b)
                           (weaken {tm = VarSet} (findUsedInBinder env used b))
                           tm)
-  findUsed env used (App fc fn arg)
+  findUsed env used (App fc fn _ arg)
       = findUsed env (findUsed env used fn) arg
   findUsed env used (As fc s a p)
       = findUsed env (findUsed env used a) p
@@ -235,13 +258,13 @@ findUsedLocs : {vars : _} ->
 findUsedLocs env tm = findUsed env VarSet.empty tm
 
 mkShrinkSub : {n : _} ->
-              (vars : _) -> VarSet (n :: vars) ->
-              (newvars ** Thin newvars (n :: vars))
-mkShrinkSub [] els
+              (vars : _) -> VarSet (Scope.bind vars n) ->
+              (newvars ** Thin newvars (Scope.bind vars n))
+mkShrinkSub [<] els
     = if first `VarSet.elem` els
          then (_ ** Keep Refl)
          else (_ ** Drop Refl)
-mkShrinkSub (x :: xs) els
+mkShrinkSub (xs :<  x) els
     = let (_ ** subRest) = mkShrinkSub xs (VarSet.dropFirst els) in
       if first `VarSet.elem` els
         then (_ ** Keep subRest)
@@ -250,8 +273,8 @@ mkShrinkSub (x :: xs) els
 mkShrink : {vars : _} ->
            VarSet vars ->
            (newvars ** Thin newvars vars)
-mkShrink {vars = []} xs = (_ ** Refl)
-mkShrink {vars = v :: vs} xs = mkShrinkSub _ xs
+mkShrink {vars = [<]} xs = (_ ** Refl)
+mkShrink {vars = vs :< v} xs = mkShrinkSub _ xs
 
 -- Find the smallest subset of the environment which is needed to type check
 -- the given term
@@ -264,26 +287,49 @@ findSubEnv env tm = mkShrink (findUsedLocs env tm)
 export
 shrinkEnv : Env Term vars -> Thin newvars vars -> Maybe (Env Term newvars)
 shrinkEnv env Refl = Just env
-shrinkEnv (b :: env) (Drop p) = shrinkEnv env p
-shrinkEnv (b :: env) (Keep p)
+shrinkEnv (env :< b) (Drop p) = shrinkEnv env p
+shrinkEnv (env :< b) (Keep p)
     = do env' <- shrinkEnv env p
          b' <- assert_total (shrinkBinder b p)
-         pure (b' :: env')
+         pure (env' :< b')
+
+rigRestrictW : RigCount -> RigCount
+rigRestrictW p = if p == top then top else erased
+
+restrictWEnv : Env Term vars -> Env Term vars
+restrictWEnv [<] = [<]
+restrictWEnv (env :< b) = restrictWEnv env :< setMultiplicity b (rigRestrictW $ multiplicity b)
+
+-- Restriction makes p-annotated variables that do not support at least q
+-- copies unavailable at runtime
+--
+-- We use restriction to push the ambient quantity p onto the context:
+--
+--    X |- e :p A
+-- =================
+-- X \ p |- e :|p| A
+--
+-- where |p| is `presence p`
+--
+-- Note: when p is Rig0, all context quantities are ignored.
+export
+restrictEnv : Env Term vars -> RigCount -> Env Term vars
+restrictEnv env p = if p == top then restrictWEnv env else env
 
 export
-mkEnvOnto : FC -> (xs : List Name) -> Env Term ys -> Env Term (xs ++ ys)
+mkEnvOnto : FC -> (xs : List Name) -> Env Term ys -> Env Term (Scope.ext ys xs)
 mkEnvOnto fc [] vs = vs
 mkEnvOnto fc (n :: ns) vs
-   = PVar fc top Explicit (Erased fc Placeholder)
-   :: mkEnvOnto fc ns vs
+   = let pv = PVar fc top Explicit (Erased fc Placeholder)
+   in mkEnvOnto fc ns (vs :< pv)
 
 -- Make a dummy environment, if we genuinely don't care about the values
 -- and types of the contents.
 -- We use this when building and comparing case trees.
 export
 mkEnv : FC -> (vs : Scope) -> Env Term vs
-mkEnv fc [] = []
-mkEnv fc (n :: ns) = PVar fc top Explicit (Erased fc Placeholder) :: mkEnv fc ns
+mkEnv fc [<] = Env.empty
+mkEnv fc (ns :< _) = Env.bind (mkEnv fc ns) $ PVar fc top Explicit (Erased fc Placeholder)
 
 -- Update an environment so that all names are guaranteed unique. In the
 -- case of a clash, the most recently bound is left unchanged.
@@ -293,7 +339,7 @@ export
 uniqifyEnv : {vars : _} ->
              Env Term vars ->
              (vars' ** (Env Term vars', CompatibleVars vars vars'))
-uniqifyEnv env = uenv [] env
+uniqifyEnv env = uenv Scope.empty env
   where
     next : Name -> Name
     next (MN n i) = MN n (i + 1)
@@ -301,7 +347,7 @@ uniqifyEnv env = uenv [] env
     next (NS ns n) = NS ns (next n)
     next n = MN (show n) 0
 
-    uniqueLocal : List Name -> Name -> Name
+    uniqueLocal : Scope -> Name -> Name
     uniqueLocal vs n
        = if n `elem` vs
                  -- we'll find a new name eventualy since the list of names
@@ -313,50 +359,42 @@ uniqifyEnv env = uenv [] env
             else n
 
     uenv : {vars : _} ->
-           List Name -> Env Term vars ->
+           Scope -> Env Term vars ->
            (vars' ** (Env Term vars', CompatibleVars vars vars'))
-    uenv used [] = ([] ** ([], Pre))
-    uenv used {vars = v :: vs} (b :: bs)
+    uenv used [<] = ([<] ** ([<], Pre))
+    uenv used {vars = vs :< v} (bs :< b)
         = if v `elem` used
              then let v' = uniqueLocal used v
-                      (vs' ** (env', compat)) = uenv (v' :: used) bs
+                      (vs' ** (env', compat)) = uenv (used :< v') bs
                       b' = map (compatNs compat) b in
-                  (v' :: vs' ** (b' :: env', Ext compat))
-             else let (vs' ** (env', compat)) = uenv (v :: used) bs
+                  (vs' :< v' ** (env' :< b', Ext compat))
+             else let (vs' ** (env', compat)) = uenv (used :< v) bs
                       b' = map (compatNs compat) b in
-                  (v :: vs' ** (b' :: env', Ext compat))
-
-export
-allVars : {0 vars : _} -> Env Term vars -> List (Var vars)
-allVars env = go env [<] where
-
-  go :  {0 vars : _} -> Env Term vars ->
-        {0 seen : SnocList Name} -> SizeOf seen ->
-        List (Var (seen <>> vars))
-  go [] _ = []
-  go (v :: vs) p = mkVarChiply p :: go vs (p :< _)
+                  (vs' :< v ** (env' :< b', Ext compat))
 
+sizeOf : {0 vars : _} -> Env Term vars -> SizeOf vars
+sizeOf [<] = zero
+sizeOf (env :< _) = suc (sizeOf env)
 
 export
-allVarsNoLet : {0 vars : _} -> Env Term vars -> List (Var vars)
-allVarsNoLet env = go env [<] where
+allVars : {0 vars : _} -> Env Term vars -> VarSet vars
+allVars env = VarSet.full (sizeOf env)
 
-  go :  {0 vars : _} -> Env Term vars ->
-        {0 seen : SnocList Name} -> SizeOf seen ->
-        List (Var (seen <>> vars))
-  go [] _ = []
-  go (Let _ _ _ _ :: vs) p = go vs (p :< _)
-  go (v :: vs) p = mkVarChiply p :: go vs (p :< _)
+export
+allVarsNoLet : {0 vars : _} -> Env Term vars -> VarSet vars
+allVarsNoLet [<] = VarSet.empty
+allVarsNoLet (vs :< Let {}) = weaken @{varSetWeaken} $ allVars vs
+allVarsNoLet a@(vs :< _) = allVars a
 
 export
 close : FC -> String -> Env Term vars -> Term vars -> ClosedTerm
 close fc nm env tm
   = let (s, env) = mkSubstEnv 0 env in
-    substs s env (rewrite appendNilRightNeutral vars in tm)
+    substs s env (rewrite appendLinLeftNeutral vars in tm)
 
   where
     mkSubstEnv : Int -> Env Term vs -> (SizeOf vs, SubstEnv vs Scope.empty)
-    mkSubstEnv i [] = (zero, Subst.empty)
-    mkSubstEnv i (v :: vs)
+    mkSubstEnv i [<] = (zero, Subst.empty {tm = Term})
+    mkSubstEnv i (vs :< v)
        = let (s, env) = mkSubstEnv (i + 1) vs in
-         (suc s, Ref fc Bound (MN nm i) :: env)
+         (suc s, env :< Ref fc Bound (MN nm i))
diff --git a/src/Core/Erase.idr b/src/Core/Erase.idr
new file mode 100644
index 00000000000..2130a810009
--- /dev/null
+++ b/src/Core/Erase.idr
@@ -0,0 +1,134 @@
+module Core.Erase
+
+-- Erase 0-mulitplicity arguments from runtime terms
+-- Assumption: Terms are already type correct
+
+import Core.Context
+import Core.Context.Log
+import Core.Env
+import Core.TT
+
+import Data.SnocList
+
+
+parameters {auto c : Ref Ctxt Defs}
+
+  echeck : {vars : _} ->
+           RigCount -> Env Term vars -> Term vars -> Core (Term vars)
+
+  echeckAlt : {vars : _} ->
+              -- must be Rig0 or Rig1
+              (rhsrig : RigCount) ->
+              Env Term vars ->
+              (scrig : RigCount) ->
+              CaseAlt vars ->
+              Core (CaseAlt vars)
+  echeckAlt rig env scrig (ConCase fc n t sc)
+      = pure $ ConCase fc n t !(echeckScope env sc)
+    where
+      echeckScope : {vars : _} -> Env Term vars -> CaseScope vars ->
+                    Core (CaseScope vars)
+      echeckScope env (RHS _ tm) = pure $ RHS [] !(echeck rig env tm)
+      echeckScope env (Arg c x sc)
+            -- We don't have the type of the argument, but the good news is
+            -- that we don't need it because we only need multiplicities and
+            -- they are cached in App nodes.
+          = do let env'
+                   = env :<
+                     PVar fc (rigMult scrig c) Explicit (Erased fc Placeholder)
+               sc' <- echeckScope env' sc
+               pure (Arg c x sc')
+  echeckAlt rig env scrig (DelayCase fc t a rhs)
+      = do -- See above for why the types are erased
+           let env'
+               = env :<
+                 PVar fc erased Implicit (Erased fc Placeholder) :<
+                 PVar fc scrig Explicit (Erased fc Placeholder)
+           rhs' <- echeck rig env' rhs
+           pure (DelayCase fc t a rhs')
+  echeckAlt rig env scrig (ConstCase fc c rhs)
+      = pure $ ConstCase fc c !(echeck rig env rhs)
+  echeckAlt rig env scrig (DefaultCase fc rhs)
+      = pure $ DefaultCase fc !(echeck rig env rhs)
+
+  echeckAlts : {vars : _} ->
+               (rhsrig : RigCount) ->
+               Env Term vars ->
+               (scrig : RigCount) ->
+               List (CaseAlt vars) ->
+               Core (List (CaseAlt vars))
+  echeckAlts rig env scrig [] = pure []
+  echeckAlts rig env scrig (a :: alts)
+     = do a' <- echeckAlt rig env scrig a
+          alts' <- echeckAlts rig env scrig alts
+          pure (a' :: alts')
+
+  echeckBinder : {vars : _} ->
+           RigCount -> Env Term vars -> Binder (Term vars) ->
+           Core (Binder (Term vars))
+  echeckBinder rig env (Lam fc c p ty) = pure $ Lam fc c p ty
+  echeckBinder rig env (Let fc c val ty)
+      = do val' <- echeck (rigMult rig c) env val
+           pure (Let fc c val' ty)
+  echeckBinder rig env (Pi fc c p ty)
+      = do ty' <- echeck (rigMult rig c) env ty
+           pure (Pi fc c p ty')
+  echeckBinder rig env (PVar fc c p ty)
+      = pure (PVar fc c p ty)
+  echeckBinder rig env (PLet fc c val ty)
+      = do val' <- echeck (rigMult rig c) env val
+           pure (PLet fc c val' ty)
+  echeckBinder rig env (PVTy fc c ty)
+      = pure (PVTy fc c ty)
+
+  echeck rig env (Meta fc n i args)
+      = do args' <- traverse (\ (c, arg) => do
+                           let argRig = rigMult rig c
+                           if isErased argRig
+                              then pure (c, Erased fc Placeholder)
+                              else do arg' <- echeck (rigMult rig c) env arg
+                                      pure (c, arg')) args
+           pure (Meta fc n i args')
+  echeck rig_in env (Bind fc nm b sc)
+      = do b' <- echeckBinder rig env b
+
+           -- Anything linear can't be used in the scope of a let/lambda, if
+           -- we're checking in general context
+           let (env', rig') = case b of
+                                   Pi _ _ _ _ => (env, rig)
+                                   _ => (restrictEnv env rig, presence rig)
+
+           sc' <- echeck rig' (env' :< b) sc
+           pure (Bind fc nm b' sc')
+    where
+      rig : RigCount
+      rig = case b of
+                 Pi _ _ _ _ =>
+                      if isErased rig_in
+                         then erased
+                         else top -- checking as if an inspectable run-time type
+                 _ => rig_in
+  echeck rig env (App fc fn q arg)
+      = do fn' <- echeck rig env fn
+           let argRig = rigMult rig q
+           arg' <- if isErased argRig
+                      then pure $ Erased fc Placeholder
+                      else echeck (rigMult rig q) env arg
+           pure (App fc fn' q arg')
+  echeck rig env (As fc s var pat)
+      = pure (As fc s !(echeck rig env var) !(echeck rig env pat))
+  echeck rig env (Case fc ct scrig sc ty alts)
+      = do sc' <- echeck (rigMult scrig rig) env sc
+           alts' <- echeckAlts (presence rig) (restrictEnv env rig) scrig alts
+           pure (Case fc ct scrig sc' ty alts')
+  echeck rig env (TDelay fc r ty arg)
+      = pure (TDelay fc r ty !(echeck rig env arg))
+  echeck rig env (TForce fc r tm) = pure (TForce fc r !(echeck rig env tm))
+  echeck rig env (Erased fc (Dotted t))
+     = pure (Erased fc (Dotted !(echeck rig env t)))
+  echeck rig env tm = pure tm
+
+  export
+  erase : {vars : _} ->
+          RigCount -> Env Term vars -> Term vars -> Core (Term vars)
+  erase = echeck
diff --git a/src/Core/Evaluate.idr b/src/Core/Evaluate.idr
new file mode 100644
index 00000000000..6ec4c03eb3b
--- /dev/null
+++ b/src/Core/Evaluate.idr
@@ -0,0 +1,413 @@
+module Core.Evaluate
+
+import Core.Context
+import Core.Context.Log
+import Core.Options.Log
+import Core.Env
+import public Core.Evaluate.Convert
+import public Core.Evaluate.Normalise
+import public Core.Evaluate.Quote
+import public Core.Evaluate.Value
+import Core.Evaluate.Expand
+import Core.TT
+
+import Data.SnocList
+
+parameters {auto c : Ref Ctxt Defs}
+
+  recompute : {vars: _} -> Env Term vars -> NF vars -> Core (NF vars)
+  recompute env val = do
+    tm <- quote env val
+    expand !(nf env tm)
+
+  export
+  touch : {vars: _} -> Env Term vars -> NF vars -> Core (NF vars)
+  touch env val@(VMeta{}) = recompute env val
+  touch env val@(VApp{}) = recompute env val
+  touch env val = pure val
+
+  export
+  normalise : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normalise env tm
+      = do val <- nf env tm
+           quoteNF env val
+
+  export
+  normaliseHNF : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseHNF env tm
+      = do val <- nf env tm
+           quoteHNF env val
+
+  export
+  normaliseAll : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseAll env tm
+      = do val <- expandFull !(nf env tm)
+           quoteNFall env val
+
+  export
+  normaliseHNFall : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseHNFall env tm
+      = do val <- expandFull !(nf env tm)
+           quoteHNFall env val
+
+  export
+  normaliseHoles : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseHoles env tm
+      = do val <- nfHoles env tm
+           quoteHoles env val
+
+  export
+  normaliseLHS : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseLHS env tm
+      = quoteHoles env !(nfLHS env tm)
+
+  export
+  normaliseBinders : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseBinders env tm
+      = do val <- nf env tm
+           quoteBinders env val
+
+  -- Normalise, but without normalising the types of binders.
+  export
+  normaliseScope : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseScope env (Bind fc n b sc)
+      = pure $ Bind fc n b !(normaliseScope (env :< b) sc)
+  normaliseScope env tm = normalise env tm
+
+  export
+  normaliseHolesScope : {vars: _} -> Env Term vars -> Term vars -> Core (Term vars)
+  normaliseHolesScope env (Bind fc n b sc)
+      = pure $ Bind fc n b !(normaliseHolesScope (env :< b) sc)
+  normaliseHolesScope env tm = normaliseHoles env tm
+
+  export
+  getArityVal : {vars: _} -> NF vars -> Core Nat
+  getArityVal (VBind fc _ (Pi _ _ _ _) sc)
+      = pure $ 1 + !(getArityVal !(expand !(sc (pure (VErased fc Placeholder)))))
+  getArityVal _ = pure 0
+
+  export
+  getArity : {vars: _} -> Env Term vars -> Term vars -> Core Nat
+  getArity env tm = getArityVal !(expand !(nf env tm))
+
+
+  -- If the term is an application of a primitive conversion (fromInteger etc)
+  -- and it's applied to a constant, fully normalise the term.
+  export
+  normalisePrims : {vs : _} ->
+                   -- size heuristic for when to unfold
+                   (Constant -> Bool) ->
+                   -- view to check whether an argument is a constant
+                   (arg -> Maybe Constant) ->
+                   -- Reduce everything (True) or just public export (False)
+                   Bool ->
+                   -- list of primitives
+                   List Name ->
+                   -- view of the potential redex
+                   (n : Name) ->          -- function name
+                   (args : SnocList arg) ->   -- arguments from inside out (arg1, ..., argk)
+                   -- actual term to evaluate if needed
+                   (tm : Term vs) ->      -- original term (n arg1 ... argk)
+                   Env Term vs ->         -- evaluation environment
+                   -- output only evaluated if primitive
+                   Core (Maybe (Term vs))
+  normalisePrims boundSafe viewConstant all prims n args tm env
+     = do let True = isPrimName prims !(getFullName n) -- is a primitive
+                | _ => pure Nothing
+          let (_ :< mc) = reverse args -- with at least one argument
+                | _ => pure Nothing
+          let (Just c) = viewConstant mc -- that is a constant
+                | _ => pure Nothing
+          let True = boundSafe c -- that we should expand
+                | _ => pure Nothing
+          tm <- if all
+                   then normaliseAll env tm
+                   else normalise env tm
+          pure (Just tm)
+
+  export
+  etaContract : {vars : _} -> Term vars -> Core (Term vars)
+  etaContract tm = do
+    defs <- get Ctxt
+    logTerm "eval.eta" 5 "Attempting to eta contract subterms of" tm
+    nf <- normalise (mkEnv EmptyFC _) tm
+    logTerm "eval.eta" 5 "Evaluated to" nf
+    res <- mapTermM act tm
+    logTerm "eval.eta" 5 "Result of eta-contraction" res
+    pure res
+
+     where
+
+      act : {vars : _} -> Term vars -> Core (Term vars)
+      act tm = do
+        logTerm "eval.eta" 10 "  Considering" tm
+        case tm of
+          (Bind _ x (Lam _ _ _ _) (App _ fn _ (Local _ _ Z _))) => do
+            logTerm "eval.eta" 10 "  Shrinking candidate" fn
+            let shrunk = shrinkTerm fn (Drop Refl)
+            case shrunk of
+              Nothing => do
+                log "eval.eta" 10 "  Failure!"
+                pure tm
+              Just tm' => do
+                logTerm "eval.eta" 10 "  Success!" tm'
+                pure tm'
+          _ => pure tm
+
+  export
+  logValue : {vars : _} ->
+          LogTopic -> Nat -> Lazy String -> Value f vars -> Core ()
+  logValue s n msg tmnf
+      = when !(logging s n) $
+          do defs <- get Ctxt
+             tmnf' <- toFullNames tmnf
+             depth <- getDepth
+             logString depth s.topic n (msg ++ ": " ++ show tmnf')
+
+  -- Log message with a value, translating back to human readable names first
+  export
+  logNF : {vars : _} ->
+          LogTopic -> Nat -> Lazy String -> Env Term vars -> Value f vars -> Core ()
+  logNF s n msg env tmnf
+      = when !(logging s n) $
+          do defs <- get Ctxt
+             tm <- logQuiet $ quote env tmnf
+             tm' <- toFullNames tm
+             depth <- getDepth
+             logString depth s.topic n (msg ++ ": " ++ show tm')
+
+  -- Log message with a term, reducing holes and translating back to human
+  -- readable names first
+  -- export
+  logTermNF' : {vars : _} ->
+               LogTopic ->
+               Nat -> Lazy String -> Env Term vars -> Term vars -> Core ()
+  logTermNF' s n msg env tm
+      = do defs <- get Ctxt
+           tmnf <- logQuiet $ normalise env tm
+           tm' <- toFullNames tmnf
+           depth <- getDepth
+           logString depth s.topic n (msg ++ ": " ++ show tm')
+
+  export
+  logTermNF : {vars : _} ->
+              LogTopic ->
+              Nat -> Lazy String -> Env Term vars -> Term vars -> Core ()
+  logTermNF s n msg env tm
+      = when !(logging s n) $ logTermNF' s n msg env tm
+
+  export
+  logEnv : {vars : _} ->
+           LogTopic ->
+           Nat -> String -> Env Term vars -> Core ()
+  logEnv s n msg env
+      = when !(logging s n) $
+          do depth <- getDepth
+             logString depth s.topic n msg
+             dumpEnv env
+    where
+      dumpEnv : {vs : SnocList Name} -> Env Term vs -> Core ()
+      dumpEnv [<] = pure ()
+      dumpEnv {vs = _ :< x} (bs :< Let _ c val ty)
+          = do logTermNF' s n (msg ++ ": let " ++ show x) bs val
+               logTermNF' s n (msg ++ ":" ++ show c ++ " " ++ show x) bs ty
+               dumpEnv bs
+      dumpEnv {vs = _ :< x} (bs :< b)
+          = do logTermNF' s n (msg ++ ":" ++ show (multiplicity b) ++ " " ++
+                             show (piInfo b) ++ " " ++
+                             show x) bs (binderType b)
+               dumpEnv bs
+
+  -- Return a new term, and whether any updates were made. If no updates were
+  -- made, we should stick with the original term (so no unnecessary expansion)
+  -- of App
+  replace'
+      : {vars: _} -> (expandGlued : Bool) -> Int -> Env Term vars ->
+        (orig : Value f vars) -> (parg : Term vars) -> (tm : Value f' vars) ->
+        Core (Term vars, Bool)
+  replace' {vars} expand tmpi env orig parg tm
+      = do ok <- convert env orig tm
+           if ok
+              then pure (parg, True)
+              else repSub tm
+    where
+      repArg : forall f . Value f vars -> Core (Term vars, Bool)
+      repArg = replace' expand tmpi env orig parg
+
+      repArgAll : Spine vars -> Core (SnocList (FC, RigCount, Term vars), Bool)
+      repArgAll [<] = pure ([<], False)
+      repArgAll (xs :< MkSpineEntry f r tm)
+          = do (xs', upd) <- repArgAll xs
+               (tm', upd') <- repArg !tm
+               pure (xs' :< (f, r, tm'), upd || upd')
+
+      repScope : FC -> Int -> (args : SnocList (RigCount, Name)) ->
+                 VCaseScope args vars -> Core (CaseScope vars, Bool)
+      repScope fc tmpi [<] rhs
+          = do -- Stop expanding or recursive functions will go forever
+               (rhs', u) <- replace' False tmpi env orig parg (snd !rhs)
+               pure (RHS [] rhs', u) -- Forced equalities thrown away now
+      repScope fc tmpi (xs :< (r, x)) scope
+          = do let xn = MN "tmpsc" tmpi
+               let xv = vRef fc Bound xn
+               (scope', u) <- repScope fc (tmpi + 1) xs (scope (pure xv))
+               pure (Arg r x (refsToLocalsCaseScope (Add x xn None) scope'), u)
+
+      repAlt : VCaseAlt vars -> Core (CaseAlt vars, Bool)
+      repAlt (VConCase fc n t args scope)
+          = do (scope', u) <- repScope fc tmpi args scope
+               pure (ConCase fc n t scope', u)
+      repAlt (VDelayCase fc ty arg scope)
+          = do let tyn = MN "tmpd" tmpi
+               let argn = MN "tmpd" (tmpi + 1)
+               let tyv = vRef fc Bound tyn
+               let argv = vRef fc Bound argn
+               -- Stop expanding or recursive functions will go forever
+               (scope', u) <- replace' False (tmpi + 2) env orig parg
+                                       (snd !(scope (pure tyv) (pure argv)))
+               let rhs = refsToLocals (Add arg argn (Add ty tyn None)) scope'
+               pure (DelayCase fc ty arg rhs, u)
+      repAlt (VConstCase fc c rhs)
+          = do (rhs', u) <- repArg rhs
+               pure (ConstCase fc c rhs', u)
+      repAlt (VDefaultCase fc rhs)
+          = do (rhs', u) <- repArg rhs
+               pure (DefaultCase fc rhs', u)
+
+      repSub : forall f . Value f vars -> Core (Term vars, Bool)
+
+      repPiInfo : forall f . PiInfo (Value f vars) -> Core (PiInfo (Term vars), Bool)
+      repPiInfo Explicit = pure (Explicit, False)
+      repPiInfo Implicit = pure (Implicit, False)
+      repPiInfo AutoImplicit = pure (AutoImplicit, False)
+      repPiInfo (DefImplicit t)
+         = do (t', u) <- repSub t
+              pure (DefImplicit t', u)
+
+      repBinder : forall f . Binder (Value f vars) -> Core (Binder (Term vars), Bool)
+      repBinder (Lam fc c p ty)
+          = do (p', u) <- repPiInfo p
+               (ty', u') <- repSub ty
+               pure (Lam fc c p' ty', u || u')
+      repBinder (Let fc c val ty)
+          = do (val', u) <- repSub val
+               (ty', u') <- repSub ty
+               pure (Let fc c val' ty', u || u')
+      repBinder (Pi fc c p ty)
+          = do (p', u) <- repPiInfo p
+               (ty', u') <- repSub ty
+               pure (Pi fc c p' ty', u || u')
+      repBinder (PVar fc c p ty)
+          = do (p', u) <- repPiInfo p
+               (ty', u') <- repSub ty
+               pure (PVar fc c p' ty', u || u')
+      repBinder (PLet fc c val ty)
+          = do (val', u) <- repSub val
+               (ty', u') <- repSub ty
+               pure (PLet fc c val' ty', u || u')
+      repBinder (PVTy fc c ty)
+          = do (ty', u) <- repSub ty
+               pure (PVTy fc c ty', u)
+
+      repSub (VBind fc x b scfn)
+          = do (b', u) <- repBinder b
+               let x' = MN "tmpb" tmpi
+               let var = vRef fc Bound x'
+               (sc', u') <- replace' expand (tmpi + 1) env orig parg !(scfn (pure var))
+               pure (Bind fc x b' (refsToLocals (Add x x' None) sc'), u || u')
+      repSub (VApp fc nt fn args val')
+          = do fl <- getFlags fn
+               if expand && not (BlockReduce `elem` fl)
+                 then do Just nf <- val'
+                              | Nothing =>
+                               do (args', u) <- repArgAll args
+                                  pure (applyStackWithFC (Ref fc nt fn) (toList args'), u)
+                         if !(blockedApp nf)
+                             then
+                                 do (args', u) <- repArgAll args
+                                    pure (applyStackWithFC (Ref fc nt fn) (toList args'), u)
+                              else
+                                 do (tm', u) <- replace' expand tmpi env orig parg nf
+                                    if u
+                                       then pure (tm', u)
+                                       else do (args', u) <- repArgAll args
+                                               pure (applyStackWithFC (Ref fc nt fn) (toList args'), u)
+                 else do (args', u) <- repArgAll args
+                         pure (applyStackWithFC (Ref fc nt fn) (toList args'), u)
+        where
+          getFlags : Name -> Core (List DefFlag)
+          getFlags fn
+              = do defs <- get Ctxt
+                   Just gdef <- lookupCtxtExact fn (gamma defs)
+                        | Nothing => pure []
+                   pure (flags gdef)
+      repSub (VLocal fc idx p args)
+          = do (args', u) <- repArgAll args
+               pure (applyStackWithFC (Local fc Nothing idx p) (toList args'), u)
+      -- Look in value of the metavar if it's solved, otherwise leave it
+      repSub (VMeta fc n i scope args val)
+          = do Nothing <- val
+                   | Just val' => repSub val'
+               sc' <- traverse (\ (q, tm) => do (tm', u) <- repArg !tm
+                                                pure ((q, tm'), u)) scope
+               (args', u) <- repArgAll args
+               let u' = or (map (\x => Delay x) (map snd sc'))
+               pure (applyStackWithFC (Meta fc n i (map fst sc')) (toList args'), u || u')
+      repSub (VDCon fc n t a args)
+        = do (args', u) <- repArgAll args
+             pure (applyStackWithFC (Ref fc (DataCon t a) n) (toList args'), u)
+      repSub (VTCon fc n a args)
+        = do (args', u) <- repArgAll args
+             pure (applyStackWithFC (Ref fc (TyCon a) n) (toList args'), u)
+      repSub (VAs fc s a pat)
+          = do (a', u) <- repSub a
+               (pat', u') <- repSub pat
+               pure (As fc s a' pat',  u || u')
+      repSub (VCase fc t r sc scty alts)
+          = do (sc', u) <- repArg sc
+               (scty', u') <- repArg scty
+               alts'  <- traverse repAlt alts
+               let u'' = or (map (\x => Delay x) (map snd alts'))
+               pure (Case fc t r sc' scty' (map fst alts'), u || u' || u'')
+      repSub (VDelayed fc r tm)
+          = do (tm', u) <- repSub tm
+               pure (TDelayed fc r tm', u)
+      repSub (VDelay fc r ty tm)
+          = do (ty', u) <- repArg ty
+               (tm', u') <- repArg tm
+               pure (TDelay fc r ty' tm', u || u')
+      repSub (VForce fc r tm args)
+          = do (args', u) <- repArgAll args
+               (tm', u') <- repSub tm
+               pure $ (applyStackWithFC (TForce fc r tm') (toList args'), u || u')
+      repSub tm = pure (!(quote env tm), False)
+
+  export
+  replace
+      : {vars: _} -> Env Term vars ->
+        (orig : Value f vars) -> (new : Term vars) -> (tm : Value f' vars) ->
+        Core (Term vars)
+  replace env orig new tm
+      = do (tm', _) <- replace' True 0 env orig new tm
+           pure tm'
+
+  export
+  replaceSyn
+      : {vars: _} -> Env Term vars ->
+        (orig : Value f vars) -> (new : Term vars) -> (tm : Value f' vars) ->
+        Core (Term vars)
+  replaceSyn env orig new tm
+      = do (tm', _) <- replace' False 0 env orig new tm
+           pure tm'
+
+export
+gErased : FC -> Glued vars
+gErased fc = VErased fc Placeholder
+
+export
+gType : FC -> Name -> Glued vars
+gType fc u = VType fc u
+
+export
+gUnmatched : FC -> String -> Glued vars
+gUnmatched fc msg = VUnmatched fc msg
diff --git a/src/Core/Evaluate/Convert.idr b/src/Core/Evaluate/Convert.idr
new file mode 100644
index 00000000000..bc31e6fb379
--- /dev/null
+++ b/src/Core/Evaluate/Convert.idr
@@ -0,0 +1,302 @@
+module Core.Evaluate.Convert
+
+import Core.Context
+import Core.Context.Log
+import Core.Core
+import Core.Env
+import Core.Evaluate.Quote
+import Core.Evaluate.Expand
+import Core.TT
+
+import Core.Evaluate.Normalise
+import Core.Evaluate.Value
+
+import Data.SnocList
+import Data.Vect
+import Libraries.Data.WithDefault
+
+data QVar : Type where
+
+data Strategy
+  = Reduce (List Namespace) -- reduce applications, as long as we're
+             -- in a namespace where the definition is visible
+  | BlockApp -- block all applications. This is for when we've gone under a
+             -- case so applications will be stuck
+
+genName : Ref QVar Int => String -> Core Name
+genName n
+    = do i <- get QVar
+         put QVar (i + 1)
+         pure (MN n i)
+
+genVar : Ref QVar Int => FC -> String -> Core (Value f vars)
+genVar fc n
+    = do var <- genName n
+         pure (vRef fc Bound var)
+
+-- TODO: Move to Core.TT.Universes
+addConstraint : {auto c : Ref Ctxt Defs} -> UConstraint -> Core ()
+addConstraint c
+    = do defs <- get Ctxt
+         put Ctxt ({ uconstraints $= (c ::) } defs)
+
+parameters {auto c : Ref Ctxt Defs}
+  convNF : {vars: _} -> Ref QVar Int =>
+           Strategy -> Env Term vars ->
+           NF vars -> NF vars -> Core Bool
+
+  convGen : {vars: _} -> Ref QVar Int =>
+            Strategy -> Env Term vars ->
+            Value f vars -> Value f' vars -> Core Bool
+
+  convSpine : {vars: _} -> Ref QVar Int =>
+              Strategy -> Env Term vars ->
+              Spine vars -> Spine vars -> Core Bool
+  convSpine s env [<] [<] = pure True
+  convSpine s env (xs :< x) (ys :< y)
+      = do True <- convGen s env !(value x) !(value y) | False => pure False
+           convSpine s env xs ys
+  convSpine s env _ _ = pure False
+
+  -- Applications which have been expanded, but not as far as 'case'
+  convertAppsNF :
+        {vars: _} ->
+        Ref QVar Int =>
+        Strategy -> Env Term vars ->
+        NF vars -> NF vars ->
+        Core Bool
+  -- If they're both still applications, see if they convert.
+  -- If they don't, see if they expand into Cases and continue if so
+  convertAppsNF s env x@(VApp _ nt n args _) y@(VApp _ nt' n' args' _)
+      = if n == n'
+           then convSpine s env args args'
+           else do x'@(VCase{}) <- expandApps x | _ => pure False
+                   y'@(VCase{}) <- expandApps y | _ => pure False
+                   -- See if the case blocks convert
+                   convGen s env x' y'
+  convertAppsNF s env (VApp{}) (VMeta{}) = pure False
+  convertAppsNF s env (VMeta{}) (VApp{}) = pure False
+  -- Expanded into something else, so we've made progress, so back to the top
+  -- level converstion
+  convertAppsNF s env x y = convGen s env x y
+
+  convertApps :
+        {vars: _} ->
+        Ref QVar Int =>
+        Strategy -> Env Term vars ->
+        FC -> NameType -> Name -> Spine vars -> Value f vars ->
+        FC -> NameType -> Name -> Spine vars -> Value f' vars ->
+        Core Bool
+  convertApps BlockApp env _ _ n args _ _ _ n' args' _
+      = if n == n'
+           then convSpine BlockApp env args args'
+           else pure False
+  convertApps s env fc nt n args x fn' nt' n' args' y
+      = -- If n == n' we can try to save work by just checking arguments
+        if n == n'
+           -- Otherwise, convert the values (val and val')
+           then do False <- convSpine BlockApp env args args'
+                            -- Check without reducing first since it might save a lot of work
+                            -- on success
+                       | True => pure True
+                   convertAppsNF s env !(expand x) !(expand y)
+           else convertAppsNF s env !(expand x) !(expand y)
+
+  -- Declared above
+  -- convNF : {vars : _} ->
+  --          Ref QVar Int =>
+  --          Strategy -> Env Term vars ->
+  --          NF vars -> NF vars -> Core Bool
+  convNF s env (VBind _ _ (Lam fc _ _ ty) sc) (VBind _ _ (Lam _ _ _ ty') sc')
+      = do True <- convGen s env ty ty' | False => pure False
+           var <- genVar fc "conv"
+           convGen s env !(sc $ pure var) !(sc' $ pure var)
+  convNF {vars} s env tmx@(VBind fc x (Lam bfc r p ty) sc) tmy
+      = do let etay = VBind fc x (Lam bfc r p ty) (apply fc tmy r)
+           convGen {f'=Normal} s env tmx etay
+  convNF {vars} s env tmx tmy@(VBind fc x (Lam bfc r p ty) sc)
+      = do let etax = VBind fc x (Lam bfc r p ty) (apply fc tmx r)
+           convGen {f=Normal} s env etax tmy
+  convNF {vars} s env (VBind fc x b sc) (VBind fc' x' b' sc')
+      = do True <- convBinders b b' | False => pure False
+           var <- genVar fc "conv"
+           convGen s env !(sc (pure var)) !(sc' (pure var))
+    where
+      sameBinders : Binder (Value f vars) -> Binder (Value f' vars) -> Bool
+      sameBinders (Pi {}) (Pi {}) = True
+      sameBinders (Lam {}) (Lam {}) = True
+      sameBinders _ _ = False
+
+      convPiInfo : PiInfo (Value f vars) -> PiInfo (Value f' vars) -> Core Bool
+      convPiInfo Implicit Implicit = pure True
+      convPiInfo Explicit Explicit = pure True
+      convPiInfo AutoImplicit AutoImplicit = pure True
+      convPiInfo (DefImplicit x) (DefImplicit y) = convGen s env x y
+      convPiInfo _ _ = pure False
+
+      convBinders : Binder (Value f vars) -> Binder (Value f' vars) -> Core Bool
+      convBinders bx by
+          = if sameBinders bx by && multiplicity bx == multiplicity by
+               then allM id [ convPiInfo (piInfo bx) (piInfo by)
+                            , convGen s env (binderType bx) (binderType by)]
+               else pure False
+
+  convNF s env x@(VApp fc nt n args val) y@(VApp fc' nt' n' args' val')
+      = convertAppsNF s env x y
+  convNF s env (VLocal _ i _ sp) (VLocal _ i' _ sp')
+      = if i == i'
+           then convSpine s env sp sp'
+           else pure False
+  convNF {vars} s env x@(VMeta _ _ i sc args val) y@(VMeta _ _ i' sc' args' val')
+      = do Just x <- val  | Nothing => convMeta
+           Just y <- val' | Nothing => convMeta
+           convGen s env !(expand x) !(expand y)
+    where
+      convScope : List (RigCount, Core (Glued vars)) ->
+                  List (RigCount, Core (Glued vars)) -> Core Bool
+      convScope [] [] = pure True
+      convScope ((_, x) :: xs) ((_, y) :: ys)
+          = do True <- convGen s env !x !y | False => pure False
+               convScope xs ys
+      convScope _ _ = pure False
+
+      convMeta : Core Bool
+      convMeta
+          = if i == i'
+               then do True <- convScope sc sc' | False => pure False
+                       convSpine s env args args'
+               else pure False
+  -- If one is a Metavar and the other isn't, try to reduce the Metavar first
+--   convNF s env (VMeta _ _ _ _ _ val) y
+--       = do Just x <- val | Nothing => pure False
+--            convGen s env !(expand x) !(expand y)
+--   convNF s env x (VMeta _ _ _ _ _ val)
+--       = do Just y <- val | Nothing => pure False
+--            convGen s env !(expand x) !(expand y)
+  convNF s env (VDCon _ n t a sp) (VDCon _ n' t' a' sp')
+      = if t == t'
+           then convSpine s env sp sp'
+           else pure False
+  convNF s env (VTCon _ n a sp) (VTCon _ n' a' sp')
+      = if n == n'
+           then convSpine s env sp sp'
+           else pure False
+  convNF s env (VAs _ _ _ x) (VAs _ _ _ y) = convGen s env x y
+  convNF {vars} s env (VCase fc t r sc ty alts) (VCase _ t' r' sc' ty' alts')
+      = do True <- convGen s env sc sc' | False => pure False
+           True <- convGen s env ty ty' | False => pure False
+           convAlts alts alts'
+   where
+     blockIfPat : CaseType -> Strategy
+     blockIfPat PatMatch = BlockApp
+     blockIfPat _ = s
+
+     convScope : (args : SnocList (RigCount, Name)) ->
+                 VCaseScope args vars ->
+                 (args' : SnocList (RigCount, Name)) ->
+                 VCaseScope args' vars ->
+                 Core Bool
+     -- block applications to avoid reducing indefinitely
+     convScope [<] sc [<] sc' = convGen (blockIfPat t) env (snd !sc) (snd !sc')
+     convScope (xs :< x) sc (ys :< y) sc'
+         = do xn <- genVar fc "arg"
+              convScope xs (sc (pure xn)) ys (sc' (pure xn))
+     convScope _ _ _ _ = pure False
+
+     convAlt : VCaseAlt vars -> VCaseAlt vars -> Core Bool
+     convAlt (VConCase _ n t args sc) (VConCase _ n' t' args' sc')
+         = if t == t'
+              then convScope args sc args' sc'
+              else pure False
+     convAlt (VDelayCase _ t a sc) (VDelayCase _ t' a' sc')
+         = do tn <- genVar fc "t"
+              an <- genVar fc "a"
+              convGen BlockApp env (snd !(sc (pure tn) (pure an)))
+                                   (snd !(sc' (pure tn) (pure an)))
+     convAlt (VConstCase _ c x) (VConstCase _ c' y)
+         = if c == c'
+              then convGen BlockApp env x y
+              else pure False
+     convAlt (VDefaultCase _ x) (VDefaultCase _ y) = convGen BlockApp env x y
+     convAlt _ _ = pure False
+
+     convAlts : List (VCaseAlt vars) -> List (VCaseAlt vars) -> Core Bool
+     convAlts [] [] = pure True
+     convAlts (x :: xs) (y :: ys)
+         = do True <- convAlt x y | False => pure False
+              convAlts xs ys
+     convAlts _ _ = pure False
+  convNF s env (VDelayed _ r x) (VDelayed _ r' y)
+      = if compatible r r'
+           then convGen s env x y
+           else pure False
+  convNF s env (VDelay _ r _ x) (VDelay _ r' _ y)
+      = if compatible r r'
+           then convGen s env x y
+           else pure False
+  convNF s env (VForce _ r x spx) (VForce _ r' y spy)
+      = if compatible r r'
+           then do True <- convGen s env x y
+                       | False => pure False
+                   convSpine s env spx spy
+           else pure False
+
+  convNF s env (VPrimVal _ c) (VPrimVal _ c') = pure $ c == c'
+  convNF {vars} s env (VPrimOp _ fn args) (VPrimOp _ fn' args')
+      = if sameFn fn fn'
+           then convArgs args args'
+           else pure False
+    where
+      convArgs : Vect n (Value f vars) -> Vect m (Value f' vars) -> Core Bool
+      convArgs [] [] = pure True
+      convArgs (x :: xs) (y :: ys)
+          = do True <- convGen s env x y
+                    | False => pure False
+               convArgs xs ys
+      convArgs _ _ = pure False
+  convNF s env (VErased _ (Dotted t)) u = convGen s env t u
+  convNF s env t (VErased _ (Dotted u)) = convGen s env t u
+  convNF s env (VErased _ _) _ = pure True
+  convNF s env _ (VErased _ _) = pure True
+  convNF s env (VType fc n) (VType fc' n')
+      = do addConstraint (ULE n n') --(ULE fc n fc' n')
+           pure True
+  convNF s env x y = pure False
+
+  convGen s env x@(VApp fc nt n args val) y@(VApp fc' nt' n' args' val')
+      = convertApps s env fc nt n args x fc' nt' n' args' y
+  convGen s env x y = convNF s env !(expand x) !(expand y)
+
+  namespace Value
+    export
+    convert : {vars: _} -> Env Term vars -> Value f vars -> Value f' vars -> Core Bool
+    convert env x y
+        = do q <- newRef QVar 0
+             defs <- get Ctxt
+             convGen (Reduce (currentNS defs :: nestedNS defs)) env x y
+
+    export
+    chkConvert : {vars : _} ->
+                 FC -> Env Term vars -> Value f vars -> Value f' vars -> Core ()
+    chkConvert fc env x y
+        = do True <- convert env x y
+                 | False => throw (CantConvert fc (gamma !(get Ctxt)) env
+                                               !(quote env x)
+                                               !(quote env y))
+             pure ()
+
+  namespace Term
+    export
+    convert : {vars: _} -> Env Term vars -> Term vars -> Term vars -> Core Bool
+    convert env x y
+        = do x' <- nf env x
+             y' <- nf env y
+             convert env x' y'
+
+    export
+    chkConvert : {vars : _} ->
+                 FC -> Env Term vars -> Term vars -> Term vars -> Core ()
+    chkConvert fc env x y
+        = do True <- convert env x y
+                 | False => throw (CantConvert fc (gamma !(get Ctxt)) env x y)
+             pure ()
diff --git a/src/Core/Evaluate/Expand.idr b/src/Core/Evaluate/Expand.idr
new file mode 100644
index 00000000000..2d921527650
--- /dev/null
+++ b/src/Core/Evaluate/Expand.idr
@@ -0,0 +1,209 @@
+module Core.Evaluate.Expand
+
+import Core.Context
+import Core.Env
+import Core.Context.Log
+import Core.Evaluate.Value
+import Core.Primitives
+import Core.Evaluate.Quote
+
+import Data.Vect
+import Data.SnocList
+import Libraries.Data.WithDefault
+import Libraries.Data.SnocList.LengthMatch
+
+data ExpandDepth
+  = OnlyVisible -- expand applications with respect their visibility between namespaced names
+  | Apps -- expand applications regardless namespaced names visibility
+  | Cases -- expand cases too
+  | Full -- reduce as much as possible regardless visibility and cases
+
+Show ExpandDepth where
+  show OnlyVisible = "OnlyVisible"
+  show Apps = "Apps"
+  show Cases = "Cases"
+  show Full = "Full"
+
+Eq ExpandDepth where
+  (==) OnlyVisible OnlyVisible = True
+  (==) Apps Apps = True
+  (==) Cases Cases = True
+  (==) Full Full = True
+  (==) _ _ = False
+
+Ord ExpandDepth where
+  compare OnlyVisible OnlyVisible = EQ
+  compare Apps Apps = EQ
+  compare Cases Cases = EQ
+  compare Full Full = EQ
+
+  compare OnlyVisible _ = LT
+  compare Apps Cases = LT
+  compare _ Full = LT
+
+  compare _ OnlyVisible = GT
+  compare Cases Apps = GT
+  compare Full _ = GT
+
+-- If a value is an App or Meta node, then it might be reducible. Expand it
+-- just enough that we have the right top level node.
+-- Don't expand Apps to a blocked top level cases, unless 'cases' is set.
+-- The 'believe_me' are there to save us deconstructing and reconstructing
+-- just to change a compile-time only index
+expand' : {auto c : Ref Ctxt Defs} ->
+          {vars: _} ->
+          ExpandDepth -> Value f vars -> Core (NF vars)
+expand' mode v@(VApp fc nt n sp val)
+    = do vis <- getVisibilityWeaked fc n
+         full_name <- toFullNames n
+         defs <- get Ctxt
+         let ns = currentNS defs :: nestedNS defs
+         logC "eval.def.stuck" 50 $ pure "expand App \{show mode} ns: \{show ns}, n: \{show n}, vis: \{show $ collapseDefault vis}, full_name: \{show full_name}"
+         if mode == Full || reducibleInAny ns (if mode == OnlyVisible then full_name else n) (collapseDefault vis)
+            -- If we are in Cases we are still needed to confirm that a name can be reduced.
+            -- If a name has no namespace (i.e. Resolved _) it will be reduced
+            then do
+               Just val' <- logDepth val
+                    | Nothing => pure (believe_me v)
+               logC "eval.def.stuck" 50 $ do val' <- toFullNames val'
+                                             pure "Reduced VApp \{show mode} \{show full_name} to \{show val'}"
+               if mode >= Cases
+                  then expand' mode val'
+                  else if !(blockedApp val')
+                          then pure (believe_me v)
+                          else expand' mode val'
+            else pure (believe_me v)
+
+expand' mode@Full v@(VCase fc t r sc ty alts)
+    = do sc' <- logDepth $ expand' mode sc
+         logC "eval.def.stuck" 50 $ pure "expand try VCase \{show t} \{show !(toFullNames sc)} (\{show !(toFullNames sc')}) alts: \{show !(toFullNames alts)}"
+         Just res <- tryAlts sc' alts
+              | Nothing =>
+                do logC "eval.def.stuck" 50 $ pure "expand failed VCase \{show t} \{show !(toFullNames sc)} (\{show !(toFullNames sc')}) alts: \{show !(toFullNames alts)}"
+                   pure $ VCase fc t r sc' ty alts
+         logC "eval.def.stuck" 50 $ pure "expand \{show !(toFullNames v)} to \{show !(toFullNames res)}"
+         expand' mode res
+  where
+    caseScope' : (vs : SnocList (Core (Glued vars))) ->
+                 (0 _ : LengthMatch vs args) ->
+                 VCaseScope args vars ->
+                 Core (Glued vars)
+    caseScope' [<] LinMatch scope
+      = do logC "eval.def.stuck" 50 $ pure "Begin Expand VCaseScope"
+           pure $ snd !scope
+    caseScope' (vars :< v) (SnocMatch m) scope
+      = do logC "eval.def.stuck" 50 $ pure "Put arg to Expand VCaseScope"
+           caseScope' vars m (scope v)
+
+    caseScope : SnocList (Core (Glued vars)) ->
+                (args : SnocList (RigCount, Name)) ->
+                VCaseScope args vars ->
+                Core (Glued vars)
+    caseScope vs as scope
+      = case checkLengthMatch vs as of
+             Just m => caseScope' vs m scope
+             Nothing => throw (GenericMsg fc "Stuck to expand VCaseScope: \{show vars}")
+
+    tryAlt : NF vars -> VCaseAlt vars -> Core (Maybe (Glued vars))
+    tryAlt _ (VDefaultCase _ rhs) = pure $ Just rhs
+    tryAlt (VDCon _ _ t a sp) (VConCase _ _ t' args scoped) =
+      if t == t' then do
+          pure $ Just !(caseScope (map value sp) args scoped)
+        else pure Nothing
+    tryAlt (VTCon _ n a sp) (VConCase _ n' _ args scoped) =
+      if n == n' then do
+          pure $ Just !(caseScope (map value sp) args scoped)
+        else pure Nothing
+    tryAlt (VDelay _ _ ty arg) (VDelayCase _ ty' arg' rhs) =
+        pure $ Just !(caseScope [<pure ty, pure arg] [<(top, ty'), (erased, arg')] rhs)
+    tryAlt (VPrimVal _ c) (VConstCase _ c' rhs) =
+      if c == c' then pure $ Just rhs
+        else pure Nothing
+    tryAlt (VErased _ (Dotted v)) alt = tryAlt v alt
+    tryAlt _ _ = pure Nothing
+
+    tryAlts : NF vars -> List (VCaseAlt vars) -> Core (Maybe (Glued vars))
+    tryAlts sc (a :: alts)
+      = case !(tryAlt sc a) of
+             Nothing => tryAlts sc alts
+             Just res => pure $ Just res
+    tryAlts sc [] = pure Nothing
+
+expand' mode@Full (VPrimOp fc op args)
+    = do args' <- traverseVect (expand' mode) args
+         case getOp op args' of
+           Just res => do logC "eval.def.stuck" 50 $ pure "Reduced full VPrimOp op: \{show op} to \{show !(toFullNames res)}"
+                          pure res
+           Nothing => do logC "eval.def.stuck" 50 $ pure "Reduced only args VPrimOp op: \{show op} \{show $ !(traverse toFullNames $ toList args')}"
+                         pure $ VPrimOp fc op (believe_me args')
+expand' mode (VErased fc (Dotted t))
+    = do t' <- expand' mode t
+         pure (VErased fc (Dotted t'))
+expand' mode v@(VMeta fc n i args sp val)
+    = do logC "eval.def.stuck" 50 $ pure "expand Meta n: \{show n}"
+         Just val' <- logDepth val
+              | Nothing => pure (believe_me v)
+         logC "eval.def.stuck" 50 $ do n' <- toFullNames n
+                                       val' <- toFullNames val'
+                                       pure "Reduced VMeta \{show mode} \{show n'} to \{show val'}"
+        --  if !(blockedApp val')
+        --   then pure (believe_me v)
+        --   else expand' mode val'
+         expand' mode val'
+expand' mode val = pure (believe_me val)
+
+logNF : {vars : _} ->
+        {auto c : Ref Ctxt Defs} ->
+        LogTopic -> Nat -> Lazy String -> Value f vars -> Core ()
+logNF s n msg tmnf
+    = when !(logging s n) $
+        do defs <- get Ctxt
+           tm <- logQuiet $ quote (mkEnv emptyFC _) tmnf
+           tm' <- toFullNames tm
+           depth <- getDepth
+           logString depth s.topic n (msg ++ ": " ++ show tm')
+
+export
+expand : {auto c : Ref Ctxt Defs} ->
+         {vars: _} ->
+         Value f vars -> Core (NF vars)
+expand v = do
+  logNF "eval.def.stuck" 50 "Begin Expand OnlyVisible for" v
+  logDepth $ expand' OnlyVisible v
+
+export
+expandApps : {auto c : Ref Ctxt Defs} ->
+         {vars: _} ->
+         Value f vars -> Core (NF vars)
+expandApps v = do
+  logNF "eval.def.stuck" 50 "Begin Expand Apps for" v
+  logDepth $ expand' Apps v
+
+-- TODO: useless?
+export
+expandCases : {auto c : Ref Ctxt Defs} ->
+             {vars: _} ->
+             Value f vars -> Core (NF vars)
+expandCases v = do
+  logNF "eval.def.stuck" 50 "Begin Expand Cases for" v
+  logDepth $ expand' Cases v
+
+export
+expandFull : {auto c : Ref Ctxt Defs} ->
+             {vars: _} ->
+             Value f vars -> Core (NF vars)
+expandFull v = do
+  logNF "eval.def.stuck" 50 "Begin Expand Full for" v
+  logDepth $ expand' Full v
+
+export
+spineVal : {auto c : Ref Ctxt Defs} ->
+           {vars: _} ->
+           SpineEntry vars -> Core (NF vars)
+spineVal e = expand !(value e)
+
+export
+spineValFull : {auto c : Ref Ctxt Defs} ->
+           {vars: _} ->
+           SpineEntry vars -> Core (NF vars)
+spineValFull e = expandFull !(value e)
diff --git a/src/Core/Evaluate/Normalise.idr b/src/Core/Evaluate/Normalise.idr
new file mode 100644
index 00000000000..96436d5d1d8
--- /dev/null
+++ b/src/Core/Evaluate/Normalise.idr
@@ -0,0 +1,519 @@
+module Core.Evaluate.Normalise
+
+import Core.Core
+import Core.Context
+import Core.Context.Log
+import Core.Env
+import Core.Evaluate.Value
+import Core.Primitives
+import Core.TT
+import Core.Evaluate.Expand
+
+import Data.List
+import Data.SnocList
+import Data.Vect
+import Data.SnocList.Quantifiers
+
+import System
+
+data HolesMode
+    = HolesAll -- expand all defined holes, and nothing else
+    | HolesArgs -- expand 'alwaysInline', evaluate holes which are relevant arguments, but don't expand any 'let' at all
+                -- former `KeepLet` but with an addition to deal with argument holes
+
+data EvalFlags
+    = Full
+    | KeepAs -- keep @ patterns, don't expand any 'let' in the environment
+    | Totality
+    | Holes HolesMode
+
+Show EvalFlags where
+  show KeepAs = "KeepAs"
+  show Full = "Full"
+  show Totality = "Totality"
+  show (Holes HolesAll) = "HolesAll"
+  show (Holes HolesArgs) = "HolesArgs"
+
+export
+apply : FC -> Value f vars -> RigCount -> Core (Glued vars) -> Core (Glued vars)
+apply fc (VBind _ _ (Lam _ _ _ _) sc) _ arg = sc arg
+-- might happen if we're in KeepLet mode
+apply fc (VBind bfc x (Let lfc c val ty) sc) q arg
+    = pure $ VBind bfc x (Let lfc c val ty)
+                   (\val' => apply fc !(sc val') q arg)
+apply fc (VApp afc nt n spine go) q arg
+    = pure $ VApp afc nt n (spine :< MkSpineEntry fc q arg) $
+           do Just go' <- go
+                   | Nothing => pure Nothing
+              res <- apply fc go' q arg
+              pure (Just res)
+apply fc (VLocal lfc idx p spine) q arg
+    = pure $ VLocal lfc idx p (spine :< MkSpineEntry fc q arg)
+apply fc (VMeta mfc n i sc spine go) q arg
+    = pure $ VMeta mfc n i sc (spine :< MkSpineEntry fc q arg) $
+           do Just go' <- go
+                   | Nothing => pure Nothing
+              res <- apply fc go' q arg
+              pure (Just res)
+apply fc (VDCon dfc n t a spine) q arg
+    = pure $ VDCon dfc n t a (spine :< MkSpineEntry fc q arg)
+apply fc (VTCon tfc n a spine) q arg
+    = pure $ VTCon tfc n a (spine :< MkSpineEntry fc q arg)
+apply fc (VAs _ _ _ pat) q arg
+    = apply fc pat q arg -- doesn't really make sense to keep the name
+apply fc (VForce ffc r v spine) q arg
+    = pure $ VForce ffc r v (spine :< MkSpineEntry fc q arg)
+apply fc (VCase cfc t r sc ty alts) q arg
+    = pure $ VCase cfc t r sc ty !(traverse (applyAlt arg) alts)
+  where
+    applyConCase : Core (Glued vars) ->
+                   Name -> Int ->
+                   (args : SnocList (RigCount, Name)) ->
+                   VCaseScope args vars ->
+                   VCaseScope args vars
+    applyConCase arg n t [<] rhs
+        = do (fs, rhs') <- rhs
+             sc <- apply fc rhs' q arg
+             pure (fs, sc)
+    applyConCase arg n t (args :< (r, a)) sc
+        = \a' => applyConCase arg n t args (sc a')
+
+    -- Need to apply the argument to the rhs of every case branch
+    applyAlt : Core (Glued vars) -> VCaseAlt vars -> Core (VCaseAlt vars)
+    applyAlt arg (VConCase fc n t args rhs)
+        = pure $ VConCase fc n t args (applyConCase arg n t args rhs)
+    applyAlt arg (VDelayCase fc t a rhs)
+        = pure $ VDelayCase fc t a
+                  (\t', a' =>
+                      do (fs, rhs') <- rhs t' a'
+                         sc <- apply fc rhs' q arg
+                         pure (fs, sc))
+    applyAlt arg (VConstCase fc c rhs) = VConstCase fc c <$> apply fc rhs q arg
+    applyAlt arg (VDefaultCase fc rhs) = VDefaultCase fc <$> apply fc rhs q arg
+-- Remaining cases would be ill-typed
+apply _ arg _ _ = pure (believe_me arg)
+
+export
+applyAll : FC -> Glued vars -> List (RigCount, Core (Glued vars)) -> Core (Glued vars)
+applyAll fc f [] = pure f
+applyAll fc f ((q, x) :: xs)
+    = do f' <- apply fc f q x
+         applyAll fc f' xs
+
+data LocalEnv : SnocList Name -> SnocList Name -> Type where
+     Lin : LocalEnv [<] vars
+     (:<) : LocalEnv free vars -> Core (Glued vars) -> LocalEnv (free :< x) vars
+
+namespace LocalEnv
+  public export
+  empty : LocalEnv Scope.empty vars
+  empty = [<]
+
+  addInner : LocalEnv ns vars -> LocalEnv ms vars -> LocalEnv (Scope.addInner ms ns) vars
+  addInner [<] env = env
+  addInner (vars :< x) env = addInner vars env :< x
+
+updateEnv : {idx : _} ->
+            LocalEnv free vars ->
+            (0 _ : IsVar n idx (vars ++ free)) -> Core (Glued vars) ->
+            LocalEnv free vars
+updateEnv (env :< b) First new = env :< new
+updateEnv (env :< b) (Later p) new = updateEnv env p new :< b
+updateEnv env _ _ = env
+
+namespace ExtendLocs
+  public export
+  data ExtendLocs : SnocList Name -> SnocList Name -> Type where
+       Lin : ExtendLocs vars [<]
+       (:<) : ExtendLocs vars xs -> Core (Glued vars) -> ExtendLocs vars (cons x xs)
+
+mkEnv : ExtendLocs vars ns -> LocalEnv ns vars
+mkEnv {vars} ext = rewrite sym (appendLinLeftNeutral ns) in go ext [<]
+  where
+    go : ExtendLocs vars ns' -> LocalEnv rest vars ->
+         LocalEnv (rest ++ ns') vars
+    go [<] locs = locs
+    go {ns' = cons x xs} {rest} (ext :< val) locs
+        = rewrite appendAssociative rest [<x] xs in
+                  go ext (locs :< val)
+
+parameters {auto c : Ref Ctxt Defs} (eflags : EvalFlags)
+
+  runOp : {ar, vars : _} ->
+          FC -> PrimFn ar -> Vect ar (Glued vars) -> Core (NF vars)
+  runOp fc op args
+      = do args' <- traverseVect expandApps args
+           -- If it gets stuck, return the glued args, not the values
+           case getOp op args' of
+             Just res => pure res
+             Nothing => do pure $ VPrimOp fc op args
+
+  -- Forward declared since these are all mutual
+  export
+  eval : {vars, free: _} -> LocalEnv free vars ->
+         Env Term vars ->
+         Term (vars ++ free) -> Core (Glued vars)
+
+  evalCaseAlt : {vars, free: _} -> LocalEnv free vars -> Env Term vars ->
+                CaseAlt (vars ++ free) ->
+                Core (VCaseAlt vars)
+  evalCaseAlt {vars} {free} locs env (ConCase fc n tag scope)
+      = pure $ VConCase fc n tag _ (getScope locs scope)
+    where
+      CaseArgs : CaseScope vs -> SnocList (RigCount, Name)
+      CaseArgs (RHS _ tm) = [<]
+      CaseArgs (Arg r x sc) = CaseArgs sc :< (r, x)
+
+      evalForced : {free: _} -> LocalEnv free vars ->
+                   (Var (vars ++ free), Term (vars ++ free)) ->
+                   Core (Glued vars, Glued vars)
+      evalForced locs (MkVar v, tm)
+          = do v' <- eval locs env (Local fc Nothing _ v)
+               tm' <- eval locs env tm
+               pure (v', tm')
+
+      getScope : {free: _} -> LocalEnv free vars ->
+                 (sc : CaseScope (vars ++ free)) ->
+                 VCaseScope (CaseArgs sc) vars
+      getScope locs (RHS fs tm)
+          = do tm' <- eval locs env tm
+               fs' <- traverse (evalForced locs) fs
+               pure (fs', tm')
+      getScope locs (Arg r x sc) = \v => getScope (locs :< v) sc
+
+  evalCaseAlt locs env (DelayCase fc t a tm)
+      = pure $ VDelayCase fc t a
+                 (\t', a' => pure ([], !(eval (locs :< a' :< t') env tm)))
+  evalCaseAlt locs env (ConstCase fc c tm)
+      = pure $ VConstCase fc c !(eval locs env tm)
+  evalCaseAlt locs env (DefaultCase fc tm)
+      = pure $ VDefaultCase fc !(eval locs env tm)
+
+  blockedCase : {vars, free: _} -> FC -> LocalEnv free vars -> Env Term vars ->
+                CaseType -> RigCount ->
+                (sc : NF vars) -> (scTy : Term (vars ++ free)) ->
+                List (CaseAlt (vars ++ free)) ->
+                Core (Glued vars)
+  blockedCase fc locs env t r sc scTy alts
+      = do scTy' <- eval locs env scTy
+           alts' <- traverse (evalCaseAlt locs env) alts
+           pure (VCase fc t r sc scTy' alts')
+
+  -- We've turned the spine into a list so that the argument positions
+  -- correspond when going through the CaseScope
+  evalCaseScope : {vars, free: _} -> LocalEnv free vars -> Env Term vars ->
+                  List (SpineEntry vars) -> CaseScope (vars ++ free) ->
+                  Core (Glued vars) -> -- what to do if stuck
+                  Core (Glued vars)
+  evalCaseScope locs env [] (RHS _ tm) stuck = eval locs env tm
+  evalCaseScope locs env (e :: sp) (Arg r x sc) stuck
+      = evalCaseScope (locs :< value e) env sp sc stuck
+  evalCaseScope _ _ _ _ stuck = stuck
+
+  tryAlt : {vars, free: _} -> LocalEnv free vars -> Env Term vars ->
+           (sc : NF vars) -> -- scrutinee, which we assume to be in
+                 -- canonical form since we've checked (so not blocked)
+           (CaseAlt (vars ++ free)) ->
+           Core (Glued vars) -> -- what to do if stuck
+           Maybe (Core (Glued vars))
+  tryAlt locs env sc (DefaultCase _ rhs) stuck = Just (eval locs env rhs)
+  tryAlt {vars} locs env (VDCon _ _ t a sp) (ConCase _ _ t' cscope) stuck
+      = if t == t' then Just (evalCaseScope locs env (cast sp) cscope stuck)
+           else Nothing
+  tryAlt {vars} locs env (VTCon _ n a sp) (ConCase _ n' _ cscope) stuck
+      = if n == n' then Just (evalCaseScope locs env (cast sp) cscope stuck)
+           else Nothing
+  tryAlt locs env (VDelay _ _ ty arg) (DelayCase _ ty' arg' rhs) stuck
+      = Just (eval (locs :< pure ty :< pure arg) env rhs)
+  tryAlt locs env (VPrimVal _ c) (ConstCase _ c' rhs) stuck
+      = if c == c'
+           then Just (eval locs env rhs)
+           else Nothing
+  tryAlt locs env (VErased _ (Dotted v)) alt stuck
+      = tryAlt locs env v alt stuck
+  tryAlt _ _ _ _ _ = Nothing
+
+  tryAlts : {vars, free: _} -> LocalEnv free vars -> Env Term vars ->
+            (sc : NF vars) -> -- scrutinee, which we assume to be in
+                  -- canonical form since we've checked (so not blocked)
+            List (CaseAlt (vars ++ free)) ->
+            Core (Glued vars) -> -- what to do if stuck
+            Core (Glued vars)
+  tryAlts locs env sc (a :: alts) stuck
+      = case tryAlt locs env sc a stuck of
+             Nothing => tryAlts locs env sc alts stuck
+             Just res => res
+  tryAlts locs env sc [] stuck = stuck
+
+  evalCaseBlock
+           : {vars, free: _} -> FC -> LocalEnv free vars -> Env Term vars ->
+             CaseType -> RigCount -> (sc : NF vars) -> (scTy : Term (vars ++ free)) ->
+             List (CaseAlt (vars ++ free)) ->
+             Core (Glued vars)
+  evalCaseBlock fc locs env t r sc ty alts
+      = if isCanonical sc
+           then tryAlts locs env sc alts (blockedCase fc locs env t r sc ty alts)
+           else blockedCase fc locs env t r sc ty alts
+    where
+      isCanonical : NF vars -> Bool
+      isCanonical (VBind{}) = True
+      isCanonical (VDCon{}) = True
+      isCanonical (VTCon{}) = True
+      isCanonical (VDelay{}) = True
+      isCanonical (VPrimVal{}) = True
+      isCanonical (VType{}) = True
+      isCanonical (VErased _ (Dotted t)) = isCanonical t
+      isCanonical _ = False
+
+  evalCase : {vars, free: _} -> LocalEnv free vars ->
+             Env Term vars ->
+             FC -> CaseType -> RigCount ->
+             Term (vars ++ free) -> Term (vars ++ free) ->
+             List (CaseAlt (vars ++ free)) -> Core (Glued vars)
+  evalCase locs env fc t r sc ty alts
+      = do sc' <- case eflags of
+                       -- Don't expand in totality mode or we might reduce too
+                       -- much
+                       Totality => believe_me $ eval locs env sc
+                       _ => expandApps !(eval locs env sc)
+           logC "eval.casetree" 5 $ do
+             xval <- toFullNames sc
+             pure "Evaluated \{show t} \{show xval} to \{show !(toFullNames sc')}"
+           locs' <- case sc of
+                         Local _ _ _ p => pure $ updateEnv locs p (pure (asGlued sc'))
+                         _ => pure locs
+           evalCaseBlock fc locs' env t r (stripAs sc') ty alts
+    where
+      stripAs : Value f vars -> Value f vars
+      stripAs (VAs _ _ _ p) = stripAs p
+      stripAs x = x
+
+  evalLocal : {vars, free: _} -> {idx : _} ->
+              Env Term vars ->
+              FC -> (0 p : IsVar n idx (vars ++ free)) ->
+              LocalEnv free vars ->
+              Core (Glued vars)
+  evalLocal env fc p [<]
+      = let loc = VLocal fc _ p [<] in
+        if keepBinder eflags
+           then pure loc
+           else case getLet p env of
+                     Nothing => pure loc
+                     Just val => eval [<] env val
+    where
+      keepBinder : EvalFlags -> Bool
+      keepBinder KeepAs = True
+      keepBinder (Holes _) = True
+      keepBinder _ = False
+  evalLocal env fc First (locs :< x) = x
+  evalLocal env fc (Later p) (locs :< x) = evalLocal env fc p locs
+
+  evalPiInfo : {vars, free: _} -> LocalEnv free vars ->
+               Env Term vars ->
+               PiInfo (Term (vars ++ free)) ->
+               Core (PiInfo (Glued vars))
+  evalPiInfo locs env Implicit = pure Implicit
+  evalPiInfo locs env Explicit = pure Explicit
+  evalPiInfo locs env AutoImplicit = pure AutoImplicit
+  evalPiInfo locs env (DefImplicit x)
+      = do x' <- eval locs env x
+           pure (DefImplicit x')
+
+  evalBinder : {vars, free: _} -> LocalEnv free vars ->
+               Env Term vars ->
+               Binder (Term (vars ++ free)) ->
+               Core (Binder (Glued vars))
+  evalBinder locs env (Lam fc c p ty)
+     = pure $ Lam fc c !(evalPiInfo locs env p) !(eval locs env ty)
+  evalBinder locs env (Let fc c val ty)
+     = pure $ Let fc c !(eval locs env val) !(eval locs env ty)
+  evalBinder locs env (Pi fc c p ty)
+     = pure $ Pi fc c !(evalPiInfo locs env p) !(eval locs env ty)
+  evalBinder locs env (PVar fc c p ty)
+     = pure $ PVar fc c !(evalPiInfo locs env p) !(eval locs env ty)
+  evalBinder locs env (PLet fc c val ty)
+     = pure $ PLet fc c !(eval locs env val) !(eval locs env ty)
+  evalBinder locs env (PVTy fc c ty)
+     = pure $ PVTy fc c !(eval locs env ty)
+
+  evalMeta : {vars, free: _} -> LocalEnv free vars ->
+             Env Term vars ->
+             FC -> Name -> Int -> List (RigCount, Term (vars ++ free)) ->
+             Core (Glued vars)
+  evalMeta locs env fc n i scope
+       = do scope' <- traverse (\ (q, val) =>
+                                     do let val' = eval locs env val
+                                        pure (q, val')) scope
+            defs <- get Ctxt
+            Just def <- lookupCtxtExact n (gamma defs)
+                 | Nothing => pure (VMeta fc n i scope' [<] (pure Nothing))
+            let Function fi fn _ _ = definition def
+                 | _ => pure (VMeta fc n i scope' [<] (pure Nothing))
+            log "eval.def.stuck" 40 ("evalMeta n: \{show n}, alwaysReduce: \{show $ alwaysReduce fi}, multiplicity: \{show $ multiplicity def}, eflags: \{show eflags}, dflags: \{show $ flags def}")
+            logTerm "eval.def.stuck" 50 "evalMeta fn" fn
+            if alwaysReduce fi || (reduceForTC eflags (multiplicity def))
+               then do evalfn <- logDepth $ eval locs env (embed fn)
+                       logC "eval.def.stuck" 50 $ pure "Reduce Meta: evalfn \{show !(toFullNames evalfn)}"
+                       res <- logDepth $ applyAll fc evalfn scope'
+                       logC "eval.ref" 50 $ do n' <- toFullNames n
+                                               res <- toFullNames res
+                                               pure "Reduced \{show n'} to \{show res}"
+                       pure res
+               else do logC "eval.def.stuck" 50 $ do
+                         def <- toFullNames def
+                         pure "Refusing to reduce Meta: n: \{show !(toFullNames n)}, def: \{show $ definition def}"
+                       pure $ VMeta fc n i scope' [<] $
+                         do logC "eval.def.stuck" 50 $ pure "Attempt to reduce refused previously Meta: n: \{show !(toFullNames n)}, tree: \{show !(toFullNames fn)}"
+                            evalfn <- eval locs env (embed fn)
+                            logC "eval.def.stuck" 50 $ pure "Attempt to reduce refused previously Meta: evalfn \{show !(toFullNames evalfn)}"
+                            res <- applyAll fc evalfn scope'
+                            logC "eval.def.stuck" 50 $ pure "Attempt to reduce refused previously Meta: res \{show !(toFullNames res)}"
+                            pure (Just res)
+    where
+      reduceForTC : EvalFlags -> RigCount -> Bool
+      reduceForTC Totality c = not (isErased c)
+      reduceForTC (Holes HolesArgs) c = not (isErased c)
+      reduceForTC (Holes HolesAll) _ = True
+      reduceForTC _ _ = False
+
+  evalRef : {vars, free: _} -> LocalEnv free vars ->
+            Env Term vars ->
+            FC -> NameType -> Name ->
+            Core (Glued vars)
+  evalRef locs env fc (DataCon t a) n
+      = pure $ VDCon fc n t a [<]
+  evalRef locs env fc (TyCon a) n
+      = pure $ vtCon fc n a [<]
+  evalRef locs env fc nt n
+      = do defs <- get Ctxt
+           Just def <- lookupCtxtExact n (gamma defs)
+                | Nothing => do logC "eval.stuck.outofscope" 5 $ do
+                                  n' <- toFullNames n
+                                  pure $ "Stuck function: " ++ show n'
+                                pure (vRef fc nt n)
+           let Function fi fn _ _ = definition def
+                | res => do logC "eval.def.stuck" 50 $ do
+                              n <- toFullNames n
+                              pure "Cannot reduce def \{show n}: it is a \{show res}"
+                            pure (vRef fc nt n)
+           log "eval.def.stuck" 40 ("evalRef n: \{show $ !(toFullNames n)}, alwaysReduce: \{show $ alwaysReduce fi}, multiplicity: \{show $ multiplicity def}, eflags: \{show eflags}, dflags: \{show $ flags def}")
+           logTerm "eval.def.stuck" 50 "evalRef fn" !(toFullNames fn)
+           if alwaysReduce fi || (reduceForTC eflags (flags def))
+              then do res <- logDepth $ eval locs env (embed fn)
+                      logC "eval.ref" 50 $ do n' <- toFullNames n
+                                              res <- toFullNames res
+                                              pure "Reduced \{show n'} to \{show res}"
+                      pure res
+              else do logC "eval.def.stuck" 50 $ do
+                        def <- toFullNames def
+                        pure "Refusing to reduce Ref: n: \{show !(toFullNames n)}, def: \{show $ definition def}"
+                      pure $ VApp fc nt n [<] $
+                          do logC "eval.def.stuck" 50 $ pure "Attempt to reduce refused previously Ref: n: \{show !(toFullNames n)}, tree: \{show !(toFullNames fn)}"
+                             res <- eval locs env (embed fn)
+                             logC "eval.def.stuck" 50 $ pure "Attempt to reduce refused previously Ref: res \{show !(toFullNames res)}"
+                             pure (Just res)
+    where
+      reduceForTC : EvalFlags -> List DefFlag -> Bool
+      reduceForTC Totality f = elem TCInline f
+      reduceForTC _ _ = False
+
+  evalBind : {vars, free: _} -> LocalEnv free vars ->
+         Env Term vars ->
+         FC -> (x : Name) -> (b : Binder (Term (vars ++ free))) ->
+         (scope : (Term ((vars ++ free) :< x))) ->
+         Core (Glued vars)
+  evalBind locs env fc x (Lam bfc r p ty) sc
+      = pure $ VBind fc x (Lam bfc r !(evalPiInfo locs env p) !(eval locs env ty))
+                        (\arg => eval (locs :< arg) env sc)
+  evalBind locs env fc x b@(Let bfc c val ty) sc
+      = case eflags of
+             Holes _ =>
+                  pure $ VBind fc x !(evalBinder locs env b)
+                               (\arg => eval (locs :< arg) env sc)
+             _ => do val' <- eval locs env val
+                     eval (locs :< pure val') env sc
+  evalBind locs env fc x b sc
+      = pure $ VBind fc x !(evalBinder locs env b)
+                     (\arg => eval (locs :< arg) env sc)
+
+  evalForce : {vars, free: _} -> LocalEnv free vars ->
+              Env Term vars ->
+              FC -> LazyReason -> Term (vars ++ free) ->
+              Core (Glued vars)
+  evalForce locs env fc r tm =
+      do val <- eval locs env tm
+         VDelay _ _ _ arg <- expandApps val
+             | tm' => pure $ VForce fc r val [<]
+         pure arg
+
+  evalPrimOp : {vars, free: _} -> {arity : _} ->
+               LocalEnv free vars ->
+               Env Term vars ->
+               FC -> PrimFn arity -> Vect arity (Term (vars ++ free)) ->
+               Core (Glued vars)
+  evalPrimOp {free} {vars} locs env fc op args
+      = do nf <- runOp fc op !(evalArgs args)
+           pure (believe_me nf) -- switch back to Glued
+    where
+      -- No traverse for Vect in Core...
+      evalArgs : Vect n (Term (vars ++ free)) -> Core (Vect n (Glued vars))
+      evalArgs [] = pure []
+      evalArgs (a :: as) = pure $ !(eval locs env a) :: !(evalArgs as)
+
+--   Declared above with this type:
+--   eval : LocalEnv free vars ->
+--          Env Term vars ->
+--          Term (vars ++ free) -> Core (Glued vars)
+  eval locs env (Local fc _ idx p) = logDepth $ evalLocal env fc p locs
+  eval locs env (Ref fc nt n) =
+    do logC "eval.ref" 50 $ do fn' <- toFullNames n
+                               pure "Ref \{show nt} \{show fn'}"
+       evalRef locs env fc nt n
+  eval locs env (Meta fc n i scope)
+       = evalMeta locs env fc n i scope
+  eval locs env (Bind fc x b sc) = evalBind locs env fc x b sc
+  eval locs env tm@(App fc fn q arg)
+      = apply fc !(eval locs env fn) q (eval locs env arg)
+  eval locs env (As fc use as pat)
+      = case eflags of
+             KeepAs => pure $ VAs fc use !(eval locs env as)
+                                         !(eval locs env pat)
+             Holes _ => pure $ VAs fc use !(eval locs env as)
+                                            !(eval locs env pat)
+             _ => eval locs env pat
+  eval locs env (Case fc t r sc ty alts)
+      = evalCase locs env fc t r sc ty alts
+  eval locs env (TDelayed fc r tm)
+      = pure $ VDelayed fc r !(eval locs env tm)
+  eval locs env (TDelay fc r ty arg)
+      = pure $ VDelay fc r !(eval locs env ty) !(eval locs env arg)
+  eval locs env (TForce fc r tm)
+      = evalForce locs env fc r tm
+  eval locs env (PrimVal fc c) = pure $ VPrimVal fc c
+  eval {free} {vars} locs env (PrimOp fc op args)
+      = evalPrimOp locs env fc op args
+  eval locs env (Erased fc why) = VErased fc <$> traverse @{%search} @{CORE} (eval locs env) why
+  eval locs env (Unmatched fc str) = pure $ VUnmatched fc str
+  eval locs env (TType fc n) = pure $ VType fc n
+
+parameters {auto c : Ref Ctxt Defs}
+
+  export
+  nf : {vars: _} -> Env Term vars -> Term vars -> Core (Glued vars)
+  nf env tm = logDepth $ eval Full [<] env tm
+
+  export
+  nfLHS : {vars: _} -> Env Term vars -> Term vars -> Core (Glued vars)
+  nfLHS env tm = logDepth $ eval KeepAs [<] env tm
+
+  export
+  nfHoles : {vars: _} -> Env Term vars -> Term vars -> Core (Glued vars)
+  nfHoles env tm = logDepth $ eval (Holes HolesAll) [<] env tm
+
+  export
+  nfHolesArgs : {vars: _} -> Env Term vars -> Term vars -> Core (Glued vars)
+  nfHolesArgs env tm = logDepth $ eval (Holes HolesArgs) [<] env tm
+
+  export
+  nfTotality : {vars: _} -> Env Term vars -> Term vars -> Core (Glued vars)
+  nfTotality env tm = logDepth $ eval Totality [<] env tm
diff --git a/src/Core/Evaluate/Quote.idr b/src/Core/Evaluate/Quote.idr
new file mode 100644
index 00000000000..d6f50fbfe66
--- /dev/null
+++ b/src/Core/Evaluate/Quote.idr
@@ -0,0 +1,374 @@
+module Core.Evaluate.Quote
+
+-- Quoting evaluated values back to Terms
+
+import Core.Context
+import Core.Context.Log
+import Core.Env
+import Core.TT
+import Core.Evaluate.Value
+
+import Data.Vect
+import Libraries.Data.WithDefault
+
+data QVar : Type where
+
+genName : Ref QVar Int => String -> Core Name
+genName n
+    = do i <- get QVar
+         put QVar (i + 1)
+         pure (MN n i)
+
+data Strategy
+  = NF (Maybe (List Namespace)) -- full normal form. If a namespace list is
+                                -- given, these are the ones where we can
+                                -- reduce 'export' names
+  | HNF (Maybe (List Namespace)) -- head normal form (block under constructors)
+  | Binders -- block after going under all the binders
+  | OnePi (List Namespace) -- block after getting the top level Pi binder
+  | BlockApp -- block all applications
+  | ExpandHoles -- block all applications except holes
+
+Show Strategy where
+  show (NF _) = "NF"
+  show (HNF _) = "HNF"
+  show Binders = "Binders"
+  show BlockApp = "BlockApp"
+  show (OnePi _) = "OnePi"
+  show ExpandHoles = "Holes"
+
+getNS : Strategy -> Maybe (List Namespace)
+getNS (NF ns) = ns
+getNS (HNF ns) = ns
+getNS (OnePi ns) = Just ns
+getNS _ = Nothing
+
+{-
+On Strategy: when quoting to full NF, we still want to block the body of an
+application if it turns out to be a case expression or primitive. This is
+primarily for readability of the result because we want to see the function
+that was blocked, not its complete definition.
+-}
+
+applySpine : Term vars -> SnocList (FC, RigCount, Term vars) -> Term vars
+applySpine tm [<] = tm
+applySpine tm (args :< (fc, q, arg)) = App fc (applySpine tm args) q arg
+
+export
+blockedApp : forall f . Value f vars -> Core Bool
+blockedApp (VBind fc _ (Lam {}) sc)
+  = blockedApp !(sc $ pure $ VErased fc Placeholder)
+blockedApp (VCase _ PatMatch _ _ _ _) = pure True
+blockedApp (VPrimOp{}) = pure True
+blockedApp _ = pure False
+
+parameters {auto c : Ref Ctxt Defs} {auto q : Ref QVar Int}
+
+  quoteGen : {bound, vars : _} ->
+             Bounds bound -> Env Term vars ->
+             Value f vars -> Strategy -> Core (Term (vars ++ bound))
+
+  -- probably ought to make traverse work on SnocList/Vect too
+  quoteSpine : {bound, vars : _} ->
+               Strategy -> Bounds bound -> Env Term vars ->
+               Spine vars -> Core (SnocList (FC, RigCount, Term (vars ++ bound)))
+  quoteSpine s bounds env [<] = pure [<]
+  quoteSpine s bounds env (args :< MkSpineEntry fc q arg)
+      = pure $ !(quoteSpine s bounds env args) :<
+               (fc, q, !(quoteGen bounds env !arg s))
+
+  mkTmp : FC -> Name -> Glued vars
+  mkTmp fc n = vRef fc Bound n
+
+  mkTmpVar : FC -> Name -> Core (Glued vars)
+  mkTmpVar fc n = pure $ mkTmp fc n
+
+  quoteAlt : {bound, vars : _} ->
+             Strategy -> Bounds bound -> Env Term vars ->
+             VCaseAlt vars -> Core (CaseAlt (vars ++ bound))
+  quoteAlt {vars} s bounds env (VConCase fc n t a sc)
+      = do sc' <- quoteScope a bounds sc
+           pure $ ConCase fc n t sc'
+    where
+      -- If forced equality is still var = tm after evaluation, then keep it,
+      -- otherwise it's been substituted so no longer useful
+      toForced : forall vars . (Term vars, Term vars) -> Maybe (Var vars, Term vars)
+      toForced (Local _ _ _ p, tm) = Just (MkVar p, tm)
+      toForced _ = Nothing
+
+      quoteScope : {bound : _} ->
+                   (args : SnocList (RigCount, Name)) ->
+                   Bounds bound ->
+                   VCaseScope args vars ->
+                   Core (CaseScope (vars ++ bound))
+      quoteScope {bound} [<] bounds rhs_in
+          = do (fs, rhs) <- rhs_in
+               rhs' <- quoteGen bounds env rhs s
+               qfs <- traverse
+                           (\ (n, v) => pure (!(quoteGen bounds env n s),
+                                              !(quoteGen bounds env v s)))
+                           fs
+               pure (RHS (mapMaybe toForced qfs) rhs')
+      quoteScope (as :< (r, a)) bounds sc
+          = do an <- genName "c"
+               let sc' = sc (mkTmpVar fc an)
+               rhs' <- quoteScope as (Add a an bounds) sc'
+               pure (Arg r a rhs')
+
+  quoteAlt s bounds env (VDelayCase fc ty arg sc)
+      = do tyn <- genName "ty"
+           argn <- genName "arg"
+           (fs, rhs) <- sc (mkTmpVar fc tyn) (mkTmpVar fc argn)
+           sc' <- quoteGen (Add arg argn (Add ty tyn bounds)) env
+                           rhs s
+           pure (DelayCase fc ty arg sc')
+  quoteAlt s bounds env (VConstCase fc c sc)
+      = do sc' <- quoteGen bounds env sc s
+           pure (ConstCase fc c sc')
+  quoteAlt s bounds env (VDefaultCase fc sc)
+      = do sc' <- quoteGen bounds env sc s
+           pure (DefaultCase fc sc')
+
+  quotePi : {bound, vars : _} ->
+            Strategy -> Bounds bound -> Env Term vars ->
+            PiInfo (Glued vars) -> Core (PiInfo (Term (vars ++ bound)))
+  quotePi s bounds env Explicit = pure Explicit
+  quotePi s bounds env Implicit = pure Implicit
+  quotePi s bounds env AutoImplicit = pure AutoImplicit
+  quotePi s bounds env (DefImplicit t)
+      = do t' <- quoteGen bounds env t s
+           pure (DefImplicit t')
+
+  quoteBinder : {bound, vars : _} ->
+                Strategy -> Bounds bound -> Env Term vars ->
+                Binder (Glued vars) -> Core (Binder (Term (vars ++ bound)))
+  quoteBinder s bounds env (Lam fc r p ty)
+      = do ty' <- quoteGen bounds env ty s
+           p' <- quotePi s bounds env p
+           pure (Lam fc r p' ty')
+  quoteBinder s bounds env (Let fc r val ty)
+      = do ty' <- quoteGen bounds env ty s
+           val' <- quoteGen bounds env val s
+           pure (Let fc r val' ty')
+  quoteBinder s bounds env (Pi fc r p ty)
+      = do ty' <- quoteGen bounds env ty s
+           p' <- quotePi s bounds env p
+           pure (Pi fc r p' ty')
+  quoteBinder s bounds env (PVar fc r p ty)
+      = do ty' <- quoteGen bounds env ty s
+           p' <- quotePi s bounds env p
+           pure (PVar fc r p' ty')
+  quoteBinder s bounds env (PLet fc r val ty)
+      = do ty' <- quoteGen bounds env ty s
+           val' <- quoteGen bounds env val s
+           pure (PLet fc r val' ty')
+  quoteBinder s bounds env (PVTy fc r ty)
+      = do ty' <- quoteGen bounds env ty s
+           pure (PVTy fc r ty')
+
+--   Declared above as:
+--   quoteGen : {bound, vars : _} ->
+--              Strategy -> Bounds bound -> Env Term vars ->
+--              Value f vars -> Core (Term (vars ++ bound))
+  quoteGen bounds env (VBind fc x b sc) s
+      = do var <- genName "qv"
+           let s' = case s of
+                         Binders => BlockApp
+                         _ => s
+           b' <- quoteBinder s' bounds env b
+           let s' = case s of
+                         OnePi _ => BlockApp
+                         _ => s
+           sc' <- quoteGen (Add x var bounds) env
+                             !(sc (mkTmpVar fc var)) s'
+           pure (Bind fc x b' sc')
+  -- These are the names we invented when quoting the scope of a binder
+  quoteGen bounds env (VApp fc Bound (MN n i) sp val) s
+      = do sp' <- quoteSpine BlockApp bounds env sp
+           case findName bounds of
+                Just (MkVar p) =>
+                    pure $ applySpine (Local fc Nothing _ (varExtend p)) sp'
+                Nothing =>
+                    pure $ applySpine (Ref fc Bound (MN n i)) sp'
+    where
+      findName : Bounds bound' -> Maybe (Var bound')
+      findName None = Nothing
+      findName (Add x (MN n' i') ns)
+          = if i == i' -- this uniquely identifies it, given how we
+                       -- generated the names, and is a faster test!
+               then Just (MkVar First)
+               else do MkVar p <-findName ns
+                       Just (MkVar (Later p))
+      findName (Add x _ ns)
+          = do MkVar p <-findName ns
+               Just (MkVar (Later p))
+  quoteGen bounds env (VApp fc nt n sp val) BlockApp
+      = do sp' <- quoteSpine BlockApp bounds env sp
+           pure $ applySpine (Ref fc nt n) sp'
+  quoteGen bounds env (VApp fc nt n sp val) ExpandHoles
+      = do sp' <- quoteSpine ExpandHoles bounds env sp
+           pure $ applySpine (Ref fc nt n) sp'
+  quoteGen bounds env v@(VApp fc nt n sp val) s
+      = do -- Reduce if it's visible in the current namespace
+           logC "eval.ref" 50 $ do pure "quoteGen VApp \{show !(toFullNames v)}"
+           True <- case getNS s of
+                        Nothing => pure True
+                        Just ns => do full_name <- toFullNames n
+                                      vis <- getVisibility fc n
+                                      -- TODO: Query context once
+                                      logC "eval.ref" 50 $ do pure "quoteGen VApp with NS: \{show n} (\{show full_name}) \{show $ collapseDefault vis} in \{show ns}"
+                                      pure $ reducibleInAny ns full_name $ collapseDefault vis
+              | False =>
+                  do sp' <- quoteSpine s bounds env sp
+                     pure $ applySpine (Ref fc nt n) sp'
+           Just v <- val
+              | Nothing =>
+                  do sp' <- quoteSpine s bounds env sp
+                     pure $ applySpine (Ref fc nt n) sp'
+           case s of
+             -- If the result is a binder, and we're in Binder mode, then
+             -- keep going, otherwise just give back the application
+                Binders =>
+                    if !(isBinder v)
+                       then quoteGen bounds env v s
+                       else do sp' <- quoteSpine s bounds env sp
+                               pure $ applySpine (Ref fc nt n) sp'
+             -- If the result is blocked by a case/lambda then just give back
+             -- the application for readability. Otherwise, keep quoting
+                _ => if !(blockedApp v)
+                        then do sp' <- quoteSpine s bounds env sp
+                                pure $ applySpine (Ref fc nt n) sp'
+                        else quoteGen bounds env v s
+    where
+      isBinder : forall f . Value f vars -> Core Bool
+      isBinder (VBind{}) = pure True
+      isBinder _ = pure False
+  quoteGen {bound} bounds env (VLocal fc idx p sp) s
+      = do sp' <- quoteSpine s bounds env sp
+           let MkVar p' = addLater bound p
+           pure $ applySpine (Local fc Nothing _ p') sp'
+    where
+      addLater : {idx : _} ->
+                 (ys : SnocList Name) -> (0 p : IsVar n idx xs) ->
+                 Var (xs ++ ys)
+      addLater [<] isv = MkVar isv
+      addLater (xs :< x) isv
+          = let MkVar isv' = addLater xs isv in
+                MkVar (Later isv')
+  quoteGen bounds env (VMeta fc n i args sp val) BlockApp
+      = do sp' <- quoteSpine BlockApp bounds env sp
+           args' <- traverse (\ (q, val) =>
+                                do val' <- quoteGen bounds env !val BlockApp
+                                   pure (q, val')) args
+           pure $ applySpine (Meta fc n i args') sp'
+  quoteGen bounds env (VMeta fc n i args sp val) s
+      = do Just v <- val
+              | Nothing =>
+                  do sp' <- quoteSpine s bounds env sp
+                     args' <- traverse (\ (q, val) =>
+                                          do val' <- quoteGen bounds env !val s
+                                             pure (q, val')) args
+                     pure $ applySpine (Meta fc n i args') sp'
+           quoteGen bounds env v s
+  quoteGen bounds env (VDCon fc n t a sp) s
+      = do let s' = case s of
+                         HNF _ => BlockApp
+                         _ => s
+           sp' <- quoteSpine s' bounds env sp
+           pure $ applySpine (Ref fc (DataCon t a) n) sp'
+  quoteGen bounds env (VTCon fc n a sp) s
+      = do let s' = case s of
+                         HNF _ => BlockApp
+                         _ => s
+           sp' <- quoteSpine s' bounds env sp
+           pure $ applySpine (Ref fc (TyCon a) n) sp'
+  quoteGen bounds env (VAs fc use as pat) s
+      = do pat' <- quoteGen bounds env pat s
+           as' <- quoteGen bounds env as s
+           pure (As fc use as' pat')
+  quoteGen bounds env (VCase fc t rig sc scTy alts) s
+      = do sc' <- quoteGen bounds env sc s
+           scTy' <- quoteGen bounds env scTy s
+           let s' = case s of
+                         NF _ => ExpandHoles
+                         ExpandHoles => ExpandHoles
+                         _ => BlockApp
+           alts' <- traverse (quoteAlt s' bounds env) alts
+           pure $ Case fc t rig sc' scTy' alts'
+  quoteGen bounds env (VDelayed fc r ty) s
+      = do ty' <- quoteGen bounds env ty s
+           pure (TDelayed fc r ty')
+  quoteGen bounds env (VDelay fc r ty arg) s
+      = do ty' <- quoteGen bounds env ty BlockApp
+           arg' <- quoteGen bounds env arg BlockApp
+           pure (TDelay fc r ty' arg')
+  quoteGen bounds env (VForce fc r val sp) s
+      = do sp' <- quoteSpine s bounds env sp
+           val' <- quoteGen bounds env val s
+           pure $ applySpine (TForce fc r val') sp'
+  quoteGen bounds env (VPrimVal fc c) s = pure $ PrimVal fc c
+  quoteGen {vars} {bound} bounds env (VPrimOp fc fn args) s
+      = do args' <- quoteArgs args
+           pure $ PrimOp fc fn args'
+    where
+      -- No traverse for Vect in Core...
+      quoteArgs : forall f . Vect n (Value f vars) -> Core (Vect n (Term (vars ++ bound)))
+      quoteArgs [] = pure []
+      quoteArgs (a :: as)
+          = pure $ !(quoteGen bounds env a s) :: !(quoteArgs as)
+  quoteGen bounds env (VErased fc why) s
+     = Erased fc <$> traverse @{%search} @{CORE} (\t => quoteGen bounds env t s) why
+  quoteGen bounds env (VUnmatched fc str) s = pure $ Unmatched fc str
+  quoteGen bounds env (VType fc n) s = pure $ TType fc n
+
+parameters {auto c : Ref Ctxt Defs}
+  quoteStrategy : { vars : _ } -> Strategy -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteStrategy s env val
+      = do q <- newRef QVar 100
+           logC "eval.ref" 50 $ do
+                val <- logQuiet $ quoteGen None env val BlockApp -- same as logNF
+                val <- toFullNames val
+                pure "Begin quote \{show s} for \{show val}"
+           logDepth $ quoteGen None env val s
+
+  export
+  quoteNFall : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteNFall = quoteStrategy (NF Nothing)
+
+  export
+  quoteHNFall : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteHNFall = quoteStrategy (HNF Nothing)
+
+  export
+  quoteNF : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteNF env val
+      = do defs <- get Ctxt
+           quoteStrategy (NF (Just (currentNS defs :: nestedNS defs)))
+                         env val
+
+  export
+  quoteHNF : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteHNF env val
+      = do defs <- get Ctxt
+           quoteStrategy (HNF (Just (currentNS defs :: nestedNS defs)))
+                         env val
+
+  -- Keep quoting while we're still going under binders
+  export
+  quoteBinders : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteBinders = quoteStrategy Binders
+
+  -- Keep quoting while we're still going under binders
+  export
+  quoteOnePi : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteOnePi env val
+      = do defs <- get Ctxt
+           quoteStrategy (OnePi (currentNS defs :: nestedNS defs)) env val
+
+  export
+  quoteHoles : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quoteHoles = quoteStrategy ExpandHoles
+
+  export
+  quote : { vars : _ } -> Env Term vars -> Value f vars -> Core (Term vars)
+  quote = quoteStrategy BlockApp
diff --git a/src/Core/Evaluate/Value.idr b/src/Core/Evaluate/Value.idr
new file mode 100644
index 00000000000..ed9d26b9ffa
--- /dev/null
+++ b/src/Core/Evaluate/Value.idr
@@ -0,0 +1,248 @@
+module Core.Evaluate.Value
+
+import Core.Context
+import Core.Core
+import Core.TT
+import Core.Options
+
+import Data.SnocList
+import Data.Vect
+import Data.List1
+import Data.String
+
+import Libraries.Data.WithDefault
+
+public export
+data Form = Glue | Normal
+
+public export
+data Value : Form -> SnocList Name -> Type
+
+public export
+Glued : SnocList Name -> Type
+Glued = Value Glue
+
+public export
+NF : SnocList Name -> Type
+NF = Value Normal
+
+public export
+ClosedNF : Type
+ClosedNF = NF [<]
+
+public export
+data VCaseAlt : SnocList Name -> Type
+
+public export
+record SpineEntry vars where
+  constructor MkSpineEntry
+  loc : FC
+  multiplicity : RigCount
+  value : Core (Glued vars)
+
+public export
+0 Spine : SnocList Name -> Type
+Spine vars = SnocList (SpineEntry vars)
+
+-- The 'Form' is a phantom type index that says whether we know the value is
+-- in normal form, or whether it might be 'Glued'
+-- In theory, we know that everything except 'VApp' and "VMeta' are Normal,
+-- but in practice this is annoying because evaluating doesn't know whether
+-- it's going to produce a 'Glued' or a 'Normal'.
+-- The phantom index gives us enough help, specifically in that it means we
+-- are sure that we've expanded to head normal Normal form before processing
+-- a Value
+public export
+data Value : Form -> SnocList Name -> Type where
+     VBind : FC -> (x : Name) -> Binder (Glued vars) ->
+             (sc : Core (Glued vars) -> Core (Glued vars)) ->
+             Value f vars
+     -- A 'glued' application. This includes the original application
+     -- (for quoting back HNFs) and what it reduces to (if the name is
+     -- defined).
+     VApp : FC ->
+            NameType -> Name -> Spine vars -> -- original form
+            Core (Maybe (Glued vars)) -> -- the normal form
+            Value f vars
+     VLocal   : FC -> (idx : Nat) -> (0 p : IsVar n idx vars) ->
+                Spine vars ->
+                Value f vars
+     VMeta  : FC -> Name -> Int -> -- Name and resolved name of metavar
+              List (RigCount, Core (Glued vars)) -> -- Scope of metavar
+              Spine vars ->
+              Core (Maybe (Glued vars)) -> -- the normal form, if solved
+              Value f vars
+     VDCon    : FC -> Name -> (tag : Tag) -> (arity : Nat) ->
+                Spine vars -> Value f vars
+     VTCon    : FC -> Name -> (arity : Nat) ->
+                Spine vars -> Value f vars
+     VAs      : FC -> UseSide -> Value f vars -> Value f vars -> Value f vars
+     VCase    : FC -> CaseType ->
+                RigCount -> (sc : NF vars) -> (scTy : Glued vars) ->
+                List (VCaseAlt vars) ->
+                Value f vars
+     VDelayed : FC -> LazyReason -> Glued vars -> Value f vars
+     VDelay   : FC -> LazyReason -> Glued vars -> Glued vars -> Value f vars
+     VForce   : FC -> LazyReason -> Glued vars -> Spine vars -> Value f vars
+     VPrimVal : FC -> Constant -> Value f vars
+     VPrimOp  : {ar : _} ->
+                FC -> PrimFn ar -> Vect ar (Glued vars) -> Value f vars
+     VErased  : FC -> WhyErased (Value f vars) -> Value f vars
+     VUnmatched : FC -> String -> Value f vars
+     VType    : FC -> Name -> Value f vars
+
+export
+vRef : FC -> NameType -> Name -> Value f vars
+vRef fc nt n = VApp fc nt n [<] (pure Nothing)
+
+export
+vtCon : FC -> Name -> Nat -> Spine vars -> Value f vars
+vtCon fc (UN (Basic "Type")) Z [<] = VType fc (MN "top" 0)
+vtCon fc n Z [<] = case isConstantType n of
+  Just c => VPrimVal fc $ PrT c
+  Nothing => VTCon fc n Z [<]
+vtCon fc n arity args = VTCon fc n arity args
+
+-- It's safe to pretend an NF is Glued, if we need it
+export
+asGlued : Value f vars -> Glued vars
+asGlued = believe_me -- justification as above
+
+export
+getLoc : Value f vars -> FC
+getLoc (VBind fc x y sc) = fc
+getLoc (VApp fc x y sx z) = fc
+getLoc (VLocal fc idx p sx) = fc
+getLoc (VMeta fc x y xs sx z) = fc
+getLoc (VDCon fc x tag arity sx) = fc
+getLoc (VTCon fc x arity sx) = fc
+getLoc (VAs fc x y z) = fc
+getLoc (VCase fc t x sc scTy xs) = fc
+getLoc (VDelayed fc x y) = fc
+getLoc (VDelay fc x y z) = fc
+getLoc (VForce fc x y sx) = fc
+getLoc (VPrimVal fc x) = fc
+getLoc (VPrimOp fc x xs) = fc
+getLoc (VErased fc imp) = fc
+getLoc (VUnmatched fc x) = fc
+getLoc (VType fc x) = fc
+
+export
+HasNames (Value f vars)
+
+export
+covering
+{free : _} -> Show (Value f free)
+
+public export
+0 VCaseScope : SnocList (RigCount, Name) -> SnocList Name -> Type
+VCaseScope [<] vars = Core (List (Glued vars, Glued vars), Glued vars)
+VCaseScope (xs :< x) vars = Core (Glued vars) -> VCaseScope xs vars
+
+public export
+data VCaseAlt : SnocList Name -> Type where
+     ||| Constructor for a data type; bind the arguments and subterms.
+     VConCase : FC -> Name -> (tag : Int) ->
+                (args : SnocList (RigCount, Name)) ->
+                VCaseScope args vars -> VCaseAlt vars
+     ||| Lazy match for the Delay type use for codata types
+     VDelayCase : FC -> (ty : Name) -> (arg : Name) ->
+                  VCaseScope [<(Algebra.Preorder.top, arg), (Algebra.Semiring.erased, ty)] vars ->
+                  VCaseAlt vars
+     ||| Match against a literal
+     VConstCase : FC -> Constant -> Glued vars -> VCaseAlt vars
+     ||| Catch-all case
+     VDefaultCase : FC -> Glued vars -> VCaseAlt vars
+
+export
+covering
+{vars : _} -> Show (VCaseAlt vars) where
+  show (VConCase _ ty _ args scoped) = "VConCase \{show ty} \{show args}"
+  show (VDelayCase _ ty arg scoped) = "VDelayCase \{show ty} \{show arg}"
+  show (VConstCase _ c vars_glued) = "VConstCase \{show c} \{show vars_glued}"
+  show (VDefaultCase _ vars_glued) = "VDefaultCase \{show vars_glued}"
+
+export
+HasNames (VCaseAlt free) where
+  full defs (VConCase fc n tag args cl) = pure $ VConCase fc !(full defs n) tag args cl
+  full defs (VDelayCase fc n arg cl) = pure $ VDelayCase fc !(full defs n) arg cl
+  full defs (VConstCase fc c cl) = pure $ VConstCase fc c cl
+  full defs (VDefaultCase fc cl) = pure $ VDefaultCase fc cl
+
+  resolved defs (VConCase fc n tag args cl) = pure $ VConCase fc !(resolved defs n) tag args cl
+  resolved defs (VDelayCase fc n arg cl) = pure $ VDelayCase fc !(resolved defs n) arg cl
+  resolved defs (VConstCase fc c cl) = pure $ VConstCase fc c cl
+  resolved defs (VDefaultCase fc cl) = pure $ VDefaultCase fc cl
+
+export
+HasNames (Value f vars) where
+  full defs (VBind fc x bd f) = pure $ VBind fc x bd f
+  full defs (VApp fc x y xs z) = pure $ VApp fc x !(full defs y) xs z
+  full defs (VDCon fc n tag arity xs) = pure $ VDCon fc !(full defs n) tag arity xs
+  full defs (VTCon fc n arity xs) = pure $ VTCon fc !(full defs n) arity xs
+  full defs (VAs fc side nf nf1) = pure $ VAs fc side !(full defs nf) !(full defs nf1)
+  full defs (VCase fc ct rc sc scTy alts) = pure $ VCase fc ct rc !(full defs sc) scTy !(traverse (full defs) alts)
+  full defs (VDelayed fc lz nf) = pure $ VDelayed fc lz !(full defs nf)
+  full defs (VDelay fc lz cl cl1) = pure $ VDelay fc lz cl cl1
+  full defs (VForce fc lz nf xs) = pure $ VForce fc lz !(full defs nf) xs
+  full defs (VPrimVal fc cst) = pure $ VPrimVal fc cst
+  full defs (VPrimOp fc op args) = pure $ VPrimOp fc op !(traverseVect (full defs) args)
+  full defs (VErased fc imp) = pure $ VErased fc imp
+  full defs (VUnmatched fc n) = pure $ VUnmatched fc n
+  full defs (VType fc n) = pure $ VType fc !(full defs n)
+  full defs (VLocal fc n v sp) = pure $ VLocal fc n v sp
+  full defs (VMeta fc n i vs sp f) = pure $ VMeta fc !(full defs n) i vs sp f
+
+  resolved defs (VBind fc x bd f) = pure $ VBind fc x bd f
+  resolved defs (VApp fc x y xs z) = pure $ VApp fc x !(resolved defs y) xs z
+  resolved defs (VDCon fc n tag arity xs) = pure $ VDCon fc !(resolved defs n) tag arity xs
+  resolved defs (VTCon fc n arity xs) = pure $ VTCon fc !(resolved defs n) arity xs
+  resolved defs (VAs fc side nf nf1) = pure $ VAs fc side !(resolved defs nf) !(resolved defs nf1)
+  resolved defs (VCase fc ct rc sc scTy alts) = pure $ VCase fc ct rc !(resolved defs sc) scTy !(resolved defs alts)
+  resolved defs (VDelayed fc lz nf) = pure $ VDelayed fc lz !(resolved defs nf)
+  resolved defs (VDelay fc lz cl cl1) = pure $ VDelay fc lz cl cl1
+  resolved defs (VForce fc lz nf xs) = pure $ VForce fc lz !(resolved defs nf) xs
+  resolved defs (VPrimVal fc cst) = pure $ VPrimVal fc cst
+  resolved defs (VPrimOp fc op args) = pure $ VPrimOp fc op !(traverseVect (resolved defs) args)
+  resolved defs (VErased fc imp) = pure $ VErased fc imp
+  resolved defs (VUnmatched fc n) = pure $ VUnmatched fc n
+  resolved defs (VType fc n) = pure $ VType fc !(resolved defs n)
+  resolved defs (VLocal fc n v sp) = pure $ VLocal fc n v sp
+  resolved defs (VMeta fc n i vs sp f) = pure $ VMeta fc !(resolved defs n) i vs sp f
+
+export
+covering
+{free : _} -> Show (Value f free) where
+  show (VBind _ x (Lam _ c info ty) _)
+    = "\\" ++ withPiInfo info (showCount c ++ show x ++ " : " ++ show ty) ++
+      " => [closure]"
+  show (VBind _ x (Let _ c val ty) _)
+    = "let " ++ showCount c ++ show x ++ " : " ++ show ty ++
+      " = " ++ show val ++ " in [closure]"
+  show (VBind _ x (Pi _ c info ty) _)
+    = withPiInfo info (showCount c ++ show x ++ " : " ++ show ty) ++
+      " -> [closure]"
+  show (VBind _ x (PVar _ c info ty) _)
+    = withPiInfo info ("pat " ++ showCount c ++ show x ++ " : " ++ show ty) ++
+      " => [closure]"
+  show (VBind _ x (PLet _ c val ty) _)
+    = "plet " ++ showCount c ++ show x ++ " : " ++ show ty ++
+      " = " ++ show val ++ " in [closure]"
+  show (VBind _ x (PVTy _ c ty) _)
+    = "pty " ++ showCount c ++ show x ++ " : " ++ show ty ++
+      " => [closure]"
+  show (VApp _ _ n sp _) = show n ++ " [" ++ show (length sp) ++ " closures]"
+  show (VLocal{}) = "Local"
+  show (VMeta _ n _ _ _ _) = "Meta " ++ show n
+  show (VDCon _ n _ _ sp) = show n ++ " %DCon [" ++ show (length sp) ++ " closures]"
+  show (VTCon _ n _ sp) = show n ++ " %TCon [" ++ show (length sp) ++ " closures]"
+  show (VCase _ ct rc vars_nf vars_glued alts) = "Case { \{show ct} \{show vars_nf} \{show vars_glued} \{show alts} }"
+  show (VPrimVal _ c) = "Constant " ++ show c
+  show (VPrimOp _ f args) = "PrimOp " ++ show f ++ " " ++ show (length args)
+  show (VAs _ _ n tm) = show n ++ "@" ++ show tm
+  show (VDelayed _ _ tm) = "%Delayed " ++ show tm
+  show (VDelay _ _ _ _) = "%Delay [closure]"
+  show (VForce _ _ tm args) = "%Force " ++ show tm ++ " [" ++ show (length args) ++ " closures]"
+  show (VErased _ w) = "[_\{show w}_]"
+  show (VUnmatched _ str) = "Unmatched: " ++ show str
+  show (VType _ n) = "Type \{show n}"
diff --git a/src/Core/GetType.idr b/src/Core/GetType.idr
deleted file mode 100644
index eb27c627891..00000000000
--- a/src/Core/GetType.idr
+++ /dev/null
@@ -1,122 +0,0 @@
-module Core.GetType
-
-import Core.Context
-import Core.Env
-import Core.Normalise
-import Core.Value
-
-%default covering
-
--- Get the type of an already typechecked thing.
--- We need this (occasionally) because we don't store types in subterms (e.g. on
--- applications) and we don't keep the type of suterms up to date throughout
--- unification. Perhaps we should? There's a trade off here, and recalculating on
--- the rare occasions it's necessary doesn't seem to cost too much, but keep an
--- eye on it...
-
-mutual
-  chk : {vars : _} ->
-        {auto c : Ref Ctxt Defs} ->
-        Env Term vars -> Term vars -> Core (Glued vars)
-  chk env (Local fc r idx p)
-      = pure $ gnf env (binderType (getBinder p env))
-  chk env (Ref fc nt n)
-      = do defs <- get Ctxt
-           Just ty <- lookupTyExact n (gamma defs)
-               | Nothing => undefinedName fc n
-           pure $ gnf env (embed ty)
-  chk env (Meta fc n i args)
-      = do defs <- get Ctxt
-           Just mty <- lookupTyExact (Resolved i) (gamma defs)
-               | Nothing => undefinedName fc n
-           chkMeta fc env !(nf defs env (embed mty)) args
-  chk env (Bind fc nm b sc)
-      = do bt <- chkBinder env b
-           sct <- chk {vars = nm :: _} (b :: env) sc
-           pure $ gnf env (discharge fc nm b !(getTerm bt) !(getTerm sct))
-  chk env (App fc f a)
-      = do fty <- chk env f
-           case !(getNF fty) of
-                NBind _ _ (Pi _ _ _ ty) scdone =>
-                      do defs <- get Ctxt
-                         aty <- chk env a
-                         sc' <- scdone defs (toClosure defaultOpts env a)
-                         pure $ glueBack defs env sc'
-                _ => do fty' <- getTerm fty
-                        throw (NotFunctionType fc env fty')
-  chk env (As fc s n p) = chk env p
-  chk env (TDelayed fc r tm) = pure (gType fc (MN "top" 0))
-  chk env (TDelay fc r dty tm)
-      = do gtm <- chk env tm
-           tm' <- getNF gtm
-           defs <- get Ctxt
-           pure $ glueBack defs env (NDelayed fc r tm')
-  chk env (TForce fc r tm)
-      = do tm' <- chk env tm
-           case !(getNF tm') of
-                NDelayed fc _ fty =>
-                    do defs <- get Ctxt
-                       pure $ glueBack defs env fty
-                _ => throw (GenericMsg fc "Not a delayed type")
-  chk env (PrimVal fc x) = pure $ gnf env (chkConstant fc x)
-  chk env (TType fc u) = pure (gType fc (MN "top" 0))
-  chk env (Erased fc _) = pure (gErased fc)
-
-  chkMeta : {vars : _} ->
-            {auto c : Ref Ctxt Defs} ->
-            FC -> Env Term vars -> NF vars -> List (Term vars) ->
-            Core (Glued vars)
-  chkMeta fc env ty []
-      = do defs <- get Ctxt
-           pure $ glueBack defs env ty
-  chkMeta fc env (NBind _ _ (Pi _ _ _ ty) scdone) (a :: args)
-      = do defs <- get Ctxt
-           aty <- chk env a
-           sc' <- scdone defs (toClosure defaultOpts env a)
-           chkMeta fc env sc' args
-  chkMeta fc env ty args
-      = do defs <- get Ctxt
-           throw (NotFunctionType fc env !(quote defs env ty))
-
-  chkBinder : {vars : _} ->
-              {auto c : Ref Ctxt Defs} ->
-              Env Term vars -> Binder (Term vars) -> Core (Glued vars)
-  chkBinder env b = chk env (binderType b)
-
-  discharge : FC -> (nm : Name) -> Binder (Term vars) ->
-              Term vars -> Term (nm :: vars) -> (Term vars)
-  discharge fc n (Lam fc' c x ty) bindty scopety
-      = Bind fc n (Pi fc' c x ty) scopety
-  discharge fc n (Let fc' c val ty) bindty scopety
-      = Bind fc n (Let fc' c val ty) scopety
-  discharge fc n (Pi {}) bindty scopety
-      = bindty
-  discharge fc n (PVar fc' c p ty) bindty scopety
-      = Bind fc n (PVTy fc' c ty) scopety
-  discharge fc n (PLet fc' c val ty) bindty scopety
-      = Bind fc n (PLet fc' c val ty) scopety
-  discharge fc n (PVTy {}) bindty scopety
-      = bindty
-
-  chkConstant : FC -> Constant -> Term vars
-  chkConstant fc (I x)    = PrimVal fc $ PrT IntType
-  chkConstant fc (I8 x)   = PrimVal fc $ PrT Int8Type
-  chkConstant fc (I16 x)  = PrimVal fc $ PrT Int16Type
-  chkConstant fc (I32 x)  = PrimVal fc $ PrT Int32Type
-  chkConstant fc (I64 x)  = PrimVal fc $ PrT Int64Type
-  chkConstant fc (BI x)   = PrimVal fc $ PrT IntegerType
-  chkConstant fc (B8 x)   = PrimVal fc $ PrT Bits8Type
-  chkConstant fc (B16 x)  = PrimVal fc $ PrT Bits16Type
-  chkConstant fc (B32 x)  = PrimVal fc $ PrT Bits32Type
-  chkConstant fc (B64 x)  = PrimVal fc $ PrT Bits64Type
-  chkConstant fc (Str x)  = PrimVal fc $ PrT StringType
-  chkConstant fc (Ch x)   = PrimVal fc $ PrT CharType
-  chkConstant fc (Db x)   = PrimVal fc $ PrT DoubleType
-  chkConstant fc WorldVal = PrimVal fc $ PrT WorldType
-  chkConstant fc _        = TType fc (MN "top" 0)
-
-export
-getType : {vars : _} ->
-          {auto c : Ref Ctxt Defs} ->
-          Env Term vars -> (term : Term vars) -> Core (Glued vars)
-getType env term = chk env term
diff --git a/src/Core/Hash.idr b/src/Core/Hash.idr
index 197cb12f851..a5246d69223 100644
--- a/src/Core/Hash.idr
+++ b/src/Core/Hash.idr
@@ -1,6 +1,5 @@
 module Core.Hash
 
-import Core.Case.CaseTree
 import Core.CompileExpr
 import Core.TT
 
@@ -153,127 +152,6 @@ Hashable ty => Hashable (Binder ty) where
 Hashable (Var vars) where
   hashWithSalt h (MkVar {varIdx = i} _) = hashWithSalt h i
 
-mutual
-  export
-  Hashable (Term vars) where
-    hashWithSalt h (Local fc x idx y)
-        = h `hashWithSalt` 0 `hashWithSalt` idx
-    hashWithSalt h (Ref fc x name)
-        = h `hashWithSalt` 1 `hashWithSalt` name
-    hashWithSalt h (Meta fc x y xs)
-        = h `hashWithSalt` 2 `hashWithSalt` y `hashWithSalt` xs
-    hashWithSalt h (Bind fc x b scope)
-        = h `hashWithSalt` 3 `hashWithSalt` b `hashWithSalt` scope
-    hashWithSalt h (App fc fn arg)
-        = h `hashWithSalt` 4 `hashWithSalt` fn `hashWithSalt` arg
-    hashWithSalt h (As fc _ nm pat)
-        = h `hashWithSalt` 5 `hashWithSalt` nm `hashWithSalt` pat
-    hashWithSalt h (TDelayed fc x y)
-        = h `hashWithSalt` 6 `hashWithSalt` y
-    hashWithSalt h (TDelay fc x t y)
-        = h `hashWithSalt` 7 `hashWithSalt` t `hashWithSalt` y
-    hashWithSalt h (TForce fc r x)
-        = h `hashWithSalt` 8 `hashWithSalt` x
-    hashWithSalt h (PrimVal fc c)
-        = h `hashWithSalt` 9 `hashWithSalt` (show c)
-    hashWithSalt h (Erased fc _)
-        = hashWithSalt h 10
-    hashWithSalt h (TType fc u)
-        = hashWithSalt h 11 `hashWithSalt` u
-
-  export
-  Hashable Pat where
-    hashWithSalt h (PAs fc nm pat)
-        = h `hashWithSalt` 0 `hashWithSalt` nm `hashWithSalt` pat
-    hashWithSalt h (PCon fc x tag arity xs)
-        = h `hashWithSalt` 1 `hashWithSalt` x `hashWithSalt` xs
-    hashWithSalt h (PTyCon fc x arity xs)
-        = h `hashWithSalt` 2 `hashWithSalt` x `hashWithSalt` xs
-    hashWithSalt h (PConst fc c)
-        = h `hashWithSalt` 3 `hashWithSalt` (show c)
-    hashWithSalt h (PArrow fc x s t)
-        = h `hashWithSalt` 4 `hashWithSalt` s `hashWithSalt` t
-    hashWithSalt h (PDelay fc r t p)
-        = h `hashWithSalt` 5 `hashWithSalt` t `hashWithSalt` p
-    hashWithSalt h (PLoc fc x)
-        = h `hashWithSalt` 6 `hashWithSalt` x
-    hashWithSalt h (PUnmatchable fc x)
-        = h `hashWithSalt` 7 `hashWithSalt` x
-
-  export
-  Hashable (CaseTree vars) where
-    hashWithSalt h (Case idx x scTy xs)
-        = h `hashWithSalt` 0 `hashWithSalt` idx `hashWithSalt` xs
-    hashWithSalt h (STerm _ x)
-        = h `hashWithSalt` 1 `hashWithSalt` x
-    hashWithSalt h (Unmatched msg)
-        = h `hashWithSalt` 2
-    hashWithSalt h Impossible
-        = h `hashWithSalt` 3
-
-  export
-  Hashable (CaseAlt vars) where
-    hashWithSalt h (ConCase x tag args y)
-        = h `hashWithSalt` 0 `hashWithSalt` x `hashWithSalt` args
-            `hashWithSalt` y
-    hashWithSalt h (DelayCase t x y)
-        = h `hashWithSalt` 2 `hashWithSalt` (show t)
-            `hashWithSalt` (show x) `hashWithSalt` y
-    hashWithSalt h (ConstCase x y)
-        = h `hashWithSalt` 3 `hashWithSalt` (show x) `hashWithSalt` y
-    hashWithSalt h (DefaultCase x)
-        = h `hashWithSalt` 4 `hashWithSalt` x
-
-export
-Hashable CFType where
-  hashWithSalt h = \case
-    CFUnit =>
-      h `hashWithSalt` 0
-    CFInt =>
-      h `hashWithSalt` 1
-    CFUnsigned8 =>
-      h `hashWithSalt` 2
-    CFUnsigned16 =>
-      h `hashWithSalt` 3
-    CFUnsigned32 =>
-      h `hashWithSalt` 4
-    CFUnsigned64 =>
-      h `hashWithSalt` 5
-    CFString =>
-      h `hashWithSalt` 6
-    CFDouble =>
-      h `hashWithSalt` 7
-    CFChar =>
-      h `hashWithSalt` 8
-    CFPtr =>
-      h `hashWithSalt` 9
-    CFGCPtr =>
-      h `hashWithSalt` 10
-    CFBuffer =>
-      h `hashWithSalt` 11
-    CFWorld =>
-      h `hashWithSalt` 12
-    CFFun a b =>
-      h `hashWithSalt` 13 `hashWithSalt` a `hashWithSalt` b
-    CFIORes a =>
-      h `hashWithSalt` 14 `hashWithSalt` a
-    CFStruct n fs =>
-      h `hashWithSalt` 15 `hashWithSalt` n `hashWithSalt` fs
-    CFUser n xs =>
-      h `hashWithSalt` 16 `hashWithSalt` n `hashWithSalt` xs
-    CFInt8 =>
-      h `hashWithSalt` 17
-    CFInt16 =>
-      h `hashWithSalt` 18
-    CFInt32 =>
-      h `hashWithSalt` 19
-    CFInt64 =>
-      h `hashWithSalt` 20
-    CFForeignObj =>
-      h `hashWithSalt` 21
-    CFInteger =>
-      h `hashWithSalt` 22
-
 export
 Hashable PrimType where
   hashWithSalt h = \case
@@ -312,13 +190,6 @@ Hashable Constant where
 
     WorldVal => h `hashWithSalt` 14
 
-export
-Hashable LazyReason where
-  hashWithSalt h = \case
-    LInf => h `hashWithSalt` 0
-    LLazy => h `hashWithSalt` 1
-    LUnknown => h `hashWithSalt` 2
-
 export
 Hashable (PrimFn arity) where
   hashWithSalt h = \case
@@ -407,6 +278,117 @@ Hashable (PrimFn arity) where
     DoublePow =>
       h `hashWithSalt` 38
 
+mutual
+  export
+  Hashable (Term vars) where
+    hashWithSalt h (Local fc x idx y)
+        = h `hashWithSalt` 0 `hashWithSalt` idx
+    hashWithSalt h (Ref fc x name)
+        = h `hashWithSalt` 1 `hashWithSalt` name
+    hashWithSalt h (Meta fc x y xs)
+        = h `hashWithSalt` 2 `hashWithSalt` y `hashWithSalt` xs
+    hashWithSalt h (Bind fc x b scope)
+        = h `hashWithSalt` 3 `hashWithSalt` b `hashWithSalt` scope
+    hashWithSalt h (App fc fn _ arg)
+        = h `hashWithSalt` 4 `hashWithSalt` fn `hashWithSalt` arg
+    hashWithSalt h (As fc _ nm pat)
+        = h `hashWithSalt` 5 `hashWithSalt` nm `hashWithSalt` pat
+    hashWithSalt h (Case fc _ _ sc ty alts)
+        = h `hashWithSalt` 6 `hashWithSalt` sc `hashWithSalt` ty
+            `hashWithSalt` alts
+    hashWithSalt h (TDelayed fc x y)
+        = h `hashWithSalt` 7 `hashWithSalt` y
+    hashWithSalt h (TDelay fc x t y)
+        = h `hashWithSalt` 8 `hashWithSalt` t `hashWithSalt` y
+    hashWithSalt h (TForce fc r x)
+        = h `hashWithSalt` 9 `hashWithSalt` x
+    hashWithSalt h (PrimVal fc c)
+        = h `hashWithSalt` 10 `hashWithSalt` (show c)
+    hashWithSalt h (PrimOp fc op t)
+        = h `hashWithSalt` 11 `hashWithSalt` op
+    hashWithSalt h (Erased fc _)
+        = hashWithSalt h 12
+    hashWithSalt h (Unmatched fc u)
+        = hashWithSalt h 13 `hashWithSalt` u
+    hashWithSalt h (TType fc u)
+        = hashWithSalt h 15 `hashWithSalt` u
+  export
+  Hashable (CaseScope vars) where
+    hashWithSalt h (RHS _ tm)
+        = hashWithSalt h 0 `hashWithSalt` tm
+    hashWithSalt h (Arg _ x sc)
+        = hashWithSalt h 1 `hashWithSalt` x `hashWithSalt` sc
+
+  export
+  Hashable (CaseAlt vars) where
+    hashWithSalt h (ConCase _ n t sc)
+        = hashWithSalt h 0 `hashWithSalt` n `hashWithSalt` t
+                           `hashWithSalt` sc
+    hashWithSalt h (DelayCase _ ty arg tm)
+        = hashWithSalt h 1 `hashWithSalt` ty `hashWithSalt` arg
+                           `hashWithSalt` tm
+    hashWithSalt h (ConstCase _ c tm)
+        = hashWithSalt h 2 `hashWithSalt` c `hashWithSalt` tm
+    hashWithSalt h (DefaultCase _ tm)
+        = hashWithSalt h 3 `hashWithSalt` tm
+
+export
+Hashable CFType where
+  hashWithSalt h = \case
+    CFUnit =>
+      h `hashWithSalt` 0
+    CFInt =>
+      h `hashWithSalt` 1
+    CFUnsigned8 =>
+      h `hashWithSalt` 2
+    CFUnsigned16 =>
+      h `hashWithSalt` 3
+    CFUnsigned32 =>
+      h `hashWithSalt` 4
+    CFUnsigned64 =>
+      h `hashWithSalt` 5
+    CFString =>
+      h `hashWithSalt` 6
+    CFDouble =>
+      h `hashWithSalt` 7
+    CFChar =>
+      h `hashWithSalt` 8
+    CFPtr =>
+      h `hashWithSalt` 9
+    CFGCPtr =>
+      h `hashWithSalt` 10
+    CFBuffer =>
+      h `hashWithSalt` 11
+    CFWorld =>
+      h `hashWithSalt` 12
+    CFFun a b =>
+      h `hashWithSalt` 13 `hashWithSalt` a `hashWithSalt` b
+    CFIORes a =>
+      h `hashWithSalt` 14 `hashWithSalt` a
+    CFStruct n fs =>
+      h `hashWithSalt` 15 `hashWithSalt` n `hashWithSalt` fs
+    CFUser n xs =>
+      h `hashWithSalt` 16 `hashWithSalt` n `hashWithSalt` xs
+    CFInt8 =>
+      h `hashWithSalt` 17
+    CFInt16 =>
+      h `hashWithSalt` 18
+    CFInt32 =>
+      h `hashWithSalt` 19
+    CFInt64 =>
+      h `hashWithSalt` 20
+    CFForeignObj =>
+      h `hashWithSalt` 21
+    CFInteger =>
+      h `hashWithSalt` 22
+
+export
+Hashable LazyReason where
+  hashWithSalt h = \case
+    LInf => h `hashWithSalt` 0
+    LLazy => h `hashWithSalt` 1
+    LUnknown => h `hashWithSalt` 2
+
 export
 Hashable ConInfo where
   hashWithSalt h = \case
diff --git a/src/Core/InitPrimitives.idr b/src/Core/InitPrimitives.idr
index 0972e9cb422..81adf774cd4 100644
--- a/src/Core/InitPrimitives.idr
+++ b/src/Core/InitPrimitives.idr
@@ -5,12 +5,41 @@ import Compiler.CompileExpr
 import Core.Context
 import Core.Primitives
 
+import Data.Nat
+import Data.Vect
+import Libraries.Data.WithDefault
+
 %default covering
 
+mkFn : {done : _} ->
+       (i : Int) ->
+       (todo : Nat) -> PrimFn (todo + done) ->
+       Vect done (Var vars) -> Term vars
+mkFn i Z op args
+    = PrimOp EmptyFC op (reverse (map mkLoc args))
+  where
+    mkLoc : Var vars -> Term vars
+    mkLoc (MkVar p) = Local EmptyFC Nothing _ p
+mkFn i (S k) op args
+    = Bind EmptyFC (MN "arg" i)
+           (Lam EmptyFC top Explicit (Erased EmptyFC Placeholder))
+           (mkFn (i + 1) k
+                 (rewrite sym (plusSuccRightSucc k done) in op)
+                 (MkVar First :: map later args))
+
+mkPrim : (arity : Nat) -> PrimFn arity -> Term [<]
+mkPrim a op = mkFn 0 a (rewrite plusZeroRightNeutral a in op) []
+
 addPrim : {auto c : Ref Ctxt Defs} ->
           Prim -> Core ()
 addPrim p
-    = do addBuiltin (opName (fn p)) (type p) (totality p) (fn p)
+    = do let fndef = mkPrim (arity p) (fn p)
+         let primdef = newDef EmptyFC (opName (fn p)) top [<]
+                              (type p) (specified Public)
+                              (Function (MkPMDefInfo NotHole False False)
+                                        fndef fndef Nothing)
+         ignore $ addDef (opName (fn p)) primdef
+         setFlag EmptyFC (opName (fn p)) Inline
          compileDef (opName (fn p))
 
 export
diff --git a/src/Core/LinearCheck.idr b/src/Core/LinearCheck.idr
index ed0c7a62162..c5aa1467b72 100644
--- a/src/Core/LinearCheck.idr
+++ b/src/Core/LinearCheck.idr
@@ -1,170 +1,369 @@
 module Core.LinearCheck
 
-import Core.Case.CaseTree
+-- Linearity checking of already typechecked/elaborated terms
+-- Assumption: Terms are already type correct and we're only checking usage.
+-- of local variables.
+-- We must be able to complete linearity checking without reference to the
+-- global context, although we are allowed to accuess the global context to
+-- update quantities in hold types.
+
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Options
-import Core.UnifyState
-import Core.Value
+import Core.Evaluate
+
+import Data.SnocList
+import Data.Vect
+import Data.SnocList.Quantifiers
 
-import Libraries.Data.List.SizeOf
 import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.VarSet.Core as VarSet
 
 %default covering
 
 -- List of variable usages - we'll count the contents of specific variables
 -- when discharging binders, to ensure that linear names are only used once
 Usage : Scoped
-Usage vars = List (Var vars)
-
-doneScope : Usage (n :: vars) -> Usage vars
-doneScope = mapMaybe isLater
-
-count : Nat -> Usage ns -> Nat
-count p [] = 0
-count p (v :: xs)
-    = if p == varIdx v then 1 + count p xs else count p xs
-
-mutual
-  updateHoleUsageArgs : {0 vars : _} ->
-                        {auto c : Ref Ctxt Defs} ->
-                        {auto u : Ref UST UState} ->
-                        (useInHole : Bool) ->
-                        Var vars -> List (Var vars) ->
-                        List (Term vars) -> Core Bool
-  updateHoleUsageArgs useInHole var zs [] = pure False
-  updateHoleUsageArgs useInHole var zs (a :: as)
-      = do h <- updateHoleUsage useInHole var zs a
-           h' <- updateHoleUsageArgs useInHole var zs as
-           pure (h || h')
-
+Usage vars = SnocList (Var vars)
+
+namespace Usage
+  public export
+  empty : Usage vars
+  empty = [<]
+
+  public export
+  single : Var vars -> Usage vars
+  single a = [<a]
+
+record HoleApp vars where
+  constructor MkHoleApp
+  resolvedName : Int
+  -- Scope the hole is applied to. This might be bigger than the scope we're
+  -- currently in, so we may not know about some arguments. That's okay,
+  -- because we're only updating usage of the things we know about
+  scope : List (Maybe (Term vars))
+
+{vars: _} -> Show (HoleApp vars) where
+  show (MkHoleApp resolvedName scope) = "HoleApp { resolvedName=\{show resolvedName} scope=\{assert_total $ show scope} }"
+
+-- A tree, built from the term, explaining what is used where.
+-- We need this because of the interaction between case branches and holes.
+-- If a variable is used in one branch, but not in another, then holes in
+-- each branch need to respect the usage information.
+-- However, we also need to know usage in the rest of the term before we
+-- can update holes accurately
+record HoleUsage vars where
+  constructor HUsage
+  location : FC
+  used : Usage vars
+  caseAlts : List (HoleUsage vars)
+  holeApps : List (HoleApp vars)
+
+{vars: _} -> Show (HoleUsage vars) where
+  show (HUsage location used caseAlts holeApps) = "HUsage { location=\{show location} used=\{show used} caseAlts=\{assert_total $ show caseAlts} holeApps=\{show holeApps} }"
+
+hdone : FC -> Core (HoleUsage vars)
+hdone fc = pure $ HUsage fc [<] [] []
+
+-- We're finished with the scope of a binder, so forget about any uses of
+-- the variable and any hole it's in
+doneScope : HoleUsage (vars :< n) -> HoleUsage vars
+doneScope (HUsage fc u hs apps)
+    = HUsage fc (doneScopeU u) (map doneScope hs) (map doneScopeH apps)
+  where
+    doneScopeV : Var (vars :< n) -> Maybe (Var vars)
+    doneScopeV (MkVar First) = Nothing
+    doneScopeV (MkVar (Later p)) = Just (MkVar p)
+
+    doneScopeU : Usage (vars :< n) -> Usage vars
+    doneScopeU [<] = [<]
+    doneScopeU (xs :< v)
+       = maybe (doneScopeU xs) (\v' => doneScopeU xs :< v')
+               (doneScopeV v)
+
+    doneScopeH : HoleApp (vars :< n) -> HoleApp vars
+    doneScopeH app
+        = let scope' = map (maybe Nothing
+                                (\tm => shrinkTerm tm (Drop Refl)))
+                           (scope app) in
+              ({ scope := scope' } app)
+
+combine : FC -> HoleUsage ns -> HoleUsage ns -> HoleUsage ns
+-- Doesn't matter where things appear, other than in alternatives, so
+-- just concatenate
+combine fc (HUsage _ us alts apps) (HUsage _ us' alts' apps')
+    = HUsage fc (us ++ us') (alts ++ alts') (apps ++ apps')
+
+concat : FC -> List (HoleUsage ns) -> HoleUsage ns
+concat fc [] = HUsage fc [<] [] []
+concat fc [u] = u
+concat fc (u :: us) = combine fc u (concat fc us)
+
+-- Count the definite uses in the scope
+countU : Nat -> Usage ns -> Nat
+countU p [<] = 0
+countU p (xs :< v)
+    = if p == varIdx v then 1 + countU p xs else countU p xs
+
+count : Nat -> HoleUsage ns -> Nat
+count n (HUsage _ us _ _) = countU n us
+
+getIdxs : {ns : _} -> Usage ns -> List Nat
+getIdxs [<] = []
+getIdxs (vs :< v) = varIdx v :: getIdxs vs
+
+sameUsage : {ns : _} -> Usage ns -> Usage ns -> Bool
+sameUsage xs ys = sort (getIdxs xs) == sort (getIdxs ys)
+
+allSameUsage : {ns : _} -> List (HoleUsage ns) -> Maybe (HoleUsage ns)
+allSameUsage [] = Just (HUsage EmptyFC [<] [] [])
+allSameUsage [u] = Just u
+allSameUsage (u :: v :: vs)
+    = if sameUsage (used u) (used v)
+         then allSameUsage (v :: vs)
+         else Nothing
+
+anyHoles : HoleUsage vars -> Bool
+anyHoles (HUsage _ _ alts []) = or (map (\x => Delay x) (map anyHoles alts))
+anyHoles (HUsage _ _ _ (_ :: _)) = True
+
+smallerU : List Nat -> List Nat -> Bool
+smallerU [] xs = True
+smallerU (x :: xs) (y :: ys)
+    = if x == y
+         then smallerU xs ys
+         else smallerU (x :: xs) ys
+smallerU _ _ = False
+
+-- Check whether the first usage set is smaller than the second, and contains
+-- holes.
+smaller : {vars : _} -> HoleUsage vars -> HoleUsage vars -> Bool
+smaller u v
+    = sameUsage (used u) (used v) ||
+         (anyHoles u &&
+            smallerU (sort (getIdxs (used u))) (sort (getIdxs (used v))))
+
+getNames : {vars : _} -> Usage vars -> List Name
+getNames [<] = []
+getNames (ns :< MkVar p) = nameAt p :: getNames ns
+
+compatibleWith : {vars : _} ->
+                 FC -> HoleUsage vars -> List (HoleUsage vars) -> Core (Usage vars)
+compatibleWith fc u [] = pure (used u)
+compatibleWith fc u (v :: vs)
+    = if smaller u v
+         then compatibleWith fc u vs
+         else if smaller v u
+                 then compatibleWith fc v vs
+                 else throw (InconsistentUse fc [(location u, getNames (used u)),
+                                                 (location v, getNames (used v))])
+
+compatibleUsage : {vars : _} ->
+                  FC -> List (HoleUsage vars) -> Core (Usage vars)
+compatibleUsage fc [] = pure [<]
+compatibleUsage fc [u] = pure (used u)
+compatibleUsage fc (u :: v :: us) = compatibleWith fc u (v :: us)
+
+localPrf : {n : Name} -> {vars, later: Scope} -> Var (vars :< n ++ later)
+localPrf {later = [<]} = MkVar First
+localPrf {n} {vars} {later = (xs :< x)}
+    = let MkVar p = localPrf {n} {vars} {later = xs} in
+          MkVar (Later p)
+
+parameters {auto c : Ref Ctxt Defs}
   -- The assumption here is that hole types are abstracted over the entire
   -- environment, so that they have the appropriate number of function
   -- arguments and there are no lets
-  updateHoleType : {0 vars : _} ->
-                   {auto c : Ref Ctxt Defs} ->
-                   {auto u : Ref UST UState} ->
-                   (useInHole : Bool) ->
-                   Var vars -> List (Var vars) ->
-                   Term vs -> List (Term vars) ->
-                   Core (Term vs)
-  updateHoleType useInHole var zs (Bind bfc nm (Pi fc' c e ty) sc) (Local _ r v _ :: as)
+  updateHoleType : {vars : _} ->
+                    (useInHole : Bool) ->
+                    Var vars ->
+                    VarSet vars ->
+                    Term vs -> List (Maybe (Term vars)) ->
+                    Core (Term vs)
+  updateHoleType useInHole var zs (Bind bfc nm (Pi fc' c e ty) sc) (Just (Local _ _ v _) :: as)
       -- if the argument to the hole type is the variable of interest,
-      -- and the variable should be used in the hole, set it to Rig1,
-      -- otherwise set it to Rig0
+      -- and the variable should be used in the hole, leave multiplicity alone,
+      -- otherwise set it to erased
       = if varIdx var == v
            then do scty <- updateHoleType False var zs sc as
                    let c' = if useInHole then c else erased
                    pure (Bind bfc nm (Pi fc' c' e ty) scty)
-           else if elem v (map varIdx zs)
-                then do scty <- updateHoleType useInHole var zs sc as
-                        pure (Bind bfc nm (Pi fc' erased e ty) scty)
-                else do scty <- updateHoleType useInHole var zs sc as
-                        pure (Bind bfc nm (Pi fc' c e ty) scty)
-  updateHoleType useInHole var zs (Bind bfc nm (Pi fc' c e ty) sc) (a :: as)
-      = do ignore $ updateHoleUsage False var zs a
-           scty <- updateHoleType useInHole var zs sc as
-           pure (Bind bfc nm (Pi fc' c e ty) scty)
+           else if VarSet.elemNat v zs
+               then do scty <- updateHoleType useInHole var zs sc as
+                       pure (Bind bfc nm (Pi fc' erased e ty) scty)
+               else do scty <- updateHoleType useInHole var zs sc as
+                       pure (Bind bfc nm (Pi fc' c e ty) scty)
+  updateHoleType useInHole var zs (Bind bfc nm b@(Pi fc' c e ty) sc) (_ :: as)
+      = do scty <- updateHoleType useInHole var zs sc as
+           pure (Bind bfc nm b scty)
   updateHoleType useInHole var zs ty as
-      = do ignore $ updateHoleUsageArgs False var zs as
-           pure ty
-
-  updateHoleUsagePats : {auto c : Ref Ctxt Defs} ->
-                        {auto u : Ref UST UState} ->
-                        (useInHole : Bool) ->
-                        Var vars -> List (Term vars) ->
-                        (vs ** (Env Term vs, Term vs, Term vs)) ->
-                        Core Bool
-  updateHoleUsagePats {vars} useInHole var args (vs ** (env, lhs, rhs))
-      = do -- Find the argument which corresponds to var
-           let argpos = findArg Z args
-           log "quantity.hole" 10 $ "At positions " ++ show argpos
-           -- Find what it's position is in env by looking at the lhs args
-           let vars = mapMaybe (findLocal (getArgs lhs)) argpos
-           hs <- traverse (\vsel => updateHoleUsage useInHole vsel [] rhs)
-                          vars
-           pure (any id hs)
-    where
-      findArg : Nat -> List (Term vars) -> List Nat
-      findArg i [] = []
-      findArg i (Local _ _ idx vel :: els)
-          = if idx == varIdx var
-               then i :: findArg (1 + i) els
-               else findArg (1 + i) els
-      findArg i (_ :: els) = findArg (1 + i) els
-
-      findLocal : List (Term vs) -> Nat -> Maybe (Var vs)
-      findLocal (Local _ _ _ p :: _) Z = Just (MkVar p)
-      findLocal (As _ _ (Local _ _ _ p) _ :: _) Z = Just (MkVar p)
-      findLocal (As _ _ _ (Local _ _ _ p) :: _) Z = Just (MkVar p)
-      findLocal (_ :: els) (S k) = findLocal els k
-      findLocal _ _ = Nothing
-
-  updateHoleUsage : {0 vars : _} ->
-                    {auto c : Ref Ctxt Defs} ->
-                    {auto u : Ref UST UState} ->
-                    (useInHole : Bool) ->
-                    Var vars -> List (Var vars) ->
-                    Term vars -> Core Bool
-  updateHoleUsage useInHole (MkVar var) zs (Bind _ _ (Let _ _ val _) sc)
-      = do h <- updateHoleUsage useInHole (MkVar var) zs val
-           h' <- updateHoleUsage useInHole (MkVar (Later var)) (map weaken zs) sc
-           pure (h || h')
-  updateHoleUsage useInHole (MkVar var) zs (Bind _ n b sc)
-      = updateHoleUsage useInHole (MkVar (Later var)) (map weaken zs) sc
-  updateHoleUsage useInHole var zs (Meta fc n i args)
+      = pure ty
+
+  updateHoleApp : {vars : _} ->
+                  (useInHole : Bool) -> Var vars -> VarSet vars ->
+                  HoleApp vars -> Core ()
+  updateHoleApp useInHole v zs hole
       = do defs <- get Ctxt
+           let i = resolvedName hole
            Just gdef <- lookupCtxtExact (Resolved i) (gamma defs)
-                | Nothing => updateHoleUsageArgs useInHole var zs args
-           -- only update for holes with no definition yet
+               | Nothing => pure ()
            case definition gdef of
-                Hole {} =>
-                   do let ty = type gdef
-                      ty' <- updateHoleType useInHole var zs ty args
-                      updateTy i ty'
-                      logTerm "quantity.hole.update" 5 ("New type of " ++
-                                 show (fullname gdef)) ty'
-                      logTerm "quantity.hole.update" 5 ("Updated from " ++
-                                 show (fullname gdef)) (type gdef)
-                      pure True
-                _ => updateHoleUsageArgs useInHole var zs args
-  updateHoleUsage useInHole var zs (As _ _ a p)
-      = do h <- updateHoleUsage useInHole var zs a
-           h' <- updateHoleUsage useInHole var zs a
-           pure (h || h')
-  updateHoleUsage useInHole var zs (TDelayed _ _ t)
-      = updateHoleUsage useInHole var zs t
-  updateHoleUsage useInHole var zs (TDelay _ _ _ t)
-      = updateHoleUsage useInHole var zs t
-  updateHoleUsage useInHole var zs (TForce _ _ t)
-      = updateHoleUsage useInHole var zs t
-  updateHoleUsage useInHole var zs tm
-      = case getFnArgs tm of
-             (Ref _ _ fn, args) =>
-                  -- no need to look inside 'fn' for holes since we did that
-                  -- when working through lcheckDef recursively
-                  updateHoleUsageArgs useInHole var zs args
-             (f, []) => pure False
-             (f, args) => updateHoleUsageArgs useInHole var zs (f :: args)
-
--- Linearity checking of an already checked term. This serves two purposes:
---  + Checking correct usage of linear bindings
---  + updating hole types to reflect usage counts correctly
--- Returns term, normalised type, and a list of used variables
-mutual
+               Hole {} =>
+                  do let ty = type gdef
+                     ty' <- updateHoleType useInHole v zs ty (scope hole)
+                     updateTy i ty'
+                     logTerm "quantity.hole.update" 5 ("New type of " ++
+                               show (fullname gdef)) ty'
+                     logTerm "quantity.hole.update" 5 ("Updated from " ++
+                               show (fullname gdef)) (type gdef)
+               _ => pure ()
+
+  -- For all the holes in the usage tree update their type so that
+  -- the variable in question's usage is set appropriately. If it appears
+  -- in the current known usage list, -- set its multiplicity to zero.
+  -- This is so that, in interactive editing, a user can see whether a variable
+  -- is available for usage in a hole or not.
+  updateHoleUsage : {vars : _} ->
+                    Var vars -> -- Variable in question
+                    VarSet vars -> -- erased variables in environment
+                    Usage vars -> -- Complete usage so far
+                    HoleUsage vars -> Core Bool
+  updateHoleUsage var@(MkVar {varIdx} _) zs usage (HUsage fc moreUsage alts holes)
+      = do let usage = usage ++ moreUsage
+           let used = countU varIdx usage == 0
+           anyHoles <- traverse (updateHoleUsage var zs usage) alts
+           traverse_ (updateHoleApp used var zs) holes
+           pure (not (null holes) || or (map (\x => Delay x) anyHoles))
+
   lcheck : {vars : _} ->
-           {auto c : Ref Ctxt Defs} ->
-           {auto u : Ref UST UState } ->
-           RigCount -> (erase : Bool) -> Env Term vars -> Term vars ->
-           Core (Term vars, Glued vars, Usage vars)
-  lcheck {vars} rig erase env (Local {name} fc x idx prf)
+           RigCount -> Env Term vars -> Term vars ->
+           Core (HoleUsage vars)
+
+  -- Checking if the bound variable is used appropriately in the scope
+  checkUsageOK : FC -> Nat -> Name -> RigCount -> Core ()
+  checkUsageOK fc used nm r
+      = when (isLinear r && used /= 1)
+          (do log "quantity" 5 $ "Linearity error " ++ show nm
+              throw (LinearUsed fc used nm))
+
+  -- Check if a term has holes (not under case alternatives, and not in types
+  -- that are in multiplicity 0 anyway).
+  -- This is so when we check linearity of case alternatives, we do the ones
+  -- without holes first to establish what the correct usage should be
+  hasHoles : Term vars -> Core Bool
+  hasHoles (Meta _ _ i _)
+      = do defs <- get Ctxt
+           Just gdef <- lookupCtxtExact (Resolved i) (gamma defs)
+                | Nothing => pure False
+           case definition gdef of
+                Hole _ _ => pure True
+                _ => pure False
+  hasHoles (Bind _ _ b sc)
+      = if !(hasHolesBinder b) then pure True
+                               else hasHoles sc
+    where
+      hasHolesBinder : Binder (Term vars) -> Core Bool
+      hasHolesBinder (Let _ _ val _) = hasHoles val
+      hasHolesBinder _ = pure False
+  hasHoles (App _ f _ a)
+      = if !(hasHoles f) then pure True else hasHoles a
+  hasHoles (Case _ _ _ sc _ _) = hasHoles sc
+  hasHoles (TDelay _ _ _ tm) = hasHoles tm
+  hasHoles (TForce _ _ tm) = hasHoles tm
+  hasHoles _ = pure False
+
+  -- Check a case alternative. Returns the usage tree just for that alternative
+  lcheckAlt : {vars : _} ->
+              -- must be Rig0 or Rig1
+              (rhsrig : RigCount) ->
+              Env Term vars ->
+              (scrig : RigCount) ->
+              CaseAlt vars ->
+              Core (HoleUsage vars)
+  lcheckAlt rig env scrig (ConCase fc n t sc)
+      = lcheckScope env sc
+    where
+      lcheckScope : {vars : _} -> Env Term vars -> CaseScope vars ->
+                    Core (HoleUsage vars)
+      lcheckScope env (RHS _ tm)
+          = lcheck rig env tm
+      lcheckScope env (Arg c x sc)
+            -- We don't have the type of the argument, but the good news is
+            -- that we don't need it because we only need multiplicities and
+            -- they are cached in App nodes.
+          = do let env'
+                   = env :<
+                     PVar fc (rigMult scrig c) Explicit (Erased fc Placeholder)
+               usc <- lcheckScope env' sc
+               let used_in = count 0 usc
+               -- As with binders, check for holes in the scope and update
+               -- their types if this variable has been consumed linearly
+               holeFound <- if isLinear c
+                               then updateHoleUsage
+                                             (MkVar First)
+                                             (weaken @{varSetWeaken} (getErased env))
+                                             [<]
+                                             usc
+                               else pure False
+               let used = if isLinear (rigMult c rig) &&
+                             holeFound && used_in == 0
+                             then 1
+                             else used_in
+               checkUsageOK EmptyFC used x (rigMult (rigMult scrig c) rig)
+               pure (doneScope usc)
+  lcheckAlt rig env scrig (DelayCase fc t a rhs)
+      = do -- See above for why the types are erased
+           let env'
+               = env :<
+                 PVar fc erased Implicit (Erased fc Placeholder) :<
+                 PVar fc scrig Explicit (Erased fc Placeholder)
+           u' <- lcheck rig env' rhs
+           -- t and a are not linear, so nothing to check
+           pure (doneScope (doneScope u'))
+  lcheckAlt rig env scrig (ConstCase fc c rhs)
+      = lcheck rig env rhs
+  lcheckAlt rig env scrig (DefaultCase fc rhs)
+      = lcheck rig env rhs
+
+  lcheckAlts : {vars : _} ->
+               FC -> (rhsrig : RigCount) ->
+               Env Term vars ->
+               (scrig : RigCount) ->
+               List (CaseAlt vars) ->
+               Core (HoleUsage vars)
+  lcheckAlts fc rig env scrig alts
+      = do allUs <- traverse (lcheckAlt rig env scrig) alts
+           -- If all the alternatives have the same usage, and there's no
+           -- holes, just lift it out, because then we can count usages
+           -- properly at the next level up
+           if not (or (map (\x => Delay x) (map anyHoles allUs)))
+              then do let Just u = allSameUsage allUs
+                           | Nothing =>
+                                throw (InconsistentUse fc (map getUse allUs))
+                      pure u
+              else
+                   -- Otherwise, check the the usage is at least compatible
+                   -- and build a tree for traversing by updateHoleUsage later
+                   do us <- compatibleUsage fc allUs
+                      pure (HUsage fc us allUs [])
+    where
+      getUse : {vars : _} -> HoleUsage vars -> (FC, List Name)
+      getUse h = (location h, getNames (used h))
+
+  lcheckBinder : {vars : _} ->
+           RigCount -> Env Term vars -> Binder (Term vars) ->
+           Core (HoleUsage vars)
+  lcheckBinder rig env (Lam fc c p ty) = hdone fc
+  lcheckBinder rig env (Let fc c val ty) = lcheck (rigMult rig c) env val
+  lcheckBinder rig env (Pi fc c p ty) = lcheck (rigMult rig c) env ty
+  lcheckBinder rig env (PVar fc c p ty) = hdone fc
+  lcheckBinder rig env (PLet fc c val ty) = lcheck (rigMult rig c) env val
+  lcheckBinder rig env (PVTy fc c ty) = hdone fc
+
+  lcheck {vars} rig env (Local fc _ idx prf)
       = let b = getBinder prf env
-            rigb = multiplicity b
-            ty = binderType b in
-            do log "quantity" 15 "lcheck Local"
-               when (not erase) $ rigSafe rigb rig
-               pure (Local fc x idx prf, gnf env ty, used rig)
+            rigb = multiplicity b in
+            do rigSafe rigb rig
+               pure (HUsage fc (used (rigMult rig rigb)) [] [])
     where
       rigSafe : RigCount -> RigCount -> Core ()
       rigSafe l r = when (l < r)
@@ -173,92 +372,72 @@ mutual
       -- count the usage if we're in a linear context. If not, the usage doesn't
       -- matter
       used : RigCount -> Usage vars
-      used r = if isLinear r then [MkVar prf] else []
-
-  lcheck rig erase env (Ref fc nt fn)
-      = do logC "quantity" 15 $ do pure "lcheck Ref \{show (nt)} \{show !(toFullNames fn)}"
-           ty <- lcheckDef fc rig erase env fn
-           pure (Ref fc nt fn, gnf env (embed ty), [])
-
-  -- If the meta has a definition, and we're not in Rig0, expand it first
-  -- and check the result.
-  -- Otherwise, don't count variable usage in holes, so as far as linearity
-  -- checking is concerned, update the type so that the binders
-  -- are in Rig0
-  lcheck {vars} rig erase env (Meta fc n idx args)
-      = do log "quantity" 15 "lcheck Meta"
-           defs <- get Ctxt
-           Just gdef <- lookupCtxtExact (Resolved idx) (gamma defs)
-                | _ => undefinedName fc n
-           let expand = branchZero
-                          (case type gdef of
-                                Erased {} => True -- defined elsewhere, need to expand
-                                _ => False)
-                          (case definition gdef of
-                                PMDef {} => True
-                                _ => False)
-                          rig
-           logC "quantity" 10 $ do
-             def <- case definition gdef of
-                         PMDef _ _ (STerm _ tm) _ _ =>
-                              do tm' <- toFullNames tm
-                                 pure (show tm')
-                         _ => pure ""
-             pure (show rig ++ ": " ++ show n ++ " " ++ show fc ++ "\n"
-                     ++ show def)
-           if expand
-              then expandMeta rig erase env n idx (definition gdef) args
-              else do let ty : ClosedTerm
-                             = case definition gdef of
-                                    Hole {} => unusedHoleArgs args (type gdef)
-                                    _ => type gdef
-                      nty <- nf defs env (embed ty)
-                      lcheckMeta rig erase env fc n idx args [] nty
-    where
-      unusedHoleArgs : List a -> Term vs -> Term vs
-      unusedHoleArgs (_ :: args) (Bind bfc n (Pi fc _ e ty) sc)
-          = Bind bfc n (Pi fc erased e ty) (unusedHoleArgs args sc)
-      unusedHoleArgs args (Bind bfc n (Let fc c e ty) sc)
-          = Bind bfc n (Let fc c e ty) (unusedHoleArgs args sc)
-      unusedHoleArgs _ ty = ty
-
-  lcheck rig_in erase env (Bind fc nm b sc)
-      = do log "quantity" 15 "lcheck Bind"
-           (b', bt, usedb) <- handleUnify (lcheckBinder rig erase env b)
-                                 (\err =>
-                                     case err of
-                                          LinearMisuse _ _ r _ =>
-                                             lcheckBinder rig erase env
-                                                (setMultiplicity b linear)
-                                          _ => throw err)
-           -- Anything linear can't be used in the scope of a lambda, if we're
-           -- checking in general context
-           let env' = if rig_in == top
-                         then case b of
-                              Lam {} => eraseLinear env
-                              _ => env
-                         else env
-           (sc', sct, usedsc) <- lcheck rig erase (b' :: env') sc
-
-           let used_in = count 0 usedsc
-           holeFound <- if not erase && isLinear (multiplicity b)
-                           then updateHoleUsage (used_in == 0)
-                                         first
-                                         (map weaken (getErased env'))
-                                         sc'
+      used r = if isLinear r then [<MkVar prf] else [<]
+  lcheck rig env (Ref fc nt n)
+      = do logC "quantity" 15 $ do pure "lcheck Ref \{show (nt)} \{show !(toFullNames n)}"
+           hdone fc -- No quantity to check, and the name's quantity was checked
+              -- when type checking
+  lcheck {vars} rig env (Meta fc n i args)
+      -- If the metavariable is defined, check as normal (we assume that
+      -- quantities cached in the arguments have been set appropriately when
+      -- the metavariable was resolved).
+      -- Otherwise, don't count any usage in the 'args' - we'll update the
+      -- type of the hole
+      -- when we updateHoleUsage based on usages elsewhere, because we don't
+      -- know if it's used until the hole is defined.
+      = if isErased rig
+           then hdone fc
+           else
+             do defs <- get Ctxt
+                let defined
+                      = case !(lookupCtxtExact (Resolved i) (gamma defs)) of
+                             Nothing => False
+                             Just def => case definition def of
+                                              Function {} => True
+                                              _ => False
+                us <- logDepth $ traverse (\ (c, arg) => logDepth $ lcheck (rigMult rig c) env arg) args
+                let newHoleApp : HoleApp vars
+                    = MkHoleApp i (map (Just . snd) args)
+                if defined
+                   then pure (concat fc us)
+                   else pure ({ used := [<],
+                                holeApps $= (newHoleApp ::) } (concat fc us))
+  lcheck rig_in env (Bind fc nm b sc)
+      = do ub <- lcheckBinder rig env b
+
+           -- Anything linear can't be used in the scope of a let/lambda, if
+           -- we're checking in general context
+           let (env', rig') = case b of
+                                   Pi _ _ _ _ => (env, rig)
+                                   _ => (restrictEnv env rig, presence rig)
+
+           usc <- logDepth $ lcheck rig' (env' :< b) sc
+           let used_in = count 0 usc
+
+           -- Look for holes in the scope, if the variable is linearly bound.
+           -- If the variable hasn't been used, we assume it is to be used in
+           -- any holes in the scope of the binder (this is so when a user
+           -- inspects the type, they see there is 1 usage available).
+           -- 'updateHoleUsage' updates the type of any holes to reflect
+           -- whether the variable in question is usable or not.
+           holeFound <- if isLinear (multiplicity b)
+                           then updateHoleUsage
+                                         (MkVar First)
+                                         (weaken @{varSetWeaken} (getErased env))
+                                         [<]
+                                         usc
                            else pure False
 
-           -- if there's a hole, assume it will contain the missing usage
-           -- if there is none already
-           let used = if isLinear ((multiplicity b) |*| rig) &&
+           -- The final usage count is always 1 if the bound variable is
+           -- linear and there are holes. Otherwise, we take the count we
+           -- found above.
+           let used = if isLinear (rigMult (multiplicity b) rig') &&
                          holeFound && used_in == 0
-                         then 1
+                         then (S Z)
                          else used_in
 
-           when (not erase) $
-               checkUsageOK used ((multiplicity b) |*| rig)
-           defs <- get Ctxt
-           discharge defs env fc nm b' bt sc' sct (usedb ++ doneScope usedsc)
+           checkUsageOK fc used nm (rigMult (multiplicity b) rig')
+           pure (combine fc ub (doneScope usc))
     where
       rig : RigCount
       rig = case b of
@@ -266,441 +445,61 @@ mutual
                       if isErased rig_in
                          then erased
                          else top -- checking as if an inspectable run-time type
-                 Let {} => rig_in
-                 _ => if isErased rig_in
-                         then erased
-                         else linear
-
-      checkUsageOK : Nat -> RigCount -> Core ()
-      checkUsageOK used r = when (isLinear r && used /= 1)
-                                 (throw (LinearUsed fc used nm))
-
-  lcheck rig erase env (App fc f a)
-      = do logC "quantity" 15 $ do pure "lcheck App \{show !(toFullNames f)} \{show !(toFullNames a)}"
-           (f', gfty, fused) <- lcheck rig erase env f
-           defs <- get Ctxt
-           fty <- getNF gfty
-           case undot fty of
-                NBind _ _ (Pi _ rigf _ ty) scdone =>
-                     -- if the argument is borrowed, it's okay to use it in
-                     -- unrestricted context, because we'll be out of the
-                     -- application without spending it
-                   do let checkRig = rigf |*| rig
-                      (a', gaty, aused) <- lcheck checkRig erase env a
-                      sc' <- scdone defs (toClosure defaultOpts env a')
-                      let aerased = if erase && isErased rigf then Erased fc Placeholder else a'
-                      -- Possibly remove this check, or make it a compiler
-                      -- flag? It is a useful double check on the result of
-                      -- elaboration, but there are pathological cases where
-                      -- it makes the check very slow (id id id id ... id id etc
-                      -- for example) and there may be similar realistic cases.
-                      -- If elaboration is correct, this should never fail!
-                      opts <- getSession
-                      when (debugElabCheck opts) $ do
-                        aty <- getNF gaty
-                        when (not !(convert defs env aty !(evalClosure defs ty))) $
-                           do ty' <- quote defs env ty
-                              aty' <- quote defs env aty
-                              throw (CantConvert fc (gamma defs) env ty' aty')
-                      pure (App fc f' aerased,
-                            glueBack defs env sc',
-                            fused ++ aused)
-                NApp _ (NRef _ n) _ =>
-                      do Just _ <- lookupCtxtExact n (gamma defs)
-                              | _ => undefinedName fc n
-                         tfty <- getTerm gfty
-                         needFunctionType f' gfty
-                NErased _ Placeholder =>
-                  do when (not erase) $ needFunctionType f' gfty
-                     -- we don't do any linearity checking when `erase` is set
-                     -- so returning an empty usage is fine
-                     pure (App fc f a, gErased fc, [])
-                _ =>
-                  needFunctionType f' gfty
-    where
-      needFunctionType : Term vars -> Glued vars -> Core _
-      needFunctionType f gfty =
-        do tfty <- getTerm gfty
-           throw (GenericMsg fc ("Linearity checking failed on " ++ show !(toFullNames f) ++
-                 " (" ++ show !(toFullNames tfty) ++ " not a function type)"))
-
-      undot : NF vars -> NF vars
-      undot (NErased _ (Dotted tm)) = tm
-      undot tm = tm
-
-  lcheck rig erase env (As fc s as pat)
-      = do log "quantity" 15 "lcheck As"
-           (as', _, _) <- lcheck rig erase env as
-           (pat', pty, u) <- lcheck rig erase env pat
-           pure (As fc s as' pat', pty, u)
-  lcheck rig erase env (TDelayed fc r ty)
-      = do log "quantity" 15 "lcheck Delayed"
-           (ty', _, u) <- lcheck rig erase env ty
-           pure (TDelayed fc r ty', gType fc (MN "top" 0), u)
-  lcheck rig erase env (TDelay fc r ty val)
-      = do (ty', _, _) <- lcheck erased erase env ty
-           (val', gty, u) <- lcheck rig erase env val
-           ty <- getTerm gty
-           pure (TDelay fc r ty' val', gnf env (TDelayed fc r ty), u)
-  lcheck rig erase env (TForce fc r val)
-      = do log "quantity" 15 "lcheck Force"
-           (val', gty, u) <- lcheck rig erase env val
-           tynf <- getNF gty
-           case tynf of
-                NDelayed _ r narg
-                    => do defs <- get Ctxt
-                          pure (TForce fc r val', glueBack defs env narg, u)
-                _ => throw (GenericMsg fc "Not a delayed type")
-  lcheck rig erase env (PrimVal fc c)
-      = do log "quantity" 15 "lcheck PrimVal"
-           pure (PrimVal fc c, gErased fc, [])
-  lcheck rig erase env (Erased fc i)
-      = do log "quantity" 15 "lcheck Erased"
-           pure (Erased fc i, gErased fc, [])
-  lcheck rig erase env (TType fc u)
-      -- Not universe checking here, just use the top of the hierarchy
-      = do log "quantity" 15 "lcheck TType"
-           pure (TType fc u, gType fc (MN "top" 0), [])
-
-  lcheckBinder : {vars : _} ->
-                 {auto c : Ref Ctxt Defs} ->
-                 {auto u : Ref UST UState} ->
-                 RigCount -> (erase : Bool) -> Env Term vars ->
-                 Binder (Term vars) ->
-                 Core (Binder (Term vars), Glued vars, Usage vars)
-  lcheckBinder rig erase env (Lam fc c x ty)
-      = do (tyv, tyt, _) <- lcheck erased erase env ty
-           pure (Lam fc c x tyv, tyt, [])
-  lcheckBinder rig erase env (Let fc rigc val ty)
-      = do (tyv, tyt, _) <- lcheck erased erase env ty
-           (valv, valt, vs) <- lcheck (rig |*| rigc) erase env val
-           pure (Let fc rigc valv tyv, tyt, vs)
-  lcheckBinder rig erase env (Pi fc c x ty)
-      = do (tyv, tyt, _) <- lcheck (rig |*| c) erase env ty
-           pure (Pi fc c x tyv, tyt, [])
-  lcheckBinder rig erase env (PVar fc c p ty)
-      = do (tyv, tyt, _) <- lcheck erased erase env ty
-           pure (PVar fc c p tyv, tyt, [])
-  lcheckBinder rig erase env (PLet fc rigc val ty)
-      = do (tyv, tyt, _) <- lcheck erased erase env ty
-           (valv, valt, vs) <- lcheck (rig |*| rigc) erase env val
-           pure (PLet fc rigc valv tyv, tyt, vs)
-  lcheckBinder rig erase env (PVTy fc c ty)
-      = do (tyv, tyt, _) <- lcheck erased erase env ty
-           pure (PVTy fc c tyv, tyt, [])
-
-  discharge : {vars : _} ->
-              Defs -> Env Term vars ->
-              FC -> (nm : Name) -> Binder (Term vars) -> Glued vars ->
-              Term (nm :: vars) -> Glued (nm :: vars) -> Usage vars ->
-              Core (Term vars, Glued vars, Usage vars)
-  discharge defs env fc nm (Lam fc' c x ty) gbindty scope gscopety used
-       = do scty <- getTerm gscopety
-            pure (Bind fc nm (Lam fc' c x ty) scope,
-                  gnf env (Bind fc nm (Pi fc' c x ty) scty), used)
-  discharge defs env fc nm (Let fc' c val ty) gbindty scope gscopety used
-       = do scty <- getTerm gscopety
-            pure (Bind fc nm (Let fc' c val ty) scope,
-                  gnf env (Bind fc nm (Let fc' c val ty) scty), used)
-  discharge defs env fc nm (Pi fc' c x ty) gbindty scope gscopety used
-       = pure (Bind fc nm (Pi fc' c x ty) scope, gbindty, used)
-  discharge defs env fc nm (PVar fc' c p ty) gbindty scope gscopety used
-       = do scty <- getTerm gscopety
-            pure (Bind fc nm (PVar fc' c p ty) scope,
-                  gnf env (Bind fc nm (PVTy fc' c ty) scty), used)
-  discharge defs env fc nm (PLet fc' c val ty) gbindty scope gscopety used
-       = do scty <- getTerm gscopety
-            pure (Bind fc nm (PLet fc' c val ty) scope,
-                  gnf env (Bind fc nm (PLet fc' c val ty) scty), used)
-  discharge defs env fc nm (PVTy fc' c ty) gbindty scope gscopety used
-       = pure (Bind fc nm (PVTy fc' c ty) scope, gbindty, used)
-
-  data ArgUsage
-       = UseAny -- RigW so we don't care
-       | Use0 -- argument position not used
-       | Use1 -- argument position used exactly once
-       | UseKeep -- keep as is
-       | UseUnknown -- hole, so can't tell
-
-  Show ArgUsage where
-    show UseAny = "any"
-    show Use0 = "0"
-    show Use1 = "1"
-    show UseKeep = "keep"
-    show UseUnknown = "unknown"
-
-  -- Check argument usage in case blocks. Returns a list of how each argument
-  -- in the case block is used, to build the appropriate type for the outer
-  -- block.
-  getArgUsage : {auto c : Ref Ctxt Defs} ->
-                {auto e : Ref UST UState} ->
-                FC -> RigCount -> ClosedTerm ->
-                List (vs ** (Env Term vs, Term vs, Term vs)) ->
-                Core (List ArgUsage)
-  getArgUsage topfc rig ty pats
-      = do us <- traverse (getPUsage ty) pats
-           pure (map snd !(combine us))
-    where
-      getCaseUsage : Term ns -> Env Term vs -> List (Term vs) ->
-                     Usage vs -> Term vs ->
-                     Core (List (Name, ArgUsage))
-      getCaseUsage ty env (As _ _ _ p :: args) used rhs
-          = getCaseUsage ty env (p :: args) used rhs
-      getCaseUsage (Bind _ n (Pi _ rig _ ty) sc) env (arg :: args) used rhs
-          = if isLinear rig
-               then case arg of
-                         (Local _ _ idx p) =>
-                           do rest <- getCaseUsage sc env args used rhs
-                              let used_in = count idx used
-                              holeFound <- updateHoleUsage (used_in == 0) (MkVar p) [] rhs
-                              let ause
-                                  = if holeFound && used_in == 0
-                                            then UseUnknown
-                                            else if used_in == 0
-                                                    then Use0
-                                                    else Use1
-                              pure ((n, ause) :: rest)
-                         _ => do elseCase
-               else elseCase
-          where
-            elseCase : Core (List (Name, ArgUsage))
-            elseCase = do rest <- getCaseUsage sc env args used rhs
-                          pure $ if isErased rig
-                             then ((n, Use0) :: rest)
-                             else ((n, UseKeep) :: rest)
-      getCaseUsage tm env args used rhs = pure []
-
-      checkUsageOK : FC -> Nat -> Name -> Bool -> RigCount -> Core ()
-      checkUsageOK fc used nm isloc rig
-          = when (isLinear rig && ((isloc && used > 1) || (not isloc && used /= 1)))
-                 (throw (LinearUsed fc used nm))
-
-      -- Is the variable one of the lhs arguments; i.e. do we treat it as
-      -- affine rather than linear
-      isLocArg : Var vars -> List (Term vars) -> Bool
-      isLocArg p [] = False
-      isLocArg p (Local _ _ idx _ :: args)
-          = idx == varIdx p || isLocArg p args
-      isLocArg p (As _ _ tm pat :: args)
-          = isLocArg p (tm :: pat :: args)
-      isLocArg p (_ :: args) = isLocArg p args
-
-      -- As checkEnvUsage in general, but it's okay for local variables to
-      -- remain unused (since in that case, they must be used outside the
-      -- case block)
-      checkEnvUsage : {vars : _} ->
-                      SizeOf done ->
-                      RigCount ->
-                      Env Term vars -> Usage (done <>> vars) ->
-                      List (Term (done <>> vars)) ->
-                      Term (done <>> vars) -> Core ()
-      checkEnvUsage s rig [] usage args tm = pure ()
-      checkEnvUsage s rig {done} {vars = nm :: xs} (b :: env) usage args tm
-          = do let pos = mkVarChiply s
-               let used_in = count (varIdx pos) usage
-
-               holeFound <- if isLinear (multiplicity b)
-                               then updateHoleUsage (used_in == 0) pos [] tm
-                               else pure False
-               let used = if isLinear ((multiplicity b) |*| rig) &&
-                             holeFound && used_in == 0
-                             then 1
-                             else used_in
-               checkUsageOK (getLoc (binderType b))
-                            used nm (isLocArg pos args)
-                                    ((multiplicity b) |*| rig)
-               checkEnvUsage (s :< nm) rig env usage args tm
-
-      getPUsage : ClosedTerm -> (vs ** (Env Term vs, Term vs, Term vs)) ->
-                  Core (List (Name, ArgUsage))
-      getPUsage ty (_ ** (penv, lhs, rhs))
-          = do logEnv "quantity" 10 "Env" penv
-               logTerm "quantity" 10 "LHS" lhs
-               logTerm "quantity" 5 "Linear check in case RHS" rhs
-               (rhs', _, used) <- lcheck rig False penv rhs
-               log "quantity" 10 $ "Used: " ++ show used
-               let args = getArgs lhs
-               checkEnvUsage [<] rig penv used args rhs'
-               ause <- getCaseUsage ty penv args used rhs
-               log "quantity" 10 $ "Arg usage: " ++ show ause
-               pure ause
-
-      combineUsage : (Name, ArgUsage) -> (Name, ArgUsage) ->
-                     Core (Name, ArgUsage)
-      combineUsage (n, Use0) (_, Use1)
-          = throw (GenericMsg topfc ("Inconsistent usage of " ++ show n ++ " in case branches"))
-      combineUsage (n, Use1) (_, Use0)
-          = throw (GenericMsg topfc ("Inconsistent usage of " ++ show n ++ " in case branches"))
-      combineUsage (n, UseAny) _ = pure (n, UseAny)
-      combineUsage _ (n, UseAny) = pure (n, UseAny)
-      combineUsage (n, UseKeep) _ = pure (n, UseKeep)
-      combineUsage _ (n, UseKeep) = pure (n, UseKeep)
-      combineUsage (n, UseUnknown) _ = pure (n, UseUnknown)
-      combineUsage _ (n, UseUnknown) = pure (n, UseUnknown)
-      combineUsage x y = pure x
-
-      combineUsages : List (Name, ArgUsage) -> List (Name, ArgUsage) ->
-                      Core (List (Name, ArgUsage))
-      combineUsages [] [] = pure []
-      combineUsages (u :: us) (v :: vs)
-          = do u' <- combineUsage u v
-               us' <- combineUsages us vs
-               pure (u' :: us')
-      combineUsages _ _ = throw (InternalError "Argument usage lists inconsistent")
-
-      combine : List (List (Name, ArgUsage)) ->
-                Core (List (Name, ArgUsage))
-      combine [] = pure []
-      combine [x] = pure x
-      combine (x :: xs)
-          = do xs' <- combine xs
-               combineUsages x xs'
-
-  lcheckDef : {auto c : Ref Ctxt Defs} ->
-              {auto u : Ref UST UState} ->
-              FC -> RigCount -> (erase : Bool) -> Env Term vars -> Name ->
-              Core ClosedTerm
-  lcheckDef fc rig True env n
-      = do defs <- get Ctxt
-           Just def <- lookupCtxtExact n (gamma defs)
-                | Nothing => undefinedName fc n
-           pure (type def)
-  lcheckDef fc rig False env n
-      = do defs <- get Ctxt
-           let Just idx = getNameID n (gamma defs)
-                | Nothing => undefinedName fc n
-           Just def <- lookupCtxtExact (Resolved idx) (gamma defs)
-                | Nothing => undefinedName fc n
-           rigSafe (multiplicity def) rig
-           if linearChecked def
-              then pure (type def)
-              else case definition def of
-                        PMDef _ _ _ _ pats =>
-                            do u <- getArgUsage (getLoc (type def))
-                                                rig (type def) pats
-                               log "quantity" 5 $ "Overall arg usage " ++ show u
-                               let ty' = updateUsage u (type def)
-                               updateTy idx ty'
-                               setLinearCheck idx True
-                               logTerm "quantity" 5 ("New type of " ++
-                                          show (fullname def)) ty'
-                               logTerm "quantity" 5 ("Updated from " ++
-                                          show (fullname def)) (type def)
-                               pure ty'
-                        _ => pure (type def)
-    where
-      updateUsage : List ArgUsage -> Term ns -> Term ns
-      updateUsage (u :: us) (Bind bfc n (Pi fc c e ty) sc)
-          = let sc' = updateUsage us sc
-                c' = case u of
-                          Use0 => erased
-                          Use1 => linear -- ignore usage elsewhere, we checked here
-                          UseUnknown => c -- don't know, assumed unchanged and update hole types
-                          UseKeep => c -- matched here, so count usage elsewhere
-                          UseAny => c in -- no constraint, so leave alone
-                Bind bfc n (Pi fc c' e ty) sc'
-      updateUsage _ ty = ty
-
-      rigSafe : RigCount -> RigCount -> Core ()
-      rigSafe a b = when (a < b)
-                         (throw (LinearMisuse fc !(getFullName n) a b))
-
-  expandMeta : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               {auto u : Ref UST UState} ->
-               RigCount -> (erase : Bool) -> Env Term vars ->
-               Name -> Int -> Def -> List (Term vars) ->
-               Core (Term vars, Glued vars, Usage vars)
-  expandMeta rig erase env n idx (PMDef _ [] (STerm _ fn) _ _) args
-      = do tm <- substMeta (embed fn) args zero Subst.empty
-           lcheck rig erase env tm
-    where
-      substMeta : {drop, vs : _} ->
-                  Term (drop ++ vs) -> List (Term vs) ->
-                  SizeOf drop -> SubstEnv drop vs ->
-                  Core (Term vs)
-      substMeta (Bind bfc n (Lam _ c e ty) sc) (a :: as) drop env
-          = substMeta sc as (suc drop) (a :: env)
-      substMeta (Bind bfc n (Let _ c val ty) sc) as drop env
-          = substMeta (subst val sc) as drop env
-      substMeta rhs [] drop env = pure (substs drop env rhs)
-      substMeta rhs _ _ _ = throw (InternalError ("Badly formed metavar solution " ++ show n ++ " " ++ show fn))
-  expandMeta rig erase env n idx def _
-      = throw (InternalError ("Badly formed metavar solution " ++ show n ++ " " ++ show def))
-
-  lcheckMeta : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               {auto u : Ref UST UState} ->
-               RigCount -> Bool -> Env Term vars ->
-               FC -> Name -> Int ->
-               (args : List (Term vars)) ->
-               (checked : List (Term vars)) ->
-               NF vars -> Core (Term vars, Glued vars, Usage vars)
-  lcheckMeta rig erase env fc n idx
-             (arg :: args) chk (NBind _ _ (Pi _ rigf _ ty) sc)
-      = do let checkRig = rigf |*| rig
-           (arg', gargTy, aused) <- lcheck checkRig erase env arg
-           defs <- get Ctxt
-           sc' <- sc defs (toClosure defaultOpts env arg')
-           let aerased = if erase && isErased rigf
-                            then Erased fc Placeholder
-                            else arg'
-           (tm, gty, u) <- lcheckMeta rig erase env fc n idx args
-                                      (aerased :: chk) sc'
-           pure (tm, gty, aused ++ u)
-  lcheckMeta rig erase env fc n idx (arg :: args) chk nty
-      = do defs <- get Ctxt
-           empty <- clearDefs defs
-           ty <- quote empty env nty
-           throw (GenericMsg fc ("Linearity checking failed on metavar "
-                      ++ show !(toFullNames n) ++ " (" ++ show !(toFullNames ty)
-                      ++ " not a function type)"))
-  lcheckMeta rig erase env fc n idx [] chk nty
-      = do defs <- get Ctxt
-           pure (Meta fc n idx (reverse chk), glueBack defs env nty, [])
-
-
-checkEnvUsage : {vars : _} ->
-                {auto c : Ref Ctxt Defs} ->
-                {auto u : Ref UST UState} ->
-                FC -> SizeOf done -> RigCount ->
-                Env Term vars -> Usage (done <>> vars) ->
-                Term (done <>> vars) ->
-                Core ()
-checkEnvUsage fc s rig [] usage tm = pure ()
-checkEnvUsage fc s rig {vars = nm :: xs} (b :: env) usage tm
-    = do let pos = mkVarChiply s
-         let used_in = count (varIdx pos) usage
-
-         holeFound <- if isLinear (multiplicity b)
-                         then updateHoleUsage (used_in == 0) pos [] tm
-                         else pure False
-         let used = if isLinear ((multiplicity b) |*| rig) &&
-                       holeFound && used_in == 0
-                       then 1
-                       else used_in
-         checkUsageOK used ((multiplicity b) |*| rig)
-         checkEnvUsage fc (s :< nm) rig env usage tm
-  where
-    checkUsageOK : Nat -> RigCount -> Core ()
-    checkUsageOK used r = when (isLinear r && used /= 1)
-                               (throw (LinearUsed fc used nm))
-
--- Linearity check an elaborated term. If 'erase' is set, erase anything that's in
--- a Rig0 argument position (we can't do this until typechecking is complete, though,
--- since it might be used for unification/reasoning elsewhere, so we only do this for
--- definitions ready for compilation).
-export
-linearCheck : {vars : _} ->
-              {auto c : Ref Ctxt Defs} ->
-              {auto u : Ref UST UState} ->
-              FC -> RigCount -> (erase : Bool) ->
-              Env Term vars -> Term vars ->
-              Core (Term vars)
-linearCheck fc rig erase env tm
-    = do logTerm "quantity" 5 "Linearity check on " tm
-         logEnv "quantity" 5 "In env" env
-         (tm', _, used) <- lcheck rig erase env tm
-         log "quantity" 5 $ "Used: " ++ show used
-         when (not erase) $ checkEnvUsage fc [<] rig env used tm'
-         pure tm'
+                 _ => rig_in
+
+  lcheck rig env (App fc fn q arg)
+      = do logC "quantity" 15 $ do pure "lcheck App \{show !(toFullNames fn)} \{show !(toFullNames arg)}"
+           uf <- logDepth $ lcheck rig env fn
+           ua <- logDepth $ lcheck (rigMult rig q) env arg
+           pure (combine fc uf ua)
+  lcheck rig env (As fc s var pat)
+      = lcheck rig env pat
+  lcheck rig env (Case fc t scrig sc ty alts)
+      = do usc <- logDepth $ lcheck (rigMult scrig rig) env sc
+           ualts <- lcheckAlts fc (presence rig) (restrictEnv env rig) scrig alts
+           pure (combine fc usc ualts)
+  lcheck rig env (TDelayed fc r tm) = logDepth $ lcheck rig env tm
+  lcheck rig env (TDelay fc r ty arg) = logDepth $ lcheck rig env arg
+  lcheck rig env (TForce fc r tm) = logDepth $ lcheck rig env tm
+  lcheck rig env (PrimVal fc c) = hdone fc
+  lcheck rig env (PrimOp fc fn args)
+     = do us <- logDepth $ traverseVect (\a => logDepth $ lcheck rig env a) args
+          pure (concat fc (toList us))
+  lcheck rig env (Erased _ (Dotted t)) = logDepth $ lcheck rig env t
+  lcheck rig env (Erased fc _) = hdone fc
+  lcheck rig env (Unmatched fc _) = hdone fc
+  lcheck rig env (TType fc _) = hdone fc
+
+  checkEnvUsage : {vars, done : _} ->
+                  FC -> RigCount ->
+                  Env Term vars -> HoleUsage (vars ++ done) ->
+                  Term (vars ++ done) ->
+                  Core ()
+  checkEnvUsage fc rig [<] usage tm = pure ()
+  checkEnvUsage {done} {vars = xs :< nm} fc rig (bs :< b) usage tm
+      = do let pos = localPrf {later=done} {vars=xs} {n=nm}
+           let used_in = count (varIdx pos) usage
+           -- Adjust usage count depending on holes, as we do when
+           -- checking binders
+           holeFound <- if isLinear (multiplicity b)
+                           then updateHoleUsage pos VarSet.empty [<] usage
+                           else pure False
+           let used = if isLinear (rigMult (multiplicity b) rig) &&
+                         holeFound && used_in == 0
+                         then 1
+                         else used_in
+           checkUsageOK fc used nm (rigMult (multiplicity b) rig)
+           checkEnvUsage {done = [<nm] ++ done} fc rig bs
+                   (rewrite appendAssociative xs [<nm] done in usage)
+                   (rewrite appendAssociative xs [<nm] done in tm)
+
+  export
+  linearCheck : {vars : _} ->
+                FC -> RigCount ->
+                Env Term vars -> Term vars -> Core ()
+  linearCheck fc rig env tm
+      = do logTerm "quantity" 5 "Linearity check on " tm
+           logEnv "quantity" 5 "In env" env
+           used <- logDepth $ lcheck rig env tm
+           log "quantity" 5 $ "Used: " ++ show used
+           checkEnvUsage {done = [<]} fc rig env used tm
diff --git a/src/Core/Metadata.idr b/src/Core/Metadata.idr
index d75452e62a7..26cd05f755a 100644
--- a/src/Core/Metadata.idr
+++ b/src/Core/Metadata.idr
@@ -3,9 +3,12 @@ module Core.Metadata
 import Core.Binary
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
 import Core.TTC
 
+import Core.Evaluate.Normalise
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+
 import System.File
 import Libraries.Data.NatSet
 import Libraries.Data.PosMap
@@ -200,9 +203,9 @@ addLHS loc outerenvlen env tm
 
   where
     toPat : Env Term vs -> Env Term vs
-    toPat (Lam fc c p ty :: bs) = PVar fc c p ty :: toPat bs
-    toPat (b :: bs) = b :: toPat bs
-    toPat [] = []
+    toPat (bs :< Lam fc c p ty) = Env.bind (toPat bs) $ PVar fc c p ty
+    toPat (bs :< b) = Env.bind (toPat bs) b
+    toPat [<] = Env.empty
 
 -- For giving local variable names types, just substitute the name
 -- rather than storing the whole environment, otherwise we'll repeatedly
@@ -214,8 +217,8 @@ addLHS loc outerenvlen env tm
 -- types directly!
 substEnv : {vars : _} ->
            FC -> Env Term vars -> (tm : Term vars) -> ClosedTerm
-substEnv loc [] tm = tm
-substEnv {vars = x :: _} loc (b :: env) tm
+substEnv loc [<] tm = tm
+substEnv {vars = _ :< x} loc (env :< b) tm
     = substEnv loc env (subst (Ref loc Bound x) tm)
 
 export
@@ -352,7 +355,8 @@ normaliseTypes
     nfType : Defs -> (NonEmptyFC, (Name, Nat, ClosedTerm)) ->
              Core (NonEmptyFC, (Name, Nat, ClosedTerm))
     nfType defs (loc, (n, len, ty))
-       = pure (loc, (n, len, !(normaliseArgHoles defs Env.empty ty)))
+      -- See nfHolesArgs at elabTermSub of TTImp.Elab
+       = pure (loc, (n, len, !(quote Env.empty !(nfHolesArgs Env.empty ty))))
 
 record TTMFile where
   constructor MkTTMFile
diff --git a/src/Core/Name.idr b/src/Core/Name.idr
index 542d116fcea..76880febd4e 100644
--- a/src/Core/Name.idr
+++ b/src/Core/Name.idr
@@ -414,9 +414,9 @@ nameEq (Resolved x) (Resolved y) = L.maybeCong Resolved (L.maybeEq x y)
 nameEq _ _ = Nothing
 
 export
-namesEq : (xs, ys : List Name) -> Maybe (xs = ys)
-namesEq [] [] = Just Refl
-namesEq (x :: xs) (y :: ys) = L.maybeCong2 (::) (nameEq x y) (namesEq xs ys)
+namesEq : (xs, ys : SnocList Name) -> Maybe (xs = ys)
+namesEq [<] [<] = Just Refl
+namesEq (xs :< x) (ys :< y) = L.maybeCong2 (:<) (namesEq xs ys) (nameEq x y)
 namesEq _ _ = Nothing
 
 ||| Generate the next machine name
diff --git a/src/Core/Name/Namespace.idr b/src/Core/Name/Namespace.idr
index 9067eb0564a..8dc40cea2a3 100644
--- a/src/Core/Name/Namespace.idr
+++ b/src/Core/Name/Namespace.idr
@@ -2,7 +2,9 @@ module Core.Name.Namespace
 
 import Data.List
 import Data.String
+
 import Decidable.Equality
+
 import Libraries.Data.String.Extra
 import Libraries.Text.PrettyPrint.Prettyprinter
 import Libraries.Utils.Path
@@ -206,14 +208,9 @@ export
 DecEq Namespace where
   decEq (MkNS ms) (MkNS ns) = decEqCong (decEq ms ns)
 
--- TODO: move somewhere more appropriate
-export
-showSep : String -> List String -> String
-showSep sep = Libraries.Data.String.Extra.join sep
-
 export
 showNSWithSep : String -> Namespace -> String
-showNSWithSep sep (MkNS ns) = showSep sep (reverse ns)
+showNSWithSep sep (MkNS ns) = joinBy sep (reverse ns)
 
 export
 Show Namespace where
diff --git a/src/Core/Name/Scoped.idr b/src/Core/Name/Scoped.idr
index 9eb207e7557..cdad67d6c9c 100644
--- a/src/Core/Name/Scoped.idr
+++ b/src/Core/Name/Scoped.idr
@@ -1,10 +1,14 @@
 module Core.Name.Scoped
 
 import public Core.Name
+import Core.Name.CompatibleVars
 
-import Libraries.Data.List.SizeOf
+import Data.SnocList
 
 import public Libraries.Data.List.Thin
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.HasLength
+import Libraries.Data.List.SizeOf
 
 %default total
 
@@ -14,7 +18,7 @@ import public Libraries.Data.List.Thin
 ||| Something which is having similar order as Scope itself
 public export
 Scopeable : (a: Type) -> Type
-Scopeable = List
+Scopeable = SnocList
 
 ||| A scope is represented by a list of names. E.g. in the following
 ||| rule, the scope Γ is extended with x when going under the λx.
@@ -30,28 +34,23 @@ Scope = Scopeable Name
 namespace Scope
   public export
   empty : Scopeable a
-  empty = []
+  empty = [<]
 
-  {-
   public export
   ext : Scopeable a -> List a -> Scopeable a
-  ext vars ns = ns ++ vars
-  --- TODO replace by `vars <>< ns`
-  -}
+  ext vars ns = vars <>< ns
 
   public export
   addInner : Scopeable a -> Scopeable a -> Scopeable a
-  addInner vars inner = inner ++ vars
-  --- TODO replace by `vars ++ inner`
+  addInner vars inner = vars ++ inner
 
   public export
   bind : Scopeable a -> a -> Scopeable a
-  bind vars n = n :: vars
-  --- TODO replace with `<:`
+  bind vars n = vars :< n
 
   public export
   single : a -> Scopeable a
-  single n = [n]
+  single n = [<n]
 
 ||| A scoped definition is one indexed by a scope
 public export
@@ -63,13 +62,22 @@ Scoped = Scope -> Type
 
 export
 scopeEq : (xs, ys : Scope) -> Maybe (xs = ys)
-scopeEq [] [] = Just Refl
-scopeEq (x :: xs) (y :: ys)
+scopeEq [<] [<] = Just Refl
+scopeEq (xs :< x) (ys :< y)
     = do Refl <- nameEq x y
          Refl <- scopeEq xs ys
          Just Refl
 scopeEq _ _ = Nothing
 
+export
+localEq : (xs, ys : List Name) -> Maybe (xs = ys)
+localEq [] [] = Just Refl
+localEq (x :: xs) (y :: ys)
+    = do Refl <- nameEq x y
+         Refl <- localEq xs ys
+         Just Refl
+localEq _ _ = Nothing
+
 ------------------------------------------------------------------------
 -- Generate a fresh name (for a given scope)
 
@@ -80,68 +88,23 @@ mkFresh vs n
     then assert_total $ mkFresh vs (next n)
     else n
 
-
-------------------------------------------------------------------------
--- Compatible variables
-
-public export
-data CompatibleVars : (xs, ys : List a) -> Type where
-   Pre : CompatibleVars xs xs
-   Ext : CompatibleVars xs ys -> CompatibleVars (n :: xs) (m :: ys)
-
-export
-invertExt : CompatibleVars (n :: xs) (m :: ys) -> CompatibleVars xs ys
-invertExt Pre = Pre
-invertExt (Ext p) = p
-
-export
-extendCompats : (args : List a) ->
-                CompatibleVars xs ys ->
-                CompatibleVars (args ++ xs) (args ++ ys)
-extendCompats args Pre = Pre
-extendCompats args prf = go args prf where
-
-  go : (args : List a) ->
-       CompatibleVars xs ys ->
-       CompatibleVars (args ++ xs) (args ++ ys)
-  go [] prf = prf
-  go (x :: xs) prf = Ext (go xs prf)
-
-export
-decCompatibleVars : (xs, ys : List a) -> Dec (CompatibleVars xs ys)
-decCompatibleVars [] [] = Yes Pre
-decCompatibleVars [] (x :: xs) = No (\case p impossible)
-decCompatibleVars (x :: xs) [] = No (\case p impossible)
-decCompatibleVars (x :: xs) (y :: ys) = case decCompatibleVars xs ys of
-  Yes prf => Yes (Ext prf)
-  No nprf => No (nprf . invertExt)
-
-export
-areCompatibleVars : (xs, ys : List a) ->
-                    Maybe (CompatibleVars xs ys)
-areCompatibleVars [] [] = pure Pre
-areCompatibleVars (x :: xs) (y :: ys)
-    = do compat <- areCompatibleVars xs ys
-         pure (Ext compat)
-areCompatibleVars _ _ = Nothing
-
 ------------------------------------------------------------------------
 -- Concepts
 
 public export
-0 Weakenable : Scoped -> Type
-Weakenable tm = {0 vars, ns : Scope} ->
-  SizeOf ns -> tm vars -> tm (ns ++ vars)
+0 Weakenable : (Scopeable a -> Type) -> Type
+Weakenable tm = {0 outer, inner : Scopeable a} ->
+  SizeOf inner -> tm outer -> tm (Scope.addInner outer inner)
 
 public export
-0 Strengthenable : Scoped -> Type
-Strengthenable tm = {0 vars, ns : Scope} ->
-  SizeOf ns -> tm (ns ++ vars) -> Maybe (tm vars)
+0 Strengthenable : (Scopeable a -> Type) -> Type
+Strengthenable tm = {0 outer, inner : Scopeable a} ->
+  SizeOf inner -> tm (Scope.addInner outer inner) -> Maybe (tm outer)
 
 public export
-0 GenWeakenable : Scoped -> Type
-GenWeakenable tm = {0 outer, ns, local : Scope} ->
-  SizeOf local -> SizeOf ns -> tm (local ++ outer) -> tm (local ++ (ns ++ outer))
+0 GenWeakenable : (Scopeable a -> Type) -> Type
+GenWeakenable tm = {0 outer, middle, inner : Scopeable a} ->
+  SizeOf middle -> SizeOf inner -> tm (Scope.addInner outer inner) -> tm (Scope.addInner (Scope.addInner outer middle) inner)
 
 public export
 0 Thinnable : Scoped -> Type
@@ -153,30 +116,49 @@ Shrinkable tm = {0 xs, ys : Scope} -> tm xs -> Thin ys xs -> Maybe (tm ys)
 
 public export
 0 Embeddable : Scoped -> Type
-Embeddable tm = {0 outer, vars : Scope} -> tm vars -> tm (vars ++ outer)
+Embeddable tm = {0 outer, vars : Scope} -> tm vars -> tm (Scope.addInner outer vars)
 
 ------------------------------------------------------------------------
 -- IsScoped interface
 
 public export
-interface Weaken (0 tm : Scoped) where
+interface Weaken (0 tm : Scopeable a -> Type) | tm where
   constructor MkWeaken
   -- methods
-  weaken : tm vars -> tm (nm :: vars)
+  weaken : tm vars -> tm (Scope.bind vars nm)
   weakenNs : Weakenable tm
   -- default implementations
   weaken = weakenNs (suc zero)
+  weakenNs p t = case sizedView p of
+    Z   => t
+    S p => weaken (weakenNs p t)
 
 -- This cannot be merged with Weaken because of WkCExp
 public export
-interface GenWeaken (0 tm : Scoped) where
+interface GenWeaken (0 tm : Scopeable a -> Type) | tm where
   constructor MkGenWeaken
   genWeakenNs : GenWeakenable tm
 
 export
 genWeaken : GenWeaken tm =>
-  SizeOf local -> tm (local ++ outer) -> tm (local ++ n :: outer)
-genWeaken l = genWeakenNs l (suc zero)
+  SizeOf inner -> tm (Scope.addInner outer inner) -> tm (Scope.addInner (Scope.bind outer n) inner)
+genWeaken = genWeakenNs (suc zero)
+
+export
+genWeakenFishily : GenWeaken tm =>
+  SizeOf outer -> tm (Scope.ext local outer) -> tm (Scope.ext (Scope.bind local n) outer)
+genWeakenFishily
+    = rewrite fishAsSnocAppend local outer in
+      rewrite fishAsSnocAppend (local :<n) outer in
+      genWeaken . cast
+
+export
+weakensN : Weaken tm =>
+  {0 vars : Scopeable a} -> {0 ns : List a} ->
+  SizeOf ns -> tm vars -> tm (vars <>< ns)
+weakensN s t
+  = rewrite fishAsSnocAppend vars ns in
+    weakenNs (zero <>< s) t
 
 public export
 interface Strengthen (0 tm : Scoped) where
@@ -185,9 +167,17 @@ interface Strengthen (0 tm : Scoped) where
   strengthenNs : Strengthenable tm
 
 export
-strengthen : Strengthen tm => tm (nm :: vars) -> Maybe (tm vars)
+strengthen : Strengthen tm => tm (Scope.bind vars nm) -> Maybe (tm vars)
 strengthen = strengthenNs (suc zero)
 
+export
+strengthensN :
+  Strengthen tm => SizeOf ns ->
+  tm (Scope.ext vars ns) -> Maybe (tm vars)
+strengthensN s t
+  = strengthenNs (zero <>< s)
+  $ rewrite sym $ fishAsSnocAppend vars ns in t
+
 public export
 interface FreelyEmbeddable (0 tm : Scoped) where
   constructor MkFreelyEmbeddable
@@ -195,6 +185,10 @@ interface FreelyEmbeddable (0 tm : Scoped) where
   embed : Embeddable tm
   embed = believe_me
 
+export
+embedFishily : FreelyEmbeddable tm => tm (cast ns) -> tm (Scope.ext vars ns)
+embedFishily t = rewrite fishAsSnocAppend vars ns in embed t
+
 export
 FunctorFreelyEmbeddable : Functor f => FreelyEmbeddable tm => FreelyEmbeddable (f . tm)
 FunctorFreelyEmbeddable = MkFreelyEmbeddable believe_me
@@ -209,7 +203,7 @@ MaybeFreelyEmbeddable = FunctorFreelyEmbeddable
 
 export
 GenWeakenWeakens : GenWeaken tm => Weaken tm
-GenWeakenWeakens = MkWeaken (genWeakenNs zero (suc zero)) (genWeakenNs zero)
+GenWeakenWeakens = MkWeaken (genWeakenNs (suc zero) zero) (flip genWeakenNs zero)
 
 export
 FunctorGenWeaken : Functor f => GenWeaken tm => GenWeaken (f . tm)
@@ -239,5 +233,5 @@ interface Weaken tm => IsScoped (0 tm : Scoped) where
   shrink : Shrinkable tm
 
 export
-compat : IsScoped tm => tm (m :: xs) -> tm (n :: xs)
+compat : IsScoped tm => tm (Scope.bind xs m) -> tm (Scope.bind xs n)
 compat = compatNs (Ext Pre)
diff --git a/src/Core/Normalise.idr b/src/Core/Normalise.idr
deleted file mode 100644
index e64610aada5..00000000000
--- a/src/Core/Normalise.idr
+++ /dev/null
@@ -1,347 +0,0 @@
-module Core.Normalise
-
-import public Core.Normalise.Convert
-import public Core.Normalise.Eval
-import public Core.Normalise.Quote
-
-import Core.Context.Log
-import Core.Env
-import Core.Value
-
-%default covering
-
--- Expand all the pi bindings at the start of a term, but otherwise don't
--- reduce
-export
-normalisePis : {auto c : Ref Ctxt Defs} ->
-               {vars : Scope} ->
-               Defs -> Env Term vars -> Term vars -> Core (Term vars)
-normalisePis defs env tm
-    = do tmnf <- nf defs env tm
-         case tmnf of
-              NBind _ _ (Pi {}) _ => quoteWithPi defs env tmnf
-              _ => pure tm
-
-export
-glueBack : {auto c : Ref Ctxt Defs} ->
-           {vars : _} ->
-           Defs -> Env Term vars -> NF vars -> Glued vars
-glueBack defs env nf
-    = MkGlue False
-             (do empty <- clearDefs defs
-                 quote empty env nf)
-             (const (pure nf))
-
-export
-glueClosure : {auto c : Ref Ctxt Defs} ->
-              {vars : _} ->
-              Defs -> Env Term vars -> Closure vars -> Glued vars
-glueClosure defs env clos
-    = MkGlue False
-             (do empty <- clearDefs defs
-                 quote empty env clos)
-             (const (evalClosure defs clos))
-
-export
-normalise : {auto c : Ref Ctxt Defs} ->
-            {free : _} ->
-            Defs -> Env Term free -> Term free -> Core (Term free)
-normalise defs env tm = quote defs env !(nf defs env tm)
-
-export
-normaliseOpts : {auto c : Ref Ctxt Defs} ->
-                {free : _} ->
-                EvalOpts -> Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseOpts opts defs env tm
-    = quote defs env !(nfOpts opts defs env tm)
-
-export
-normaliseHoles : {auto c : Ref Ctxt Defs} ->
-                 {free : _} ->
-                 Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseHoles defs env tm
-    = quote defs env !(nfOpts withHoles defs env tm)
-
-export
-normaliseLHS : {auto c : Ref Ctxt Defs} ->
-               {free : _} ->
-               Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseLHS defs env (Bind fc n b sc)
-    = pure $ Bind fc n b !(normaliseLHS defs (b :: env) sc)
-normaliseLHS defs env tm
-    = quote defs env !(nfOpts onLHS defs env tm)
-
-export
-tryNormaliseSizeLimit : {auto c : Ref Ctxt Defs} ->
-                     {free : _} ->
-                     Defs -> Nat ->
-                     Env Term free -> Term free -> Core (Term free)
-tryNormaliseSizeLimit defs limit env tm
-    = do tm' <- nf defs env tm
-         quoteOpts (MkQuoteOpts False False (Just limit)) defs env tm'
-
--- The size limit here is the depth of stuck applications. If it gets past
--- that size, return the original
-export
-normaliseSizeLimit : {auto c : Ref Ctxt Defs} ->
-                     {free : _} ->
-                     Defs -> Nat ->
-                     Env Term free -> Term free -> Core (Term free)
-normaliseSizeLimit defs limit env tm
-    = catch (do tm' <- nf defs env tm
-                quoteOpts (MkQuoteOpts False False (Just limit)) defs env tm')
-            (\err => pure tm)
-
-export
-normaliseArgHoles : {auto c : Ref Ctxt Defs} ->
-                    {free : _} ->
-                    Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseArgHoles defs env tm
-    = quote defs env !(nfOpts withArgHoles defs env tm)
-
-export
-normaliseAll : {auto c : Ref Ctxt Defs} ->
-               {free : _} ->
-               Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseAll defs env tm
-    = quote defs env !(nfOpts withAll defs env tm)
-
--- Normalise, but without normalising the types of binders. Dealing with
--- binders is the slow part of normalisation so whenever we can avoid it, it's
--- a big win
-export
-normaliseScope : {auto c : Ref Ctxt Defs} ->
-                 {free : _} ->
-                 Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseScope defs env (Bind fc n b sc)
-    = pure $ Bind fc n b !(normaliseScope defs (b :: env) sc)
-normaliseScope defs env tm = normalise defs env tm
-
-export
-etaContract : {auto _ : Ref Ctxt Defs} ->
-              {vars : _} -> Term vars -> Core (Term vars)
-etaContract tm = do
-  defs <- get Ctxt
-  logTerm "eval.eta" 5 "Attempting to eta contract subterms of" tm
-  nf <- normalise defs (mkEnv EmptyFC _) tm
-  logTerm "eval.eta" 5 "Evaluated to" nf
-  res <- mapTermM act tm
-  logTerm "eval.eta" 5 "Result of eta-contraction" res
-  pure res
-
-   where
-
-    act : {vars : _} -> Term vars -> Core (Term vars)
-    act tm = do
-      logTerm "eval.eta" 10 "  Considering" tm
-      case tm of
-        (Bind _ x (Lam {}) (App _ fn (Local _ _ Z _))) => do
-          logTerm "eval.eta" 10 "  Shrinking candidate" fn
-          let shrunk = shrink fn (Drop Refl)
-          case shrunk of
-            Nothing => do
-              log "eval.eta" 10 "  Failure!"
-              pure tm
-            Just tm' => do
-              logTerm "eval.eta" 10 "  Success!" tm'
-              pure tm'
-        _ => pure tm
-
-export
-getValArity : Defs -> Env Term vars -> NF vars -> Core Nat
-getValArity defs env (NBind fc x (Pi {}) sc)
-    = pure (S !(getValArity defs env !(sc defs (toClosure defaultOpts env (Erased fc Placeholder)))))
-getValArity defs env val = pure 0
-
-export
-getArity : {auto c : Ref Ctxt Defs} ->
-           {vars : _} ->
-           Defs -> Env Term vars -> Term vars -> Core Nat
-getArity defs env tm = getValArity defs env !(nf defs env tm)
-
--- Log message with a value, translating back to human readable names first
-export
-logNF : {vars : _} ->
-        {auto c : Ref Ctxt Defs} ->
-        LogTopic -> Nat -> Lazy String -> Env Term vars -> NF vars -> Core ()
-logNF s n msg env tmnf
-    = when !(logging s n) $
-        do defs <- get Ctxt
-           tm <- quote defs env tmnf
-           tm' <- toFullNames tm
-           logString s.topic n (msg ++ ": " ++ show tm')
-
--- Log message with a term, reducing holes and translating back to human
--- readable names first
-export
-logTermNF' : {vars : _} ->
-             {auto c : Ref Ctxt Defs} ->
-             LogTopic ->
-             Nat -> Lazy String -> Env Term vars -> Term vars -> Core ()
-logTermNF' s n msg env tm
-    = do defs <- get Ctxt
-         tmnf <- normaliseHoles defs env tm
-         tm' <- toFullNames tmnf
-         logString s.topic n (msg ++ ": " ++ show tm')
-
-export
-logTermNF : {vars : _} ->
-            {auto c : Ref Ctxt Defs} ->
-            LogTopic ->
-            Nat -> Lazy String -> Env Term vars -> Term vars -> Core ()
-logTermNF s n msg env tm
-    = when !(logging s n) $ logTermNF' s n msg env tm
-
-export
-logGlue : {vars : _} ->
-          {auto c : Ref Ctxt Defs} ->
-          LogTopic ->
-          Nat -> Lazy String -> Glued vars -> Core ()
-logGlue s n msg gtm
-    = when !(logging s n) $
-        do defs <- get Ctxt
-           tm <- getTerm gtm
-           tm' <- toFullNames tm
-           logString s.topic n (msg ++ ": " ++ show tm')
-
-export
-logGlueNF : {vars : _} ->
-            {auto c : Ref Ctxt Defs} ->
-            LogTopic ->
-            Nat -> Lazy String -> Env Term vars -> Glued vars -> Core ()
-logGlueNF s n msg env gtm
-    = when !(logging s n) $
-        do defs <- get Ctxt
-           tm <- getTerm gtm
-           tmnf <- normaliseHoles defs env tm
-           tm' <- toFullNames tmnf
-           logString s.topic n (msg ++ ": " ++ show tm')
-
-export
-logEnv : {vars : _} ->
-         {auto c : Ref Ctxt Defs} ->
-         LogTopic ->
-         Nat -> String -> Env Term vars -> Core ()
-logEnv s n msg env
-    = when !(logging s n) $
-        do logString s.topic n msg
-           dumpEnv env
-
-  where
-
-    dumpEnv : {vs : Scope} -> Env Term vs -> Core ()
-    dumpEnv [] = pure ()
-    dumpEnv {vs = x :: _} (Let _ c val ty :: bs)
-        = do logTermNF' s n (msg ++ ": let " ++ show x) bs val
-             logTermNF' s n (msg ++ ":" ++ show c ++ " " ++ show x) bs ty
-             dumpEnv bs
-    dumpEnv {vs = x :: _} (b :: bs)
-        = do logTermNF' s n (msg ++ ":" ++ show (multiplicity b) ++ " " ++
-                           show (piInfo b) ++ " " ++
-                           show x) bs (binderType b)
-             dumpEnv bs
-replace' : {auto c : Ref Ctxt Defs} ->
-           {vars : _} ->
-           Int -> Defs -> Env Term vars ->
-           (lhs : NF vars) -> (parg : Term vars) -> (exp : NF vars) ->
-           Core (Term vars)
-replace' {vars} tmpi defs env lhs parg tm
-    = if !(convert defs env lhs tm)
-         then pure parg
-         else repSub tm
-  where
-    repArg : (Closure vars) -> Core (Term vars)
-    repArg c
-        = do tmnf <- evalClosure defs c
-             replace' tmpi defs env lhs parg tmnf
-
-    repSub : NF vars -> Core (Term vars)
-    repSub (NBind fc x b scfn)
-        = do b' <- traverse (\c => repSub !(evalClosure defs c)) b
-             let x' = MN "tmp" tmpi
-             sc' <- replace' (tmpi + 1) defs env lhs parg
-                             !(scfn defs (toClosure defaultOpts env (Ref fc Bound x')))
-             pure (Bind fc x b' (refsToLocals (Add x x' None) sc'))
-    repSub (NApp fc hd [])
-        = do empty <- clearDefs defs
-             quote empty env (NApp fc hd [])
-    repSub (NApp fc hd args)
-        = do args' <- traverse (traversePair repArg) args
-             pure $ applyStackWithFC
-                        !(replace' tmpi defs env lhs parg (NApp fc hd []))
-                        args'
-    repSub (NDCon fc n t a args)
-        = do args' <- traverse (traversePair repArg) args
-             empty <- clearDefs defs
-             pure $ applyStackWithFC
-                        !(quote empty env (NDCon fc n t a []))
-                        args'
-    repSub (NTCon fc n a args)
-        = do args' <- traverse (traversePair repArg) args
-             empty <- clearDefs defs
-             pure $ applyStackWithFC
-                        !(quote empty env (NTCon fc n a []))
-                        args'
-    repSub (NAs fc s a p)
-        = do a' <- repSub a
-             p' <- repSub p
-             pure (As fc s a' p')
-    repSub (NDelayed fc r tm)
-        = do tm' <- repSub tm
-             pure (TDelayed fc r tm')
-    repSub (NDelay fc r ty tm)
-        = do ty' <- replace' tmpi defs env lhs parg !(evalClosure defs ty)
-             tm' <- replace' tmpi defs env lhs parg !(evalClosure defs tm)
-             pure (TDelay fc r ty' tm')
-    repSub (NForce fc r tm args)
-        = do args' <- traverse (traversePair repArg) args
-             tm' <- repSub tm
-             pure $ applyStackWithFC (TForce fc r tm') args'
-    repSub (NErased fc (Dotted t))
-        = do t' <- repSub t
-             pure (Erased fc (Dotted t'))
-    repSub tm = do empty <- clearDefs defs
-                   quote empty env tm
-
-export
-replace : {auto c : Ref Ctxt Defs} ->
-          {vars : _} ->
-          Defs -> Env Term vars ->
-          (orig : NF vars) -> (new : Term vars) -> (tm : NF vars) ->
-          Core (Term vars)
-replace = replace' 0
-
--- If the term is an application of a primitive conversion (fromInteger etc)
--- and it's applied to a constant, fully normalise the term.
-export
-normalisePrims : {auto c : Ref Ctxt Defs} -> {vs : _} ->
-                 -- size heuristic for when to unfold
-                 (Constant -> Bool) ->
-                 -- view to check whether an argument is a constant
-                 (arg -> Maybe Constant) ->
-                 -- Reduce everything (True) or just public export (False)
-                 Bool ->
-                 -- list of primitives
-                 List Name ->
-                 -- view of the potential redex
-                 (n : Name) ->          -- function name
-                 (args : List arg) ->   -- arguments from inside out (arg1, ..., argk)
-                 -- actual term to evaluate if needed
-                 (tm : Term vs) ->      -- original term (n arg1 ... argk)
-                 Env Term vs ->         -- evaluation environment
-                 -- output only evaluated if primitive
-                 Core (Maybe (Term vs))
-normalisePrims boundSafe viewConstant all prims n args tm env
-   = do let True = isPrimName prims !(getFullName n) -- is a primitive
-              | _ => pure Nothing
-        let (mc :: _) = reverse args -- with at least one argument
-              | _ => pure Nothing
-        let (Just c) = viewConstant mc -- that is a constant
-              | _ => pure Nothing
-        let True = boundSafe c -- that we should expand
-              | _ => pure Nothing
-        defs <- get Ctxt
-        tm <- if all
-                 then normaliseAll defs env tm
-                 else normalise defs env tm
-        pure (Just tm)
diff --git a/src/Core/Normalise/Convert.idr b/src/Core/Normalise/Convert.idr
deleted file mode 100644
index 8f65a4a4a3f..00000000000
--- a/src/Core/Normalise/Convert.idr
+++ /dev/null
@@ -1,437 +0,0 @@
-module Core.Normalise.Convert
-
-import public Core.Normalise.Eval
-import public Core.Normalise.Quote
-
-import Core.Case.CaseTree
-import Core.Context
-import Core.Env
-import Core.Value
-
-import Libraries.Data.NatSet
-import Libraries.Data.List.SizeOf
-
-%default covering
-
-public export
-interface Convert tm where
-  convert : {auto c : Ref Ctxt Defs} ->
-            {vars : Scope} ->
-            Defs -> Env Term vars ->
-            tm vars -> tm vars -> Core Bool
-  convertInf : {auto c : Ref Ctxt Defs} ->
-               {vars : Scope} ->
-               Defs -> Env Term vars ->
-               tm vars -> tm vars -> Core Bool
-
-  convGen : {auto c : Ref Ctxt Defs} ->
-            {vars : _} ->
-            Ref QVar Int ->
-            Bool -> -- skip forced arguments (must have checked the type
-                    -- elsewhere first)
-            Defs -> Env Term vars ->
-            tm vars -> tm vars -> Core Bool
-
-  convert defs env tm tm'
-      = do q <- newRef QVar 0
-           convGen q False defs env tm tm'
-
-  convertInf defs env tm tm'
-      = do q <- newRef QVar 0
-           convGen q True defs env tm tm'
-
-tryUpdate : {vars, vars' : _} ->
-            List (Var vars, Var vars') ->
-            Term vars -> Maybe (Term vars')
-tryUpdate ms (Local fc l idx p)
-    = do MkVar p' <- findIdx ms (MkVar p)
-         pure $ Local fc l _ p'
-  where
-    findIdx : List (Var vars, Var vars') -> Var vars -> Maybe (Var vars')
-    findIdx [] _ = Nothing
-    findIdx ((old, v) :: ps) n
-        = if old == n then Just v else findIdx ps n
-tryUpdate ms (Ref fc nt n) = pure $ Ref fc nt n
-tryUpdate ms (Meta fc n i args) = pure $ Meta fc n i !(traverse (tryUpdate ms) args)
-tryUpdate ms (Bind fc x b sc)
-    = do b' <- tryUpdateB b
-         pure $ Bind fc x b' !(tryUpdate (map weakenP ms) sc)
-  where
-    tryUpdatePi : PiInfo (Term vars) -> Maybe (PiInfo (Term vars'))
-    tryUpdatePi Explicit = pure Explicit
-    tryUpdatePi Implicit = pure Implicit
-    tryUpdatePi AutoImplicit = pure AutoImplicit
-    tryUpdatePi (DefImplicit t) = pure $ DefImplicit !(tryUpdate ms t)
-
-    tryUpdateB : Binder (Term vars) -> Maybe (Binder (Term vars'))
-    tryUpdateB (Lam fc r p t) = pure $ Lam fc r !(tryUpdatePi p) !(tryUpdate ms t)
-    tryUpdateB (Let fc r v t) = pure $ Let fc r !(tryUpdate ms v) !(tryUpdate ms t)
-    tryUpdateB (Pi fc r p t) = pure $ Pi fc r !(tryUpdatePi p) !(tryUpdate ms t)
-    tryUpdateB _ = Nothing
-
-    weakenP : {n : _} -> (Var vars, Var vars') ->
-              (Var (n :: vars), Var (n :: vars'))
-    weakenP (v, vs) = (weaken v, weaken vs)
-tryUpdate ms (App fc f a) = pure $ App fc !(tryUpdate ms f) !(tryUpdate ms a)
-tryUpdate ms (As fc s a p) = pure $ As fc s !(tryUpdate ms a) !(tryUpdate ms p)
-tryUpdate ms (TDelayed fc r tm) = pure $ TDelayed fc r !(tryUpdate ms tm)
-tryUpdate ms (TDelay fc r ty tm) = pure $ TDelay fc r !(tryUpdate ms ty) !(tryUpdate ms tm)
-tryUpdate ms (TForce fc r tm) = pure $ TForce fc r !(tryUpdate ms tm)
-tryUpdate ms (PrimVal fc c) = pure $ PrimVal fc c
-tryUpdate ms (Erased fc a) = Erased fc <$> traverse (tryUpdate ms) a
-tryUpdate ms (TType fc u) = pure $ TType fc u
-
-mutual
-  allConvNF : {auto c : Ref Ctxt Defs} ->
-              {vars : _} ->
-              Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-              List (NF vars) -> List (NF vars) -> Core Bool
-  allConvNF q i defs env [] [] = pure True
-  allConvNF q i defs env (x :: xs) (y :: ys)
-      = do ok <- allConvNF q i defs env xs ys
-           if ok then convGen q i defs env x y
-                 else pure False
-  allConvNF q i defs env _ _ = pure False
-
-  -- return False if anything differs at the head, to quickly find
-  -- conversion failures without going deeply into all the arguments.
-  -- True means they might still match
-  quickConv : List (NF vars) -> List (NF vars) -> Bool
-  quickConv [] [] = True
-  quickConv (x :: xs) (y :: ys) = quickConvArg x y && quickConv xs ys
-    where
-      quickConvHead : NHead vars -> NHead vars -> Bool
-      quickConvHead (NLocal {}) (NLocal {}) = True
-      quickConvHead (NRef _ n) (NRef _ n') = n == n'
-      quickConvHead (NMeta n _ _) (NMeta n' _ _) = n == n'
-      quickConvHead _ _ = False
-
-      quickConvArg : NF vars -> NF vars -> Bool
-      quickConvArg (NBind {}) _ = True -- let's not worry about eta here...
-      quickConvArg _ (NBind {}) = True
-      quickConvArg (NApp _ h _) (NApp _ h' _) = quickConvHead h h'
-      quickConvArg (NDCon _ _ t _ _) (NDCon _ _ t' _ _) = t == t'
-      quickConvArg (NTCon _ n _ _) (NTCon _ n' _ _) = n == n'
-      quickConvArg (NAs _ _ _ t) (NAs _ _ _ t') = quickConvArg t t'
-      quickConvArg (NDelayed _ _ t) (NDelayed _ _ t') = quickConvArg t t'
-      quickConvArg (NDelay {}) (NDelay {}) = True
-      quickConvArg (NForce _ _ t _) (NForce _ _ t' _) = quickConvArg t t'
-      quickConvArg (NPrimVal _ c) (NPrimVal _ c') = c == c'
-      quickConvArg (NType {}) (NType {}) = True
-      quickConvArg (NErased {}) _ = True
-      quickConvArg _ (NErased {}) = True
-      quickConvArg _ _ = False
-  quickConv _ _ = False
-
-  allConv : {auto c : Ref Ctxt Defs} ->
-            {vars : _} ->
-            Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-            List (Closure vars) -> List (Closure vars) -> Core Bool
-  allConv q i defs env xs ys
-      = do xsnf <- traverse (evalClosure defs) xs
-           ysnf <- traverse (evalClosure defs) ys
-           if quickConv xsnf ysnf
-              then allConvNF q i defs env xsnf ysnf
-              else pure False
-
-  -- If the case trees match in structure, get the list of variables which
-  -- have to match in the call
-  getMatchingVarAlt : {auto c : Ref Ctxt Defs} ->
-                      {args, args' : _} ->
-                      Defs ->
-                      List (Var args, Var args') ->
-                      CaseAlt args -> CaseAlt args' ->
-                      Core (Maybe (List (Var args, Var args')))
-  getMatchingVarAlt defs ms (ConCase n tag cargs t) (ConCase n' tag' cargs' t')
-      = if n == n'
-           then do let Just ms' = extend cargs cargs' ms
-                        | Nothing => pure Nothing
-                   Just ms <- getMatchingVars defs ms' t t'
-                        | Nothing => pure Nothing
-                   -- drop the prefix from cargs/cargs' since they won't
-                   -- be in the caller
-                   pure (Just (mapMaybe (dropP (mkSizeOf cargs) (mkSizeOf cargs')) ms))
-           else pure Nothing
-    where
-      weakenP : {0 c, c' : _} -> {0 args, args' : Scope} ->
-                (Var args, Var args') ->
-                (Var (c :: args), Var (c' :: args'))
-      weakenP (v, vs) = (weaken v, weaken vs)
-
-      extend : (cs : List Name) -> (cs' : List Name) ->
-               (List (Var args, Var args')) ->
-               Maybe (List (Var (cs ++ args), Var (cs' ++ args')))
-      extend [] [] ms = pure ms
-      extend (c :: cs) (c' :: cs') ms
-          = do rest <- extend cs cs' ms
-               pure ((first, first) :: map weakenP rest)
-      extend _ _ _ = Nothing
-
-      dropP : SizeOf cs -> SizeOf cs' ->
-              (Var (cs ++ args), Var (cs' ++ args')) ->
-              Maybe (Var args, Var args')
-      dropP cs cs' (x, y) = pure (!(strengthenNs cs x), !(strengthenNs cs' y))
-
-  getMatchingVarAlt defs ms (ConstCase c t) (ConstCase c' t')
-      = if c == c'
-           then getMatchingVars defs ms t t'
-           else pure Nothing
-  getMatchingVarAlt defs ms (DefaultCase t) (DefaultCase t')
-      = getMatchingVars defs ms t t'
-  getMatchingVarAlt defs _ _ _ = pure Nothing
-
-  getMatchingVarAlts : {auto c : Ref Ctxt Defs} ->
-                       {args, args' : _} ->
-                       Defs ->
-                       List (Var args, Var args') ->
-                       List (CaseAlt args) -> List (CaseAlt args') ->
-                       Core (Maybe (List (Var args, Var args')))
-  getMatchingVarAlts defs ms [] [] = pure (Just ms)
-  getMatchingVarAlts defs ms (a :: as) (a' :: as')
-      = do Just ms <- getMatchingVarAlt defs ms a a'
-                | Nothing => pure Nothing
-           getMatchingVarAlts defs ms as as'
-  getMatchingVarAlts defs _ _ _ = pure Nothing
-
-  getMatchingVars : {auto c : Ref Ctxt Defs} ->
-                    {args, args' : _} ->
-                    Defs ->
-                    List (Var args, Var args') ->
-                    CaseTree args -> CaseTree args' ->
-                    Core (Maybe (List (Var args, Var args')))
-  getMatchingVars defs ms (Case _ p _ alts) (Case _ p' _ alts')
-      = getMatchingVarAlts defs ((MkVar p, MkVar p') :: ms) alts alts'
-  getMatchingVars defs ms (STerm i tm) (STerm i' tm')
-      = do let Just tm'' = tryUpdate ms tm
-               | Nothing => pure Nothing
-           if !(convert defs (mkEnv (getLoc tm) args') tm'' tm')
-              then pure (Just ms)
-              else pure Nothing
-  getMatchingVars defs ms (Unmatched _) (Unmatched _) = pure (Just ms)
-  getMatchingVars defs ms Impossible Impossible = pure (Just ms)
-  getMatchingVars _ _ _ _ = pure Nothing
-
-  chkSameDefs : {auto c : Ref Ctxt Defs} ->
-                {vars : _} ->
-                Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-                Name -> Name ->
-                List (Closure vars) -> List (Closure vars) -> Core Bool
-  chkSameDefs q i defs env n n' nargs nargs'
-     = do Just (PMDef _ args ct rt _) <- lookupDefExact n (gamma defs)
-               | _ => pure False
-          Just (PMDef _ args' ct' rt' _) <- lookupDefExact n' (gamma defs)
-               | _ => pure False
-
-          -- If the two case blocks match in structure, get which variables
-          -- correspond. If corresponding variables convert, the two case
-          -- blocks convert.
-          Just ms <- getMatchingVars defs [] ct ct'
-               | Nothing => pure False
-          convertMatches ms
-     where
-       -- We've only got the index into the argument list, and the indices
-       -- don't match up, which is annoying. But it'll always be there!
-       getArgPos : Nat -> List (Closure vars) -> Maybe (Closure vars)
-       getArgPos _ [] = Nothing
-       getArgPos Z (c :: cs) = pure c
-       getArgPos (S k) (c :: cs) = getArgPos k cs
-
-       convertMatches : {vs, vs' : _} ->
-                        List (Var vs, Var vs') ->
-                        Core Bool
-       convertMatches [] = pure True
-       convertMatches ((MkVar {varIdx = ix} p, MkVar {varIdx = iy} p') :: vs)
-          = do let Just varg = getArgPos ix nargs
-                   | Nothing => pure False
-               let Just varg' = getArgPos iy nargs'
-                   | Nothing => pure False
-               pure $ !(convGen q i defs env varg varg') &&
-                      !(convertMatches vs)
-
-  -- If two names are standing for case blocks, check the blocks originate
-  -- from the same place, and have the same scrutinee
-  chkConvCaseBlock : {auto c : Ref Ctxt Defs} ->
-                     {vars : _} ->
-                     FC -> Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-                     NHead vars -> List (Closure vars) ->
-                     NHead vars -> List (Closure vars) -> Core Bool
-  chkConvCaseBlock fc q i defs env (NRef _ n) nargs (NRef _ n') nargs'
-      = do NS _ (CaseBlock {}) <- full (gamma defs) n
-              | _ => pure False
-           NS _ (CaseBlock {}) <- full (gamma defs) n'
-              | _ => pure False
-           False <- chkSameDefs q i defs env n n' nargs nargs'
-              | True => pure True
-           -- both case operators. Due to the way they're elaborated, two
-           -- blocks might arise from the same source but have different
-           -- names. So we consider them the same if the scrutinees convert,
-           -- and the functions are defined at the same location. This is a
-           -- bit of a hack - and relies on the location being stored in the
-           -- term accurately - but otherwise it's a quick way to find out!
-           Just def <- lookupCtxtExact n (gamma defs)
-                | _ => pure False
-           Just def' <- lookupCtxtExact n' (gamma defs)
-                | _ => pure False
-           let PMDef _ _ tree _ _ = definition def
-                | _ => pure False
-           let PMDef _ _ tree' _ _ = definition def'
-                | _ => pure False
-           let Just scpos = findArgPos tree
-                | Nothing => pure False
-           let Just scpos' = findArgPos tree'
-                | Nothing => pure False
-           let Just sc = getScrutinee scpos nargs
-                | Nothing => pure False
-           let Just sc' = getScrutinee scpos' nargs'
-                | Nothing => pure False
-           ignore $ convGen q i defs env sc sc'
-           pure (location def == location def')
-    where
-      -- Need to find the position of the scrutinee to see if they are the
-      -- same
-      findArgPos : CaseTree as -> Maybe Nat
-      findArgPos (Case idx p _ _) = Just idx
-      findArgPos _ = Nothing
-
-      getScrutinee : Nat -> List (Closure vs) -> Maybe (Closure vs)
-      getScrutinee Z (x :: xs) = Just x
-      getScrutinee (S k) (x :: xs) = getScrutinee k xs
-      getScrutinee _ _ = Nothing
-  chkConvCaseBlock _ _ _ _ _ _ _ _ _ = pure False
-
-  chkConvHead : {auto c : Ref Ctxt Defs} ->
-                {vars : _} ->
-                Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-                NHead vars -> NHead vars -> Core Bool
-  chkConvHead q i defs env (NLocal _ idx _) (NLocal _ idx' _) = pure $ idx == idx'
-  chkConvHead q i defs env (NRef _ n) (NRef _ n') = pure $ n == n'
-  chkConvHead q inf defs env (NMeta n i args) (NMeta n' i' args')
-     = if i == i'
-          then allConv q inf defs env args args'
-          else pure False
-  chkConvHead q i defs env _ _ = pure False
-
-  convPiInfo : {auto c : Ref Ctxt Defs} ->
-               {vars : _} ->
-               Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-               PiInfo (Closure vars) -> PiInfo (Closure vars) -> Core Bool
-  convPiInfo q i defs env Implicit Implicit = pure True
-  convPiInfo q i defs env Explicit Explicit = pure True
-  convPiInfo q i defs env AutoImplicit AutoImplicit = pure True
-  convPiInfo q i defs env (DefImplicit x) (DefImplicit y) = convGen q i defs env x y
-  convPiInfo q i defs env _ _ = pure False
-
-  convBinders : {auto c : Ref Ctxt Defs} ->
-                {vars : _} ->
-                Ref QVar Int -> Bool -> Defs -> Env Term vars ->
-                Binder (Closure vars) -> Binder (Closure vars) -> Core Bool
-  convBinders q i defs env bx by
-    = if sameBinders bx by && multiplicity bx == multiplicity by
-         then allM id [ convPiInfo q i defs env (piInfo bx) (piInfo by)
-                      , convGen q i defs env (binderType bx) (binderType by)]
-         else pure False
-    where
-      sameBinders : Binder (Closure vars) -> Binder (Closure vars) -> Bool
-      sameBinders (Pi {}) (Pi {}) = True
-      sameBinders (Lam {}) (Lam {}) = True
-      sameBinders _ _ = False
-
-  export
-  Convert NF where
-    convGen q i defs env (NBind fc x b sc) (NBind _ x' b' sc')
-        = do var <- genName "conv"
-             let c = MkClosure defaultOpts LocalEnv.empty env (Ref fc Bound var)
-             bok <- convBinders q i defs env b b'
-             if bok
-                then do bsc <- sc defs c
-                        bsc' <- sc' defs c
-                        convGen q i defs env bsc bsc'
-                else pure False
-
-    convGen q i defs env tmx@(NBind fc x (Lam fc' c ix tx) scx) tmy
-        = do empty <- clearDefs defs
-             etay <- nf defs env
-                        (Bind fc x (Lam fc' c !(traverse (quote empty env) ix) !(quote empty env tx))
-                           (App fc (weaken !(quote empty env tmy))
-                                (Local fc Nothing _ First)))
-             convGen q i defs env tmx etay
-    convGen q i defs env tmx tmy@(NBind fc y (Lam fc' c iy ty) scy)
-        = do empty <- clearDefs defs
-             etax <- nf defs env
-                        (Bind fc y (Lam fc' c !(traverse (quote empty env) iy) !(quote empty env ty))
-                           (App fc (weaken !(quote empty env tmx))
-                                (Local fc Nothing _ First)))
-             convGen q i defs env etax tmy
-
-    convGen q inf defs env (NApp fc val args) (NApp _ val' args')
-        = if !(chkConvHead q inf defs env val val')
-             then do i <- getInfPos val
-                     allConv q inf defs env (drop i args1) (drop i args2)
-             else chkConvCaseBlock fc q inf defs env val args1 val' args2
-        where
-          getInfPos : NHead vars -> Core NatSet
-          getInfPos (NRef _ n)
-              = if inf
-                   then do Just gdef <- lookupCtxtExact n (gamma defs)
-                                | _ => pure NatSet.empty
-                           pure (inferrable gdef)
-                   else pure NatSet.empty
-          getInfPos _ = pure NatSet.empty
-
-          -- Discard file context information irrelevant for conversion checking
-          args1 : List (Closure vars)
-          args1 = map snd args
-
-          args2 : List (Closure vars)
-          args2 = map snd args'
-
-    convGen q i defs env (NDCon _ nm tag _ args) (NDCon _ nm' tag' _ args')
-        = if tag == tag'
-             then allConv q i defs env (map snd args) (map snd args')
-             else pure False
-    convGen q i defs env (NTCon _ nm _ args) (NTCon _ nm' _ args')
-        = if nm == nm'
-             then allConv q i defs env (map snd args) (map snd args')
-             else pure False
-    convGen q i defs env (NAs _ _ _ tm) (NAs _ _ _ tm')
-        = convGen q i defs env tm tm'
-
-    convGen q i defs env (NDelayed _ r arg) (NDelayed _ r' arg')
-        = if compatible r r'
-             then convGen q i defs env arg arg'
-             else pure False
-    convGen q i defs env (NDelay _ r _ arg) (NDelay _ r' _ arg')
-        = if compatible r r'
-             then do -- if it's codata, don't reduce the argument or we might
-                     -- go for ever, if it's infinite
-                     adefs <- case r of
-                                   LLazy => pure defs
-                                   _ => clearDefs defs
-                     convGen q i adefs env arg arg'
-             else pure False
-    convGen q i defs env (NForce _ r arg args) (NForce _ r' arg' args')
-        = if compatible r r'
-             then if !(convGen q i defs env arg arg')
-                     then allConv q i defs env (map snd args) (map snd args')
-                     else pure False
-             else pure False
-
-    convGen q i defs env (NPrimVal _ c) (NPrimVal _ c') = pure (c == c')
-    convGen q i defs env (NErased _ (Dotted t)) u = convGen q i defs env t u
-    convGen q i defs env t (NErased _ (Dotted u)) = convGen q i defs env t u
-    convGen q i defs env (NErased {}) _ = pure True
-    convGen q i defs env _ (NErased {}) = pure True
-    convGen q i defs env (NType _ ul) (NType _ ur)
-        = -- TODO Cumulativity: Add constraint here
-          pure True
-    convGen q i defs env x y = pure False
-
-  export
-  Convert Term where
-    convGen q i defs env x y
-        = convGen q i defs env !(nf defs env x) !(nf defs env y)
-
-  export
-  Convert Closure where
-    convGen q i defs env x y
-        = convGen q i defs env !(evalClosure defs x) !(evalClosure defs y)
diff --git a/src/Core/Normalise/Eval.idr b/src/Core/Normalise/Eval.idr
deleted file mode 100644
index 0ab608a4636..00000000000
--- a/src/Core/Normalise/Eval.idr
+++ /dev/null
@@ -1,620 +0,0 @@
-module Core.Normalise.Eval
-
-import Core.Case.CaseTree
-import Core.Context.Log
-import Core.Env
-import Core.Primitives
-import Core.Value
-
-import Data.Vect
-
-import Libraries.Data.WithDefault
-
-%default covering
-
--- A pair of a term and its normal form. This could be constructed either
--- from a term (via 'gnf') or a normal form (via 'glueBack') but the other
--- part will only be constructed when needed, because it's in Core.
-public export
-data Glued : Scoped where
-     MkGlue : (fromTerm : Bool) -> -- is it built from the term; i.e. can
-                                   -- we read the term straight back?
-              Core (Term vars) -> (Ref Ctxt Defs -> Core (NF vars)) -> Glued vars
-
-export
-isFromTerm : Glued vars -> Bool
-isFromTerm (MkGlue ft _ _) = ft
-
-export
-getTerm : Glued vars -> Core (Term vars)
-getTerm (MkGlue _ tm _) = tm
-
-export
-getNF : {auto c : Ref Ctxt Defs} -> Glued vars -> Core (NF vars)
-getNF {c} (MkGlue _ _ nf) = nf c
-
-public export
-Stack : Scoped
-Stack vars = List (FC, Closure vars)
-
-evalWithOpts : {auto c : Ref Ctxt Defs} ->
-               {free, vars : _} ->
-               Defs -> EvalOpts ->
-               Env Term free -> LocalEnv free vars ->
-               Term (vars ++ free) -> Stack free -> Core (NF free)
-
-export
-evalClosure : {auto c : Ref Ctxt Defs} ->
-              {free : _} -> Defs -> Closure free -> Core (NF free)
-
-export
-evalArg : {auto c : Ref Ctxt Defs} -> {free : _} -> Defs -> Closure free -> Core (NF free)
-evalArg defs c = evalClosure defs c
-
-export
-toClosure : EvalOpts -> Env Term outer -> Term outer -> Closure outer
-toClosure opts env tm = MkClosure opts LocalEnv.empty env tm
-
-mkClosure : {vars : _} ->
-            EvalOpts ->
-            LocalEnv free vars -> Env Term free ->
-            Term (vars ++ free) -> Closure free
-mkClosure opts locs env tm@(Local _ _ idx prf)
-    = fromMaybe (MkClosure opts locs env tm) (getLocal idx prf locs)
-  where
-    getLocal : {vars : _} ->
-               (idx : Nat) -> (0 p : IsVar nm idx (vars ++ free)) ->
-               LocalEnv free vars ->
-               Maybe (Closure free)
-    getLocal idx prf [] = Nothing
-    getLocal Z First (x :: locs) = Just x
-    getLocal (S idx) (Later p) (_ :: locs) = getLocal idx p locs
-mkClosure opts locs env tm = MkClosure opts locs env tm
-
-updateLimit : NameType -> Name -> EvalOpts -> Core (Maybe EvalOpts)
-updateLimit Func n opts
-    = pure $ if isNil (reduceLimit opts)
-         then Just opts
-         else case lookup n (reduceLimit opts) of
-                   Nothing => Nothing
-                   Just Z => Nothing
-                   Just (S k) =>
-                      Just ({ reduceLimit $= set n k } opts)
-  where
-    set : Name -> Nat -> List (Name, Nat) -> List (Name, Nat)
-    set n v [] = []
-    set n v ((x, l) :: xs)
-        = if x == n
-             then (x, v) :: xs
-             else (x, l) :: set n v xs
-updateLimit t n opts = pure (Just opts)
-
-data CaseResult a
-     = Result a
-     | NoMatch -- case alternative didn't match anything
-     | GotStuck -- alternative matched, but got stuck later
-
-record TermWithEnv (free : Scope) where
-    constructor MkTermEnv
-    { varsEnv : Scope }
-    locEnv : LocalEnv free varsEnv
-    term : Term $ Scope.addInner free varsEnv
-
-parameters (defs : Defs) (topopts : EvalOpts)
-  mutual
-    eval : {auto c : Ref Ctxt Defs} ->
-           {free, vars : _} ->
-           Env Term free -> LocalEnv free vars ->
-           Term (vars ++ free) -> Stack free -> Core (NF free)
-    eval env locs (Local fc mrig idx prf) stk
-        = evalLocal env fc mrig idx prf stk locs
-    eval env locs (Ref fc nt fn) stk
-        = evalRef env False fc nt fn stk (NApp fc (NRef nt fn) stk)
-    eval {vars} {free} env locs (Meta fc name idx args) stk
-        = evalMeta env fc name idx (closeArgs args) stk
-      where
-        -- Yes, it's just a map, but specialising it by hand since we
-        -- use this a *lot* and it saves the run time overhead of making
-        -- a closure and calling APPLY.
-        closeArgs : List (Term (Scope.addInner free vars)) -> List (Closure free)
-        closeArgs [] = []
-        closeArgs (t :: ts) = mkClosure topopts locs env t :: closeArgs ts
-    eval env locs (Bind fc x (Lam _ r _ ty) scope) (thunk :: stk)
-        = eval env (snd thunk :: locs) scope stk
-    eval env locs (Bind fc x b@(Let _ r val ty) scope) stk
-        = if (holesOnly topopts || argHolesOnly topopts) && not (tcInline topopts)
-             then do let b' = map (mkClosure topopts locs env) b
-                     pure $ NBind fc x b'
-                        (\defs', arg => evalWithOpts defs' topopts
-                                                env (arg :: locs) scope stk)
-             else eval env (mkClosure topopts locs env val :: locs) scope stk
-    eval env locs (Bind fc x b scope) stk
-        = do let b' = map (mkClosure topopts locs env) b
-             pure $ NBind fc x b'
-                      (\defs', arg => evalWithOpts defs' topopts
-                                              env (arg :: locs) scope stk)
-    eval env locs (App fc fn arg) stk
-        = case strategy topopts of
-               CBV => do arg' <- eval env locs arg []
-                         eval env locs fn ((fc, MkNFClosure topopts env arg') :: stk)
-               CBN => eval env locs fn ((fc, mkClosure topopts locs env arg) :: stk)
-    eval env locs (As fc s n tm) stk
-        = if removeAs topopts
-             then eval env locs tm stk
-             else do n' <- eval env locs n stk
-                     tm' <- eval env locs tm stk
-                     pure (NAs fc s n' tm')
-    eval env locs (TDelayed fc r ty) stk
-        = do ty' <- eval env locs ty stk
-             pure (NDelayed fc r ty')
-    eval env locs (TDelay fc r ty tm) stk
-        = pure (NDelay fc r (mkClosure topopts locs env ty)
-                            (mkClosure topopts locs env tm))
-    eval env locs (TForce fc r tm) stk
-        = do tm' <- eval env locs tm []
-             case tm' of
-                  NDelay fc r _ arg =>
-                      eval env (arg :: locs) (Local {name = UN (Basic "fvar")} fc Nothing _ First) stk
-                  _ => pure (NForce fc r tm' stk)
-    eval env locs (PrimVal fc c) stk = pure $ NPrimVal fc c
-    eval env locs (Erased fc a) stk
-      = NErased fc <$> traverse @{%search} @{CORE} (\ t => eval env locs t stk) a
-    eval env locs (TType fc u) stk = pure $ NType fc u
-
-    -- Apply an evaluated argument (perhaps cached from an earlier evaluation)
-    -- to a stack
-    export
-    applyToStack : {auto c : Ref Ctxt Defs} ->
-                   {free : _} ->
-                   Env Term free ->
-                   NF free -> Stack free -> Core (NF free)
-    applyToStack env (NBind fc _ (Lam {}) sc) (arg :: stk)
-        = do arg' <- sc defs $ snd arg
-             applyToStack env arg' stk
-    applyToStack env (NBind fc x b@(Let _ r val ty) sc) stk
-        = if (holesOnly topopts || argHolesOnly topopts) && not (tcInline topopts)
-             then pure (NBind fc x b
-                              (\defs', arg => applyToStack env !(sc defs' arg) stk))
-             else applyToStack env !(sc defs val) stk
-    applyToStack env (NBind fc x b sc) stk
-        = pure (NBind fc x b
-                      (\defs', arg => applyToStack env !(sc defs' arg) stk))
-    applyToStack env (NApp fc (NRef nt fn) args) stk
-        = evalRef env False fc nt fn (args ++ stk)
-                  (NApp fc (NRef nt fn) (args ++ stk))
-    applyToStack env (NApp fc (NLocal mrig idx p) args) stk
-        = evalLocal env fc mrig _ p (args ++ stk) LocalEnv.empty
-    applyToStack env (NApp fc (NMeta n i args) args') stk
-        = evalMeta env fc n i args (args' ++ stk)
-    applyToStack env (NDCon fc n t a args) stk
-        = pure $ NDCon fc n t a (args ++ stk)
-    applyToStack env (NTCon fc n a args) stk
-        = pure $ NTCon fc n a (args ++ stk)
-    applyToStack env (NAs fc s p t) stk
-       = if removeAs topopts
-            then applyToStack env t stk
-            else do p' <- applyToStack env p []
-                    t' <- applyToStack env t stk
-                    pure (NAs fc s p' t')
-    applyToStack env (NDelayed fc r tm) stk
-       = do tm' <- applyToStack env tm stk
-            pure (NDelayed fc r tm')
-    applyToStack env nf@(NDelay fc r ty tm) stk
-       = pure nf -- stack should always be empty here!
-    applyToStack env (NForce fc r tm args) stk
-       = do tm' <- applyToStack env tm []
-            case tm' of
-                 NDelay fc r _ arg =>
-                    eval env [arg] (Local {name = UN (Basic "fvar")} fc Nothing _ First) stk
-                 _ => pure (NForce fc r tm' (args ++ stk))
-    applyToStack env nf@(NPrimVal fc _) _ = pure nf
-    applyToStack env (NErased fc a) stk
-      = NErased fc <$> traverse @{%search} @{CORE} (\ t => applyToStack env t stk) a
-    applyToStack env nf@(NType fc _) _ = pure nf
-
-    evalLocClosure : {auto c : Ref Ctxt Defs} ->
-                     {free : _} ->
-                     Env Term free ->
-                     FC -> Maybe Bool ->
-                     Stack free ->
-                     Closure free ->
-                     Core (NF free)
-    evalLocClosure env fc mrig stk (MkClosure opts locs' env' tm')
-        = evalWithOpts defs opts env' locs' tm' stk
-    evalLocClosure {free} env fc mrig stk (MkNFClosure opts env' nf)
-        = applyToStack env' nf stk
-
-    evalLocal : {auto c : Ref Ctxt Defs} ->
-                {free : _} ->
-                Env Term free ->
-                FC -> Maybe Bool ->
-                (idx : Nat) -> (0 p : IsVar nm idx (vars ++ free)) ->
-                Stack free ->
-                LocalEnv free vars ->
-                Core (NF free)
-    -- If it's one of the free variables, we are done unless the free
-    -- variable maps to a let-binding
-    evalLocal env fc mrig idx prf stk []
-        = if not (holesOnly topopts || argHolesOnly topopts)
-             -- if we know it's not a let, no point in even running `getBinder`
-             && fromMaybe True mrig
-             then
-               case getBinder prf env of
-                    Let _ _ val _ => eval env LocalEnv.empty val stk
-                    _ => pure $ NApp fc (NLocal mrig idx prf) stk
-             else pure $ NApp fc (NLocal mrig idx prf) stk
-    evalLocal env fc mrig Z First stk (x :: locs)
-        = evalLocClosure env fc mrig stk x
-    evalLocal env fc mrig (S idx) (Later p) stk (_ :: locs)
-        = evalLocal env fc mrig idx p stk locs
-
-    updateLocal : EvalOpts -> Env Term free ->
-                  (idx : Nat) -> (0 p : IsVar nm idx (vars ++ free)) ->
-                  LocalEnv free vars -> NF free ->
-                  LocalEnv free vars
-    updateLocal opts env Z First (x :: locs) nf
-        = MkNFClosure opts env nf :: locs
-    updateLocal opts env (S idx) (Later p) (x :: locs) nf
-        = x :: updateLocal opts env idx p locs nf
-    updateLocal _ _ _ _ locs nf = locs
-
-    evalMeta : {auto c : Ref Ctxt Defs} ->
-               {free : _} ->
-               Env Term free ->
-               FC -> Name -> Int -> List (Closure free) ->
-               Stack free -> Core (NF free)
-    evalMeta env fc nm i args stk
-        = let args' = if isNil stk then map (EmptyFC,) args
-                         else map (EmptyFC,) args ++ stk
-                        in
-              evalRef env True fc Func (Resolved i) args'
-                          (NApp fc (NMeta nm i args) stk)
-
-    -- The commented out logging here might still be useful one day, but
-    -- evalRef is used a lot and even these tiny checks turn out to be
-    -- worth skipping if we can
-    evalRef : {auto c : Ref Ctxt Defs} ->
-              {free : _} ->
-              Env Term free ->
-              (isMeta : Bool) ->
-              FC -> NameType -> Name -> Stack free -> (def : Lazy (NF free)) ->
-              Core (NF free)
-    evalRef env meta fc (DataCon tag arity) fn stk def
-        = do -- logC "eval.ref.data" 50 $ do fn' <- toFullNames fn -- Can't use ! here, it gets lifted too far
-             --                             pure $ "Found data constructor: " ++ show fn'
-             pure $ NDCon fc fn tag arity stk
-    evalRef env meta fc (TyCon arity) fn stk def
-        = do -- logC "eval.ref.type" 50 $ do fn' <- toFullNames fn
-             --                             pure $ "Found type constructor: " ++ show fn'
-             pure $ ntCon fc fn arity stk
-    evalRef env meta fc Bound fn stk def
-        = do -- logC "eval.ref.bound" 50 $ do fn' <- toFullNames fn
-             --                              pure $ "Found bound variable: " ++ show fn'
-             pure def
-    evalRef env meta fc nt@Func n stk def
-        = do -- logC "eval.ref" 50 $ do n' <- toFullNames n
-             --                        pure $ "Found function: " ++ show n'
-             Just res <- lookupCtxtExact n (gamma defs)
-                  | Nothing => do logC "eval.stuck.outofscope" 5 $ do n' <- toFullNames n
-                                                                      pure $ "Stuck function: " ++ show n'
-                                  pure def
-             let redok1 = evalAll topopts
-             let redok2 = reducibleInAny (currentNS defs :: nestedNS defs)
-                                         (fullname res)
-                                         (collapseDefault $ visibility res)
-             -- want to shortcut that second check, if we're evaluating
-             -- everything, so don't let bind unless we need that log!
-             let redok = redok1 || redok2
-             checkTimer -- If we're going to time out anywhere, it'll be
-                        -- when evaluating something recursive, so this is a
-                        -- good place to check
-             unless redok2 $ logC "eval.stuck" 5 $ do n' <- toFullNames n
-                                                      pure $ "Stuck function: \{show n'}"
-             if redok
-                then do
-                   Just opts' <- updateLimit nt n topopts
-                        | Nothing => do log "eval.stuck" 10 $ "Function \{show n} past reduction limit"
-                                        pure def -- name is past reduction limit
-                   nf <- evalDef env opts' meta fc
-                           (multiplicity res) (definition res) (flags res) stk def
-                   -- logC "eval.ref" 50 $ do n' <- toFullNames n
-                   --                         nf <- toFullNames nf
-                   --                         pure "Reduced \{show n'} to \{show nf}"
-                   pure nf
-                else pure def
-
-    -- TODO note the list of closures is stored RTL
-    getCaseBound : List (Closure free) ->
-                   (args : Scope) ->
-                   LocalEnv free more ->
-                   Maybe (LocalEnv free (Scope.addInner more args))
-    getCaseBound []            []        loc = Just loc
-    getCaseBound []            (_ :: _)  loc = Nothing -- mismatched arg length
-    getCaseBound (arg :: args) []        loc = Nothing -- mismatched arg length
-    getCaseBound (arg :: args) (n :: ns) loc = (arg ::) <$> getCaseBound args ns loc
-
-    -- Returns the case term from the matched pattern with the LocalEnv (arguments from constructor pattern ConCase)
-    evalConAlt : {auto c : Ref Ctxt Defs} ->
-                 {more, free : _} ->
-                 Env Term free ->
-                 LocalEnv free more -> EvalOpts -> FC ->
-                 Stack free ->
-                 (args : List Name) ->
-                 List (Closure free) ->
-                 CaseTree (Scope.addInner more args) ->
-                 Core (CaseResult (TermWithEnv free))
-    evalConAlt env loc opts fc stk args args' sc
-         = do let Just bound = getCaseBound args' args loc
-                   | Nothing => pure GotStuck
-              evalTree env bound opts fc stk sc
-
-    tryAlt : {auto c : Ref Ctxt Defs} ->
-             {free, more : _} ->
-             Env Term free ->
-             LocalEnv free more -> EvalOpts -> FC ->
-             Stack free -> NF free -> CaseAlt more ->
-             Core (CaseResult (TermWithEnv free))
-    -- Dotted values should still reduce at compile time
-    tryAlt {more} env loc opts fc stk (NErased _ (Dotted tm)) alt
-         = tryAlt {more} env loc opts fc stk tm alt
-    -- Ordinary constructor matching
-    tryAlt {more} env loc opts fc stk (NDCon _ nm tag' arity args') (ConCase x tag args sc)
-         = if tag == tag'
-              then evalConAlt env loc opts fc stk args (map snd args') sc
-              else pure NoMatch
-    -- Type constructor matching, in typecase
-    tryAlt {more} env loc opts fc stk (NTCon _ nm arity args') (ConCase nm' tag args sc)
-         = if nm == nm'
-              then evalConAlt env loc opts fc stk args (map snd args') sc
-              else pure NoMatch
-    -- Primitive type matching, in typecase
-    tryAlt env loc opts fc stk (NPrimVal _ c) (ConCase nm tag args sc)
-         = case args of -- can't just test for it in the `if` for typing reasons
-             [] => if UN (Basic $ show c) == nm
-                   then evalTree env loc opts fc stk sc
-                   else pure NoMatch
-             _ => pure NoMatch
-    -- Type of type matching, in typecase
-    tryAlt env loc opts fc stk (NType {}) (ConCase (UN (Basic "Type")) tag [] sc)
-         = evalTree env loc opts fc stk sc
-    tryAlt env loc opts fc stk (NType {}) (ConCase {})
-         = pure NoMatch
-    -- Arrow matching, in typecase
-    tryAlt {more}
-           env loc opts fc stk (NBind pfc x (Pi fc' r e aty) scty) (ConCase (UN (Basic "->")) tag [s,t] sc)
-       = evalConAlt {more} env loc opts fc stk [s,t]
-                  [aty,
-                   MkNFClosure opts env (NBind pfc x (Lam fc' r e aty) scty)]
-                  sc
-    tryAlt {more}
-           env loc opts fc stk (NBind pfc x (Pi fc' r e aty) scty) (ConCase nm tag args sc)
-       = pure NoMatch
-    -- Delay matching
-    tryAlt env loc opts fc stk (NDelay _ _ ty arg) (DelayCase tyn argn sc)
-         = evalTree env (ty :: arg :: loc) opts fc stk sc
-    -- Constant matching
-    tryAlt env loc opts fc stk (NPrimVal _ c') (ConstCase c sc)
-         = if c == c' then evalTree env loc opts fc stk sc
-                      else pure NoMatch
-    -- Default case matches against any *concrete* value
-    tryAlt env loc opts fc stk val (DefaultCase sc)
-         = if concrete val
-              then evalTree env loc opts fc stk sc
-              else pure GotStuck
-      where
-        concrete : NF free -> Bool
-        concrete (NDCon {}) = True
-        concrete (NTCon {}) = True
-        concrete (NPrimVal {}) = True
-        concrete (NBind {}) = True
-        concrete (NType {}) = True
-        concrete (NDelay {}) = True
-        concrete _ = False
-    tryAlt _ _ _ _ _ _ _ = pure GotStuck
-
-    findAlt : {auto c : Ref Ctxt Defs} ->
-              {args, free : _} ->
-              Env Term free ->
-              LocalEnv free args -> EvalOpts -> FC ->
-              Stack free -> NF free -> List (CaseAlt args) ->
-              Core (CaseResult (TermWithEnv free))
-    findAlt env loc opts fc stk val [] = do
-      log "eval.casetree.stuck" 2 "Ran out of alternatives"
-      pure GotStuck
-    findAlt env loc opts fc stk val (x :: xs)
-         = do res@(Result {}) <- tryAlt env loc opts fc stk val x
-                   | NoMatch => findAlt env loc opts fc stk val xs
-                   | GotStuck => do
-                       logC "eval.casetree.stuck" 5 $ do
-                         val <- toFullNames val
-                         x <- toFullNames x
-                         pure $ "Got stuck matching \{show val} against \{show x}"
-                       pure GotStuck
-              pure res
-
-    evalTree : {auto c : Ref Ctxt Defs} ->
-               {args, free : _} -> Env Term free -> LocalEnv free args ->
-               EvalOpts -> FC ->
-               Stack free -> CaseTree args ->
-               Core (CaseResult (TermWithEnv free))
-    evalTree env loc opts fc stk (Case {name} idx x _ alts)
-      = do xval <- evalLocal env fc Nothing idx (embedIsVar x) [] loc
-           -- we have not defined quote yet (it depends on eval itself) so we show the NF
-           -- i.e. only the top-level constructor.
-           logC "eval.casetree" 5 $ do
-             xval <- toFullNames xval
-             pure "Evaluated \{show name} to \{show xval}"
-           let loc' = updateLocal opts env idx (embedIsVar x) loc xval
-           findAlt env loc' opts fc stk xval alts
-    evalTree env loc opts fc stk (STerm _ tm)
-          = pure (Result $ MkTermEnv loc $ embed tm)
-    evalTree env loc opts fc stk _ = pure GotStuck
-
-    -- Take arguments from the stack, as long as there's enough.
-    -- Returns the arguments, and the rest of the stack
-    takeFromStack : (arity : Nat) -> Stack free ->
-                    Maybe (Vect arity (Closure free), Stack free)
-    takeFromStack arity stk = takeStk arity stk []
-      where
-        takeStk : (remain : Nat) -> Stack free ->
-                  Vect got (Closure free) ->
-                  Maybe (Vect (got + remain) (Closure free), Stack free)
-        takeStk {got} Z stk acc = Just (rewrite plusZeroRightNeutral got in
-                                    reverse acc, stk)
-        takeStk (S k) [] acc = Nothing
-        takeStk {got} (S k) (arg :: stk) acc
-           = rewrite sym (plusSuccRightSucc got k) in
-                     takeStk k stk (snd arg :: acc)
-
-    argsFromStack : (args : List Name) ->
-                    Stack free ->
-                    Maybe (LocalEnv free args, Stack free)
-    argsFromStack [] stk = Just ([], stk)
-    argsFromStack (n :: ns) [] = Nothing
-    argsFromStack (n :: ns) (arg :: args)
-         = do (loc', stk') <- argsFromStack ns args
-              pure (snd arg :: loc', stk')
-
-    evalOp : {auto c : Ref Ctxt Defs} ->
-             {arity, free : _} ->
-             (Vect arity (NF free) -> Maybe (NF free)) ->
-             Stack free -> (def : Lazy (NF free)) ->
-             Core (NF free)
-    evalOp {arity} fn stk def
-        = case takeFromStack arity stk of
-               -- Stack must be exactly the right height
-               Just (args, []) =>
-                  do argsnf <- evalAll args
-                     pure $ case fn argsnf of
-                          Nothing => def
-                          Just res => res
-               _ => pure def
-      where
-        -- No traverse for Vect in Core...
-        evalAll : Vect n (Closure free) -> Core (Vect n (NF free))
-        evalAll [] = pure []
-        evalAll (c :: cs) = pure $ !(evalClosure defs c) :: !(evalAll cs)
-
-    evalDef : {auto c : Ref Ctxt Defs} ->
-              {free : _} ->
-              Env Term free -> EvalOpts ->
-              (isMeta : Bool) -> FC ->
-              RigCount -> Def -> List DefFlag ->
-              Stack free -> (def : Lazy (NF free)) ->
-              Core (NF free)
-    evalDef env opts meta fc rigd (PMDef r args tree _ _) flags stk def
-       -- If evaluating the definition fails (e.g. due to a case being
-       -- stuck) return the default.
-       -- We can use the definition if one of the following is true:
-       --   + The 'alwayReduce' flag (r) is set
-       --   + We're not in 'holesOnly', 'argHolesOnly' or 'tcInline'
-       --         (that's the default mode)
-       --   + It's a metavariable and not in Rig0
-       --   + It's a metavariable and we're not in 'argHolesOnly'
-       --   + It's inlinable and we're in 'tcInline'
-        = if alwaysReduce r
-             || (not (holesOnly opts || argHolesOnly opts || tcInline opts))
-             || (meta && not (isErased rigd))
-             || (meta && holesOnly opts)
-             || (tcInline opts && elem TCInline flags)
-             then case argsFromStack args stk of
-                       Nothing => do logC "eval.def.underapplied" 50 $ do
-                                       def <- toFullNames def
-                                       pure "Cannot reduce under-applied \{show def}"
-                                     pure def
-                       Just (locs', stk') =>
-                            do (Result (MkTermEnv newLoc res)) <- evalTree env locs' opts fc stk' tree
-                                    | _ => do logC "eval.def.stuck" 50 $ do
-                                                def <- toFullNames def
-                                                pure "evalTree failed on \{show def}"
-                                              pure def
-                               case fuel opts of
-                                    Nothing => evalWithOpts defs opts env newLoc res stk'
-                                    Just Z => log "eval.def.stuck" 50 "Recursion depth limit exceeded"
-                                              >> pure def
-                                    Just (S k) =>
-                                        do let opts' = { fuel := Just k } opts
-                                           evalWithOpts defs opts' env newLoc res stk'
-             else do -- logC "eval.def.stuck" 50 $ do
-                     --   def <- toFullNames def
-                     --   pure $ unlines [ "Refusing to reduce \{show def}:"
-                     --                  , "  holesOnly   : \{show $ holesOnly opts}"
-                     --                  , "  argHolesOnly: \{show $ argHolesOnly opts}"
-                     --                  , "  tcInline    : \{show $ tcInline opts}"
-                     --                  , "  meta        : \{show meta}"
-                     --                  , "  rigd        : \{show rigd}"
-                     --                  ]
-                     pure def
-    evalDef env opts meta fc rigd (Builtin op) flags stk def
-        = evalOp (getOp op) stk def
-    -- All other cases, use the default value, which is already applied to
-    -- the stack
-    evalDef env opts meta fc rigd def flags stk orig = do
-      logC "eval.def.stuck" 50 $ do
-        orig <- toFullNames orig
-        pure "Cannot reduce def \{show orig}: it is a \{show def}"
-      pure orig
-
--- Make sure implicit argument order is right... 'vars' is used so we'll
--- write it explicitly, but it does appear after the parameters in 'eval'!
-evalWithOpts {vars} defs opts = eval {vars} defs opts
-
-evalClosure defs (MkClosure opts locs env tm)
-    = eval defs opts env locs tm []
-evalClosure defs (MkNFClosure opts env nf)
-    = applyToStack defs opts env nf []
-
-export
-evalClosureWithOpts : {auto c : Ref Ctxt Defs} ->
-                      {free : _} ->
-                      Defs -> EvalOpts -> Closure free -> Core (NF free)
-evalClosureWithOpts defs opts (MkClosure _ locs env tm)
-    = eval defs opts env locs tm []
-evalClosureWithOpts defs opts (MkNFClosure _ env nf)
-    = applyToStack defs opts env nf []
-
-export
-nf : {auto c : Ref Ctxt Defs} ->
-     {vars : _} ->
-     Defs -> Env Term vars -> Term vars -> Core (NF vars)
-nf defs env tm = eval defs defaultOpts env LocalEnv.empty tm []
-
-export
-nfOpts : {auto c : Ref Ctxt Defs} ->
-         {vars : _} ->
-         EvalOpts -> Defs -> Env Term vars -> Term vars -> Core (NF vars)
-nfOpts opts defs env tm = eval defs opts env LocalEnv.empty tm []
-
-export
-gnf : {vars : _} ->
-      Env Term vars -> Term vars -> Glued vars
-gnf env tm
-    = MkGlue True
-             (pure tm)
-             (\c => do defs <- get Ctxt
-                       nf defs env tm)
-
-export
-gnfOpts : {vars : _} ->
-          EvalOpts -> Env Term vars -> Term vars -> Glued vars
-gnfOpts opts env tm
-    = MkGlue True
-             (pure tm)
-             (\c => do defs <- get Ctxt
-                       nfOpts opts defs env tm)
-
-export
-gType : FC -> Name -> Glued vars
-gType fc u = MkGlue True (pure (TType fc u)) (const (pure (NType fc u)))
-
-export
-gErased : FC -> Glued vars
-gErased fc = MkGlue True (pure (Erased fc Placeholder)) (const (pure (NErased fc Placeholder)))
-
--- Resume a previously blocked normalisation with a new environment
-export
-continueNF : {auto c : Ref Ctxt Defs} ->
-             {vars : _} ->
-             Defs -> Env Term vars -> NF vars -> Core (NF vars)
-continueNF defs env stuck
-   = applyToStack defs defaultOpts env stuck []
diff --git a/src/Core/Normalise/Quote.idr b/src/Core/Normalise/Quote.idr
deleted file mode 100644
index 9a400cdc6bd..00000000000
--- a/src/Core/Normalise/Quote.idr
+++ /dev/null
@@ -1,272 +0,0 @@
-module Core.Normalise.Quote
-
-import Core.Context
-import Core.Env
-import Core.Normalise.Eval
-import Core.Value
-
-%default covering
-
-export
-data QVar : Type where
-
-public export
-record QuoteOpts where
-  constructor MkQuoteOpts
-  topLevel : Bool -- At the top level application
-  patterns : Bool -- only quote as far as is useful to get LHS patterns.
-                  -- That means, stop on encountering a block function or
-                  -- local
-  sizeLimit : Maybe Nat
-
-public export
-interface Quote tm where
-    quote : {auto c : Ref Ctxt Defs} ->
-            {vars : Scope} ->
-            Defs -> Env Term vars -> tm vars -> Core (Term vars)
-    quoteLHS : {auto c : Ref Ctxt Defs} ->
-               {vars : Scope} ->
-               Defs -> Env Term vars -> tm vars -> Core (Term vars)
-    quoteOpts : {auto c : Ref Ctxt Defs} ->
-                {vars : Scope} ->
-                QuoteOpts -> Defs -> Env Term vars -> tm vars -> Core (Term vars)
-
-    quoteGen : {auto c : Ref Ctxt Defs} ->
-               {vars : _} ->
-               Ref QVar Int -> QuoteOpts ->
-               Defs -> Env Term vars -> tm vars -> Core (Term vars)
-
-    quote defs env tm
-        = do q <- newRef QVar 0
-             quoteGen q (MkQuoteOpts True False Nothing) defs env tm
-
-    quoteLHS defs env tm
-        = do q <- newRef QVar 0
-             quoteGen q (MkQuoteOpts True True Nothing) defs env tm
-
-    quoteOpts opts defs env tm
-        = do q <- newRef QVar 0
-             quoteGen q opts defs env tm
-
-export
-genName : {auto q : Ref QVar Int} -> String -> Core Name
-genName n
-    = do i <- get QVar
-         put QVar (i + 1)
-         pure (MN n i)
-
-mutual
-  quoteArg : {auto c : Ref Ctxt Defs} ->
-              {bound, free : _} ->
-              Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-              Env Term free -> Closure free ->
-              Core (Term (bound ++ free))
-  quoteArg q opts defs bounds env a
-      = quoteGenNF q opts defs bounds env !(evalClosure defs a)
-
-  quoteArgWithFC : {auto c : Ref Ctxt Defs} ->
-                   {bound, free : _} ->
-                   Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-                   Env Term free -> (FC, Closure free) ->
-                   Core ((FC, Term (bound ++ free)))
-  quoteArgWithFC q opts defs bounds env
-       = traversePair (quoteArg q opts defs bounds env)
-
-  quoteArgs : {auto c : Ref Ctxt Defs} ->
-              {bound, free : _} ->
-              Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-              Env Term free -> List (Closure free) ->
-              Core (List (Term (bound ++ free)))
-  quoteArgs q opts defs bounds env = traverse (quoteArg q opts defs bounds env)
-
-  quoteArgsWithFC : {auto c : Ref Ctxt Defs} ->
-                    {bound, free : _} ->
-                    Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-                    Env Term free -> List (FC, Closure free) ->
-                    Core (List (FC, Term (bound ++ free)))
-  quoteArgsWithFC q opts defs bounds env
-      = traverse (quoteArgWithFC q opts defs bounds env)
-
-  quoteHead : {auto c : Ref Ctxt Defs} ->
-              {bound, free : _} ->
-              Ref QVar Int -> QuoteOpts -> Defs ->
-              FC -> Bounds bound -> Env Term free -> NHead free ->
-              Core (Term (bound ++ free))
-  quoteHead {bound} q opts defs fc bounds env (NLocal mrig _ prf)
-      = let MkVar prf' = addLater bound prf in
-            pure $ Local fc mrig _ prf'
-    where
-      addLater : {idx : _} ->
-                 (ys : List Name) -> (0 p : IsVar n idx xs) ->
-                 Var (ys ++ xs)
-      addLater [] isv = MkVar isv
-      addLater (x :: xs) isv
-          = let MkVar isv' = addLater xs isv in
-                MkVar (Later isv')
-  quoteHead q opts defs fc bounds env (NRef Bound (MN n i))
-      = pure $ case findName bounds of
-             Just (MkVar p) => Local fc Nothing _ (embedIsVar p)
-             Nothing => Ref fc Bound (MN n i)
-    where
-      findName : Bounds bound' -> Maybe (Var bound')
-      findName None = Nothing
-      findName (Add x (MN n' i') ns)
-          = if i == i' -- this uniquely identifies it, given how we
-                       -- generated the names, and is a faster test!
-               then Just first
-               else do MkVar p <-findName ns
-                       Just (MkVar (Later p))
-      findName (Add x _ ns)
-          = do MkVar p <-findName ns
-               Just (MkVar (Later p))
-  quoteHead q opts defs fc bounds env (NRef nt n) = pure $ Ref fc nt n
-  quoteHead q opts defs fc bounds env (NMeta n i args)
-      = do args' <- quoteArgs q opts defs bounds env args
-           pure $ Meta fc n i args'
-
-  quotePi : {auto c : Ref Ctxt Defs} ->
-            {bound, free : _} ->
-            Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-            Env Term free -> PiInfo (Closure free) ->
-            Core (PiInfo (Term (bound ++ free)))
-  quotePi q opts defs bounds env Explicit = pure Explicit
-  quotePi q opts defs bounds env Implicit = pure Implicit
-  quotePi q opts defs bounds env AutoImplicit = pure AutoImplicit
-  quotePi q opts defs bounds env (DefImplicit t)
-      = do t' <- quoteGenNF q opts defs bounds env !(evalClosure defs t)
-           pure (DefImplicit t')
-
-  quoteBinder : {auto c : Ref Ctxt Defs} ->
-                {bound, free : _} ->
-                Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-                Env Term free -> Binder (Closure free) ->
-                Core (Binder (Term (bound ++ free)))
-  quoteBinder q opts defs bounds env (Lam fc r p ty)
-      = do ty' <- quoteGenNF q opts defs bounds env !(evalClosure defs ty)
-           p' <- quotePi q opts defs bounds env p
-           pure (Lam fc r p' ty')
-  quoteBinder q opts defs bounds env (Let fc r val ty)
-      = do val' <- quoteGenNF q opts defs bounds env !(evalClosure defs val)
-           ty' <- quoteGenNF q opts defs bounds env !(evalClosure defs ty)
-           pure (Let fc r val' ty')
-  quoteBinder q opts defs bounds env (Pi fc r p ty)
-      = do ty' <- quoteGenNF q opts defs bounds env !(evalClosure defs ty)
-           p' <- quotePi q opts defs bounds env p
-           pure (Pi fc r p' ty')
-  quoteBinder q opts defs bounds env (PVar fc r p ty)
-      = do ty' <- quoteGenNF q opts defs bounds env !(evalClosure defs ty)
-           p' <- quotePi q opts defs bounds env p
-           pure (PVar fc r p' ty')
-  quoteBinder q opts defs bounds env (PLet fc r val ty)
-      = do val' <- quoteGenNF q opts defs bounds env !(evalClosure defs val)
-           ty' <- quoteGenNF q opts defs bounds env !(evalClosure defs ty)
-           pure (PLet fc r val' ty')
-  quoteBinder q opts defs bounds env (PVTy fc r ty)
-      = do ty' <- quoteGenNF q opts defs bounds env !(evalClosure defs ty)
-           pure (PVTy fc r ty')
-
-  quoteGenNF : {auto c : Ref Ctxt Defs} ->
-               {bound, vars : _} ->
-               Ref QVar Int -> QuoteOpts ->
-               Defs -> Bounds bound ->
-               Env Term vars -> NF vars -> Core (Term (bound ++ vars))
-  quoteGenNF q opts defs bound env (NBind fc n b sc)
-      = do var <- genName "qv"
-           sc' <- quoteGenNF q opts defs (Add n var bound) env
-                       !(sc defs (toClosure defaultOpts env (Ref fc Bound var)))
-           b' <- quoteBinder q opts defs bound env b
-           pure (Bind fc n b' sc')
-  quoteGenNF q opts defs bound env (NApp fc f args)
-      = do f' <- quoteHead q opts defs fc bound env f
-           opts' <- case sizeLimit opts of
-                         Nothing => pure opts
-                         Just Z => throw (InternalError "Size limit exceeded")
-                         Just (S k) => pure ({ sizeLimit := Just k } opts)
-           args' <- if patterns opts && not (topLevel opts) && isRef f
-                       then do empty <- clearDefs defs
-                               quoteArgsWithFC q opts' empty bound env args
-                               else quoteArgsWithFC q ({ topLevel := False } opts')
-                                                    defs bound env args
-           pure $ applyStackWithFC f' args'
-    where
-      isRef : NHead vars -> Bool
-      isRef (NRef {}) = True
-      isRef _ = False
-  quoteGenNF q opts defs bound env (NDCon fc n t ar args)
-      = do args' <- quoteArgsWithFC q opts defs bound env args
-           pure $ applyStackWithFC (Ref fc (DataCon t ar) n) args'
-  quoteGenNF q opts defs bound env (NTCon fc n ar args)
-      = do args' <- quoteArgsWithFC q opts defs bound env args
-           pure $ applyStackWithFC (Ref fc (TyCon ar) n) args'
-  quoteGenNF q opts defs bound env (NAs fc s n pat)
-      = do n' <- quoteGenNF q opts defs bound env n
-           pat' <- quoteGenNF q opts defs bound env pat
-           pure (As fc s n' pat')
-  quoteGenNF q opts defs bound env (NDelayed fc r arg)
-      = do argQ <- quoteGenNF q opts defs bound env arg
-           pure (TDelayed fc r argQ)
-  quoteGenNF q opts defs bound env (NDelay fc r ty arg)
-      = do argNF <- evalClosure defs (toHolesOnly arg)
-           argQ <- quoteGenNF q opts defs bound env argNF
-           tyNF <- evalClosure defs (toHolesOnly ty)
-           tyQ <- quoteGenNF q opts defs bound env tyNF
-           pure (TDelay fc r tyQ argQ)
-    where
-      toHolesOnly : Closure vs -> Closure vs
-      toHolesOnly (MkClosure opts locs env tm)
-          = MkClosure ({ holesOnly := True,
-                         argHolesOnly := True } opts)
-                      locs env tm
-      toHolesOnly c = c
-  quoteGenNF q opts defs bound env (NForce fc r arg args)
-      = do args' <- quoteArgsWithFC q opts defs bound env args
-           case arg of
-                NDelay fc _ _ arg =>
-                   do argNF <- evalClosure defs arg
-                      pure $ applyStackWithFC !(quoteGenNF q opts defs bound env argNF) args'
-                _ => do arg' <- quoteGenNF q opts defs bound env arg
-                        pure $ applyStackWithFC (TForce fc r arg') args'
-  quoteGenNF q opts defs bound env (NPrimVal fc c) = pure $ PrimVal fc c
-  quoteGenNF q opts defs bound env (NErased fc t)
-    = Erased fc <$> traverse @{%search} @{CORE} (\ nf => quoteGenNF q opts defs bound env nf) t
-  quoteGenNF q opts defs bound env (NType fc u) = pure $ TType fc u
-
-export
-Quote NF where
-  quoteGen q opts defs env tm = quoteGenNF q opts defs None env tm
-
-export
-Quote Term where
-  quoteGen q opts defs env tm = pure tm
-
-export
-Quote Closure where
-  quoteGen q opts defs env c = quoteGen q opts defs env !(evalClosure defs c)
-
-quoteWithPiGen : {auto _ : Ref Ctxt Defs} ->
-                 {bound, vars : _} ->
-                 Ref QVar Int -> QuoteOpts -> Defs -> Bounds bound ->
-                 Env Term vars -> NF vars -> Core (Term (bound ++ vars))
-quoteWithPiGen q opts defs bound env (NBind fc n (Pi bfc c p ty) sc)
-    = do var <- genName "qv"
-         empty <- clearDefs defs
-         sc' <- quoteWithPiGen q opts defs (Add n var bound) env
-                     !(sc defs (toClosure defaultOpts env (Ref fc Bound var)))
-         ty' <- quoteGenNF q opts empty bound env !(evalClosure empty ty)
-         p' <- quotePi q opts empty bound env p
-         pure (Bind fc n (Pi bfc c p' ty') sc')
-quoteWithPiGen q opts defs bound env (NErased fc t)
-  = Erased fc <$> traverse @{%search} @{CORE} (quoteWithPiGen q opts defs bound env) t
-quoteWithPiGen q opts defs bound env tm
-    = do empty <- clearDefs defs
-         quoteGenNF q opts empty bound env tm
-
--- Quote back to a term, but only to find out how many Pi bindings there
--- are, don't reduce anything else
-export
-quoteWithPi : {auto c : Ref Ctxt Defs} ->
-              {vars : Scope} ->
-              Defs -> Env Term vars -> NF vars -> Core (Term vars)
-quoteWithPi defs env tm
-    = do q <- newRef QVar 0
-         quoteWithPiGen q (MkQuoteOpts True False Nothing) defs None env tm
diff --git a/src/Core/Options.idr b/src/Core/Options.idr
index 07392c16738..3e0bb12962d 100644
--- a/src/Core/Options.idr
+++ b/src/Core/Options.idr
@@ -153,6 +153,8 @@ record Session where
                     -- any logging is enabled.
   logLevel : LogLevels
   logTimings : Maybe Nat -- log level, higher means more details
+  logTreeEnabled : Bool -- do we show logs in a tree-like output
+  logDepth : Nat -- depth level of logging to separate related stuff visually
   debugElabCheck : Bool -- do conversion check to verify results of elaborator
   dumpcases : Maybe String -- file to output compiled case trees
   dumplifted : Maybe String -- file to output lambda lifted definitions
@@ -240,7 +242,7 @@ docsPPrint = MkPPOpts
 export
 defaultSession : Session
 defaultSession = MkSessionOpts False CoveringOnly False False Chez [] 1000 False False
-                               defaultLogLevel Nothing False Nothing Nothing
+                               defaultLogLevel Nothing False 0 False Nothing Nothing
                                Nothing Nothing False 1 False False True
                                False [] False False
 
diff --git a/src/Core/Options/Log.idr b/src/Core/Options/Log.idr
index db188cc67e6..1443e3e7952 100644
--- a/src/Core/Options/Log.idr
+++ b/src/Core/Options/Log.idr
@@ -53,6 +53,8 @@ knownTopics = [
     ("compile.casetree.missing", Just "Log when we add an error case for uncovered branches."),
     ("compile.casetree.partition", Nothing),
     ("compile.casetree.pick", Nothing),
+    ("compile.casetree.subst", Nothing),
+    ("compile.casetree.updateVar", Nothing),
     ("compiler.const-fold", Just "Log definitions before and after constant folding."),
     ("compiler.cse", Just "Log information about common sub-expression elimination."),
     ("compiler.identity", Just "Log definitions that are equivalent to identity at runtime."),
diff --git a/src/Core/Ord.idr b/src/Core/Ord.idr
index 6e5ab99eb77..79e5cfd515d 100644
--- a/src/Core/Ord.idr
+++ b/src/Core/Ord.idr
@@ -43,12 +43,20 @@ mutual
         CCrash _ m1 == CCrash _ m2 = m1 == m2
         _ == _ = False
 
+    export
+    covering
+    Eq (CCaseScope vars) where
+        CRHS tm == CRHS tm' = tm == tm'
+        CArg x sc == CArg x' sc' =
+             case nameEq x x' of
+                  Just Refl => sc == sc'
+                  Nothing => False
+        _ == _ = False
+
     export
     covering
     Eq (CConAlt vars) where
-        MkConAlt n1 _ t1 a1 e1 == MkConAlt n2 _ t2 a2 e2 = t1 == t2 && n1 == n2 && case namesEq a1 a2 of
-            Just Refl => e1 == e2
-            Nothing => False
+        MkConAlt n1 _ t1 e1 == MkConAlt n2 _ t2 e2 = t1 == t2 && n1 == n2 && e1 == e2
 
     export
     covering
@@ -99,13 +107,25 @@ mutual
             tag (CErased {}) = 13
             tag (CCrash {}) = 14
 
+    export
+    covering
+    Ord (CCaseScope vars) where
+      compare (CRHS tm) (CRHS tm') = compare tm tm'
+      compare (CArg x sc) (CArg x' sc')
+          = case nameEq x x' of
+                 Just Refl => compare sc sc'
+                 Nothing => compare x x'
+      compare x y = compare (tag x) (tag y)
+        where
+          tag : CCaseScope vars -> Int
+          tag (CRHS{}) = 0
+          tag (CArg{}) = 1
+
     export
     covering
     Ord (CConAlt vars) where
-        MkConAlt n1 _ t1 a1 e1 `compare` MkConAlt n2 _ t2 a2 e2 =
-            compare t1 t2 `thenCmp` compare n1 n2 `thenCmp` case namesEq a1 a2 of
-                Just Refl => compare e1 e2
-                Nothing => compare a1 a2
+        MkConAlt n1 _ t1 e1 `compare` MkConAlt n2 _ t2 e2 =
+            compare t1 t2 `thenCmp` compare n1 n2 `thenCmp` compare e1 e2
 
     export
     covering
diff --git a/src/Core/Primitives.idr b/src/Core/Primitives.idr
index 1fe1a2a8cb4..03548fd5136 100644
--- a/src/Core/Primitives.idr
+++ b/src/Core/Primitives.idr
@@ -1,7 +1,7 @@
 module Core.Primitives
 
 import Core.TT
-import Core.Value
+import Core.Evaluate.Value
 import Libraries.Utils.String
 
 import Data.Vect
@@ -17,60 +17,60 @@ record Prim where
   totality : Totality
 
 binOp : (Constant -> Constant -> Maybe Constant) ->
-        Vect 2 (NF vars) -> Maybe (NF vars)
-binOp fn [NPrimVal fc x, NPrimVal _ y]
-    = map (NPrimVal fc) (fn x y)
+        {0 vars : _} -> Vect 2 (NF vars) -> Maybe (NF vars)
+binOp fn [VPrimVal fc x, VPrimVal _ y]
+    = map (VPrimVal fc) (fn x y)
 binOp _ _ = Nothing
 
 unaryOp : (Constant -> Maybe Constant) ->
-          Vect 1 (NF vars) -> Maybe (NF vars)
-unaryOp fn [NPrimVal fc x]
-    = map (NPrimVal fc) (fn x)
+          {0 vars : _} -> Vect 1 (NF vars) -> Maybe (NF vars)
+unaryOp fn [VPrimVal fc x]
+    = map (VPrimVal fc) (fn x)
 unaryOp _ _ = Nothing
 
 castString : Vect 1 (NF vars) -> Maybe (NF vars)
-castString [NPrimVal fc (I i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (I8 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (I16 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (I32 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (I64 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (BI i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (B8 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (B16 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (B32 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (B64 i)] = Just (NPrimVal fc (Str (show i)))
-castString [NPrimVal fc (Ch i)] = Just (NPrimVal fc (Str (stripQuotes (show i))))
-castString [NPrimVal fc (Db i)] = Just (NPrimVal fc (Str (show i)))
+castString [VPrimVal fc (I i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (I8 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (I16 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (I32 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (I64 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (BI i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (B8 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (B16 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (B32 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (B64 i)] = Just (VPrimVal fc (Str (show i)))
+castString [VPrimVal fc (Ch i)] = Just (VPrimVal fc (Str (stripQuotes (show i))))
+castString [VPrimVal fc (Db i)] = Just (VPrimVal fc (Str (show i)))
 castString _ = Nothing
 
 castInteger : Vect 1 (NF vars) -> Maybe (NF vars)
-castInteger [NPrimVal fc (I i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (I8 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (I16 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (I32 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (I64 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (B8 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (B16 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (B32 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (B64 i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (Ch i)] = Just (NPrimVal fc (BI (cast (cast {to=Int} i))))
-castInteger [NPrimVal fc (Db i)] = Just (NPrimVal fc (BI (cast i)))
-castInteger [NPrimVal fc (Str i)] = Just (NPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (I i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (I8 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (I16 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (I32 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (I64 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (B8 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (B16 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (B32 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (B64 i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (Ch i)] = Just (VPrimVal fc (BI (cast (cast {to=Int} i))))
+castInteger [VPrimVal fc (Db i)] = Just (VPrimVal fc (BI (cast i)))
+castInteger [VPrimVal fc (Str i)] = Just (VPrimVal fc (BI (cast i)))
 castInteger _ = Nothing
 
 castInt : Vect 1 (NF vars) -> Maybe (NF vars)
-castInt [NPrimVal fc (I8 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (I16 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (I32 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (I64 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (BI i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (B8 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (B16 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (B32 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (B64 i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (Db i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (Ch i)] = Just (NPrimVal fc (I (cast i)))
-castInt [NPrimVal fc (Str i)] = Just (NPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (I8 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (I16 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (I32 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (I64 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (BI i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (B8 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (B16 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (B32 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (B64 i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (Db i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (Ch i)] = Just (VPrimVal fc (I (cast i)))
+castInt [VPrimVal fc (Str i)] = Just (VPrimVal fc (I (cast i)))
 castInt _ = Nothing
 
 constantIntegerValue : Constant -> Maybe Integer
@@ -87,113 +87,113 @@ constantIntegerValue (B64 i) = Just $ cast i
 constantIntegerValue _       = Nothing
 
 castBits8 : Vect 1 (NF vars) -> Maybe (NF vars)
-castBits8 [NPrimVal fc constant] =
-    NPrimVal fc . B8 . cast <$> constantIntegerValue constant
+castBits8 [VPrimVal fc constant] =
+    VPrimVal fc . B8 . cast <$> constantIntegerValue constant
 castBits8 _ = Nothing
 
 castBits16 : Vect 1 (NF vars) -> Maybe (NF vars)
-castBits16 [NPrimVal fc constant] =
-    NPrimVal fc . B16 . cast <$> constantIntegerValue constant
+castBits16 [VPrimVal fc constant] =
+    VPrimVal fc . B16 . cast <$> constantIntegerValue constant
 castBits16 _ = Nothing
 
 castBits32 : Vect 1 (NF vars) -> Maybe (NF vars)
-castBits32 [NPrimVal fc constant] =
-    NPrimVal fc . B32 . cast <$> constantIntegerValue constant
+castBits32 [VPrimVal fc constant] =
+    VPrimVal fc . B32 . cast <$> constantIntegerValue constant
 castBits32 _ = Nothing
 
 castBits64 : Vect 1 (NF vars) -> Maybe (NF vars)
-castBits64 [NPrimVal fc constant] =
-    NPrimVal fc . B64 . cast <$> constantIntegerValue constant
+castBits64 [VPrimVal fc constant] =
+    VPrimVal fc . B64 . cast <$> constantIntegerValue constant
 castBits64 _ = Nothing
 
 castInt8 : Vect 1 (NF vars) -> Maybe (NF vars)
-castInt8 [NPrimVal fc constant] =
-    NPrimVal fc . I8 . cast <$> constantIntegerValue constant
+castInt8 [VPrimVal fc constant] =
+    VPrimVal fc . I8 . cast <$> constantIntegerValue constant
 castInt8 _ = Nothing
 
 castInt16 : Vect 1 (NF vars) -> Maybe (NF vars)
-castInt16 [NPrimVal fc constant] =
-    NPrimVal fc . I16 . cast <$> constantIntegerValue constant
+castInt16 [VPrimVal fc constant] =
+    VPrimVal fc . I16 . cast <$> constantIntegerValue constant
 castInt16 _ = Nothing
 
 castInt32 : Vect 1 (NF vars) -> Maybe (NF vars)
-castInt32 [NPrimVal fc constant] =
-    NPrimVal fc . I32 . cast <$> constantIntegerValue constant
+castInt32 [VPrimVal fc constant] =
+    VPrimVal fc . I32 . cast <$> constantIntegerValue constant
 castInt32 _ = Nothing
 
 castInt64 : Vect 1 (NF vars) -> Maybe (NF vars)
-castInt64 [NPrimVal fc constant] =
-    NPrimVal fc . I64 . cast <$> constantIntegerValue constant
+castInt64 [VPrimVal fc constant] =
+    VPrimVal fc . I64 . cast <$> constantIntegerValue constant
 castInt64 _ = Nothing
 
 castDouble : Vect 1 (NF vars) -> Maybe (NF vars)
-castDouble [NPrimVal fc (I i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (I8 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (I16 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (I32 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (I64 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (B8 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (B16 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (B32 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (B64 i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (BI i)] = Just (NPrimVal fc (Db (cast i)))
-castDouble [NPrimVal fc (Str i)] = Just (NPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (I i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (I8 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (I16 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (I32 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (I64 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (B8 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (B16 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (B32 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (B64 i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (BI i)] = Just (VPrimVal fc (Db (cast i)))
+castDouble [VPrimVal fc (Str i)] = Just (VPrimVal fc (Db (cast i)))
 castDouble _ = Nothing
 
 castChar : Vect 1 (NF vars) -> Maybe (NF vars)
-castChar [NPrimVal fc (I i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (I8 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (I16 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (I32 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (I64 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (B8 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (B16 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (B32 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (B64 i)] = Just (NPrimVal fc (Ch (cast i)))
-castChar [NPrimVal fc (BI i)] = Just (NPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (I i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (I8 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (I16 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (I32 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (I64 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (B8 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (B16 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (B32 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (B64 i)] = Just (VPrimVal fc (Ch (cast i)))
+castChar [VPrimVal fc (BI i)] = Just (VPrimVal fc (Ch (cast i)))
 castChar _ = Nothing
 
 strLength : Vect 1 (NF vars) -> Maybe (NF vars)
-strLength [NPrimVal fc (Str s)] = Just (NPrimVal fc (I (cast (length s))))
+strLength [VPrimVal fc (Str s)] = Just (VPrimVal fc (I (cast (length s))))
 strLength _ = Nothing
 
 strHead : Vect 1 (NF vars) -> Maybe (NF vars)
-strHead [NPrimVal fc (Str "")] = Nothing
-strHead [NPrimVal fc (Str str)]
-    = Just (NPrimVal fc (Ch (assert_total (prim__strHead str))))
+strHead [VPrimVal fc (Str "")] = Nothing
+strHead [VPrimVal fc (Str str)]
+    = Just (VPrimVal fc (Ch (assert_total (prim__strHead str))))
 strHead _ = Nothing
 
 strTail : Vect 1 (NF vars) -> Maybe (NF vars)
-strTail [NPrimVal fc (Str "")] = Nothing
-strTail [NPrimVal fc (Str str)]
-    = Just (NPrimVal fc (Str (assert_total (prim__strTail str))))
+strTail [VPrimVal fc (Str "")] = Nothing
+strTail [VPrimVal fc (Str str)]
+    = Just (VPrimVal fc (Str (assert_total (prim__strTail str))))
 strTail _ = Nothing
 
 strIndex : Vect 2 (NF vars) -> Maybe (NF vars)
-strIndex [NPrimVal fc (Str str), NPrimVal _ (I i)]
+strIndex [VPrimVal fc (Str str), VPrimVal _ (I i)]
     = if i >= 0 && integerToNat (cast i) < length str
-         then Just (NPrimVal fc (Ch (assert_total (prim__strIndex str i))))
+         then Just (VPrimVal fc (Ch (assert_total (prim__strIndex str i))))
          else Nothing
 strIndex _ = Nothing
 
 strCons : Vect 2 (NF vars) -> Maybe (NF vars)
-strCons [NPrimVal fc (Ch x), NPrimVal _ (Str y)]
-    = Just (NPrimVal fc (Str (strCons x y)))
+strCons [VPrimVal fc (Ch x), VPrimVal _ (Str y)]
+    = Just (VPrimVal fc (Str (strCons x y)))
 strCons _ = Nothing
 
 strAppend : Vect 2 (NF vars) -> Maybe (NF vars)
-strAppend [NPrimVal fc (Str x), NPrimVal _ (Str y)]
-    = Just (NPrimVal fc (Str (x ++ y)))
+strAppend [VPrimVal fc (Str x), VPrimVal _ (Str y)]
+    = Just (VPrimVal fc (Str (x ++ y)))
 strAppend _ = Nothing
 
 strReverse : Vect 1 (NF vars) -> Maybe (NF vars)
-strReverse [NPrimVal fc (Str x)]
-    = Just (NPrimVal fc (Str (reverse x)))
+strReverse [VPrimVal fc (Str x)]
+    = Just (VPrimVal fc (Str (reverse x)))
 strReverse _ = Nothing
 
 strSubstr : Vect 3 (NF vars) -> Maybe (NF vars)
-strSubstr [NPrimVal fc (I start), NPrimVal _ (I len), NPrimVal _ (Str str)]
-    = Just (NPrimVal fc (Str (prim__strSubstr start len str)))
+strSubstr [VPrimVal fc (I start), VPrimVal _ (I len), VPrimVal _ (Str str)]
+    = Just (VPrimVal fc (Str (prim__strSubstr start len str)))
 strSubstr _ = Nothing
 
 
@@ -452,7 +452,7 @@ gt (Db x) (Db y) = pure $ toInt (x > y)
 gt _ _ = Nothing
 
 doubleOp : (Double -> Double) -> Vect 1 (NF vars) -> Maybe (NF vars)
-doubleOp f [NPrimVal fc (Db x)] = Just (NPrimVal fc (Db (f x)))
+doubleOp f [VPrimVal fc (Db x)] = Just (VPrimVal fc (Db (f x)))
 doubleOp f _ = Nothing
 
 doubleExp : Vect 1 (NF vars) -> Maybe (NF vars)
@@ -461,7 +461,7 @@ doubleExp = doubleOp exp
 doubleLog : Vect 1 (NF vars) -> Maybe (NF vars)
 doubleLog = doubleOp log
 
-doublePow : {vars : _ } -> Vect 2 (NF vars) -> Maybe (NF vars)
+doublePow : {0 vars : _ } -> Vect 2 (NF vars) -> Maybe (NF vars)
 doublePow = binOp pow'
     where pow' : Constant -> Constant -> Maybe Constant
           pow' (Db x) (Db y) = pure $ Db (pow x y)
@@ -496,10 +496,10 @@ doubleCeiling = doubleOp ceiling
 
 -- Only reduce for concrete values
 believeMe : Vect 3 (NF vars) -> Maybe (NF vars)
-believeMe [_, _, val@(NDCon {})] = Just val
-believeMe [_, _, val@(NTCon {})] = Just val
-believeMe [_, _, val@(NPrimVal {})] = Just val
-believeMe [_, _, NType fc u] = Just (NType fc u)
+believeMe [_, _, val@(VDCon {})] = Just val
+believeMe [_, _, val@(VTCon {})] = Just val
+believeMe [_, _, val@(VPrimVal {})] = Just val
+believeMe [_, _, VType fc u] = Just (VType fc u)
 believeMe [_, _, val] = Nothing
 
 primTyVal : PrimType -> ClosedTerm
@@ -531,7 +531,7 @@ doubleTy : ClosedTerm
 doubleTy = predTy DoubleType DoubleType
 
 pi : (x : String) -> RigCount -> PiInfo (Term xs) -> Term xs ->
-     Term (UN (Basic x) :: xs) -> Term xs
+     Term (Scope.bind xs $ UN (Basic x)) -> Term xs
 pi x rig plic ty sc = Bind emptyFC (UN (Basic x)) (Pi emptyFC rig plic ty) sc
 
 believeMeTy : ClosedTerm
@@ -565,7 +565,7 @@ castTo WorldType = const Nothing
 
 export
 getOp : {0 arity : Nat} -> PrimFn arity ->
-        {vars : Scope} -> Vect arity (NF vars) -> Maybe (NF vars)
+        {0 vars : Scope} -> Vect arity (NF vars) -> Maybe (NF vars)
 getOp (Add ty) = binOp add
 getOp (Sub ty) = binOp sub
 getOp (Mul ty) = binOp mul
diff --git a/src/Core/Reflect.idr b/src/Core/Reflect.idr
index c415b9599d1..e53ceddf796 100644
--- a/src/Core/Reflect.idr
+++ b/src/Core/Reflect.idr
@@ -4,8 +4,11 @@ import Data.List1
 
 import Core.Context
 import Core.Env
-import Core.Normalise
-import Core.Value
+import Core.Evaluate
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+
+import Data.SnocList
 
 import Libraries.Data.WithDefault
 
@@ -24,23 +27,39 @@ interface Reflect a where
             FC -> Defs -> (onLHS : Bool) ->
             Env Term vars -> a -> Core (Term vars)
 
+export
+spineFull : {vars: _} -> {auto c : Ref Ctxt Defs} ->
+        Spine vars -> Core (List (NF vars))
+spineFull sp = pure $ cast !(traverseSnocList spineValFull sp)
+
 export
 getCon : {vars : _} ->
          FC -> Defs -> Name -> Core (Term vars)
 getCon fc defs n
     = case !(lookupDefExact n (gamma defs)) of
-           Just (DCon t a _) => resolved (gamma defs) (Ref fc (DataCon t a) n)
+           Just (DCon _ t a) => resolved (gamma defs) (Ref fc (DataCon t a) n)
            Just (TCon a _ _ _ _ _ _) => resolved (gamma defs) (Ref fc (TyCon a) n)
            Just _ => resolved (gamma defs) (Ref fc Func n)
            _ => throw (UndefinedName fc n)
 
 export
 appCon : {vars : _} ->
-         FC -> Defs -> Name -> List (Term vars) -> Core (Term vars)
+         FC -> Defs -> Name -> List (RigCount, Term vars) -> Core (Term vars)
 appCon fc defs n args
     = do fn <- getCon fc defs n
          resolved (gamma defs) (apply fc fn args)
 
+export
+appConTop : {vars : _} ->
+         FC -> Defs -> Name -> List (Term vars) -> Core (Term vars)
+appConTop fc defs n args
+    = do fn <- getCon fc defs n
+         resolved (gamma defs) (apply fc fn (map (top,) args))
+
+export
+blank : FC -> (RigCount, Term vars)
+blank fc = (erased, Erased fc Placeholder)
+
 export
 preludetypes : String -> Name
 preludetypes n = NS typesNS (UN $ Basic n)
@@ -73,7 +92,7 @@ export
 cantReify : Ref Ctxt Defs => {vars : _} -> NF vars -> String -> Core a
 cantReify val ty = do
   logNF "reflection.reify" 10 "Can't reify as \{ty}" (mkEnv emptyFC vars) val
-  throw (GenericMsg (getLoc val) ("Can't reify as " ++ ty))
+  throw (GenericMsg (getLoc val) ("Can't reify as " ++ ty ++ ": \{show !(toFullNames val)}"))
 
 export
 cantReflect : FC -> String -> Core a
@@ -90,7 +109,7 @@ Reflect () where
 
 export
 Reify String where
-  reify defs (NPrimVal _ (Str str)) = pure str
+  reify defs (VPrimVal _ (Str str)) = pure str
   reify defs val = cantReify val "String"
 
 export
@@ -99,7 +118,7 @@ Reflect String where
 
 export
 Reify Int where
-  reify defs (NPrimVal _ (I v)) = pure v
+  reify defs (VPrimVal _ (I v)) = pure v
   reify defs val = cantReify val "Int"
 
 export
@@ -108,7 +127,7 @@ Reflect Int where
 
 export
 Reify Int8 where
-  reify defs (NPrimVal _ (I8 v)) = pure v
+  reify defs (VPrimVal _ (I8 v)) = pure v
   reify defs val = cantReify val "Int8"
 
 export
@@ -117,7 +136,7 @@ Reflect Int8 where
 
 export
 Reify Int16 where
-  reify defs (NPrimVal _ (I16 v)) = pure v
+  reify defs (VPrimVal _ (I16 v)) = pure v
   reify defs val = cantReify val "Int16"
 
 export
@@ -126,7 +145,7 @@ Reflect Int16 where
 
 export
 Reify Int32 where
-  reify defs (NPrimVal _ (I32 v)) = pure v
+  reify defs (VPrimVal _ (I32 v)) = pure v
   reify defs val = cantReify val "Int32"
 
 export
@@ -135,7 +154,7 @@ Reflect Int32 where
 
 export
 Reify Int64 where
-  reify defs (NPrimVal _ (I64 v)) = pure v
+  reify defs (VPrimVal _ (I64 v)) = pure v
   reify defs val = cantReify val "Int64"
 
 export
@@ -144,7 +163,7 @@ Reflect Int64 where
 
 export
 Reify Bits8 where
-  reify defs (NPrimVal _ (B8 v)) = pure v
+  reify defs (VPrimVal _ (B8 v)) = pure v
   reify defs val = cantReify val "Bits8"
 
 export
@@ -153,7 +172,7 @@ Reflect Bits8 where
 
 export
 Reify Bits16 where
-  reify defs (NPrimVal _ (B16 v)) = pure v
+  reify defs (VPrimVal _ (B16 v)) = pure v
   reify defs val = cantReify val "Bits16"
 
 export
@@ -162,7 +181,7 @@ Reflect Bits16 where
 
 export
 Reify Bits32 where
-  reify defs (NPrimVal _ (B32 v)) = pure v
+  reify defs (VPrimVal _ (B32 v)) = pure v
   reify defs val = cantReify val "Bits32"
 
 export
@@ -171,7 +190,7 @@ Reflect Bits32 where
 
 export
 Reify Bits64 where
-  reify defs (NPrimVal _ (B64 v)) = pure v
+  reify defs (VPrimVal _ (B64 v)) = pure v
   reify defs val = cantReify val "Bits64"
 
 export
@@ -180,7 +199,7 @@ Reflect Bits64 where
 
 export
 Reify Integer where
-  reify defs (NPrimVal _ (BI v)) = pure v
+  reify defs (VPrimVal _ (BI v)) = pure v
   reify defs val = cantReify val "Integer"
 
 export
@@ -189,7 +208,7 @@ Reflect Integer where
 
 export
 Reify Char where
-  reify defs (NPrimVal _ (Ch v)) = pure v
+  reify defs (VPrimVal _ (Ch v)) = pure v
   reify defs val = cantReify val "Char"
 
 export
@@ -198,7 +217,7 @@ Reflect Char where
 
 export
 Reify Double where
-  reify defs (NPrimVal _ (Db v)) = pure v
+  reify defs (VPrimVal _ (Db v)) = pure v
   reify defs val = cantReify val "Double"
 
 export
@@ -207,7 +226,7 @@ Reflect Double where
 
 export
 Reify Bool where
-  reify defs val@(NDCon _ n _ _ _)
+  reify defs val@(VDCon _ n _ _ _)
       = case dropAllNS !(full (gamma defs) n) of
             UN (Basic "True") => pure True
             UN (Basic "False") => pure False
@@ -221,11 +240,11 @@ Reflect Bool where
 
 export
 Reify Nat where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "Z"), _) => pure Z
-             (UN (Basic "S"), [(_, k)])
-                 => do k' <- reify defs !(evalClosure defs k)
+             (UN (Basic "S"), [k])
+                 => do k' <- reify defs !(expandFull k)
                        pure (S k')
              _ => cantReify val "Nat"
   reify defs val = cantReify val "Nat"
@@ -235,35 +254,37 @@ Reflect Nat where
   reflect fc defs lhs env Z = getCon fc defs (preludetypes "Z")
   reflect fc defs lhs env (S k)
       = do k' <- reflect fc defs lhs env k
-           appCon fc defs (preludetypes "S") [k']
+           appCon fc defs (preludetypes "S") [(top, k')]
 
 export
 Reify a => Reify (List a) where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "Nil"), _) => pure []
-             (UN (Basic "::"), [_, (_, x), (_, xs)])
-                  => do x' <- reify defs !(evalClosure defs x)
-                        xs' <- reify defs !(evalClosure defs xs)
+             (UN (Basic "::"), [_, x, xs])
+                  => do x' <- reify defs !(expandFull x)
+                        xs' <- reify defs !(expandFull xs)
                         pure (x' :: xs')
              _ => cantReify val "List"
   reify defs val = cantReify val "List"
 
 export
 Reflect a => Reflect (List a) where
-  reflect fc defs lhs env [] = appCon fc defs (basics "Nil") [Erased fc Placeholder]
+  reflect fc defs lhs env []
+      = appCon fc defs (basics "Nil") [blank fc]
   reflect fc defs lhs env (x :: xs)
       = do x' <- reflect fc defs lhs env x
            xs' <- reflect fc defs lhs env xs
-           appCon fc defs (basics "::") [Erased fc Placeholder, x', xs']
+           appCon fc defs (basics "::") [blank fc,
+                                         (top, x'), (top, xs')]
 
 export
 Reify a => Reify (List1 a) where
-  reify defs val@(NDCon _ n _ _ [_, (_, x), (_, xs)])
-      = case dropAllNS !(full (gamma defs) n) of
-             UN (Basic ":::")
-                  => do x' <- reify defs !(evalClosure defs x)
-                        xs' <- reify defs !(evalClosure defs xs)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic ":::"), [_, x, xs])
+                  => do x' <- reify defs !(expandFull x)
+                        xs' <- reify defs !(expandFull xs)
                         pure (x' ::: xs')
              _ => cantReify val "List1"
   reify defs val = cantReify val "List1"
@@ -274,74 +295,74 @@ Reflect a => Reflect (List1 a) where
       = do x' <- reflect fc defs lhs env (head xxs)
            xs' <- reflect fc defs lhs env (tail xxs)
            appCon fc defs (NS (mkNamespace "Data.List1")
-                  (UN $ Basic ":::")) [Erased fc Placeholder, x', xs']
+                  (UN $ Basic ":::")) [blank fc,
+                                       (top, x'), (top, xs')]
 
 export
 Reify a => Reify (SnocList a) where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "Lin"), _) => pure [<]
-             (UN (Basic ":<"), [_, (_, sx), (_, x)])
-                  => do sx' <- reify defs !(evalClosure defs sx)
-                        x' <- reify defs !(evalClosure defs x)
+             (UN (Basic ":<"), [_, sx, x])
+                  => do sx' <- reify defs !(expandFull sx)
+                        x' <- reify defs !(expandFull x)
                         pure (sx' :< x')
              _ => cantReify val "SnocList"
   reify defs val = cantReify val "SnocList"
 
 export
 Reflect a => Reflect (SnocList a) where
-  reflect fc defs lhs env [<] = appCon fc defs (basics "Lin") [Erased fc Placeholder]
+  reflect fc defs lhs env [<] = appCon fc defs (basics "Lin") [blank fc]
   reflect fc defs lhs env (sx :< x)
       = do sx' <- reflect fc defs lhs env sx
            x' <- reflect fc defs lhs env x
-           appCon fc defs (basics ":<") [Erased fc Placeholder, sx', x']
+           appCon fc defs (basics ":<") [blank fc, (top, sx'), (top, x')]
 
 export
 Reify a => Reify (Maybe a) where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "Nothing"), _) => pure Nothing
-             (UN (Basic "Just"), [_, (_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "Just"), [_, x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (Just x')
              _ => cantReify val "Maybe"
   reify defs val = cantReify val "Maybe"
 
 export
 Reflect a => Reflect (Maybe a) where
-  reflect fc defs lhs env Nothing = appCon fc defs (preludetypes "Nothing") [Erased fc Placeholder]
+  reflect fc defs lhs env Nothing
+      = appCon fc defs (preludetypes "Nothing") [blank fc]
   reflect fc defs lhs env (Just x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (preludetypes "Just") [Erased fc Placeholder, x']
+           appCon fc defs (preludetypes "Just") [blank fc, (top, x')]
 
 
 export
 Reify a => Reify (WithDefault a def) where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "DefaultedValue"), _) => pure defaulted
-             (UN (Basic "SpecifiedValue"), [_, _, (_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
-                        pure (specified x')
+             (UN (Basic "SpecifiedValue"), [_, _, x]) => do x' <- reify defs !(expandFull x)
+                                                            pure (specified x')
              _ => cantReify val "WithDefault"
   reify defs val = cantReify val "WithDefault"
 
 export
 Reflect a => Reflect (WithDefault a def) where
-  reflect fc defs lhs env def
-    = onWithDefault
-        (appCon fc defs (reflectionttimp "DefaultedValue") [Erased fc Placeholder, Erased fc Placeholder])
-        (\x => do x' <- reflect fc defs lhs env x
-                  appCon fc defs (reflectionttimp "SpecifiedValue") [Erased fc Placeholder, Erased fc Placeholder, x'])
-        def
+  reflect fc defs lhs env
+      = onWithDefault
+          (appCon fc defs (reflectionttimp "DefaultedValue") [blank fc, blank fc])
+          (\x => do x' <- reflect fc defs lhs env x
+                    appCon fc defs (reflectionttimp "SpecifiedValue") [blank fc, blank fc, (top, x')])
 
 export
 (Reify a, Reify b) => Reify (a, b) where
-  reify defs val@(NDCon _ n _ _ [_, _, (_, x), (_, y)])
-      = case dropAllNS !(full (gamma defs) n) of
-             UN (Basic "MkPair")
-                 => do x' <- reify defs !(evalClosure defs x)
-                       y' <- reify defs !(evalClosure defs y)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "MkPair"), [_, _, x, y])
+                 => do x' <- reify defs !(expandFull x)
+                       y' <- reify defs !(expandFull y)
                        pure (x', y')
              _ => cantReify val "Pair"
   reify defs val = cantReify val "Pair"
@@ -351,14 +372,15 @@ export
   reflect fc defs lhs env (x, y)
       = do x' <- reflect fc defs lhs env x
            y' <- reflect fc defs lhs env y
-           appCon fc defs (builtin "MkPair") [Erased fc Placeholder, Erased fc Placeholder, x', y']
+           appCon fc defs (builtin "MkPair") [blank fc, blank fc,
+                                              (top, x'), (top, y')]
 
 export
 Reify Namespace where
-  reify defs val@(NDCon _ n _ _ [(_, ns)])
-    = case dropAllNS !(full (gamma defs) n) of
-        UN (Basic "MkNS")
-          => do ns' <- reify defs !(evalClosure defs ns)
+  reify defs val@(VDCon _ n _ _ args)
+    = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+        (UN (Basic "MkNS"), [ns])
+          => do ns' <- reify defs !(expandFull ns)
                 pure (unsafeFoldNamespace ns')
         _ => cantReify val "Namespace"
   reify defs val = cantReify val "Namespace"
@@ -367,14 +389,14 @@ export
 Reflect Namespace where
   reflect fc defs lhs env ns
     = do ns' <- reflect fc defs lhs env (unsafeUnfoldNamespace ns)
-         appCon fc defs (reflectiontt "MkNS") [ns']
+         appCon fc defs (reflectiontt "MkNS") [(top, ns')]
 
 export
 Reify ModuleIdent where
-  reify defs val@(NDCon _ n _ _ [(_, ns)])
-    = case dropAllNS !(full (gamma defs) n) of
-        UN (Basic "MkMI")
-          => do ns' <- reify defs !(evalClosure defs ns)
+  reify defs val@(VDCon _ n _ _ args)
+    = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+        (UN (Basic "MkMI"), [ns])
+          => do ns' <- reify defs !(expandFull ns)
                 pure (unsafeFoldModuleIdent ns')
         _ => cantReify val "ModuleIdent"
   reify defs val = cantReify val "ModuleIdent"
@@ -383,101 +405,101 @@ export
 Reflect ModuleIdent where
   reflect fc defs lhs env ns
     = do ns' <- reflect fc defs lhs env (unsafeUnfoldModuleIdent ns)
-         appCon fc defs (reflectiontt "MkMI") [ns']
+         appCon fc defs (reflectiontt "MkMI") [(top, ns')]
 
 export
 Reify UserName where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "Basic"), [(_, str)])
-                 => do str' <- reify defs !(evalClosure defs str)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "Basic"), [str])
+                 => do str' <- reify defs !(expandFull str)
                        pure (Basic str')
-             (UN (Basic "Field"), [(_, str)])
-                 => do str' <- reify defs !(evalClosure defs str)
+             (UN (Basic "Field"), [str])
+                 => do str' <- reify defs !(expandFull str)
                        pure (Field str')
              (UN (Basic "Underscore"), [])
                  => pure Underscore
              (NS _ (UN _), _)
-                 => cantReify val "Name, reifying it is unimplemented or intentionally internal"
-             _ => cantReify val "Name, the name was not found in context"
-  reify defs val = cantReify val "Name, value is not an NDCon interally"
+                 => cantReify val "UserName, reifying it is unimplemented or intentionally internal"
+             _ => cantReify val "UserName, the name was not found in context"
+  reify defs val = cantReify val "UserName, value is not an VDCon interally"
 
 export
 Reflect UserName where
   reflect fc defs lhs env (Basic x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "Basic") [x']
+           appCon fc defs (reflectiontt "Basic") [(top, x')]
   reflect fc defs lhs env (Field x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "Field") [x']
+           appCon fc defs (reflectiontt "Field") [(top, x')]
   reflect fc defs lhs env Underscore
       = do appCon fc defs (reflectiontt "Underscore") []
 
 export
 Reify Name where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "UN"), [(_, str)])
-                 => do str' <- reify defs !(evalClosure defs str)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "UN"), [str])
+                 => do str' <- reify defs !(expandFull str)
                        pure (UN str')
-             (UN (Basic "MN"), [(_, str), (_, i)])
-                 => do str' <- reify defs !(evalClosure defs str)
-                       i' <- reify defs !(evalClosure defs i)
+             (UN (Basic "MN"), [str, i])
+                 => do str' <- reify defs !(expandFull str)
+                       i' <- reify defs !(expandFull i)
                        pure (MN str' i')
-             (UN (Basic "NS"), [(_, ns), (_, n)])
-                 => do ns' <- reify defs !(evalClosure defs ns)
-                       n' <- reify defs !(evalClosure defs n)
+             (UN (Basic "NS"), [ns, n])
+                 => do ns' <- reify defs !(expandFull ns)
+                       n' <- reify defs !(expandFull n)
                        pure (NS ns' n')
-             (UN (Basic "DN"), [(_, str), (_, n)])
-                 => do str' <- reify defs !(evalClosure defs str)
-                       n' <- reify defs !(evalClosure defs n)
+             (UN (Basic "DN"), [str, n])
+                 => do str' <- reify defs !(expandFull str)
+                       n' <- reify defs !(expandFull n)
                        pure (DN str' n')
-             (UN (Basic "Nested"), [(_, ix), (_, n)])
-                 => do ix' <- reify defs !(evalClosure defs ix)
-                       n' <- reify defs !(evalClosure defs n)
+             (UN (Basic "Nested"), [ix, n])
+                 => do ix' <- reify defs !(expandFull ix)
+                       n' <- reify defs !(expandFull n)
                        pure (Nested ix' n')
-             (UN (Basic "CaseBlock"), [(_, outer), (_, i)])
-                 => do outer' <- reify defs !(evalClosure defs outer)
-                       i' <- reify defs !(evalClosure defs i)
+             (UN (Basic "CaseBlock"), [outer, i])
+                 => do outer' <- reify defs !(expandFull outer)
+                       i' <- reify defs !(expandFull i)
                        pure (CaseBlock outer' i')
-             (UN (Basic "WithBlock"), [(_, outer), (_, i)])
-                 => do outer' <- reify defs !(evalClosure defs outer)
-                       i' <- reify defs !(evalClosure defs i)
+             (UN (Basic "WithBlock"), [outer, i])
+                 => do outer' <- reify defs !(expandFull outer)
+                       i' <- reify defs !(expandFull i)
                        pure (WithBlock outer' i')
              (NS _ (UN _), _)
                  => cantReify val "Name, reifying it is unimplemented or intentionally internal"
              _ => cantReify val "Name, the name was not found in context"
-  reify defs val = cantReify val "Name, value is not an NDCon interally"
+  reify defs val = cantReify val "Name, value is not an VDCon interally"
 
 export
 Reflect Name where
   reflect fc defs lhs env (UN x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "UN") [x']
+           appCon fc defs (reflectiontt "UN") [(top, x')]
   reflect fc defs lhs env (MN x i)
       = do x' <- reflect fc defs lhs env x
            i' <- reflect fc defs lhs env i
-           appCon fc defs (reflectiontt "MN") [x', i']
+           appCon fc defs (reflectiontt "MN") [(top, x'), (top, i')]
   reflect fc defs lhs env (NS ns n)
       = do ns' <- reflect fc defs lhs env ns
            n' <- reflect fc defs lhs env n
-           appCon fc defs (reflectiontt "NS") [ns', n']
+           appCon fc defs (reflectiontt "NS") [(top, ns'), (top, n')]
   reflect fc defs lhs env (DN str n)
       = do str' <- reflect fc defs lhs env str
            n' <- reflect fc defs lhs env n
-           appCon fc defs (reflectiontt "DN") [str', n']
+           appCon fc defs (reflectiontt "DN") [(top, str'), (top, n')]
   reflect fc defs lhs env (Nested ix n)
       = do ix' <- reflect fc defs lhs env ix
            n'  <- reflect fc defs lhs env n
-           appCon fc defs (reflectiontt "Nested") [ix',n']
+           appCon fc defs (reflectiontt "Nested") [(top, ix'),(top, n')]
   reflect fc defs lhs env (CaseBlock outer i)
       = do outer' <- reflect fc defs lhs env outer
            i' <- reflect fc defs lhs env i
-           appCon fc defs (reflectiontt "CaseBlock") [outer',i']
+           appCon fc defs (reflectiontt "CaseBlock") [(top, outer'),(top, i')]
   reflect fc defs lhs env (WithBlock outer i)
       = do outer' <- reflect fc defs lhs env outer
            i' <- reflect fc defs lhs env i
-           appCon fc defs (reflectiontt "WithBlock") [outer',i']
+           appCon fc defs (reflectiontt "WithBlock") [(top, outer'),(top, i')]
   reflect fc defs lhs env (Resolved i)
       = case !(full (gamma defs) (Resolved i)) of
              Resolved _ => cantReflect fc
@@ -488,16 +510,16 @@ Reflect Name where
 
 export
 Reify NameType where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "Bound"), _) => pure Bound
              (UN (Basic "Func"), _) => pure Func
-             (UN (Basic "DataCon"), [(_, t), (_, i)])
-                  => do t' <- reify defs !(evalClosure defs t)
-                        i' <- reify defs !(evalClosure defs i)
+             (UN (Basic "DataCon"), [t, i])
+                  => do t' <- reify defs !(expandFull t)
+                        i' <- reify defs !(expandFull i)
                         pure (DataCon t' i')
-             (UN (Basic "TyCon"), [(_, i)])
-                  => do i' <- reify defs !(evalClosure defs i)
+             (UN (Basic "TyCon"), [i])
+                  => do i' <- reify defs !(expandFull i)
                         pure (TyCon i')
              _ => cantReify val "NameType"
   reify defs val = cantReify val "NameType"
@@ -509,15 +531,15 @@ Reflect NameType where
   reflect fc defs lhs env (DataCon t i)
       = do t' <- reflect fc defs lhs env t
            i' <- reflect fc defs lhs env i
-           appCon fc defs (reflectiontt "DataCon") [t', i']
+           appCon fc defs (reflectiontt "DataCon") [(top, t'), (top, i')]
   reflect fc defs lhs env (TyCon i)
       = do i' <- reflect fc defs lhs env i
-           appCon fc defs (reflectiontt "TyCon") [PrimVal fc (I 0), i']
+           appCon fc defs (reflectiontt "TyCon") [(top, PrimVal fc (I 0)), (top, i')]
 
 export
 Reify PrimType where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "IntType"), [])
                   => pure IntType
              (UN (Basic "Int8Type"), [])
@@ -551,49 +573,49 @@ Reify PrimType where
 
 export
 Reify Constant where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "I"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "I"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (I x')
-             (UN (Basic "I8"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "I8"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (I8 x')
-             (UN (Basic "I16"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "I16"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (I16 x')
-             (UN (Basic "I32"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "I32"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (I32 x')
-             (UN (Basic "I64"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "I64"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (I64 x')
-             (UN (Basic "BI"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "BI"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (BI x')
-             (UN (Basic "B8"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "B8"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (B8 x')
-             (UN (Basic "B16"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "B16"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (B16 x')
-             (UN (Basic "B32"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "B32"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (B32 x')
-             (UN (Basic "B64"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "B64"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (B64 x')
-             (UN (Basic "Str"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "Str"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (Str x')
-             (UN (Basic "Ch"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "Ch"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (Ch x')
-             (UN (Basic "Db"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "Db"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (Db x')
-             (UN (Basic "PrT"), [(_, x)])
-                  => do x' <- reify defs !(evalClosure defs x)
+             (UN (Basic "PrT"), [x])
+                  => do x' <- reify defs !(expandFull x)
                         pure (PrT x')
              (UN (Basic "WorldVal"), [])
                   => pure WorldVal
@@ -635,52 +657,52 @@ export
 Reflect Constant where
   reflect fc defs lhs env (I x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "I") [x']
+           appCon fc defs (reflectiontt "I") [(top, x')]
   reflect fc defs lhs env (I8 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "I8") [x']
+           appCon fc defs (reflectiontt "I8") [(top, x')]
   reflect fc defs lhs env (I16 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "I16") [x']
+           appCon fc defs (reflectiontt "I16") [(top, x')]
   reflect fc defs lhs env (I32 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "I32") [x']
+           appCon fc defs (reflectiontt "I32") [(top, x')]
   reflect fc defs lhs env (I64 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "I64") [x']
+           appCon fc defs (reflectiontt "I64") [(top, x')]
   reflect fc defs lhs env (BI x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "BI") [x']
+           appCon fc defs (reflectiontt "BI") [(top, x')]
   reflect fc defs lhs env (B8 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "B8") [x']
+           appCon fc defs (reflectiontt "B8") [(top, x')]
   reflect fc defs lhs env (B16 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "B16") [x']
+           appCon fc defs (reflectiontt "B16") [(top, x')]
   reflect fc defs lhs env (B32 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "B32") [x']
+           appCon fc defs (reflectiontt "B32") [(top, x')]
   reflect fc defs lhs env (B64 x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "B64") [x']
+           appCon fc defs (reflectiontt "B64") [(top, x')]
   reflect fc defs lhs env (Str x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "Str") [x']
+           appCon fc defs (reflectiontt "Str") [(top, x')]
   reflect fc defs lhs env (Ch x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "Ch") [x']
+           appCon fc defs (reflectiontt "Ch") [(top, x')]
   reflect fc defs lhs env (Db x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "Db") [x']
+           appCon fc defs (reflectiontt "Db") [(top, x')]
   reflect fc defs lhs env (PrT x)
       = do x' <- reflect fc defs lhs env x
-           appCon fc defs (reflectiontt "PrT") [x']
+           appCon fc defs (reflectiontt "PrT") [(top, x')]
   reflect fc defs lhs env WorldVal
       = getCon fc defs (reflectiontt "WorldVal")
 
 export
 Reify Visibility where
-  reify defs val@(NDCon _ n _ _ _)
+  reify defs val@(VDCon _ n _ _ _)
       = case dropAllNS !(full (gamma defs) n) of
              UN (Basic "Private") => pure Private
              UN (Basic "Export") => pure Export
@@ -696,7 +718,7 @@ Reflect Visibility where
 
 export
 Reify TotalReq where
-  reify defs val@(NDCon _ n _ _ _)
+  reify defs val@(VDCon _ n _ _ _)
       = case dropAllNS !(full (gamma defs) n) of
              UN (Basic "Total") => pure Total
              UN (Basic "CoveringOnly") => pure CoveringOnly
@@ -712,7 +734,7 @@ Reflect TotalReq where
 
 export
 Reify RigCount where
-  reify defs val@(NDCon _ n _ _ _)
+  reify defs val@(VDCon _ n _ _ _)
       = case dropAllNS !(full (gamma defs) n) of
              UN (Basic "M0") => pure erased
              UN (Basic "M1") => pure linear
@@ -730,13 +752,13 @@ Reflect RigCount where
 
 export
 Reify t => Reify (PiInfo t) where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "ImplicitArg"), _) => pure Implicit
              (UN (Basic "ExplicitArg"), _) => pure Explicit
              (UN (Basic "AutoImplicit"), _) => pure AutoImplicit
-             (UN (Basic "DefImplicit"), [_, (_, t)])
-                 => do t' <- reify defs !(evalClosure defs t)
+             (UN (Basic "DefImplicit"), [_, t])
+                 => do t' <- reify defs !(expandFull t)
                        pure (DefImplicit t')
              _ => cantReify val "PiInfo"
   reify defs val = cantReify val "PiInfo"
@@ -744,18 +766,18 @@ Reify t => Reify (PiInfo t) where
 export
 Reflect t => Reflect (PiInfo t) where
   reflect fc defs lhs env Implicit
-      = appCon fc defs (reflectiontt "ImplicitArg") [Erased fc Placeholder]
+      = appCon fc defs (reflectiontt "ImplicitArg") [blank fc]
   reflect fc defs lhs env Explicit
-      = appCon fc defs (reflectiontt "ExplicitArg") [Erased fc Placeholder]
+      = appCon fc defs (reflectiontt "ExplicitArg") [blank fc]
   reflect fc defs lhs env AutoImplicit
-      = appCon fc defs (reflectiontt "AutoImplicit") [Erased fc Placeholder]
+      = appCon fc defs (reflectiontt "AutoImplicit") [blank fc]
   reflect fc defs lhs env (DefImplicit t)
       = do t' <- reflect fc defs lhs env t
-           appCon fc defs (reflectiontt "DefImplicit") [Erased fc Placeholder, t']
+           appCon fc defs (reflectiontt "DefImplicit") [blank fc, (top, t')]
 
 export
 Reify LazyReason where
-  reify defs val@(NDCon _ n _ _ _)
+  reify defs val@(VDCon _ n _ _ _)
       = case dropAllNS !(full (gamma defs) n) of
              UN (Basic "LInf") => pure LInf
              UN (Basic "LLazy") => pure LLazy
@@ -771,9 +793,9 @@ Reflect LazyReason where
 
 export
 Reify VirtualIdent where
-  reify defs val@(NDCon _ n _ _ args)
+  reify defs val@(VDCon _ n _ _ args)
       = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "Interactive"), [])
+             (UN (Basic "Interactive"), [<])
                    => pure Interactive
              _ => cantReify val "VirtualIdent"
   reify defs val = cantReify val "VirtualIdent"
@@ -789,13 +811,13 @@ Reflect BuiltinType where
 
 export
 Reify BuiltinType where
-  reify defs val@(NDCon _ n _ _ args)
+  reify defs val@(VDCon _ n _ _ args)
       = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "BuiltinNatural"), [])
+             (UN (Basic "BuiltinNatural"), [<])
                    => pure BuiltinNatural
-             (UN (Basic "NaturalToInteger"), [])
+             (UN (Basic "NaturalToInteger"), [<])
                    => pure NaturalToInteger
-             (UN (Basic "IntegerToNatural"), [])
+             (UN (Basic "IntegerToNatural"), [<])
                    => pure IntegerToNatural
              _ => cantReify val "BuiltinType"
   reify defs val = cantReify val "BuiltinType"
@@ -807,16 +829,16 @@ Reflect VirtualIdent where
 
 export
 Reify OriginDesc where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "PhysicalIdrSrc"), [(_, ident)])
-                   => do ident' <- reify defs !(evalClosure defs ident)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "PhysicalIdrSrc"), [ident])
+                   => do ident' <- reify defs !(expandFull ident)
                          pure (PhysicalIdrSrc ident')
-             (UN (Basic "PhysicalPkgSrc"), [(_, fname)])
-                   => do fname' <- reify defs !(evalClosure defs fname)
+             (UN (Basic "PhysicalPkgSrc"), [fname])
+                   => do fname' <- reify defs !(expandFull fname)
                          pure (PhysicalPkgSrc fname')
-             (UN (Basic "Virtual"), [(_, ident)])
-                   => do ident' <- reify defs !(evalClosure defs ident)
+             (UN (Basic "Virtual"), [ident])
+                   => do ident' <- reify defs !(expandFull ident)
                          pure (Virtual ident')
              _ => cantReify val "OriginDesc"
   reify defs val = cantReify val "OriginDesc"
@@ -825,22 +847,22 @@ export
 Reflect OriginDesc where
   reflect fc defs lhs env (PhysicalIdrSrc ident)
       = do ident' <- reflect fc defs lhs env ident
-           appCon fc defs (reflectiontt "PhysicalIdrSrc") [ident']
+           appCon fc defs (reflectiontt "PhysicalIdrSrc") [(top, ident')]
   reflect fc defs lhs env (PhysicalPkgSrc fname)
       = do fname' <- reflect fc defs lhs env fname
-           appCon fc defs (reflectiontt "PhysicalPkgSrc") [fname']
+           appCon fc defs (reflectiontt "PhysicalPkgSrc") [(top, fname')]
   reflect fc defs lhs env (Virtual ident)
       = do ident' <- reflect fc defs lhs env ident
-           appCon fc defs (reflectiontt "Virtual") [ident']
+           appCon fc defs (reflectiontt "Virtual") [(top, ident')]
 
 export
 Reify FC where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "MkFC"), [(_, fn), (_, start), (_, end)])
-                   => do fn' <- reify defs !(evalClosure defs fn)
-                         start' <- reify defs !(evalClosure defs start)
-                         end' <- reify defs !(evalClosure defs end)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "MkFC"), [fn, start, end])
+                   => do fn' <- reify defs !(expandFull fn)
+                         start' <- reify defs !(expandFull start)
+                         end' <- reify defs !(expandFull end)
                          pure (MkFC fn' start' end')
              (UN (Basic "EmptyFC"), _) => pure EmptyFC
              _ => cantReify val "FC"
@@ -853,25 +875,25 @@ Reflect FC where
       = do fn' <- reflect fc defs lhs env fn
            start' <- reflect fc defs lhs env start
            end' <- reflect fc defs lhs env end
-           appCon fc defs (reflectiontt "MkFC") [fn', start', end']
+           appCon fc defs (reflectiontt "MkFC") [(top, fn'), (top, start'), (top, end')]
   reflect fc defs lhs env (MkVirtualFC fn start end)
       = do fn' <- reflect fc defs lhs env fn
            start' <- reflect fc defs lhs env start
            end' <- reflect fc defs lhs env end
-           appCon fc defs (reflectiontt "MkFC") [fn', start', end']
+           appCon fc defs (reflectiontt "MkFC") [(top, fn'), (top, start'), (top, end')]
   reflect fc defs lhs env EmptyFC = getCon fc defs (reflectiontt "EmptyFC")
 
 export
 Reify a => Reify (WithFC a) where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), map snd args) of
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
              (UN (Basic "MkFCVal"), [fcterm, nestedVal]) => do
-                 fc <- reify defs !(evalClosure defs fcterm)
-                 val <- reify defs !(evalClosure defs nestedVal)
+                 fc <- reify defs !(expandFull fcterm)
+                 val <- reify defs !(expandFull nestedVal)
                  pure $ MkFCVal fc val
-             (UN (Basic "MkFCVal"), [_, fc, l2]) => do
-                 fc' <- reify defs !(evalClosure defs fc)
-                 val' <- reify defs !(evalClosure defs l2)
+             (UN (Basic "MkFCVal"), [_, fc, nestedVal]) => do
+                 fc' <- reify defs !(expandFull fc)
+                 val' <- reify defs !(expandFull nestedVal)
                  pure $ MkFCVal fc' val'
              (t, l) => cantReify val "WithFC constructor: \{show t}, args: \{show (length l)}"
   reify defs val = cantReify val "Expected WithFC, found something else"
@@ -881,7 +903,7 @@ Reflect a => Reflect (WithFC a) where
   reflect fc defs lhs env value
       = do loc' <- reflect fc defs lhs env value.fc
            val' <- reflect fc defs lhs env value.val
-           appCon fc defs (reflectiontt "MkFCVal") [Erased fc Placeholder, loc', val']
+           appCon fc defs (reflectiontt "MkFCVal") [blank fc, (top, loc'), (top, val')]
 
 {-
 -- Reflection of well typed terms: We don't reify terms because that involves
@@ -892,12 +914,12 @@ Reflect a => Reflect (WithFC a) where
 export
 Reflect (IsVar name idx vs) where
   reflect fc defs lhs env First
-      = appCon fc defs (reflectiontt "First") [Erased fc Placeholder, Erased fc Placeholder]
+      = appCon fc defs (reflectiontt "First") [blank fc, blank fc]
   reflect fc defs lhs env (Later p)
       = do p' <- reflect fc defs lhs env p
            appCon fc defs (reflectiontt "Later")
-                  [Erased fc Placeholder, Erased fc Placeholder,
-                   Erased fc Placeholder, Erased fc Placeholder, p']
+                  [blank fc, blank fc,
+                   blank fc, blank fc, (top, p')]
 
 -- Assume terms are normalised so there's not Let bindings in particular
 export
@@ -906,13 +928,13 @@ Reflect (Term vs) where
       = do lfc' <- reflect fc defs lhs env lfc
            idx' <- reflect fc defs lhs env idx
            appCon fc defs (reflectiontt "Local")
-                  [Erased fc Placeholder, Erased fc Placeholder, lfc', idx', Erased fc Placeholder]
+                  [blank fc, blank fc, (top, lfc'), (top, idx'), blank fc]
   reflect fc defs lhs env (Ref rfc nt n)
       = do rfc' <- reflect fc defs lhs env rfc
            nt' <- reflect fc defs lhs env nt
            n' <- reflect fc defs lhs env n
            appCon fc defs (reflectiontt "Ref")
-                  [Erased fc Placeholder, rfc', nt', n']
+                  [blank fc, (top, rfc'), (top, nt'), (top, n')]
   reflect fc defs lhs env (Bind bfc x (Pi c p ty) sc)
       = do bfc' <- reflect fc defs lhs env bfc
            x' <- reflect fc defs lhs env x
@@ -921,7 +943,8 @@ Reflect (Term vs) where
            ty' <- reflect fc defs lhs env ty
            sc' <- reflect fc defs lhs env sc
            appCon fc defs (reflectiontt "Pi")
-                  [Erased fc Placeholder, bfc', c', p', x', ty', sc']
+                  [blank fc, (top, bfc'), (top, c'), (top, p'),
+                   (top, x'), (top, ty'), (top, sc')]
   reflect fc defs lhs env (Bind bfc x (Lam c p ty) sc)
       = do bfc' <- reflect fc defs lhs env bfc
            x' <- reflect fc defs lhs env x
@@ -930,44 +953,45 @@ Reflect (Term vs) where
            ty' <- reflect fc defs lhs env ty
            sc' <- reflect fc defs lhs env sc
            appCon fc defs (reflectiontt "Lam")
-                  [Erased fc Placeholder, bfc', c', p', x', ty', sc']
+                  [blank fc, (top, bfc'), (top, c'), (top, p'),
+                   (top, x'), (top, ty'), (top, sc')]
   reflect fc defs lhs env (App afc fn arg)
       = do afc' <- reflect fc defs lhs env afc
            fn' <- reflect fc defs lhs env fn
            arg' <- reflect fc defs lhs env arg
            appCon fc defs (reflectiontt "App")
-                  [Erased fc Placeholder, afc', fn', arg']
+                  [blank fc, (top, afc'), (top, fn'), (top, arg')]
   reflect fc defs lhs env (TDelayed dfc r tm)
       = do dfc' <- reflect fc defs lhs env dfc
            r' <- reflect fc defs lhs env r
            tm' <- reflect fc defs lhs env tm
            appCon fc defs (reflectiontt "TDelayed")
-                  [Erased fc Placeholder, dfc', r', tm']
+                  [blank fc, (top, dfc'), (top, r'), (top, tm')]
   reflect fc defs lhs env (TDelay dfc r ty tm)
       = do dfc' <- reflect fc defs lhs env dfc
            r' <- reflect fc defs lhs env r
            ty' <- reflect fc defs lhs env ty
            tm' <- reflect fc defs lhs env tm
            appCon fc defs (reflectiontt "TDelay")
-                  [Erased fc Placeholder, dfc', r', ty', tm']
+                  [blank fc, (top, dfc'), (top, r'), (top, ty'), (top, tm')]
   reflect fc defs lhs env (TForce dfc r tm)
       = do dfc' <- reflect fc defs lhs env dfc
            r' <- reflect fc defs lhs env r
            tm' <- reflect fc defs lhs env tm
            appCon fc defs (reflectiontt "TForce")
-                  [Erased fc Placeholder, r', dfc', tm']
+                  [blank fc, (top, r'), (top, dfc'), (top, tm')]
   reflect fc defs lhs env (PrimVal pfc c)
       = do pfc' <- reflect fc defs lhs env pfc
            c' <- reflect fc defs lhs env c
            appCon fc defs (reflectiontt "PrimVal")
-                  [Erased fc Placeholder, pfc', c']
+                  [blank fc, (top, pfc'), (top, c')]
   reflect fc defs lhs env (Erased efc _)
       = do efc' <- reflect fc defs lhs env efc
            appCon fc defs (reflectiontt "Erased")
-                  [Erased fc Placeholder, efc']
+                  [blank fc, (top, efc')]
   reflect fc defs lhs env (TType tfc)
       = do tfc' <- reflect fc defs lhs env tfc
            appCon fc defs (reflectiontt "TType")
-                  [Erased fc Placeholder, tfc']
+                  [blank fc, (top, tfc')]
   reflect fc defs lhs env val = cantReflect fc "Term"
   -}
diff --git a/src/Core/SchemeEval.idr b/src/Core/SchemeEval.idr
deleted file mode 100644
index 7f60feb7eb4..00000000000
--- a/src/Core/SchemeEval.idr
+++ /dev/null
@@ -1,82 +0,0 @@
-module Core.SchemeEval
-
--- Top level interface to the scheme based evaluator
--- Drops back to the default slow evaluator if scheme isn't available
-
-import Core.Context
-import Core.Env
-import Core.Normalise
-import public Core.SchemeEval.Compile
-import public Core.SchemeEval.Evaluate
-import public Core.SchemeEval.Quote
-import public Core.SchemeEval.ToScheme
-
-{-
-
-Summary:
-
-SObj vars
-   ...is a scheme object with the scheme representation of the result
-   of evaluating a term vars
-
-SNF vars
-   ...corresponds to NF vars, and is an inspectable version of the above.
-   Evaluation is call by value, but there has not yet been any evaluation
-   under lambdas
-
-'Evaluate.seval' gets you an SObj from a Term
-   - this involves compiling all the relevant definitions to scheme code
-   first. We make a note of what we've compiled to scheme so we don't have
-   to do it more than once.
-`Evaluate.toSNF` gets you an SNF from an SObj
-`Quote.quote` gets you back to a Term from an SNF
-
-`snf` gets you directly to an SNF from a Term
-`snormalise` packages up the whole process
-
-All of this works only on a back end which can call scheme directly, and
-with the relevant support files (currently: Chez)
-
--}
-
-snormaliseMode : {auto c : Ref Ctxt Defs} ->
-                 {vars : _} ->
-                 SchemeMode -> Env Term vars -> Term vars -> Core (Term vars)
-snormaliseMode mode env tm
-    = do defs <- get Ctxt
-         True <- initialiseSchemeEval
-             | _ => normalise defs env tm
-         sval <- seval mode env tm
-         quoteObj sval
-
-export
-snormalise : {auto c : Ref Ctxt Defs} ->
-             {vars : _} ->
-             Env Term vars -> Term vars -> Core (Term vars)
-snormalise = snormaliseMode BlockExport
-
-export
-snormaliseAll : {auto c : Ref Ctxt Defs} ->
-                {vars : _} ->
-                Env Term vars -> Term vars -> Core (Term vars)
-snormaliseAll = snormaliseMode EvalAll
-
-export
-snf : {auto c : Ref Ctxt Defs} ->
-      {vars : _} ->
-      Env Term vars -> Term vars -> Core (SNF vars)
-snf env tm
-    = do True <- initialiseSchemeEval
-             | _ => throw (InternalError "Scheme evaluator not available")
-         sval <- seval BlockExport env tm
-         toSNF sval
-
-export
-snfAll : {auto c : Ref Ctxt Defs} ->
-         {vars : _} ->
-         Env Term vars -> Term vars -> Core (SNF vars)
-snfAll env tm
-    = do True <- initialiseSchemeEval
-             | _ => throw (InternalError "Scheme evaluator not available")
-         sval <- seval EvalAll env tm
-         toSNF sval
diff --git a/src/Core/SchemeEval/Builtins.idr b/src/Core/SchemeEval/Builtins.idr
deleted file mode 100644
index 50f8923f6ab..00000000000
--- a/src/Core/SchemeEval/Builtins.idr
+++ /dev/null
@@ -1,313 +0,0 @@
-module Core.SchemeEval.Builtins
-
-import Core.SchemeEval.ToScheme
-import Core.TT
-
-import Data.Vect
-import Libraries.Utils.Scheme
-
--- Integers are wrapped, so unwrap then wrap again
-add : Maybe IntKind -> SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-add (Just (Signed (P n))) x y = Apply (Var "ct-s+") [x, y, toScheme (n-1)]
-add (Just (Unsigned n)) x y = Apply (Var "ct-u+") [x, y, toScheme n]
-add _ x y = Apply (Var "ct+") [x, y]
-
-sub : Maybe IntKind -> SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-sub (Just (Signed (P n))) x y = Apply (Var "ct-s-") [x, y, toScheme (n-1)]
-sub (Just (Unsigned n)) x y = Apply (Var "ct-u-") [x, y, toScheme n]
-sub _ x y = Apply (Var "ct-") [x, y]
-
-mul : Maybe IntKind -> SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-mul (Just (Signed (P n))) x y = Apply (Var "ct-s*") [x, y, toScheme (n-1)]
-mul (Just (Unsigned n)) x y = Apply (Var "ct-u*") [x, y, toScheme n]
-mul _ x y = Apply (Var "ct*") [x, y]
-
-div : Maybe IntKind -> SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-div (Just (Signed Unlimited)) x y = Apply (Var "ct/") [x, y]
-div (Just (Signed (P n))) x y = Apply (Var "ct-s/") [x, y, toScheme (n-1)]
-div (Just (Unsigned n)) x y = Apply (Var "ct-u/") [x, y, toScheme n]
-div _ x y = Apply (Var "ct/") [x, y]
-
-mod : SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-mod x y = Apply (Var "ct-mod") [x, y]
-
-shl : Maybe IntKind -> SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-shl (Just (Signed (P n))) x y = Apply (Var "ct-bits-shl-signed") [x, y, toScheme (n-1)]
-shl (Just (Unsigned n)) x y = Apply (Var "ct-bits-shl") [x, y, toScheme n]
-shl _ x y = Apply (Var "ct-shl") [x, y]
-
-shr : Maybe IntKind -> SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-shr _ x y = Apply (Var "ct-shr") [x, y]
-
--- Doubles don't need wrapping, since there's only one double type
-addDbl : SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-addDbl x y = Apply (Var "+") [x, y]
-
-subDbl : SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-subDbl x y = Apply (Var "-") [x, y]
-
-mulDbl : SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-mulDbl x y = Apply (Var "*") [x, y]
-
-divDbl : SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-divDbl x y = Apply (Var "/") [x, y]
-
--- Check necessary arguments are in canonical form before applying the
--- operator, otherwise return the blocked form
--- Current assumption is that all primitives that we can evaluate at
--- compile time work on constants, if they do anything in Scheme at all.
-canonical : SchemeObj Write ->
-            Vect n (SchemeObj Write) -> SchemeObj Write -> SchemeObj Write
-canonical blk [] body = body
-canonical blk (n :: ns) body
-   = If (Apply (Var "ct-isConstant") [n]) (canonical blk ns body) blk
-
--- Return blocked application if a partial operator is given an input
--- on which it's undefined
-testPartial : SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-testPartial blk res
-    = Let "p-0" res $
-          (If (Apply (Var "ct-isConstant") [Var "p-0"])
-              (Var "p-0")
-              blk)
-
-unaryOp : SchemeObj Write -> String ->
-          SchemeObj Write -> SchemeObj Write
-unaryOp blk op x = canonical blk [x] $ Apply (Var op) [x]
-
-binOp : SchemeObj Write -> String ->
-        SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-binOp blk op x y = canonical blk [x, y] $ Apply (Var op) [x, y]
-
-ternaryOp : SchemeObj Write -> String ->
-            SchemeObj Write -> SchemeObj Write -> SchemeObj Write ->
-            SchemeObj Write
-ternaryOp blk op x y z = canonical blk [x, y, z] $ Apply (Var op) [x, y, z]
-
-int : SchemeObj Write -> SchemeObj Write
-int obj = Vector (-100) [obj]
-
-int8 : SchemeObj Write -> SchemeObj Write
-int8 obj = Vector (-101) [obj]
-
-int16 : SchemeObj Write -> SchemeObj Write
-int16 obj = Vector (-102) [obj]
-
-int32 : SchemeObj Write -> SchemeObj Write
-int32 obj = Vector (-103) [obj]
-
-int64 : SchemeObj Write -> SchemeObj Write
-int64 obj = Vector (-104) [obj]
-
-integer : SchemeObj Write -> SchemeObj Write
-integer obj = Vector (-105) [obj]
-
-bits8 : SchemeObj Write -> SchemeObj Write
-bits8 obj = Vector (-106) [obj]
-
-bits16 : SchemeObj Write -> SchemeObj Write
-bits16 obj = Vector (-107) [obj]
-
-bits32 : SchemeObj Write -> SchemeObj Write
-bits32 obj = Vector (-108) [obj]
-
-bits64 : SchemeObj Write -> SchemeObj Write
-bits64 obj = Vector (-109) [obj]
-
-wrap : IntKind -> SchemeObj Write -> SchemeObj Write
-wrap (Signed Unlimited) = integer
-wrap (Signed (P 8)) = int8
-wrap (Signed (P 16)) = int16
-wrap (Signed (P 32)) = int32
-wrap (Signed (P 64)) = int64
-wrap (Unsigned 8) = bits8
-wrap (Unsigned 16) = bits16
-wrap (Unsigned 32) = bits32
-wrap (Unsigned 64) = bits64
-wrap _ = integer
-
--- Result has to be wrapped in Int, which is Vector (-100)
-boolOp : SchemeObj Write -> String ->
-         SchemeObj Write -> SchemeObj Write -> SchemeObj Write
-boolOp blk op x y
-    = canonical blk [x, y] $
-         int $
-             Apply (Var "or")
-                [Apply (Var "and") [Apply (Var op) [x, y],
-                                    IntegerVal 1],
-                 IntegerVal 0]
-
-applyIntCast : IntKind -> IntKind -> SchemeObj Write -> SchemeObj Write
-applyIntCast _ (Signed Unlimited) x = x
-applyIntCast (Signed m) k@(Signed (P n)) x
-    = if P n >= m
-         then x
-         else wrap k $ Apply (Var "ct-cast-signed") [x, toScheme (n - 1)]
-applyIntCast (Unsigned m) k@(Signed (P n)) x
-    = if n > m
-         then x
-         else wrap k $ Apply (Var "ct-cast-signed") [x, toScheme (n - 1)]
-applyIntCast (Signed _) k@(Unsigned n) x
-    = wrap k $ Apply (Var "ct-cast-unsigned") [x, toScheme n]
-applyIntCast (Unsigned m) (Unsigned n) x
-    = if n >= m
-         then x
-         else Apply (Var "ct-cast-unsigned") [x, toScheme n]
-
-applyCast : SchemeObj Write ->
-            PrimType -> PrimType ->
-            SchemeObj Write -> SchemeObj Write
-applyCast blk CharType to x
-    = canonical blk [x] $
-        case intKind to of
-           Nothing =>
-              case to of
-                   StringType => Apply (Var "string") [x]
-                   _ => blk
-           Just (Signed Unlimited) => integer $ Apply (Var "char->integer") [x]
-           Just k@(Signed (P n)) => wrap k $ Apply (Var "ct-cast-char-boundedInt") [x, toScheme (n - 1)]
-           Just k@(Unsigned n) => wrap k $ Apply (Var "ct-cast-char-boundedUInt") [x, toScheme n]
-applyCast blk from CharType x
-    = canonical blk [x] $
-        case intKind from of
-           Nothing => blk
-           Just k => Apply (Var "ct-cast-int-char") [x]
-applyCast blk StringType to x
-    = canonical blk [x] $
-        case intKind to of
-           Nothing => case to of
-                           DoubleType => Apply (Var "ct-cast-string-double") [x]
-                           _ => blk
-           Just (Signed Unlimited) => integer $ Apply (Var "ct-cast-string-int") [x]
-           Just k@(Signed (P n)) => wrap k $ Apply (Var "ct-cast-string-boundedInt") [x, toScheme (n - 1)]
-           Just k@(Unsigned n) => wrap k $ Apply (Var "ct-cast-string-boundedUInt") [x, toScheme n]
-applyCast blk from StringType x
-    = canonical blk [x] $
-        case intKind from of
-           Nothing => case from of
-                           DoubleType => Apply (Var "number->string") [x]
-                           _ => blk
-           Just k => Apply (Var "ct-cast-number-string") [x]
-applyCast blk DoubleType to x
-    = canonical blk [x] $
-        case intKind to of
-           Nothing => case to of
-                           StringType => Apply (Var "number->string") [x]
-                           _ => blk
-           Just (Signed Unlimited) => integer $ Apply (Var "ct-exact-truncate") [x]
-           Just k@(Signed (P n)) => wrap k $ Apply (Var "ct-exact-truncate-boundedInt") [x, toScheme (n - 1)]
-           Just k@(Unsigned n) => wrap k $ Apply (Var "ct-exact-truncate-boundedUInt") [x, toScheme n]
-applyCast blk from DoubleType x
-    = canonical blk [x] $
-        case intKind from of
-           Nothing => case from of
-                           StringType => Apply (Var "ct-cast-string-double") [x]
-                           _ => blk
-           Just k => Apply (Var "ct-int-double") [x]
-applyCast blk from to x
-    = canonical blk [x] $
-        case (intKind from, intKind to) of
-           (Just f, Just t) => applyIntCast f t x
-           _ => blk
-
-applyOp : SchemeObj Write -> -- if we don't have arguments in canonical form
-          PrimFn n -> Vect n (SchemeObj Write) ->
-          SchemeObj Write
-applyOp blk (Add DoubleType) [x, y] = binOp blk "+" x y
-applyOp blk (Sub DoubleType) [x, y] = binOp blk "-" x y
-applyOp blk (Mul DoubleType) [x, y] = binOp blk "*" x y
-applyOp blk (Div DoubleType) [x, y] = binOp blk "/" x y
-applyOp blk (Neg DoubleType) [x] = unaryOp blk "-" x
-applyOp blk (Add ty) [x, y] = canonical blk [x, y] $ add (intKind ty) x y
-applyOp blk (Sub ty) [x, y] = canonical blk [x, y] $ sub (intKind ty) x y
-applyOp blk (Mul ty) [x, y] = canonical blk [x, y] $ mul (intKind ty) x y
-applyOp blk (Div ty) [x, y] = canonical blk [x, y] $ div (intKind ty) x y
-applyOp blk (Mod ty) [x, y] = canonical blk [x, y] $ mod x y
-applyOp blk (Neg ty) [x] = canonical blk [x] $ Apply (Var "ct-neg") [x]
-applyOp blk (ShiftL ty) [x, y] = canonical blk [x, y] $ shl (intKind ty) x y
-applyOp blk (ShiftR ty) [x, y] = canonical blk [x, y] $ shr (intKind ty) x y
-applyOp blk (BAnd ty) [x, y] = binOp blk "ct-and" x y
-applyOp blk (BOr ty) [x, y] = binOp blk "ct-or" x y
-applyOp blk (BXOr ty) [x, y] = binOp blk "ct-xor" x y
-applyOp blk (LT CharType) [x, y] = boolOp blk "char<?" x y
-applyOp blk (LTE CharType) [x, y] = boolOp blk "char<=?" x y
-applyOp blk (EQ CharType) [x, y] = boolOp blk "char=?" x y
-applyOp blk (GTE CharType) [x, y] = boolOp blk "char>=?" x y
-applyOp blk (GT CharType) [x, y] = boolOp blk "char>?" x y
-applyOp blk (LT StringType) [x, y] = boolOp blk "string<?" x y
-applyOp blk (LTE StringType) [x, y] = boolOp blk "string<=?" x y
-applyOp blk (EQ StringType) [x, y] = boolOp blk "string=?" x y
-applyOp blk (GTE StringType) [x, y] = boolOp blk "string>=?" x y
-applyOp blk (GT StringType) [x, y] = boolOp blk "string>?" x y
-applyOp blk (LT DoubleType) [x, y] = boolOp blk "<" x y
-applyOp blk (LTE DoubleType) [x, y] = boolOp blk "<=" x y
-applyOp blk (EQ DoubleType) [x, y] = boolOp blk "=" x y
-applyOp blk (GTE DoubleType) [x, y] = boolOp blk ">=" x y
-applyOp blk (GT DoubleType) [x, y] = boolOp blk ">" x y
-applyOp blk (LT ty) [x, y] = boolOp blk "ct<" x y
-applyOp blk (LTE ty) [x, y] = boolOp blk "ct<=" x y
-applyOp blk (EQ ty) [x, y] = boolOp blk "ct=" x y
-applyOp blk (GTE ty) [x, y] = boolOp blk "ct>=" x y
-applyOp blk (GT ty) [x, y] = boolOp blk "ct>" x y
-applyOp blk StrLength [x]
-    = canonical blk [x] $ Vector (-100) [Apply (Var "string-length") [x]]
-applyOp blk StrHead [x]
-    = canonical blk [x] $ Apply (Var "string-ref")
-                                [x, IntegerVal 0]
-applyOp blk StrTail [x]
-    = canonical blk [x] $ Apply (Var "substring")
-                                [x, IntegerVal 1,
-                                 Apply (Var "string-length") [x]]
-applyOp blk StrIndex [x, y]
-    = canonical blk [x, y] $ testPartial blk $
-         Apply (Var "ct-string-ref") [x, y]
-applyOp blk StrCons [x, y]
-    = canonical blk [x, y] $ Apply (Var "ct-string-cons") [x, y]
-applyOp blk StrAppend [x, y]
-    = canonical blk [x, y] $ Apply (Var "string-append") [x, y]
-applyOp blk StrReverse [x]
-    = canonical blk [x] $ Apply (Var "ct-string-reverse") [x]
-applyOp blk StrSubstr [x, y, z]
-    = canonical blk [x, y, z] $ Apply (Var "ct-string-substr") [x]
-
-applyOp blk DoubleExp [x] = unaryOp blk "flexp" x
-applyOp blk DoubleLog [x] = unaryOp blk "fllog" x
-applyOp blk DoublePow [x, y] = binOp blk "expt" x y
-applyOp blk DoubleSin [x] = unaryOp blk "flsin" x
-applyOp blk DoubleCos [x] = unaryOp blk "flcos" x
-applyOp blk DoubleTan [x] = unaryOp blk "fltan" x
-applyOp blk DoubleASin [x] = unaryOp blk "flasin" x
-applyOp blk DoubleACos [x] = unaryOp blk "flacos" x
-applyOp blk DoubleATan [x] = unaryOp blk "flatan" x
-applyOp blk DoubleSqrt [x] = unaryOp blk "flsqrt" x
-applyOp blk DoubleFloor [x] = unaryOp blk "flfloor" x
-applyOp blk DoubleCeiling [x] = unaryOp blk "flceiling" x
-
-applyOp blk (Cast from to) [x] = applyCast blk from to x
-applyOp blk BelieveMe [_, _, x] = x
-applyOp blk Crash [_, msg] = blk
-
-mkArgList : Int -> (n : Nat) -> Vect n String
-mkArgList i Z = []
-mkArgList i (S k) = ("x-" ++ show i) :: mkArgList (i + 1) k
-
-export
-compileBuiltin : {farity : Nat} ->
-                Name -> PrimFn farity -> SchemeObj Write
-compileBuiltin nm fn
-    = let args = mkArgList 0 farity in
-          bindArgs args [] args
-  where
-    makeBlockedApp : Vect n String -> SchemeObj Write
-    makeBlockedApp args = Vector (-2) [toScheme nm, vars args]
-      where
-        vars : forall n . Vect n String -> SchemeObj Write
-        vars [] = Null
-        vars (x :: xs) = Cons (Var x) (vars xs)
-
-    bindArgs : Vect n String -> Vect n' String ->
-               Vect farity String -> SchemeObj Write
-    bindArgs [] done args = applyOp (makeBlockedApp args) fn (map Var args)
-    bindArgs (x :: xs) done args
-        = Vector (-9) [makeBlockedApp (reverse done),
-                       Lambda [x] (bindArgs xs (x :: done) args)]
diff --git a/src/Core/SchemeEval/Compile.idr b/src/Core/SchemeEval/Compile.idr
deleted file mode 100644
index 170485bec48..00000000000
--- a/src/Core/SchemeEval/Compile.idr
+++ /dev/null
@@ -1,616 +0,0 @@
-module Core.SchemeEval.Compile
-
-{- TODO:
-
-- Make a decent set of test cases
-- Option to keep vs discard FCs for faster quoting where we don't need FC
-
-Advanced TODO (possibly not worth it...):
-- Write a conversion check
-- Extend unification to use SObj; include SObj in Glued
-
--}
-
-import Core.Case.CaseTree
-import Core.Context
-import Core.Directory
-import Core.SchemeEval.Builtins
-import Core.SchemeEval.ToScheme
-
-import Data.List.Quantifiers
-
-import Libraries.Utils.Scheme
-import System.Info
-
-import Libraries.Data.WithDefault
-
-schString : String -> String
-schString s = concatMap okchar (unpack s)
-  where
-    okchar : Char -> String
-    okchar c = if isAlphaNum c || c =='_'
-                  then cast c
-                  else "C-" ++ show (cast {to=Int} c)
-
-schVarUN : UserName -> String
-schVarUN (Basic n) = schString n
-schVarUN (Field n) = "rf--" ++ schString n
-schVarUN Underscore = "_US_"
-
-schVarName : Name -> String
-schVarName (NS ns (UN n))
-   = schString (showNSWithSep "-" ns) ++ "-" ++ schVarUN n
-schVarName (NS ns n) = schString (showNSWithSep "-" ns) ++ "-" ++ schVarName n
-schVarName (UN n) = "u--" ++ schVarUN n
-schVarName (MN n i) = schString n ++ "-" ++ show i
-schVarName (PV n d) = "pat--" ++ schVarName n
-schVarName (DN _ n) = schVarName n
-schVarName (Nested (i, x) n) = "n--" ++ show i ++ "-" ++ show x ++ "-" ++ schVarName n
-schVarName (CaseBlock x y) = "case--" ++ schString x ++ "-" ++ show y
-schVarName (WithBlock x y) = "with--" ++ schString x ++ "-" ++ show y
-schVarName (Resolved i) = "fn--" ++ show i
-
-schName : Name -> String
-schName n = "ct-" ++ schVarName n
-
-export
-data Sym : Type where
-
-export
-nextName : Ref Sym Integer => Core Integer
-nextName
-    = do n <- get Sym
-         put Sym (n + 1)
-         pure n
-
-public export
-data SVar = Bound String | Free String
-
-Show SVar where
-  show (Bound x) = x
-  show (Free x) = "'" ++ x
-
-export
-getName : SVar -> String
-getName (Bound x) = x
-getName (Free x) = x
-
-public export
-SchVars : Scoped
-SchVars = All (\_ => SVar)
-
-Show (SchVars ns) where
-  show xs = show (toList xs)
-    where
-      -- TODO move to Data.List.Quantifiers
-      toList : forall ns . SchVars ns -> List String
-      toList [] = []
-      toList (Bound x :: xs) = x :: toList xs
-      toList (Free x :: xs) = "'x" :: toList xs
-
-getSchVar : {idx : _} -> (0 _ : IsVar n idx vars) -> SchVars vars -> String
-getSchVar First (Bound x :: xs) = x
-getSchVar First (Free x :: xs) = "'" ++ x
-getSchVar (Later p) (x :: xs) = getSchVar p xs
-
-{-
-
-Encoding of NF -> Scheme
-
-Maybe consider putting this back into a logical order, rather than the order
-I implemented them in...
-
-vector (tag>=0) name args == data constructor
-vector (-10) (name, arity) (args as list) == blocked meta application
-                   (needs to be same arity as block app, for ct-addArg)
-vector (-11) symbol (args as list) == blocked local application
-vector (-1) ... == type constructor
-vector (-2) name (args as list) == blocked application
-vector (-3) ... == Pi binder
-vector (-4) ... == delay arg
-vector (-5) ... == force arg
-vector (-6) = Erased
-vector (-7) = Type
-vector (-8) ... = Lambda
-vector (-9) blockedapp proc = Top level lambda (from a PMDef, so not expanded)
-vector (-12) ... = PVar binding
-vector (-13) ... = PVTy binding
-vector (-14) ... = PLet binding
-vector (-15) ... = Delayed
-
-vector (-100 onwards) ... = constants
--}
-
-blockedAppWith : Name -> List (SchemeObj Write) -> SchemeObj Write
-blockedAppWith n args = Vector (-2) [toScheme n, vars args]
-  where
-    vars : List (SchemeObj Write) -> SchemeObj Write
-    vars [] = Null
-    vars (x :: xs) = Cons x (vars xs)
-
-blockedMetaApp : Name -> SchemeObj Write
-blockedMetaApp n
-    = Lambda ["arity-0"] (Vector (-10) [Cons (toScheme n) (Var "arity-0"),
-                                        Null])
-
-unload : SchemeObj Write -> List (SchemeObj Write) -> SchemeObj Write
-unload f [] = f
-unload f (a :: as) = unload (Apply (Var "ct-app") [f, a]) as
-
-compileConstant : FC -> Constant -> SchemeObj Write
-compileConstant fc (I x) = Vector (-100) [IntegerVal (cast x)]
-compileConstant fc (I8 x) = Vector (-101) [IntegerVal (cast x)]
-compileConstant fc (I16 x) = Vector (-102) [IntegerVal (cast x)]
-compileConstant fc (I32 x) = Vector (-103) [IntegerVal (cast x)]
-compileConstant fc (I64 x) = Vector (-104) [IntegerVal (cast x)]
-compileConstant fc (BI x) = Vector (-105) [IntegerVal x]
-compileConstant fc (B8 x) = Vector (-106) [IntegerVal (cast x)]
-compileConstant fc (B16 x) = Vector (-107) [IntegerVal (cast x)]
-compileConstant fc (B32 x) = Vector (-108) [IntegerVal (cast x)]
-compileConstant fc (B64 x) = Vector (-109) [IntegerVal (cast x)]
-compileConstant fc (Str x) = StringVal x
-compileConstant fc (Ch x) = CharVal x
-compileConstant fc (Db x) = FloatVal x
-compileConstant fc (PrT t) -- Constant types get compiled as TyCon names, for matching purposes
-    = Vector (-1) [IntegerVal (cast (primTypeTag t)),
-                   StringVal (show t),
-                   toScheme (UN (Basic (show t))),
-                   toScheme fc]
-compileConstant fc WorldVal = Null
-
-compileStk : Ref Sym Integer =>
-             {auto c : Ref Ctxt Defs} ->
-             SchVars vars -> List (SchemeObj Write) -> Term vars ->
-             Core (SchemeObj Write)
-
-compilePiInfo : Ref Sym Integer =>
-                {auto c : Ref Ctxt Defs} ->
-                SchVars vars -> PiInfo (Term vars) ->
-                Core (PiInfo (SchemeObj Write))
-compilePiInfo svs Implicit = pure Implicit
-compilePiInfo svs Explicit = pure Explicit
-compilePiInfo svs AutoImplicit = pure AutoImplicit
-compilePiInfo svs (DefImplicit t)
-    = do t' <- compileStk svs [] t
-         pure (DefImplicit t')
-
-compileWhyErased : Ref Sym Integer =>
-                {auto c : Ref Ctxt Defs} ->
-                SchVars vars -> List (SchemeObj Write) -> WhyErased (Term vars) ->
-                Core (WhyErased (SchemeObj Write))
-compileWhyErased svs stk Impossible = pure Impossible
-compileWhyErased svs stk Placeholder = pure Placeholder
-compileWhyErased svs stk (Dotted t)
-    = do t' <- compileStk svs stk t
-         pure (Dotted t')
-
-compileStk svs stk (Local fc isLet idx p)
-    = pure $ unload (Var (getSchVar p svs)) stk
--- We are assuming that the bound name is a valid scheme symbol. We should
--- only see this when inventing temporary names during quoting
-compileStk svs stk (Ref fc Bound name)
-    = pure $ unload (Symbol (show name)) stk
-compileStk svs stk (Ref fc (DataCon t a) name)
-    = if length stk == a -- inline it if it's fully applied
-         then pure $ Vector (cast t)
-                       (toScheme !(toResolvedNames name) ::
-                        toScheme fc :: stk)
-         else pure $ unload (Apply (Var (schName name)) []) stk
-compileStk svs stk (Ref fc (TyCon a) name)
-    = if length stk == a -- inline it if it's fully applied
-         then pure $ Vector (-1)
-                       (StringVal (show name) ::
-                        toScheme !(toResolvedNames name) ::
-                        toScheme fc :: stk)
-         else pure $ unload (Apply (Var (schName name)) []) stk
-compileStk svs stk (Ref fc x name)
-    = pure $ unload (Apply (Var (schName name)) []) stk
-compileStk svs stk (Meta fc name i xs)
-    = do xs' <- traverse (compileStk svs stk) xs
-         -- we encode the arity as first argument to the hole definition, which
-         -- helps in readback, so we have to apply the hole function to the
-         -- length of xs to be able to restore the Meta properly
-         pure $ unload (Apply (Var (schName name)) [])
-                       (IntegerVal (cast (length xs)) :: stk ++ xs')
-compileStk svs stk (Bind fc x (Let _ _ val _) scope)
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         val' <- compileStk svs [] val
-         sc' <- compileStk (Bound x' :: svs) [] scope
-         pure $ unload (Let x' val' sc') stk
-compileStk svs stk (Bind fc x (Pi _ rig p ty) scope)
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         ty' <- compileStk svs [] ty
-         sc' <- compileStk (Bound x' :: svs) [] scope
-         p' <- compilePiInfo svs p
-         pure $ Vector (-3) [Lambda [x'] sc', toScheme rig, toSchemePi p',
-                                              ty', toScheme x]
-compileStk svs stk (Bind fc x (PVar _ rig p ty) scope)
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         ty' <- compileStk svs [] ty
-         sc' <- compileStk (Bound x' :: svs) [] scope
-         p' <- compilePiInfo svs p
-         pure $ Vector (-12) [Lambda [x'] sc', toScheme rig, toSchemePi p',
-                                               ty', toScheme x]
-compileStk svs stk (Bind fc x (PVTy _ rig ty) scope)
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         ty' <- compileStk svs [] ty
-         sc' <- compileStk (Bound x' :: svs) [] scope
-         pure $ Vector (-13) [Lambda [x'] sc', toScheme rig, ty', toScheme x]
-compileStk svs stk (Bind fc x (PLet _ rig val ty) scope) -- we only see this on LHS
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         val' <- compileStk svs [] val
-         ty' <- compileStk svs [] ty
-         sc' <- compileStk (Bound x' :: svs) [] scope
-         pure $ Vector (-14) [Lambda [x'] sc', toScheme rig, val', ty', toScheme x]
-compileStk svs [] (Bind fc x (Lam _ rig p ty) scope)
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         ty' <- compileStk svs [] ty
-         sc' <- compileStk (Bound x' :: svs) [] scope
-         p' <- compilePiInfo svs p
-         pure $ Vector (-8) [Lambda [x'] sc', toScheme rig, toSchemePi p',
-                                              ty', toScheme x]
-compileStk svs (s :: stk) (Bind fc x (Lam {}) scope)
-    = do i <- nextName
-         let x' = schVarName x ++ "-" ++ show i
-         sc' <- compileStk (Bound x' :: svs) stk scope
-         pure $ Apply (Lambda [x'] sc') [s]
-compileStk svs stk (App fc fn arg)
-    = compileStk svs (!(compileStk svs [] arg) :: stk) fn
--- We're only using this evaluator for REPL and typechecking, not for
--- tidying up definitions or LHSs, so we'll always remove As patterns
-compileStk svs stk (As fc x as pat) = compileStk svs stk pat
-compileStk svs stk (TDelayed fc r ty)
-    = do ty' <- compileStk svs stk ty
-         pure $ Vector (-15) [toScheme r, ty']
-compileStk svs stk (TDelay fc r ty arg)
-    = do ty' <- compileStk svs [] ty
-         arg' <- compileStk svs [] arg
-         pure $ Vector (-4) [toScheme r, toScheme fc,
-                             Lambda [] ty', Lambda [] arg']
-compileStk svs stk (TForce fc x tm)
-    = do tm' <- compileStk svs [] tm
-         pure $ Apply (Var "ct-doForce")
-                      [tm',
-                      Vector (-5) [toScheme x, toScheme fc, Lambda [] tm']]
-compileStk svs stk (PrimVal fc c) = pure $ compileConstant fc c
-compileStk svs stk (Erased fc why)
-  = do why' <- compileWhyErased svs stk why
-       pure $ Vector (-6) [toScheme fc, toSchemeWhy why']
-compileStk svs stk (TType fc u) = pure $ Vector (-7) [toScheme fc, toScheme u]
-
-export
-compile : Ref Sym Integer =>
-          {auto c : Ref Ctxt Defs} ->
-          SchVars vars -> Term vars -> Core (SchemeObj Write)
-compile vars tm = compileStk vars [] tm
-
-getArgName : Ref Sym Integer =>
-             Core Name
-getArgName
-    = do i <- nextName
-         pure (MN "carg" (cast i))
-
-extend : Ref Sym Integer =>
-         (args : List Name) -> SchVars vars ->
-         Core (List Name, SchVars (args ++ vars))
-extend [] svs = pure ([], svs)
-extend (arg :: args) svs
-    = do n <- getArgName
-         (args', svs') <- extend args svs
-         pure (n :: args', Bound (schVarName n) :: svs')
-
-compileCase : Ref Sym Integer =>
-              {auto c : Ref Ctxt Defs} ->
-              (blocked : SchemeObj Write) ->
-              SchVars vars -> CaseTree vars -> Core (SchemeObj Write)
-compileCase blk svs (Case idx p scTy xs)
-    = case !(caseType xs) of
-           CON => toSchemeConCases idx p xs
-           TYCON => toSchemeTyConCases idx p xs
-           DELAY => toSchemeDelayCases idx p xs
-           CONST => toSchemeConstCases idx p xs
-  where
-    data CaseType = CON | TYCON | DELAY | CONST
-
-    caseType : List (CaseAlt vs) -> Core CaseType
-    caseType [] = pure CON
-    caseType (ConCase x tag args y :: xs)
-        = do defs <- get Ctxt
-             Just gdef <- lookupCtxtExact x (gamma defs)
-                  | Nothing => pure TYCON -- primitive type match
-             case definition gdef of
-                  DCon {} => pure CON
-                  TCon {} => pure TYCON
-                  _ => pure CON -- or maybe throw?
-    caseType (DelayCase ty arg x :: xs) = pure DELAY
-    caseType (ConstCase x y :: xs) = pure CONST
-    caseType (DefaultCase x :: xs) = caseType xs
-
-    makeDefault : List (CaseAlt vars) -> Core (SchemeObj Write)
-    makeDefault [] = pure blk
-    makeDefault (DefaultCase sc :: xs) = compileCase blk svs sc
-    makeDefault (_ :: xs) = makeDefault xs
-
-    toSchemeConCases : (idx : Nat) -> (0 p : IsVar n idx vars) ->
-                       List (CaseAlt vars) -> Core (SchemeObj Write)
-    toSchemeConCases idx p alts
-        = do let var = getSchVar p svs
-             alts' <- traverse (makeAlt var) alts
-             let caseblock
-                    = Case (Apply (Var "vector-ref") [Var var, IntegerVal 0])
-                           (mapMaybe id alts')
-                           (Just !(makeDefault alts))
-             pure $ If (Apply (Var "ct-isDataCon") [Var var])
-                       caseblock
-                       blk
-      where
-        project : Int -> String -> List Name ->
-                  SchemeObj Write -> SchemeObj Write
-        project i var [] body = body
-        project i var (n :: ns) body
-            = Let (schVarName n)
-                  (Apply (Var "vector-ref") [Var var, IntegerVal (cast i)])
-                  (project (i + 1) var ns body)
-
-        bindArgs : String -> (args : List Name) -> CaseTree (args ++ vars) ->
-                   Core (SchemeObj Write)
-        bindArgs var args sc
-            = do (bind, svs') <- extend args svs
-                 project 3 var bind <$> compileCase blk svs' sc
-
-        makeAlt : String -> CaseAlt vars ->
-                  Core (Maybe (SchemeObj Write, SchemeObj Write))
-        makeAlt var (ConCase n t args sc)
-            = pure $ Just (IntegerVal (cast t), !(bindArgs var args sc))
-        -- TODO: Matching on types, including ->
-        makeAlt var _ = pure Nothing
-
-    toSchemeTyConCases : (idx : Nat) -> (0 p : IsVar n idx vars) ->
-                         List (CaseAlt vars) -> Core (SchemeObj Write)
-    toSchemeTyConCases idx p alts
-        = do let var = getSchVar p svs
-             alts' <- traverse (makeAlt var) alts
-             caseblock <- addPiMatch var alts
-                      -- work on the name, so the 2nd arg
-                            (Case (Apply (Var "vector-ref") [Var var, IntegerVal 2])
-                               (mapMaybe id alts')
-                               (Just !(makeDefault alts)))
-             pure $ If (Apply (Var "ct-isTypeMatchable") [Var var])
-                       caseblock
-                       blk
-      where
-        project : Int -> String -> List Name ->
-                  SchemeObj Write -> SchemeObj Write
-        project i var [] body = body
-        project i var (n :: ns) body
-            = Let (schVarName n)
-                  (Apply (Var "vector-ref") [Var var, IntegerVal (cast i)])
-                  (project (i + 1) var ns body)
-
-        bindArgs : String -> (args : List Name) -> CaseTree (args ++ vars) ->
-                   Core (SchemeObj Write)
-        bindArgs var args sc
-            = do (bind, svs') <- extend args svs
-                 project 5 var bind <$> compileCase blk svs' sc
-
-        makeAlt : String -> CaseAlt vars ->
-                  Core (Maybe (SchemeObj Write, SchemeObj Write))
-        makeAlt var (ConCase (UN (Basic "->")) t [_, _] sc)
-            = pure Nothing -- do this in 'addPiMatch' below, since the
-                           -- representation is different
-        makeAlt var (ConCase n t args sc)
-            = pure $ Just (StringVal (show n), !(bindArgs var args sc))
-        makeAlt var _ = pure Nothing
-
-        addPiMatch : String -> List (CaseAlt vars) -> SchemeObj Write ->
-                     Core (SchemeObj Write)
-        addPiMatch var [] def = pure def
-        -- t is a function type, and conveniently the scope of a pi
-        -- binding is represented as a function. Lucky us! So we just need
-        -- to extract it then evaluate the scope
-        addPiMatch var (ConCase (UN (Basic "->")) _ [s, t] sc :: _) def
-            = do sn <- getArgName
-                 tn <- getArgName
-                 let svs' = Bound (schVarName sn) ::
-                              Bound (schVarName tn) :: svs
-                 sc' <- compileCase blk svs' sc
-                 pure $ If (Apply (Var "ct-isPi") [Var var])
-                           (Let (schVarName sn) (Apply (Var "vector-ref") [Var var, IntegerVal 4]) $
-                            Let (schVarName tn) (Apply (Var "vector-ref") [Var var, IntegerVal 1]) $
-                            sc')
-                           def
-        addPiMatch var (x :: xs) def = addPiMatch var xs def
-
-    toSchemeConstCases : (idx : Nat) -> (0 p : IsVar n idx vars) ->
-                         List (CaseAlt vars) -> Core (SchemeObj Write)
-    toSchemeConstCases x p alts
-        = do let var = getSchVar p svs
-             alts' <- traverse (makeAlt var) alts
-             let caseblock
-                    = Cond (mapMaybe id alts')
-                           (Just !(makeDefault alts))
-             pure $ If (Apply (Var "ct-isConstant") [Var var])
-                       caseblock
-                       blk
-     where
-        makeAlt : String -> CaseAlt vars ->
-                  Core (Maybe (SchemeObj Write, SchemeObj Write))
-        makeAlt var (ConstCase c sc)
-            = do sc' <- compileCase blk svs sc
-                 pure (Just (Apply (Var "equal?")
-                               [Var var, compileConstant emptyFC c], sc'))
-        makeAlt var _ = pure Nothing
-
-    toSchemeDelayCases : (idx : Nat) -> (0 p : IsVar n idx vars) ->
-                         List (CaseAlt vars) -> Core (SchemeObj Write)
-    -- there will only ever be one, or a default case
-    toSchemeDelayCases idx p (DelayCase ty arg sc :: rest)
-        = do let var = getSchVar p svs
-             tyn <- getArgName
-             argn <- getArgName
-             let svs' = Bound (schVarName tyn) ::
-                          Bound (schVarName argn) :: svs
-             sc' <- compileCase blk svs' sc
-             pure $ If (Apply (Var "ct-isDelay") [Var var])
-                       (Let (schVarName tyn)
-                           (Apply (Apply (Var "vector-ref") [Var var, IntegerVal 3]) []) $
-                        Let (schVarName argn)
-                           (Apply (Apply (Var "vector-ref") [Var var, IntegerVal 4]) []) $
-                         sc')
-                       blk
-    toSchemeDelayCases idx p (_ :: rest) = toSchemeDelayCases idx p rest
-    toSchemeDelayCases idx p _ = pure Null
-
-compileCase blk vars (STerm _ tm) = compile vars tm
-compileCase blk vars _ = pure blk
-
-varObjs : SchVars ns -> List (SchemeObj Write)
-varObjs [] = []
-varObjs (x :: xs) = Var (show x) :: varObjs xs
-
-mkArgs : (ns : Scope) -> Core (SchVars ns)
-mkArgs [] = pure []
-mkArgs (x :: xs)
-    = pure $ Bound (schVarName x) :: !(mkArgs xs)
-
-bindArgs : Name ->
-           (todo : SchVars ns) ->
-           (done : List (SchemeObj Write)) ->
-           SchemeObj Write -> SchemeObj Write
-bindArgs n [] done body = body
-bindArgs n (x :: xs) done body
-    = Vector (-9) [blockedAppWith n (reverse done),
-                   Lambda [show x]
-                      (bindArgs n xs (Var (show x) :: done) body)]
-
-compileBody : {auto c : Ref Ctxt Defs} ->
-              Bool -> -- okay to reduce (if False, block)
-              Name -> Def -> Core (SchemeObj Write)
-compileBody _ n None = pure $ blockedAppWith n []
-compileBody redok n (PMDef pminfo args treeCT treeRT pats)
-    = do i <- newRef Sym 0
-         argvs <- mkArgs args
-         let blk = blockedAppWith n (varObjs argvs)
-         body <- compileCase blk argvs treeCT
-         let body' = if redok
-                        then If (Apply (Var "ct-isBlockAll") []) blk body
-                        else blk
-         -- If it arose from a hole, we need to take an extra argument for
-         -- the arity since that's what Meta gets applied to
-         case holeInfo pminfo of
-              NotHole => pure (bindArgs n argvs [] body')
-              SolvedHole _ => pure (Lambda ["h-0"] (bindArgs n argvs [] body'))
-compileBody _ n (ExternDef arity) = pure $ blockedAppWith n []
-compileBody _ n (ForeignDef arity xs) = pure $ blockedAppWith n []
-compileBody _ n (Builtin x) = pure $ compileBuiltin n x
-compileBody _ n (DCon tag Z newtypeArg)
-    = pure $ Vector (cast tag) [toScheme !(toResolvedNames n), toScheme emptyFC]
-compileBody _ n (DCon tag arity newtypeArg)
-    = do let args = mkArgNs 0 arity
-         argvs <- mkArgs args
-         let body
-               = Vector (cast tag)
-                        (toScheme n :: toScheme emptyFC ::
-                             map (Var . schVarName) args)
-         pure (bindArgs n argvs [] body)
-  where
-    mkArgNs : Int -> Nat -> List Name
-    mkArgNs i Z = []
-    mkArgNs i (S k) = MN "arg" i :: mkArgNs (i+1) k
-compileBody _ n (TCon Z parampos detpos flags mutwith datacons detagabbleBy)
-    = pure $ Vector (-1) [StringVal (show n), toScheme n, toScheme emptyFC]
-compileBody _ n (TCon arity parampos detpos flags mutwith datacons detagabbleBy)
-    = do let args = mkArgNs 0 arity
-         argvs <- mkArgs args
-         let body
-               = Vector (-1)
-                        (StringVal (show n) ::
-                          toScheme n :: toScheme emptyFC ::
-                            map (Var . schVarName) args)
-         pure (bindArgs n argvs [] body)
-  where
-    mkArgNs : Int -> Nat -> List Name
-    mkArgNs i Z = []
-    mkArgNs i (S k) = MN "arg" i :: mkArgNs (i+1) k
-compileBody _ n (Hole numlocs x) = pure $ blockedMetaApp n
-compileBody _ n (BySearch x maxdepth defining) = pure $ blockedMetaApp n
-compileBody _ n (Guess guess envbind constraints) = pure $ blockedMetaApp n
-compileBody _ n ImpBind = pure $ blockedMetaApp n
-compileBody _ n (UniverseLevel _) = pure $ blockedMetaApp n
-compileBody _ n Delayed = pure $ blockedMetaApp n
-
-export
-compileDef : {auto c : Ref Ctxt Defs} -> SchemeMode -> Name -> Core ()
-compileDef mode n_in
-    = do n <- toFullNames n_in -- this is handy for readability of generated names
-                     -- we used resolved names for blocked names, though, as
-                     -- that's a bit better for performance
-         defs <- get Ctxt
-         Just def <- lookupCtxtExact n (gamma defs)
-              | Nothing => throw (UndefinedName emptyFC n)
-
-         let True = case schemeExpr def of
-                         Nothing => True
-                         Just (cmode, def) => cmode /= mode
-               | _ => pure () -- already done
-         -- If we're in BlockExport mode, check whether the name is
-         -- available for reduction.
-         let redok = mode == EvalAll ||
-                       reducibleInAny (currentNS defs :: nestedNS defs)
-                                      (fullname def)
-                                      (collapseDefault $ visibility def)
-         -- 'n' is used in compileBody for generating names for readback,
-         -- and reading back resolved names is quicker because it's just
-         -- an integer
-         b <- compileBody redok !(toResolvedNames n) !(toFullNames (definition def))
-         let schdef = Define (schName n) b
-
-         -- Add the new definition to the current scheme runtime
-         Just obj <- coreLift $ evalSchemeObj schdef
-              | Nothing => throw (InternalError ("Compiling " ++ show n ++ " failed"))
-
-         -- Record that this one is done
-         ignore $ addDef n ({ schemeExpr := Just (mode, schdef) } def)
-
-initEvalWith : {auto c : Ref Ctxt Defs} ->
-               String -> Core Bool
-initEvalWith "chez"
-    = do defs <- get Ctxt
-         if defs.schemeEvalLoaded
-            then pure True
-            else
-             catch (do f <- readDataFile "chez/ct-support.ss"
-                       Just _ <- coreLift $ evalSchemeStr $ "(begin " ++ f ++ ")"
-                            | Nothing => pure False
-                       put Ctxt ({ schemeEvalLoaded := True } defs)
-                       pure True)
-                (\err => pure False)
-initEvalWith "racket"
-    = do defs <- get Ctxt
-         if defs.schemeEvalLoaded
-            then pure True
-            else
-             catch (do f <- readDataFile "racket/ct-support.rkt"
-                       Just _ <- coreLift $ evalSchemeStr $ "(begin " ++ f ++ ")"
-                            | Nothing => pure False
-                       put Ctxt ({ schemeEvalLoaded := True } defs)
-                       pure True)
-                (\err => do coreLift $ printLn err
-                            pure False)
-initEvalWith _ = pure False -- only works on Chez for now
-
--- Initialise the internal functions we need to build/extend blocked
--- applications
--- These are in a support file, chez/support.ss. Returns True if loading
--- and processing succeeds. If it fails, which it probably will during a
--- bootstrap build at least, we can fall back to the default evaluator.
-export
-initialiseSchemeEval : {auto c : Ref Ctxt Defs} ->
-                       Core Bool
-initialiseSchemeEval = initEvalWith codegen
diff --git a/src/Core/SchemeEval/Evaluate.idr b/src/Core/SchemeEval/Evaluate.idr
deleted file mode 100644
index b2453bae211..00000000000
--- a/src/Core/SchemeEval/Evaluate.idr
+++ /dev/null
@@ -1,598 +0,0 @@
-module Core.SchemeEval.Evaluate
-
-import Core.Context.Log
-import Core.Env
-import Core.SchemeEval.Compile
-import Core.SchemeEval.ToScheme
-
-import Libraries.Data.NameMap
-import Libraries.Utils.Scheme
-
-public export
-data SObj : Scoped where
-     MkSObj : ForeignObj -> SchVars vars -> SObj vars
-
--- Values, which we read off evaluated scheme objects.
--- Unfortunately we can't quite get away with using Core.Value.NF because
--- of the different representation of closures. Also, we're call by value
--- when going via scheme, so this structure is a little bit simpler (not
--- recording a LocalEnv for example).
-mutual
-  public export
-  data SHead : Scoped where
-       SLocal : (idx : Nat) -> (0 p : IsVar nm idx vars) -> SHead vars
-       SRef : NameType -> Name -> SHead vars
-       SMeta : Name -> Int -> List (Core (SNF vars)) -> SHead vars
-
-  public export
-  data SNF : Scoped where
-       SBind    : FC -> (x : Name) -> Binder (SNF vars) ->
-                  (SObj vars -> Core (SNF vars)) -> SNF vars
-       SApp     : FC -> SHead vars -> List (Core (SNF vars)) -> SNF vars
-       SDCon    : FC -> Name -> (tag : Int) -> (arity : Nat) ->
-                  List (Core (SNF vars)) -> SNF vars
-       STCon    : FC -> Name -> (arity : Nat) ->
-                  List (Core (SNF vars)) -> SNF vars
-       SDelayed : FC -> LazyReason -> SNF vars -> SNF vars
-       SDelay   : FC -> LazyReason -> Core (SNF vars) -> Core (SNF vars) ->
-                  SNF vars
-       SForce   : FC -> LazyReason -> SNF vars -> SNF vars
-       SPrimVal : FC -> Constant -> SNF vars
-       SErased  : FC -> WhyErased (SNF vars) -> SNF vars
-       SType    : FC -> Name -> SNF vars
-
-getAllNames : {auto c : Ref Ctxt Defs} ->
-              NameMap () -> List Name -> Core (NameMap ())
-getAllNames done [] = pure done
-getAllNames done (x :: xs)
-    = do let Nothing = lookup x done
-             | _ => getAllNames done xs
-         defs <- get Ctxt
-         Just gdef <- lookupCtxtExact x (gamma defs)
-             | _ => getAllNames done xs
-         getAllNames (insert x () done) (xs ++ keys (refersTo gdef))
-
--- Evaluate a term via scheme. This will throw if the backend doesn't
--- support scheme evaluation, so callers should have checked first and fall
--- back to the internal (slow!) evaluator if initialisation fails.
-export
-seval : {auto c : Ref Ctxt Defs} ->
-        SchemeMode -> Env Term vars -> Term vars -> Core (SObj vars)
-seval mode env tm
-    = do -- Check the evaluator is initialised. This will fail if the backend
-         -- doesn't support scheme evaluation.
-         True <- logTimeWhen False 0 "Scheme eval" initialiseSchemeEval
-              | False => throw (InternalError "Loading scheme support failed")
-
-         -- make sure all the names in the term are compiled
-         -- We need to recheck in advance, since definitions might have changed
-         -- since we last evaluated a name, and we might have evaluated the
-         -- name in a different mode
-         let ms = getRefs (MN "" 0) tm
-         let rs = addMetas False ms tm
-         names <- getAllNames empty (keys rs)
-         traverse_ (compileDef mode) (keys names)
-
-         i <- newRef Sym 0
-         (bind, schEnv) <- mkEnv env id
-         stm <- compile schEnv !(toFullNames tm)
-         Just res <- coreLift $ evalSchemeObj (bind stm)
-              | Nothing => throw (InternalError "Compiling expression failed")
-         pure (MkSObj res schEnv)
-  where
-    mkEnv : forall vars . Ref Sym Integer =>
-            Env Term vars ->
-            (SchemeObj Write -> SchemeObj Write) ->
-            Core (SchemeObj Write -> SchemeObj Write, SchVars vars)
-    mkEnv [] k = pure (k, [])
-    mkEnv (Let fc c val ty :: es) k
-        = do i <- nextName
-             (bind, vs) <- mkEnv es k
-             val' <- compile vs val
-             let n = "let-var-" ++ show i
-             pure (\x => Let n val' (bind x), Bound n :: vs)
-    mkEnv (_ :: es) k
-        = do i <- nextName
-             (bind, vs) <- mkEnv es k
-             pure (bind, Free ("free-" ++ show i) :: vs)
-
-invalid : Core (Term vs)
-invalid = pure (Erased emptyFC Placeholder)
-
-invalidS : Core (SNF vs)
-invalidS = pure (SErased emptyFC Placeholder)
-
-getArgList : ForeignObj -> List ForeignObj
-getArgList obj
-    = if isPair obj
-         then unsafeFst obj :: getArgList (unsafeSnd obj)
-         else []
-
-quoteFC : ForeignObj -> FC
-quoteFC fc_in = fromMaybe emptyFC (fromScheme (decodeObj fc_in))
-
-quoteLazyReason : ForeignObj -> LazyReason
-quoteLazyReason r_in = fromMaybe LUnknown (fromScheme (decodeObj r_in))
-
-quoteTypeLevel : ForeignObj -> Name
-quoteTypeLevel u_in = fromMaybe (MN "top" 0) (fromScheme (decodeObj u_in))
-
-quoteRigCount : ForeignObj -> RigCount
-quoteRigCount rig_in = fromMaybe top (fromScheme (decodeObj rig_in))
-
-quoteBinderName : ForeignObj -> Name
-quoteBinderName nm_in
-  = fromMaybe (UN (Basic "x")) (fromScheme (decodeObj nm_in))
-
-quoteOrInvalid : Scheme x =>
-              ForeignObj -> (x -> Core (Term vars)) -> Core (Term vars)
-quoteOrInvalid obj_in k = do
-  let Just obj = fromScheme (decodeObj obj_in)
-    | Nothing => invalid
-  k obj
-
-quoteOrInvalidS : Scheme x =>
-                 ForeignObj -> (x -> Core (SNF vars)) -> Core (SNF vars)
-quoteOrInvalidS obj_in k = do
-  let Just obj = fromScheme (decodeObj obj_in)
-    | Nothing => invalidS
-  k obj
-
-mutual
-
-  -- We don't use decodeObj because then we have to traverse the term twice.
-  -- Instead, decode the ForeignObj directly, which is uglier but faster.
-  quoteVector : Ref Sym Integer =>
-                Ref Ctxt Defs =>
-                SchVars (outer ++ vars) ->
-                Integer -> List ForeignObj ->
-                Core (Term (outer ++ vars))
-  quoteVector svs (-2) [_, fname_in, args_in] -- Blocked app
-      = quoteOrInvalid fname_in $ \ fname => do
-           let argList = getArgList args_in
-           args <- traverse (quote' svs) argList
-           pure (apply emptyFC (Ref emptyFC Func fname) args)
-  quoteVector svs (-10) [_, fn_arity, args_in] -- Blocked meta app
-      = quoteOrInvalid {x = (Name, Integer)} fn_arity $ \ (fname, arity_in) => do
-           let arity : Nat = cast arity_in
-           let argList = getArgList args_in
-           args <- traverse (quote' svs) argList
-           defs <- get Ctxt
-           fnameF <- toFullNames fname
-           (idx, _) <- getPosition fname (gamma defs)
-           pure (apply emptyFC (Meta emptyFC fnameF idx (take arity args))
-                               (drop arity args))
-  quoteVector svs (-11) [_, loc_in, args_in] -- Blocked local var application
-      = do loc <- quote' svs loc_in
-           let argList = getArgList args_in
-           args <- traverse (quote' svs) argList
-           pure (apply emptyFC loc args)
-  quoteVector svs (-1) (_ :: strtag :: cname_in :: fc_in :: args_in) -- TyCon
-      = quoteOrInvalid cname_in $ \ cname => do
-           let fc = emptyFC -- quoteFC fc_in
-           args <- traverse (quote' svs) args_in
-           pure (apply fc (Ref fc (TyCon (length args)) cname)
-                           args)
-  quoteVector svs (-15) [_, r_in, ty_in] -- Delayed
-      = do ty <- quote' svs ty_in
-           let r = quoteLazyReason r_in
-           pure (TDelayed emptyFC r ty)
-  quoteVector svs (-4) [_, r_in, fc_in, ty_in, tm_in] -- Delay
-      = do -- Block further reduction under tm_in
-           Just _ <- coreLift $ evalSchemeStr "(ct-setBlockAll #t)"
-                | Nothing => invalid
-           let Procedure tmproc = decodeObj tm_in
-                | _ => invalid
-           let Procedure typroc = decodeObj ty_in
-                | _ => invalid
-           tm <- quote' svs (unsafeForce tmproc)
-           ty <- quote' svs (unsafeForce typroc)
-           -- Turn blocking off again
-           Just _ <- coreLift $ evalSchemeStr "(ct-setBlockAll #f)"
-                | Nothing => invalid
-           let fc = quoteFC fc_in
-           let r = quoteLazyReason r_in
-           pure (TDelay fc r ty tm)
-  quoteVector svs (-5) [_, r_in, fc_in, tm_in] -- Force
-      = do -- The thing we were trying to force was stuck. Corresponding to
-           -- Core.Normalise, reduce it anyway here (so no ct-blockAll like above)
-           tm <- quote' svs tm_in
-           let fc = quoteFC fc_in
-           let r = quoteLazyReason r_in
-           pure (TForce fc r tm)
-  quoteVector svs (-6) [_, fc_in, imp_in] -- Erased
-      = do let fc = quoteFC fc_in
-           imp <- quoteWhyErased (quote' svs) imp_in
-           pure (Erased fc imp)
-  quoteVector svs (-7) [_, fc_in, u_in] -- Type
-      = do let fc = quoteFC fc_in
-           let u = quoteTypeLevel u_in
-           pure (TType fc u)
-  quoteVector svs (-8) [_, proc_in, rig_in, pi_in, ty_in, name_in] -- Lambda
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- quote' svs ty_in
-           pi <- quotePiInfo svs pi_in
-           quoteBinder svs Lam proc_in rig pi ty name
-  quoteVector svs (-3) [_, proc_in, rig_in, pi_in, ty_in, name_in] -- Pi
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- quote' svs ty_in
-           pi <- quotePiInfo svs pi_in
-           quoteBinder svs Pi proc_in rig pi ty name
-  quoteVector svs (-12) [_, proc_in, rig_in, pi_in, ty_in, name_in] -- PVar
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- quote' svs ty_in
-           pi <- quotePiInfo svs pi_in
-           quoteBinder svs PVar proc_in rig pi ty name
-  quoteVector svs (-13) [_, proc_in, rig_in, ty_in, name_in] -- PVTy
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- quote' svs ty_in
-           quoteBinder svs (\fc, r, p, t => PVTy fc r t) proc_in rig Explicit ty name
-  quoteVector svs (-14) [_, proc_in, rig_in, val_in, ty_in, name_in] -- PLet
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- quote' svs ty_in
-           val <- quote' svs val_in
-           quotePLet svs proc_in rig val ty name
-  quoteVector svs (-9) [_, blocked, _] -- Blocked top level lambda
-      = quote' svs blocked
-  quoteVector svs (-100) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (I x')
-  quoteVector svs (-101) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (I8 x')
-  quoteVector svs (-102) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (I16 x')
-  quoteVector svs (-103) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (I32 x')
-  quoteVector svs (-104) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (I64 x')
-  quoteVector svs (-105) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (BI x')
-  quoteVector svs (-106) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (B8 x')
-  quoteVector svs (-107) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (B16 x')
-  quoteVector svs (-108) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (B32 x')
-  quoteVector svs (-109) [_, x]
-      = quoteOrInvalid x $ \ x' => pure $ PrimVal emptyFC (B64 x')
-  quoteVector svs tag (_ :: cname_in :: fc_in :: args_in) -- DataCon
-      = if tag >= 0
-           then quoteOrInvalid cname_in $ \ cname =>  do
-             let fc = emptyFC -- quoteFC fc_in
-             args <- traverse (quote' svs) args_in
-             pure (apply fc (Ref fc (DataCon (cast tag) (length args)) cname)
-                            args)
-           else invalid
-  quoteVector _ _ _ = invalid
-
-  quotePiInfo : Ref Sym Integer =>
-                Ref Ctxt Defs =>
-                SchVars (outer ++ vars) ->
-                ForeignObj ->
-                Core (PiInfo (Term (outer ++ vars)))
-  quotePiInfo svs obj
-      = if isInteger obj
-           then case unsafeGetInteger obj of
-                     0 => pure Implicit
-                     1 => pure Explicit
-                     2 => pure AutoImplicit
-                     _ => pure Explicit
-           else if isBox obj
-                   then do t' <- quote' svs (unsafeUnbox obj)
-                           pure (DefImplicit t')
-           else pure Explicit
-
-  quoteWhyErased : (ForeignObj -> Core a) ->
-                   ForeignObj ->
-                   Core (WhyErased a)
-  quoteWhyErased qt obj
-      = if isInteger obj
-           then case unsafeGetInteger obj of
-                     0 => pure Impossible
-                     _ => pure Placeholder
-           else if isBox obj
-                   then do t' <- qt (unsafeUnbox obj)
-                           pure (Dotted t')
-           else pure Placeholder
-
-  quoteBinder : Ref Sym Integer =>
-                Ref Ctxt Defs =>
-                SchVars (outer ++ vars) ->
-                (forall ty . FC -> RigCount -> PiInfo ty -> ty -> Binder ty) ->
-                ForeignObj -> -- body of binder, represented as a function
-                RigCount ->
-                PiInfo (Term (outer ++ vars)) ->
-                Term (outer ++ vars) -> -- decoded type
-                Name -> -- bound name
-                Core (Term (outer ++ vars))
-  quoteBinder svs binder proc_in r pi ty name
-      = do let Procedure proc = decodeObj proc_in
-                    | _ => invalid
-           i <- nextName
-           let n = show name ++ "-" ++ show i
-           let sc = unsafeApply proc (makeSymbol n)
-           sc' <- quote' {outer = name :: outer} (Bound n :: svs) sc
-           pure (Bind emptyFC name
-                      (binder emptyFC r pi ty)
-                      sc')
-
-  quotePLet : Ref Sym Integer =>
-              Ref Ctxt Defs =>
-              SchVars (outer ++ vars) ->
-              ForeignObj -> -- body of binder, represented as a function
-              RigCount ->
-              Term (outer ++ vars) -> -- decoded type
-              Term (outer ++ vars) -> -- decoded value
-              Name -> -- bound name
-              Core (Term (outer ++ vars))
-  quotePLet svs proc_in r val ty name
-      = do let Procedure proc = decodeObj proc_in
-                    | _ => invalid
-           i <- nextName
-           let n = show name ++ "-" ++ show i
-           let sc = unsafeApply proc (makeSymbol n)
-           sc' <- quote' {outer = name :: outer} (Bound n :: svs) sc
-           pure (Bind emptyFC name
-                      (PLet emptyFC r val ty)
-                      sc')
-
-  quote' : Ref Sym Integer =>
-           Ref Ctxt Defs =>
-           SchVars (outer ++ vars) -> ForeignObj ->
-           Core (Term (outer ++ vars))
-  quote' svs obj
-      = if isVector obj
-           then quoteVector svs (unsafeGetInteger (unsafeVectorRef obj 0))
-                                (unsafeVectorToList obj)
-        else if isProcedure obj then quoteBinder svs Lam obj top
-                                              Explicit
-                                              (Erased emptyFC Placeholder)
-                                              (UN (Basic "x"))
-        else if isSymbol obj then pure $ findName svs (unsafeReadSymbol obj)
-        else if isFloat obj then pure $ PrimVal emptyFC (Db (unsafeGetFloat obj))
-        else if isInteger obj then pure $ PrimVal emptyFC (I (cast (unsafeGetInteger obj)))
-        else if isString obj then pure $ PrimVal emptyFC (Str (unsafeGetString obj))
-        else if isChar obj then pure $ PrimVal emptyFC (Ch (unsafeGetChar obj))
-        else invalid
-    where
-      findName : forall vars . SchVars vars -> String -> Term vars
-      findName [] n = Ref emptyFC Func (UN (Basic n))
-      findName (x :: xs) n
-          = if getName x == n
-               then Local emptyFC Nothing _ First
-               else let Local fc loc _ p = findName xs n
-                           | _ => Ref emptyFC Func (UN (Basic n)) in
-                        Local fc loc _ (Later p)
-
-      readVector : Integer -> Integer -> ForeignObj -> List ForeignObj
-      readVector len i obj
-          = if len == i
-               then []
-               else unsafeVectorRef obj i :: readVector len (i + 1) obj
-
--- Quote a scheme value directly back to a Term, without making an SNF
--- in between. This is what we want if we're just looking for a normal
--- form immediately (so, evaluating under binders)
-export
-quoteObj : {auto c : Ref Ctxt Defs} ->
-           SObj vars -> Core (Term vars)
-quoteObj (MkSObj val schEnv)
-    = do i <- newRef Sym 0
-         quote' {outer = Scope.empty} schEnv val
-
-mutual
-  snfVector : Ref Ctxt Defs =>
-              SchVars vars ->
-              Integer -> List ForeignObj ->
-              Core (SNF vars)
-  snfVector svs (-2) [_, fname_in, args_in] -- Blocked application
-      = quoteOrInvalidS fname_in $ \ fname => do
-           let args = map (snf' svs) (getArgList args_in)
-           pure (SApp emptyFC (SRef Func fname) args)
-  snfVector svs (-10) [_, fn_arity, args_in] -- Block meta app
-      = quoteOrInvalidS {x = (Name, Integer)} fn_arity $ \ (fname, arity_in) => do
-           let arity : Nat = cast arity_in
-           let args = map (snf' svs) (getArgList args_in)
-           defs <- get Ctxt
-           fnameF <- toFullNames fname
-           (idx, _) <- getPosition fnameF (gamma defs)
-           pure (SApp emptyFC (SMeta fnameF idx (take arity args))
-                               (drop arity args))
-  snfVector svs (-11) [_, loc_in, args_in] -- Blocked local var application
-      = do SApp fc loc args <- snf' svs loc_in
-                | _ => invalidS
-           let args' = map (snf' svs) (getArgList args_in)
-           pure (SApp fc loc (args ++ args'))
-  snfVector svs (-1) (_ :: strtag :: cname_in :: fc_in :: args_in) -- TyCon
-      = quoteOrInvalidS cname_in $ \ cname => do
-           let fc = quoteFC fc_in
-           let args = map (snf' svs) args_in
-           pure (STCon fc cname (length args) args)
-  snfVector svs (-15) [_, r_in, ty_in] -- Delayed
-      = do ty <- snf' svs ty_in
-           let r = quoteLazyReason r_in
-           pure (SDelayed emptyFC r ty)
-  snfVector svs (-4) [_, r_in, fc_in, ty_in, tm_in] -- Delay
-      = do let Procedure tmproc = decodeObj tm_in
-                | _ => invalidS
-           let Procedure typroc = decodeObj ty_in
-                | _ => invalidS
-           -- Block further reduction under tm_in
-           let tm = do Just _ <- coreLift $ evalSchemeStr "(ct-setBlockAll #t)"
-                            | Nothing => invalidS
-                       res <- snf' svs (unsafeForce tmproc)
-                       Just _ <- coreLift $ evalSchemeStr "(ct-setBlockAll #f)"
-                            | Nothing => invalidS
-                       pure res
-           let ty = snf' svs (unsafeForce typroc)
-           let fc = quoteFC fc_in
-           let r = quoteLazyReason r_in
-           pure (SDelay fc r ty tm)
-  snfVector svs (-5) [_, r_in, fc_in, tm_in] -- Force
-      = do -- The thing we were trying to force was stuck. Corresponding to
-           -- Core.Normalise, reduce it anyway here (so no ct-blockAll like above)
-           tm <- snf' svs tm_in
-           let fc = quoteFC fc_in
-           let r = quoteLazyReason r_in
-           pure (SForce fc r tm)
-  snfVector svs (-6) [_, fc_in, imp_in] -- Erased
-      = do let fc = quoteFC fc_in
-           imp <- quoteWhyErased (snf' svs) imp_in
-           pure (SErased fc imp)
-  snfVector svs (-7) [_, fc_in, u_in] -- Type
-      = do let fc = quoteFC fc_in
-           let u = quoteTypeLevel u_in
-           pure (SType fc u)
-  snfVector svs (-8) [_, proc_in, rig_in, pi_in, ty_in, name_in] -- Lambda
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- snf' svs ty_in
-           pi <- snfPiInfo svs pi_in
-           snfBinder svs Lam proc_in rig pi ty name
-  snfVector svs (-3) [_, proc_in, rig_in, pi_in, ty_in, name_in] -- Pi
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- snf' svs ty_in
-           pi <- snfPiInfo svs pi_in
-           snfBinder svs Pi proc_in rig pi ty name
-  snfVector svs (-12) [_, proc_in, rig_in, pi_in, ty_in, name_in] -- PVar
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- snf' svs ty_in
-           pi <- snfPiInfo svs pi_in
-           snfBinder svs PVar proc_in rig pi ty name
-  snfVector svs (-13) [_, proc_in, rig_in, ty_in, name_in] -- PVTy
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- snf' svs ty_in
-           snfBinder svs (\fc, r, p, t => PVTy fc r t) proc_in rig Explicit ty name
-  snfVector svs (-14) [_, proc_in, rig_in, val_in, ty_in, name_in] -- PLet
-      = do let name = quoteBinderName name_in
-           let rig = quoteRigCount rig_in
-           ty <- snf' svs ty_in
-           val <- snf' svs val_in
-           snfPLet svs proc_in rig val ty name
-  snfVector svs (-9) [_, blocked, _] -- Blocked top level lambda
-      = snf' svs blocked
-
-  -- constants here
-  snfVector svs (-100) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (I x')
-  snfVector svs (-101) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (I8 x')
-  snfVector svs (-102) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (I16 x')
-  snfVector svs (-103) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (I32 x')
-  snfVector svs (-104) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (I64 x')
-  snfVector svs (-105) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (BI x')
-  snfVector svs (-106) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (B8 x')
-  snfVector svs (-107) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (B16 x')
-  snfVector svs (-108) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (B32 x')
-  snfVector svs (-109) [_, x]
-      = quoteOrInvalidS x $ \ x' => pure $ SPrimVal emptyFC (B64 x')
-
-  snfVector svs tag (_ :: cname_in :: fc_in :: args_in) -- DataCon
-      = if tag >= 0
-           then quoteOrInvalidS cname_in $ \ cname => do
-             let fc = quoteFC fc_in
-             let args = map (snf' svs) args_in
-             pure (SDCon fc cname (cast tag) (length args) args)
-           else invalidS
-  snfVector _ _ _ = invalidS
-
-  snfPiInfo : Ref Ctxt Defs =>
-              SchVars vars ->
-              ForeignObj ->
-              Core (PiInfo (SNF vars))
-  snfPiInfo svs obj
-      = if isInteger obj
-           then case unsafeGetInteger obj of
-                     0 => pure Implicit
-                     1 => pure Explicit
-                     2 => pure AutoImplicit
-                     _ => pure Explicit
-           else if isBox obj
-                   then do t' <- snf' svs (unsafeUnbox obj)
-                           pure (DefImplicit t')
-           else pure Explicit
-
-  snfBinder : Ref Ctxt Defs =>
-              SchVars vars ->
-              (forall ty . FC -> RigCount -> PiInfo ty -> ty -> Binder ty) ->
-              ForeignObj -> -- body of binder, represented as a function
-              RigCount ->
-              PiInfo (SNF vars) ->
-              SNF vars -> -- decoded type
-              Name -> -- bound name
-              Core (SNF vars)
-  snfBinder svs binder proc_in r pi ty name
-      = do let Procedure proc = decodeObj proc_in
-                    | _ => invalidS
-           pure (SBind emptyFC name (binder emptyFC r pi ty)
-                       (\tm => do let MkSObj arg _ = tm
-                                  let sc = unsafeApply proc arg
-                                  snf' svs sc))
-
-  snfPLet : Ref Ctxt Defs =>
-            SchVars vars ->
-            ForeignObj -> -- body of binder, represented as a function
-            RigCount ->
-            SNF vars -> -- decoded type
-            SNF vars -> -- decoded value
-            Name -> -- bound name
-            Core (SNF vars)
-  snfPLet svs proc_in r val ty name
-      = do let Procedure proc = decodeObj proc_in
-                    | _ => invalidS
-           pure (SBind emptyFC name (PLet emptyFC r val ty)
-                       (\tm => do let MkSObj arg _ = tm
-                                  let sc = unsafeApply proc arg
-                                  snf' svs sc))
-
-  snf' : Ref Ctxt Defs =>
-         SchVars vars -> ForeignObj ->
-         Core (SNF vars)
-  snf' svs obj
-      = if isVector obj
-           then snfVector svs (unsafeGetInteger (unsafeVectorRef obj 0))
-                              (unsafeVectorToList obj)
-           else if isProcedure obj then snfBinder svs Lam obj top
-                                                 Explicit
-                                                 (SErased emptyFC Placeholder)
-                                                 (UN (Basic "x"))
-           else if isSymbol obj then pure $ findName svs (unsafeReadSymbol obj)
-           else if isFloat obj then pure $ SPrimVal emptyFC (Db (unsafeGetFloat obj))
-           else if isInteger obj then pure $ SPrimVal emptyFC (I (cast (unsafeGetInteger obj)))
-           else if isString obj then pure $ SPrimVal emptyFC (Str (unsafeGetString obj))
-           else if isChar obj then pure $ SPrimVal emptyFC (Ch (unsafeGetChar obj))
-           else invalidS
-    where
-      findName : forall vars . SchVars vars -> String -> SNF vars
-      findName [] n = SApp emptyFC (SRef Func (UN (Basic n))) []
-      findName (x :: xs) n
-          = if getName x == n
-               then SApp emptyFC (SLocal _ First) []
-               else let SApp fc (SLocal _ p) args = findName xs n
-                           | _ => SApp emptyFC (SRef Func (UN (Basic n))) [] in
-                        SApp fc (SLocal _ (Later p)) []
-
-      readVector : Integer -> Integer -> ForeignObj -> List ForeignObj
-      readVector len i obj
-          = if len == i
-               then []
-               else unsafeVectorRef obj i :: readVector len (i + 1) obj
-
-export
-toSNF : Ref Ctxt Defs =>
-        SObj vars -> Core (SNF vars)
-toSNF (MkSObj val schEnv) = snf' schEnv val
diff --git a/src/Core/SchemeEval/Quote.idr b/src/Core/SchemeEval/Quote.idr
deleted file mode 100644
index 6d64f46abb5..00000000000
--- a/src/Core/SchemeEval/Quote.idr
+++ /dev/null
@@ -1,139 +0,0 @@
-module Core.SchemeEval.Quote
-
-import Core.Context
-import Core.Env
-import Core.SchemeEval.Compile
-import Core.SchemeEval.Evaluate
-
-mutual
-  quoteArgs : {auto c : Ref Ctxt Defs} ->
-              {bound, free : _} ->
-              Ref Sym Integer -> Bounds bound ->
-              Env Term free -> List (Core (SNF free)) ->
-              Core (List (Term (bound ++ free)))
-  quoteArgs q bound env args
-      = traverse (\arg => do arg' <- arg
-                             quoteGen q bound env arg') args
-
-  quotePi : {auto c : Ref Ctxt Defs} ->
-            {bound, free : _} ->
-            Ref Sym Integer -> Bounds bound ->
-            Env Term free -> PiInfo (SNF free) ->
-            Core (PiInfo (Term (bound ++ free)))
-  quotePi q bound env Explicit = pure Explicit
-  quotePi q bound env Implicit = pure Implicit
-  quotePi q bound env AutoImplicit = pure AutoImplicit
-  quotePi q bound env (DefImplicit t)
-      = do t' <- quoteGen q bound env t
-           pure (DefImplicit t')
-
-  quoteBinder : {auto c : Ref Ctxt Defs} ->
-                {bound, free : _} ->
-                Ref Sym Integer -> Bounds bound ->
-                Env Term free -> Binder (SNF free) ->
-                Core (Binder (Term (bound ++ free)))
-  quoteBinder q bound env (Lam fc r p ty)
-     = do ty' <- quoteGen q bound env ty
-          p' <- quotePi q bound env p
-          pure (Lam fc r p' ty')
-  quoteBinder q bound env (Let fc r val ty)
-     = do ty' <- quoteGen q bound env ty
-          val' <- quoteGen q bound env val
-          pure (Let fc r val' ty')
-  quoteBinder q bound env (Pi fc r p ty)
-     = do ty' <- quoteGen q bound env ty
-          p' <- quotePi q bound env p
-          pure (Pi fc r p' ty')
-  quoteBinder q bound env (PVar fc r p ty)
-     = do ty' <- quoteGen q bound env ty
-          p' <- quotePi q bound env p
-          pure (PVar fc r p' ty')
-  quoteBinder q bound env (PLet fc r val ty)
-     = do ty' <- quoteGen q bound env ty
-          val' <- quoteGen q bound env val
-          pure (PLet fc r val' ty')
-  quoteBinder q bound env (PVTy fc r ty)
-     = do ty' <- quoteGen q bound env ty
-          pure (PVTy fc r ty')
-
-  quoteHead : {auto c : Ref Ctxt Defs} ->
-              {bound, free : _} ->
-              Ref Sym Integer ->
-              FC -> Bounds bound -> Env Term free -> SHead free ->
-              Core (Term (bound ++ free))
-  quoteHead {bound} q fc bounds env (SLocal idx prf)
-      = let MkVar prf' = addLater bound prf in
-            pure (Local fc Nothing _ prf')
-    where
-      addLater : {idx : _} ->
-                 (ys : Scope) -> (0 p : IsVar n idx xs) ->
-                 Var (ys ++ xs)
-      addLater [] isv = MkVar isv
-      addLater (x :: xs) isv
-          = let MkVar isv' = addLater xs isv in
-                MkVar (Later isv')
-  quoteHead q fc bounds env (SRef nt n)
-      = pure $ case findName bounds of
-             Just (MkVar p) => Local fc Nothing _ (embedIsVar p)
-             Nothing => Ref fc nt n
-    where
-      findName : Bounds bound' -> Maybe (Var bound')
-      findName None = Nothing
-      findName (Add x n' ns)
-          = if n == n'
-               then Just first
-               else do MkVar p <-findName ns
-                       Just (MkVar (Later p))
-  quoteHead q fc bounds env (SMeta n i args)
-      = do args' <- quoteArgs q bounds env args
-           pure $ Meta fc n i args'
-
-  quoteGen : {auto c : Ref Ctxt Defs} ->
-             {bound, vars : _} ->
-             Ref Sym Integer -> Bounds bound ->
-             Env Term vars -> SNF vars -> Core (Term (bound ++ vars))
-  quoteGen q bound env (SBind fc n b sc)
-      = do i <- nextName
-           let var = UN (Basic ("b-" ++ show (fromInteger i)))
-           -- Ref Bound gets turned directly into a symbol by seval, which
-           -- we can then read back when quoting the scope
-           arg <- seval EvalAll env (Ref fc Bound var)
-           sc' <- quoteGen q (Add n var bound) env !(sc arg)
-           b' <- quoteBinder q bound env b
-           pure (Bind fc n b' sc')
-  quoteGen q bound env (SApp fc f args)
-      = do f' <- quoteHead q fc bound env f
-           args' <- quoteArgs q bound env args
-           pure $ apply fc f' args'
-  quoteGen q bound env (SDCon fc n t ar args)
-      = do args' <- quoteArgs q bound env args
-           pure $ apply fc (Ref fc (DataCon t ar) n) args'
-  quoteGen q bound env (STCon fc n ar args)
-      = do args' <- quoteArgs q bound env args
-           pure $ apply fc (Ref fc (TyCon ar) n) args'
-  quoteGen q bound env (SDelayed fc r arg)
-      = do argQ <- quoteGen q bound env arg
-           pure (TDelayed fc r argQ)
-  quoteGen q bound env (SDelay fc r ty arg)
-      = do argQ <- quoteGen q bound env !arg
-           tyQ <- quoteGen q bound env !ty
-           pure (TDelay fc r tyQ argQ)
-  quoteGen q bound env (SForce fc r arg)
-      = case arg of
-             SDelay fc _ _ arg => quoteGen q bound env !arg
-             _ => do arg' <- quoteGen q bound env arg
-                     pure $ (TForce fc r arg')
-  quoteGen q bound env (SPrimVal fc c) = pure $ PrimVal fc c
-  quoteGen q bound env (SErased fc Impossible) = pure $ Erased fc Impossible
-  quoteGen q bound env (SErased fc Placeholder) = pure $ Erased fc Placeholder
-  quoteGen q bound env (SErased fc (Dotted t))
-    = pure $ Erased fc $ Dotted !(quoteGen q bound env t)
-  quoteGen q bound env (SType fc u) = pure $ TType fc u
-
-export
-quote : {auto c : Ref Ctxt Defs} ->
-        {vars : _} ->
-        Env Term vars -> SNF vars -> Core (Term vars)
-quote env tm
-    = do q <- newRef Sym 0
-         quoteGen q None env tm
diff --git a/src/Core/SchemeEval/ToScheme.idr b/src/Core/SchemeEval/ToScheme.idr
deleted file mode 100644
index cc9dab2cf43..00000000000
--- a/src/Core/SchemeEval/ToScheme.idr
+++ /dev/null
@@ -1,114 +0,0 @@
-module Core.SchemeEval.ToScheme
-
-import Core.TT
-import Libraries.Utils.Scheme
-
-export
-Scheme Namespace where
-  toScheme x = toScheme (unsafeUnfoldNamespace x)
-  fromScheme x = Just $ unsafeFoldNamespace !(fromScheme x)
-
-export
-Scheme UserName where
-  toScheme (Basic str) = toScheme str
-  toScheme (Field str) = Vector 5 [toScheme str]
-  toScheme Underscore = Vector 9 []
-
-  fromScheme (Vector 5 [x]) = pure $ Field !(fromScheme x)
-  fromScheme (Vector 9 []) = pure Underscore
-  fromScheme (StringVal x) = pure (Basic x)
-  fromScheme _ = Nothing
-
-export
-Scheme Name where
-  toScheme (NS x y) = Vector 0 [toScheme x, toScheme y]
-  toScheme (UN x) = toScheme x
-  toScheme (MN x y) = Vector 2 [toScheme x, toScheme y]
-  toScheme (PV x y) = Vector 3 [toScheme x, toScheme y]
-  toScheme (DN x y) = Vector 4 [toScheme x, toScheme y]
-  toScheme (Nested x y) = Vector 6 [toScheme x, toScheme y]
-  toScheme (CaseBlock x y) = Vector 7 [toScheme x, toScheme y]
-  toScheme (WithBlock x y) = Vector 8 [toScheme x, toScheme y]
-  toScheme (Resolved x) = toScheme x -- we'll see this most often
-
-  fromScheme (Vector 0 [x, y])
-      = pure $ NS !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 2 [x, y])
-      = pure $ MN !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 3 [x, y])
-      = pure $ PV !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 4 [x, y])
-      = pure $ DN !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 5 [x, y])
-      = pure $ UN (Field !(fromScheme x))
-  fromScheme (Vector 6 [x, y])
-      = pure $ Nested !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 7 [x, y])
-      = pure $ CaseBlock !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 8 [x, y])
-      = pure $ WithBlock !(fromScheme x) !(fromScheme y)
-  fromScheme (Vector 9 [])
-      = pure $ UN Underscore
-  fromScheme (IntegerVal x)
-      = pure $ Resolved (cast x)
-  fromScheme (StringVal x)
-      = pure $ UN (Basic x)
-  fromScheme _ = Nothing
-
-export
-Scheme ModuleIdent where
-  toScheme ns = toScheme (miAsNamespace ns)
-  fromScheme s = Just $ nsAsModuleIdent !(fromScheme s)
-
-export
-Scheme OriginDesc where
-  toScheme (PhysicalIdrSrc ident) = Vector 0 [toScheme ident]
-  toScheme (PhysicalPkgSrc fname) = Vector 1 [toScheme fname]
-  toScheme (Virtual ident) = Null
-
-  fromScheme (Vector 0 [i]) = Just (PhysicalIdrSrc !(fromScheme i))
-  fromScheme (Vector 1 [i]) = Just (PhysicalPkgSrc !(fromScheme i))
-  fromScheme (Vector {}) = Nothing
-  fromScheme _ = Just (Virtual Interactive)
-
-export
-Scheme FC where
-  toScheme (MkFC d s e) = Vector 0 [toScheme d, toScheme s, toScheme e]
-  toScheme (MkVirtualFC d s e) = Vector 1 [toScheme d, toScheme s, toScheme e]
-  toScheme EmptyFC = Null
-
-  fromScheme _ = Just EmptyFC
-
-export
-Scheme LazyReason where
-  toScheme LInf = IntegerVal 0
-  toScheme LLazy = IntegerVal 1
-  toScheme LUnknown = IntegerVal 2
-
-  fromScheme (IntegerVal 0) = Just LInf
-  fromScheme (IntegerVal 1) = Just LLazy
-  fromScheme _ = Just LUnknown
-
-export
-Scheme RigCount where
-  toScheme x
-      = if isErased x then IntegerVal 0
-        else if isLinear x then IntegerVal 1
-        else IntegerVal 2
-
-  fromScheme (IntegerVal 0) = Just erased
-  fromScheme (IntegerVal 1) = Just linear
-  fromScheme _ = Just top
-
-export
-toSchemePi : PiInfo (SchemeObj Write) -> SchemeObj Write
-toSchemePi Implicit = IntegerVal 0
-toSchemePi Explicit = IntegerVal 1
-toSchemePi AutoImplicit = IntegerVal 2
-toSchemePi (DefImplicit s) = Box s
-
-export
-toSchemeWhy : WhyErased (SchemeObj Write) -> SchemeObj Write
-toSchemeWhy Impossible = IntegerVal 0
-toSchemeWhy Placeholder = IntegerVal 1
-toSchemeWhy (Dotted s) = Box s
diff --git a/src/Core/TT.idr b/src/Core/TT.idr
index fd576405b98..4ae89f45230 100644
--- a/src/Core/TT.idr
+++ b/src/Core/TT.idr
@@ -5,6 +5,8 @@ import public Core.Name
 import public Core.Name.Scoped
 
 import Data.Maybe
+import Data.String
+import Data.Vect
 
 import Libraries.Data.NameMap
 import Libraries.Text.PrettyPrint.Prettyprinter
@@ -285,13 +287,13 @@ Show PartialReason where
   show (BadCall [n])
       = "possibly not terminating due to call to " ++ show n
   show (BadCall ns)
-      = "possibly not terminating due to calls to " ++ showSep ", " (map show ns)
+      = "possibly not terminating due to calls to " ++ joinBy ", " (map show ns)
   show (BadPath [_] n)
       = "possibly not terminating due to call to " ++ show n
   show (BadPath init n)
-      = "possibly not terminating due to function " ++ show n ++ " being reachable via " ++ showSep " -> " (map show init)
+      = "possibly not terminating due to function " ++ show n ++ " being reachable via " ++ joinBy " -> " (map show init)
   show (RecPath loop)
-      = "possibly not terminating due to recursive path " ++ showSep " -> " (map (show . snd) loop)
+      = "possibly not terminating due to recursive path " ++ joinBy " -> " (map (show . snd) loop)
 
 export
 Pretty Void PartialReason where
@@ -340,7 +342,7 @@ Show Covering where
   show (NonCoveringCall [f])
      = "not covering due to call to function " ++ show f
   show (NonCoveringCall cs)
-     = "not covering due to calls to functions " ++ showSep ", " (map show cs)
+     = "not covering due to calls to functions " ++ joinBy ", " (map show cs)
 
 export
 Pretty Void Covering where
@@ -395,105 +397,177 @@ namespace Bounds
   public export
   data Bounds : Scoped where
        None : Bounds Scope.empty
-       Add : (x : Name) -> Name -> Bounds xs -> Bounds (x :: xs)
+       Add : (x : Name) -> Name -> Bounds xs -> Bounds (Scope.bind xs x)
        -- TODO add diagonal constructor
 
   export
-  sizeOf : Bounds xs -> SizeOf xs
+  sizeOf : Bounds xs -> Libraries.Data.SnocList.SizeOf.SizeOf xs
   sizeOf None        = zero
   sizeOf (Add _ _ b) = suc (sizeOf b)
 
 export
-addVars : SizeOf outer -> Bounds bound ->
-          NVar name (outer ++ vars) ->
-          NVar name (outer ++ (bound ++ vars))
-addVars p = insertNVarNames p . sizeOf
+addVars : Bounds bound ->
+          SizeOf inner ->
+          NVar name (Scope.addInner outer inner) ->
+          NVar name (Scope.addInner (outer ++ bound) inner)
+addVars = insertNVarNames . sizeOf
 
 export
-resolveRef : SizeOf outer ->
-             SizeOf done ->
-             Bounds bound -> FC -> Name ->
-             Maybe (Var (outer ++ (done <>> bound ++ vars)))
-resolveRef _ _ None _ _ = Nothing
-resolveRef {outer} {vars} {done} p q (Add {xs} new old bs) fc n
-    = if n == old
-         then Just (weakenNs p (mkVarChiply q))
-         else resolveRef p (q :< new) bs fc n
-
-mkLocals : SizeOf outer -> Bounds bound ->
-           Term (outer ++ vars) -> Term (outer ++ (bound ++ vars))
-mkLocals outer bs (Local fc r idx p)
-    = let MkNVar p' = addVars outer bs (MkNVar p) in Local fc r _ p'
-mkLocals outer bs (Ref fc Bound name)
+covering
+{vars : _} -> Show (Bounds vars) where
+  show None = "None"
+  show {vars = xs :< x} (Add x n b) = show x ++ " " ++ show n ++ " + " ++ show b
+
+export
+findBound : Name ->
+            Bounds bound ->
+            SizeOf done ->
+            Maybe (Var (Scope.ext bound done))
+findBound _ None _ = Nothing
+findBound nm (Add {xs} new old bs) p
+    = if nm == old
+        then Just (mkVarFishily p)
+        else findBound nm bs (suc p)
+
+export
+resolveRef : Name ->
+             Bounds bound ->
+             SizeOf inner ->
+             Maybe (Var (Scope.addInner (outer ++ bound) inner))
+resolveRef nm bs inn = weakenNs inn . embed <$> (findBound nm bs zero)
+
+mkLocalsAlt : SizeOf inner -> Bounds bound ->
+              CaseAlt (Scope.addInner outer inner) -> CaseAlt (Scope.addInner (outer ++ bound) inner)
+
+mkLocals : SizeOf inner -> Bounds bound ->
+           Term (Scope.addInner outer inner) -> Term (Scope.addInner (outer ++ bound) inner)
+mkLocals inn bs (Local fc r idx p)
+    = let MkNVar p' = addVars bs inn (MkNVar p) in Local fc r _ p'
+mkLocals inn bs (Ref fc Bound name)
     = fromMaybe (Ref fc Bound name) $ do
-        MkVar p <- resolveRef outer [<] bs fc name
+        MkVar p <- resolveRef name bs inn
         pure (Local fc Nothing _ p)
-mkLocals outer bs (Ref fc nt name)
+mkLocals inn bs (Ref fc nt name)
     = Ref fc nt name
-mkLocals outer bs (Meta fc name y xs)
-    = fromMaybe (Meta fc name y (map (mkLocals outer bs) xs)) $ do
-        MkVar p <- resolveRef outer [<] bs fc name
+mkLocals inn bs (Meta fc name y xs)
+    = fromMaybe (Meta fc name y (map @{Compose} (mkLocals inn bs) xs)) $ do
+        MkVar p <- resolveRef name bs inn
         pure (Local fc Nothing _ p)
-mkLocals outer bs (Bind fc x b scope)
-    = Bind fc x (map (mkLocals outer bs) b)
-           (mkLocals (suc outer) bs scope)
-mkLocals outer bs (App fc fn arg)
-    = App fc (mkLocals outer bs fn) (mkLocals outer bs arg)
-mkLocals outer bs (As fc s as tm)
-    = As fc s (mkLocals outer bs as) (mkLocals outer bs tm)
-mkLocals outer bs (TDelayed fc x y)
-    = TDelayed fc x (mkLocals outer bs y)
-mkLocals outer bs (TDelay fc x t y)
-    = TDelay fc x (mkLocals outer bs t) (mkLocals outer bs y)
-mkLocals outer bs (TForce fc r x)
-    = TForce fc r (mkLocals outer bs x)
-mkLocals outer bs (PrimVal fc c) = PrimVal fc c
-mkLocals outer bs (Erased fc Impossible) = Erased fc Impossible
-mkLocals outer bs (Erased fc Placeholder) = Erased fc Placeholder
-mkLocals outer bs (Erased fc (Dotted t)) = Erased fc (Dotted (mkLocals outer bs t))
-mkLocals outer bs (TType fc u) = TType fc u
-
-export
-refsToLocals : Bounds bound -> Term vars -> Term (bound ++ vars)
+mkLocals inn bs (Bind fc x b scope)
+    = Bind fc x (map (mkLocals inn bs) b)
+           (mkLocals (suc inn) bs scope)
+mkLocals inn bs (App fc fn c arg)
+    = App fc (mkLocals inn bs fn) c (mkLocals inn bs arg)
+mkLocals inn bs (As fc s as tm)
+    = As fc s (mkLocals inn bs as) (mkLocals inn bs tm)
+mkLocals inn bs (Case fc t r sc scTy alts)
+    = Case fc t r (mkLocals inn bs sc) (mkLocals inn bs scTy)
+           (map (mkLocalsAlt inn bs) alts)
+mkLocals inn bs (TDelayed fc x y)
+    = TDelayed fc x (mkLocals inn bs y)
+mkLocals inn bs (TDelay fc x t y)
+    = TDelay fc x (mkLocals inn bs t) (mkLocals inn bs y)
+mkLocals inn bs (TForce fc r x)
+    = TForce fc r (mkLocals inn bs x)
+mkLocals inn bs (PrimVal fc c) = PrimVal fc c
+mkLocals inn bs (PrimOp fc fn args)
+    = PrimOp fc fn (map (mkLocals inn bs) args)
+mkLocals inn bs (Erased fc Impossible) = Erased fc Impossible
+mkLocals inn bs (Erased fc Placeholder) = Erased fc Placeholder
+mkLocals inn bs (Erased fc (Dotted t)) = Erased fc (Dotted (mkLocals inn bs t))
+mkLocals inn bs (Unmatched fc u) = Unmatched fc u
+mkLocals inn bs (TType fc u) = TType fc u
+
+mkLocalsCaseScope : SizeOf inner -> Bounds bound ->
+                    CaseScope (Scope.addInner outer inner) -> CaseScope (Scope.addInner (outer ++ bound) inner)
+mkLocalsCaseScope inn bs (RHS fs tm)
+    = RHS (map (\ (MkVar n, t) =>
+                      (let MkNVar p' = addVars bs inn (MkNVar n) in
+                           MkVar p', mkLocals inn bs t)) fs)
+          (mkLocals inn bs tm)
+mkLocalsCaseScope inn bs (Arg r x scope)
+    = Arg r x (mkLocalsCaseScope (suc inn) bs scope)
+
+mkLocalsAlt inn bs (ConCase fc n t scope)
+    = ConCase fc n t (mkLocalsCaseScope inn bs scope)
+mkLocalsAlt inn bs (DelayCase fc ty arg rhs)
+    = DelayCase fc ty arg (mkLocals (suc (suc inn)) bs rhs)
+mkLocalsAlt inn bs (ConstCase fc c rhs) = ConstCase fc c (mkLocals inn bs rhs)
+mkLocalsAlt inn bs (DefaultCase fc rhs) = DefaultCase fc (mkLocals inn bs rhs)
+
+export
+refsToLocals : Bounds bound -> Term vars -> Term (Scope.addInner vars bound)
 refsToLocals None y = y
-refsToLocals bs y = mkLocals zero  bs y
+refsToLocals bs y = mkLocals zero bs y
+
+export
+refsToLocalsCaseScope : Bounds bound -> CaseScope vars -> CaseScope (Scope.addInner vars bound)
+refsToLocalsCaseScope bs sc = mkLocalsCaseScope zero bs sc
 
 -- Replace any reference to 'x' with a locally bound name 'new'
 export
-refToLocal : (x : Name) -> (new : Name) -> Term vars -> Term (new :: vars)
+refToLocal : (x : Name) -> (new : Name) -> Term vars -> Term (Scope.bind vars new)
 refToLocal x new tm = refsToLocals (Add new x None) tm
 
+substNameScope : SizeOf local -> Name -> Term vars ->
+                 CaseScope (Scope.addInner vars local) -> CaseScope (Scope.addInner vars local)
+
+substNameAlt : SizeOf local -> Name -> Term vars ->
+               CaseAlt (Scope.addInner vars local) -> CaseAlt (Scope.addInner vars local)
+
 -- Replace an explicit name with a term
 export
-substName : Name -> Term vars -> Term vars -> Term vars
-substName x new (Ref fc nt name)
+substName : SizeOf local -> Name -> Term vars -> Term (Scope.addInner vars local) -> Term (Scope.addInner vars local)
+substName s x new (Ref fc nt name)
     = case nameEq x name of
            Nothing => Ref fc nt name
-           Just Refl => new
-substName x new (Meta fc n i xs)
-    = Meta fc n i (map (substName x new) xs)
+           Just Refl => weakenNs s new
+substName s x new (Meta fc n i xs)
+    = Meta fc n i (map @{Compose} (substName s x new) xs)
 -- ASSUMPTION: When we substitute under binders, the name has always been
 -- resolved to a Local, so no need to check that x isn't shadowing
-substName x new (Bind fc y b scope)
-    = Bind fc y (map (substName x new) b) (substName x (weaken new) scope)
-substName x new (App fc fn arg)
-    = App fc (substName x new fn) (substName x new arg)
-substName x new (As fc s as pat)
-    = As fc s as (substName x new pat)
-substName x new (TDelayed fc y z)
-    = TDelayed fc y (substName x new z)
-substName x new (TDelay fc y t z)
-    = TDelay fc y (substName x new t) (substName x new z)
-substName x new (TForce fc r y)
-    = TForce fc r (substName x new y)
-substName x new tm = tm
+substName s x new (Bind fc y b scope)
+    = Bind fc y (map (substName s x new) b) (substName (suc s) x new scope)
+substName s x new (App fc fn c arg)
+    = App fc (substName s x new fn) c (substName s x new arg)
+substName s x new (As fc use as pat)
+    = As fc use (substName s x new as) (substName s x new pat)
+substName s x new (Case fc t c sc scty alts)
+    = Case fc t c (substName s x new sc) (substName s x new scty)
+           (map (substNameAlt s x new) alts)
+substName s x new (TDelayed fc y z)
+    = TDelayed fc y (substName s x new z)
+substName s x new (TDelay fc y t z)
+    = TDelay fc y (substName s x new t) (substName s x new z)
+substName s x new (TForce fc r y)
+    = TForce fc r (substName s x new y)
+substName s x new (PrimOp fc fn args)
+    = PrimOp fc fn (map (substName s x new) args)
+substName s x new tm@(Local{}) = tm
+substName s x new tm@(PrimVal{}) = tm
+substName s x new (Erased fc why) = Erased fc (substName s x new <$> why)
+substName s x new tm@(TType{}) = tm
+substName s x new tm@(Unmatched fc u) = tm
+
+substNameScope s x new (RHS fs tm)
+    = RHS (map (\ (n, t) => (n, substName s x new t)) fs)
+          (substName s x new tm)
+substNameScope s x new (Arg c n sc)
+    = Arg c n (substNameScope (suc s) x new sc)
+
+substNameAlt s x new (ConCase cfc n t sc)
+    = ConCase cfc n t (substNameScope s x new sc)
+substNameAlt s x new (DelayCase fc ty arg rhs)
+    = DelayCase fc ty arg (substName (suc (suc s)) x new rhs)
+substNameAlt s x new (ConstCase fc c tm) = ConstCase fc c (substName s x new tm)
+substNameAlt s x new (DefaultCase fc tm) = DefaultCase fc (substName s x new tm)
 
 export
 addMetas : (usingResolved : Bool) -> NameMap Bool -> Term vars -> NameMap Bool
 addMetas res ns (Local fc x idx y) = ns
 addMetas res ns (Ref fc x name) = ns
 addMetas res ns (Meta fc n i xs)
-  = addMetaArgs (insert (ifThenElse res (Resolved i) n) False ns) xs
+  = addMetaArgs (insert (ifThenElse res (Resolved i) n) False ns) $ map snd xs
   where
     addMetaArgs : NameMap Bool -> List (Term vars) -> NameMap Bool
     addMetaArgs ns [] = ns
@@ -502,15 +576,37 @@ addMetas res ns (Bind fc x (Let _ c val ty) scope)
     = addMetas res (addMetas res (addMetas res ns val) ty) scope
 addMetas res ns (Bind fc x b scope)
     = addMetas res (addMetas res ns (binderType b)) scope
-addMetas res ns (App fc fn arg)
+addMetas res ns (App fc fn _ arg)
     = addMetas res (addMetas res ns fn) arg
 addMetas res ns (As fc s as tm) = addMetas res ns tm
+addMetas res ns (Case fc t c sc scty alts)
+    = addMetaAlts (addMetas res ns sc) alts
+  where
+    addMetaScope : forall vars . NameMap Bool -> CaseScope vars -> NameMap Bool
+    addMetaScope ns (RHS _ tm) = addMetas res ns tm
+    addMetaScope ns (Arg c x sc) = addMetaScope ns sc
+
+    addMetaAlt : NameMap Bool -> CaseAlt vars -> NameMap Bool
+    addMetaAlt ns (ConCase _ n t sc) = addMetaScope ns sc
+    addMetaAlt ns (DelayCase _ ty arg tm) = addMetas res ns tm
+    addMetaAlt ns (ConstCase _ c tm) = addMetas res ns tm
+    addMetaAlt ns (DefaultCase _ tm) = addMetas res ns tm
+
+    addMetaAlts : NameMap Bool -> List (CaseAlt vars) -> NameMap Bool
+    addMetaAlts ns [] = ns
+    addMetaAlts ns (t :: ts) = addMetaAlts (addMetaAlt ns t) ts
 addMetas res ns (TDelayed fc x y) = addMetas res ns y
 addMetas res ns (TDelay fc x t y)
     = addMetas res (addMetas res ns t) y
 addMetas res ns (TForce fc r x) = addMetas res ns x
 addMetas res ns (PrimVal fc c) = ns
+addMetas res ns (PrimOp fc op args) = addMetaArgs ns args
+  where
+    addMetaArgs : NameMap Bool -> Vect n (Term vars) -> NameMap Bool
+    addMetaArgs ns [] = ns
+    addMetaArgs ns (t :: ts) = addMetaArgs (addMetas res ns t) ts
 addMetas res ns (Erased fc i) = foldr (flip $ addMetas res) ns i
+addMetas res ns (Unmatched fc u) = ns
 addMetas res ns (TType fc u) = ns
 
 -- Get the metavariable names in a term
@@ -524,7 +620,7 @@ addRefs : (underAssert : Bool) -> (aTotal : Name) ->
 addRefs ua at ns (Local fc x idx y) = ns
 addRefs ua at ns (Ref fc x name) = insert name ua ns
 addRefs ua at ns (Meta fc n i xs)
-    = addRefsArgs ns xs
+    = addRefsArgs ns $ map snd xs
   where
     addRefsArgs : NameMap Bool -> List (Term vars) -> NameMap Bool
     addRefsArgs ns [] = ns
@@ -533,19 +629,46 @@ addRefs ua at ns (Bind fc x (Let _ c val ty) scope)
     = addRefs ua at (addRefs ua at (addRefs ua at ns val) ty) scope
 addRefs ua at ns (Bind fc x b scope)
     = addRefs ua at (addRefs ua at ns (binderType b)) scope
-addRefs ua at ns (App _ (App _ (Ref fc _ name) x) y)
+addRefs ua at ns (App _ (App _ (Ref fc _ name) _ x) _ y)
     = if name == at
          then addRefs True at (insert name True ns) y
          else addRefs ua at (addRefs ua at (insert name ua ns) x) y
-addRefs ua at ns (App fc fn arg)
+addRefs ua at ns (App fc fn _ arg)
     = addRefs ua at (addRefs ua at ns fn) arg
 addRefs ua at ns (As fc s as tm) = addRefs ua at ns tm
+addRefs ua at ns (Case fc t c sc scty alts)
+    = let ns' = case t of
+                 -- if it came from a case block, record which one so that
+                 -- we can know if it's a 'case' under an assert_total
+                     CaseBlock n => insert n ua ns
+                     _ => ns in
+          addRefAlts (addRefs ua at ns' sc) alts
+  where
+    addRefScope : forall vars . NameMap Bool -> CaseScope vars -> NameMap Bool
+    addRefScope ns (RHS _ tm) = addRefs ua at ns tm
+    addRefScope ns (Arg c x sc) = addRefScope ns sc
+
+    addRefAlt : NameMap Bool -> CaseAlt vars -> NameMap Bool
+    addRefAlt ns (ConCase _ n t sc) = addRefScope ns sc
+    addRefAlt ns (DelayCase _ ty arg tm) = addRefs ua at ns tm
+    addRefAlt ns (ConstCase _ c tm) = addRefs ua at ns tm
+    addRefAlt ns (DefaultCase _ tm) = addRefs ua at ns tm
+
+    addRefAlts : NameMap Bool -> List (CaseAlt vars) -> NameMap Bool
+    addRefAlts ns [] = ns
+    addRefAlts ns (t :: ts) = addRefAlts (addRefAlt ns t) ts
 addRefs ua at ns (TDelayed fc x y) = addRefs ua at ns y
 addRefs ua at ns (TDelay fc x t y)
     = addRefs ua at (addRefs ua at ns t) y
 addRefs ua at ns (TForce fc r x) = addRefs ua at ns x
 addRefs ua at ns (PrimVal fc c) = ns
+addRefs ua at ns (PrimOp fc op args) = addRefArgs ns args
+  where
+    addRefArgs : NameMap Bool -> Vect n (Term vars) -> NameMap Bool
+    addRefArgs ns [] = ns
+    addRefArgs ns (t :: ts) = addRefArgs (addRefs ua at ns t) ts
 addRefs ua at ns (Erased fc i) = foldr (flip $ addRefs ua at) ns i
+addRefs ua at ns (Unmatched fc str) = ns
 addRefs ua at ns (TType fc u) = ns
 
 -- As above, but for references. Also flag whether a name is under an
diff --git a/src/Core/TT/Primitive.idr b/src/Core/TT/Primitive.idr
index fae4d8a52e0..30cd12ed323 100644
--- a/src/Core/TT/Primitive.idr
+++ b/src/Core/TT/Primitive.idr
@@ -435,6 +435,49 @@ Show (PrimFn arity) where
   show BelieveMe = "believe_me"
   show Crash = "crash"
 
+export
+sameFn : PrimFn x -> PrimFn y -> Bool
+sameFn (Add _) (Add _) = True
+sameFn (Sub _) (Sub _) = True
+sameFn (Mul _) (Mul _)= True
+sameFn (Div _) (Div _) = True
+sameFn (Mod _) (Mod _) = True
+sameFn (Neg _) (Neg _) = True
+sameFn (ShiftL _) (ShiftL _) = True
+sameFn (ShiftR _) (ShiftR _) = True
+sameFn (BAnd _) (BAnd _) = True
+sameFn (BOr _) (BOr _) = True
+sameFn (BXOr _) (BXOr _) = True
+sameFn (LT _) (LT _) = True
+sameFn (LTE _) (LTE _) = True
+sameFn (EQ _) (EQ _) = True
+sameFn (GTE _) (GTE _) = True
+sameFn (GT _) (GT _) = True
+sameFn StrLength StrLength = True
+sameFn StrHead StrHead = True
+sameFn StrTail StrTail = True
+sameFn StrIndex StrIndex = True
+sameFn StrCons StrCons = True
+sameFn StrAppend StrAppend = True
+sameFn StrReverse StrReverse = True
+sameFn StrSubstr StrSubstr = True
+sameFn DoubleExp DoubleExp = True
+sameFn DoubleLog DoubleLog = True
+sameFn DoublePow DoublePow = True
+sameFn DoubleSin DoubleSin = True
+sameFn DoubleCos DoubleCos = True
+sameFn DoubleTan DoubleTan = True
+sameFn DoubleASin DoubleASin = True
+sameFn DoubleACos DoubleACos = True
+sameFn DoubleATan DoubleATan = True
+sameFn DoubleSqrt DoubleSqrt = True
+sameFn DoubleFloor DoubleFloor = True
+sameFn DoubleCeiling DoubleCeiling = True
+sameFn (Cast{}) (Cast{}) = True
+sameFn BelieveMe BelieveMe = True
+sameFn Crash Crash = True
+sameFn _ _ = False
+
 export
 [Sugared] Show (PrimFn arity) where
   show (Add ty) = "+"
diff --git a/src/Core/TT/Subst.idr b/src/Core/TT/Subst.idr
index 3f15ac88983..dd0821b60c6 100644
--- a/src/Core/TT/Subst.idr
+++ b/src/Core/TT/Subst.idr
@@ -3,59 +3,62 @@ module Core.TT.Subst
 import Core.Name.Scoped
 import Core.TT.Var
 
-import Libraries.Data.List.SizeOf
+import Data.SnocList
+import Data.SnocList.Quantifiers
 
-%default total
+import Libraries.Data.SnocList.SizeOf
 
--- TODO replace by pointwise lifting: `Subst tm ds vars = All (\_. tm vars) ds`
-public export
-data Subst : Scoped -> Scope -> Scoped where
-  Nil : Subst tm Scope.empty vars
-  (::) : tm vars -> Subst tm ds vars -> Subst tm (d :: ds) vars
+%default total
 
 public export
-empty : Subst tm Scope.empty vars
-empty = []
+-- TODO revisit order of ds and vars?
+-- TODO vars is constantly applied
+Subst : Scoped -> Scope -> Scoped
+Subst tm ds vars = All (\_ => tm vars) ds
 
+export
+cons : Subst tm ds vars -> tm vars -> Subst tm (v `cons` ds) vars
+cons [<] p = Lin :< p
+cons (ns :< s) p = cons ns {tm} p :< s
 
-namespace Var
+namespace Subst
+  public export
+  empty : Subst tm Scope.empty vars
+  empty = [<]
 
-  export
-  index : Subst tm ds vars -> Var ds -> tm vars
-  index [] (MkVar p) impossible
-  index (t :: _) (MkVar First) = t
-  index (_ :: ts) (MkVar (Later p)) = index ts (MkVar p)
+  public export
+  bind : Subst tm ds vars -> tm vars -> Subst tm (Scope.bind ds v) vars
+  bind = (:<)
 
--- TODO revisit order of `dropped` and `Subst`
 export
 findDrop :
-  (Var vars -> tm vars) ->
+  (Var outer -> tm outer) ->
   SizeOf dropped ->
-  Var (dropped ++ vars) ->
-  Subst tm dropped vars ->
-  tm vars
+  Var (Scope.addInner outer dropped) ->
+  Subst tm dropped outer ->
+  tm outer
 findDrop k s var sub = case locateVar s var of
-  Left var => index sub var
-  Right var => k var
+  Left var => k var
+  Right var => lookup sub var
 
 export
 find : Weaken tm =>
        (forall vars. Var vars -> tm vars) ->
-       SizeOf outer -> SizeOf dropped ->
-       Var (outer ++ (dropped ++ vars)) ->
-       Subst tm dropped vars ->
-       tm (outer ++ vars)
-find k outer dropped var sub = case locateVar outer var of
-  Left var => k (embed var)
-  Right var => weakenNs outer (findDrop k dropped var sub)
-
--- TODO rename `outer`
+       SizeOf dropped ->
+       SizeOf inner ->
+       Var (Scope.addInner (Scope.addInner outer dropped) inner) ->
+       Subst tm dropped outer ->
+       tm (Scope.addInner outer inner)
+find k dropped inner var sub = case locateVar inner var of
+  Left var => weakenNs inner (findDrop {tm} k dropped var sub)
+  Right var => k (embed var)
+
 public export
 0 Substitutable : Scoped -> Scoped -> Type
 Substitutable val tm
-  = {0 outer, dropped, vars : Scope} ->
-    SizeOf outer ->
+  = {0 outer, dropped, inner : Scope} ->
     SizeOf dropped ->
-    Subst val dropped vars ->
-    tm (outer ++ (dropped ++ vars)) ->
-    tm (outer ++ vars)
+    SizeOf inner ->
+    Subst val dropped outer ->
+    tm (Scope.addInner (Scope.addInner outer dropped) inner) ->
+    tm (Scope.addInner outer inner)
diff --git a/src/Core/TT/Term.idr b/src/Core/TT/Term.idr
index e68d634fcb9..d5d70e818a3 100644
--- a/src/Core/TT/Term.idr
+++ b/src/Core/TT/Term.idr
@@ -3,15 +3,17 @@ module Core.TT.Term
 import Algebra
 
 import Core.FC
-
 import Core.Name.Scoped
+import Core.Name.CompatibleVars
 import Core.TT.Binder
 import Core.TT.Primitive
 import Core.TT.Var
 
-import Data.List
+import Data.String
+import Data.Vect
 
-import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.LengthMatch
 
 %default total
 
@@ -20,11 +22,15 @@ import Libraries.Data.List.SizeOf
 -- This information is cached in Refs (global variables) so as to avoid
 -- too many lookups
 
+public export
+Tag : Type
+Tag = Int
+
 public export
 data NameType : Type where
      Bound   : NameType
      Func    : NameType
-     DataCon : (tag : Int) -> (arity : Nat) -> NameType
+     DataCon : (tag : Tag) -> (arity : Nat) -> NameType
      TyCon   : (arity : Nat) -> NameType
 
 %name NameType nt
@@ -56,6 +62,11 @@ data LazyReason = LInf | LLazy | LUnknown
 public export
 data UseSide = UseLeft | UseRight
 
+export
+Show UseSide where
+  show UseLeft = "UseLeft"
+  show UseRight = "UseRight"
+
 %name UseSide side
 
 public export
@@ -89,21 +100,34 @@ Traversable WhyErased where
   traverse f Impossible = pure Impossible
   traverse f (Dotted x) = Dotted <$> f x
 
+-- A 'Case' arises either from a top level pattern match, or a 'case' block,
+-- and it's useful to know the difference so we know when to stop reducing due
+-- to a blocked top level function
+public export
+data CaseType = PatMatch | CaseBlock Name
+
+export
+Show CaseType where
+  show PatMatch = "(pat)"
+  show (CaseBlock n) = "(block " ++ show n ++ ")"
 
 ------------------------------------------------------------------------
 -- Core Terms
 
+public export
+data CaseAlt : SnocList Name -> Type
+
 public export
 data Term : Scoped where
      Local : FC -> (isLet : Maybe Bool) ->
              (idx : Nat) -> (0 p : IsVar name idx vars) -> Term vars
      Ref : FC -> NameType -> (name : Name) -> Term vars
      -- Metavariables and the scope they are applied to
-     Meta : FC -> Name -> Int -> List (Term vars) -> Term vars
+     Meta : FC -> Name -> Int -> List (RigCount, Term vars) -> Term vars
      Bind : FC -> (x : Name) ->
             (b : Binder (Term vars)) ->
             (scope : Term (Scope.bind vars x)) -> Term vars
-     App : FC -> (fn : Term vars) -> (arg : Term vars) -> Term vars
+     App : FC -> (fn : Term vars) -> RigCount -> (arg : Term vars) -> Term vars
      -- as patterns; since we check LHS patterns as terms before turning
      -- them into patterns, this helps us get it right. When normalising,
      -- we just reduce the inner term and ignore the 'as' part
@@ -112,12 +136,19 @@ data Term : Scoped where
      -- names (Ref) and resolved names (Local) without having to define a
      -- special purpose thing. (But it'd be nice to tidy that up, nevertheless)
      As : FC -> UseSide -> (as : Term vars) -> (pat : Term vars) -> Term vars
+     Case : FC -> CaseType ->
+            RigCount -> (sc : Term vars) -> (scTy : Term vars) ->
+            List (CaseAlt vars) ->
+            Term vars
      -- Typed laziness annotations
      TDelayed : FC -> LazyReason -> Term vars -> Term vars
      TDelay : FC -> LazyReason -> (ty : Term vars) -> (arg : Term vars) -> Term vars
      TForce : FC -> LazyReason -> Term vars -> Term vars
      PrimVal : FC -> (c : Constant) -> Term vars
+     PrimOp : {arity : _} ->
+              FC -> PrimFn arity -> Vect arity (Term vars) -> Term vars
      Erased : FC -> WhyErased (Term vars) -> Term vars
+     Unmatched : FC -> String -> Term vars -- error from a partialmatch
      TType : FC -> Name -> -- universe variable
              Term vars
 
@@ -125,35 +156,84 @@ data Term : Scoped where
 
 public export
 ClosedTerm : Type
-ClosedTerm = Term []
+ClosedTerm = Term Scope.empty
+
+public export
+data CaseScope : Scope -> Type where
+     RHS : List (Var vars, Term vars) -> -- Forced equalities
+           Term vars -> -- RHS
+           CaseScope vars
+     Arg : RigCount -> (x : Name) -> CaseScope (vars :< x) -> CaseScope vars
+
+||| Case alternatives. Unlike arbitrary patterns, they can be at most
+||| one constructor deep.
+public export
+data CaseAlt : Scoped where
+     ||| Constructor for a data type; bind the arguments and subterms.
+     ConCase : FC -> Name -> (tag : Int) -> CaseScope vars -> CaseAlt vars
+     ||| Lazy match for the Delay type use for codata types
+     DelayCase : FC -> (ty : Name) -> (arg : Name) ->
+                 Term (vars :< ty :< arg) -> CaseAlt vars
+     ||| Match against a literal
+     ConstCase : FC -> Constant -> Term vars -> CaseAlt vars
+     ||| Catch-all case
+     DefaultCase : FC -> Term vars -> CaseAlt vars
+
+export
+isDefault : CaseAlt vars -> Bool
+isDefault (DefaultCase _ _) = True
+isDefault _ = False
 
 ------------------------------------------------------------------------
 -- Weakening
+insertNamesAlt : GenWeakenable CaseAlt
 
-export covering
+export
 insertNames : GenWeakenable Term
-insertNames out ns (Local fc r idx prf)
-   = let MkNVar prf' = insertNVarNames out ns (MkNVar prf) in
+insertNames mid inn (Local fc r idx prf)
+   = let MkNVar prf' = insertNVarNames mid inn (MkNVar prf) in
      Local fc r _ prf'
-insertNames out ns (Ref fc nt name) = Ref fc nt name
-insertNames out ns (Meta fc name idx args)
-    = Meta fc name idx (map (insertNames out ns) args)
-insertNames out ns (Bind fc x b scope)
-    = Bind fc x (assert_total (map (insertNames out ns) b))
-           (insertNames (suc out) ns scope)
-insertNames out ns (App fc fn arg)
-    = App fc (insertNames out ns fn) (insertNames out ns arg)
-insertNames out ns (As fc s as tm)
-    = As fc s (insertNames out ns as) (insertNames out ns tm)
-insertNames out ns (TDelayed fc r ty) = TDelayed fc r (insertNames out ns ty)
-insertNames out ns (TDelay fc r ty tm)
-    = TDelay fc r (insertNames out ns ty) (insertNames out ns tm)
-insertNames out ns (TForce fc r tm) = TForce fc r (insertNames out ns tm)
-insertNames out ns (PrimVal fc c) = PrimVal fc c
-insertNames out ns (Erased fc Impossible) = Erased fc Impossible
-insertNames out ns (Erased fc Placeholder) = Erased fc Placeholder
-insertNames out ns (Erased fc (Dotted t)) = Erased fc (Dotted (insertNames out ns t))
-insertNames out ns (TType fc u) = TType fc u
+insertNames mid inn (Ref fc nt name) = Ref fc nt name
+insertNames mid inn (Meta fc name idx args)
+    = Meta fc name idx (assert_total $ map @{Compose} (insertNames mid inn) args)
+insertNames mid inn (Bind fc x b scope)
+    = Bind fc x (assert_total (map (insertNames mid inn) b))
+           (insertNames mid (suc inn) scope)
+insertNames mid inn (App fc fn c arg)
+    = App fc (insertNames mid inn fn) c (insertNames mid inn arg)
+insertNames mid inn (As fc s as tm)
+    = As fc s (insertNames mid inn as) (insertNames mid inn tm)
+insertNames out ns (Case fc t r sc scTy xs)
+    = Case fc t r (insertNames out ns sc) (insertNames out ns scTy)
+           (assert_total $ map (insertNamesAlt out ns) xs)
+insertNames mid inn (TDelayed fc r ty) = TDelayed fc r (insertNames mid inn ty)
+insertNames mid inn (TDelay fc r ty tm)
+    = TDelay fc r (insertNames mid inn ty) (insertNames mid inn tm)
+insertNames mid inn (TForce fc r tm) = TForce fc r (insertNames mid inn tm)
+insertNames mid inn (PrimVal fc c) = PrimVal fc c
+insertNames out ns (PrimOp fc x xs)
+    = PrimOp fc x (assert_total (map (insertNames out ns) xs))
+insertNames mid inn (Erased fc Impossible) = Erased fc Impossible
+insertNames mid inn (Erased fc Placeholder) = Erased fc Placeholder
+insertNames mid inn (Erased fc (Dotted t)) = Erased fc (Dotted (insertNames mid inn t))
+insertNames out ns (Unmatched fc x) = Unmatched fc x
+insertNames mid inn (TType fc u) = TType fc u
+
+insertNamesScope : GenWeakenable CaseScope
+insertNamesScope out ns (RHS fs tm)
+    = RHS (map (\ (n, tm) => (insertVarNames out ns n,
+                              insertNames out ns tm)) fs)
+          (insertNames out ns tm)
+insertNamesScope out ns (Arg r x sc) = Arg r x (insertNamesScope out (suc ns) sc)
+
+insertNamesAlt out sns (ConCase fc n t scope)
+    = ConCase fc n t (insertNamesScope out sns scope)
+insertNamesAlt out ns (DelayCase fc ty arg scope)
+    = DelayCase fc ty arg (insertNames out (suc (suc ns)) scope)
+insertNamesAlt out ns (ConstCase fc c scope)
+    = ConstCase fc c (insertNames out ns scope)
+insertNamesAlt out ns (DefaultCase fc scope)
+    = DefaultCase fc (insertNames out ns scope)
 
 export
 compatTerm : CompatibleVars xs ys -> Term xs -> Term ys
@@ -168,8 +248,8 @@ compatTerm compat tm = believe_me tm -- no names in term, so it's identity
 --     = Meta fc n i (map (compatTerm prf) args)
 -- compatTerm prf (Bind fc x b scope)
 --     = Bind fc x (map (compatTerm prf) b) (compatTerm (CompatExt prf) scope)
--- compatTerm prf (App fc fn arg)
---     = App fc (compatTerm prf fn) (compatTerm prf arg)
+-- compatTerm prf (App fc fn c arg)
+--     = App fc (compatTerm prf fn) c (compatTerm prf arg)
 -- compatTerm prf (As fc s as tm)
 --     = As fc s (compatTerm prf as) (compatTerm prf tm)
 -- compatTerm prf (TDelayed fc r ty) = TDelayed fc r (compatTerm prf ty)
@@ -180,86 +260,144 @@ compatTerm compat tm = believe_me tm -- no names in term, so it's identity
 -- compatTerm prf (Erased fc i) = Erased fc i
 -- compatTerm prf (TType fc) = TType fc
 
+export
+shrinkTerm : Shrinkable Term
+
+export
+shrinkPi : Shrinkable (PiInfo . Term)
+shrinkPi pinfo th
+  = assert_total
+  $ traverse (\ t => shrinkTerm t th) pinfo
+
+export
+shrinkBinder : Shrinkable (Binder . Term)
+shrinkBinder binder th
+  = assert_total
+  $ traverse (\ t => shrinkTerm t th) binder
+
+export
+shrinkTerms : Shrinkable (List . Term)
+shrinkTerms ts th
+  = assert_total
+  $ traverse (\ t => shrinkTerm t th) ts
+
+export
+shrinkTaggedTerms : Shrinkable (List . (RigCount,) . Term)
+shrinkTaggedTerms ts th
+  = assert_total
+  $ traverse @{Compose} (\ t => shrinkTerm t th) ts
+
+shrinkScope : Shrinkable CaseScope
+shrinkScope (RHS fs tm) prf
+    = Just (RHS !(traverse shrinkForcedEq fs) !(shrinkTerm tm prf))
+  where
+    shrinkForcedEq : (Var xs, Term xs) -> Maybe (Var ys, Term ys)
+    shrinkForcedEq (MkVar v, tm) = Just (!(shrinkIsVar v prf), !(shrinkTerm tm prf))
+shrinkScope (Arg r x sc) prf = Just (Arg r x !(shrinkScope sc (Keep prf)))
+
+shrinkAlt : Shrinkable CaseAlt
+shrinkAlt (ConCase fc x tag sc) prf
+  = ConCase fc x tag <$> shrinkScope sc prf
+shrinkAlt (DelayCase fc ty arg sc) prf
+  = DelayCase fc ty arg <$> shrinkTerm sc (Keep (Keep prf))
+shrinkAlt (ConstCase fc c sc) prf = ConstCase fc c <$> shrinkTerm sc prf
+shrinkAlt (DefaultCase fc sc) prf = DefaultCase fc <$> shrinkTerm sc prf
+
+shrinkTerm (Local fc r idx loc) prf
+  = do MkVar loc' <- shrinkIsVar loc prf
+       pure (Local fc r _ loc')
+shrinkTerm (Ref fc x name) prf = Just (Ref fc x name)
+shrinkTerm (Meta fc x y xs) prf
+    = do Just (Meta fc x y !(shrinkTaggedTerms xs prf))
+shrinkTerm (Bind fc x b scope) prf
+    = Just (Bind fc x !(shrinkBinder b prf) !(shrinkTerm scope (Keep prf)))
+shrinkTerm (App fc fn c arg) prf
+    = Just (App fc !(shrinkTerm fn prf) c !(shrinkTerm arg prf))
+shrinkTerm (As fc s as tm) prf
+    = Just (As fc s !(shrinkTerm as prf) !(shrinkTerm tm prf))
+shrinkTerm (Case fc t r sc scTy alts) prf
+   = Just (Case fc t r !(shrinkTerm sc prf) !(shrinkTerm scTy prf)
+                !(assert_total $ traverse (\alt => shrinkAlt alt prf) alts))
+shrinkTerm (TDelayed fc x y) prf
+    = Just (TDelayed fc x !(shrinkTerm y prf))
+shrinkTerm (TDelay fc x t y) prf
+    = Just (TDelay fc x !(shrinkTerm t prf) !(shrinkTerm y prf))
+shrinkTerm (TForce fc r x) prf
+    = Just (TForce fc r !(shrinkTerm x prf))
+shrinkTerm (PrimVal fc c) prf = Just (PrimVal fc c)
+shrinkTerm (PrimOp fc fn args) prf
+    = Just (PrimOp fc fn !(assert_total $ (traverse (\arg => shrinkTerm arg prf) args)))
+shrinkTerm (Erased fc Placeholder) prf = Just (Erased fc Placeholder)
+shrinkTerm (Erased fc Impossible) prf = Just (Erased fc Impossible)
+shrinkTerm (Erased fc (Dotted t)) prf = Erased fc . Dotted <$> shrinkTerm t prf
+shrinkTerm (Unmatched fc s) prf = Just (Unmatched fc s)
+shrinkTerm (TType fc u) prf = Just (TType fc u)
+
+
+thinTerm : Thinnable Term
+
+export
+thinPi : Thinnable (PiInfo . Term)
+thinPi pinfo th = assert_total $ map (\ t => thinTerm t th) pinfo
 
-mutual
-  export
-  shrinkPi : Shrinkable (PiInfo . Term)
-  shrinkPi pinfo th
-    = assert_total
-    $ traverse (\ t => shrinkTerm t th) pinfo
-
-  export
-  shrinkBinder : Shrinkable (Binder . Term)
-  shrinkBinder binder th
-    = assert_total
-    $ traverse (\ t => shrinkTerm t th) binder
-
-  export
-  shrinkTerms : Shrinkable (List . Term)
-  shrinkTerms ts th
-    = assert_total
-    $ traverse (\ t => shrinkTerm t th) ts
-
-  shrinkTerm : Shrinkable Term
-  shrinkTerm (Local fc r idx loc) prf
-    = do MkVar loc' <- shrinkIsVar loc prf
-         pure (Local fc r _ loc')
-  shrinkTerm (Ref fc x name) prf = Just (Ref fc x name)
-  shrinkTerm (Meta fc x y xs) prf
-     = do Just (Meta fc x y !(shrinkTerms xs prf))
-  shrinkTerm (Bind fc x b scope) prf
-     = Just (Bind fc x !(shrinkBinder b prf) !(shrinkTerm scope (Keep prf)))
-  shrinkTerm (App fc fn arg) prf
-     = Just (App fc !(shrinkTerm fn prf) !(shrinkTerm arg prf))
-  shrinkTerm (As fc s as tm) prf
-     = Just (As fc s !(shrinkTerm as prf) !(shrinkTerm tm prf))
-  shrinkTerm (TDelayed fc x y) prf
-     = Just (TDelayed fc x !(shrinkTerm y prf))
-  shrinkTerm (TDelay fc x t y) prf
-     = Just (TDelay fc x !(shrinkTerm t prf) !(shrinkTerm y prf))
-  shrinkTerm (TForce fc r x) prf
-     = Just (TForce fc r !(shrinkTerm x prf))
-  shrinkTerm (PrimVal fc c) prf = Just (PrimVal fc c)
-  shrinkTerm (Erased fc Placeholder) prf = Just (Erased fc Placeholder)
-  shrinkTerm (Erased fc Impossible) prf = Just (Erased fc Impossible)
-  shrinkTerm (Erased fc (Dotted t)) prf = Erased fc . Dotted <$> shrinkTerm t prf
-  shrinkTerm (TType fc u) prf = Just (TType fc u)
-
-
-mutual
-  export
-  thinPi : Thinnable (PiInfo . Term)
-  thinPi pinfo th = assert_total $ map (\ t => thinTerm t th) pinfo
-
-  export
-  thinBinder : Thinnable (Binder . Term)
-  thinBinder binder th = assert_total $ map (\ t => thinTerm t th) binder
-
-  export
-  thinTerms : Thinnable (List . Term)
-  thinTerms ts th = assert_total $ map (\ t => thinTerm t th) ts
-
-  thinTerm : Thinnable Term
-  thinTerm (Local fc x idx y) th
-      = let MkVar y' = thinIsVar y th in Local fc x _ y'
-  thinTerm (Ref fc x name) th = Ref fc x name
-  thinTerm (Meta fc x y xs) th
-      = Meta fc x y (thinTerms xs th)
-  thinTerm (Bind fc x b scope) th
-      = Bind fc x (thinBinder b th) (thinTerm scope (Keep th))
-  thinTerm (App fc fn arg) th
-      = App fc (thinTerm fn th) (thinTerm arg th)
-  thinTerm (As fc s nm pat) th
-      = As fc s (thinTerm nm th) (thinTerm pat th)
-  thinTerm (TDelayed fc x y) th = TDelayed fc x (thinTerm y th)
-  thinTerm (TDelay fc x t y) th
-      = TDelay fc x (thinTerm t th) (thinTerm y th)
-  thinTerm (TForce fc r x) th = TForce fc r (thinTerm x th)
-  thinTerm (PrimVal fc c) th = PrimVal fc c
-  thinTerm (Erased fc Impossible) th = Erased fc Impossible
-  thinTerm (Erased fc Placeholder) th = Erased fc Placeholder
-  thinTerm (Erased fc (Dotted t)) th = Erased fc (Dotted (thinTerm t th))
-  thinTerm (TType fc u) th = TType fc u
+export
+thinBinder : Thinnable (Binder . Term)
+thinBinder binder th = assert_total $ map (\ t => thinTerm t th) binder
+
+export
+thinTerms : Thinnable (List . Term)
+thinTerms ts th = assert_total $ map (\ t => thinTerm t th) ts
+
+export
+thinVect : forall a. Thinnable (Vect a . Term)
+thinVect ts th = assert_total $ map (\ t => thinTerm t th) ts
+
+export
+thinTaggedTerms : Thinnable (List . (RigCount,) . Term)
+thinTaggedTerms ts th = assert_total $ map @{Compose} (\ t => thinTerm t th) ts
+
+thinScope : Thinnable CaseScope
+thinScope (RHS fs tm) th
+  = RHS (thinForcedEq <$> fs) (thinTerm tm th)
+  where
+    thinForcedEq : (Var xs, Term xs) -> (Var ys, Term ys)
+    thinForcedEq (MkVar v, tm) = (thinIsVar v th, thinTerm tm th)
+thinScope (Arg r x sc) prf = Arg r x (thinScope sc (Keep prf))
+
+thinAlt : Thinnable CaseAlt
+thinAlt (ConCase fc n t sc) th = ConCase fc n t (thinScope sc th)
+thinAlt (DelayCase fc t a tm) th = DelayCase fc t a (thinTerm tm (Keep (Keep th)))
+thinAlt (ConstCase fc c tm) th = ConstCase fc c (thinTerm tm th)
+thinAlt (DefaultCase fc tm) th = DefaultCase fc (thinTerm tm th)
+
+thinAlts : Thinnable (List . CaseAlt)
+thinAlts alts th = assert_total $ map (\ t => thinAlt t th) alts
+
+thinTerm (Local fc x idx y) th
+    = let MkVar y' = thinIsVar y th in Local fc x _ y'
+thinTerm (Ref fc x name) th = Ref fc x name
+thinTerm (Meta fc x y xs) th
+    = Meta fc x y (thinTaggedTerms xs th)
+thinTerm (Bind fc x b scope) th
+    = Bind fc x (thinBinder b th) (thinTerm scope (Keep th))
+thinTerm (App fc fn c arg) th
+    = App fc (thinTerm fn th) c (thinTerm arg th)
+thinTerm (As fc s nm pat) th
+    = As fc s (thinTerm nm th) (thinTerm pat th)
+thinTerm (TDelayed fc x y) th = TDelayed fc x (thinTerm y th)
+thinTerm (TDelay fc x t y) th
+    = TDelay fc x (thinTerm t th) (thinTerm y th)
+thinTerm (Case fc t r sc scTy alts) th
+   = Case fc t r (thinTerm sc th) (thinTerm scTy th) (thinAlts alts th)
+thinTerm (TForce fc r x) th = TForce fc r (thinTerm x th)
+thinTerm (PrimVal fc c) th = PrimVal fc c
+thinTerm (PrimOp fc x args) th
+    = PrimOp fc x (thinVect args th)
+thinTerm (Erased fc Impossible) th = Erased fc Impossible
+thinTerm (Erased fc Placeholder) th = Erased fc Placeholder
+thinTerm (Erased fc (Dotted t)) th = Erased fc (Dotted (thinTerm t th))
+thinTerm (Unmatched fc s) th = Unmatched fc s
+thinTerm (TType fc u) th = TType fc u
 
 export
 GenWeaken Term where
@@ -283,21 +421,26 @@ IsScoped Term where
 -- Smart constructors
 
 export
-apply : FC -> Term vars -> List (Term vars) -> Term vars
+apply : FC -> Term vars -> List (RigCount, Term vars) -> Term vars
 apply loc fn [] = fn
-apply loc fn (a :: args) = apply loc (App loc fn a) args
+apply loc fn ((c, a) :: args) = apply loc (App loc fn c a) args
+
+export
+applySpine : FC -> Term vars -> SnocList (RigCount, Term vars) -> Term vars
+applySpine loc fn [<] = fn
+applySpine loc fn (args :< (c, a)) = App loc (applySpine loc fn args) c a
 
 -- Creates a chain of `App` nodes, each with its own file context
 export
-applySpineWithFC : Term vars -> SnocList (FC, Term vars) -> Term vars
+applySpineWithFC : Term vars -> SnocList (FC, RigCount, Term vars) -> Term vars
 applySpineWithFC fn [<] = fn
-applySpineWithFC fn (args :< (fc, arg)) = App fc (applySpineWithFC fn args) arg
+applySpineWithFC fn (args :< (fc, c, arg)) = App fc (applySpineWithFC fn args) c arg
 
 -- Creates a chain of `App` nodes, each with its own file context
 export
-applyStackWithFC : Term vars -> List (FC, Term vars) -> Term vars
+applyStackWithFC : Term vars -> List (FC, RigCount, Term vars) -> Term vars
 applyStackWithFC fn [] = fn
-applyStackWithFC fn ((fc, arg) :: args) = applyStackWithFC (App fc fn arg) args
+applyStackWithFC fn ((fc, c, arg) :: args) = applyStackWithFC (App fc fn c arg) args
 
 -- Build a simple function type
 export
@@ -314,18 +457,61 @@ getFnArgs tm = getFA [] tm
   where
     getFA : List (Term vars) -> Term vars ->
             (Term vars, List (Term vars))
-    getFA args (App _ f a) = getFA (a :: args) f
+    getFA args (App _ f _ a) = getFA (a :: args) f
     getFA args tm = (tm, args)
 
+export
+getFnArgsWithCounts : Term vars -> (Term vars, List (RigCount, Term vars))
+getFnArgsWithCounts tm = getFA [] tm
+  where
+    getFA : List (RigCount, Term vars) -> Term vars ->
+            (Term vars, List (RigCount, Term vars))
+    getFA args (App _ f c a) = getFA ((c, a) :: args) f
+    getFA args tm = (tm, args)
+
+export
+getFnArgsSpine : Term vars -> (Term vars, SnocList (RigCount, Term vars))
+getFnArgsSpine (App _ f c a)
+    = let (fn, sp) = getFnArgsSpine f in
+          (fn, sp :< (c, a))
+getFnArgsSpine tm = (tm, [<])
+
 export
 getFn : Term vars -> Term vars
-getFn (App _ f a) = getFn f
+getFn (App _ f _ a) = getFn f
 getFn tm = tm
 
 export
 getArgs : Term vars -> (List (Term vars))
 getArgs = snd . getFnArgs
 
+export
+varExtend : IsVar x idx xs -> IsVar x idx (ys ++ xs)
+-- What Could Possibly Go Wrong?
+-- This relies on the runtime representation of the term being the same
+-- after embedding! It is just an identity function at run time, though, and
+-- we don't need its definition at compile time, so let's do it...
+varExtend p = believe_me p
+
+export
+renameVars : CompatibleVars xs ys -> Term xs -> Term ys
+renameVars compat tm = believe_me tm -- no names in term, so it's identity
+
+export
+renameNTopVar : (ms : SnocList Name) ->
+             LengthMatch ns ms ->
+             Var (vars ++ ns) -> Var (vars ++ ms)
+renameNTopVar ms ok v = believe_me v
+
+export
+renameNTop : (ms : SnocList Name) ->
+             LengthMatch ns ms ->
+             Term (vars ++ ns) -> Term (vars ++ ms)
+renameNTop ms ok tm = believe_me tm
+
+export
+renameTop : (m : Name) -> Term (vars :< n) -> Term (vars :< m)
+renameTop m tm = renameNTop {ns = [<n]} [<m] (SnocMatch LinMatch) tm
 
 ------------------------------------------------------------------------
 -- Namespace manipulations
@@ -338,6 +524,26 @@ interface StripNamespace a where
   trimNS : Namespace -> a -> a
   restoreNS : Namespace -> a -> a
 
+export
+StripNamespace a => StripNamespace (Maybe a) where
+  trimNS ns Nothing = Nothing
+  trimNS ns (Just x) = Just (trimNS ns x)
+  restoreNS ns Nothing = Nothing
+  restoreNS ns (Just x) = Just (restoreNS ns x)
+
+export
+StripNamespace a => StripNamespace (List a) where
+  trimNS c ns = trimNS_aux c [] ns
+    where trimNS_aux : Namespace -> List a -> List a -> List a
+          trimNS_aux c res [] = reverse res
+          trimNS_aux c res (n :: ns) = trimNS_aux c ((trimNS c n):: res) ns
+
+
+  restoreNS c ns = restoreNS_aux c [] ns
+    where restoreNS_aux : Namespace -> List a -> List a -> List a
+          restoreNS_aux c res [] = reverse res
+          restoreNS_aux c res (n :: ns) = restoreNS_aux c ((restoreNS c n) :: res) ns
+
 export
 StripNamespace Name where
   trimNS ns nm@(NS tns n)
@@ -357,11 +563,11 @@ StripNamespace (Term vars) where
   trimNS ns (Ref fc x nm)
       = Ref fc x (trimNS ns nm)
   trimNS ns (Meta fc x y xs)
-      = Meta fc x y (map (trimNS ns) xs)
+      = Meta fc x y (map @{Compose} (trimNS ns) xs)
   trimNS ns (Bind fc x b scope)
       = Bind fc x (map (trimNS ns) b) (trimNS ns scope)
-  trimNS ns (App fc fn arg)
-      = App fc (trimNS ns fn) (trimNS ns arg)
+  trimNS ns (App fc fn c arg)
+      = App fc (trimNS ns fn) c (trimNS ns arg)
   trimNS ns (As fc s p tm)
       = As fc s (trimNS ns p) (trimNS ns tm)
   trimNS ns (TDelayed fc x y)
@@ -375,11 +581,11 @@ StripNamespace (Term vars) where
   restoreNS ns (Ref fc x nm)
       = Ref fc x (restoreNS ns nm)
   restoreNS ns (Meta fc x y xs)
-      = Meta fc x y (map (restoreNS ns) xs)
+      = Meta fc x y (map @{Compose} (restoreNS ns) xs)
   restoreNS ns (Bind fc x b scope)
       = Bind fc x (map (restoreNS ns) b) (restoreNS ns scope)
-  restoreNS ns (App fc fn arg)
-      = App fc (restoreNS ns fn) (restoreNS ns arg)
+  restoreNS ns (App fc fn c arg)
+      = App fc (restoreNS ns fn) c (restoreNS ns arg)
   restoreNS ns (As fc s p tm)
       = As fc s (restoreNS ns p) (restoreNS ns tm)
   restoreNS ns (TDelayed fc x y)
@@ -402,13 +608,16 @@ getLoc (Local fc _ _ _) = fc
 getLoc (Ref fc _ _) = fc
 getLoc (Meta fc _ _ _) = fc
 getLoc (Bind fc _ _ _) = fc
-getLoc (App fc _ _) = fc
+getLoc (App fc _ _ _) = fc
 getLoc (As fc _ _ _) = fc
+getLoc (Case fc _ _ _ _ _) = fc
 getLoc (TDelayed fc _ _) = fc
 getLoc (TDelay fc _ _ _) = fc
 getLoc (TForce fc _ _) = fc
 getLoc (PrimVal fc _) = fc
+getLoc (PrimOp fc _ _) = fc
 getLoc (Erased fc i) = fc
+getLoc (Unmatched fc _) = fc
 getLoc (TType fc _) = fc
 
 export
@@ -451,11 +660,26 @@ eqTerm : Term vs -> Term vs' -> Bool
 eqTerm (Local _ _ idx _) (Local _ _ idx' _) = idx == idx'
 eqTerm (Ref _ _ n) (Ref _ _ n') = n == n'
 eqTerm (Meta _ _ i args) (Meta _ _ i' args')
-    = i == i' && assert_total (all (uncurry eqTerm) (zip args args'))
+    = i == i' && assert_total (all (uncurry eqTerm) (zip (map snd args) (map snd args')))
 eqTerm (Bind _ _ b sc) (Bind _ _ b' sc')
     = assert_total (eqBinderBy eqTerm b b') && eqTerm sc sc'
-eqTerm (App _ f a) (App _ f' a') = eqTerm f f' && eqTerm a a'
+eqTerm (App _ f _ a) (App _ f' _ a') = eqTerm f f' && eqTerm a a'
 eqTerm (As _ _ a p) (As _ _ a' p') = eqTerm a a' && eqTerm p p'
+eqTerm (Case _ _ _ sc ty alts) (Case _ _ _ sc' ty' alts')
+    = eqTerm sc sc' && eqTerm ty ty' &&
+          assert_total (all (uncurry eqAlt) (zip alts alts'))
+  where
+    eqScope : forall vs, vs' . CaseScope vs -> CaseScope vs' -> Bool
+    eqScope (RHS _ tm) (RHS _ tm') = eqTerm tm tm'
+    eqScope (Arg _ _ sc) (Arg _ _ sc') = eqScope sc sc'
+    eqScope _ _ = False
+
+    eqAlt : CaseAlt vs -> CaseAlt vs' -> Bool
+    eqAlt (ConCase _ n tag sc) (ConCase _ n' tag' sc') = tag == tag' && eqScope sc sc'
+    eqAlt (DelayCase _ ty arg tm) (DelayCase _ ty' arg' tm') = eqTerm tm tm'
+    eqAlt (ConstCase _ c tm) (ConstCase _ c' tm') = c == c' && eqTerm tm tm'
+    eqAlt (DefaultCase _ tm) (DefaultCase _ tm') = eqTerm tm tm'
+    eqAlt _ _ = False
 eqTerm (TDelayed _ _ t) (TDelayed _ _ t') = eqTerm t t'
 eqTerm (TDelay _ _ t x) (TDelay _ _ t' x') = eqTerm t t' && eqTerm x x'
 eqTerm (TForce _ _ t) (TForce _ _ t') = eqTerm t t'
@@ -472,36 +696,52 @@ Eq (Term vars) where
 ------------------------------------------------------------------------
 -- Scope checking
 
-mutual
-
-  resolveNamesBinder : (vars : Scope) -> Binder (Term vars) -> Binder (Term vars)
-  resolveNamesBinder vars b = assert_total $ map (resolveNames vars) b
-
-  resolveNamesTerms : (vars : Scope) -> List (Term vars) -> List (Term vars)
-  resolveNamesTerms vars ts = assert_total $ map (resolveNames vars) ts
-
-  -- Replace any Ref Bound in a type with appropriate local
-  export
-  resolveNames : (vars : Scope) -> Term vars -> Term vars
-  resolveNames vars (Ref fc Bound name)
-      = case isNVar name vars of
-             Just (MkNVar prf) => Local fc (Just False) _ prf
-             _ => Ref fc Bound name
-  resolveNames vars (Meta fc n i xs)
-      = Meta fc n i (resolveNamesTerms vars xs)
-  resolveNames vars (Bind fc x b scope)
-      = Bind fc x (resolveNamesBinder vars b) (resolveNames (x :: vars) scope)
-  resolveNames vars (App fc fn arg)
-      = App fc (resolveNames vars fn) (resolveNames vars arg)
-  resolveNames vars (As fc s as pat)
-      = As fc s (resolveNames vars as) (resolveNames vars pat)
-  resolveNames vars (TDelayed fc x y)
-      = TDelayed fc x (resolveNames vars y)
-  resolveNames vars (TDelay fc x t y)
-      = TDelay fc x (resolveNames vars t) (resolveNames vars y)
-  resolveNames vars (TForce fc r x)
-      = TForce fc r (resolveNames vars x)
-  resolveNames vars tm = tm
+-- Replace any Ref Bound in a type with appropriate local
+export
+resolveNames : (vars : Scope) -> Term vars -> Term vars
+
+resolveNamesBinder : (vars : Scope) -> Binder (Term vars) -> Binder (Term vars)
+resolveNamesBinder vars b = assert_total $ map (resolveNames vars) b
+
+resolveNamesTerms : (vars : Scope) -> List (RigCount, Term vars) -> List (RigCount, Term vars)
+resolveNamesTerms vars ts = assert_total $ map @{Compose} (resolveNames vars) ts
+
+resolveScope : (vars : SnocList Name) -> CaseScope vars -> CaseScope vars
+resolveScope vars (RHS fs tm)
+    = RHS (map (\ (n, t) => (n, resolveNames vars t)) fs)
+          (resolveNames vars tm)
+resolveScope vars (Arg c x sc) = Arg c x (resolveScope (vars :< x) sc)
+
+resolveAlt : (vars : SnocList Name) -> CaseAlt vars -> CaseAlt vars
+resolveAlt vars (ConCase fc x tag sc)
+    = ConCase fc x tag (resolveScope vars sc)
+resolveAlt vars (DelayCase fc ty arg tm)
+    = DelayCase fc ty arg (resolveNames (vars :< ty :< arg) tm)
+resolveAlt vars (ConstCase fc x tm) = ConstCase fc x (resolveNames vars tm)
+resolveAlt vars (DefaultCase fc tm) = DefaultCase fc (resolveNames vars tm)
+
+resolveNames vars (Ref fc Bound name)
+    = case isNVar name vars of
+            Just (MkNVar prf) => Local fc (Just False) _ prf
+            _ => Ref fc Bound name
+resolveNames vars (Meta fc n i xs)
+    = Meta fc n i (resolveNamesTerms vars xs)
+resolveNames vars (Bind fc x b scope)
+    = Bind fc x (resolveNamesBinder vars b) (resolveNames (Scope.bind vars x) scope)
+resolveNames vars (App fc fn c arg)
+    = App fc (resolveNames vars fn) c (resolveNames vars arg)
+resolveNames vars (As fc s as pat)
+    = As fc s (resolveNames vars as) (resolveNames vars pat)
+resolveNames vars (Case fc t c sc scty alts)
+    = Case fc t c (resolveNames vars sc) (resolveNames vars scty)
+                  (map (assert_total $ resolveAlt vars) alts)
+resolveNames vars (TDelayed fc x y)
+    = TDelayed fc x (resolveNames vars y)
+resolveNames vars (TDelay fc x t y)
+    = TDelay fc x (resolveNames vars t) (resolveNames vars y)
+resolveNames vars (TForce fc r x)
+    = TForce fc r (resolveNames vars x)
+resolveNames vars tm = tm
 
 ------------------------------------------------------------------------
 -- Showing
@@ -513,12 +753,29 @@ withPiInfo Implicit tm = "{" ++ tm ++ "}"
 withPiInfo AutoImplicit tm = "{auto " ++ tm ++ "}"
 withPiInfo (DefImplicit t) tm = "{default " ++ show t ++ " " ++ tm ++ "}"
 
+export
+{vars : _} -> Show (Term vars)
+
+export
+covering
+{vars : _} -> Show (CaseScope vars) where
+    show (RHS fs rhs) = " => " ++ show fs ++ " " ++ show rhs
+    show (Arg r nm sc) = " " ++ show nm ++ show sc
+
+export
+covering
+{vars : _} -> Show (CaseAlt vars) where
+   show (ConCase _ n t sc) = show n ++ show sc
+   show (DelayCase _ ty arg sc) = "Delay " ++ show arg ++ " => " ++ show sc
+   show (ConstCase _ c sc) = show c ++ " => " ++ show sc
+   show (DefaultCase _ sc) = "_ => " ++ show sc
+
 export
 covering
 {vars : _} -> Show (Term vars) where
-  show tm = let (fn, args) = getFnArgs tm in showApp fn args
+  show tm = let (fn, args) = getFnArgsWithCounts tm in showApp fn args
     where
-      showApp : {vars : _} -> Term vars -> List (Term vars) -> String
+      showApp : {vars : _} -> Term vars -> List (ZeroOneOmega, Term vars) -> String
       showApp (Local _ c idx p) []
          = show (nameAt p) ++ "[" ++ show idx ++ "]"
 
@@ -543,16 +800,19 @@ covering
       showApp (Bind _ x (PVTy _ c ty) sc) []
           = "pty " ++ showCount c ++ show x ++ " : " ++ show ty ++
             " => " ++ show sc
-      showApp (App {}) [] = "[can't happen]"
+      showApp (App _ {}) [] = "[can't happen]"
       showApp (As _ _ n tm) [] = show n ++ "@" ++ show tm
+      showApp (Case _ t r sc scty alts) []
+            = "case " ++ show r ++ " " ++ show sc ++ " : " ++ show scty ++ " of " ++ show alts
       showApp (TDelayed _ _ tm) [] = "%Delayed " ++ show tm
       showApp (TDelay _ _ _ tm) [] = "%Delay " ++ show tm
       showApp (TForce _ _ tm) [] = "%Force " ++ show tm
       showApp (PrimVal _ c) [] = show c
+      showApp (PrimOp _ f ar) [] = "PrimOp " ++ show f ++ " " ++ show (length ar)
       showApp (Erased _ (Dotted t)) [] = ".(" ++ show t ++ ")"
       showApp (Erased {}) [] = "[__]"
       showApp (TType _ u) [] = "Type"
       showApp _ [] = "???"
       showApp f args = "(" ++ assert_total (show f) ++ " " ++
-                        assert_total (showSep " " (map show args))
+                        assert_total (joinBy " " (map show args))
                      ++ ")"
diff --git a/src/Core/TT/Term/Subst.idr b/src/Core/TT/Term/Subst.idr
index 95ee9e415b3..0456808958f 100644
--- a/src/Core/TT/Term/Subst.idr
+++ b/src/Core/TT/Term/Subst.idr
@@ -1,5 +1,6 @@
 module Core.TT.Term.Subst
 
+import Algebra
 import Core.Name.Scoped
 
 import Core.TT.Binder
@@ -7,7 +8,10 @@ import Core.TT.Subst
 import Core.TT.Term
 import Core.TT.Var
 
-import Libraries.Data.List.SizeOf
+import Data.Vect
+import Data.SnocList.Quantifiers
+
+import Libraries.Data.SnocList.SizeOf
 
 %default total
 
@@ -15,42 +19,99 @@ public export
 SubstEnv : Scope -> Scoped
 SubstEnv = Subst Term
 
+single : Term vars -> SubstEnv [<x] vars
+single n = [<n]
+
+findDropVar : Var (Scope.addInner outer dropped) ->
+              SubstEnv dropped outer ->
+              Maybe (Var outer)
+findDropVar (MkVar var) [<] = Just (MkVar var)
+findDropVar (MkVar First) (env :< tm) = Nothing
+findDropVar (MkVar (Later p)) (env :< tm)
+    = findDropVar (MkVar p) env
+
+findVar : SizeOf inner ->
+          Var (Scope.addInner (Scope.addInner outer dropped) inner) ->
+          SubstEnv dropped outer ->
+          Maybe (Var (Scope.addInner outer inner))
+findVar inn var env = case sizedView inn of
+  Z       => findDropVar var env
+  S inn => case var of
+    MkVar First     => Just (MkVar First)
+    MkVar (Later p) => map weaken (findVar inn (MkVar p) env)
+
 substTerm : Substitutable Term Term
 substTerms : Substitutable Term (List . Term)
+substVect : forall a. Substitutable Term (Vect a . Term)
 substBinder : Substitutable Term (Binder . Term)
+substTaggedTerms : forall a. Substitutable Term (List . (a,) . Term)
+substAlt : Substitutable Term CaseAlt
+substCaseScope : Substitutable Term CaseScope
+
+substTerm drp inn env (Local fc r _ prf)
+    = find (\ (MkVar p) => Local fc r _ p) drp inn (MkVar prf) env
+substTerm drp inn env (Ref fc x name) = Ref fc x name
+substTerm drp inn env (Meta fc n i xs)
+    = Meta fc n i (substTaggedTerms drp inn env xs)
+substTerm drp inn env (Bind fc x b scope)
+    = Bind fc x (substBinder drp inn env b)
+                (substTerm drp (suc inn) env scope)
+substTerm drp inn env (App fc fn c arg)
+    = App fc (substTerm drp inn env fn) c (substTerm drp inn env arg)
+substTerm drp inn env (As fc s as pat)
+    = As fc s (substTerm drp inn env as) (substTerm drp inn env pat)
+substTerm drp inn env (Case fc t c sc scty alts)
+    = Case fc t c (substTerm drp inn env sc)
+                  (substTerm drp inn env scty)
+                  (map (assert_total $ substAlt drp inn env) alts)
+substTerm drp inn env (TDelayed fc x y) = TDelayed fc x (substTerm drp inn env y)
+substTerm drp inn env (TDelay fc x t y)
+    = TDelay fc x (substTerm drp inn env t) (substTerm drp inn env y)
+substTerm drp inn env (TForce fc r x) = TForce fc r (substTerm drp inn env x)
+substTerm drp inn env (PrimVal fc c) = PrimVal fc c
+substTerm drp inn env (PrimOp fc x args)
+    = PrimOp fc x (substVect drp inn env args)
+substTerm drp inn env (Erased fc Impossible) = Erased fc Impossible
+substTerm drp inn env (Erased fc Placeholder) = Erased fc Placeholder
+substTerm drp inn env (Erased fc (Dotted t)) = Erased fc (Dotted (substTerm drp inn env t))
+substTerm drp inn env (Unmatched fc u) = Unmatched fc u
+substTerm drp inn env (TType fc u) = TType fc u
+
+substTerms drp inn env xs
+  = assert_total $ map (substTerm drp inn env) xs
+
+substVect drp inn env xs
+  = assert_total $ map (substTerm drp inn env) xs
+
+substBinder drp inn env b
+  = assert_total $ map (substTerm drp inn env) b
+
+substTaggedTerms drp inn env b
+  = assert_total $ map @{Compose} (substTerm drp inn env) b
+
+substCaseScope drp inn env (RHS fs tm)
+  = RHS (substForced fs) (substTerm drp inn env tm)
+  where
+    -- If we substitute in the vars, the equality is no longer useful
+    substForced : List (Var (Scope.addInner (Scope.addInner outer dropped) inner), Term (Scope.addInner (Scope.addInner outer dropped) inner)) ->
+                  List (Var (Scope.addInner outer inner), Term (Scope.addInner outer inner))
+    substForced [] = []
+    substForced ((v, tm) :: fs)
+        = case findVar inn v env of
+              Nothing => substForced fs
+              Just v' => ((v', substTerm drp inn env tm) :: substForced fs)
+
+substCaseScope drp inn env (Arg c x sc) = Arg c x (substCaseScope drp (suc inn) env sc)
 
-substTerm outer dropped env (Local fc r _ prf)
-    = find (\ (MkVar p) => Local fc r _ p) outer dropped (MkVar prf) env
-substTerm outer dropped env (Ref fc x name) = Ref fc x name
-substTerm outer dropped env (Meta fc n i xs)
-    = Meta fc n i (substTerms outer dropped env xs)
-substTerm outer dropped env (Bind fc x b scope)
-    = Bind fc x (substBinder outer dropped env b)
-                (substTerm (suc outer) dropped env scope)
-substTerm outer dropped env (App fc fn arg)
-    = App fc (substTerm outer dropped env fn) (substTerm outer dropped env arg)
-substTerm outer dropped env (As fc s as pat)
-    = As fc s (substTerm outer dropped env as) (substTerm outer dropped env pat)
-substTerm outer dropped env (TDelayed fc x y) = TDelayed fc x (substTerm outer dropped env y)
-substTerm outer dropped env (TDelay fc x t y)
-    = TDelay fc x (substTerm outer dropped env t) (substTerm outer dropped env y)
-substTerm outer dropped env (TForce fc r x) = TForce fc r (substTerm outer dropped env x)
-substTerm outer dropped env (PrimVal fc c) = PrimVal fc c
-substTerm outer dropped env (Erased fc Impossible) = Erased fc Impossible
-substTerm outer dropped env (Erased fc Placeholder) = Erased fc Placeholder
-substTerm outer dropped env (Erased fc (Dotted t)) = Erased fc (Dotted (substTerm outer dropped env t))
-substTerm outer dropped env (TType fc u) = TType fc u
-
-substTerms outer dropped env xs
-  = assert_total $ map (substTerm outer dropped env) xs
-
-substBinder outer dropped env b
-  = assert_total $ map (substTerm outer dropped env) b
+substAlt drp inn env (ConCase fc n t sc) = ConCase fc n t (substCaseScope drp inn env sc)
+substAlt drp inn env (DelayCase fc ty arg sc) = DelayCase fc ty arg (substTerm drp (suc (suc inn)) env sc)
+substAlt drp inn env (ConstCase fc c sc) = ConstCase fc c (substTerm drp inn env sc)
+substAlt drp inn env (DefaultCase fc sc) = DefaultCase fc (substTerm drp inn env sc)
 
 export
-substs : SizeOf dropped -> SubstEnv dropped vars -> Term (dropped ++ vars) -> Term vars
-substs dropped env tm = substTerm zero dropped env tm
+substs : SizeOf dropped -> SubstEnv dropped vars -> Term (Scope.addInner vars dropped) -> Term vars
+substs dropped env tm = substTerm dropped zero env tm
 
 export
 subst : Term vars -> Term (Scope.bind vars x) -> Term vars
-subst val tm = substs (suc zero) [val] tm
+subst val tm = substs (suc zero) (Subst.single val) tm
diff --git a/src/Core/TT/Traversals.idr b/src/Core/TT/Traversals.idr
index 7d853ab8742..68507bc0d88 100644
--- a/src/Core/TT/Traversals.idr
+++ b/src/Core/TT/Traversals.idr
@@ -4,17 +4,12 @@ import Core.TT
 
 import Data.DPair
 import Data.SortedSet
+import Data.Vect
 import Libraries.Data.NameMap
 
 %default covering
 
 -- TODO fix future type error
-export
-unBinds : Term vars -> Exists (\ outer => Term (outer <>> vars))
-unBinds (Bind _ x _ scope) = let (Evidence outer t) = unBinds scope in
-                             Evidence (outer :< x) t
-unBinds t = Evidence [<] t
-
 export
 onPRefs : Monoid m =>
           (Name      -> m) ->
@@ -23,23 +18,40 @@ onPRefs f = go neutral where
 
   go  : m -> Term vars' -> m
   gos : m -> List (Term vars') -> m
+  goScope : m -> CaseScope vars' -> m
+  goAlt : m -> CaseAlt vars' -> m
+  goAlts : m -> List (CaseAlt vars') -> m
 
   go acc (Local fc isLet idx p) = acc
   go acc (Ref fc x name) = acc <+> f name
-  go acc (Meta fc x y xs) = gos acc xs
+  go acc (Meta fc x y xs) = gos acc $ map snd xs
   go acc (Bind fc x b scope) = go (acc <+> concatMap (onPRefs f) b) scope
-  go acc (App fc fn arg) = go (go acc fn) arg
+  go acc (App fc fn _ arg) = go (go acc fn) arg
   go acc (As fc x as pat) = go (go acc as) pat
+  go acc (Case fc t c sc scty alts) = goAlts (go (go acc sc) scty) alts
   go acc (TDelayed fc x y) = go acc y
   go acc (TDelay fc x ty arg) = go (go acc ty) arg
   go acc (TForce fc x y) = go acc y
   go acc (PrimVal fc c) = acc
+  go acc (PrimOp fc fn args) = gos acc (toList args)
   go acc (Erased fc imp) = acc
   go acc (TType fc u) = acc
+  go acc (Unmatched fc _) = acc
+
+  goScope acc (RHS _ tm) = go acc tm
+  goScope acc (Arg c x sc) = goScope acc sc
+
+  goAlt acc (ConCase _ n t sc) = goScope acc sc
+  goAlt acc (DelayCase _ ty arg tm) = go acc tm
+  goAlt acc (ConstCase _ c tm) = go acc tm
+  goAlt acc (DefaultCase _ tm) = go acc tm
 
   gos acc [] = acc
   gos acc (x :: xs) = gos (go acc x) xs
 
+  goAlts acc [] = acc
+  goAlts acc (x :: xs) = goAlts (goAlt acc x) xs
+
 export
 allGlobals : Term vars -> NameMap ()
 allGlobals = onPRefs (\ n => singleton n ())
@@ -52,23 +64,40 @@ onConstants f = go neutral where
 
   go  : m -> Term vars' -> m
   gos : m -> List (Term vars') -> m
+  goScope : m -> CaseScope vars' -> m
+  goAlt : m -> CaseAlt vars' -> m
+  goAlts : m -> List (CaseAlt vars') -> m
 
   go acc (Local fc isLet idx p) = acc
   go acc (Ref fc x name) = acc
-  go acc (Meta fc x y xs) = gos acc xs
+  go acc (Meta fc x y xs) = gos acc $ map snd xs
   go acc (Bind fc x b scope) = go (acc <+> concatMap (onConstants f) b) scope
-  go acc (App fc fn arg) = go (go acc fn) arg
+  go acc (App fc fn _ arg) = go (go acc fn) arg
   go acc (As fc x as pat) = go (go acc as) pat
+  go acc (Case fc ty c sc scty alts) = goAlts (go (go acc sc) scty) alts
   go acc (TDelayed fc x y) = go acc y
   go acc (TDelay fc x ty arg) = go (go acc ty) arg
   go acc (TForce fc x y) = go acc y
   go acc (PrimVal fc c) = acc <+> f c
+  go acc (PrimOp fc fn args) = gos acc (toList args)
   go acc (Erased fc imp) = acc
   go acc (TType fc u) = acc
+  go acc (Unmatched fc _) = acc
 
   gos acc [] = acc
   gos acc (x :: xs) = gos (go acc x) xs
 
+  goScope acc (RHS _ tm) = go acc tm
+  goScope acc (Arg c x sc) = goScope acc sc
+
+  goAlt acc (ConCase _ n t sc) = goScope acc sc
+  goAlt acc (DelayCase _ ty arg tm) = go acc tm
+  goAlt acc (ConstCase _ c tm) = go acc tm
+  goAlt acc (DefaultCase _ tm) = go acc tm
+
+  goAlts acc [] = acc
+  goAlts acc (x :: xs) = goAlts (goAlt acc x) xs
+
 export
 allConstants : Term vars -> SortedSet Constant
 allConstants = onConstants @{MkMonoid @{MkSemigroup union} empty} singleton
@@ -81,21 +110,36 @@ mapTermM f t = act t where
 
   act : {vars : _} -> Term vars -> m (Term vars)
   go  : {vars : _} -> Term vars -> m (Term vars)
+  goScope  : {vars : _} -> CaseScope vars -> m (CaseScope vars)
+  goAlt  : {vars : _} -> CaseAlt vars -> m (CaseAlt vars)
 
   act t = f =<< go t
 
   go t@(Local fc isLet idx p) = pure t
   go t@(Ref fc x name) = pure t
-  go t@(Meta fc x y xs) = Meta fc x y <$> traverse act xs
+  go t@(Meta fc x y xs) = Meta fc x y <$> traverse @{Compose} act xs
   go t@(Bind fc x b scope) = Bind fc x <$> traverse act b <*> act scope
-  go t@(App fc fn arg) = App fc <$> act fn <*> act arg
+  go t@(App fc fn c arg) = App fc <$> act fn <*> pure c <*> act arg
   go t@(As fc x as pat) = As fc x <$> act as <*> act pat
+  go t@(Case fc ty c sc scty alts)
+    = Case fc ty c <$> act sc <*> act scty <*> traverse goAlt alts
   go t@(TDelayed fc x y) = TDelayed fc x <$> act y
   go t@(TDelay fc x ty arg) = TDelay fc x <$> act ty <*> act arg
   go t@(TForce fc x y) = pure t
   go t@(PrimVal fc c) = pure t
+  go t@(PrimOp fc fn args) = PrimOp fc fn <$> traverse act args
   go t@(Erased fc imp) = pure t
   go t@(TType fc u) = pure t
+  go t@(Unmatched fc _) = pure t
+
+  goScope (RHS fs tm)
+      = RHS <$> traverse (\ (n, t) => pure (n, !(act t))) fs <*> act tm
+  goScope (Arg c x sc) = Arg c x <$> goScope sc
+
+  goAlt (ConCase fc n t sc) = ConCase fc n t <$> goScope sc
+  goAlt (DelayCase fc t a tm) = DelayCase fc t a <$> act tm
+  goAlt (ConstCase fc c tm) = ConstCase fc c <$> act tm
+  goAlt (DefaultCase fc tm) = DefaultCase fc <$> act tm
 
 export
 mapTerm : ({vars : _} -> Term vars -> Term vars) ->
@@ -104,18 +148,31 @@ mapTerm f t = act t where
 
   act : {vars : _} -> Term vars -> Term vars
   go  : {vars : _} -> Term vars -> Term vars
+  goScope  : {vars : _} -> CaseScope vars -> CaseScope vars
+  goAlt  : {vars : _} -> CaseAlt vars -> CaseAlt vars
 
   act t = f (go t)
 
   go t@(Local fc isLet idx p) = t
   go t@(Ref fc x name) = t
-  go t@(Meta fc x y xs) = Meta fc x y (map act xs)
+  go t@(Meta fc x y xs) = Meta fc x y (map @{Compose} act xs)
   go t@(Bind fc x b scope) = Bind fc x (map act b) (act scope)
-  go t@(App fc fn arg) = App fc (act fn) (act arg)
+  go t@(App fc fn c arg) = App fc (act fn) c (act arg)
   go t@(As fc x as pat) = As fc x (act as) (act pat)
+  go t@(Case fc ty c sc scty alts) = Case fc ty c (act sc) (act scty) (map goAlt alts)
   go t@(TDelayed fc x y) = TDelayed fc x (act y)
   go t@(TDelay fc x ty arg) = TDelay fc x (act ty) (act arg)
   go t@(TForce fc x y) = t
   go t@(PrimVal fc c) = t
+  go t@(PrimOp fc fn args) = PrimOp fc fn (map act args)
   go t@(Erased fc imp) = t
   go t@(TType fc u) = t
+  go t@(Unmatched fc u) = t
+
+  goScope (RHS fs tm) = RHS (map (\ (n, t) => (n, act t)) fs) (act tm)
+  goScope (Arg c x sc) = Arg c x (goScope sc)
+
+  goAlt (ConCase fc n t sc) = ConCase fc n t (goScope sc)
+  goAlt (DelayCase fc t a tm) = DelayCase fc t a (act tm)
+  goAlt (ConstCase fc c tm) = ConstCase fc c (act tm)
+  goAlt (DefaultCase fc tm) = DefaultCase fc (act tm)
diff --git a/src/Core/TT/Var.idr b/src/Core/TT/Var.idr
index d5f370e8825..f2eed9c3819 100644
--- a/src/Core/TT/Var.idr
+++ b/src/Core/TT/Var.idr
@@ -1,20 +1,20 @@
 module Core.TT.Var
 
+import Core.Name.Scoped
+import Core.Name.CompatibleVars
+
+import Data.DPair
 import Data.Fin
 import Data.List
+import Data.List.HasLength
 import Data.So
 import Data.SnocList
 
-import Core.Name.Scoped
+import Data.SnocList.Quantifiers
 
 import Libraries.Data.SnocList.HasLength
 import Libraries.Data.SnocList.SizeOf
-
-import Data.List.HasLength
-import Data.DPair
-
 import Libraries.Data.List.SizeOf
-
 import Libraries.Data.Erased
 
 %default total
@@ -29,12 +29,24 @@ import Libraries.Data.Erased
 ||| is a position k
 ||| in the snoclist ns
 public export
-data IsVar : a -> Nat -> List a -> Type where
-     First : IsVar n Z (n :: ns)
-     Later : IsVar n i ns -> IsVar n (S i) (m :: ns)
+data IsVar : a -> Nat -> SnocList a -> Type where
+     First : IsVar n Z (ns :< n)
+     Later : IsVar n i ns -> IsVar n (S i) (ns :< m)
 
 %name IsVar idx
 
+namespace List
+  ||| IsVar n k ns is a proof that
+  ||| the name n
+  ||| is a position k
+  ||| in the list ns
+  public export
+  data IsVarL : a -> Nat -> List a -> Type where
+      First : IsVarL n Z (n :: ns)
+      Later : IsVarL n i ns -> IsVarL n (S i) (m :: ns)
+
+  %name IsVarL idx
+
 -- `vs` is available in the erased fragment, and the case builder
 -- pattern-matches on it. To simplify the case tree and help the
 -- coverage checker, we use an explicit dot pattern here.
@@ -52,57 +64,77 @@ finIdx (Later l) = FS (finIdx l)
 
 ||| Recover the value pointed at by an IsVar proof
 ||| O(n) in the size of the index
+-- TODO make return type a Singleton
 export
-nameAt : {vars : List a} -> {idx : Nat} -> (0 p : IsVar n idx vars) -> a
-nameAt {vars = n :: _} First = n
+nameAt : {vars : SnocList a} -> {idx : Nat} -> (0 p : IsVar n idx vars) -> a
+nameAt {vars = _ :< n} First = n
 nameAt (Later p) = nameAt p
 
 ||| Inversion principle for Later
 export
-dropLater : IsVar nm (S idx) (n :: ns) -> IsVar nm idx ns
+dropLater : IsVar nm (S idx) (ns :< n) -> IsVar nm idx ns
 dropLater (Later p) = p
 
 export
-0 mkIsVar : HasLength m inner -> IsVar nm m (inner ++ nm :: outer)
-mkIsVar Z = First
-mkIsVar (S x) = Later (mkIsVar x)
+0 appendIsVar : HasLength m inner -> IsVar nm m (outer :< nm ++ inner)
+appendIsVar Z = First
+appendIsVar (S x) = Later (appendIsVar x)
+
+export
+0 isVarFishily : HasLength m inner -> IsVar nm m (outer :< nm <>< inner)
+isVarFishily hl
+  = rewrite fishAsSnocAppend (outer :< nm) inner in
+    appendIsVar
+  $ rewrite sym $ plusZeroRightNeutral m in
+    hlFish Z hl
 
 export
-0 mkIsVarChiply : HasLength m inner -> IsVar nm m (inner <>> nm :: outer)
-mkIsVarChiply hl
-  = rewrite chipsAsListAppend inner (nm :: outer) in
-    rewrite sym $ plusZeroRightNeutral m in
-    mkIsVar (hlChips hl Z)
+0 mkIsVar : HasLength m inner -> IsVar nm m (outer :< nm ++ inner)
+mkIsVar Z = First
+mkIsVar (S x) = Later (mkIsVar x)
 
 ||| Compute the remaining scope once the target variable has been removed
 public export
 dropIsVar :
-  (ns : List a) ->
+  (ns : SnocList a) ->
   {idx : Nat} -> (0 p : IsVar name idx ns) ->
-  List a
-dropIsVar (_ :: xs) First = xs
-dropIsVar (n :: xs) (Later p) = n :: dropIsVar xs p
+  SnocList a
+dropIsVar (xs :< _) First = xs
+dropIsVar (xs :< n) (Later p) = dropIsVar xs p :< n
+
+||| Compute the remaining scope once the target variable has been removed
+public export
+dropIsVarL : (ns : List a) -> {idx : Nat} -> (0 _ : IsVarL nm idx ns) -> List a
+dropIsVarL (_ :: xs) First = xs
+dropIsVarL (n :: xs) (Later p) = n :: dropIsVarL xs p
 
 ||| Throw in extra variables on the outer side of the context
 ||| This is essentially the identity function
 ||| This is slow so we ensure it's only used in a runtime irrelevant manner
 export
-0 embedIsVar : IsVar x idx xs -> IsVar x idx (xs ++ outer)
+0 embedIsVar : IsVar x idx vars -> IsVar x idx (more ++ vars)
 embedIsVar First = First
 embedIsVar (Later p) = Later (embedIsVar p)
 
 ||| Throw in extra variables on the local end of the context.
 ||| This is slow so we ensure it's only used in a runtime irrelevant manner
 export
-0 weakenIsVar : (s : SizeOf ns) -> IsVar x idx xs -> IsVar x (size s + idx) (ns ++ xs)
+0 weakenIsVar : (s : SizeOf ns) -> IsVar x idx xs -> IsVar x (size s + idx) (xs ++ ns)
 weakenIsVar (MkSizeOf Z Z) p =  p
 weakenIsVar (MkSizeOf (S k) (S l)) p =  Later (weakenIsVar (MkSizeOf k l) p)
 
+||| Throw in extra variables on the local end of the context.
+||| This is slow so we ensure it's only used in a runtime irrelevant manner
+export
+0 weakenIsVarL : (s : SizeOf ns) -> IsVarL x idx xs -> IsVarL x (size s + idx) (ns ++ xs)
+weakenIsVarL (MkSizeOf Z Z) p =  p
+weakenIsVarL (MkSizeOf (S k) (S l)) p =  Later (weakenIsVarL (MkSizeOf k l) p)
+
 0 locateIsVarLT :
-  (s : SizeOf local) ->
+  (s : SizeOf inner) ->
   So (idx < size s) ->
-  IsVar x idx (local ++ outer) ->
-  IsVar x idx local
+  IsVar x idx (outer ++ inner) ->
+  IsVar x idx inner
 locateIsVarLT (MkSizeOf Z Z) so v = case v of
   First impossible
   Later v impossible
@@ -111,22 +143,22 @@ locateIsVarLT (MkSizeOf (S k) (S l)) so v = case v of
   Later v => Later (locateIsVarLT (MkSizeOf k l) so v)
 
 0 locateIsVarGE :
-  (s : SizeOf local) ->
+  (s : SizeOf inner) ->
   So (idx >= size s) ->
-  IsVar x idx (local ++ outer) ->
+  IsVar x idx (outer ++ inner) ->
   IsVar x (idx `minus` size s) outer
 locateIsVarGE (MkSizeOf Z Z) so v = rewrite minusZeroRight idx in v
 locateIsVarGE (MkSizeOf (S k) (S l)) so v = case v of
   Later v => locateIsVarGE (MkSizeOf k l) so v
 
 export
-locateIsVar : {idx : Nat} -> (s : SizeOf local) ->
-  (0 p : IsVar x idx (local ++ outer)) ->
-  Either (Erased (IsVar x idx local))
-         (Erased (IsVar x (idx `minus` size s) outer))
+locateIsVar : {idx : Nat} -> (s : SizeOf inner) ->
+  (0 p : IsVar x idx (outer ++ inner)) ->
+  Either (Erased (IsVar x (idx `minus` size s) outer))
+         (Erased (IsVar x idx inner))
 locateIsVar s p = case choose (idx < size s) of
-  Left so => Left (MkErased (locateIsVarLT s so p))
-  Right so => Right (MkErased (locateIsVarGE s so p))
+  Left so => Right (MkErased (locateIsVarLT s so p))
+  Right so => Left (MkErased (locateIsVarGE s so p))
 
 ------------------------------------------------------------------------
 -- Variable in scope
@@ -135,7 +167,7 @@ locateIsVar s p = case choose (idx < size s) of
 ||| and a proof that the name is at that position in the scope.
 ||| Everything but the De Bruijn index is erased.
 public export
-record Var {0 a : Type} (vars : List a) where
+record Var {0 a : Type} (vars : SnocList a) where
   constructor MkVar
   {varIdx : Nat}
   {0 varNm : a}
@@ -144,15 +176,15 @@ record Var {0 a : Type} (vars : List a) where
 namespace Var
 
   export
-  first : Var (n :: ns)
+  first : Var (ns :< n)
   first = MkVar First
 
   export
-  later : Var ns -> Var (n :: ns)
+  later : Var ns -> Var (ns :< n)
   later (MkVar p) = MkVar (Later p)
 
   export
-  isLater : Var (n :: vs) -> Maybe (Var vs)
+  isLater : Var (vs :< n) -> Maybe (Var vs)
   isLater (MkVar First) = Nothing
   isLater (MkVar (Later p)) = Just (MkVar p)
 
@@ -162,21 +194,27 @@ namespace Var
   last (MkSizeOf (S n) p) = Just (MkVar (snd $ Last p))
 
 export
-mkVar : SizeOf inner -> Var (inner ++ nm :: outer)
+mkVar : SizeOf inner -> Var (Scope.addInner (Scope.bind outer nm) inner)
 mkVar (MkSizeOf s p) = MkVar (mkIsVar p)
 
 export
-mkVarChiply : SizeOf inner -> Var (inner <>> nm :: outer)
-mkVarChiply (MkSizeOf s p) = MkVar (mkIsVarChiply p)
-
-||| Generate all variables
-export
-allVars : (vars : Scope) -> List (Var vars)
-allVars = go [<] where
+mkVarFishily : SizeOf inner -> Var (outer :< nm <>< inner)
+mkVarFishily (MkSizeOf s p) = MkVar (isVarFishily p)
 
-  go : SizeOf local -> (vs : Scope) -> List (Var (local <>> vs))
-  go s [] = []
-  go s (v :: vs) = mkVarChiply s :: go (s :< v) vs
+namespace SnocList
+  ||| Generate all variables
+  export
+  allVars : (vars : Scope) -> Scopeable (Var vars)
+  allVars = go zero where
+    go : SizeOf inner -> (vs : Scope) -> Scopeable (Var (vs <>< inner))
+    go s [<] = [<]
+    go s (vs :< v) = go (suc s) vs :< mkVarFishily s
+
+namespace List
+  ||| Generate all variables
+  export
+  allVars : (vars : List Name) -> List (Var ([<] <>< vars))
+  allVars vs = toList $ SnocList.allVars (cast vs)
 
 export
 Eq (Var xs) where
@@ -190,23 +228,30 @@ Show (Var ns) where
 -- Named variable in scope
 
 public export
-record NVar {0 a : Type} (nm : a) (vars : List a) where
+record NVar {0 a : Type} (nm : a) (vars : SnocList a) where
   constructor MkNVar
   {nvarIdx : Nat}
   0 nvarPrf : IsVar nm nvarIdx vars
 
+namespace List
+  public export
+  record NVarL {0 a : Type} (nm : a) (vars : List a) where
+    constructor MkNVarL
+    {nvarIdx : Nat}
+    0 nvarPrf : IsVarL nm nvarIdx vars
+
 namespace NVar
 
   export
-  first : NVar n (n :: ns)
+  first : NVar n (ns :< n)
   first = MkNVar First
 
   export
-  later : NVar nm ns -> NVar nm (n :: ns)
+  later : NVar nm ns -> NVar nm (ns :< n)
   later (MkNVar p) = MkNVar (Later p)
 
   export
-  isLater : NVar nm (n :: ns) -> Maybe (NVar nm ns)
+  isLater : NVar nm (ns :< n) -> Maybe (NVar nm ns)
   isLater (MkNVar First) = Nothing
   isLater (MkNVar (Later p)) = Just (MkNVar p)
 
@@ -219,135 +264,115 @@ recoverName : (v : Var vars) -> NVar (varNm v) vars
 recoverName (MkVar p) = MkNVar p
 
 export
-mkNVar : SizeOf inner -> NVar nm (inner ++ nm :: outer)
+mkNVar : SizeOf inner -> NVar nm (outer :< nm ++ inner)
 mkNVar (MkSizeOf s p) = MkNVar (mkIsVar p)
 
 export
-mkNVarChiply : SizeOf inner -> NVar nm (inner <>> nm :: outer)
-mkNVarChiply (MkSizeOf s p) = MkNVar (mkIsVarChiply p)
-
-export
-locateNVar : SizeOf local -> NVar nm (local ++ outer) ->
-             Either (NVar nm local) (NVar nm outer)
+locateNVar : SizeOf inner -> NVar nm (outer ++ inner) ->
+             Either (NVar nm outer) (NVar nm inner)
 locateNVar s (MkNVar p) = case locateIsVar s p of
   Left p => Left (MkNVar (runErased p))
   Right p => Right (MkNVar (runErased p))
 
 public export
-dropNVar : {ns : List a} -> NVar nm ns -> List a
+dropNVar : {ns : SnocList a} -> NVar nm ns -> SnocList a
 dropNVar (MkNVar p) = dropIsVar ns p
 
 ------------------------------------------------------------------------
 -- Scope checking
 
 export
-isDeBruijn : Nat -> (vars : List Name) -> Maybe (Var vars)
-isDeBruijn Z (_ :: _) = pure first
-isDeBruijn (S k) (_ :: vs) = later <$> isDeBruijn k vs
+isDeBruijn : Nat -> (vars : SnocList Name) -> Maybe (Var vars)
+isDeBruijn Z (_ :< _) = pure first
+isDeBruijn (S k) (vs :< _) = later <$> isDeBruijn k vs
 isDeBruijn _ _ = Nothing
 
 export
-isNVar : (n : Name) -> (ns : List Name) -> Maybe (NVar n ns)
-isNVar n [] = Nothing
-isNVar n (m :: ms)
+isNVar : (n : Name) -> (ns : SnocList Name) -> Maybe (NVar n ns)
+isNVar n [<] = Nothing
+isNVar n (ms :< m)
     = case nameEq n m of
-           Nothing   => map later (isNVar n ms)
+           Nothing   => map later (isNVar n ms) -- TODO make tail-recursive
            Just Refl => pure (MkNVar First)
 
 export
-isVar : (n : Name) -> (ns : List Name) -> Maybe (Var ns)
+isVar : (n : Name) -> (ns : SnocList Name) -> Maybe (Var ns)
 isVar n ns = forgetName <$> isNVar n ns
 
 export
-locateVar : SizeOf local -> Var (local ++ outer) ->
-            Either (Var local) (Var outer)
+locateVar : SizeOf inner -> Var (outer ++ inner) ->
+            Either (Var outer) (Var inner)
 locateVar s v  = bimap forgetName forgetName
   $ locateNVar s (recoverName v)
 
 ------------------------------------------------------------------------
 -- Weakening
 
+%inline export
+weakenNVar : Weakenable (NVar name)
+weakenNVar s (MkNVar p) = MkNVar (weakenIsVar s p)
+
 export
-weakenNVar : SizeOf ns -> NVar name outer -> NVar name (ns ++ outer)
-weakenNVar s (MkNVar {nvarIdx} p)
-  = MkNVar {nvarIdx = plus (size s) nvarIdx} (weakenIsVar s p)
+weakenNVarL : SizeOf ns -> NVarL nm inner -> NVarL nm (ns ++ inner)
+weakenNVarL s (MkNVarL p) = MkNVarL (weakenIsVarL s p)
 
 export
-embedNVar : NVar name ns -> NVar name (ns ++ outer)
+embedNVar : NVar name inner -> NVar name (outer ++ inner)
 embedNVar (MkNVar p) = MkNVar (embedIsVar p)
 
 export
-insertNVar : SizeOf local ->
-             NVar nm (local ++ outer) ->
-             NVar nm (local ++ n :: outer)
+insertNVar : SizeOf inner ->
+             NVar nm (outer ++ inner) ->
+             NVar nm (outer :< n ++ inner)
 insertNVar p v = case locateNVar p v of
-  Left v => embedNVar v
-  Right v => weakenNVar p (later v)
+  Left v => weakenNVar p (later v)
+  Right v => embedNVar v
 
 export
-insertNVarChiply : SizeOf local ->
-  NVar nm (local <>> outer) ->
-  NVar nm (local <>> n :: outer)
-insertNVarChiply p v
-  = rewrite chipsAsListAppend local (n :: outer) in
-    insertNVar (p <>> zero)
-  $ replace {p = NVar nm} (chipsAsListAppend local outer) v
+insertNVarFishy : SizeOf inner ->
+             NVar nm (outer <>< inner) ->
+             NVar nm (outer :< n <>< inner)
+insertNVarFishy p v
+  = rewrite fishAsSnocAppend (outer :< n) inner in
+    insertNVar (zero <>< p)
+  $ replace {p = NVar nm} (fishAsSnocAppend outer inner) v
 
 export
 insertNVarNames : GenWeakenable (NVar name)
-insertNVarNames p q v = case locateNVar p v of
-  Left v => embedNVar v
-  Right v =>
-    rewrite appendAssociative local ns outer in
-    weakenNVar (p + q) v
+insertNVarNames p q v = case locateNVar q v of
+  Left v => weakenNVar q (weakenNVar p v)
+  Right v => embedNVar v
 
-||| The (partial) inverse to insertNVar
 export
-removeNVar : SizeOf local ->
-         NVar nm (local ++ n :: outer) ->
-  Maybe (NVar nm (local ++      outer))
-removeNVar s var = case locateNVar s var of
-  Left v => pure (embedNVar v)
-  Right v => weakenNVar s <$> isLater v
-
-export
-insertVar : SizeOf local ->
-  Var (local ++ outer) ->
-  Var (local ++ n :: outer)
+insertVar : SizeOf inner ->
+  Var (outer ++ inner) ->
+  Var (outer :< n ++ inner)
 insertVar p v = forgetName $ insertNVar p (recoverName v)
 
-weakenVar : SizeOf ns -> Var outer -> Var (ns ++ outer)
+weakenVar : Weakenable Var
 weakenVar p v = forgetName $ weakenNVar p (recoverName v)
 
+export
 insertVarNames : GenWeakenable Var
 insertVarNames p q v = forgetName $ insertNVarNames p q (recoverName v)
 
-||| The (partial) inverse to insertVar
-export
-removeVar : SizeOf local ->
-         Var (local ++ n :: outer) ->
-  Maybe (Var (local ++      outer))
-removeVar s var = forgetName <$> removeNVar s (recoverName var)
-
 ------------------------------------------------------------------------
 -- Strengthening
 
 export
 strengthenIsVar : {n : Nat} -> (s : SizeOf inner) ->
-  (0 p : IsVar x n (inner ++ vars)) ->
-  Maybe (Erased (IsVar x (n `minus` size s) vars))
+  (0 p : IsVar x n (outer ++ inner)) ->
+  Maybe (Erased (IsVar x (n `minus` size s) outer))
 strengthenIsVar s p = case locateIsVar s p of
-  Left _ => Nothing
-  Right p => pure p
+  Left p => pure p
+  Right _ => Nothing
 
-strengthenVar : SizeOf inner ->
-  Var (inner ++ vars) -> Maybe (Var vars)
+strengthenVar : Strengthenable Var
 strengthenVar s (MkVar p)
   = do MkErased p <- strengthenIsVar s p
        pure (MkVar p)
 
-strengthenNVar : SizeOf inner ->
-  NVar x (inner ++ vars) -> Maybe (NVar x vars)
+strengthenNVar : Strengthenable (NVar name)
 strengthenNVar s (MkNVar p)
   = do MkErased p <- strengthenIsVar s p
        pure (MkNVar p)
@@ -355,25 +380,27 @@ strengthenNVar s (MkNVar p)
 ------------------------------------------------------------------------
 -- Reindexing
 
-0 lookup :
-  CompatibleVars xs ys ->
-  {idx : Nat} ->
-  (0 p : IsVar {a} name idx xs) ->
-  a
-lookup Pre p = name
-lookup (Ext {m} x) First = m
-lookup (Ext x) (Later p) = lookup x p
-
-0 compatIsVar :
-  (ns : CompatibleVars xs ys) ->
-  {idx : Nat} -> (0 p : IsVar name idx xs) ->
-  IsVar (lookup ns p) idx ys
-compatIsVar Pre p = p
-compatIsVar (Ext {n} x) First = First
-compatIsVar (Ext {n} x) (Later p) = Later (compatIsVar x p)
-
-compatVar : CompatibleVars xs ys -> Var xs -> Var ys
-compatVar prf (MkVar p) = MkVar (compatIsVar prf p)
+namespace CompatibleVars
+  0 lookup :
+    CompatibleVars xs ys ->
+    {idx : Nat} ->
+    (0 p : IsVar {a} name idx xs) ->
+    a
+  lookup Pre p = name
+  lookup (Ext {m} x) First = m
+  lookup (Ext x) (Later p) = lookup x p
+
+  0 compatIsVar :
+    (ns : CompatibleVars xs ys) ->
+    {idx : Nat} -> (0 p : IsVar name idx xs) ->
+    IsVar (lookup ns p) idx ys
+  compatIsVar Pre p = p
+  compatIsVar (Ext {n} x) First = First
+  compatIsVar (Ext {n} x) (Later p) = Later (compatIsVar x p)
+
+  export
+  compatVar : CompatibleVars xs ys -> Var xs -> Var ys
+  compatVar prf (MkVar p) = MkVar (compatIsVar prf p)
 
 ------------------------------------------------------------------------
 -- Thinning
@@ -404,44 +431,44 @@ export
 FreelyEmbeddableIsVar = MkFreelyEmbeddable embedIsVar
 
 export
-GenWeaken (Var {a = Name}) where
+GenWeaken Var where
   genWeakenNs = insertVarNames
 
 %hint
 export
-WeakenVar : Weaken (Var {a = Name})
+WeakenVar : Weaken Var
 WeakenVar = GenWeakenWeakens
 
 export
-Strengthen (Var {a = Name}) where
+Strengthen Var where
   strengthenNs = strengthenVar
 
 export
-FreelyEmbeddable (Var {a = Name}) where
+FreelyEmbeddable Var where
   embed (MkVar p) = MkVar (embedIsVar p)
 
 export
-IsScoped (Var {a = Name}) where
-  compatNs = compatVar
+IsScoped Var where
+  compatNs = CompatibleVars.compatVar
 
   thin (MkVar p) = thinIsVar p
   shrink (MkVar p) = shrinkIsVar p
 
 export
-GenWeaken (NVar {a = Name} nm) where
+GenWeaken (NVar nm) where
   genWeakenNs = insertNVarNames
 
 %hint
 export
-WeakenNVar : Weaken (NVar {a = Name} nm)
+WeakenNVar : Weaken (NVar nm)
 WeakenNVar = GenWeakenWeakens
 
 export
-Strengthen (NVar {a = Name} nm) where
+Strengthen (NVar nm) where
   strengthenNs = strengthenNVar
 
 export
-FreelyEmbeddable (NVar {a = Name} nm) where
+FreelyEmbeddable (NVar nm) where
   embed (MkNVar p) = MkNVar (embedIsVar p)
 
 ------------------------------------------------------------------------
@@ -449,9 +476,28 @@ FreelyEmbeddable (NVar {a = Name} nm) where
 
 ||| Moving the zeroth variable under a set number of variables
 export
-shiftUnderNs : SizeOf {a = Name} inner ->
+shiftUnderNs : SizeOf {a = Name} args ->
                {idx : _} ->
-               (0 p : IsVar n idx (x :: inner ++ outer)) ->
-               NVar n (inner ++ x :: outer)
+               (0 p : IsVar n idx (vars ++ args :< x)) ->
+               NVar n (vars :< x ++ args)
 shiftUnderNs s First = weakenNs s (MkNVar First)
 shiftUnderNs s (Later p) = insertNVar s (MkNVar p)
+
+export
+shiftUndersN : SizeOf {a = Name} args ->
+               {idx : _} ->
+               (0 p : IsVar n idx (vars <>< args :< x)) ->
+               NVar n (vars :< x <>< args)
+shiftUndersN s First = weakensN s (MkNVar First)
+shiftUndersN s (Later p) = insertNVarFishy s (MkNVar p)
+
+namespace IsVar
+  export
+  lookup : {idx : _}  -> All p vs -> (0 _ : IsVar x idx vs) -> p x
+  lookup (xs :< x) First = x
+  lookup (xs :< x) (Later p) = lookup xs p
+
+namespace Var
+  export %inline
+  lookup : All p vs -> (v : Var vs) -> p (varNm v)
+  lookup vs (MkVar p) = lookup vs p
diff --git a/src/Core/TT/Views.idr b/src/Core/TT/Views.idr
index 219873a1fdd..14e7fed61d7 100644
--- a/src/Core/TT/Views.idr
+++ b/src/Core/TT/Views.idr
@@ -6,10 +6,10 @@ import Core.TT
 ||| Go under n Pis (if n < 0 then go under as many as possible)
 export
 underPis : (n : Int) -> Env Term vars -> Term vars ->
-           (bnds : SnocList Name ** (Env Term (bnds <>> vars), Term (bnds <>> vars)))
-underPis 0 env t = ([<] ** (env, t))
+           (bnds : List Name ** (Env Term (Scope.ext vars bnds), Term (Scope.ext vars bnds)))
+underPis 0 env t = ([] ** (env, t))
 underPis n env (Bind fc x bd@(Pi {}) scope) =
-  let (bnds ** (env', scope')) := underPis (n - 1) (bd :: env) scope in
-  (bnds :< x ** (env', scope'))
+  let (bnds ** (env', scope')) := underPis (n - 1) (Env.bind env bd) scope in
+  (x :: bnds ** (env', scope'))
 underPis n env (Bind fc x bd@(PLet fc1 y val ty) scope) = underPis n env (subst val scope)
-underPis n env t = ([<] ** (env, t))
+underPis n env t = ([] ** (env, t))
diff --git a/src/Core/TTC.idr b/src/Core/TTC.idr
index aba6aa4dbea..97d3e8e24f1 100644
--- a/src/Core/TTC.idr
+++ b/src/Core/TTC.idr
@@ -1,7 +1,6 @@
 module Core.TTC
 
 import Core.Binary.Prims
-import Core.Case.CaseTree
 import Core.CompileExpr
 import Core.Context
 import Core.Env
@@ -296,9 +295,135 @@ TTC NameType where
 -- (Indeed, we're expecting the whole IsVar proof to be erased because
 -- we have the idx...)
 mkPrf : (idx : Nat) -> IsVar n idx ns
-mkPrf {n} {ns} Z = believe_me (First {n} {ns = n :: ns})
+mkPrf {n} {ns} Z = believe_me (First {n} {ns = ns :< n})
 mkPrf {n} {ns} (S k) = believe_me (Later {m=n} (mkPrf {n} {ns} k))
 
+getName : (idx : Nat) -> Scope -> Maybe Name
+getName Z (xs :< x) = Just x
+getName (S k) (xs :< x) = getName k xs
+getName _ [<] = Nothing
+
+export
+TTC CaseType where
+  toBuf PatMatch = tag 0
+  toBuf (CaseBlock n) = do tag 1; toBuf n
+
+  fromBuf
+      = case !getTag of
+              0 => pure PatMatch
+              1 => do n <- fromBuf; pure (CaseBlock n)
+              _ => corrupt "CaseType"
+
+export
+{n : _} -> TTC (PrimFn n) where
+  toBuf (Add ty) = do tag 0; toBuf ty
+  toBuf (Sub ty) = do tag 1; toBuf ty
+  toBuf (Mul ty) = do tag 2; toBuf ty
+  toBuf (Div ty) = do tag 3; toBuf ty
+  toBuf (Mod ty) = do tag 4; toBuf ty
+  toBuf (Neg ty) = do tag 5; toBuf ty
+  toBuf (ShiftL ty) = do tag 35; toBuf ty
+  toBuf (ShiftR ty) = do tag 36; toBuf ty
+  toBuf (BAnd ty) = do tag 37; toBuf ty
+  toBuf (BOr ty) = do tag 38; toBuf ty
+  toBuf (BXOr ty) = do tag 39; toBuf ty
+  toBuf (LT ty) = do tag 6; toBuf ty
+  toBuf (LTE ty) = do tag 7; toBuf ty
+  toBuf (EQ ty) = do tag 8; toBuf ty
+  toBuf (GTE ty) = do tag 9; toBuf ty
+  toBuf (GT ty) = do tag 10; toBuf ty
+  toBuf StrLength = tag 11
+  toBuf StrHead = tag 12
+  toBuf StrTail = tag 13
+  toBuf StrIndex = tag 14
+  toBuf StrCons = tag 15
+  toBuf StrAppend = tag 16
+  toBuf StrReverse = tag 17
+  toBuf StrSubstr = tag 18
+
+  toBuf DoubleExp = tag 19
+  toBuf DoubleLog = tag 20
+  toBuf DoublePow = tag 21
+  toBuf DoubleSin = tag 22
+  toBuf DoubleCos = tag 23
+  toBuf DoubleTan = tag 24
+  toBuf DoubleASin = tag 25
+  toBuf DoubleACos = tag 26
+  toBuf DoubleATan = tag 27
+  toBuf DoubleSqrt = tag 32
+  toBuf DoubleFloor = tag 33
+  toBuf DoubleCeiling = tag 34
+
+  toBuf (Cast x y) = do tag 99; toBuf x; toBuf y
+  toBuf BelieveMe = tag 100
+  toBuf Crash = tag 101
+
+  fromBuf {n}
+      = case n of
+             S Z => fromBuf1
+             S (S Z) => fromBuf2
+             S (S (S Z)) => fromBuf3
+             _ => corrupt "PrimFn"
+    where
+      fromBuf1 : Core (PrimFn 1)
+      fromBuf1
+          = case !getTag of
+                 5 => do ty <- fromBuf; pure (Neg ty)
+                 11 => pure StrLength
+                 12 => pure StrHead
+                 13 => pure StrTail
+                 17 => pure StrReverse
+                 19 => pure DoubleExp
+                 20 => pure DoubleLog
+                 22 => pure DoubleSin
+                 23 => pure DoubleCos
+                 24 => pure DoubleTan
+                 25 => pure DoubleASin
+                 26 => pure DoubleACos
+                 27 => pure DoubleATan
+                 32 => pure DoubleSqrt
+                 33 => pure DoubleFloor
+                 34 => pure DoubleCeiling
+
+                 99 => do x <- fromBuf; y <- fromBuf; pure (Cast x y)
+                 _ => corrupt "PrimFn 1"
+
+      fromBuf2 : Core (PrimFn 2)
+      fromBuf2
+          = case !getTag of
+                 0 => do ty <- fromBuf; pure (Add ty)
+                 1 => do ty <- fromBuf; pure (Sub ty)
+                 2 => do ty <- fromBuf; pure (Mul ty)
+                 3 => do ty <- fromBuf; pure (Div ty)
+                 4 => do ty <- fromBuf; pure (Mod ty)
+                 6 => do ty <- fromBuf; pure (LT ty)
+                 7 => do ty <- fromBuf; pure (LTE ty)
+                 8 => do ty <- fromBuf; pure (EQ ty)
+                 9 => do ty <- fromBuf; pure (GTE ty)
+                 10 => do ty <- fromBuf; pure (GT ty)
+                 14 => pure StrIndex
+                 15 => pure StrCons
+                 16 => pure StrAppend
+                 21 => pure DoublePow
+                 35 => do ty <- fromBuf; pure (ShiftL ty)
+                 36 => do ty <- fromBuf; pure (ShiftR ty)
+                 37 => do ty <- fromBuf; pure (BAnd ty)
+                 38 => do ty <- fromBuf; pure (BOr ty)
+                 39 => do ty <- fromBuf; pure (BXOr ty)
+                 101 => pure Crash
+                 _ => corrupt "PrimFn 2"
+
+      fromBuf3 : Core (PrimFn 3)
+      fromBuf3
+          = case !getTag of
+                 18 => pure StrSubstr
+                 100 => pure BelieveMe
+                 _ => corrupt "PrimFn 3"
+
+
+ttcTermUsed : Nat
+ttcTermUsed = 16 -- it should be a length of all encoding cases at `toBuf` / `fromBuf`
+
 mutual
   export
   {vars : _} -> TTC (Binder (Term vars)) where
@@ -330,16 +455,18 @@ mutual
                1 => pure UseRight
                _ => corrupt "UseSide"
 
-
   export
   {vars : _} -> TTC (Term vars) where
     toBuf (Local {name} fc c idx y)
-        = if idx < 243
-             then do tag (13 + cast idx)
+        = if idx < free
+             then do tag (cast (ttcTermUsed + idx))
                      toBuf c
              else do tag 0
                      toBuf c
                      toBuf idx
+        where
+         free : Nat
+         free = 256 `minus` ttcTermUsed -- we use 1 byte to encode special cases
     toBuf (Ref fc nt name)
         = do tag 1;
              toBuf nt; toBuf name
@@ -350,41 +477,53 @@ mutual
         = do tag 3;
              toBuf x;
              toBuf bnd; toBuf scope
-    toBuf (App fc fn arg)
-        = do let (fn, args) = getFnArgs (App fc fn arg)
+    toBuf (App fc fn c arg)
+        = do let (fn, args) = getFnArgsWithCounts (App fc fn c arg)
              case args of
-                  [arg] => do tag 4
-                              toBuf fn
-                              toBuf arg
-                  args => do tag 12
+                  [(c, arg)] => do tag 4
+                                   toBuf fn
+                                   toBuf c
+                                   toBuf arg
+                  args => do tag 5
                              toBuf fn
                              toBuf args
     toBuf (As fc s as tm)
-        = do tag 5;
+        = do tag 6;
              toBuf as; toBuf s; toBuf tm
+    toBuf (Case fc t c sc scty alts)
+        = do tag 7
+             toBuf t; toBuf c; toBuf sc; toBuf scty
+             toBuf alts
     toBuf (TDelayed fc r tm)
-        = do tag 6;
+        = do tag 8;
              toBuf r; toBuf tm
     toBuf (TDelay fc r ty tm)
-        = do tag 7;
+        = do tag 9;
              toBuf r; toBuf ty; toBuf tm
     toBuf (TForce fc r tm)
-        = do tag 8;
+        = do tag 10;
              toBuf r; toBuf tm
     toBuf (PrimVal fc c)
-        = do tag 9;
+        = do tag 11;
              toBuf c
+    toBuf (PrimOp {arity} fc fn args)
+        = do tag 12
+             toBuf arity
+             toBuf fn
+             toBuf args
     toBuf (Erased fc _)
-        = tag 10
+        = tag 13
+    toBuf (Unmatched fc u)
+        = do tag 14; toBuf u
     toBuf (TType fc u)
-        = do tag 11; toBuf u
+        = do tag 15; toBuf u
 
     fromBuf {vars}
         = case !getTag of
                0 => do c <- fromBuf
                        idx <- fromBuf
                        name <- maybe (corrupt "Term") pure
-                                     (getAt idx vars)
+                                     (getName idx vars)
                        pure (Local {name} emptyFC c idx (mkPrf idx))
                1 => do nt <- fromBuf; name <- fromBuf
                        pure (Ref emptyFC nt name)
@@ -395,135 +534,90 @@ mutual
                        bnd <- fromBuf; scope <- fromBuf
                        pure (Bind emptyFC x bnd scope)
                4 => do fn <- fromBuf
+                       c <- fromBuf
                        arg <- fromBuf
-                       pure (App emptyFC fn arg)
-               5 => do as <- fromBuf; s <- fromBuf; tm <- fromBuf
+                       pure (App emptyFC fn c arg)
+               5 => do fn <- fromBuf
+                       args <- fromBuf
+                       pure (apply emptyFC fn args)
+               6 => do as <- fromBuf; s <- fromBuf; tm <- fromBuf
                        pure (As emptyFC s as tm)
-               6 => do lr <- fromBuf; tm <- fromBuf
+               7 => do t <- fromBuf; c <- fromBuf; sc <- fromBuf; scty <- fromBuf
+                       alts <- fromBuf
+                       pure (Case emptyFC t c sc scty alts)
+               8 => do lr <- fromBuf; tm <- fromBuf
                        pure (TDelayed emptyFC lr tm)
-               7 => do lr <- fromBuf;
+               9 => do lr <- fromBuf;
                        ty <- fromBuf; tm <- fromBuf
                        pure (TDelay emptyFC lr ty tm)
-               8 => do lr <- fromBuf; tm <- fromBuf
-                       pure (TForce emptyFC lr tm)
-               9 => do c <- fromBuf
-                       pure (PrimVal emptyFC c)
-               10 => pure (Erased emptyFC Placeholder)
-               11 => do u <- fromBuf; pure (TType emptyFC u)
-               12 => do fn <- fromBuf
+               10 => do lr <- fromBuf; tm <- fromBuf
+                        pure (TForce emptyFC lr tm)
+               11 => do c <- fromBuf
+                        pure (PrimVal emptyFC c)
+               12 => do arity <- fromBuf
+                        op <- fromBuf
                         args <- fromBuf
-                        pure (apply emptyFC fn args)
+                        pure (PrimOp {arity} emptyFC op args)
+               13 => pure (Erased emptyFC Placeholder)
+               14 => do str <- fromBuf
+                        pure (Unmatched emptyFC str)
+               15 => do u <- fromBuf
+                        pure (TType emptyFC u)
                idxp => do c <- fromBuf
-                          let idx : Nat = fromInteger (cast (idxp - 13))
-                          let Just name = getAt idx vars
+                          let idx : Nat = fromInteger (cast (idxp - (cast ttcTermUsed)))
+                          let Just name = getName idx vars
                               | Nothing => corrupt "Term"
                           pure (Local {name} emptyFC c idx (mkPrf idx))
 
-export
-TTC Pat where
-  toBuf (PAs fc x y)
-      = do tag 0; toBuf fc; toBuf x; toBuf y
-  toBuf (PCon fc x t arity xs)
-      = do tag 1; toBuf fc; toBuf x; toBuf t; toBuf arity; toBuf xs
-  toBuf (PTyCon fc x arity xs)
-      = do tag 2; toBuf fc; toBuf x; toBuf arity; toBuf xs
-  toBuf (PConst fc c)
-      = do tag 3; toBuf fc; toBuf c
-  toBuf (PArrow fc x s t)
-      = do tag 4; toBuf fc; toBuf x; toBuf s; toBuf t
-  toBuf (PDelay fc x t y)
-      = do tag 5; toBuf fc; toBuf x; toBuf t; toBuf y
-  toBuf (PLoc fc x)
-      = do tag 6; toBuf fc; toBuf x
-  toBuf (PUnmatchable fc x)
-      = do tag 7; toBuf fc; toBuf x
-
-  fromBuf
-      = case !getTag of
-             0 => do fc <- fromBuf; x <- fromBuf;
-                     y <- fromBuf
-                     pure (PAs fc x y)
-             1 => do fc <- fromBuf; x <- fromBuf
-                     t <- fromBuf; arity <- fromBuf
-                     xs <- fromBuf
-                     pure (PCon fc x t arity xs)
-             2 => do fc <- fromBuf; x <- fromBuf
-                     arity <- fromBuf
-                     xs <- fromBuf
-                     pure (PTyCon fc x arity xs)
-             3 => do fc <- fromBuf; c <- fromBuf
-                     pure (PConst fc c)
-             4 => do fc <- fromBuf; x <- fromBuf
-                     s <- fromBuf; t <- fromBuf
-                     pure (PArrow fc x s t)
-             5 => do fc <- fromBuf; x <- fromBuf;
-                     t <- fromBuf; y <- fromBuf
-                     pure (PDelay fc x t y)
-             6 => do fc <- fromBuf; x <- fromBuf
-                     pure (PLoc fc x)
-             7 => do fc <- fromBuf; x <- fromBuf
-                     pure (PUnmatchable fc x)
-             _ => corrupt "Pat"
-
-mutual
   export
-  {vars : _} -> TTC (CaseTree vars) where
-    toBuf (Case {name} idx x scTy xs)
-        = do tag 0; toBuf name; toBuf idx; toBuf xs
-    toBuf (STerm _ x)
-        = do tag 1; toBuf x
-    toBuf (Unmatched msg)
-        = do tag 2; toBuf msg
-    toBuf Impossible = tag 3
+  {vars : _} -> TTC (CaseScope vars) where
+    toBuf (RHS _ tm) = do tag 0; toBuf tm
+    toBuf (Arg c x sc) = do tag 1; toBuf c; toBuf x; toBuf sc
 
     fromBuf
         = case !getTag of
-               0 => do name <- fromBuf; idx <- fromBuf
-                       xs <- fromBuf
-                       pure (Case {name} idx (mkPrf idx) (Erased emptyFC Placeholder) xs)
-               1 => do x <- fromBuf
-                       pure (STerm 0 x)
-               2 => do msg <- fromBuf
-                       pure (Unmatched msg)
-               3 => pure Impossible
-               _ => corrupt "CaseTree"
+               0 => do tm <- fromBuf
+                       pure (RHS [] tm)
+               1 => do c <- fromBuf; x <- fromBuf; sc <- fromBuf
+                       pure (Arg c x sc)
+               _ => corrupt "CaseScope"
 
   export
   {vars : _} -> TTC (CaseAlt vars) where
-    toBuf (ConCase x t args y)
-        = do tag 0; toBuf x; toBuf t; toBuf args; toBuf y
-    toBuf (DelayCase ty arg y)
+    toBuf (ConCase _ x t y)
+        = do tag 0; toBuf x; toBuf t; toBuf y
+    toBuf (DelayCase _ ty arg y)
         = do tag 1; toBuf ty; toBuf arg; toBuf y
-    toBuf (ConstCase x y)
+    toBuf (ConstCase _ x y)
         = do tag 2; toBuf x; toBuf y
-    toBuf (DefaultCase x)
+    toBuf (DefaultCase _ x)
         = do tag 3; toBuf x
 
     fromBuf
         = case !getTag of
                0 => do x <- fromBuf; t <- fromBuf
-                       args <- fromBuf; y <- fromBuf
-                       pure (ConCase x t args y)
+                       y <- fromBuf
+                       pure (ConCase emptyFC x t y)
                1 => do ty <- fromBuf; arg <- fromBuf; y <- fromBuf
-                       pure (DelayCase ty arg y)
+                       pure (DelayCase emptyFC ty arg y)
                2 => do x <- fromBuf; y <- fromBuf
-                       pure (ConstCase x y)
+                       pure (ConstCase emptyFC x y)
                3 => do x <- fromBuf
-                       pure (DefaultCase x)
+                       pure (DefaultCase emptyFC x)
                _ => corrupt "CaseAlt"
 
 export
 {vars : _} -> TTC (Env Term vars) where
-  toBuf [] = pure ()
-  toBuf ((::) bnd env)
+  toBuf [<] = pure ()
+  toBuf {vars = _ :< _} (env :< bnd)
       = do toBuf bnd; toBuf env
 
   -- Length has to correspond to length of 'vars'
-  fromBuf {vars = []} = pure []
-  fromBuf {vars = x :: xs}
+  fromBuf {vars = [<]} = pure Env.empty
+  fromBuf {vars = xs :< x}
       = do bnd <- fromBuf
            env <- fromBuf
-           pure (bnd :: env)
+           pure (Env.bind env bnd)
 
 export
 TTC Visibility where
@@ -599,112 +693,6 @@ TTC Totality where
            cov <- fromBuf
            pure (MkTotality term cov)
 
-export
-{n : _} -> TTC (PrimFn n) where
-  toBuf (Add ty) = do tag 0; toBuf ty
-  toBuf (Sub ty) = do tag 1; toBuf ty
-  toBuf (Mul ty) = do tag 2; toBuf ty
-  toBuf (Div ty) = do tag 3; toBuf ty
-  toBuf (Mod ty) = do tag 4; toBuf ty
-  toBuf (Neg ty) = do tag 5; toBuf ty
-  toBuf (ShiftL ty) = do tag 35; toBuf ty
-  toBuf (ShiftR ty) = do tag 36; toBuf ty
-  toBuf (BAnd ty) = do tag 37; toBuf ty
-  toBuf (BOr ty) = do tag 38; toBuf ty
-  toBuf (BXOr ty) = do tag 39; toBuf ty
-  toBuf (LT ty) = do tag 6; toBuf ty
-  toBuf (LTE ty) = do tag 7; toBuf ty
-  toBuf (EQ ty) = do tag 8; toBuf ty
-  toBuf (GTE ty) = do tag 9; toBuf ty
-  toBuf (GT ty) = do tag 10; toBuf ty
-  toBuf StrLength = tag 11
-  toBuf StrHead = tag 12
-  toBuf StrTail = tag 13
-  toBuf StrIndex = tag 14
-  toBuf StrCons = tag 15
-  toBuf StrAppend = tag 16
-  toBuf StrReverse = tag 17
-  toBuf StrSubstr = tag 18
-
-  toBuf DoubleExp = tag 19
-  toBuf DoubleLog = tag 20
-  toBuf DoublePow = tag 21
-  toBuf DoubleSin = tag 22
-  toBuf DoubleCos = tag 23
-  toBuf DoubleTan = tag 24
-  toBuf DoubleASin = tag 25
-  toBuf DoubleACos = tag 26
-  toBuf DoubleATan = tag 27
-  toBuf DoubleSqrt = tag 32
-  toBuf DoubleFloor = tag 33
-  toBuf DoubleCeiling = tag 34
-
-  toBuf (Cast x y) = do tag 99; toBuf x; toBuf y
-  toBuf BelieveMe = tag 100
-  toBuf Crash = tag 101
-
-  fromBuf {n}
-      = case n of
-             S Z => fromBuf1
-             S (S Z) => fromBuf2
-             S (S (S Z)) => fromBuf3
-             _ => corrupt "PrimFn"
-    where
-      fromBuf1 : Core (PrimFn 1)
-      fromBuf1
-          = case !getTag of
-                 5 => do ty <- fromBuf; pure (Neg ty)
-                 11 => pure StrLength
-                 12 => pure StrHead
-                 13 => pure StrTail
-                 17 => pure StrReverse
-                 19 => pure DoubleExp
-                 20 => pure DoubleLog
-                 22 => pure DoubleSin
-                 23 => pure DoubleCos
-                 24 => pure DoubleTan
-                 25 => pure DoubleASin
-                 26 => pure DoubleACos
-                 27 => pure DoubleATan
-                 32 => pure DoubleSqrt
-                 33 => pure DoubleFloor
-                 34 => pure DoubleCeiling
-
-                 99 => do x <- fromBuf; y <- fromBuf; pure (Cast x y)
-                 _ => corrupt "PrimFn 1"
-
-      fromBuf2 : Core (PrimFn 2)
-      fromBuf2
-          = case !getTag of
-                 0 => do ty <- fromBuf; pure (Add ty)
-                 1 => do ty <- fromBuf; pure (Sub ty)
-                 2 => do ty <- fromBuf; pure (Mul ty)
-                 3 => do ty <- fromBuf; pure (Div ty)
-                 4 => do ty <- fromBuf; pure (Mod ty)
-                 6 => do ty <- fromBuf; pure (LT ty)
-                 7 => do ty <- fromBuf; pure (LTE ty)
-                 8 => do ty <- fromBuf; pure (EQ ty)
-                 9 => do ty <- fromBuf; pure (GTE ty)
-                 10 => do ty <- fromBuf; pure (GT ty)
-                 14 => pure StrIndex
-                 15 => pure StrCons
-                 16 => pure StrAppend
-                 21 => pure DoublePow
-                 35 => do ty <- fromBuf; pure (ShiftL ty)
-                 36 => do ty <- fromBuf; pure (ShiftR ty)
-                 37 => do ty <- fromBuf; pure (BAnd ty)
-                 38 => do ty <- fromBuf; pure (BOr ty)
-                 39 => do ty <- fromBuf; pure (BXOr ty)
-                 101 => pure Crash
-                 _ => corrupt "PrimFn 2"
-
-      fromBuf3 : Core (PrimFn 3)
-      fromBuf3
-          = case !getTag of
-                 18 => pure StrSubstr
-                 100 => pure BelieveMe
-                 _ => corrupt "PrimFn 3"
-
 export
 TTC ConInfo where
   toBuf DATACON = tag 0
@@ -757,7 +745,7 @@ mutual
         = assert_total $ case !getTag of
                0 => do fc <- fromBuf
                        idx <- fromBuf
-                       let Just x = getAt idx vars
+                       let Just x = getName idx vars
                            | Nothing => corrupt "CExp"
                        pure (CLocal {x} fc (mkPrf idx))
                1 => do fc <- fromBuf
@@ -805,14 +793,26 @@ mutual
                         pure (CCrash fc msg)
                _ => corrupt "CExp"
 
+  export
+  {vars : _} -> TTC (CCaseScope vars) where
+    toBuf (CRHS sc) = do tag 0; toBuf sc
+    toBuf (CArg x sc) = do tag 1; toBuf x; toBuf sc
+
+    fromBuf
+        = case !getTag of
+               0 => do sc <- fromBuf
+                       pure (CRHS sc)
+               1 => do x <- fromBuf; sc <- fromBuf
+                       pure (CArg x sc)
+               _ => corrupt "CCaseScope"
+
   export
   {vars : _} -> TTC (CConAlt vars) where
-    toBuf (MkConAlt n ci t as sc) = do toBuf n; toBuf ci; toBuf t; toBuf as; toBuf sc
+    toBuf (MkConAlt n ci t sc) = do toBuf n; toBuf ci; toBuf t; toBuf sc
 
     fromBuf
-        = do n <- fromBuf; ci <- fromBuf; t <- fromBuf
-             as <- fromBuf; sc <- fromBuf
-             pure (MkConAlt n ci t as sc)
+        = do n <- fromBuf; ci <- fromBuf; t <- fromBuf; sc <- fromBuf
+             pure (MkConAlt n ci t sc)
 
   export
   {vars : _} -> TTC (CConstAlt vars) where
@@ -995,17 +995,32 @@ TTC TypeFlags where
            e <- fromBuf
            pure (MkTypeFlags u e)
 
+export
+TTC DataConInfo where
+  toBuf l
+      = do toBuf (quantities l)
+           toBuf (newTypeArg l)
+  fromBuf
+      = do q <- fromBuf; n <- fromBuf
+           pure (MkDataConInfo q n)
+
+export
+TTC Clause where
+  toBuf (MkClause {vars} env lhs rhs)
+      = do toBuf vars; toBuf env; toBuf lhs; toBuf rhs
+  fromBuf
+      = do vars <- fromBuf; env <- fromBuf; lhs <- fromBuf; rhs <- fromBuf
+           pure (MkClause {vars} env lhs rhs)
+
 export
 TTC Def where
   toBuf None = tag 0
-  toBuf (PMDef pi args ct rt pats)
-      = do tag 1; toBuf pi; toBuf args; toBuf ct; toBuf pats
+  toBuf (Function pi ct rt pats)
+      = do tag 1; toBuf pi; toBuf ct; toBuf pats
   toBuf (ExternDef a)
       = do tag 2; toBuf a
   toBuf (ForeignDef a cs)
       = do tag 3; toBuf a; toBuf cs
-  toBuf (Builtin a)
-      = throw (InternalError "Trying to serialise a Builtin")
   toBuf (DCon t arity nt) = do tag 4; toBuf t; toBuf arity; toBuf nt
   toBuf (TCon arity parampos detpos u ms datacons dets)
       = do tag 5; toBuf arity; toBuf parampos
@@ -1025,10 +1040,9 @@ TTC Def where
       = case !getTag of
              0 => pure None
              1 => do pi <- fromBuf
-                     args <- fromBuf
                      ct <- fromBuf
                      pats <- fromBuf
-                     pure (PMDef pi args ct (Unmatched "") pats)
+                     pure (Function pi ct (Unmatched emptyFC "") pats)
              2 => do a <- fromBuf
                      pure (ExternDef a)
              3 => do a <- fromBuf
@@ -1071,18 +1085,19 @@ TTC TotalReq where
 
 TTC DefFlag where
   toBuf Inline = tag 2
-  toBuf NoInline = tag 13
-  toBuf Deprecate = tag 15
   toBuf Invertible = tag 3
   toBuf Overloadable = tag 4
   toBuf TCInline = tag 5
   toBuf (SetTotal x) = do tag 6; toBuf x
   toBuf BlockedHint = tag 7
-  toBuf Macro = tag 8
-  toBuf (PartialEval x) = tag 9 -- names not useful any more
-  toBuf AllGuarded = tag 10
-  toBuf (ConType ci) = do tag 11; toBuf ci
-  toBuf (Identity x) = do tag 12; toBuf x
+  toBuf BlockReduce = tag 8
+  toBuf Macro = tag 9
+  toBuf (PartialEval x) = tag 10 -- names not useful any more
+  toBuf AllGuarded = tag 11
+  toBuf (ConType ci) = do tag 12; toBuf ci
+  toBuf (Identity x) = do tag 13; toBuf x
+  toBuf NoInline = tag 14
+  toBuf Deprecate = tag 15
 
   fromBuf
       = case !getTag of
@@ -1092,12 +1107,13 @@ TTC DefFlag where
              5 => pure TCInline
              6 => do x <- fromBuf; pure (SetTotal x)
              7 => pure BlockedHint
-             8 => pure Macro
-             9 => pure (PartialEval [])
-             10 => pure AllGuarded
-             11 => do ci <- fromBuf; pure (ConType ci)
-             12 => do x <- fromBuf; pure (Identity x)
-             13 => pure NoInline
+             8 => pure BlockReduce
+             9 => pure Macro
+             10 => pure (PartialEval [])
+             11 => pure AllGuarded
+             12 => do ci <- fromBuf; pure (ConType ci)
+             13 => do x <- fromBuf; pure (Identity x)
+             14 => pure NoInline
              15 => pure Deprecate
              _ => corrupt "DefFlag"
 
diff --git a/src/Core/Termination.idr b/src/Core/Termination.idr
index 1f943b49c3b..8c3c9790054 100644
--- a/src/Core/Termination.idr
+++ b/src/Core/Termination.idr
@@ -2,8 +2,8 @@ module Core.Termination
 
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
 
 import Core.Termination.CallGraph
 import Core.Termination.Positivity
@@ -23,18 +23,54 @@ checkIfGuarded : {auto c : Ref Ctxt Defs} ->
 checkIfGuarded fc n
     = do logC "totality.termination.guarded" 6 $ do pure $ "Check if Guarded: " ++ show !(toFullNames n)
          defs <- get Ctxt
-         Just (PMDef _ _ _ _ pats) <- lookupDefExact n (gamma defs)
+         Just (Function _ tm _ _) <- lookupDefExact n (gamma defs)
               | _ => pure ()
-         t <- allGuarded pats
-         when t $ setFlag fc n AllGuarded
+         tmnf <- nfTotality [<] tm
+         -- Just work from 'Glued', don't do any actual normalisation
+         t <- guardedDef tmnf
+         log "totality.termination.guarded" 6 (show t)
+         if t then do Just gdef <- lookupCtxtExact n (gamma defs)
+                           | Nothing => pure ()
+                      g <- allM (checkNotFn defs) (keys (refersTo gdef))
+                      log "totality.termination.guarded" 6
+                            $ "Refers to " ++ show !(toFullNames (keys (refersTo gdef)))
+                      when g $ setFlag fc n AllGuarded
+              else pure ()
   where
-    guardedNF : Defs -> Env Term vars -> NF vars -> Core Bool
-    guardedNF defs env (NDCon _ _ _ _ args) = pure True
-    guardedNF defs env (NApp _ (NRef _ n) args)
-        = do Just gdef <- lookupCtxtExact n (gamma defs)
+   mutual
+    guardedNF : Glued vars -> Core Bool
+    guardedNF (VDCon{}) = pure True
+    guardedNF (VApp _ _ n _ _)
+        = do defs <- get Ctxt
+             Just gdef <- lookupCtxtExact n (gamma defs)
                   | Nothing => pure False
              pure (AllGuarded `elem` flags gdef)
-    guardedNF defs env _ = pure False
+    guardedNF (VCase fc ct c _ _ alts)
+        = guardedAlts alts
+    guardedNF _ = pure False
+
+    guardedScope : (args : _) -> VCaseScope args vars -> Core Bool
+    guardedScope [<] sc = guardedNF (snd !sc)
+    guardedScope (sx :< y) sc = guardedScope sx (sc (pure (VErased fc Placeholder)))
+
+    guardedAlt : VCaseAlt vars -> Core Bool
+    guardedAlt (VConCase _ _ _ args sc) = guardedScope _ sc
+    guardedAlt (VDelayCase fc ty arg sc)
+        = guardedScope [< (top, arg), (top, ty) ] sc
+    guardedAlt (VConstCase _ _ sc) = guardedNF sc
+    guardedAlt (VDefaultCase _ sc) = guardedNF sc
+
+    guardedAlts : List (VCaseAlt vars) -> Core Bool
+    guardedAlts [] = pure True
+    guardedAlts (x :: xs)
+        = if !(guardedAlt x) then guardedAlts xs else pure False
+
+    guardedDef : Glued vars -> Core Bool
+    guardedDef (VBind fc _ (Lam _ _ _ _) sc)
+        = guardedDef !(sc $ pure $ VErased fc Placeholder)
+    guardedDef (VCase fc ct c _ _ alts)
+        = guardedAlts alts
+    guardedDef nf = guardedNF nf
 
     checkNotFn : Defs -> Name -> Core Bool
     checkNotFn defs n
@@ -45,24 +81,6 @@ checkIfGuarded fc n
                   _ => pure (multiplicity gdef == erased
                               || (AllGuarded `elem` flags gdef))
 
-    guarded : {vars : _} -> Env Term vars -> Term vars -> Core Bool
-    guarded env tm
-        = do defs <- get Ctxt
-             empty <- clearDefs defs
-             tmnf <- nf empty env tm
-             if !(guardedNF defs env tmnf)
-                then do Just gdef <- lookupCtxtExact n (gamma defs)
-                             | Nothing => pure False
-                        allM (checkNotFn defs) (keys (refersTo gdef))
-                else pure False
-
-    allGuarded : List (vs ** (Env Term vs, Term vs, Term vs)) -> Core Bool
-    allGuarded [] = pure True
-    allGuarded ((_ ** (env, lhs, rhs)) :: ps)
-        = if !(guarded env rhs)
-             then allGuarded ps
-             else pure False
-
 -- Check whether a function is terminating, and record in the context
 export
 checkTerminating : {auto c : Ref Ctxt Defs} ->
diff --git a/src/Core/Termination/CallGraph.idr b/src/Core/Termination/CallGraph.idr
index 4bfa8d7b0a4..935ca99039c 100644
--- a/src/Core/Termination/CallGraph.idr
+++ b/src/Core/Termination/CallGraph.idr
@@ -1,19 +1,98 @@
 module Core.Termination.CallGraph
 
-import Core.Case.CaseTree
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
 import Core.Options
-import Core.Value
-
-import Libraries.Data.List.SizeOf
-import Libraries.Data.SparseMatrix
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate
+import Core.Name.CompatibleVars
 
 import Data.String
+import Data.SnocList.Quantifiers
+
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SparseMatrix
+import Data.SortedMap
 
 %default covering
 
+-- Drop any non-inf top level laziness annotations
+-- Remove all force and delay annotations which are nothing to do with
+-- coinduction meaning that all Delays left guard coinductive calls.
+dropLazy : Value f vars -> Core (Glued vars)
+dropLazy val@(VDelayed _ r t)
+    = case r of
+           LInf => pure (asGlued val)
+           _ => pure t
+dropLazy val@(VDelay _ r t v)
+    = case r of
+           LInf => pure (asGlued val)
+           _ => pure v
+dropLazy val@(VForce fc r v sp)
+    = case r of
+           LInf => pure (asGlued val)
+           _ => applyAll fc v (cast (map (\ e => (multiplicity e, value e)) sp))
+dropLazy val = pure (asGlued val)
+
+scEq : Value f vars -> Value f' vars -> Core Bool
+
+scEqSpine : Spine vars -> Spine vars -> Core Bool
+scEqSpine [<] [<] = pure True
+scEqSpine (sp :< x) (sp' :< y)
+    = do x' <- value x
+         y' <- value y
+         if !(scEq x' y')
+            then scEqSpine sp sp'
+            else pure False
+scEqSpine _ _ = pure False
+
+-- Approximate equality between values. We don't go under binders - we're
+-- only checking for size change equality so expect to just see type and
+-- data constructors
+-- TODO: size change for pattern matching on types
+scEq' : Value f vars -> Value f' vars -> Core Bool
+scEq' (VApp _ _ n sp _) (VApp _ _ n' sp' _)
+    = if n == n'
+         then scEqSpine sp sp'
+         else pure False
+-- Should never see this since we always call with vars = [<], but it is
+-- technically possible
+scEq' (VLocal _ idx _ sp) (VLocal _ idx' _ sp')
+    = if idx == idx'
+         then scEqSpine sp sp'
+         else pure False
+scEq' (VDCon _ _ t a sp) (VDCon _ _ t' a' sp')
+    = if t == t'
+         then scEqSpine sp sp'
+         else pure False
+scEq' (VTCon _ n a sp) (VTCon _ n' a' sp')
+    = if n == n'
+         then scEqSpine sp sp'
+         else pure False
+scEq' (VMeta _ _ i _ args _) (VMeta _ _ i' _ args' _)
+   -- = i == i' && assert_total (all (uncurry scEq) (zip args args'))
+   = pure $ i == i' && assert_total !(allM (uncurry scEq) !paired_values)
+   where
+     paired_values : Core (SnocList (Value Glue vars, Value Glue vars))
+     paired_values = traverse (\(a, a') => pure (!a, !a')) (zip (map value args) (map value args'))
+scEq' (VAs _ _ a p) p' = pure $ !(scEq p p') || !(scEq p a)
+scEq' p (VAs _ _ a p') = pure $ !(scEq p a) || !(scEq p p')
+scEq' (VDelayed _ _ t) (VDelayed _ _ t') = scEq t t'
+scEq' (VDelay _ _ t x) (VDelay _ _ t' x')
+     = if !(scEq t t') then scEq x x'
+          else pure False
+scEq' (VForce _ _ t [<]) (VForce _ _ t' [<]) = scEq t t'
+scEq' (VPrimVal _ c) (VPrimVal _ c') = pure $ c == c'
+-- traverse dotted LHS terms
+scEq' t (VErased _ (Dotted t')) = scEq t t' -- t' is no longer a pattern
+scEq' (VErased _ _) (VErased _ _) = pure True
+scEq' (VUnmatched _ _) (VUnmatched _ _) = pure True
+scEq' (VType _ _) (VType _ _) = pure True
+scEq' _ _ = pure False -- other cases not checkable
+
+scEq x y = scEq' !(dropLazy x) !(dropLazy y)
+
 data Guardedness = Toplevel | Unguarded | Guarded | InDelay
 
 Show Guardedness where
@@ -22,385 +101,436 @@ Show Guardedness where
   show Guarded = "Guarded"
   show InDelay = "InDelay"
 
-sizeEq : {auto 0 cv : CompatibleVars rhsVars lhsVars} ->
-         Term rhsVars -> -- RHS
-         Term lhsVars -> -- LHS: may contain dot-patterns, try both sides of as patterns
-         Bool
-sizeEq (Local _ _ idx _) (Local _ _ idx' _) = idx == idx'
-sizeEq (Ref _ _ n) (Ref _ _ n') = n == n'
-sizeEq (Meta _ _ i args) (Meta _ _ i' args')
-    = i == i' && assert_total (all (uncurry sizeEq) (zip args args'))
-sizeEq (Bind _ _ b sc) (Bind _ _ b' sc') = eqBinderBy sizeEq b b' && sizeEq sc sc'
-sizeEq (App _ f a) (App _ f' a') = sizeEq f f' && sizeEq a a'
-sizeEq (As _ _ a p) p' = sizeEq p p'
-sizeEq p (As _ _ a p') = sizeEq p a || sizeEq p p'
-sizeEq (TDelayed _ _ t) (TDelayed _ _ t') = sizeEq t t'
-sizeEq (TDelay _ _ t x) (TDelay _ _ t' x') = sizeEq t t' && sizeEq x x'
-sizeEq (TForce _ _ t) (TForce _ _ t') = sizeEq t t'
-sizeEq (PrimVal _ c) (PrimVal _ c') = c == c'
--- traverse dotted LHS terms
-sizeEq t (Erased _ (Dotted t')) = eqTerm t t' -- t' is no longer a pattern
-sizeEq (TType {}) (TType {}) = True
-sizeEq _ _ = False
-
--- Remove all force and delay annotations which are nothing to do with
--- coinduction meaning that all Delays left guard coinductive calls.
-delazy : Defs -> Term vars -> Term vars
-delazy defs (TDelayed fc r tm)
-    = let tm' = delazy defs tm in
-          case r of
-               LInf => TDelayed fc r tm'
-               _ => tm'
-delazy defs (TDelay fc r ty tm)
-    = let ty' = delazy defs ty
-          tm' = delazy defs tm in
-          case r of
-               LInf => TDelay fc r ty' tm'
-               _ => tm'
-delazy defs (TForce fc r t)
-    = case r of
-           LInf => TForce fc r (delazy defs t)
-           _ => delazy defs t
-delazy defs (Meta fc n i args) = Meta fc n i (map (delazy defs) args)
-delazy defs (Bind fc x b sc)
-    = Bind fc x (map (delazy defs) b) (delazy defs sc)
-delazy defs (App fc f a) = App fc (delazy defs f) (delazy defs a)
-delazy defs (As fc s a p) = As fc s (delazy defs a) (delazy defs p)
-delazy defs tm = tm
+knownOr : Core SizeChange -> Core SizeChange -> Core SizeChange
+knownOr x y = case !x of Unknown => y; _ => x
+
+plusLazy : Core SizeChange -> Core SizeChange -> Core SizeChange
+plusLazy x y = case !x of Smaller => pure Smaller; x => pure $ x |+| !y
+
+-- Return whether first argument is structurally smaller than the second.
+sizeCompare : {auto c : Ref Ctxt Defs} ->
+              {auto defs : Defs} ->
+              Nat -> -- backtracking fuel
+              Glued [<] -> -- RHS: term we're checking
+              Glued [<] -> -- LHS: argument it might be smaller than
+              Core SizeChange
+
+sizeCompareCon : {auto c : Ref Ctxt Defs} -> {auto defs : Defs} -> Nat -> Glued [<] -> Glued [<] -> Core Bool
+sizeCompareTyCon : {auto c : Ref Ctxt Defs} -> {auto defs : Defs} -> Nat -> Glued [<] -> Glued [<] -> Core Bool
+sizeCompareConArgs : {auto c : Ref Ctxt Defs} -> {auto defs : Defs} -> Nat -> Glued [<] -> List (Glued [<]) -> Core Bool
+sizeCompareApp : {auto c : Ref Ctxt Defs} -> {auto defs : Defs} -> Nat -> Glued [<] -> Glued [<] -> Core SizeChange
+
+sizeCompare fuel s (VErased _ (Dotted t)) = sizeCompare fuel s t
+sizeCompare fuel _ (VErased _ _) = pure Unknown -- incomparable!
+-- for an as pattern, it's smaller if it's smaller than either part
+sizeCompare fuel s (VAs _ _ p t)
+    = knownOr (sizeCompare fuel s p) (sizeCompare fuel s t)
+sizeCompare fuel (VAs _ _ p s) t
+    = knownOr (sizeCompare fuel p t) (sizeCompare fuel s t)
+-- if they're both metas, let scEq check if they're the same
+sizeCompare fuel s@(VMeta _ _ _ _ _ _) t@(VMeta _ _ _ _ _ _) = pure (if !(scEq s t) then Same else Unknown)
+-- otherwise try to expand RHS meta
+sizeCompare fuel s@(VMeta _ n i args _ _) t = do
+  Just gdef <- lookupCtxtExact (Resolved i) (gamma defs) | _ => pure Unknown
+  let (Function _ tm _ _) = definition gdef | _ => pure Unknown
+  tm <- substMeta (embed tm) !(traverse snd args) zero [<]
+  sizeCompare fuel tm t
+  where
+    substMeta : {0 drop : _} ->
+                Term (Scope.addInner Scope.empty drop) -> List (Glued Scope.empty) ->
+                SizeOf drop -> Subst Glued drop Scope.empty ->
+                Core (Glued Scope.empty)
+    substMeta (Bind bfc n (Lam _ c e ty) sc) (a :: as) drop env
+        = substMeta sc as (suc drop) (env :< a)
+    substMeta (Bind bfc n (Let _ c val ty) sc) as drop env
+        = substMeta (subst val sc) as drop env
+    substMeta rhs [] drop env = (nf [<] (substs drop !(to_env env) rhs))
+      where
+        to_env : {0 drop : _} -> Subst Glued drop Scope.empty -> Core (SubstEnv drop Scope.empty)
+        to_env [<] = pure [<]
+        to_env (as :< a) = pure $ !(to_env as) :< !(quote [<] a)
+    substMeta rhs _ _ _ = throw (InternalError ("Badly formed metavar solution \{show n}"))
+
+sizeCompare fuel s t
+   = if !(sizeCompareTyCon fuel s t) then pure Same
+     else if !(sizeCompareCon fuel s t)
+        then pure Smaller
+        else knownOr (sizeCompareApp fuel s t) (pure $ if !(scEq s t) then Same else Unknown)
+
+sizeCompareProdConArgs : {auto c : Ref Ctxt Defs} -> {auto defs : Defs} -> Nat -> List (Glued [<]) -> List (Glued [<]) -> Core SizeChange
+sizeCompareProdConArgs _ [] [] = pure Same
+sizeCompareProdConArgs fuel (x :: xs) (y :: ys) =
+  case !(sizeCompare fuel x y) of
+    Unknown => pure Unknown
+    t => (t |*|) <$> sizeCompareProdConArgs fuel xs ys
+sizeCompareProdConArgs _ _ _ = pure Unknown
+
+sizeCompareTyCon fuel s t =
+  case t of
+    VTCon _ cn _ args => case s of
+      VTCon _ cn' _ args' => if cn == cn'
+          then (Unknown /=) <$> sizeCompareProdConArgs fuel (toList !(traverseSnocList value args')) (toList !(traverseSnocList value args))
+          else pure False
+      _ => pure False
+    _ => pure False
+
+sizeCompareCon fuel s t
+    = case t of
+           VDCon _ cn _ _ sp =>
+            do
+              sp_value <- toList <$> traverseSnocList value sp
+              -- if s is smaller or equal to an arg, then it is smaller than t
+              if !(sizeCompareConArgs (minus fuel 1) s sp_value) then pure True
+               else case (fuel, s) of
+                      (S k, VDCon _ cn' _ _ sp') => do
+                              -- if s is a matching DataCon, applied to same number of args,
+                              -- no Unknown args, and at least one Smaller
+                              if cn == cn' && length sp == length sp'
+                                then (Smaller ==) <$> sizeCompareProdConArgs k (toList !(traverseSnocList value sp')) sp_value
+                                else pure False
+                      _ => pure $ False
+           _ => pure False
+
+sizeCompareConArgs _ s [] = pure False
+sizeCompareConArgs fuel s (t :: ts)
+    = case !(sizeCompare fuel s t) of
+        Unknown => sizeCompareConArgs fuel s ts
+        _ => pure True
+
+sizeCompareApp fuel l@(VApp _ _ n sp _) r@(VApp _ _ n' sp' _)
+ = if n == n'
+     then if length sp == length sp'
+             then do sp_value <- toList <$> traverseSnocList value sp
+                     sp_value' <- toList <$> traverseSnocList value sp'
+                     sizeCompareProdConArgs fuel sp_value sp_value'
+             else do -- TODO: how to compare detected recursion?
+                     -- It is a case like: {arg:0} vs {arg:0} {arg:1}
+                     pure Same
+     else do pure Unknown
+sizeCompareApp _ _ t = pure Unknown
+
+sizeCompareAsserted : {auto c : Ref Ctxt Defs} -> {auto defs : Defs} -> Nat -> Maybe (Glued [<]) -> Glued [<] -> Core SizeChange
+sizeCompareAsserted fuel (Just s) t
+    = pure $ case !(sizeCompare fuel s t) of
+        Unknown => Unknown
+        _ => Smaller
+sizeCompareAsserted _ Nothing _ = pure Unknown
+
+-- Substitute a name with what we know about it.
+-- We assume that the name has come from a case pattern, which means we're
+-- not going to have to look under binders.
+-- We also assume that (despite the 'Glued') it's always a VDCon or VDelay
+-- therefore no need to expand apps.
+substNameInVal : Name -> Glued vars -> Glued vars -> Core (Glued vars)
+-- Only interested in Bound names (that we just made) and so we only need
+-- to check the index
+substNameInVal (MN _ i') rep tm@(VApp _ Bound (MN _ i) _ _)
+    = if i == i' then pure rep else pure tm
+substNameInVal n rep (VDCon fc cn t a sp)
+    = pure $ VDCon fc cn t a !(substNameInSpine sp)
+  where
+    substNameInSpine : Spine vars -> Core (Spine vars)
+    substNameInSpine [<] = pure [<]
+    substNameInSpine (rest :< MkSpineEntry fc c arg)
+        = do rest' <- substNameInSpine rest
+             pure (rest' :< MkSpineEntry fc c (substNameInVal n rep !arg))
+substNameInVal n rep (VDelay fc r t v)
+    = pure $ VDelay fc r !(substNameInVal n rep t) !(substNameInVal n rep v)
+substNameInVal n rep tm = pure tm
+
+replaceInArgs : Name -> Glued [<] ->
+                List (Nat, Glued [<]) -> Core (List (Nat, Glued [<]))
+replaceInArgs v tm [] = pure []
+-- -- Don't copy if there's no substitution done!
+replaceInArgs v tm ((n, arg) :: args)
+    = do arg' <- substNameInVal v tm arg
+         if !(scEq arg arg')
+            then pure $ (n, arg) :: !(replaceInArgs v tm args)
+            else pure $ (n, arg) :: (n, arg') :: !(replaceInArgs v tm args)
+
+expandForced : List (Glued [<], Glued [<]) ->
+               List (Nat, Glued [<]) -> Core (List (Nat, Glued [<]))
+expandForced [] args = pure args
+-- Only useful if the equality evaluated to a bound name that we know about
+expandForced ((VApp _ Bound n _ _, tm) :: fs) args
+    = expandForced fs !(replaceInArgs n tm args)
+expandForced (_ :: fs) args = expandForced fs args
+
+data SCVar : Type where
+
+mkvar : Int -> Value f [<]
+mkvar i = vRef EmptyFC Bound (MN "scv" i)
+
+nextVar : {auto c : Ref SCVar Int} -> Core (Value f [<])
+nextVar
+    = do v <- get SCVar
+         put SCVar (v + 1)
+         pure (mkvar v)
+
+ForcedEqs : Type
+ForcedEqs = List (Glued [<], Glued [<])
+
+findVar : Int -> List (Glued vars, Glued vars) -> Maybe (Glued vars)
+findVar i [] = Nothing
+findVar i ((VApp _ Bound (MN _ i') _ _, tm) :: eqs)
+    = if i == i' then Just tm else findVar i eqs
+findVar i (_ :: eqs) = findVar i eqs
+
+canonicalise : List (Glued vars, Glued vars) -> Glued vars -> Core (Glued vars)
+canonicalise eqs tm@(VApp _ Bound (MN _ i) _ _)
+    = case findVar i eqs of
+           Nothing => pure tm
+           Just val => canonicalise eqs val
+canonicalise eqs (VDCon fc cn t a sp)
+    = pure $ VDCon fc cn t a !(canonSp sp)
+  where
+    canonSp : Spine vars -> Core (Spine vars)
+    canonSp [<] = pure [<]
+    canonSp (rest :< MkSpineEntry fc c arg)
+        = do rest' <- canonSp rest
+             pure (rest' :< MkSpineEntry fc c (canonicalise eqs !arg))
+-- for matching on types, convert to the form the case tree builder uses
+canonicalise eqs (VPrimVal fc (PrT c))
+    = pure $ (VTCon fc (UN (Basic $ show c)) 0 [<])
+canonicalise eqs (VType fc _)
+    = pure $ (VTCon fc (UN (Basic "Type")) 0 [<])
+canonicalise eqs val = pure val
+
+isAssertTotal : Name -> Bool
+isAssertTotal = (== NS builtinNS (UN $ Basic "assert_total"))
 
 mutual
-  findSC : {vars : _} ->
-           {auto c : Ref Ctxt Defs} ->
-           Defs -> Env Term vars -> Guardedness ->
-           List (Term vars) -> -- LHS args
-           Term vars -> -- RHS
+  findSC : {auto c : Ref Ctxt Defs} ->
+           {auto v : Ref SCVar Int} ->
+           Guardedness ->
+           ForcedEqs ->
+           List (Nat, Glued [<]) -> -- LHS args and their position
+           Glued [<] -> -- definition. No expanding to NF, we want to check
+                        -- the program as written (plus tcinlines)
            Core (List SCCall)
-  findSC {vars} defs env g pats (Bind fc n b sc)
-       = pure $
-            !(findSCbinder b) ++
-            !(findSC defs (b :: env) g (map weaken pats) sc)
-    where
-      findSCbinder : Binder (Term vars) -> Core (List SCCall)
-      findSCbinder (Let _ c val ty) = findSC defs env g pats val
-      findSCbinder b = pure [] -- only types, no need to look
   -- If we're Guarded and find a Delay, continue with the argument as InDelay
-  findSC defs env Guarded pats (TDelay _ _ _ tm)
-      = findSC defs env InDelay pats tm
-  findSC defs env g pats (TDelay _ _ _ tm)
-      = findSC defs env g pats tm
-  findSC defs env g pats (TForce _ _ tm)
-      = findSC defs env Unguarded pats tm
-  findSC defs env g pats tm
-      = do let (fn, args) = getFnArgs tm
-           False <- isAssertTotal fn
-               | True => pure []
-           -- if it's a 'case' or 'if' just go straight into the arguments
-           Nothing <- handleCase fn args
-               | Just res => pure res
-           fn' <- conIfGuarded fn -- pretend it's a data constructor if
-                                  -- it has the AllGuarded flag
-           case (g, fn', args) of
-    -- If we're InDelay and find a constructor (or a function call which is
-    -- guaranteed to return a constructor; AllGuarded set), continue as InDelay
-             (InDelay, Ref fc (DataCon {}) cn, args) =>
-                 do scs <- traverse (findSC defs env InDelay pats) args
-                    pure (concat scs)
-             -- If we're InDelay otherwise, just check the arguments, the
-             -- function call is okay
-             (InDelay, _, args) =>
-                 do scs <- traverse (findSC defs env Unguarded pats) args
-                    pure (concat scs)
-             (Guarded, Ref fc (DataCon {}) cn, args) =>
-                    findSCcall defs env Guarded pats fc cn args
-             (Toplevel, Ref fc (DataCon {}) cn, args) =>
-                    findSCcall defs env Guarded pats fc cn args
-             (_, Ref fc Func fn, args) =>
-                 do logC "totality" 50 $
-                       pure $ "Looking up type of " ++ show !(toFullNames fn)
-                    findSCcall defs env Unguarded pats fc fn args
-             (_, f, args) =>
-                 do scs <- traverse (findSC defs env Unguarded pats) args
-                    pure (concat scs)
-      where
-        handleCase : Term vars -> List (Term vars) -> Core (Maybe (List SCCall))
-        handleCase (Ref fc nt n) args
-            = do n' <- toFullNames n
-                 if caseFn n'
-                    then Just <$> findSCcall defs env g pats fc n args
-                    else pure Nothing
-        handleCase _ _ = pure Nothing
-
-        isAssertTotal : Term vars -> Core Bool
-        isAssertTotal (Ref fc Func fn)
-            = pure $ !(toFullNames fn) == NS builtinNS (UN $ Basic "assert_total")
-        isAssertTotal tm = pure False
-
-        conIfGuarded : Term vars -> Core (Term vars)
-        conIfGuarded (Ref fc Func n)
-            = do defs <- get Ctxt
-                 Just gdef <- lookupCtxtExact n (gamma defs)
-                      | Nothing => pure $ Ref fc Func n
-                 if AllGuarded `elem` flags gdef
-                    then pure $ Ref fc (DataCon 0 0) n
-                    else pure $ Ref fc Func n
-        conIfGuarded tm = pure tm
-
-  knownOr : Core SizeChange -> Core SizeChange -> Core SizeChange
-  knownOr x y = case !x of Unknown => y; _ => x
-
-  plusLazy : Core SizeChange -> Core SizeChange -> Core SizeChange
-  plusLazy x y = case !x of Smaller => pure Smaller; x => pure $ x |+| !y
-
-  -- Return whether first argument is structurally smaller than the second.
-  sizeCompare : {auto defs : Defs} ->
-                Nat -> -- backtracking fuel
-                Term vars -> -- RHS: term we're checking
-                Term vars -> -- LHS: argument it might be smaller than
-                Core SizeChange
-
-  sizeCompareCon : {auto defs : Defs} -> Nat -> Term vars -> Term vars -> Core Bool
-  sizeCompareTyCon : {auto defs : Defs} -> Nat -> Term vars -> Term vars -> Core Bool
-  sizeCompareConArgs : {auto defs : Defs} -> Nat -> Term vars -> List (Term vars) -> Core Bool
-  sizeCompareApp : {auto defs : Defs} -> Nat -> Term vars -> Term vars -> Core SizeChange
-
-  sizeCompare fuel s (Erased _ (Dotted t)) = sizeCompare fuel s t
-  sizeCompare fuel _ (Erased {}) = pure Unknown -- incomparable!
-  -- for an as pattern, it's smaller if it's smaller than either part
-  sizeCompare fuel s (As _ _ p t)
-      = knownOr (sizeCompare fuel s p) (sizeCompare fuel s t)
-  sizeCompare fuel (As _ _ p s) t
-      = knownOr (sizeCompare fuel p t) (sizeCompare fuel s t)
-  -- if they're both metas, let sizeEq check if they're the same
-  sizeCompare fuel s@(Meta {}) t@(Meta {}) = pure (if sizeEq s t then Same else Unknown)
-  -- otherwise try to expand RHS meta
-  sizeCompare fuel s@(Meta n _ i args) t = do
-    Just gdef <- lookupCtxtExact (Resolved i) (gamma defs) | _ => pure Unknown
-    let (PMDef _ [] (STerm _ tm) _ _) = definition gdef | _ => pure Unknown
-    tm <- substMeta (embed tm) args zero Subst.empty
-    sizeCompare fuel tm t
+  findSC Guarded eqs pats (VDelay _ LInf _ tm)
+      = findSC InDelay eqs pats tm
+  findSC g eqs args (VBind _ _ (Lam _ _ _ _) sc)
+      = findSC g eqs args !(sc nextVar)
+  findSC g eqs args (VBind fc n b sc)
+      = do v <- nextVar
+           pure $ !(findSCbinder b) ++ !(findSC g eqs args !(sc (pure v)))
     where
-      substMeta : {0 drop, vs : _} ->
-                  Term (drop ++ vs) -> List (Term vs) ->
-                  SizeOf drop -> SubstEnv drop vs ->
-                  Core (Term vs)
-      substMeta (Bind bfc n (Lam _ c e ty) sc) (a :: as) drop env
-          = substMeta sc as (suc drop) (a :: env)
-      substMeta (Bind bfc n (Let _ c val ty) sc) as drop env
-          = substMeta (subst val sc) as drop env
-      substMeta rhs [] drop env = pure (substs drop env rhs)
-      substMeta rhs _ _ _ = throw (InternalError ("Badly formed metavar solution \{show n}"))
-
-  sizeCompare fuel s t
-     = if !(sizeCompareTyCon fuel s t) then pure Same
-       else if !(sizeCompareCon fuel s t)
-          then pure Smaller
-          else knownOr (sizeCompareApp fuel s t) (pure $ if sizeEq s t then Same else Unknown)
-
-  sizeCompareProdConArgs : {auto defs : Defs} -> Nat -> List (Term vars) -> List (Term vars) -> Core SizeChange
-  sizeCompareProdConArgs _ [] [] = pure Same
-  sizeCompareProdConArgs fuel (x :: xs) (y :: ys) =
-    case !(sizeCompare fuel x y) of
-      Unknown => pure Unknown
-      t => (t |*|) <$> sizeCompareProdConArgs fuel xs ys
-  sizeCompareProdConArgs _ _ _ = pure Unknown
-
-  sizeCompareTyCon fuel s t =
-    let (f, args) = getFnArgs t in
-    let (g, args') = getFnArgs s in
-    case f of
-      Ref _ (TyCon {}) cn => case g of
-        Ref _ (TyCon {}) cn' => if cn == cn'
-            then (Unknown /=) <$> sizeCompareProdConArgs fuel args' args
-            else pure False
-        _ => pure False
-      _ => pure False
+        findSCbinder : Binder (Glued [<]) -> Core (List SCCall)
+        findSCbinder (Let _ c val ty) = findSC Unguarded eqs args val
+        -- Idris2: findSCbinder (Let _ c val ty) = findSC g eqs args val
+        -- TODO: Why?
+        findSCbinder _ = pure [] -- only types, no need to look
+  findSC g eqs pats (VDelay _ _ _ tm)
+      = findSC g eqs pats tm
+  findSC g eqs pats (VForce _ _ v sp)
+      = do vCalls <- findSC Unguarded eqs pats v
+           spCalls <- findSCspine Unguarded eqs pats sp
+           pure (vCalls ++ spCalls)
+  findSC g eqs args (VCase fc ct c (VApp _ Bound n [<] _) scTy alts)
+      = do altCalls <- traverse (findSCalt g eqs args (Just n)) alts
+           pure (concat altCalls)
+  findSC g eqs args (VCase _ ct c (VApp fc Func fn sp _) scTy alts)
+      = do allg <- allGuarded fn
+           -- If it has the all guarded flag, pretend it's a data constructor
+           -- Otherwise just carry on as normal
+           scCalls <- if allg
+              then findSCapp g eqs args (VDCon fc fn 0 0 sp)
+              else case g of
+                      -- constructor guarded and delayed, so just check the
+                      -- arguments
+                      InDelay => findSCspine Unguarded eqs args sp
+                      _ => do fn_args <- traverseSnocList value sp
+                              findSCcall Unguarded eqs args fc fn (cast fn_args)
+
+           altCalls <- traverse (findSCalt g eqs args Nothing) alts
+           pure (scCalls ++ concat altCalls)
+    where
+      allGuarded : Name -> Core Bool
+      allGuarded n
+          = do defs <- get Ctxt
+               Just gdef <- lookupCtxtExact n (gamma defs)
+                    | Nothing => pure False
+               pure (AllGuarded `elem` flags gdef)
+
+  findSC g eqs args (VCase fc ct c sc scTy alts)
+      = do altCalls <- traverse (findSCalt g eqs args Nothing) alts
+           scCalls <- findSC Unguarded eqs args (asGlued sc)
+           pure (scCalls ++ concat altCalls)
+  findSC g eqs pats tm = findSCapp g eqs pats tm
+
+  findSCapp : {auto c : Ref Ctxt Defs} ->
+              {auto v : Ref SCVar Int} ->
+              Guardedness ->
+              ForcedEqs ->
+              List (Nat, Glued [<]) -> -- LHS args and their position
+              Glued [<] -> -- dealing with cases where this is an application
+                           -- of some sort
+              Core (List SCCall)
+  findSCapp g eqs pats (VLocal fc _ _ sp)
+      = do args <- traverseSnocList value sp
+           scs <- traverseSnocList (findSC g eqs pats) args
+           pure (concat scs)
+  findSCapp g eqs pats (VApp fc Bound _ sp _)
+      = do args <- traverseSnocList value sp
+           scs <- traverseSnocList (findSC g eqs pats) args
+           pure (concat scs)
+  -- If we're InDelay and find a constructor (or a function call which is
+  -- guaranteed to return a constructor; AllGuarded set), continue as InDelay
+  findSCapp InDelay eqs pats (VDCon fc n t a sp)
+      = findSCspine InDelay eqs pats sp
+  findSCapp Guarded eqs pats (VDCon fc n t a sp)
+      = do defs <- get Ctxt
+           findSCcall Guarded eqs pats fc n (toList !(traverseSnocList value sp))
+  findSCapp Toplevel eqs pats (VDCon fc n t a sp)
+      = do defs <- get Ctxt
+           findSCcall Guarded eqs pats fc n (toList !(traverseSnocList value sp))
+  findSCapp g eqs pats tm = pure [] -- not an application (TODO: VTCon)
+
+
+  findSCscope : {auto c : Ref Ctxt Defs} ->
+                {auto v : Ref SCVar Int} ->
+                Guardedness ->
+                ForcedEqs ->
+                List (Nat, Glued [<]) -> -- LHS args and their position
+                Maybe Name -> -- variable we're splitting on (if it is a variable)
+                FC -> Glued [<] ->
+                (args : _) -> VCaseScope args [<] -> -- case alternative
+                Core (List SCCall)
+  findSCscope g eqs args var fc pat [<] sc
+     = do (eqsc, rhs) <- sc
+          logC "totality.termination.sizechange" 10 $
+              (do tms <- traverse (\ (gx, gy) =>
+                              pure (!(toFullNames !(quote [<] gx)),
+                                    !(toFullNames !(quote [<] gy)))) eqsc
+                  pure ("Force equalities " ++ show tms))
+          let eqs' = eqsc ++ eqs
+          args' <- maybe (pure args) (\v => replaceInArgs v pat args) var
+          logNF "totality.termination.sizechange" 10 "RHS" [<] rhs
+          findSC g eqs'
+                 !(traverse (\ (n, arg) => pure (n, !(canonicalise eqs' arg))) args')
+                 rhs
+  findSCscope g eqs args var fc pat (cargs :< (c, xn)) sc
+     = do varg <- nextVar
+          pat' <- the (Core (Glued [<])) $ case pat of
+                    VDCon vfc n t a sp =>
+                        pure (VDCon vfc n t a (sp :< MkSpineEntry fc c (pure varg)))
+                    _ => throw (InternalError "Not a data constructor in findSCscope")
+          findSCscope g eqs args var fc pat' cargs (sc (pure varg))
+
+
+  findSCalt : {auto c : Ref Ctxt Defs} ->
+              {auto v : Ref SCVar Int} ->
+              Guardedness ->
+              ForcedEqs ->
+              List (Nat, Glued [<]) -> -- LHS args and their position
+              Maybe Name -> -- variable we're splitting on (if it is a variable)
+              VCaseAlt [<] -> -- case alternative
+              Core (List SCCall)
+  findSCalt g eqs args var (VConCase fc n t cargs sc)
+      = findSCscope g eqs args var fc (VDCon fc n t (length cargs) [<]) _ sc
+  findSCalt g eqs args var (VDelayCase fc ty arg tm)
+      = do targ <- nextVar
+           varg <- nextVar
+           let pat = VDelay fc LUnknown targ varg
+           (eqs, rhs) <- tm (pure targ) (pure varg)
+           findSC g eqs !(expandForced eqs
+                       !(maybe (pure args)
+                               (\v => replaceInArgs v pat args) var))
+                    rhs
+  findSCalt g eqs args var (VConstCase fc c tm)
+      = findSC g eqs !(maybe (pure args)
+                         (\v => replaceInArgs v (VPrimVal fc c) args) var)
+                 tm
+  findSCalt g eqs args var (VDefaultCase fc tm) = findSC g eqs args tm
+
+
+  findSCspine : {auto c : Ref Ctxt Defs} ->
+           {auto v : Ref SCVar Int} ->
+           Guardedness ->
+           ForcedEqs ->
+           List (Nat, Glued [<]) -> -- LHS args and their position
+           Spine [<] ->
+           Core (List SCCall)
+  findSCspine g eqs pats [<] = pure []
+  findSCspine g eqs pats (sp :< e)
+      = do vCalls <- findSC g eqs pats !(value e)
+           spCalls <- findSCspine g eqs pats sp
+           pure (vCalls ++ spCalls)
+
 
-  sizeCompareCon fuel s t
-      = let (f, args) = getFnArgs t in
-        case f of
-             Ref _ (DataCon t a) cn =>
-                -- if s is smaller or equal to an arg, then it is smaller than t
-                if !(sizeCompareConArgs (minus fuel 1) s args) then pure True
-                else let (g, args') = getFnArgs s in
-                    case (fuel, g) of
-                        (S k, Ref _ (DataCon t' a') cn') => do
-                                -- if s is a matching DataCon, applied to same number of args,
-                                -- no Unknown args, and at least one Smaller
-                                if cn == cn' && length args == length args'
-                                  then (Smaller ==) <$> sizeCompareProdConArgs k args' args
-                                  else pure False
-                        _ => pure $ False
-             _ => pure False
-
-  sizeCompareConArgs _ s [] = pure False
-  sizeCompareConArgs fuel s (t :: ts)
-      = case !(sizeCompare fuel s t) of
-          Unknown => sizeCompareConArgs fuel s ts
-          _ => pure True
-
-  sizeCompareApp fuel (App _ f _) t = sizeCompare fuel f t
-  sizeCompareApp _ _ t = pure Unknown
-
-  sizeCompareAsserted : {auto defs : Defs} -> Nat -> Maybe (Term vars) -> Term vars -> Core SizeChange
-  sizeCompareAsserted fuel (Just s) t
-      = pure $ case !(sizeCompare fuel s t) of
-          Unknown => Unknown
-          _ => Smaller
-  sizeCompareAsserted _ Nothing _ = pure Unknown
 
   -- if the argument is an 'assert_smaller', return the thing it's smaller than
-  asserted : Name -> Term vars -> Maybe (Term vars)
-  asserted aSmaller tm
-       = case getFnArgs tm of
-              (Ref _ nt fn, [_, _, b, _])
-                   => if fn == aSmaller
-                         then Just b
-                         else Nothing
-              _ => Nothing
-
-  -- Calculate the size change for the given argument.  i.e., return the
-  -- relative size of the given argument to each entry in 'pats'.
-  mkChange : Defs -> Name ->
-             (pats : List (Term vars)) ->
-             (arg : Term vars) ->
+  asserted : ForcedEqs -> Name -> Glued [<] -> Core (Maybe (Glued [<]))
+  asserted eqs aSmaller (VApp _ nt fn [<_, _, e, _] _)
+       = if fn == aSmaller
+            then Just <$> canonicalise eqs !(value e)
+            else pure Nothing
+  asserted _ _ _ = pure Nothing
+
+  -- Calculate the size change for the given argument.
+  -- i.e., return the size relationship of the given argument with an entry
+  -- in 'pats'; the position in 'pats' and the size change.
+  -- Nothing if there is no relation with any of them.
+  mkChange : {auto c : Ref Ctxt Defs} ->
+             ForcedEqs ->
+             Name ->
+             (pats : List (Nat, Glued [<])) ->
+             (arg : Glued [<]) ->
              Core (List SizeChange)
-  mkChange defs aSmaller pats arg
-    = let fuel = defs.options.elabDirectives.totalLimit
-      in traverse (\p => plusLazy (sizeCompareAsserted fuel (asserted aSmaller arg) p) (sizeCompare fuel arg p)) pats
-
-  -- Given a name of a case function, and a list of the arguments being
-  -- passed to it, update the pattern list so that it's referring to the LHS
-  -- of the case block function and return the corresponding RHS.
-
-  -- This way, we can build case blocks directly into the size change graph
-  -- rather than treating the definitions separately.
-  getCasePats : {auto c : Ref Ctxt Defs} ->
-                {vars : _} ->
-                Defs -> Name -> List (Term vars) ->
-                List (Term vars) ->
-                Core (Maybe (List (vs ** (Env Term vs,
-                                         List (Term vs), Term vs))))
-
-  getCasePats {vars} defs n pats args
-      = do Just (PMDef _ _ _ _ pdefs) <- lookupDefExact n (gamma defs)
-             | _ => pure Nothing
-           log "totality" 20 $
-             unwords ["Looking at the", show (length pdefs), "cases of", show  n]
-           let pdefs' = map matchArgs pdefs
-           logC "totality" 20 $ do
-              old <- for pdefs $ \ (_ ** (_, lhs, rhs)) => do
-                       lhs <- toFullNames lhs
-                       rhs <- toFullNames rhs
-                       pure $ "    " ++ show lhs ++ " => " ++ show rhs
-              new <- for pdefs' $ \ (_ ** (_, lhs, rhs)) => do
-                       lhs <- traverse toFullNames lhs
-                       rhs <- toFullNames rhs
-                       pure $ "    " ++ show lhs ++ " => " ++ show rhs
-              pure $ unlines $ "Updated" :: old ++ "  to:" :: new
-           pure $ Just pdefs'
-
-    where
-      updateRHS : {vs, vs' : _} ->
-                  List (Term vs, Term vs') -> Term vs -> Term vs'
-      updateRHS {vs} {vs'} ms tm
-          = case lookupTm tm ms of
-                 Nothing => urhs tm
-                 Just t => t
-        where
-          urhs : Term vs -> Term vs'
-          urhs (Local fc _ _ _) = Erased fc Placeholder
-          urhs (Ref fc nt n) = Ref fc nt n
-          urhs (Meta fc m i margs) = Meta fc m i (map (updateRHS ms) margs)
-          urhs (App fc f a) = App fc (updateRHS ms f) (updateRHS ms a)
-          urhs (As fc s a p) = As fc s (updateRHS ms a) (updateRHS ms p)
-          urhs (TDelayed fc r ty) = TDelayed fc r (updateRHS ms ty)
-          urhs (TDelay fc r ty tm)
-              = TDelay fc r (updateRHS ms ty) (updateRHS ms tm)
-          urhs (TForce fc r tm) = TForce fc r (updateRHS ms tm)
-          urhs (Bind fc x b sc)
-              = Bind fc x (map (updateRHS ms) b)
-                  (updateRHS (map (\vt => (weaken (fst vt), weaken (snd vt))) ms) sc)
-          urhs (PrimVal fc c) = PrimVal fc c
-          urhs (Erased fc Impossible) = Erased fc Impossible
-          urhs (Erased fc Placeholder) = Erased fc Placeholder
-          urhs (Erased fc (Dotted t)) = Erased fc (Dotted (updateRHS ms t))
-          urhs (TType fc u) = TType fc u
-
-          lookupTm : Term vs -> List (Term vs, Term vs') -> Maybe (Term vs')
-          lookupTm tm [] = Nothing
-          lookupTm (As fc s p tm) tms -- Want to keep the pattern and the variable,
-                                      -- if there was an @ in the parent
-              = do tm' <- lookupTm tm tms
-                   Just $ As fc s tm' (urhs tm)
-          lookupTm tm ((As fc s p tm', v) :: tms)
-              = if tm == p
-                   then Just v
-                   else do tm' <- lookupTm tm ((tm', v) :: tms)
-                           Just $ As fc s (urhs p) tm'
-          lookupTm tm ((tm', v) :: tms)
-              = if tm == tm'
-                   then Just v
-                   else lookupTm tm tms
-
-      updatePat : {vs, vs' : _} ->
-                  List (Term vs, Term vs') -> Term vs -> Term vs'
-      updatePat ms tm = updateRHS ms tm
-
-      matchArgs : (vs ** (Env Term vs, Term vs, Term vs)) ->
-                  (vs ** (Env Term vs, List (Term vs), Term vs))
-      matchArgs (_ ** (env', lhs, rhs))
-         = let patMatch = reverse (zip args (getArgs lhs)) in
-               (_ ** (env', map (updatePat patMatch) pats, rhs))
-
-  findSCcall : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               Defs -> Env Term vars -> Guardedness ->
-               List (Term vars) ->
-               FC -> Name -> List (Term vars) ->
-               Core (List SCCall)
-  findSCcall defs env g pats fc fn_in args
-        -- Under 'assert_total' we assume that all calls are fine, so leave
-        -- the size change list empty
-      = do fn <- getFullName fn_in
-           logC "totality.termination.sizechange" 10 $ do pure $ "Looking under " ++ show !(toFullNames fn)
-           aSmaller <- resolved (gamma defs) (NS builtinNS (UN $ Basic "assert_smaller"))
-           if caseFn fn
-              then do scs1 <- traverse (findSC defs env g pats) args
-                      mps  <- getCasePats defs fn pats args
-                      scs2 <- traverse (findInCase defs g) $ fromMaybe [] mps
-                      pure (concat (scs1 ++ scs2))
-              else do scs <- traverse (findSC defs env g pats) args
-                      pure $ [MkSCCall fn
-                               (fromListList
-                                    !(traverse (mkChange defs aSmaller pats) args))
-                               fc]
-                               ++ concat scs
-
-  findInCase : {auto c : Ref Ctxt Defs} ->
-               Defs -> Guardedness ->
-               (vs ** (Env Term vs, List (Term vs), Term vs)) ->
+  mkChange eqs aSmaller pats arg
+    = do defs <- get Ctxt
+         let fuel = defs.options.elabDirectives.totalLimit
+         res <- traverse (\(n, p) => pure (n, !(plusLazy (sizeCompareAsserted fuel !(asserted eqs aSmaller arg) p) (sizeCompare fuel arg p)))) pats
+         let squashed = fromListWith (|+|) res
+         pure $ toList squashed
+
+  findSCcall : {auto c : Ref Ctxt Defs} ->
+               {auto v : Ref SCVar Int} ->
+               Guardedness ->
+               ForcedEqs ->
+               List (Nat, Glued [<]) ->
+               FC -> Name -> List (Glued [<]) ->
                Core (List SCCall)
-  findInCase defs g (_ ** (env, pats, tm))
-     = do logC "totality" 10 $
-                   do ps <- traverse toFullNames pats
-                      pure ("Looking in case args " ++ show ps)
-          logTermNF "totality" 10 "        =" env tm
-          rhs <- normaliseOpts tcOnly defs env tm
-          findSC defs env g pats (delazy defs rhs)
-
-findCalls : {auto c : Ref Ctxt Defs} ->
-            Defs -> (vars ** (Env Term vars, Term vars, Term vars)) ->
-            Core (List SCCall)
-findCalls defs (_ ** (env, lhs, rhs_in))
-   = do let pargs = getArgs (delazy defs lhs)
-        rhs <- normaliseOpts tcOnly defs env rhs_in
-        findSC defs env Toplevel pargs (delazy defs rhs)
+  findSCcall g eqs pats fc fn_in args
+          -- Under 'assert_total' we assume that all calls are fine, so leave
+          -- the size change list empty
+        = do args <- traverse (canonicalise eqs) args
+             defs <- get Ctxt
+             fn <- getFullName fn_in
+             logC "totality.termination.sizechange" 10 $ do pure "Looking under \{show fn}"
+             aSmaller <- resolved (gamma defs) (NS builtinNS (UN $ Basic "assert_smaller"))
+             logC "totality.termination.sizechange" 10 $
+                 do under <- traverse (\ (n, t) =>
+                                pure (n, !(toFullNames !(quote [<] t)))) pats
+                    targs <- traverse (\t => toFullNames !(quote [<] t)) args
+                    pure ("Under " ++ show under ++ "\n" ++ "Args " ++ show targs)
+             if isAssertTotal fn
+                then pure []
+                else
+                 do scs <- traverse (findSC g eqs pats) args
+                    pure ([MkSCCall fn
+                             (fromListList
+                                   !(traverse (mkChange eqs aSmaller pats) args))
+                             fc] ++ concat scs)
+
+findSCTop : {auto c : Ref Ctxt Defs} ->
+            {auto v : Ref SCVar Int} ->
+            Nat -> List (Nat, Glued [<]) -> Glued [<] -> Core (List SCCall)
+findSCTop i args (VBind _ _ (Lam _ _ _ _) sc)
+    = do arg <- nextVar
+         findSCTop (i + 1) ((i, arg) :: args) !(sc $ pure arg)
+findSCTop i args def = findSC Toplevel [] (reverse args) def
 
 getSC : {auto c : Ref Ctxt Defs} ->
         Defs -> Def -> Core (List SCCall)
-getSC defs (PMDef _ args _ _ pats)
-   = do sc <- traverse (findCalls defs) pats
-        pure $ nub (concat sc)
+getSC defs (Function _ tm _ _)
+   = do ntm <- nfTotality [<] tm
+        logNF "totality.termination.sizechange" 5 "From tree" [<] ntm
+        v <- newRef SCVar 0
+        sc <- findSCTop 0 [] ntm
+        pure $ nub sc
 getSC defs _ = pure []
 
 export
@@ -411,4 +541,6 @@ calculateSizeChange loc n
          defs <- get Ctxt
          Just def <- lookupCtxtExact n (gamma defs)
               | Nothing => undefinedName loc n
-         getSC defs (definition def)
+         r <- getSC defs (definition def)
+         log "totality.termination.sizechange" 5 $ "Calculated: " ++ show r
+         pure r
diff --git a/src/Core/Termination/Positivity.idr b/src/Core/Termination/Positivity.idr
index c81cf8d66e0..ef986721879 100644
--- a/src/Core/Termination/Positivity.idr
+++ b/src/Core/Termination/Positivity.idr
@@ -2,8 +2,10 @@ module Core.Termination.Positivity
 
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
+import Core.Evaluate
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Core.Termination.References
 
@@ -13,126 +15,121 @@ import Libraries.Data.NatSet
 
 %default covering
 
-isAssertTotal : Ref Ctxt Defs => NHead vars -> Core Bool
-isAssertTotal (NRef _ fn_in) =
+isAssertTotal : Ref Ctxt Defs => Name -> Core Bool
+isAssertTotal fn_in =
   do fn <- getFullName fn_in
      pure (fn == NS builtinNS (UN $ Basic "assert_total"))
-isAssertTotal _ = pure False
 
 nameIn : {auto c : Ref Ctxt Defs} ->
-         Defs -> List Name -> ClosedNF -> Core Bool
-nameIn defs tyns (NBind fc x b sc)
-    = if !(nameIn defs tyns !(evalClosure defs (binderType b)))
+         List Name -> NF [<] -> Core Bool
+nameIn tyns (VBind fc x b sc)
+    = if !(nameIn tyns !(expand (binderType b)))
          then pure True
-         else do let nm = Ref fc Bound (MN ("NAMEIN_" ++ show x) 0)
-                 let arg = toClosure defaultOpts Env.empty nm
-                 sc' <- sc defs arg
-                 nameIn defs tyns sc'
-nameIn defs tyns (NApp _ nh args)
-    = do False <- isAssertTotal nh
+         else do sc' <- sc (pure (vRef fc Bound (MN ("NAMEIN_" ++ show x) 0)))
+                 nameIn tyns !(expand sc')
+nameIn tyns (VApp _ nt n args _)
+    = do False <- isAssertTotal n
            | True => pure False
-         anyM (nameIn defs tyns)
-           !(traverse (evalClosure defs . snd) args)
-nameIn defs tyns (NTCon _ n _ args)
+         Core.Core.anyM (nameIn tyns) (cast !(traverseSnocList spineVal args))
+nameIn tyns (VTCon _ n _ args)
     = if n `elem` tyns
          then pure True
-         else do args' <- traverse (evalClosure defs . snd) args
-                 anyM (nameIn defs tyns) args'
-nameIn defs tyns (NDCon _ n _ _ args)
-    = anyM (nameIn defs tyns)
-           !(traverse (evalClosure defs . snd) args)
-nameIn defs tyns (NDelayed fc lr ty) = nameIn defs tyns ty
-nameIn defs tyns (NDelay fc lr ty tm) = nameIn defs tyns !(evalClosure defs tm)
-nameIn defs tyns _ = pure False
+         else do args' <- traverseSnocList spineVal args
+                 Core.Core.anyM (nameIn tyns) (cast args')
+nameIn tyns (VDCon _ n _ _ args)
+    = Core.Core.anyM (nameIn tyns)
+           (cast !(traverseSnocList spineVal args))
+nameIn tyns (VDelayed fc lr ty) = nameIn tyns !(expand ty)
+nameIn tyns (VDelay fc lr ty tm) = nameIn tyns !(expand tm)
+nameIn tyns _ = pure False
 
 -- Check an argument type doesn't contain a negative occurrence of any of
 -- the given type names
 posArg  : {auto c : Ref Ctxt Defs} ->
-          Defs -> List Name -> ClosedNF -> Core Terminating
+          List Name -> NF [<] -> Core Terminating
 
 posArgs : {auto c : Ref Ctxt Defs} ->
-          Defs -> List Name -> List ClosedClosure -> Core Terminating
-posArgs defs tyn [] = pure IsTerminating
-posArgs defs tyn (x :: xs)
-  = do xNF <- evalClosure defs x
+          List Name -> SnocList (Glued [<]) -> Core Terminating
+posArgs tyn [<] = pure IsTerminating
+posArgs tyn (xs :< x)
+  = do xNF <- expand x
        logNF "totality.positivity" 50 "Checking parameter for positivity" Env.empty xNF
-       IsTerminating <- posArg defs tyn xNF
+       IsTerminating <- posArg tyn xNF
           | err => pure err
-       posArgs defs tyn xs
+       posArgs tyn xs
 
 -- a tyn can only appear in the parameter positions of
 -- tc; report positivity failure if it appears anywhere else
-posArg defs tyns nf@(NTCon loc tc _ args) =
+posArg tyns nf@(VTCon loc tc _ args) =
   do logNF "totality.positivity" 50 "Found a type constructor" Env.empty nf
+     defs <- get Ctxt
      testargs <- case !(lookupDefExact tc (gamma defs)) of
                     Just (TCon _ params _ _ _ _ _) => do
-                         log "totality.positivity" 50 $
-                           unwords [show tc, "has", show (size params), "parameters"]
-                         pure $ NatSet.partition params (map snd args)
+                         logC "totality.positivity" 50 $
+                           do pure $ unwords [show tc, "has", show (NatSet.size params), "parameters"]
+                         pure $ NatSet.partition params !(traverseSnocList value args)
                     _ => throw (GenericMsg loc (show tc ++ " not a data type"))
      let (params, indices) = testargs
-     False <- anyM (nameIn defs tyns) !(traverse (evalClosure defs) indices)
+     False <- Core.Core.anyM (nameIn tyns) (cast !(traverseSnocList expand indices))
        | True => pure (NotTerminating NotStrictlyPositive)
-     posArgs defs tyns params
+     posArgs tyns params
 -- a tyn can not appear as part of ty
-posArg defs tyns nf@(NBind fc x (Pi _ _ e ty) sc)
+posArg tyns nf@(VBind fc x (Pi _ _ e ty) sc)
   = do logNF "totality.positivity" 50 "Found a Pi-type" Env.empty nf
-       if !(nameIn defs tyns !(evalClosure defs ty))
+       if !(nameIn tyns !(expand ty))
          then pure (NotTerminating NotStrictlyPositive)
-         else do let nm = Ref fc Bound (MN ("POSCHECK_" ++ show x) 1)
-                 let arg = toClosure defaultOpts Env.empty nm
-                 sc' <- sc defs arg
-                 posArg defs tyns sc'
-posArg defs tyns nf@(NApp fc nh args)
-    = do False <- isAssertTotal nh
+         else do sc' <- sc (pure (vRef fc Bound (MN ("POSCHECK_" ++ show x) 1)))
+                 posArg tyns !(expand sc')
+posArg tyns nf@(VApp _ _ n args _)
+    = do False <- isAssertTotal n
            | True => do logNF "totality.positivity" 50 "Trusting an assertion" Env.empty nf
                         pure IsTerminating
          logNF "totality.positivity" 50 "Found an application" Env.empty nf
-         args <- traverse (evalClosure defs . snd) args
-         pure $ if !(anyM (nameIn defs tyns) args)
+         args <- traverseSnocList spineVal args
+         pure $ if !(Core.Core.anyM (nameIn tyns) (cast args))
            then NotTerminating NotStrictlyPositive
            else IsTerminating
-posArg defs tyn (NDelayed fc lr ty) = posArg defs tyn ty
-posArg defs tyn nf
+posArg tyn (VDelayed _ _ ty) = posArg tyn !(expand ty)
+posArg tyn nf
   = do logNF "totality.positivity" 50 "Reached the catchall" Env.empty nf
        pure IsTerminating
 
 checkPosArgs : {auto c : Ref Ctxt Defs} ->
-               Defs -> List Name -> ClosedNF -> Core Terminating
-checkPosArgs defs tyns (NBind fc x (Pi _ _ e ty) sc)
-    = case !(posArg defs tyns !(evalClosure defs ty)) of
+               List Name -> NF [<] -> Core Terminating
+checkPosArgs tyns (VBind fc x (Pi _ _ e ty) sc)
+    = case !(posArg tyns !(expand ty)) of
            IsTerminating =>
-               do let nm = Ref fc Bound (MN ("POSCHECK_" ++ show x) 0)
-                  let arg = toClosure defaultOpts Env.empty nm
-                  checkPosArgs defs tyns !(sc defs arg)
+               do let nm = vRef fc Bound (MN ("POSCHECK_" ++ show x) 0)
+                  checkPosArgs tyns !(expand !(sc (pure nm)))
            bad => pure bad
-checkPosArgs defs tyns nf
+checkPosArgs tyns nf
   = do logNF "totality.positivity" 50 "Giving up on non-Pi type" Env.empty nf
        pure IsTerminating
 
 checkCon : {auto c : Ref Ctxt Defs} ->
-           Defs -> List Name -> Name -> Core Terminating
-checkCon defs tyns cn
-    = case !(lookupTyExact cn (gamma defs)) of
-        Nothing => do log "totality.positivity" 20 $
-                        "Couldn't find constructor " ++ show cn
-                      pure Unchecked
-        Just ty =>
-          case !(totRefsIn defs ty) of
-            IsTerminating =>
-              do tyNF <- nf defs Env.empty ty
-                 logNF "totality.positivity" 20 "Checking the type " Env.empty tyNF
-                 checkPosArgs defs tyns tyNF
-            bad => pure bad
+           List Name -> Name -> Core Terminating
+checkCon tyns cn
+    = do defs <- get Ctxt
+         case !(lookupTyExact cn (gamma defs)) of
+           Nothing => do log "totality.positivity" 20 $
+                           "Couldn't find constructor " ++ show cn
+                         pure Unchecked
+           Just ty =>
+             case !(totRefsIn defs ty) of
+                IsTerminating =>
+                  do tyNF <- nf Env.empty ty
+                     logNF "totality.positivity" 20 "Checking the type " [<] tyNF
+                     checkPosArgs tyns !(expand tyNF)
+                bad => pure bad
 
 checkData : {auto c : Ref Ctxt Defs} ->
-            Defs -> List Name -> List Name -> Core Terminating
-checkData defs tyns [] = pure IsTerminating
-checkData defs tyns (c :: cs)
+            List Name -> List Name -> Core Terminating
+checkData tyns [] = pure IsTerminating
+checkData tyns (c :: cs)
     = do log "totality.positivity" 40 $
            "Checking positivity of constructor " ++ show c
-         case !(checkCon defs tyns c) of
-           IsTerminating => checkData defs tyns cs
+         case !(checkCon tyns c) of
+           IsTerminating => checkData tyns cs
            bad => pure bad
 
 blockingAssertTotal : {auto c : Ref Ctxt Defs} -> FC -> Core a -> Core a
@@ -153,15 +150,15 @@ calcPositive : {auto c : Ref Ctxt Defs} ->
                FC -> Name -> Core (Terminating, List Name)
 calcPositive loc n
     = do defs <- get Ctxt
-         logC "totality.positivity" 6 $ do pure $ "Calculating positivity: " ++ show !(toFullNames n)
+         logC "totality.positivity" 6 $ do pure $ "Calculating positivity: \{show !(toFullNames n)}"
          case !(lookupDefTyExact n (gamma defs)) of
               Just (TCon _ _ _ _ tns dcons _, ty) =>
                   let dcons = fromMaybe [] dcons in
                   case !(totRefsIn defs ty) of
                        IsTerminating =>
-                            do log "totality.positivity" 30 $
-                                 "Now checking constructors of " ++ show !(toFullNames n)
-                               t <- blockingAssertTotal loc $ checkData defs (n :: tns) dcons
+                            do logC "totality.positivity" 30 $
+                                 do pure $ "Now checking constructors of \{show !(toFullNames n)}"
+                               t <- blockingAssertTotal loc $ checkData (n :: tns) dcons
                                pure (t , dcons)
                        bad => pure (bad, dcons)
               Just _ => throw (GenericMsg loc (show n ++ " not a data type"))
diff --git a/src/Core/Transform.idr b/src/Core/Transform.idr
index 2d0904a0b94..18c6fdace28 100644
--- a/src/Core/Transform.idr
+++ b/src/Core/Transform.idr
@@ -3,13 +3,15 @@ module Core.Transform
 import Core.Context
 import Core.Env
 
+import Data.Vect
+
 import Libraries.Data.NameMap
 
 %default total
 
-unload : List (FC, Term vars) -> Term vars -> Term vars
+unload : List (FC, RigCount, Term vars) -> Term vars -> Term vars
 unload [] fn = fn
-unload ((fc, arg) :: args) fn = unload args (App fc fn arg)
+unload ((fc, c, arg) :: args) fn = unload args (App fc fn c arg)
 
 -- List of matches on LHS
 data MatchVars : Scope -> Scope -> Type where
@@ -40,7 +42,7 @@ match : MatchVars vars vs ->
         Term vars -> Term vs -> Maybe (MatchVars vars vs)
 match ms (Local _ _ idx p) val
     = addMatch idx p val ms
-match ms (App _ f a) (App _ f' a')
+match ms (App _ f _ a) (App _ f' _ a')
     = do ms' <- match ms f f'
          match ms' a a'
 match ms x y
@@ -53,20 +55,20 @@ tryReplace : MatchVars vars vs -> Term vars -> Maybe (Term vs)
 tryReplace ms (Local _ _ idx p) = lookupMatch idx p ms
 tryReplace ms (Ref fc nt n) = pure (Ref fc nt n)
 tryReplace ms (Meta fc n i as)
-    = do as' <- traverse (tryReplace ms) as
+    = do as' <- traverse @{Compose} (tryReplace ms) as
          pure (Meta fc n i as')
 tryReplace ms (Bind fc x b sc)
     = Nothing -- TODO: can't do this yet... need to be able to weaken ms
               -- Rules are unlikely to have binders usually but we should
               -- still support it eventually
-tryReplace ms (App fc f a)
+tryReplace ms (App fc f c a)
     = do f' <- tryReplace ms f
          a' <- tryReplace ms a
-         pure (App fc f' a')
+         pure (App fc f' c a')
 tryReplace ms (As fc s a p)
-    = do a' <- tryReplace ms a
-         p' <- tryReplace ms p
-         pure (As fc s a' p')
+    = Nothing -- No 'As' on RHS of a rule
+tryReplace ms (Case{})
+    = Nothing -- As for 'Bind', can't do this yet
 tryReplace ms (TDelayed fc r tm)
     = do tm' <- tryReplace ms tm
          pure (TDelayed fc r tm')
@@ -78,9 +80,13 @@ tryReplace ms (TForce fc r tm)
     = do tm' <- tryReplace ms tm
          pure (TForce fc r tm')
 tryReplace ms (PrimVal fc c) = pure (PrimVal fc c)
+tryReplace ms (PrimOp fc fn args)
+    = do args' <- traverse (tryReplace ms) args
+         pure (PrimOp fc fn args')
 tryReplace ms (Erased fc Impossible) = pure (Erased fc Impossible)
 tryReplace ms (Erased fc Placeholder) = pure (Erased fc Placeholder)
 tryReplace ms (Erased fc (Dotted t)) = Erased fc . Dotted <$> tryReplace ms t
+tryReplace ms (Unmatched fc s) = pure (Unmatched fc s)
 tryReplace ms (TType fc u) = pure (TType fc u)
 
 covering
@@ -90,9 +96,9 @@ tryApply trans@(MkTransform {vars} n _ lhs rhs) tm
           Just ms => tryReplace ms rhs
           Nothing =>
             case tm of
-                 App fc f a =>
+                 App fc f c a =>
                      do f' <- tryApply trans f
-                        Just (App fc f' a)
+                        Just (App fc f' c a)
                  _ => Nothing
 
 covering
@@ -108,7 +114,7 @@ data Upd : Type where
 covering
 trans : {auto c : Ref Ctxt Defs} ->
         {auto u : Ref Upd Bool} ->
-        Env Term vars -> List (FC, Term vars) -> Term vars ->
+        Env Term vars -> List (FC, RigCount, Term vars) -> Term vars ->
         Core (Term vars)
 trans env stk (Ref fc Func fn)
     = do defs <- get Ctxt
@@ -119,15 +125,15 @@ trans env stk (Ref fc Func fn)
                             update Upd (|| u)
                             pure tm'
 trans env stk (Meta fc n i args)
-    = do args' <- traverse (trans env []) args
+    = do args' <- traverse (traversePair $ trans env []) args
          pure $ unload stk (Meta fc n i args')
 trans env stk (Bind fc x b sc)
     = do b' <- traverse (trans env []) b
-         sc' <- trans (b' :: env) [] sc
+         sc' <- trans (Env.bind env b') [] sc
          pure $ unload stk (Bind fc x b' sc')
-trans env stk (App fc fn arg)
+trans env stk (App fc fn c arg)
     = do arg' <- trans env [] arg
-         trans env ((fc, arg') :: stk) fn
+         trans env ((fc, c, arg') :: stk) fn
 trans env stk (TDelayed fc r tm)
     = do tm' <- trans env [] tm
          pure $ unload stk (TDelayed fc r tm')
diff --git a/src/Core/Unify.idr b/src/Core/Unify.idr
index adf9a204a3c..1be5878abb8 100644
--- a/src/Core/Unify.idr
+++ b/src/Core/Unify.idr
@@ -1,22 +1,28 @@
 module Core.Unify
 
-import Core.Case.CaseTree
 import Core.Context.Log
 import Core.Env
-import Core.GetType
-import Core.Normalise
 import Core.Options
+import Core.TT.Binder
 import public Core.UnifyState
-import Core.Value
 
 import Data.Maybe
-
-import Libraries.Data.List.SizeOf
-
+import Data.Vect
+
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Convert
+import Core.Evaluate.Expand
+import Core.Evaluate
+import Data.SnocList
+import Data.SnocList.Quantifiers
+
+import Libraries.Data.SnocList.SizeOf
 import Libraries.Data.VarSet
-
 import Libraries.Data.IntMap
 import Libraries.Data.NameMap
+import Libraries.Data.NatSet
 
 %default covering
 
@@ -69,6 +75,9 @@ Show UnifyMode where
   show InMatch = "InMatch"
   show InSearch = "InSearch"
 
+Show UnifyInfo where
+  show (MkUnifyInfo t u) = "{UnifyInfo atTop=\{show t} umode=\{show u}}"
+
 -- If we're unifying a Lazy type with a non-lazy type, we need to add an
 -- explicit force or delay to the first argument to unification. This says
 -- which to add, if any. Can only added at the very top level.
@@ -89,6 +98,13 @@ record UnifyResult where
   namesSolved : List Int -- which ones did we solve (as name indices)
   addLazy : AddLazy
 
+export
+Show UnifyResult where
+  show a = "constraints: " ++ show a.constraints
+    ++ ", holesSolved: " ++ show a.holesSolved
+    ++ ", namesSolved: " ++ show a.namesSolved
+    ++ ", addLazy: " ++ show a.addLazy
+
 union : UnifyResult -> UnifyResult -> UnifyResult
 union u1 u2 = MkUnifyResult (union (constraints u1) (constraints u2))
                             (holesSolved u1 || holesSolved u2)
@@ -130,57 +146,58 @@ interface Unify tm where
                    Core UnifyResult
   unifyWithLazyD = unifyD
 
--- Workaround for auto implicits not working in interfaces
--- In calls to unification, the first argument is the given type, and the second
--- argument is the expected type.
-export
-unify : Unify tm =>
-        {vars : _} ->
-        {auto c : Ref Ctxt Defs} ->
-        {auto u : Ref UST UState} ->
-        UnifyInfo ->
-        FC -> Env Term vars ->
-        tm vars -> tm vars ->
-        Core UnifyResult
-unify {c} {u} = unifyD c u
+parameters {auto c : Ref Ctxt Defs} {auto u : Ref UST UState}
+  -- Defined in Core.AutoSearch
+  export
+  search : {vars : _} ->
+           FC -> RigCount ->
+           (defaults : Bool) -> (depth : Nat) ->
+           (defining : Name) -> (topTy : Term vars) -> Env Term vars ->
+           Core (Term vars)
+
+  -- TODO: Should we prefer interface here?
+  -- Blindly copied from Yaffle
+  namespace Value
+    export
+    unify : {vars : _} ->
+            UnifyInfo -> FC -> Env Term vars ->
+            Value f vars -> Value f' vars -> Core UnifyResult
 
-export
-unifyWithLazy : Unify tm =>
-                {vars : _} ->
-                {auto c : Ref Ctxt Defs} ->
-                {auto u : Ref UST UState} ->
-                UnifyInfo ->
-                FC -> Env Term vars ->
-                tm vars -> tm vars ->
-                Core UnifyResult
-unifyWithLazy {c} {u} = unifyWithLazyD c u
+    export
+    unifyWithLazy : {vars : _} ->
+            UnifyInfo -> FC -> Env Term vars ->
+            Value f vars -> Value f' vars -> Core UnifyResult
 
--- Defined in Core.AutoSearch
-export
-search : {vars : _} ->
-         {auto c : Ref Ctxt Defs} ->
-         {auto u : Ref UST UState} ->
-         FC -> RigCount ->
-         (defaults : Bool) -> (depth : Nat) ->
-         (defining : Name) -> (topTy : Term vars) -> Env Term vars ->
-         Core (Term vars)
+  namespace Term
+    export
+    unify : {vars : _} ->
+            UnifyInfo -> FC -> Env Term vars ->
+            Term vars -> Term vars -> Core UnifyResult
+    export
+    unifyWithLazy : {vars : _} ->
+            UnifyInfo -> FC -> Env Term vars ->
+            Term vars -> Term vars -> Core UnifyResult
 
 ufail : FC -> String -> Core a
 ufail loc msg = throw (GenericMsg loc msg)
 
 convertError : {vars : _} ->
                {auto c : Ref Ctxt Defs} ->
-               FC -> Env Term vars -> NF vars -> NF vars -> Core a
+               FC -> Env Term vars -> Value f vars -> Value f' vars -> Core a
 convertError loc env x y
     = do defs <- get Ctxt
-         empty <- clearDefs defs
-         throw (CantConvert loc (gamma defs)
-                                env !(quote empty env x)
-                                    !(quote empty env y))
+         throw (CantConvert loc (gamma defs) env !(quote env x) !(quote env y))
+
+convertGluedError : {vars : _} ->
+                    {auto c : Ref Ctxt Defs} ->
+                    FC -> Env Term vars -> Glued vars -> Glued vars -> Core a
+convertGluedError loc env x y
+    = do defs <- get Ctxt
+         throw (CantConvert loc (gamma defs) env !(quote env x) !(quote env y))
 
 convertErrorS : {vars : _} ->
                 {auto c : Ref Ctxt Defs} ->
-                Bool -> FC -> Env Term vars -> NF vars -> NF vars -> Core a
+                Bool -> FC -> Env Term vars -> Value f vars -> Value f' vars -> Core a
 convertErrorS s loc env x y
     = if s then convertError loc env y x
            else convertError loc env x y
@@ -194,8 +211,7 @@ chaseMetas (n :: ns) all
     = case lookup n all of
            Just _ => chaseMetas ns all
            _ => do defs <- get Ctxt
-                   Just (PMDef _ _ (STerm _ soln) _ _) <-
-                                  lookupDefExact n (gamma defs)
+                   Just (Function _ soln _ _) <- lookupDefExact n (gamma defs)
                         | _ => chaseMetas ns (insert n () all)
                    let sns = keys (getMetas soln)
                    chaseMetas (sns ++ ns) (insert n () all)
@@ -212,29 +228,30 @@ postpone : {vars : _} ->
            {auto c : Ref Ctxt Defs} ->
            {auto u : Ref UST UState} ->
            FC -> UnifyInfo -> String ->
-           Env Term vars -> NF vars -> NF vars -> Core UnifyResult
+           Env Term vars -> Value f vars -> Value f' vars -> Core UnifyResult
 postpone loc mode logstr env x y
-    = do defs <- get Ctxt
-         empty <- clearDefs defs
+    = do log "unify.postpone" 10 $ "Begin postponing \"\{logstr}\""
+         defs <- get Ctxt
+         xtm <- quote env x
+         ytm <- quote env y
          logC "unify.postpone" 10 $
-              do xq <- quote defs env x
-                 yq <- quote defs env y
-                 pure (logstr ++ ": " ++ show !(toFullNames xq) ++
-                                    " =?= " ++ show !(toFullNames yq))
+              do xf <- toFullNames xtm
+                 yf <- toFullNames ytm
+                 pure (logstr ++ ": " ++ show xf ++ " =?= " ++ show yf)
 
          -- If we're blocked because a name is undefined, give up
          checkDefined defs x
          checkDefined defs y
 
-         c <- addConstraint (MkConstraint loc (atTop mode) env x y)
+         c <- addConstraint (MkConstraint loc (atTop mode) env xtm ytm)
          log "unify.postpone" 10 $
                  show c ++ " NEW CONSTRAINT " ++ show loc
-         logNF "unify.postpone" 10 "X" env x
-         logNF "unify.postpone" 10 "Y" env y
+         logTerm "unify.postpone" 10 "X" xtm
+         logTerm "unify.postpone" 10 "Y" ytm
          pure (constrain c)
   where
-    checkDefined : Defs -> NF vars -> Core ()
-    checkDefined defs (NApp _ (NRef _ n) _)
+    checkDefined : forall f . Defs -> Value f vars -> Core ()
+    checkDefined defs (VApp _ _ n _ _)
         = do Just _ <- lookupCtxtExact n (gamma defs)
                   | _ => undefinedName loc n
              pure ()
@@ -253,53 +270,181 @@ postponeS : {vars : _} ->
             {auto c : Ref Ctxt Defs} ->
             {auto u : Ref UST UState} ->
             Bool -> FC -> UnifyInfo -> String -> Env Term vars ->
-            NF vars -> NF vars ->
+            Value f vars -> Value f' vars ->
             Core UnifyResult
 postponeS s loc mode logstr env x y
     = if s then postpone loc (lower mode) logstr env y x
            else postpone loc mode logstr env x y
 
-unifyArgs : (Unify tm, Quote tm) =>
-            {vars : _} ->
+unifyArgs : {vars : _} ->
             {auto c : Ref Ctxt Defs} ->
             {auto u : Ref UST UState} ->
             UnifyInfo -> FC -> Env Term vars ->
-            List (tm vars) -> List (tm vars) ->
+            List (Core (Glued vars)) -> List (Core (Glued vars)) ->
             Core UnifyResult
 unifyArgs mode loc env [] [] = pure success
 unifyArgs mode loc env (cx :: cxs) (cy :: cys)
     = do -- Do later arguments first, since they may depend on earlier
          -- arguments and use their solutions.
-         cs <- unifyArgs mode loc env cxs cys
-         res <- unify (lower mode) loc env cx cy
+         cs <- logDepth $ unifyArgs mode loc env cxs cys
+         -- We might know more about cx and cy now, so normalise again to
+         -- reduce any newly solved holes
+         logC "unify" 20 $ pure $ "unifyArgs done: " ++ show cs
+
+         cx' <- nf env !(quote env !cx)
+         logNF "unify.application" 20 "unifyArgs cx'" env cx'
+         cy' <- nf env !(quote env !cy)
+         logNF "unify.application" 20 "unifyArgs cy'" env cy'
+
+         res <- unify (lower mode) loc env cx' cy'
+         log "unify.application" 20 "unifyArgs res \{show res}"
+
          pure (union res cs)
 unifyArgs mode loc env _ _ = ufail loc ""
 
+unifySpine : {vars : _} ->
+             {auto c : Ref Ctxt Defs} ->
+             {auto u : Ref UST UState} ->
+             UnifyInfo -> FC -> Env Term vars ->
+             Spine vars -> Spine vars ->
+             Core UnifyResult
+unifySpine mode fc env [<] [<] = pure success
+unifySpine mode fc env (cxs :< ex) (cys :< ey)
+    = do -- We might know more about cx and cy now, so normalise again to
+         -- reduce any newly solved holes
+         cx' <- logQuiet $ do nf env !(quote env !(value ex))
+         logNF "unify.application" 20 "unifySpine cx'" env cx'
+
+         cy' <- logQuiet $ do nf env !(quote env !(value ey))
+         logNF "unify.application" 20 "unifySpine cy'" env cy'
+
+         res <- unify (lower mode) fc env cx' cy'
+         log "unify.application" 20 "unifySpine res \{show res}"
+
+         cs <- logDepth $ unifySpine mode fc env cxs cys
+         logC "unify" 20 $ pure $ "unifySpine done: " ++ show cs
+         pure (union cs res)
+unifySpine mode fc env _ _ = ufail fc ""
+
+unifySpineMetaArg : {vars : _} ->
+             {auto c : Ref Ctxt Defs} ->
+             {auto u : Ref UST UState} ->
+             UnifyInfo -> FC -> Env Term vars ->
+             Spine vars -> Spine vars ->
+             Core UnifyResult
+unifySpineMetaArg mode fc env [<] [<] = pure success
+unifySpineMetaArg mode fc env (cxs :< ex) (cys :< ey)
+    = do -- We might know more about cx and cy now, so normalise again to
+         -- reduce any newly solved holes
+         cx' <- value ex
+         logC "unify.application" 50 $ pure "unifySpine cx Glue Spine \{show cx'}"
+         cx' <- quote env cx'
+         logC "unify.application" 50 $ pure "unifySpine cx Term \{show cx'}"
+         cx' <- nf env cx'
+         logC "unify.application" 50 $ pure "unifySpine cx Glue NF \{show cx'}"
+
+         logNF "unify.application" 20 "unifySpine cx'" env cx'
+
+         cy' <- value ey
+         logC "unify.application" 50 $ pure "unifySpine cy Glue Spine \{show cy'}"
+         cy' <- quote env cy'
+         logC "unify.application" 50 $ pure "unifySpine cy Term \{show cy'}"
+         cy' <- nf env cy'
+         logC "unify.application" 50 $ pure "unifySpine cy Glue NF \{show cy'}"
+
+         logNF "unify.application" 20 "unifySpine cy'" env cy'
+
+         res <- unifySpineEntry (lower mode) cx' cy'
+         log "unify.application" 20 "unifySpine res \{show res}"
+
+         cs <- logDepth $ unifySpineMetaArg mode fc env cxs cys
+         pure (union cs res)
+    where
+      unifySpineEntry : UnifyInfo -> Glued vars -> Glued vars -> Core UnifyResult
+      unifySpineEntry mode xnf ynf
+          = do defs <- get Ctxt
+               empty <- clearDefs defs
+               -- If one's a meta and the other isn't, don't reduce at all
+               case (xnf, ynf) of
+                     (VMeta {}, VMeta {})
+                         => unify mode fc env xnf ynf
+                     (VMeta {}, _)
+                         => do ytm <- logQuiet $ quote env ynf
+                               put Ctxt empty
+                               ynf' <- nf env ytm
+                               put Ctxt defs
+                               logC "unify" 20 $
+                                 do xtm <- logQuiet $ quote env xnf
+                                    pure $ "Don't reduce at all (left): " ++ show xtm ++ " and " ++ show ytm
+                               cs <- unify mode fc env xnf ynf'
+                               case constraints cs of
+                                   [] => pure cs
+                                   _  => unify mode fc env xnf ynf
+                     (_, VMeta {})
+                         => do xtm <- logQuiet $ quote env xnf
+                               put Ctxt empty
+                               xnf' <- nf env xtm
+                               put Ctxt defs
+                               logC "unify" 20 $
+                                 do ytm <- logQuiet $ quote env ynf
+                                    pure $ "Don't reduce at all (right): " ++ show {ty=Term _} ytm ++ " and " ++ show xtm
+                               cs <- unify mode fc env xnf' ynf
+                               case constraints cs of
+                                   [] => pure cs
+                                   _  => do unify mode fc env xnf ynf
+                     _ => unify mode fc env xnf ynf
+unifySpineMetaArg mode fc env _ _ = ufail fc ""
+
+convertSpine : {vars : _} ->
+               {auto c : Ref Ctxt Defs} ->
+               {auto u : Ref UST UState} ->
+               FC -> Env Term vars ->
+               Spine vars -> Spine vars ->
+               Core Bool
+convertSpine fc env [<] [<] = pure True
+convertSpine fc env (cxs :< ex) (cys :< ey)
+    = do cx' <- logQuiet $ value ex
+         cy' <- logQuiet $ value ey
+         logNF "unify.application" 20 "convertSpine cx'" env cx'
+         logNF "unify.application" 20 "convertSpine cy'" env cy'
+
+         res <- convert env cx' cy'
+         log "unify.application" 20 "convertSpine res \{show res}"
+
+         if res
+           then logDepth $ convertSpine fc env cxs cys
+           else pure False
+convertSpine fc env _ _ = pure False
+
 -- Get the variables in an application argument list; fail if any arguments
 -- are not variables, fail if there's any repetition of variables
 -- We use this to check that the pattern unification rule is applicable
 -- when solving a metavariable applied to arguments
 -- We return a list (because the order matters) and a set (for easy
 -- querying)
-getVars : List (NF vars) -> Maybe (List (Var vars), VarSet vars)
+getVars : SnocList (NF vars) -> Maybe (SnocList (Var vars), VarSet vars)
 getVars = go [<] VarSet.empty where
 
   go : SnocList (Var vars) -> VarSet vars ->
-       List (NF vars) -> Maybe (List (Var vars), VarSet vars)
-  go acc got [] = Just (acc <>> [], got)
-  go acc got (NErased fc (Dotted t) :: xs) = go acc got (t :: xs)
-  go acc got (NApp fc (NLocal r idx p) [] :: xs)
+       SnocList (NF vars) -> Maybe (SnocList (Var vars), VarSet vars)
+  go acc got [<] = Just (acc, got)
+  go acc got (xs :< VErased fc (Dotted t)) = go acc got (xs :< t)
+  go acc got (xs :< VLocal fc idx p [<])
     = let v := MkVar p in
       if v `VarSet.elem` got then Nothing
          else go (acc :< v) (VarSet.insert v got) xs
-  go acc got (NAs _ _ _ p :: xs) = go acc got (p :: xs)
-  go acc _ (_ :: xs) = Nothing
+  go acc got (xs :< VAs _ _ _ p) = go acc got (xs :< p)
+  go acc _ (xs :< _) = Nothing
 
 -- Update the variable list to point into the sub environment
 -- (All of these will succeed because the Thin we have comes from
 -- the list of variable uses! It's not stated in the type, though.)
-updateVars : List (Var {a = Name} vars) -> Thin newvars vars -> List (Var newvars)
-updateVars vs th = mapMaybe (\ v => shrink v th) vs
+updateVars : SnocList (Var {a = Name} vars) -> Thin newvars vars -> SnocList (Var newvars)
+updateVars [<] svs = [<]
+updateVars (ps :< p) svs
+    = case shrink p svs of
+            Nothing => updateVars ps svs
+            Just p' => updateVars ps svs :< p'
 
 {- Applying the pattern unification rule is okay if:
    * Arguments are all distinct local variables
@@ -319,38 +464,39 @@ updateVars vs th = mapMaybe (\ v => shrink v th) vs
 patternEnv : {auto c : Ref Ctxt Defs} ->
              {auto u : Ref UST UState} ->
              {vars : _} ->
-             Env Term vars -> List (Closure vars) ->
-             Core (Maybe (newvars ** (List (Var newvars),
+             Env Term vars -> SnocList (Glued vars) ->
+             Core (Maybe (newvars ** (SnocList (Var newvars),
                                      Thin newvars vars)))
 patternEnv {vars} env args
     = do defs <- get Ctxt
          empty <- clearDefs defs
-         args' <- traverse (evalArg empty) args
+         -- [Note] Restore logging sequence
+         args' <- traverseSnocList expand args
          pure $
            case getVars args' of
              Nothing => Nothing
              Just (vslist, vsset) =>
                let (newvars ** svs) = fromVarSet _ vsset in
-                 Just (newvars ** (updateVars vslist svs, svs))
+                 Just (newvars ** (updateVars (reverse vslist) svs, svs))
 
-getVarsTm : List (Term vars) -> Maybe (List (Var vars), VarSet vars)
+getVarsTm : SnocList (Term vars) -> Maybe (SnocList (Var vars), VarSet vars)
 getVarsTm = go [<] VarSet.empty where
 
   go : SnocList (Var vars) -> VarSet vars ->
-       List (Term vars) -> Maybe (List (Var vars), VarSet vars)
-  go acc got [] = Just (acc <>> [], got)
-  go acc got (Local fc r idx p :: xs)
+       SnocList (Term vars) -> Maybe (SnocList (Var vars), VarSet vars)
+  go acc got [<] = Just (acc, got)
+  go acc got (xs :< Local fc r idx p)
     = let v := MkVar p in
       if v `VarSet.elem` got then Nothing
          else go (acc :< v) (VarSet.insert v got) xs
-  go acc _ (_ :: xs) = Nothing
+  go acc _ (xs :< _) = Nothing
 
 export
 patternEnvTm : {auto c : Ref Ctxt Defs} ->
                {auto u : Ref UST UState} ->
                {vars : _} ->
-               Env Term vars -> List (Term vars) ->
-               Core (Maybe (newvars ** (List (Var newvars),
+               Env Term vars -> SnocList (Term vars) ->
+               Core (Maybe (newvars ** (SnocList (Var newvars),
                                        Thin newvars vars)))
 patternEnvTm {vars} env args
     = do defs <- get Ctxt
@@ -359,7 +505,7 @@ patternEnvTm {vars} env args
            Nothing => Nothing
            Just (vslist, vsset) =>
              let (newvars ** svs) = fromVarSet _ vsset in
-                 Just (newvars ** (updateVars vslist svs, svs))
+                 Just (newvars ** (updateVars (reverse vslist) svs, svs))
 
 -- Check that the metavariable name doesn't occur in the solution.
 -- If it does, normalising might help. If it still does, that's an error.
@@ -371,7 +517,7 @@ occursCheck fc env mode mname tm
     = do solmetas <- getMetaNames tm
          let False = mname `elem` solmetas
              | _ => do defs <- get Ctxt
-                       tmnf <- normalise defs env tm
+                       tmnf <- normalise env tm
                        solmetas <- getMetaNames tmnf
                        if mname `elem` solmetas
                           then do failOnStrongRigid False
@@ -404,7 +550,7 @@ occursCheck fc env mode mname tm
 data IVars : Scope -> Scoped where
      INil : IVars Scope.empty newvars
      ICons : Maybe (Var newvars) -> IVars vs newvars ->
-             IVars (v :: vs) newvars
+             IVars (Scope.bind vs v) newvars
 
 Weaken (IVars vs) where
   weakenNs s INil = INil
@@ -429,20 +575,22 @@ tryInstantiate : {auto c : Ref Ctxt Defs} ->
               Term newvars -> -- shrunk environment
               Core Bool -- postpone if the type is yet unknown
 tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
-    = do logTerm "unify.instantiate" 5 ("Instantiating in " ++ show newvars) tm
+    = do logTerm "unify.instantiate" 5 ("Instantiating in " ++ show !(traverse toFullNames (asList newvars))) !(toFullNames tm)
 --          let Hole _ _ = definition mdef
 --              | def => ufail {a=()} loc (show mname ++ " already resolved as " ++ show def)
          case fullname mdef of
               PV pv pi => throw (PatternVariableUnifies loc (getLoc otm) env (PV pv pi) otm)
               _ => pure ()
          defs <- get Ctxt
-         ty <- normalisePis defs Env.empty $ type mdef
+         tynf <- nf Env.empty (type mdef)
+         logNF "unify.instantiate" 5 "tynf" Env.empty tynf
+         ty <- quoteBinders Env.empty tynf
                      -- make sure we have all the pi binders we need in the
                      -- type to make the metavariable definition
-         logTerm "unify.instantiate" 5 ("Type: " ++ show mname) (type mdef)
+         logTerm "unify.instantiate" 5 ("Type: " ++ show !(toFullNames mname)) (type mdef)
          logTerm "unify.instantiate" 5 ("Type: " ++ show mname) ty
          log "unify.instantiate" 5 ("With locs: " ++ show locs)
-         log "unify.instantiate" 5 ("From vars: " ++ show newvars)
+         log "unify.instantiate" 5 ("From vars: " ++ show (asList newvars))
 
          defs <- get Ctxt
          -- Try to instantiate the hole
@@ -455,9 +603,7 @@ tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
          let simpleDef = MkPMDefInfo (SolvedHole num)
                                      (not (isUserName mname) && isSimple rhs)
                                      False
-         let newdef = { definition :=
-                          PMDef simpleDef Scope.empty (STerm 0 rhs) (STerm 0 rhs) []
-                      } mdef
+         let newdef = { definition := Function simpleDef rhs rhs Nothing } mdef
          ignore $ addDef (Resolved mref) newdef
          removeHole mref
          pure True
@@ -472,7 +618,7 @@ tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
     --   * It is smaller than some threshold and has no metavariables in it
     --   * It's just a metavariable itself
     noMeta : Term vs -> Nat -> Bool
-    noMeta (App _ f a) (S k) = noMeta f k && noMeta a k
+    noMeta (App _ f _ a) (S k) = noMeta f k && noMeta a k
     noMeta (Bind _ _ b sc) (S k) = noMeta (binderType b) k && noMeta sc k
     noMeta (Meta {}) d = False
     noMeta (TDelayed _ _ t) d = noMeta t d
@@ -488,7 +634,7 @@ tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
     isSimple : Term vs -> Bool
     isSimple (Meta {}) = True
     isSimple (Bind _ _ (Lam {}) sc) = isSimple sc
-    isSimple (App _ f a) = noMeta f 6 && noMeta a 3
+    isSimple (App _ f _ a) = noMeta f 6 && noMeta a 3
     isSimple tm = noMeta tm 0
 
     updateIVar : forall vs, newvars . IVars vs newvars -> Var newvars ->
@@ -503,12 +649,45 @@ tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
 
     updateIVars : {vs, newvars : _} ->
                   IVars vs newvars -> Term newvars -> Maybe (Term vs)
+
+    updateForced : {vs, newvars : _} ->
+                   IVars vs newvars -> List (Var newvars, Term newvars) ->
+                   Maybe (List (Var vs, Term vs))
+    updateForced ivs [] = Just []
+    updateForced ivs ((v, tm) :: ts)
+        = case updateIVar ivs v of
+               Nothing => updateForced ivs ts
+               Just v' => Just ((v', !(updateIVars ivs tm)) ::
+                                   !(updateForced ivs ts))
+
+    updateIScope : {vs, newvars : _} ->
+                   IVars vs newvars -> CaseScope newvars -> Maybe (CaseScope vs)
+    updateIScope ivs (RHS fs tm)
+        = Just (RHS !(updateForced ivs fs) !(updateIVars ivs tm))
+    updateIScope ivs (Arg c x sc)
+        = Just (Arg c x !(updateIScope (ICons (Just (MkVar First))
+                                            (weaken ivs)) sc))
+
+    updateIAlts : {vs, newvars : _} ->
+                  IVars vs newvars -> CaseAlt newvars -> Maybe (CaseAlt vs)
+    updateIAlts ivs (ConCase fc n t sc)
+        = Just (ConCase fc n t !(updateIScope ivs sc))
+    updateIAlts ivs (DelayCase fc ty arg rhs)
+        = let ivs' = ICons (Just (MkVar First)) $
+                     ICons (Just (MkVar (Later First))) $
+                     weaken (weaken ivs) in
+              Just (DelayCase fc ty arg !(updateIVars ivs' rhs))
+    updateIAlts ivs (ConstCase fc c rhs)
+        = Just (ConstCase fc c !(updateIVars ivs rhs))
+    updateIAlts ivs (DefaultCase fc rhs)
+        = Just (DefaultCase fc !(updateIVars ivs rhs))
+
     updateIVars ivs (Local fc r idx p)
         = do MkVar p' <- updateIVar ivs (MkVar p)
              Just (Local fc r _ p')
     updateIVars ivs (Ref fc nt n) = pure $ Ref fc nt n
     updateIVars ivs (Meta fc n i args)
-        = pure $ Meta fc n i !(traverse (updateIVars ivs) args)
+        = pure $ Meta fc n i !(traverse @{Compose} (updateIVars ivs) args)
     updateIVars {vs} ivs (Bind fc x b sc)
         = do b' <- updateIVarsB ivs b
              sc' <- updateIVars (ICons (Just first) (weaken ivs)) sc
@@ -539,10 +718,13 @@ tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
                  Just (PVar fc c p' !(updateIVars ivs t))
         updateIVarsB ivs (PLet fc c v t) = Just (PLet fc c !(updateIVars ivs v) !(updateIVars ivs t))
         updateIVarsB ivs (PVTy fc c t) = Just (PVTy fc c !(updateIVars ivs t))
-    updateIVars ivs (App fc f a)
-        = Just (App fc !(updateIVars ivs f) !(updateIVars ivs a))
+    updateIVars ivs (App fc f c a)
+        = Just (App fc !(updateIVars ivs f) c !(updateIVars ivs a))
     updateIVars ivs (As fc u a p)
         = Just (As fc u !(updateIVars ivs a) !(updateIVars ivs p))
+    updateIVars ivs (Case fc t c sc scty alts)
+        = Just (Case fc t c !(updateIVars ivs sc) !(updateIVars ivs scty)
+                      !(traverse (updateIAlts ivs) alts))
     updateIVars ivs (TDelayed fc r arg)
         = Just (TDelayed fc r !(updateIVars ivs arg))
     updateIVars ivs (TDelay fc r ty arg)
@@ -550,9 +732,12 @@ tryInstantiate {newvars} loc mode env mname mref num mdef locs otm tm
     updateIVars ivs (TForce fc r arg)
         = Just (TForce fc r !(updateIVars ivs arg))
     updateIVars ivs (PrimVal fc c) = Just (PrimVal fc c)
+    updateIVars ivs (PrimOp fc fn args)
+        = Just (PrimOp fc fn !(traverse (updateIVars ivs) args))
     updateIVars ivs (Erased fc Impossible) = Just (Erased fc Impossible)
     updateIVars ivs (Erased fc Placeholder) = Just (Erased fc Placeholder)
     updateIVars ivs (Erased fc (Dotted t)) = Erased fc . Dotted <$> updateIVars ivs t
+    updateIVars ivs (Unmatched fc u) = Just (Unmatched fc u)
     updateIVars ivs (TType fc u) = Just (TType fc u)
 
     mkDef : {vs, newvars : _} ->
@@ -584,7 +769,7 @@ updateSolution : {vars : _} ->
                  Env Term vars -> Term vars -> Term vars -> Core Bool
 updateSolution env (Meta fc mname idx args) soln
     = do defs <- get Ctxt
-         case !(patternEnvTm env args) of
+         case !(patternEnvTm env (cast (map snd args))) of
               Nothing => pure False
               Just (newvars ** (locs, submv)) =>
                   case shrink soln submv of
@@ -619,16 +804,19 @@ isDefInvertible fc i
               | Nothing => throw (UndefinedName fc (Resolved i))
          pure (invertible gdef)
 
+spineToValues : Spine vars -> List (Core (Glued vars))
+spineToValues sp = toList (map value sp)
+
 mutual
   unifyIfEq : {auto c : Ref Ctxt Defs} ->
               {auto u : Ref UST UState} ->
               {vars : _} ->
               (postpone : Bool) ->
-              FC -> UnifyInfo -> Env Term vars -> NF vars -> NF vars ->
+              FC -> UnifyInfo -> Env Term vars -> Glued vars -> Glued vars ->
               Core UnifyResult
   unifyIfEq post loc mode env x y
         = do defs <- get Ctxt
-             if !(convertInf defs env x y)
+             if !(convert env x y)
                 then pure success
                 else if post
                         then postpone loc mode ("Postponing unifyIfEq " ++
@@ -637,25 +825,25 @@ mutual
 
   getArgTypes : {vars : _} ->
                 {auto c : Ref Ctxt Defs} ->
-                Defs -> (fnType : NF vars) -> List (Closure vars) ->
-                Core (Maybe (List (NF vars)))
-  getArgTypes defs (NBind _ n (Pi _ _ _ ty) sc) (a :: as)
-     = do Just scTys <- getArgTypes defs !(sc defs a) as
+                (fnType : NF vars) -> SnocList (Core (Glued vars)) ->
+                Core (Maybe (SnocList (Glued vars)))
+  getArgTypes (VBind _ n (Pi _ _ _ ty) sc) (as :< a)
+     = do Just scTys <- getArgTypes !(expand !(sc a)) as
                | Nothing => pure Nothing
-          pure (Just (!(evalClosure defs ty) :: scTys))
-  getArgTypes _ _ [] = pure (Just [])
-  getArgTypes _ _ _ = pure Nothing
+          pure (Just (scTys :< ty))
+  getArgTypes _ [<] = pure (Just [<])
+  getArgTypes _ _ = pure Nothing
 
   headsConvert : {vars : _} ->
                  {auto c : Ref Ctxt Defs} ->
                  {auto u : Ref UST UState} ->
                  UnifyInfo ->
                  FC -> Env Term vars ->
-                 Maybe (List (NF vars)) -> Maybe (List (NF vars)) ->
+                 Maybe (SnocList (Glued vars)) -> Maybe (SnocList (Glued vars)) ->
                  Core Bool
   headsConvert mode fc env (Just vs) (Just ns)
       = case (reverse vs, reverse ns) of
-             (v :: _, n :: _) =>
+             (_ :< v, _ :< n) =>
                 do logNF "unify.head" 10 "Unifying head" env v
                    logNF "unify.head" 10 ".........with" env n
                    res <- unify mode fc env v n
@@ -673,56 +861,62 @@ mutual
                     (swaporder : Bool) ->
                     UnifyInfo -> FC -> Env Term vars ->
                     (metaname : Name) -> (metaref : Int) ->
-                    (margs : List (Closure vars)) ->
-                    (margs' : List (Closure vars)) ->
-                    Maybe ClosedTerm ->
-                    (List (FC, Closure vars) -> NF vars) ->
-                    List (FC, Closure vars) ->
+                    (args : List (RigCount, Core (Glued vars))) ->
+                    (sp : Spine vars) ->
+                    Maybe (ClosedTerm) ->
+                    (Spine vars -> Glued vars) ->
+                    Spine vars ->
                     Core UnifyResult
-  unifyInvertible swap mode fc env mname mref margs margs' nty con args'
+  unifyInvertible swap mode fc env mname mref args sp nty con args'
       = do defs <- get Ctxt
            -- Get the types of the arguments to ensure that the rightmost
            -- argument types match up
            Just vty <- lookupTyExact (Resolved mref) (gamma defs)
                 | Nothing => ufail fc ("No such metavariable " ++ show mname)
-           vargTys <- getArgTypes defs !(nf defs env (embed vty)) (margs ++ margs')
+           vargTys <- getArgTypes !(expand !(nf env (embed vty)))
+                                  (reverse (cast (map snd args) ++ map value sp)) --  ++ sp)
            nargTys <- maybe (pure Nothing)
-                            (\ty => getArgTypes defs !(nf defs env (embed ty)) $ map snd args')
+                            (\ty => getArgTypes !(expand !(nf env (embed ty)))
+                                                $ reverse (map value args'))
                             nty
+           log "unify.invertible" 10 "Unifying invertible vty: \{show vty}, vargTys: \{show $ map asList vargTys}, nargTys: \{show $ map asList nargTys}"
            -- If the rightmost arguments have the same type, or we don't
            -- know the types of the arguments, we'll get on with it.
            if !(headsConvert mode fc env vargTys nargTys)
               then
                 -- Unify the rightmost arguments, with the goal of turning the
                 -- hole application into a pattern form
-                case (reverse margs', reverse args') of
-                     (h :: hargs, f :: fargs) =>
+                case (sp, args') of
+                     (hargs :< h, fargs :< f) =>
                         tryUnify
                           (if not swap then
-                              do log "unify.invertible" 10 "Unifying invertible"
-                                 ures <- unify mode fc env h (snd f)
+                              do hv <- value h
+                                 fv <- value f
+                                 logNF "unify.invertible" 10 "Unifying rightmost" env hv
+                                 logNF "unify.invertible" 10 "With rightmost...." env fv
+                                 ures <- unify mode fc env hv fv
                                  log "unify.invertible" 10 $ "Constraints " ++ show (constraints ures)
-                                 uargs <- unify mode fc env
-                                       (NApp fc (NMeta mname mref margs) (reverse $ map (EmptyFC,) hargs))
-                                       (con (reverse fargs))
+                                 uargs <- unify {f=Normal} mode fc env
+                                                (VMeta fc mname mref args hargs (pure Nothing))
+                                                (con fargs)
                                  pure (union ures uargs)
                              else
                               do log "unify.invertible" 10 "Unifying invertible"
-                                 ures <- unify mode fc env (snd f) h
+                                 ures <- unify mode fc env !(value f) !(value h)
                                  log "unify.invertible" 10 $ "Constraints " ++ show (constraints ures)
-                                 uargs <- unify mode fc env
-                                       (con (reverse fargs))
-                                       (NApp fc (NMeta mname mref margs) (reverse $ map (EmptyFC,) hargs))
+                                 uargs <- unify {f'=Normal} mode fc env
+                                                (con fargs)
+                                                (VMeta fc mname mref args hargs (pure Nothing))
                                  pure (union ures uargs))
-                          (postponeS swap fc mode "Postponing hole application [1]" env
-                                (NApp fc (NMeta mname mref margs) $ map (EmptyFC,) margs')
+                          (postponeS {f=Normal} swap fc mode "Postponing hole application [1]" env
+                                (VMeta fc mname mref args sp (pure Nothing))
                                 (con args'))
-                     _ => postponeS swap fc mode "Postponing hole application [2]" env
-                                (NApp fc (NMeta mname mref margs) (map (EmptyFC,) margs'))
+                     _ => postponeS {f=Normal} swap fc mode "Postponing hole application [2]" env
+                                (VMeta fc mname mref args sp (pure Nothing))
                                 (con args')
               else -- TODO: Cancellable function applications
-                   postpone fc mode "Postponing hole application [3]" env
-                            (NApp fc (NMeta mname mref margs) (map (EmptyFC,) margs')) (con args')
+                   postpone {f=Normal} fc mode "Postponing hole application [3]" env
+                            (VMeta fc mname mref args sp (pure Nothing)) (con args')
 
   -- Unify a hole application - we have already checked that the hole is
   -- invertible (i.e. it's a determining argument to a proof search where
@@ -733,39 +927,37 @@ mutual
                  (swaporder : Bool) ->
                  UnifyInfo -> FC -> Env Term vars ->
                  (metaname : Name) -> (metaref : Int) ->
-                 (margs : List (Closure vars)) ->
-                 (margs' : List (Closure vars)) ->
+                 (args : List (RigCount, Core (Glued vars))) ->
+                 (sp : Spine vars) ->
                  NF vars ->
                  Core UnifyResult
-  unifyHoleApp swap mode loc env mname mref margs margs' (NTCon nfc n a args')
+  unifyHoleApp swap mode fc env mname mref args sp (VTCon nfc n a args')
       = do defs <- get Ctxt
            mty <- lookupTyExact n (gamma defs)
-           unifyInvertible swap (lower mode) loc env mname mref margs margs' mty (NTCon nfc n a) args'
-  unifyHoleApp swap mode loc env mname mref margs margs' (NDCon nfc n t a args')
+           unifyInvertible swap (lower mode) fc env mname mref args sp mty (VTCon nfc n a) args'
+  unifyHoleApp swap mode fc env mname mref args sp (VDCon nfc n t a args')
       = do defs <- get Ctxt
            mty <- lookupTyExact n (gamma defs)
-           unifyInvertible swap (lower mode) loc env mname mref margs margs' mty (NDCon nfc n t a) args'
-  unifyHoleApp swap mode loc env mname mref margs margs' (NApp nfc (NLocal r idx p) args')
-      = unifyInvertible swap (lower mode) loc env mname mref margs margs' Nothing
-                        (NApp nfc (NLocal r idx p)) args'
-  unifyHoleApp swap mode loc env mname mref margs margs' tm@(NApp nfc (NMeta n i margs2) args2')
+           unifyInvertible swap (lower mode) fc env mname mref args sp mty (VDCon nfc n t a) args'
+  unifyHoleApp swap mode loc env mname mref args sp (VLocal nfc idx p args')
+      = unifyInvertible swap (lower mode) loc env mname mref args sp Nothing (VLocal nfc idx p) args'
+  unifyHoleApp swap mode fc env mname mref args sp tm@(VMeta nfc n i margs2 args2' val)
       = do defs <- get Ctxt
            Just mdef <- lookupCtxtExact (Resolved i) (gamma defs)
                 | Nothing => undefinedName nfc mname
            let inv = isPatName n || invertible mdef
            if inv
-              then unifyInvertible swap (lower mode) loc env mname mref margs margs' Nothing
-                                   (NApp nfc (NMeta n i margs2)) args2'
-              else postponeS swap loc mode "Postponing hole application" env
-                             (NApp loc (NMeta mname mref margs) $ map (EmptyFC,) margs') tm
+              then unifyInvertible swap (lower mode) fc env mname mref args sp Nothing
+                                   (\t => VMeta nfc n i margs2 t val) args2'
+              else postponeS {f=Normal} swap fc mode "Postponing hole application" env
+                             (VMeta fc mname mref args sp (pure Nothing)) (asGlued tm)
     where
       isPatName : Name -> Bool
       isPatName (PV {}) = True
       isPatName _ = False
-
-  unifyHoleApp swap mode loc env mname mref margs margs' tm
-      = postponeS swap loc mode "Postponing hole application" env
-                 (NApp loc (NMeta mname mref margs) $ map (EmptyFC,) margs') tm
+  unifyHoleApp swap mode fc env mname mref args sp tm
+      = postponeS {f=Normal} swap fc mode "Postponing hole application" env
+                  (VMeta fc mname mref args sp (pure Nothing)) (asGlued tm)
 
   postponePatVar : {auto c : Ref Ctxt Defs} ->
                    {auto u : Ref UST UState} ->
@@ -773,47 +965,42 @@ mutual
                    (swaporder : Bool) ->
                    UnifyInfo -> FC -> Env Term vars ->
                    (metaname : Name) -> (metaref : Int) ->
-                   (margs : List (Closure vars)) ->
-                   (margs' : List (Closure vars)) ->
-                   (soln : NF vars) ->
+                   (margs : List (RigCount, Core (Glued vars))) ->
+                   (margs' : Spine vars) ->
+                   (soln : Glued vars) ->
                    Core UnifyResult
-  postponePatVar swap mode loc env mname mref margs margs' tm
-      = do let x = NApp loc (NMeta mname mref margs) (map (EmptyFC,) margs')
-           defs <- get Ctxt
-           if !(convert defs env x tm)
+  postponePatVar swap mode fc env mname mref margs margs' tm
+      = do let x = VMeta fc mname mref margs margs' (pure Nothing)
+           if !(convert env x tm)
               then pure success
-              else postponeS swap loc mode "Not in pattern fragment" env
+              else postponeS {f=Normal} swap fc mode "Not in pattern fragment" env
                              x tm
 
+  -- Solve a metavariable application (that is, the name applied the to
+  -- args and spine) with the given solution.
+  -- Also given the results we got from 'patternEnv' that tells us how to
+  -- instantiate the environment in the solution
   solveHole : {auto c : Ref Ctxt Defs} ->
               {auto u : Ref UST UState} ->
               {newvars, vars : _} ->
               FC -> UnifyInfo -> Env Term vars ->
               (metaname : Name) -> (metaref : Int) ->
-              (margs : List (Closure vars)) ->
-              (margs' : List (Closure vars)) ->
-              List (Var newvars) ->
+              (args : List (RigCount, Core (Glued vars))) ->
+              (sp : Spine vars) ->
+              SnocList (Var newvars) ->
               Thin newvars vars ->
               (solfull : Term vars) -> -- Original solution
               (soln : Term newvars) -> -- Solution with shrunk environment
-              (solnf : NF vars) ->
+              (solnf : Glued vars) ->
               Core (Maybe UnifyResult)
-  solveHole loc mode env mname mref margs margs' locs submv solfull stm solnf
+  solveHole fc mode env mname mref margs margs' locs submv solfull stm solnf
       = do defs <- get Ctxt
            ust <- get UST
-           empty <- clearDefs defs
-           -- if the terms are the same, this isn't a solution
-           -- but they are already unifying, so just return
-           if solutionHeadSame solnf || inNoSolve mref (noSolve ust)
+           if solutionHeadSame !(expand solnf) || inNoSolve mref (noSolve ust)
               then pure $ Just success
-              else -- Rather than doing the occurs check here immediately,
-                   -- we'll wait until all metavariables are resolved, and in
-                   -- the meantime look out for cycles when normalising (which
-                   -- is cheap enough because we only need to look out for
-                   -- metavariables)
-                   do Just hdef <- lookupCtxtExact (Resolved mref) (gamma defs)
+              else do Just hdef <- lookupCtxtExact (Resolved mref) (gamma defs)
                            | Nothing => throw (InternalError ("Can't happen: Lost hole " ++ show mname))
-                      progress <- tryInstantiate loc mode env mname mref (length margs) hdef (toList locs) solfull stm
+                      progress <- tryInstantiate fc mode env mname mref (length margs) hdef (toList locs) solfull stm
                       pure $ toMaybe progress (solvedHole mref)
     where
       inNoSolve : Int -> IntMap () -> Bool
@@ -825,8 +1012,9 @@ mutual
       -- Only need to check the head metavar is the same, we've already
       -- checked the rest if they are the same (and we couldn't instantiate it
       -- anyway...)
+      -- Also the solution is expanded by now (via Evaluate.Value.expand)
       solutionHeadSame : NF vars -> Bool
-      solutionHeadSame (NApp _ (NMeta _ shead _) _) = shead == mref
+      solutionHeadSame (VMeta _ _ shead _ _ _) = shead == mref
       solutionHeadSame _ = False
 
   unifyHole : {auto c : Ref Ctxt Defs} ->
@@ -835,206 +1023,262 @@ mutual
               (swaporder : Bool) ->
               UnifyInfo -> FC -> Env Term vars ->
               FC -> (metaname : Name) -> (metaref : Int) ->
-              (args : List (Closure vars)) ->
-              (args' : List (Closure vars)) ->
-              (soln : NF vars) ->
+              (args : List (RigCount, Core (Glued vars))) ->
+              (sp : Spine vars) ->
+              (soln : Glued vars) ->
               Core UnifyResult
-  unifyHole swap mode loc env fc mname mref margs margs' tmnf
-      = do defs <- get Ctxt
-           empty <- clearDefs defs
-           let args = if isNil margs' then margs else margs ++ margs'
+  unifyHole swap mode fc env nfc mname mref args sp tmnf
+      = do let margs = cast !(traverse snd args)
+           margs' <- traverseSnocList value sp
+           let pargs = if isLin margs' then margs else margs ++ margs'
+           logC "unify.hole" 10
+                   (do -- [Note] Restore logging sequence
+                       qargs <- map reverse $ traverse (quote env) (reverse margs')
+                       qtm <- quote env tmnf
+                       pure $ "Unifying: " ++ show !(toFullNames mname) ++ " " ++ show !(traverse toFullNames qargs) ++
+                              " with " ++ show !(toFullNames qtm)) -- first attempt, try 'empty', only try 'defs' when on 'retry'?
+           defs <- get Ctxt
+           logNF "elab" 10 ("Trying to solve " ++ show mname ++ " with") env tmnf
            logC "unify.hole" 10
-                   (do args' <- traverse (evalArg empty) args
-                       qargs <- traverse (quote empty env) args'
-                       qtm <- quote empty env tmnf
-                       pure $ "Unifying: " ++ show mname ++ " " ++ show qargs ++
+                   (do qargs <- logQuiet $ traverse (quote env) pargs
+                       qtm <- logQuiet $ quote env tmnf
+                       pure $ "Unifying: " ++ show mname ++ " args " ++ show qargs ++
                               " with " ++ show qtm) -- first attempt, try 'empty', only try 'defs' when on 'retry'?
-           case !(patternEnv env args) of
+           case !(patternEnv env pargs) of
                 Nothing =>
-                  do Just hdef <- lookupCtxtExact (Resolved mref) (gamma defs)
-                        | _ => postponePatVar swap mode loc env mname mref margs margs' tmnf
+                  do log "unify.hole" 10 $ "unifyHole patEnv: Nothing"
+                     Just hdef <- lookupCtxtExact (Resolved mref) (gamma defs)
+                        | _ => postponePatVar swap mode fc env mname mref args sp tmnf
                      let Hole _ _ = definition hdef
-                        | _ => postponePatVar swap mode loc env mname mref margs margs' tmnf
+                        | _ => postponePatVar swap mode fc env mname mref args sp tmnf
                      if invertible hdef
-                        then unifyHoleApp swap mode loc env mname mref margs margs' tmnf
-                        else postponePatVar swap mode loc env mname mref margs margs' tmnf
+                        then unifyHoleApp swap mode fc env mname mref args sp !(expand tmnf)
+                        else postponePatVar swap mode fc env mname mref args sp tmnf
                 Just (newvars ** (locs, submv)) =>
-                  do Just hdef <- lookupCtxtExact (Resolved mref) (gamma defs)
-                         | _ => postponePatVar swap mode loc env mname mref margs margs' tmnf
+                  do log "unify.hole" 10 $ "unifyHole patEnv newvars: \{show $ asList newvars}, locs: \{show locs}, submv: \{show submv}"
+                     Just hdef <- lookupCtxtExact (Resolved mref) (gamma defs)
+                         | _ => postponePatVar swap mode fc env mname mref args sp tmnf
                      let Hole _ _ = definition hdef
-                         | _ => postponeS swap loc mode "Delayed hole" env
-                                          (NApp loc (NMeta mname mref margs) $ map (EmptyFC,) margs')
+                         | wat => postponeS {f=Normal} swap fc mode "Delayed hole" env
+                                          (VMeta fc mname mref args sp (pure Nothing))
                                           tmnf
-                     let qopts = MkQuoteOpts False False
-                                             (Just defs.options.elabDirectives.nfThreshold)
-                     tm <- catch (quoteOpts qopts empty env tmnf)
-                                 (\err => quote defs env tmnf)
-                     Just tm <- occursCheck loc env mode mname tm
-                         | _ => postponeS swap loc mode "Occurs check failed" env
-                                          (NApp loc (NMeta mname mref margs) $ map (EmptyFC,) margs')
+                     tm <- quote env tmnf
+                     Just tm <- occursCheck fc env mode mname tm
+                         | _ => postponeS {f=Normal} swap fc mode "Occurs check failed" env
+                                          (VMeta fc mname mref args sp (pure Nothing))
                                           tmnf
-
                      let solveOrElsePostpone : Term newvars -> Core UnifyResult
                          solveOrElsePostpone stm = do
                            mbResult <- solveHole fc mode env mname mref
-                                                 margs margs' locs submv
+                                                 args sp locs submv
                                                  tm stm tmnf
                            flip fromMaybe (pure <$> mbResult) $
-                             postponeS swap loc mode "Can't instantiate" env
-                                       (NApp loc (NMeta mname mref margs) $ map (EmptyFC,) margs') tmnf
-
-                     case shrink tm submv of
+                             postponeS {f=Normal} swap fc mode "Can't instantiate" env
+                                       (VMeta fc mname mref args sp (pure Nothing))
+                                       tmnf
+                     case shrinkTerm tm submv of
                           Just stm => solveOrElsePostpone stm
                           Nothing =>
-                            do tm' <- quote defs env tmnf
-                               case shrink tm' submv of
-                                    Nothing => postponeS swap loc mode "Can't shrink" env
-                                                         (NApp loc (NMeta mname mref margs) $ map (EmptyFC,) margs')
+                            do tm' <- quoteNF env tmnf
+                               case shrinkTerm tm' submv of
+                                    Nothing => postponeS {f=Normal} swap fc mode "Can't shrink" env
+                                                         (VMeta fc mname mref args sp (pure Nothing))
                                                          tmnf
                                     Just stm => solveOrElsePostpone stm
 
-  -- Unify an application with something else
-  unifyApp : {auto c : Ref Ctxt Defs} ->
-             {auto u : Ref UST UState} ->
-             {vars : _} ->
-             (swaporder : Bool) -> -- swap the order when postponing
-                                   -- (this is to preserve second arg being expected type)
-             UnifyInfo -> FC -> Env Term vars -> FC ->
-             NHead vars -> List (FC, Closure vars) -> NF vars ->
-             Core UnifyResult
-  unifyApp swap mode loc env fc (NMeta n i margs) args tm
-      = unifyHole swap mode loc env fc n i margs (map snd args) tm
-  unifyApp swap mode loc env fc hd args (NApp mfc (NMeta n i margs) margs')
-      = unifyHole swap mode loc env mfc n i margs (map snd margs') (NApp fc hd args)
-  unifyApp swap mode loc env fc hd args (NErased _ (Dotted t))
-      = unifyApp swap mode loc env fc hd args t
-  -- Postpone if a name application against an application, unless they are
-  -- convertible
-  unifyApp swap mode loc env fc (NRef nt n) args tm
-      = do log "unify.application" 10 $ "Name against app, unifyIfEq"
-           if not swap
-              then unifyIfEq True loc mode env (NApp fc (NRef nt n) args) tm
-              else unifyIfEq True loc mode env tm (NApp fc (NRef nt n) args)
-  unifyApp swap mode loc env xfc (NLocal rx x xp) [] (NApp yfc (NLocal ry y yp) [])
-      = do gam <- get Ctxt
-           if x == y then pure success
-             else postponeS swap loc mode "Postponing var"
-                            env (NApp xfc (NLocal rx x xp) [])
-                                (NApp yfc (NLocal ry y yp) [])
-  -- A local against something canonical (binder or constructor) is bad
-  unifyApp swap mode loc env xfc (NLocal rx x xp) args y@(NBind {})
-      = convertErrorS swap loc env (NApp xfc (NLocal rx x xp) args) y
-  unifyApp swap mode loc env xfc (NLocal rx x xp) args y@(NDCon {})
-      = convertErrorS swap loc env (NApp xfc (NLocal rx x xp) args) y
-  unifyApp swap mode loc env xfc (NLocal rx x xp) args y@(NTCon {})
-      = convertErrorS swap loc env (NApp xfc (NLocal rx x xp) args) y
-  unifyApp swap mode loc env xfc (NLocal rx x xp) args y@(NPrimVal {})
-      = convertErrorS swap loc env (NApp xfc (NLocal rx x xp) args) y
-  unifyApp swap mode loc env xfc (NLocal rx x xp) args y@(NType {})
-      = convertErrorS swap loc env (NApp xfc (NLocal rx x xp) args) y
-  -- If they're already convertible without metavariables, we're done,
-  -- otherwise postpone
-  unifyApp False mode loc env fc hd args tm
-      = do gam <- get Ctxt
-           if !(convert gam env (NApp fc hd args) tm)
+  -- Main bit of unification, decomposing unification problems into
+  -- sub-problems and solving metavariables where appropriate
+  unifyNoEta : {auto c : Ref Ctxt Defs} ->
+               {auto u : Ref UST UState} ->
+               {vars : _} ->
+               UnifyInfo -> FC -> Env Term vars ->
+               Value f vars -> Value f' vars -> Core UnifyResult
+
+  unifyNotMetavar : {auto c : Ref Ctxt Defs} ->
+                    {auto u : Ref UST UState} ->
+                    {vars : _} ->
+                    UnifyInfo -> FC -> Env Term vars ->
+                    Value f vars -> Value f' vars -> Core UnifyResult
+  -- Unifying applications means we're stuck and need to postpone, since we've
+  -- already checked convertibility
+  -- In 'match' or 'search'  mode, we can nevertheless unify the arguments
+  -- if the names match.
+  unifyNotMetavar mode@(MkUnifyInfo p InSearch) fc env x@(VApp _ _ nx spx _) y@(VApp _ _ ny spy _)
+      = if nx == ny
+           then do logC "unify.application" 5
+                          (do xs' <- logQuiet $ traverse value spx
+                              xs <- logQuiet $ traverse (quote env) xs'
+                              yx' <- logQuiet $ traverse value spy
+                              ys <- logQuiet $ traverse (quote env) yx'
+                              pure ("Searching args " ++ show xs ++ " " ++ show ys))
+                   unifySpine mode fc env spx spy
+           else postpone fc mode "Postponing application (search)" env x y
+  unifyNotMetavar mode@(MkUnifyInfo p InMatch) fc env x@(VApp _ _ nx spx _) y@(VApp _ _ ny spy _)
+      = if nx == ny
+           then do logC "unify.application" 5
+                          (do xs' <- logQuiet $ traverse value spx
+                              xs <- logQuiet $ traverse (quote env) xs'
+                              yx' <- logQuiet $ traverse value spy
+                              ys <- logQuiet $ traverse (quote env) yx'
+                              pure ("Matching args " ++ show xs ++ " " ++ show ys))
+                   unifySpine mode fc env spx spy
+           else postpone fc mode "Postponing application (match)" env x y
+  -- Now the cases where we're decomposing into smaller problems
+  unifyNotMetavar mode fc env x@(VLocal fcx idx _ [<]) y@(VLocal fcy idy _ [<])
+      = if idx == idy
+           then pure success
+           else convertError fc env x y
+  unifyNotMetavar mode@(MkUnifyInfo p InTerm) fc env x@(VLocal fcx idx _ spx)
+                                                     y@(VLocal fcy idy _ spy)
+      = if idx == idy
+           then unifySpine mode fc env spx spy
+           else postpone fc mode "Postponing local app" env x y
+  unifyNotMetavar mode@(MkUnifyInfo p InMatch) fc env x@(VLocal fcx idx _ spx)
+                                                      y@(VLocal fcy idy _ spy)
+      = if idx == idy
+           then unifySpine mode fc env spx spy
+           else postpone fc mode "Postponing local app" env x y
+  unifyNotMetavar mode fc env x@(VDCon fcx nx tx ax spx) y@(VDCon fcy ny ty ay spy)
+      = do logC "unify" 20 $ do
+             x <- toFullNames nx
+             y <- toFullNames ny
+             pure $ "Comparing data constructors " ++ show x ++ " and " ++ show y
+           if tx == ty
+             then unifySpine mode fc env spx spy
+             else convertError fc env x y
+  unifyNotMetavar mode fc env x@(VTCon fcx nx ax spx) y@(VTCon fcy ny ay spy)
+      = do logC "unify" 20 $ do
+             x <- toFullNames nx
+             y <- toFullNames ny
+             pure $ "Comparing type constructors " ++ show x ++ " and " ++ show y
+           if nx == ny
+             then do logC "unify" 20 $
+                       pure $ "Constructor " ++ show !(toFullNames nx)
+                     logC "unify" 20 $ map (const "") $
+                        traverse_ dumpArg (map value spx)
+                     logC "unify" 20 $ map (const "") $
+                        traverse_ dumpArg (map value spy)
+                     unifySpineMetaArg mode fc env spx spy
+             else convertError fc env x y
+      where
+        dumpArg : Core (Glued vars) -> Core ()
+        dumpArg v = do
+          v' <- logQuiet $ do nf env !(quote env !v)
+          logNF "unify" 20 "NF" env v'
+          logC "unify" 50 $ pure "NF Show: \{show v'}"
+
+  unifyNotMetavar mode fc env (VDelayed _ _ x) (VDelayed _ _ y)
+      = unify (lower mode) fc env x y
+  unifyNotMetavar mode fc env (VDelay _ _ tx ax) (VDelay _ _ ty ay)
+      = unifyArgs (lower mode) fc env [pure tx,pure ax] [pure ty,pure ay]
+  unifyNotMetavar mode fc env (VForce _ _ vx spx) (VForce _ _ vy spy)
+      = do cs <- unify (lower mode) fc env vx vy
+           cs' <- unifySpine (lower mode) fc env spx spy
+           pure (union cs cs')
+  unifyNotMetavar mode fc env x@(VCase{}) y@(VCase{})
+      = unifyIfEq True fc mode env (asGlued x) (asGlued y)
+  unifyNotMetavar mode fc env x@(VApp{}) y
+      -- conversion check first, in case app is a blocked case
+      = do logC "unify" 20 $ do
+             x <- logQuiet $ quote env x
+             x <- toFullNames x
+             y <- logQuiet $ quote env y
+             y <- toFullNames y
+             pure $ "Comparing left application to right something: " ++ show x ++ " and " ++ show y
+           if !(convert env x y)
               then pure success
-              else postponeS False loc mode "Postponing constraint"
-                             env (NApp fc hd args) tm
-  unifyApp True mode loc env fc hd args tm
-      = do gam <- get Ctxt
-           if !(convert gam env tm (NApp fc hd args))
+              else postpone fc mode "Postponing application (left)" env x y
+  unifyNotMetavar mode fc env x y@(VApp{})
+      = do logC "unify" 20 $ do
+             x <- logQuiet $ quote env x
+             x <- toFullNames x
+             y <- logQuiet $ quote env y
+             y <- toFullNames y
+             pure $ "Comparing right application to left something: " ++ show y ++ " and " ++ show x
+           if !(convert env x y)
               then pure success
-              else postponeS True loc mode "Postponing constraint"
-                             env (NApp fc hd args) tm
-
-  unifyBothApps : {auto c : Ref Ctxt Defs} ->
-                  {auto u : Ref UST UState} ->
-                  {vars : _} ->
-                  UnifyInfo -> FC -> Env Term vars ->
-                  FC -> NHead vars -> List (FC, Closure vars) ->
-                  FC -> NHead vars -> List (FC, Closure vars) ->
-                  Core UnifyResult
-  unifyBothApps mode loc env xfc (NLocal xr x xp) [] yfc (NLocal yr y yp) []
-      = if x == y
-           then pure success
-           else convertError loc env (NApp xfc (NLocal xr x xp) [])
-                                     (NApp yfc (NLocal yr y yp) [])
-  -- Locally bound things, in a term (not LHS). Since we have to unify
-  -- for *all* possible values, we can safely unify the arguments.
-  unifyBothApps mode@(MkUnifyInfo p InTerm) loc env xfc (NLocal xr x xp) xargs yfc (NLocal yr y yp) yargs
-      = if x == y
-           then unifyArgs mode loc env (map snd xargs) (map snd yargs)
-           else postpone loc mode "Postponing local app"
-                         env (NApp xfc (NLocal xr x xp) xargs)
-                             (NApp yfc (NLocal yr y yp) yargs)
-  unifyBothApps mode loc env xfc (NLocal xr x xp) xargs yfc (NLocal yr y yp) yargs
-      = do log "unify.application" 10 $ "Both local apps, unifyIfEq"
-           unifyIfEq True loc mode env (NApp xfc (NLocal xr x xp) xargs)
-                                       (NApp yfc (NLocal yr y yp) yargs)
+              else postpone fc mode "Postponing application (right)" env x y
+  unifyNotMetavar mode fc env (VAs _ _ _ x) y = unifyNoEta mode fc env !(expand x) y
+  unifyNotMetavar mode fc env x (VAs _ _ _ y) = unifyNoEta mode fc env x !(expand y)
+  unifyNotMetavar mode fc env x_in y_in
+      = do x <- expand x_in
+           y <- expand y_in
+           log "unify.noeta" 10 $ "Nothing else worked, unifyIfEq"
+           unifyIfEq (isPostponable x || isPostponable y) fc mode env (asGlued x) (asGlued y)
+    where
+      -- If one of them is a delay, and they're not equal, we'd better
+      -- postpone and come back to it so we can insert the implicit
+      -- Force/Delay later
+      isPostponable : NF vars -> Bool
+      isPostponable (VDelayed{}) = True
+      isPostponable (VCase{}) = True
+      isPostponable (VForce{}) = True
+      isPostponable _ = False
+
+  -- Deal with metavariable cases first
   -- If they're both holes, solve the one with the bigger context
-  unifyBothApps mode loc env xfc (NMeta xn xi xargs) xargs' yfc (NMeta yn yi yargs) yargs'
-      = do invx <- isDefInvertible loc xi
-           if xi == yi && (invx || umode mode == InSearch)
+  unifyNoEta mode fc env x@(VMeta fcx nx ix margsx argsx _) y@(VMeta fcy ny iy margsy argsy _)
+      = do -- First check if they're convertible already, in which case
+           -- we've won already
+           log "elab" 10 ("Unifying metas " ++ show nx ++ " and " ++ show ny)
+           False <- convert env x y
+                | _ => pure success
+           invx <- isDefInvertible fc ix
+           if ix == iy && (invx || umode mode == InSearch)
                                -- Invertible, (from auto implicit search)
                                -- so we can also unify the arguments.
-              then unifyArgs mode loc env (xargs ++ map snd xargs')
-                                          (yargs ++ map snd yargs')
-              else do xlocs <- localsIn xargs
-                      ylocs <- localsIn yargs
+              then unifyArgs mode fc env
+                             ((map snd margsx) ++ (spineToValues argsx))
+                             ((map snd margsy) ++ (spineToValues argsy))
+              else do xvs <- traverse (\ (c, t) => pure (c, asGlued !(expand !t))) margsx
+                      yvs <- traverse (\ (c, t) => pure (c, asGlued !(expand !t))) margsy
+                      let xlocs = localsIn (map snd xvs)
+                      let ylocs = localsIn (map snd yvs)
                       -- Solve the one with the bigger context, and if they're
                       -- equal, the one that's applied to fewest things (because
-                      -- then they arguments get substituted in)
+                      -- then the arguments get substituted in)
                       let xbigger = xlocs > ylocs
                                       || (xlocs == ylocs &&
-                                           length xargs' <= length yargs')
-                      if (xbigger || umode mode == InMatch) && not (pv xn)
-                        then unifyApp False mode loc env xfc (NMeta xn xi xargs) xargs'
-                                            (NApp yfc (NMeta yn yi yargs) yargs')
-                        else unifyApp True mode loc env yfc (NMeta yn yi yargs) yargs'
-                                           (NApp xfc (NMeta xn xi xargs) xargs')
+                                           length argsx <= length argsy)
+                      if (xbigger || umode mode == InMatch) && not (pv nx)
+                         then unifyHole False mode fc env fcx nx ix (map toCore xvs) argsx (asGlued y)
+                         else unifyHole True mode fc env fcy ny iy (map toCore yvs) argsy (asGlued x)
     where
+      toCore : (a, b) -> (a, Core b)
+      toCore (x, y) = (x, pure y)
+
       pv : Name -> Bool
       pv (PV {}) = True
       pv _ = False
 
-      localsIn : List (Closure vars) -> Core Nat
-      localsIn [] = pure 0
-      localsIn (c :: cs)
-          = do defs <- get Ctxt
-               case !(evalClosure defs c) of
-                 NApp _ (NLocal {}) _ => pure $ S !(localsIn cs)
-                 _ => localsIn cs
-
-  unifyBothApps mode loc env xfc (NMeta xn xi xargs) xargs' yfc fy yargs'
-      = unifyApp False mode loc env xfc (NMeta xn xi xargs) xargs'
-                                        (NApp yfc fy yargs')
-  unifyBothApps mode loc env xfc fx xargs' yfc (NMeta yn yi yargs) yargs'
-      = if umode mode /= InMatch
-           then unifyApp True mode loc env xfc (NMeta yn yi yargs) yargs'
-                                               (NApp xfc fx xargs')
-           else unifyApp False mode loc env xfc fx xargs'
-                                        (NApp yfc (NMeta yn yi yargs) yargs')
-  unifyBothApps mode@(MkUnifyInfo p InSearch) loc env xfc fx@(NRef xt hdx) xargs yfc fy@(NRef yt hdy) yargs
-      = if hdx == hdy
-           then unifyArgs mode loc env (map snd xargs) (map snd yargs)
-           else unifyApp False mode loc env xfc fx xargs (NApp yfc fy yargs)
-  unifyBothApps mode@(MkUnifyInfo p InMatch) loc env xfc fx@(NRef xt hdx) xargs yfc fy@(NRef yt hdy) yargs
-      = if hdx == hdy
-           then do logC "unify.application" 5
-                          (do defs <- get Ctxt
-                              xs <- traverse (quote defs env) (map snd xargs)
-                              ys <- traverse (quote defs env) (map snd yargs)
-                              pure ("Matching args " ++ show xs ++ " " ++ show ys))
-                   unifyArgs mode loc env (map snd xargs) (map snd yargs)
-           else unifyApp False mode loc env xfc fx xargs (NApp yfc fy yargs)
-  unifyBothApps mode loc env xfc fx ax yfc fy ay
-      = unifyApp False mode loc env xfc fx ax (NApp yfc fy ay)
+      localsIn : forall f . List (Value f vars) -> Nat
+      localsIn [] = 0
+      localsIn (VLocal {} :: xs) = 1 + localsIn xs
+      localsIn (_ :: xs) = localsIn xs
+  unifyNoEta mode fc env (VErased _ (Dotted x)) (VErased _ (Dotted y))
+      = unifyNoEta mode fc env !(expand x) !(expand y)
+  unifyNoEta mode fc env x (VErased _ (Dotted y))
+      = unifyNoEta mode fc env x !(expand y)
+  unifyNoEta mode fc env (VErased _ (Dotted x)) y
+      = unifyNoEta mode fc env !(expand x) y
+  unifyNoEta mode fc env (VMeta fcm n i margs args _) tm
+      = unifyHole False mode fc env fcm n i margs args (asGlued tm)
+  unifyNoEta mode fc env tm (VMeta fcm n i margs args _)
+      = unifyHole True mode fc env fcm n i margs args (asGlued tm)
+  unifyNoEta mode fc env tm tm' = unifyNotMetavar mode fc env tm tm'
+
+  mkArgVar : FC -> Name -> Glued vars
+  mkArgVar fc var = vRef fc Bound var
+
+  mkArg : FC -> Name -> Core (Glued vars)
+  mkArg fc var = pure $ mkArgVar fc var
+
 
   unifyPiInfo : {auto c : Ref Ctxt Defs} ->
                 {auto u : Ref UST UState} ->
                 {vars : _} ->
                 UnifyInfo -> FC -> Env Term vars ->
-                PiInfo (Closure vars) -> PiInfo (Closure vars) ->
+                PiInfo (Glued vars) -> PiInfo (Glued vars) ->
                 Core (Maybe UnifyResult)
   unifyPiInfo mode loc env Explicit Explicit = pure $ Just success
   unifyPiInfo mode loc env Implicit Implicit = pure $ Just success
@@ -1046,308 +1290,348 @@ mutual
                     {auto u : Ref UST UState} ->
                     {vars : _} ->
                     UnifyInfo -> FC -> Env Term vars ->
-                    FC -> Name -> Binder (Closure vars) ->
-                    (Defs -> Closure vars -> Core (NF vars)) ->
-                    FC -> Name -> Binder (Closure vars) ->
-                    (Defs -> Closure vars -> Core (NF vars)) ->
+                    FC -> Name -> Binder (Glued vars) ->
+                    (Core (Glued vars) -> Core (Glued vars)) ->
+                    FC -> Name -> Binder (Glued vars) ->
+                    (Core (Glued vars) -> Core (Glued vars)) ->
                     Core UnifyResult
-  unifyBothBinders mode loc env xfc x (Pi fcx cx ix tx) scx yfc y (Pi fcy cy iy ty) scy
-      = do defs <- get Ctxt
-           let err = convertError loc env
-                       (NBind xfc x (Pi fcx cx ix tx) scx)
-                       (NBind yfc y (Pi fcy cy iy ty) scy)
-           if cx /= cy
-             then err
-             else do Just ci <- unifyPiInfo (lower mode) loc env ix iy
-                       | Nothing => err
-                     empty <- clearDefs defs
-                     tx' <- quote empty env tx
-                     logC "unify.binder" 10 $
-                               (do ty' <- quote empty env ty
-                                   pure ("Unifying arg types " ++ show tx' ++ " and " ++ show ty'))
-                     ct <- unify (lower mode) loc env tx ty
-                     xn <- genVarName "x"
-                     let env' : Env Term (x :: _)
-                              = Pi fcy cy Explicit tx' :: env
-                     case constraints ct of
-                         [] => -- No constraints, check the scope
-                            do tscx <- scx defs (toClosure defaultOpts env (Ref loc Bound xn))
-                               tscy <- scy defs (toClosure defaultOpts env (Ref loc Bound xn))
-                               tmx <- quote empty env tscx
-                               tmy <- quote empty env tscy
-                               cs <- unify (lower mode) loc env'
-                                       (refsToLocals (Add x xn None) tmx)
-                                       (refsToLocals (Add x xn None) tmy)
-                               pure (union ci cs)
-                         cs => -- Constraints, make new guarded constant
-                            do txtm <- quote empty env tx
-                               tytm <- quote empty env ty
-                               c <- newConstant loc erased env
-                                      (Bind xfc x (Lam fcy cy Explicit txtm) (Local xfc Nothing _ First))
-                                      (Bind xfc x (Pi fcy cy Explicit txtm)
-                                          (weaken tytm)) cs
-                               tscx <- scx defs (toClosure defaultOpts env (Ref loc Bound xn))
-                               tscy <- scy defs (toClosure defaultOpts env (App loc c (Ref loc Bound xn)))
-                               tmx <- quote empty env tscx
-                               tmy <- quote empty env tscy
-                               cs' <- unify (lower mode) loc env'
-                                        (refsToLocals (Add x xn None) tmx)
-                                        (refsToLocals (Add x xn None) tmy)
-                               pure (union ci (union ct cs'))
-  unifyBothBinders mode loc env xfc x (Lam fcx cx ix tx) scx yfc y (Lam fcy cy iy ty) scy
-      = do defs <- get Ctxt
-           let err = convertError loc env
-                       (NBind xfc x (Lam fcx cx ix tx) scx)
-                       (NBind yfc y (Lam fcy cy iy ty) scy)
-           if cx /= cy
-             then err
-             else do empty <- clearDefs defs
-                     Just ci <- unifyPiInfo (lower mode) loc env ix iy
-                       | Nothing => err
-                     ct <- unify (lower mode) loc env tx ty
-                     xn <- genVarName "x"
-                     txtm <- quote empty env tx
-                     let env' : Env Term (x :: _)
-                              = Lam fcx cx Explicit txtm :: env
-
-                     tscx <- scx defs (toClosure defaultOpts env (Ref loc Bound xn))
-                     tscy <- scy defs (toClosure defaultOpts env (Ref loc Bound xn))
-                     tmx <- quote empty env tscx
-                     tmy <- quote empty env tscy
-                     cs' <- unify (lower mode) loc env' (refsToLocals (Add x xn None) tmx)
-                                                              (refsToLocals (Add x xn None) tmy)
-                     pure (union ci (union ct cs'))
-
-  unifyBothBinders mode loc env xfc x bx scx yfc y by scy
-      = convertError loc env
-                  (NBind xfc x bx scx)
-                  (NBind yfc y by scy)
-
-  dumpArg : {vars : _} ->
-            {auto c : Ref Ctxt Defs} ->
-            Env Term vars -> Closure vars -> Core ()
-  dumpArg env (MkClosure opts loc lenv tm)
-      = do defs <- get Ctxt
-           empty <- clearDefs defs
-           logTerm "unify" 20 "Term: " tm
-           nf <- evalClosure empty (MkClosure opts loc lenv tm)
-           logNF "unify" 20 "  " env nf
-  dumpArg env cl
-      = do defs <- get Ctxt
-           empty <- clearDefs defs
-           nf <- evalClosure empty cl
-           logNF "unify" 20 "  " env nf
-
-  export
-  unifyNoEta : {auto c : Ref Ctxt Defs} ->
-               {auto u : Ref UST UState} ->
-               {vars : _} ->
-               UnifyInfo -> FC -> Env Term vars ->
-               NF vars -> NF vars ->
-               Core UnifyResult
-  unifyNoEta mode loc env (NDCon xfc x tagx ax xs) (NDCon yfc y tagy ay ys)
-      = do gam <- get Ctxt
-           if tagx == tagy
-             then
-                  do -- Constantly checking the log setting appears to have
-                     -- a bit of overhead, but I'm keeping this here because it
-                     -- may prove useful again...
-                     {-
-                     ust <- get UST
-                     when (logging ust) $
-                        do logC "unify" 20 $ do pure $ "Constructor " ++ show !(toFullNames x) ++ " " ++ show loc
-                           log "unify" 20 "ARGUMENTS:"
-                           traverse_ (dumpArg env) xs
-                           log "unify" 20 "WITH:"
-                           traverse_ (dumpArg env) ys
-                     -}
-                     unifyArgs mode loc env (map snd xs) (map snd ys)
-             else convertError loc env
-                       (NDCon xfc x tagx ax xs)
-                       (NDCon yfc y tagy ay ys)
-  unifyNoEta mode loc env (NTCon xfc x ax xs) (NTCon yfc y ay ys)
-   = do logC "unify" 20 $ do
-          x <- toFullNames x
-          y <- toFullNames y
-          pure $ "Comparing type constructors " ++ show x ++ " and " ++ show y
-        if x == y
-           then do let xs = map snd xs
-                   let ys = map snd ys
-
-                   logC "unify" 20 $
-                     pure $ "Constructor " ++ show x
-                   logC "unify" 20 $ map (const "") $ traverse_ (dumpArg env) xs
-                   logC "unify" 20 $ map (const "") $ traverse_ (dumpArg env) ys
-                   unifyArgs mode loc env xs ys
-             -- TODO: Type constructors are not necessarily injective.
-             -- If we don't know it's injective, need to postpone the
-             -- constraint. But before then, we need some way to decide
-             -- what's injective...
-             -- gallais: really? We don't mind being anticlassical do we?
---                then postpone True loc mode env (quote empty env (NTCon x ax xs))
---                                           (quote empty env (NTCon y ay ys))
-           else convertError loc env
-                     (NTCon xfc x ax xs)
-                     (NTCon yfc y ay ys)
-  unifyNoEta mode loc env (NDelayed xfc _ x) (NDelayed yfc _ y)
-      = unify (lower mode) loc env x y
-  unifyNoEta mode loc env (NDelay xfc _ xty x) (NDelay yfc _ yty y)
-      = unifyArgs mode loc env [xty, x] [yty, y]
-  unifyNoEta mode loc env (NForce xfc _ x axs) (NForce yfc _ y ays)
-      = do cs <- unify (lower mode) loc env x y
-           cs' <- unifyArgs mode loc env (map snd axs) (map snd ays)
-           pure (union cs cs')
-  unifyNoEta mode loc env x@(NApp xfc fx@(NMeta {}) axs)
-                          y@(NApp yfc fy@(NMeta {}) ays)
-      = do defs <- get Ctxt
-           if !(convert defs env x y)
-               then pure success
-               else unifyBothApps (lower mode) loc env xfc fx axs yfc fy ays
-  unifyNoEta mode loc env (NApp xfc fx axs) (NApp yfc fy ays)
-      = unifyBothApps (lower mode) loc env xfc fx axs yfc fy ays
-  unifyNoEta mode loc env x (NErased _ (Dotted y)) = unifyNoEta mode loc env x y
-  unifyNoEta mode loc env (NErased _ (Dotted x)) y = unifyNoEta mode loc env x y
-  unifyNoEta mode loc env (NApp xfc hd args) y
-      = unifyApp False (lower mode) loc env xfc hd args y
-  unifyNoEta mode loc env y (NApp yfc hd args)
-      = if umode mode /= InMatch
-           then unifyApp True mode loc env yfc hd args y
-           else do log "unify.noeta" 10 $ "Unify if Eq due to something with app"
-                   unifyIfEq True loc mode env y (NApp yfc hd args)
-  -- Only try stripping as patterns as a last resort
-  unifyNoEta mode loc env x (NAs _ _ _ y) = unifyNoEta mode loc env x y
-  unifyNoEta mode loc env (NAs _ _ _ x) y = unifyNoEta mode loc env x y
-  unifyNoEta mode loc env x y
-      = do defs <- get Ctxt
-           empty <- clearDefs defs
-           log "unify.noeta" 10 $ "Nothing else worked, unifyIfEq"
-           unifyIfEq (isDelay x || isDelay y) loc mode env x y
-    where
-      -- If one of them is a delay, and they're not equal, we'd better
-      -- postpone and come back to it so we can insert the implicit
-      -- Force/Delay later
-      isDelay : NF vars -> Bool
-      isDelay (NDelayed {}) = True
-      isDelay _ = False
+  unifyBothBinders mode fc env fcx nx bx@(Pi bfcx cx ix tx) scx fcy ny by@(Pi bfcy cy iy ty) scy
+      = let err = convertGluedError fc env
+                 (VBind fcx nx bx scx)
+                 (VBind fcy ny by scy)
+        in if cx /= cy
+          then err
+          else do Just ci <- unifyPiInfo (lower mode) fc env ix iy
+                    | Nothing => err
+                  csarg <- unify (lower mode) fc env tx ty
+                  tx' <- quote env tx
+                  x' <- genVarName "x"
+                  logTerm "unify.binder" 10 "Unifying arg" tx'
+                  logNF "unify.binder" 10 "........with" env ty
+                  let env' : Env Term (_ :< nx)
+                           = env :< Pi fcy cy Explicit tx'
+                  logEnv "unify.binder" 10 "env'" env'
+                  logC "unify.binder" 10 $ pure "Unifying pi \{show ix} and \{show iy}"
+                  case constraints csarg of
+                      [] => -- No constraints, check the scope
+                         do tscx <- scx (mkArg fc x')
+                            logNF "unify.binder" 10 "tscx" env tscx
+                            tscy <- scy (mkArg fc x')
+                            logNF "unify.binder" 10 "tscy" env tscy
+                            tmx <- quote env tscx
+                            tmy <- quote env tscy
+                            logTermNF "unify.binder" 10 "Unifying scope" env tmx
+                            logTermNF "unify.binder" 10 "..........with" env tmy
+                            logTermNF "unify.binder" 10 "refsToLocals: Unifying scope" env' (refsToLocals (Add nx x' None) tmx)
+                            logTermNF "unify.binder" 10 "refsToLocals: ..........with" env' (refsToLocals (Add nx x' None) tmy)
+                            cs <- unify (lower mode) fc env'
+                              (refsToLocals (Add nx x' None) tmx)
+                              (refsToLocals (Add nx x' None) tmy)
+                            pure (union ci cs)
+                      cs => -- Constraints, make new constant
+                         do txtm <- quote env tx
+                            tytm <- quote env ty
+                            c <- newConstant fc erased env
+                                   (Bind fcx nx (Lam fcy cy Explicit txtm) (Local fcx Nothing _ First))
+                                   (Bind fcx nx (Pi fcy cy Explicit txtm)
+                                       (weaken tytm)) cs
+                            tscx <- scx (mkArg fc x')
+                            tscy <- scy (mkArg fc x')
+                            tmx <- quote env tscx
+                            tmy <- quote env tscy
+                            cs' <- unify (lower mode) fc env'
+                                     (refsToLocals (Add nx x' None) tmx)
+                                     (refsToLocals (Add nx x' None) tmy)
+                            pure (union ci (union csarg cs'))
+  unifyBothBinders mode fc env xfc nx bx@(Lam fcx cx ix tx) scx yfc ny by@(Lam fcy cy iy ty) scy
+      = let err = convertGluedError fc env
+                 (VBind fcx nx bx scx)
+                 (VBind fcy ny by scy)
+        in if cx /= cy
+          then err
+          else do Just ci <- unifyPiInfo (lower mode) fc env ix iy
+                    | Nothing => err
+                  ct <- unify (lower mode) fc env tx ty
+                  xn <- genVarName "x"
+                  txtm <- quote env tx
+                  let env' : Env Term (_ :< nx)
+                           = env :< Lam fcx cx Explicit txtm
+
+                  tscx <- scx (mkArg fc xn)
+                  tscy <- scy (mkArg fc xn)
+                  tmx <- quote env tscx
+                  tmy <- quote env tscy
+                  cs' <- unify (lower mode) fc env'
+                           (refsToLocals (Add nx xn None) tmx)
+                           (refsToLocals (Add nx xn None) tmy)
+                  pure (union ci (union ct cs'))
+  unifyBothBinders mode fc env fcx nx bx scx fcy ny by scy
+      = convertGluedError fc env
+                  (VBind fcx nx bx scx)
+                  (VBind fcy ny by scy)
 
   isHoleApp : NF vars -> Bool
-  isHoleApp (NApp _ (NMeta {}) _) = True
+  isHoleApp (VMeta{}) = True
   isHoleApp _ = False
 
-  export
-  Unify NF where
-    unifyD _ _ mode loc env (NBind xfc x bx scx) (NBind yfc y by scy)
-        = unifyBothBinders mode loc env xfc x bx scx yfc y by scy
-    unifyD _ _ mode loc env tmx@(NBind xfc x (Lam fcx cx ix tx) scx) tmy
-        = do defs <- get Ctxt
-             logNF "unify" 10 "EtaR" env tmx
+  -- At this point, we know that 'VApp' and 'VMeta' don't reduce further
+  unifyWithEta : {auto c : Ref Ctxt Defs} ->
+                 {auto u : Ref UST UState} ->
+                 {vars : _} ->
+                 UnifyInfo -> FC -> Env Term vars ->
+                 NF vars -> NF vars -> Core UnifyResult
+  -- Pair of binders or lambdas
+  unifyWithEta mode fc env x@(VBind _ nx (Lam fcx cx ix tx) scx) y@(VBind _ ny (Lam _ cy iy ty) scy)
+      = if cx /= cy
+          then convertError fc env x y
+          else do ct <- unify (lower mode) fc env tx ty
+                  var <- genVarName "x"
+                  txtm <- quote env tx
+                  let env' : Env Term (_ :< nx)
+                           = env :< Lam fcx cx Explicit txtm
+                  tscx <- scx $ pure $ mkArgVar fc var
+                  tscy <- scy $ pure $ mkArgVar fc var
+                  tmx <- quote env tscx
+                  tmy <- quote env tscy
+                  logTerm "unify.binder" 10 "Unifying lambda scope" tmx
+                  logTerm "unify.binder" 10 ".................with" tmy
+                  cs' <- unify (lower mode) fc env'
+                               (refsToLocals (Add nx var None) tmx)
+                               (refsToLocals (Add nx var None) tmy)
+                  pure (union ct cs')
+
+  -- Eta rules
+  unifyWithEta mode fc env tmx@(VBind fcx x (Lam bfc cx ix tx) scx) tmy
+        = do logNF "unify" 10 "EtaR" env tmx
              logNF "unify" 10 "...with" env tmy
              if isHoleApp tmy
-                then if not !(convert defs env tmx tmy)
-                        then unifyNoEta (lower mode) loc env tmx tmy
+                then if not !(convert env tmx tmy)
+                        then unifyNoEta (lower mode) fc env tmx tmy
                         else pure success
-                else do empty <- clearDefs defs
-                        domty <- quote empty env tx
-                        etay <- nf defs env
-                                  $ Bind xfc x (Lam fcx cx Explicit domty)
-                                  $ App xfc (weaken !(quote empty env tmy))
-                                            (Local xfc Nothing 0 First)
+                else do domty <- quote env tx
+                        etay <- nf env
+                                  $ Bind fcx x (Lam bfc cx Explicit domty)
+                                  $ App fcx (weaken !(quote env tmy))
+                                            cx
+                                            (Local fcx Nothing 0 First)
                         logNF "unify" 10 "Expand" env etay
-                        unify (lower mode) loc env tmx etay
-    unifyD _ _ mode loc env tmx tmy@(NBind yfc y (Lam fcy cy iy ty) scy)
-        = do defs <- get Ctxt
-             logNF "unify" 10 "EtaL" env tmx
+                        unify (lower mode) fc env tmx etay
+  unifyWithEta mode fc env tmx tmy@(VBind fcy y (Lam bfc cy iy ty) scy)
+        = do logNF "unify" 10 "EtaR" env tmx
              logNF "unify" 10 "...with" env tmy
              if isHoleApp tmx
-                then if not !(convert defs env tmx tmy)
-                        then unifyNoEta (lower mode) loc env tmx tmy
+                then if not !(convert env tmx tmy)
+                        then unifyNoEta (lower mode) fc env tmx tmy
                         else pure success
-                else do empty <- clearDefs defs
-                        domty <- quote empty env ty
-                        etax <- nf defs env
-                                 $ Bind yfc y (Lam fcy cy Explicit domty)
-                                 $ App yfc (weaken !(quote empty env tmx))
-                                           (Local yfc Nothing 0 First)
+                else do domty <- quote env ty
+                        etax <- nf env
+                                  $ Bind fcy y (Lam bfc cy Explicit domty)
+                                  $ App fcy (weaken !(quote env tmx))
+                                            cy
+                                            (Local fcy Nothing 0 First)
                         logNF "unify" 10 "Expand" env etax
-                        unify (lower mode) loc env etax tmy
-    unifyD _ _ mode loc env tmx tmy = unifyNoEta mode loc env tmx tmy
-
-    unifyWithLazyD _ _ mode loc env (NDelayed _ _ tmx) (NDelayed _ _ tmy)
-       = unify (lower mode) loc env tmx tmy
-    unifyWithLazyD _ _ mode loc env x@(NDelayed _ r tmx) tmy
-       = if isHoleApp tmy && not (umode mode == InMatch)
-            -- given type delayed, expected unknown, so let's wait and see
-            -- what the expected type turns out to be
-            then postpone loc mode "Postponing in lazy" env x tmy
-            else do vs <- unify (lower mode) loc env tmx tmy
-                    pure ({ addLazy := AddForce r } vs)
-    unifyWithLazyD _ _ mode loc env tmx (NDelayed _ r tmy)
-       = do vs <- unify (lower mode) loc env tmx tmy
-            pure ({ addLazy := AddDelay r } vs)
-    unifyWithLazyD _ _ mode loc env tmx tmy
-       = unify mode loc env tmx tmy
+                        unify (lower mode) fc env etax tmy
+  unifyWithEta mode fc env (VBind fcx nx bx scx) (VBind fcy ny by scy)
+      = unifyBothBinders mode fc env fcx nx bx scx fcy ny by scy
+  unifyWithEta mode fc env x y
+      = unifyNoEta mode fc env x y
+
+  -- At this point, we know that 'VApp' and 'VMeta' don't reduce further
+  unifyLazy : {auto c : Ref Ctxt Defs} ->
+              {auto u : Ref UST UState} ->
+              {vars : _} ->
+              UnifyInfo -> FC -> Env Term vars ->
+              NF vars -> NF vars -> Core UnifyResult
+  unifyLazy mode fc env (VDelayed _ _ x) (VDelayed _ _ y)
+      = unifyWithEta (lower mode) fc env !(expand x) !(expand y)
+  unifyLazy mode fc env x@(VDelayed _ r tmx) tmy
+      = if isHoleApp tmy && not (umode mode == InMatch)
+           then postpone fc mode "Postponing in lazy" env x tmy
+           else do logNF "unify" 5 "Add force" env tmx
+                   vs <- unify (lower mode) fc env tmx tmy
+                   pure ({ addLazy := AddForce r } vs)
+  unifyLazy mode fc env tmx (VDelayed _ r tmy)
+      = do vs <- unify (lower mode) fc env tmx tmy
+           pure ({ addLazy := AddDelay r } vs)
+  unifyLazy mode fc env x y = unifyWithEta mode fc env x y
+
+  -- First, see if we need to evaluate VApp a bit more
+  -- Also, if we have two VApps that immediately convert without reduction,
+  -- take advantage of that
+  unifyExpandApps : {auto c : Ref Ctxt Defs} ->
+                    {auto u : Ref UST UState} ->
+                    {vars : _} ->
+                    Bool ->
+                    UnifyInfo -> FC -> Env Term vars ->
+                    Glued vars -> Glued vars -> Core UnifyResult
+  -- If the values convert already, we're done
+  unifyExpandApps lazy mode fc env x@(VApp fcx ntx nx spx _) y@(VApp fcy nty ny spy _)
+      = if nx == ny
+           then do inf <- getInfPos nx
+                   logC "unify.equal" 10 $
+                                do x <- toFullNames nx
+                                   y <- toFullNames ny
+                                   xs' <- logQuiet $ traverse value spx
+                                   xs <- logQuiet $ traverse (quote env) xs'
+                                   yx' <- logQuiet $ traverse value spy
+                                   ys <- logQuiet $ traverse (quote env) yx'
+                                   pure $ "Attempt to convertSpine (func equal already): \{show x} (\{show !(toFullNames xs)}) and \{show y} (\{show !(toFullNames ys)}) \n with inf: \{show inf}"
+                   let spx' = NatSet.SnocList.drop inf spx
+                   let spy' = NatSet.SnocList.drop inf spy
+                   unless (NatSet.isEmpty inf)
+                     $ logC "unify.equal" 10 $
+                                do xs' <- logQuiet $ traverse value spx'
+                                   xs <- logQuiet $ traverse (quote env) xs'
+                                   yx' <- logQuiet $ traverse value spy'
+                                   ys <- logQuiet $ traverse (quote env) yx'
+                                   pure $ "Inferred arguments (\{show inf}) are considered safe to be dropped from convert: (\{show !(toFullNames xs)}) and (\{show !(toFullNames ys)})"
+                   c <- convertSpine fc env spx' spy'
+                   if c
+                      then
+                        do logC "unify.equal" 10 $
+                                do x <- toFullNames nx
+                                   y <- toFullNames ny
+                                   pure $ "Skipped unification (equal already): \{show x} and \{show y}"
+                           pure success
+                      else do valx' <- expand x
+                              valy' <- expand y
+                              logC "unify.equal" 10 $
+                                do x <- toFullNames valx'
+                                   y <- toFullNames valy'
+                                   pure $ "Begin unification (non-convertable) \{show lazy}: \{show x} and \{show y}"
+                              if lazy
+                                then unifyLazy mode fc env valx' valy'
+                                else unifyWithEta mode fc env valx' valy'
+           else do valx' <- expand x
+                   valy' <- expand y
+                   logC "unify.equal" 10 $
+                     do valx' <- toFullNames valx'
+                        valy' <- toFullNames valy'
+                        pure $ "Begin unification (func non-equal) \{show lazy} \{show mode}: \{show valx'} (from \{show x}) and \{show valy'} (from \{show y})"
+                   if lazy
+                      then unifyLazy mode fc env valx' valy'
+                      else unifyWithEta mode fc env valx' valy'
+      where
+          getInfPos : Name -> Core NatSet
+          getInfPos n
+              = do defs <- get Ctxt
+                   Just gdef <- lookupCtxtExact n (gamma defs)
+                       | _ => pure NatSet.empty
+                   pure (inferrable gdef)
+
+          dropInf : Nat -> Nat -> List Nat -> SnocList (SpineEntry a) -> SnocList (SpineEntry a)
+          dropInf _ _ [] xs = xs
+          dropInf _ _ _ [<] = [<]
+          dropInf a i ds (xs :< x)
+              = if (a `minus` i) `elem` ds
+                   then dropInf a (S i) ds xs
+                   else dropInf a (S i) ds xs :< x
+
+  -- Same quick check for metavars
+  unifyExpandApps {vars} lazy mode fc env x@(VMeta fcx nx ix scx spx _) y@(VMeta fcy ny iy scy spy _)
+      = do True <- do let True = ix == iy
+                           | False => pure False
+                      True <- convertSpine fc env spx spy
+                           | False => pure False
+                      convScope scx scy
+              | False => do valx' <- expand x
+                            valy' <- expand y
+                            if lazy
+                              then unifyLazy mode fc env valx' valy'
+                              else unifyWithEta mode fc env valx' valy'
+           pure success
+    where
+      convScope : List (RigCount, Core (Glued vars)) ->
+                  List (RigCount, Core (Glued vars)) -> Core Bool
+      convScope [] [] = pure True
+      convScope ((_, x) :: xs) ((_, y) :: ys)
+          = do True <- convert env !x !y | False => pure False
+               convScope xs ys
+      convScope _ _ = pure False
+  -- Otherwise, make sure the top level thing is expanded (so not a reducible
+  -- VApp or VMeta node) then move on
+  unifyExpandApps lazy mode fc env x y
+      = do logC "unify.equal" 10 $
+             do x <- logQuiet $ quote env x
+                x <- toFullNames x
+                y <- logQuiet $ quote env y
+                y <- toFullNames y
+                pure $ "Begin unification (non-application) \{show lazy}: \{show x} and \{show y}"
+           x' <- expand x
+           y' <- expand y
+           logC "unify.equal" 10 $
+             do x <- logQuiet $ quote env x'
+                x <- toFullNames x
+                y <- logQuiet $ quote env y'
+                y <- toFullNames y
+                pure $ "Begin unification (non-application) \{show lazy} expanded: \{show x} and \{show y}"
+           if lazy
+              then unifyLazy mode fc env x' y'
+              else unifyWithEta mode fc env x' y'
+
+  -- Start by expanding any top level Apps (if they don't convert already)
+  -- then invoke full unification, either inserting laziness coercions
+  -- or not.
+
+  unifyVal : {auto c : Ref Ctxt Defs} ->
+             {auto u : Ref UST UState} ->
+             {vars : _} ->
+             UnifyInfo -> FC -> Env Term vars ->
+             Glued vars -> Glued vars -> Core UnifyResult
+  unifyVal mode fc env x y = logDepth $ unifyExpandApps False mode fc env x y
+
+  unifyValLazy : {auto c : Ref Ctxt Defs} ->
+                 {auto u : Ref UST UState} ->
+                 {vars : _} ->
+                 UnifyInfo -> FC -> Env Term vars ->
+                 Glued vars -> Glued vars -> Core UnifyResult
+  unifyValLazy mode fc env x y = logDepth $ unifyExpandApps True mode fc env x y
+
+  -- The interesting top level case, for unifying values
+  Core.Unify.Value.unify mode fc env x y
+     = logDepth $ unifyVal mode fc env (asGlued x) (asGlued y)
+
+  -- The interesting top level case, for unifying values and inserting laziness
+  -- coercions if appropriate
+  Core.Unify.Value.unifyWithLazy mode fc env x y
+     = logDepth $ unifyValLazy mode fc env (asGlued x) (asGlued y)
+
+  Core.Unify.Term.unify umode fc env x y
+     = do x' <- logQuiet $ nf env x
+          y' <- logQuiet $ nf env y
+          unify umode fc env x' y'
+
+  Core.Unify.Term.unifyWithLazy umode fc env x y
+     = do x' <- logQuiet $ nf env x
+          y' <- logQuiet $ nf env y
+          unifyWithLazy umode fc env x' y'
+
+  export
+  Unify NF where
+    unifyD _ _ mode fc env x y
+      = logDepth $ unifyVal mode fc env (asGlued x) (asGlued y)
+
+    unifyWithLazyD _ _ mode fc env x y
+      = logDepth $ unifyValLazy mode fc env (asGlued x) (asGlued y)
 
   export
   Unify Term where
-    unifyD _ _ mode loc env x y
-          = do defs <- get Ctxt
-               empty <- clearDefs defs
-               if x == y
-                  then do log "unify.equal" 10 $
-                                 "Skipped unification (equal already): "
-                                 ++ show x ++ " and " ++ show y
-                          pure success
-                  else do xnf <- nf defs env x
-                          ynf <- nf defs env y
-                          unify mode loc env xnf ynf
-    unifyWithLazyD _ _ mode loc env x y
-          = do defs <- get Ctxt
-               empty <- clearDefs defs
-               if x == y
-                  then do log "unify.equal" 10 $
-                                 "Skipped unification (equal already): "
-                                 ++ show x ++ " and " ++ show y
-                          pure success
-                  else do xnf <- nf defs env x
-                          ynf <- nf defs env y
-                          unifyWithLazy mode loc env xnf ynf
+    unifyD _ _ umode fc env x y
+      = do x' <- logQuiet $ nf env x
+           y' <- logQuiet $ nf env y
+           unify umode fc env x' y'
+    unifyWithLazyD _ _ umode fc env x y
+      = do x' <- logQuiet $ nf env x
+           y' <- logQuiet $ nf env y
+           unifyWithLazy umode fc env x' y'
 
   export
-  Unify Closure where
-    unifyD _ _ mode loc env x y
-        = do defs <- get Ctxt
-             empty <- clearDefs defs
-             if !(convert empty env x y)
-                then pure success
-                else
-                  do xnf <- evalClosure defs x
-                     ynf <- evalClosure defs y
-                     -- If one's a meta and the other isn't, don't reduce at
-                     -- all
-                     case (xnf, ynf) of
-                         -- They might be equal, don't want to make a cycle
-                         (NApp _ (NMeta {}) _, NApp _ (NMeta {}) _)
-                               => unify mode loc env xnf ynf
-                         (NApp _ (NMeta _ i _) _, _) =>
-                            do ynf' <- evalClosure empty y
-                               xtm <- quote empty env xnf
-                               ytm <- quote empty env ynf'
-                               cs <- unify mode loc env !(nf empty env xtm)
-                                                        !(nf empty env ytm)
-                               case constraints cs of
-                                    [] => pure cs
-                                    _ => do ynf <- evalClosure defs y
-                                            unify mode loc env xnf ynf
-                         (_, NApp _ (NMeta _ i _ ) _) =>
-                            do xnf' <- evalClosure empty x
-                               xtm <- quote empty env xnf'
-                               ytm <- quote empty env ynf
-                               cs <- unify mode loc env !(nf empty env ytm)
-                                                        !(nf empty env xtm)
-                               case constraints cs of
-                                    [] => pure cs
-                                    _ => unify mode loc env xnf ynf
-                         _ => unify mode loc env xnf ynf
+  Unify Glued where
+    unifyD _ _ mode fc env x y
+      = logDepth $ unifyVal mode fc env x y
+
+    unifyWithLazyD _ _ mode fc env x y
+      = logDepth $ unifyValLazy mode fc env x y
 
 export
 setInvertible : {auto c : Ref Ctxt Defs} ->
@@ -1381,17 +1665,21 @@ retry mode c
               Just Resolved => pure success
               Just (MkConstraint loc withLazy env xold yold)
                => do defs <- get Ctxt
-                     x <- continueNF defs env xold
-                     y <- continueNF defs env yold
+                     x <- logQuiet $ nf env xold
+                     y <- logQuiet $ nf env yold
+                     log "unify.retry" 10 (show loc)
+                     logNF "unify.retry" 5 ("Retrying " ++ show c ++ " " ++ show (umode mode))
+                           env x
+                     logNF "unify.retry" 5 "....with" env y
+                     log "unify.retry" 5 $ if withLazy
+                                then "(lazy allowed)"
+                                else "(no lazy)"
+
                      catch
-                       (do logNF "unify.retry" 5 ("Retrying " ++ show c ++ " " ++ show (umode mode)) env x
-                           logNF "unify.retry" 5 "....with" env y
-                           log "unify.retry" 5 $ if withLazy
-                                      then "(lazy allowed)"
-                                      else "(no lazy)"
-                           cs <- ifThenElse withLazy
+                       (do cs <- ifThenElse withLazy
                                     (unifyWithLazy mode loc env x y)
                                     (unify (lower mode) loc env x y)
+                           logC "unify.retry" 5 $ pure "....result: \{show cs}"
                            case constraints cs of
                              [] => do log "unify.retry" 5 $ "Success " ++ show (addLazy cs)
                                       deleteConstraint c
@@ -1399,8 +1687,9 @@ retry mode c
                              _ => do log "unify.retry" 5 $ "Constraints " ++ show (addLazy cs)
                                      pure cs)
                       (\err => do defs <- get Ctxt
-                                  empty <- clearDefs defs
-                                  throw (WhenUnifying loc (gamma defs) env !(quote empty env x) !(quote empty env y) err))
+                                  throw (WhenUnifying loc (gamma defs) env
+                                                      !(quote env x)
+                                                      !(quote env y) err))
 
 delayMeta : {vars : _} ->
             LazyReason -> Nat -> Term vars -> Term vars -> Term vars
@@ -1439,7 +1728,10 @@ retryGuess mode smode (hid, (loc, hname))
                   handleUnify
                      (do tm <- search loc rig (smode == Defaults) depth defining
                                       (type def) Env.empty
-                         let gdef = { definition := PMDef defaultPI Scope.empty (STerm 0 tm) (STerm 0 tm) [] } def
+                         let pi = if isErased rig
+                                    then defaultPI
+                                    else reducePI
+                         let gdef = { definition := Function pi tm tm Nothing } def
                          logTermNF "unify.retry" 5 ("Solved " ++ show hname) Env.empty tm
                          ignore $ addDef (Resolved hid) gdef
                          removeGuess hid
@@ -1453,7 +1745,7 @@ retryGuess mode smode (hid, (loc, hname))
                             pure False -- progress not made yet!
                        err =>
                          do logTermNF "unify.retry" 5
-                                      ("Search failed at " ++ show rig ++ " for " ++ show hname)
+                                      ("Search failed at " ++ show rig ++ " for " ++ show hname ++ " err: " ++ show err)
                                       Env.empty (type def)
                             case smode of
                                  LastChance => throw err
@@ -1461,6 +1753,8 @@ retryGuess mode smode (hid, (loc, hname))
                                          then pure False -- Postpone again
                                          else throw (CantSolveGoal loc (gamma defs)
                                                         Env.empty (type def) (Just err))
+               -- TODO: Check if this is still needed as a performance
+               -- hack
                Guess tm envb [constr] =>
                  do let umode = case smode of
                                      MatchArgs => inMatch
@@ -1471,11 +1765,9 @@ retryGuess mode smode (hid, (loc, hname))
                                            NoLazy => pure tm
                                            AddForce r => pure $ forceMeta r envb tm
                                            AddDelay r =>
-                                              do ty <- getType Env.empty tm
-                                                 logTerm "unify.retry" 5 "Retry Delay" tm
-                                                 pure $ delayMeta r envb !(getTerm ty) tm
-                                  let gdef = { definition := PMDef (MkPMDefInfo NotHole True False)
-                                                                   Scope.empty (STerm 0 tm') (STerm 0 tm') [] } def
+                                              do logTerm "unify.retry" 5 "Retry Delay" tm
+                                                 pure $ delayMeta r envb (type def) tm
+                                  let gdef = { definition := Function reducePI tm' tm' Nothing } def
                                   logTerm "unify.retry" 5 ("Resolved " ++ show hname) tm'
                                   ignore $ addDef (Resolved hid) gdef
                                   removeGuess hid
@@ -1484,9 +1776,8 @@ retryGuess mode smode (hid, (loc, hname))
                                            NoLazy => pure tm
                                            AddForce r => pure $ forceMeta r envb tm
                                            AddDelay r =>
-                                              do ty <- getType Env.empty tm
-                                                 logTerm "unify.retry" 5 "Retry Delay (constrained)" tm
-                                                 pure $ delayMeta r envb !(getTerm ty) tm
+                                              do logTerm "unify.retry" 5 "Retry Delay (constrained)" tm
+                                                 pure $ delayMeta r envb (type def) tm
                                      let gdef = { definition := Guess tm' envb newcs } def
                                      ignore $ addDef (Resolved hid) gdef
                                      pure False
@@ -1500,8 +1791,7 @@ retryGuess mode smode (hid, (loc, hname))
                          -- All constraints resolved, so turn into a
                          -- proper definition and remove it from the
                          -- hole list
-                         [] => do let gdef = { definition := PMDef (MkPMDefInfo NotHole True False)
-                                                                   Scope.empty (STerm 0 tm) (STerm 0 tm) [] } def
+                         [] => do let gdef = { definition := Function reducePI tm tm Nothing } def
                                   logTerm "unify.retry" 5 ("Resolved " ++ show hname) tm
                                   ignore $ addDef (Resolved hid) gdef
                                   removeGuess hid
@@ -1564,7 +1854,7 @@ checkArgsSame : {auto u : Ref UST UState} ->
 checkArgsSame [] = pure False
 checkArgsSame (x :: xs)
     = do defs <- get Ctxt
-         Just (PMDef _ [] (STerm 0 def) _ _) <-
+         Just (Function _ def _ _) <-
                     lookupDefExact (Resolved x) (gamma defs)
               | _ => checkArgsSame xs
          s <- anySame def xs
@@ -1576,10 +1866,10 @@ checkArgsSame (x :: xs)
     anySame tm [] = pure False
     anySame tm (t :: ts)
         = do defs <- get Ctxt
-             Just (PMDef _ [] (STerm 0 def) _ _) <-
+             Just (Function _ def _ _) <-
                         lookupDefExact (Resolved t) (gamma defs)
-                 | _ => anySame tm ts
-             if !(convert defs Env.empty tm def)
+                  | _ => anySame tm ts
+             if !(convert Env.empty tm def)
                 then pure True
                 else anySame tm ts
 
@@ -1594,18 +1884,18 @@ checkDots
          hs <- getCurrentHoles
          update UST { dotConstraints := [] }
   where
-    getHoleName : ClosedTerm -> Core (Maybe Name)
+    getHoleName : Term [<] -> Core (Maybe Name)
     getHoleName tm
         = do defs <- get Ctxt
-             NApp _ (NMeta n' i args) _ <- nf defs Env.empty tm
+             VMeta _ n' i _ _ _ <- expand !(nf Env.empty tm)
                  | _ => pure Nothing
              pure (Just n')
 
     checkConstraint : (Name, DotReason, Constraint) -> Core ()
-    checkConstraint (n, reason, MkConstraint fc wl env xold yold)
+    checkConstraint (n, reason, MkConstraint fc _ env xold yold)
         = do defs <- get Ctxt
-             x <- continueNF defs env xold
-             y <- continueNF defs env yold
+             x <- nf env xold
+             y <- nf env yold
              logNF "unify.constraint" 10 "Dot" env y
              logNF "unify.constraint" 10 "  =" env x
              -- A dot is okay if the constraint is solvable *without solving
@@ -1655,10 +1945,9 @@ checkDots
                               -- Clear constraints so we don't report again
                               -- later
                               put UST ({ dotConstraints := [] } ust)
-                              empty <- clearDefs defs
                               throw (BadDotPattern fc env reason
-                                      !(quote empty env x)
-                                      !(quote empty env y))
+                                      !(quote env x)
+                                      !(quote env y))
                          _ => do put UST ({ dotConstraints := [] } ust)
                                  throw err)
     checkConstraint _ = pure ()
diff --git a/src/Core/UnifyState.idr b/src/Core/UnifyState.idr
index 1c7c5f081e2..18477a26ddf 100644
--- a/src/Core/UnifyState.idr
+++ b/src/Core/UnifyState.idr
@@ -3,13 +3,15 @@ module Core.UnifyState
 
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
+
+import Core.Evaluate.Value
+import Core.Evaluate
+
+import Data.SnocList
 
 import Libraries.Data.IntMap
 import Libraries.Data.NameMap
 import Libraries.Data.WithDefault
-
 import Libraries.Data.SnocList.HasLength
 
 %default covering
@@ -22,7 +24,7 @@ data Constraint : Type where
                     FC ->
                     (withLazy : Bool) ->
                     (env : Env Term vars) ->
-                    (x : NF vars) -> (y : NF vars) ->
+                    (x : Term vars) -> (y : Term vars) ->
                     Constraint
      -- A resolved constraint
      Resolved : Constraint
@@ -36,8 +38,8 @@ data PolyConstraint : Type where
      MkPolyConstraint : {vars : _} ->
                         FC -> Env Term vars ->
                         (arg : Term vars) ->
-                        (expty : NF vars) ->
-                        (argty : NF vars) -> PolyConstraint
+                        (expty : Glued vars) ->
+                        (argty : Term vars) -> PolyConstraint
 
 -- Explanation for why an elaborator has been delayed. It's helpful to know
 -- the reason for a delay (I wish airlines and train companies knew this)
@@ -295,101 +297,46 @@ addDot : {vars : _} ->
          Core ()
 addDot fc env dotarg x reason y
     = do defs <- get Ctxt
-         xnf <- nf defs env x
-         ynf <- nf defs env y
-         update UST { dotConstraints $= ((dotarg, reason, MkConstraint fc False env xnf ynf) ::) }
+         update UST { dotConstraints $= ((dotarg, reason, MkConstraint fc False env x y) ::) }
 
 export
 addPolyConstraint : {vars : _} ->
                     {auto u : Ref UST UState} ->
-                    FC -> Env Term vars -> Term vars -> NF vars -> NF vars ->
+                    FC -> Env Term vars -> Term vars -> Glued vars -> Term vars ->
                     Core ()
-addPolyConstraint fc env arg x@(NApp _ (NMeta {}) _) y
+addPolyConstraint fc env arg x@(VMeta {} _ _ _) y
     = update UST { polyConstraints $= ((MkPolyConstraint fc env arg x y) ::) }
 addPolyConstraint fc env arg x y
     = pure ()
 
-mkLocal : {wkns : SnocList Name} -> FC -> Binder (Term vars) -> Term (wkns <>> x :: (vars ++ done))
-mkLocal fc b = Local fc (Just (isLet b)) _ (mkIsVarChiply (mkHasLength wkns))
+mkLocal : {wkns : SnocList Name} -> FC -> Binder (Term vars) -> Term (((done ++ vars) :< x ++ wkns))
+mkLocal fc b = Local fc (Just (isLet b)) _ (mkIsVar (mkHasLength wkns))
 
 mkConstantAppArgs : {vars : _} ->
                     Bool -> FC -> Env Term vars ->
                     (wkns : SnocList Name) ->
-                    List (Term (wkns <>> (vars ++ done)))
-mkConstantAppArgs lets fc [] wkns = []
-mkConstantAppArgs {done} {vars = x :: xs} lets fc (b :: env) wkns
-    = let rec = mkConstantAppArgs {done} lets fc env (wkns :< x) in
-          if lets || not (isLet b)
-             then mkLocal fc b :: rec
-             else rec
-
-mkConstantAppArgsSub : {vars : _} ->
-                       Bool -> FC -> Env Term vars ->
-                       Thin smaller vars ->
-                       (wkns : SnocList Name) ->
-                       List (Term (wkns <>> (vars ++ done)))
-mkConstantAppArgsSub lets fc [] p wkns = []
-mkConstantAppArgsSub {done} {vars = x :: xs}
-                        lets fc (b :: env) Refl wkns
-    = mkConstantAppArgs lets fc env (wkns :< x)
-mkConstantAppArgsSub {done} {vars = x :: xs}
-                        lets fc (b :: env) (Drop p) wkns
-    = mkConstantAppArgsSub lets fc env p (wkns :< x)
-mkConstantAppArgsSub {done} {vars = x :: xs}
-                        lets fc (b :: env) (Keep p) wkns
-    = let rec = mkConstantAppArgsSub {done} lets fc env p (wkns :< x) in
-          if lets || not (isLet b)
-             then mkLocal fc b :: rec
-             else rec
-
-mkConstantAppArgsOthers : {vars : _} ->
-                          Bool -> FC -> Env Term vars ->
-                          Thin smaller vars ->
-                          (wkns : SnocList Name) ->
-                          List (Term (wkns <>> (vars ++ done)))
-mkConstantAppArgsOthers lets fc [] p wkns = []
-mkConstantAppArgsOthers {done} {vars = x :: xs}
-                        lets fc (b :: env) Refl wkns
-    = mkConstantAppArgsOthers lets fc env Refl (wkns :< x)
-mkConstantAppArgsOthers {done} {vars = x :: xs}
-                        lets fc (b :: env) (Keep p) wkns
-    = mkConstantAppArgsOthers lets fc env p (wkns :< x)
-mkConstantAppArgsOthers {done} {vars = x :: xs}
-                        lets fc (b :: env) (Drop p) wkns
-    = let rec = mkConstantAppArgsOthers {done} lets fc env p (wkns :< x) in
+                    List (RigCount, Term ((done ++ vars) ++ wkns))
+mkConstantAppArgs lets fc [<] wkns = []
+mkConstantAppArgs {done} {vars = xs :< x} lets fc (env :< b) wkns
+    = let rec = mkConstantAppArgs {done} lets fc env (cons x wkns) in
           if lets || not (isLet b)
-             then mkLocal fc b :: rec
-             else rec
+             then (multiplicity b, mkLocal fc b) ::
+                rewrite sym $ appendAssociative (done ++ xs) [<x] wkns in rec
+             else rewrite sym $ appendAssociative (done ++ xs) [<x] wkns in rec
 
 export
 applyTo : {vars : _} ->
           FC -> Term vars -> Env Term vars -> Term vars
 applyTo fc tm env
   = let args = reverse (mkConstantAppArgs {done = Scope.empty} False fc env [<]) in
-        apply fc tm (rewrite sym (appendNilRightNeutral vars) in args)
+        apply fc tm (rewrite sym (appendLinLeftNeutral vars) in args)
 
 export
 applyToFull : {vars : _} ->
               FC -> Term vars -> Env Term vars -> Term vars
 applyToFull fc tm env
   = let args = reverse (mkConstantAppArgs {done = Scope.empty} True fc env [<]) in
-        apply fc tm (rewrite sym (appendNilRightNeutral vars) in args)
-
-export
-applyToSub : {vars : _} ->
-             FC -> Term vars -> Env Term vars ->
-             Thin smaller vars -> Term vars
-applyToSub fc tm env sub
-  = let args = reverse (mkConstantAppArgsSub {done = Scope.empty} True fc env sub [<]) in
-        apply fc tm (rewrite sym (appendNilRightNeutral vars) in args)
-
-export
-applyToOthers : {vars : _} ->
-                FC -> Term vars -> Env Term vars ->
-                Thin smaller vars -> Term vars
-applyToOthers fc tm env sub
-  = let args = reverse (mkConstantAppArgsOthers {done = Scope.empty} True fc env sub [<]) in
-        apply fc tm (rewrite sym (appendNilRightNeutral vars) in args)
+        apply fc tm (rewrite sym (appendLinLeftNeutral vars) in args)
 
 -- Create a new metavariable with the given name and return type,
 -- and return a term which is the metavariable applied to the environment
@@ -412,12 +359,14 @@ newMetaLets {vars} fc rig env n ty def nocyc lets
          log "unify.meta" 5 $ "Adding new meta " ++ show (n, fc, rig)
          logTerm "unify.meta" 10 ("New meta type " ++ show n) hty
          idx <- addDef n hole
+         let app = Meta fc n idx envArgs
+         logTerm "unify.meta" 10 ("New meta app " ++ show n) app
          addHoleName fc n idx
-         pure (idx, Meta fc n idx envArgs)
+         pure (idx, app)
   where
-    envArgs : List (Term vars)
+    envArgs : List (RigCount, Term vars)
     envArgs = let args = reverse (mkConstantAppArgs {done = Scope.empty} lets fc env [<]) in
-                  rewrite sym (appendNilRightNeutral vars) in args
+                  (rewrite sym (appendLinLeftNeutral vars) in args)
 
 export
 newMeta : {vars : _} ->
@@ -431,10 +380,10 @@ newMeta fc r env n ty def cyc = newMetaLets fc r env n ty def cyc False
 
 mkConstant : {vars : _} ->
              FC -> Env Term vars -> Term vars -> ClosedTerm
-mkConstant fc [] tm = tm
+mkConstant fc [<] tm = tm
 -- mkConstant {vars = x :: _} fc (Let c val ty :: env) tm
 --     = mkConstant fc env (Bind fc x (Let c val ty) tm)
-mkConstant {vars = x :: _} fc (b :: env) tm
+mkConstant {vars = _ :< x} fc (env :< b) tm
     = let ty = binderType b in
           mkConstant fc env (Bind fc x (Lam fc (multiplicity b) Explicit ty) tm)
 
@@ -461,9 +410,9 @@ newConstant {vars} fc rig env tm ty constrs
          addGuessName fc cn idx
          pure (Meta fc cn idx envArgs)
   where
-    envArgs : List (Term vars)
+    envArgs : List (RigCount, Term vars)
     envArgs = let args = reverse (mkConstantAppArgs {done = Scope.empty} True fc env [<]) in
-                  rewrite sym (appendNilRightNeutral vars) in args
+                  rewrite sym (appendLinLeftNeutral vars) in args
 
 -- Create a new search with the given name and return type,
 -- and return a term which is the name applied to the environment
@@ -483,9 +432,9 @@ newSearch {vars} fc rig depth def env n ty
          addGuessName fc n idx
          pure (idx, Meta fc n idx envArgs)
   where
-    envArgs : List (Term vars)
+    envArgs : List (RigCount, Term vars)
     envArgs = let args = reverse (mkConstantAppArgs {done = Scope.empty} False fc env [<]) in
-                  rewrite sym (appendNilRightNeutral vars) in args
+                  rewrite sym (appendLinLeftNeutral vars) in args
 
 -- Add a hole which stands for a delayed elaborator
 export
@@ -503,9 +452,9 @@ newDelayed {vars} fc rig env n ty
          addHoleName fc n idx
          pure (idx, Meta fc n idx envArgs)
   where
-    envArgs : List (Term vars)
+    envArgs : List (RigCount, Term vars)
     envArgs = let args = reverse (mkConstantAppArgs {done = Scope.empty} False fc env [<]) in
-                  rewrite sym (appendNilRightNeutral vars) in args
+                  rewrite sym (appendLinLeftNeutral vars) in args
 
 export
 tryErrorUnify : {auto c : Ref Ctxt Defs} ->
@@ -584,11 +533,8 @@ checkValidHole base (idx, (fc, n))
                           | Nothing => pure ()
                      case c of
                           MkConstraint fc l env x y =>
-                             do put UST ({ guesses := empty } ust)
-                                empty <- clearDefs defs
-                                xnf <- quote empty env x
-                                ynf <- quote empty env y
-                                throw (CantSolveEq fc (gamma defs) env xnf ynf)
+                            do put UST ({ guesses := empty } ust)
+                               throw (CantSolveEq fc (gamma defs) env x y)
                           _ => pure ()
               _ => traverse_ checkRef !(traverse getFullName
                                         ((keys (getRefs (Resolved (-1)) (type gdef)))))
@@ -612,7 +558,7 @@ checkUserHolesAfter base now
     = do gs_map <- getGuesses
          let gs = toList gs_map
          log "unify.unsolved" 10 $ "Unsolved guesses " ++ show gs
-         List.traverse_ (checkValidHole base) gs
+         Core.Core.List.traverse_ (checkValidHole base) gs
          hs_map <- getCurrentHoles
          let hs = toList hs_map
          let hs' = if any isUserName (map (snd . snd) hs)
@@ -645,58 +591,56 @@ dumpHole : {auto u : Ref UST UState} ->
 dumpHole s n hole
     = do ust <- get UST
          defs <- get Ctxt
+         depth <- getDepth
          case !(lookupCtxtExact (Resolved hole) (gamma defs)) of
           Nothing => pure ()
           Just gdef => case (definition gdef, type gdef) of
              (Guess tm envb constraints, ty) =>
-                  do logString s.topic n $
-                       "!" ++ show !(getFullName (Resolved hole)) ++ " : "
-                           ++ show !(toFullNames !(normaliseHoles defs Env.empty ty))
+                  do logString depth s.topic n $
+                       "! \{show hole} " ++ show !(getFullName (Resolved hole)) ++ " : "
+                           ++ show !(toFullNames !(logQuiet $ normaliseHoles Env.empty ty))
                        ++ "\n\t  = "
-                           ++ show !(normaliseHoles defs Env.empty tm)
+                           ++ show !(toFullNames !(logQuiet $ normaliseHoles Env.empty tm))
                            ++ "\n\twhen"
                      traverse_ dumpConstraint constraints
              (Hole _ p, ty) =>
-                  logString s.topic n $
-                    "?" ++ show (fullname gdef) ++ " : "
-                        ++ show !(normaliseHoles defs Env.empty ty)
+                  logString depth s.topic n $
+                    "? \{show hole} " ++ show (fullname gdef) ++ " : "
+                        ++ show !(toFullNames !(logQuiet $ normaliseHoles Env.empty ty))
                         ++ if implbind p then " (ImplBind)" else ""
                         ++ if invertible gdef then " (Invertible)" else ""
              (BySearch _ _ _, ty) =>
-                  logString s.topic n $
+                  logString depth s.topic n $
                      "Search " ++ show hole ++ " : " ++
-                     show !(toFullNames !(normaliseHoles defs Env.empty ty))
-             (PMDef _ args t _ _, ty) =>
+                     show !(toFullNames !(logQuiet $ normaliseHoles Env.empty ty))
+             (Function _ t _ _, ty) =>
                   log s 4 $
                      "Solved: " ++ show hole ++ " : " ++
-                     show !(normalise defs Env.empty ty) ++
-                     " = " ++ show !(normalise defs Env.empty (Ref emptyFC Func (Resolved hole)))
+                     show !(toFullNames !(logQuiet $ normalise Env.empty ty)) ++
+                     " = " ++ show !(toFullNames !(logQuiet $ normalise Env.empty (Ref emptyFC Func (Resolved hole))))
              (ImpBind, ty) =>
                   log s 4 $
                       "Bound: " ++ show hole ++ " : " ++
-                      show !(normalise defs Env.empty ty)
+                      show !(toFullNames !(logQuiet $ normalise Env.empty ty))
              (Delayed, ty) =>
                   log s 4 $
                      "Delayed elaborator : " ++
-                     show !(normalise defs Env.empty ty)
+                     show !(toFullNames !(logQuiet $ normalise Env.empty ty))
              _ => pure ()
   where
     dumpConstraint : Int -> Core ()
     dumpConstraint cid
         = do ust <- get UST
              defs <- get Ctxt
+             depth <- getDepth
              case lookup cid (constraints ust) of
-                  Nothing => pure ()
-                  Just Resolved => logString s.topic n "\tResolved"
-                  Just (MkConstraint _ lazy env x y) =>
-                    do logString s.topic n $
-                         "\t  " ++ show !(toFullNames !(quote defs env x))
-                                ++ " =?= " ++ show !(toFullNames !(quote defs env y))
-                       empty <- clearDefs defs
-                       log s 5 $
-                         "\t    from " ++ show !(toFullNames !(quote empty env x))
-                            ++ " =?= " ++ show !(toFullNames !(quote empty env y))
-                            ++ if lazy then "\n\t(lazy allowed)" else ""
+               Nothing => pure ()
+               Just Resolved => logString depth s.topic n "\tResolved"
+               Just (MkConstraint _ lazy env x y) =>
+                    logString depth s.topic n $
+                         "\t  " ++ show !(toFullNames x)
+                                ++ " =?= " ++ show !(toFullNames y)
+                                ++ if lazy then "\n\t(lazy allowed)" else ""
 
 export
 dumpConstraints : {auto u : Ref UST UState} ->
@@ -709,5 +653,6 @@ dumpConstraints s n all
            let hs = toList (guesses ust) ++
                     toList (if all then holes ust else currentHoles ust)
            unless (isNil hs) $
-             do logString s.topic n "--- CONSTRAINTS AND HOLES ---"
-                traverse_ (dumpHole s n) (map fst hs)
+             do depth <- getDepth
+                logString depth s.topic n "--- CONSTRAINTS AND HOLES ---"
+                logDepth $ traverse_ (dumpHole s n) (map fst hs)
diff --git a/src/Core/Value.idr b/src/Core/Value.idr
deleted file mode 100644
index f0fea423b7f..00000000000
--- a/src/Core/Value.idr
+++ /dev/null
@@ -1,256 +0,0 @@
-module Core.Value
-
-import Core.Context
-import Core.Env
-
-import Data.List.Quantifiers
-
-%default covering
-
-public export
-data EvalOrder = CBV | CBN
-
-public export
-record EvalOpts where
-  constructor MkEvalOpts
-  holesOnly : Bool -- only evaluate hole solutions
-  argHolesOnly : Bool -- only evaluate holes which are relevant arguments
-  removeAs : Bool -- reduce 'as' patterns (don't do this on LHS)
-  evalAll : Bool -- evaluate everything, including private names
-  tcInline : Bool -- inline for totality checking
-  fuel : Maybe Nat -- Limit for recursion depth
-  reduceLimit : List (Name, Nat) -- reduction limits for given names. If not
-                     -- present, no limit
-  strategy : EvalOrder
-
-export
-defaultOpts : EvalOpts
-defaultOpts = MkEvalOpts
-    { holesOnly = False
-    , argHolesOnly = False
-    , removeAs = True
-    , evalAll = False
-    , tcInline = False
-    , fuel = Nothing
-    , reduceLimit = []
-    , strategy = CBN
-    }
-
-export
-withHoles : EvalOpts
-withHoles = MkEvalOpts
-    { holesOnly = True
-    , argHolesOnly = True
-    , removeAs = False
-    , evalAll = False
-    , tcInline = False
-    , fuel = Nothing
-    , reduceLimit = []
-    , strategy = CBN
-    }
-
-export
-withAll : EvalOpts
-withAll = MkEvalOpts
-    { holesOnly = False
-    , argHolesOnly = False
-    , removeAs = True
-    , evalAll = True
-    , tcInline = False
-    , fuel = Nothing
-    , reduceLimit = []
-    , strategy = CBN
-    }
-
-export
-withArgHoles : EvalOpts
-withArgHoles = MkEvalOpts
-    { holesOnly = False
-    , argHolesOnly = True
-    , removeAs = False
-    , evalAll = False
-    , tcInline = False
-    , fuel = Nothing
-    , reduceLimit = []
-    , strategy = CBN
-    }
-
-export
-tcOnly : EvalOpts
-tcOnly = { tcInline := True } withArgHoles
-
-export
-onLHS : EvalOpts
-onLHS = { removeAs := False } defaultOpts
-
-export
-cbn : EvalOpts
-cbn = defaultOpts
-
-export
-cbv : EvalOpts
-cbv = { strategy := CBV } defaultOpts
-
-mutual
-  -- TODO swap arguments and type as `Scope -> Scoped`
-  public export
-  LocalEnv : Scope -> Scope -> Type
-  LocalEnv free = All (\_ => Closure free)
-
-  public export
-  data Closure : Scoped where
-       MkClosure : {vars : _} ->
-                   (opts : EvalOpts) ->
-                   LocalEnv free vars ->
-                   Env Term free ->
-                   Term (Scope.addInner free vars) -> Closure free
-       MkNFClosure : EvalOpts -> Env Term free -> NF free -> Closure free
-
-  -- The head of a value: things you can apply arguments to
-  public export
-  data NHead : Scoped where
-       NLocal : Maybe Bool -> (idx : Nat) -> (0 p : IsVar nm idx vars) ->
-                NHead vars
-       NRef   : NameType -> Name -> NHead vars
-       NMeta  : Name -> Int -> List (Closure vars) -> NHead vars
-
-
-  -- Values themselves. 'Closure' is an unevaluated thunk, which means
-  -- we can wait until necessary to reduce constructor arguments
-  public export
-  data NF : Scoped where
-       NBind    : FC -> (x : Name) -> Binder (Closure vars) ->
-                  (Defs -> Closure vars -> Core (NF vars)) -> NF vars
-       -- Each closure is associated with the file context of the App node that
-       -- had it as an argument. It's necessary so as to not lose file context
-       -- information when creating the normal form.
-       NApp     : FC -> NHead vars -> List (FC, Closure vars) -> NF vars
-       NDCon    : FC -> Name -> (tag : Int) -> (arity : Nat) ->
-                  List (FC, Closure vars) -> NF vars
-                  -- TODO it looks like the list of closures is stored in spine order, c.f. `getCaseBounds`
-       NTCon    : FC -> Name -> (arity : Nat) ->
-                  List (FC, Closure vars) -> NF vars
-       NAs      : FC -> UseSide -> NF vars -> NF vars -> NF vars
-       NDelayed : FC -> LazyReason -> NF vars -> NF vars
-       NDelay   : FC -> LazyReason -> Closure vars -> Closure vars -> NF vars
-       NForce   : FC -> LazyReason -> NF vars -> List (FC, Closure vars) -> NF vars
-       NPrimVal : FC -> Constant -> NF vars
-       NErased  : FC -> WhyErased (NF vars) -> NF vars
-       NType    : FC -> Name -> NF vars
-
-%name LocalEnv lenv
-%name Closure cl
-%name NHead hd
-%name NF nf
-
-public export
-ClosedClosure : Type
-ClosedClosure = Closure []
-
-public export
-ClosedNF : Type
-ClosedNF = NF []
-
-namespace LocalEnv
-  public export
-  empty : LocalEnv free Scope.empty
-  empty = []
-
-export
-ntCon : FC -> Name -> Nat -> List (FC, Closure vars) -> NF vars
--- Part of the machinery for matching on types - I believe this won't affect
--- universe checking so put a dummy name.
-ntCon fc (UN (Basic "Type")) Z [] = NType fc (MN "top" 0)
-ntCon fc n Z [] = case isConstantType n of
-  Just c => NPrimVal fc $ PrT c
-  Nothing => NTCon fc n Z []
-ntCon fc n arity args = NTCon fc n arity args
-
-export
-getLoc : NF vars -> FC
-getLoc (NBind fc _ _ _) = fc
-getLoc (NApp fc _ _) = fc
-getLoc (NDCon fc _ _ _ _) = fc
-getLoc (NTCon fc _ _ _) = fc
-getLoc (NAs fc _ _ _) = fc
-getLoc (NDelayed fc _ _) = fc
-getLoc (NDelay fc _ _ _) = fc
-getLoc (NForce fc _ _ _) = fc
-getLoc (NPrimVal fc _) = fc
-getLoc (NErased fc i) = fc
-getLoc (NType fc _) = fc
-
-export
-{free : _} -> Show (NHead free) where
-  show (NLocal _ idx p) = show (nameAt p) ++ "[" ++ show idx ++ "]"
-  show (NRef _ n) = show n
-  show (NMeta n _ args) = "?" ++ show n ++ "_[" ++ show (length args) ++ " closures]"
-
-Show (Closure free) where
-  show _ = "[closure]"
-
-export
-HasNames (NHead free) where
-  full defs (NRef nt n) = NRef nt <$> full defs n
-  full defs hd = pure hd
-
-  resolved defs (NRef nt n) = NRef nt <$> resolved defs n
-  resolved defs hd = pure hd
-
-export
-HasNames (NF free) where
-  full defs (NBind fc x bd f) = pure $ NBind fc x bd f
-  full defs (NApp fc hd xs) = pure $ NApp fc !(full defs hd) xs
-  full defs (NDCon fc n tag arity xs) = pure $ NDCon fc !(full defs n) tag arity xs
-  full defs (NTCon fc n arity xs) = pure $ NTCon fc !(full defs n) arity xs
-  full defs (NAs fc side nf nf1) = pure $ NAs fc side !(full defs nf) !(full defs nf1)
-  full defs (NDelayed fc lz nf) = pure $ NDelayed fc lz !(full defs nf)
-  full defs (NDelay fc lz cl cl1) = pure $ NDelay fc lz cl cl1
-  full defs (NForce fc lz nf xs) = pure $ NForce fc lz !(full defs nf) xs
-  full defs (NPrimVal fc cst) = pure $ NPrimVal fc cst
-  full defs (NErased fc imp) = pure $ NErased fc imp
-  full defs (NType fc n) = pure $ NType fc !(full defs n)
-
-  resolved defs (NBind fc x bd f) = pure $ NBind fc x bd f
-  resolved defs (NApp fc hd xs) = pure $ NApp fc !(resolved defs hd) xs
-  resolved defs (NDCon fc n tag arity xs) = pure $ NDCon fc !(resolved defs n) tag arity xs
-  resolved defs (NTCon fc n arity xs) = pure $ NTCon fc !(resolved defs n) arity xs
-  resolved defs (NAs fc side nf nf1) = pure $ NAs fc side !(resolved defs nf) !(resolved defs nf1)
-  resolved defs (NDelayed fc lz nf) = pure $ NDelayed fc lz !(resolved defs nf)
-  resolved defs (NDelay fc lz cl cl1) = pure $ NDelay fc lz cl cl1
-  resolved defs (NForce fc lz nf xs) = pure $ NForce fc lz !(resolved defs nf) xs
-  resolved defs (NPrimVal fc cst) = pure $ NPrimVal fc cst
-  resolved defs (NErased fc imp) = pure $ NErased fc imp
-  resolved defs (NType fc n) = pure $ NType fc !(resolved defs n)
-
-export
-covering
-{free : _} -> Show (NF free) where
-  show (NBind _ x (Lam _ c info ty) _)
-    = "\\" ++ withPiInfo info (showCount c ++ show x ++ " : " ++ show ty) ++
-      " => [closure]"
-  show (NBind _ x (Let _ c val ty) _)
-    = "let " ++ showCount c ++ show x ++ " : " ++ show ty ++
-      " = " ++ show val ++ " in [closure]"
-  show (NBind _ x (Pi _ c info ty) _)
-    = withPiInfo info (showCount c ++ show x ++ " : " ++ show ty) ++
-      " -> [closure]"
-  show (NBind _ x (PVar _ c info ty) _)
-    = withPiInfo info ("pat " ++ showCount c ++ show x ++ " : " ++ show ty) ++
-      " => [closure]"
-  show (NBind _ x (PLet _ c val ty) _)
-    = "plet " ++ showCount c ++ show x ++ " : " ++ show ty ++
-      " = " ++ show val ++ " in [closure]"
-  show (NBind _ x (PVTy _ c ty) _)
-    = "pty " ++ showCount c ++ show x ++ " : " ++ show ty ++
-      " => [closure]"
-  show (NApp _ hd args) = show hd ++ " [" ++ show (length args) ++ " closures]"
-  show (NDCon _ n _ _ args) = show n ++ " [" ++ show (length args) ++ " closures]"
-  show (NTCon _ n _ args) = show n ++ " [" ++ show (length args) ++ " closures]"
-  show (NAs _ _ n tm) = show n ++ "@" ++ show tm
-  show (NDelayed _ _ tm) = "%Delayed " ++ show tm
-  show (NDelay {}) = "%Delay [closure]"
-  show (NForce _ _ tm args) = "%Force " ++ show tm ++ " [" ++ show (length args) ++ " closures]"
-  show (NPrimVal _ c) = show c
-  show (NErased {}) = "[__]"
-  show (NType {}) = "Type"
diff --git a/src/Idris/CommandLine.idr b/src/Idris/CommandLine.idr
index 53dbbb2a4b5..a1e7f32a97e 100644
--- a/src/Idris/CommandLine.idr
+++ b/src/Idris/CommandLine.idr
@@ -116,6 +116,8 @@ data CLOpt
   Color Bool |
    ||| Set the log level globally
   Logging LogLevel |
+   ||| Enable logging in a tree-like output
+  LoggingTree |
    ||| Add a package as a dependency
   PkgPath String |
    ||| List installed packages
@@ -351,6 +353,8 @@ options = [MkOpt ["--check", "-c"] [] [CheckOnly]
               (Just "Verbose mode (default)"),
            MkOpt ["--log"] [RequiredLogLevel "log level"] (\l => [Logging l])
               (Just "Global log level (0 by default)"),
+           MkOpt ["--log-tree"] [] [LoggingTree]
+              (Just "Enable log output in a tree-like view to allow folding/unfolding inner parts (disabled by default)"),
 
            optSeparator,
            MkOpt ["--version", "-v"] [] [Version]
@@ -398,14 +402,9 @@ options = [MkOpt ["--check", "-c"] [] [CheckOnly]
 
 optShow : OptDesc -> (String, Maybe String)
 optShow (MkOpt [] _ _ _) = ("", Just "")
-optShow (MkOpt flags argdescs action help) = (showSep ", " flags ++ " " ++
-                                              showSep " " (map show argdescs),
+optShow (MkOpt flags argdescs action help) = (joinBy ", " flags ++ " " ++
+                                              joinBy " " (map show argdescs),
                                               help)
-  where
-    showSep : String -> List String -> String
-    showSep sep [] = ""
-    showSep sep [x] = x
-    showSep sep (x :: xs) = x ++ sep ++ showSep sep xs
 
 firstColumnWidth : Nat
 firstColumnWidth = let maxOpt = foldr max 0 $ map (length . fst . optShow) options
diff --git a/src/Idris/Doc/Display.idr b/src/Idris/Doc/Display.idr
index 2f57cf0347e..3cb27691a8d 100644
--- a/src/Idris/Doc/Display.idr
+++ b/src/Idris/Doc/Display.idr
@@ -1,6 +1,7 @@
 module Idris.Doc.Display
 
 import Core.Env
+import Core.Evaluate
 
 import Idris.IDEMode.Holes
 
@@ -16,34 +17,34 @@ import Idris.Syntax.Views
 export
 displayType : {auto c : Ref Ctxt Defs} ->
               {auto s : Ref Syn SyntaxInfo} ->
-              (shortName : Bool) -> Defs -> (Name, Int, GlobalDef) ->
+              (shortName : Bool) -> (Name, Int, GlobalDef) ->
               Core (Doc IdrisSyntax)
-displayType shortName defs (n, i, gdef)
-  = maybe (do tm <- resugar Env.empty !(normaliseHoles defs Env.empty (type gdef))
+displayType shortName (n, i, gdef)
+  = maybe (do tm <- resugar Env.empty !(normaliseHoles Env.empty (type gdef))
               nm <- aliasName (fullname gdef)
               let nm = ifThenElse shortName (dropNS nm) nm
               let prig = prettyRig gdef.multiplicity
               let ann = showCategory id gdef
               pure (prig <+> ann (cast $ prettyOp True nm) <++> colon <++> pretty tm))
-          (\num => prettyHole defs Env.empty n num (type gdef))
+          (\num => prettyHole Env.empty n num (type gdef))
           (isHole gdef)
 export
 displayTerm : {auto c : Ref Ctxt Defs} ->
               {auto s : Ref Syn SyntaxInfo} ->
-              Defs -> ClosedTerm ->
+              ClosedTerm ->
               Core (Doc IdrisSyntax)
-displayTerm defs tm
-  = do ptm <- resugar Env.empty !(normaliseHoles defs Env.empty tm)
+displayTerm tm
+  = do ptm <- resugar Env.empty !(normaliseHoles Env.empty tm)
        pure (pretty ptm)
 
 export
 displayClause : {auto c : Ref Ctxt Defs} ->
                 {auto s : Ref Syn SyntaxInfo} ->
-                Defs -> (vs ** (Env Term vs, Term vs, Term vs)) ->
+                Clause ->
                 Core (Doc IdrisSyntax)
-displayClause defs (vs ** (env, lhs, rhs))
-  = do lhstm <- resugar env !(normaliseHoles defs env lhs)
-       rhstm <- resugar env !(normaliseHoles defs env rhs)
+displayClause (MkClause env lhs rhs)
+  = do lhstm <- resugar env !(normaliseHoles env lhs)
+       rhstm <- resugar env !(normaliseHoles env rhs)
        pure (prettyLHS lhstm <++> equals <++> pretty rhstm)
 
   where
@@ -54,25 +55,25 @@ displayClause defs (vs ** (env, lhs, rhs))
 export
 displayPats : {auto c : Ref Ctxt Defs} ->
               {auto s : Ref Syn SyntaxInfo} ->
-              (shortName : Bool) -> Defs -> (Name, Int, GlobalDef) ->
+              (shortName : Bool) -> (Name, Int, GlobalDef) ->
               Core (Doc IdrisSyntax)
-displayPats shortName defs (n, idx, gdef)
+displayPats shortName (n, idx, gdef)
   = case definition gdef of
-      PMDef _ _ _ _ pats =>
-        do ty <- displayType shortName defs (n, idx, gdef)
-           ps <- traverse (displayClause defs) pats
+      Function _ _ _ pats =>
+        do ty <- displayType shortName (n, idx, gdef)
+           ps <- traverse (displayClause) (maybe [] id pats)
            pure (vsep (ty :: ps))
       _ => pure (pretty0 n <++> reflow "is not a pattern matching definition")
 
 export
 displayImpl : {auto c : Ref Ctxt Defs} ->
               {auto s : Ref Syn SyntaxInfo} ->
-              Defs -> (Name, Int, GlobalDef) ->
+              (Name, Int, GlobalDef) ->
               Core (Doc IdrisSyntax)
-displayImpl defs (n, idx, gdef)
+displayImpl (n, idx, gdef)
   = case definition gdef of
-      PMDef _ _ ct _ [(vars ** (env,  _, rhs))] =>
-        do rhstm <- resugar env !(normaliseHoles defs env rhs)
+      Function _ ct _ (Just [MkClause env  _ rhs]) =>
+        do rhstm <- resugar env !(normaliseHoles env rhs)
            let (_, args) = getFnArgs defaultKindedName rhstm
            defs <- get Ctxt
            pds <- map catMaybes $ for args $ \ arg => do
@@ -87,7 +88,7 @@ displayImpl defs (n, idx, gdef)
              Just (idx, gdef) <- lookupCtxtExactI kn.fullName (gamma defs)
                | _ => do log "doc.implementation" 10 $ "Couldn't find \{show @{Raw} nm}"
                          pure Nothing
-             pdef <- displayPats True defs (nm, idx, gdef)
+             pdef <- displayPats True (nm, idx, gdef)
              pure (Just pdef)
            pure (vcat $ intersperse "" pds)
       _ => pure (pretty0 n <++> reflow "is not an implementation definition")
diff --git a/src/Idris/Doc/String.idr b/src/Idris/Doc/String.idr
index 8ee2249234b..8b33033db3f 100644
--- a/src/Idris/Doc/String.idr
+++ b/src/Idris/Doc/String.idr
@@ -2,6 +2,7 @@ module Idris.Doc.String
 
 import Core.Env
 import Core.TT.Traversals
+import Core.Evaluate
 
 import Idris.Doc.Display
 import Idris.Pretty
@@ -78,8 +79,7 @@ prettyType : {auto c : Ref Ctxt Defs} ->
              {auto s : Ref Syn SyntaxInfo} ->
              (IdrisSyntax -> ann) -> ClosedTerm -> Core (Doc ann)
 prettyType syn ty = do
-  defs <- get Ctxt
-  ty <- normaliseHoles defs Env.empty ty
+  ty <- normaliseHoles Env.empty ty
   ty <- toFullNames ty
   ty <- resugar Env.empty ty
   pure (prettyBy syn ty)
@@ -99,7 +99,7 @@ getImplDocs keep
               let Just Func = defNameType (definition def)
                 | _ => pure []
               -- Check that the type mentions the name of interest
-              ty <- toFullNames !(normaliseHoles defs Env.empty (type def))
+              ty <- toFullNames !(normaliseHoles Env.empty (type def))
               True <- keep ty
                 | False => pure []
               ty <- resugar Env.empty ty
@@ -409,7 +409,7 @@ getDocsForName fc n config
              | [ifacedata] => (Just "interface",) . pure <$> getIFaceDoc ifacedata
              | _ => pure (Nothing, []) -- shouldn't happen, we've resolved ambiguity by now
          case definition d of
-           PMDef {} => pure ( Nothing
+           Function {} => pure ( Nothing
                                    , catMaybes [ showTotal (totality d)
                                                , pure (showVisible (collapseDefault $ visibility d))])
            TCon _ _ _ _ _ cons _ =>
@@ -442,7 +442,7 @@ getDocsForName fc n config
                                (pure (Nothing, []))
 
              -- Then form the type declaration
-             ty <- resugar Env.empty =<< normaliseHoles defs Env.empty (type def)
+             ty <- resugar Env.empty =<< normaliseHoles Env.empty (type def)
              -- when printing e.g. interface methods there is no point in
              -- repeating the interface's name
              let ty = ifThenElse (not dropFirst) ty $ case ty of
@@ -495,7 +495,7 @@ getDocsForImplementation t = do
     -- get the return type of all the candidate hints
     Just (ix, def) <- lookupCtxtExactI hint (gamma defs)
       | Nothing => pure Nothing
-    ty <- resugar Env.empty =<< normaliseHoles defs Env.empty (type def)
+    ty <- resugar Env.empty =<< normaliseHoles Env.empty (type def)
     let (_, retTy) = underPis ty
     -- try to see whether it approximates what we are looking for
     -- we throw the head away because it'll be the interface name (I)
@@ -536,7 +536,7 @@ getDocsForImplementation t = do
     pure (Just (hint, ix, def))
   case impls of
     [] => pure $ Just $ "Could not find an implementation for" <++> pretty0 (show t) --hack
-    _ => do ds <- traverse (displayImpl defs) impls
+    _ => do ds <- traverse displayImpl impls
             pure $ Just $ vcat ds
 
 export
diff --git a/src/Idris/Elab/Implementation.idr b/src/Idris/Elab/Implementation.idr
index e8f5b0e44af..f83e2d151f5 100644
--- a/src/Idris/Elab/Implementation.idr
+++ b/src/Idris/Elab/Implementation.idr
@@ -3,6 +3,9 @@ module Idris.Elab.Implementation
 import Core.Env
 import Core.Metadata
 import Core.Unify
+import Core.Evaluate.Value
+import Core.Evaluate.Convert
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -16,7 +19,9 @@ import TTImp.TTImp.Functor
 import TTImp.Unelab
 import TTImp.Utils
 
+import Data.String
 import Control.Monad.State
+
 import Libraries.Data.ANameMap
 import Libraries.Data.NameMap
 
@@ -38,7 +43,7 @@ mkImplName : FC -> Name -> List RawImp -> Name
 mkImplName fc n ps
     = DN (show n ++ " implementation at " ++ replaceSep (show fc))
          (UN $ Basic ("__Impl_" ++ show n ++ "_" ++
-          showSep "_" (map show ps)))
+          joinBy "_" (map show ps)))
 
 bindConstraints : FC -> PiInfo RawImp ->
                   List (Maybe Name, RawImp) -> RawImp -> RawImp
@@ -101,12 +106,12 @@ getMethImps : {vars : _} ->
               Core (List (Name, RigCount, Maybe RawImp, RawImp))
 getMethImps env (Bind fc x (Pi fc' c Implicit ty) sc)
     = do rty <- map (map rawName) $ unelabNoSugar env ty
-         ts <- getMethImps (Pi fc' c Implicit ty :: env) sc
+         ts <- getMethImps (Env.bind env $ Pi fc' c Implicit ty) sc
          pure ((x, c, Nothing, rty) :: ts)
 getMethImps env (Bind fc x (Pi fc' c (DefImplicit def) ty) sc)
     = do rty <- map (map rawName) $ unelabNoSugar env ty
          rdef <- map (map rawName) $ unelabNoSugar env def
-         ts <- getMethImps (Pi fc' c (DefImplicit def) ty :: env) sc
+         ts <- getMethImps (Env.bind env $ Pi fc' c (DefImplicit def) ty) sc
          pure ((x, c, Just rdef, rty) :: ts)
 getMethImps env tm = pure []
 
@@ -201,7 +206,7 @@ elabImplementation {vars} ifc vis opts_in pass env nest is cons iname ps named i
                                       (IBindHere vfc (PI erased) impTy)
                                       (Just (gType vfc u))
                    let fullty = abstractFullEnvType vfc env ty
-                   ok <- convert defs Env.empty fullty (type gdef)
+                   ok <- convert Env.empty fullty (type gdef)
                    unless ok $ do logTermNF "elab.implementation" 1 "Previous" Env.empty (type gdef)
                                   logTermNF "elab.implementation" 1 "Now" Env.empty fullty
                                   throw (CantConvert (getFC impTy) (gamma defs) Env.empty fullty (type gdef))
@@ -227,7 +232,7 @@ elabImplementation {vars} ifc vis opts_in pass env nest is cons iname ps named i
                log "elab.implementation" 5 $ "Missing methods: " ++ show missing
                when (not (isNil missing)) $
                  throw (GenericMsg ifc ("Missing methods in " ++ show iname ++ ": "
-                                        ++ showSep ", " (map show missing)))
+                                        ++ joinBy ", " (map show missing)))
 
                -- Add the 'using' hints
                defs <- get Ctxt
@@ -252,7 +257,7 @@ elabImplementation {vars} ifc vis opts_in pass env nest is cons iname ps named i
                -- RHS is the constructor applied to a search for the necessary
                -- parent constraints, then the method implementations
                defs <- get Ctxt
-               let fldTys = getFieldArgs !(normaliseHoles defs Env.empty conty)
+               let fldTys = getFieldArgs !(normaliseHoles Env.empty conty)
                log "elab.implementation" 5 $ "Field types " ++ show fldTys
                let irhs = apply (autoImpsApply (IVar vfc con) $ map (const (ISearch vfc 500)) (parents cdata))
                                 (map (mkMethField methImps fldTys) fns)
@@ -276,6 +281,7 @@ elabImplementation {vars} ifc vis opts_in pass env nest is cons iname ps named i
                unsetFlag vfc impName BlockedHint
 
                setFlag vfc impName TCInline
+               setFlag vfc impName BlockReduce
                -- it's the methods we're interested in, not the implementation
                setFlag vfc impName (SetTotal PartialOK)
 
@@ -307,7 +313,7 @@ elabImplementation {vars} ifc vis opts_in pass env nest is cons iname ps named i
                Core (Name, (Maybe Name, List (Var vars), FC -> NameType -> Term vars))
     applyEnv n
         = do n' <- resolveName n
-             pure (Resolved n', (Nothing, reverse (allVars env),
+             pure (Resolved n', (Nothing, VarSet.asList $ allVars env,
                       \fn, nt => applyToFull vfc
                                      (Ref vfc nt (Resolved n')) env))
 
@@ -376,7 +382,7 @@ elabImplementation {vars} ifc vis opts_in pass env nest is cons iname ps named i
         = DN (show n)
              (UN $ Basic (show n ++ "_" ++ show iname ++ "_" ++
                      (if named then show impName_in else "") ++
-                     showSep "_" (map show ps)))
+                     joinBy "_" (map show ps)))
 
     applyCon : Name -> Name -> Core (Name, RawImp)
     applyCon impl n
diff --git a/src/Idris/Elab/Interface.idr b/src/Idris/Elab/Interface.idr
index 6436ac5727a..bb7bcb2cac1 100644
--- a/src/Idris/Elab/Interface.idr
+++ b/src/Idris/Elab/Interface.idr
@@ -14,6 +14,8 @@ import TTImp.Elab.Check
 import TTImp.TTImp
 import TTImp.Utils
 
+import Data.SnocList
+
 import Libraries.Data.ANameMap
 import Libraries.Data.List.Extra
 import Libraries.Data.WithDefault
@@ -470,6 +472,6 @@ elabInterface {vars} ifc def_vis env nest constraints iname params dets mcon bod
                                                  meth_names
                                                  params) nconstraints
              log "elab.interface" 5 $ "Constraint hints from " ++ show constraints ++ ": " ++ show chints
-             List.traverse_ (processDecl [] nest env) (concatMap snd chints)
+             Core.Core.List.traverse_ (processDecl [] nest env) (concatMap snd chints)
              traverse_ (\n => do mn <- inCurrentNS n
                                  setFlag vfc mn TCInline) (map fst chints)
diff --git a/src/Idris/Error.idr b/src/Idris/Error.idr
index 1783acd59b4..7fb7ea8ff41 100644
--- a/src/Idris/Error.idr
+++ b/src/Idris/Error.idr
@@ -1,6 +1,7 @@
 module Idris.Error
 
 import Core.Env
+import Core.Evaluate
 
 import Idris.Doc.String
 import Idris.REPL.Opts
@@ -146,8 +147,7 @@ pshow : {vars : _} ->
         {auto s : Ref Syn SyntaxInfo} ->
         Env Term vars -> Term vars -> Core (Doc IdrisAnn)
 pshow env tm
-    = do defs <- get Ctxt
-         ntm <- normaliseHoles defs env tm
+    = do ntm <- normaliseHoles env tm
          itm <- resugar env ntm
          pure (pShowMN ntm env $ prettyBy Syntax itm)
 
@@ -420,6 +420,17 @@ perrorRaw (LinearMisuse fc n exp ctx)
     prettyRel = elimSemi "irrelevant"
                          "relevant"
                          (const "non-linear")
+perrorRaw (InconsistentUse fc ns)
+    = pure $ errorDesc (hsep
+                (reflow "Inconsistent usage of names in case branches:"
+                   :: !(traverse branch ns)))
+  where
+    branch : (FC, List Name) -> Core (Doc IdrisAnn)
+    branch (fc, [])
+        = pure $ reflow "No linear usage in " <++> !(ploc fc)
+    branch (fc, ns)
+        = pure $ concatWith (surround ",") (map pretty0 ns) <++>
+                 reflow "used in" <++> !(ploc fc)
 perrorRaw (BorrowPartial fc env tm arg)
     = pure $ errorDesc (code !(pshow env tm) <++> reflow "borrows argument" <++> code !(pshow env arg)
         <++> reflow "so must be fully applied.")
@@ -528,8 +539,8 @@ perrorRaw (CantSolveGoal fc gam env g reason)
     dropEnv : {vars : _} ->
               Env Term vars -> Term vars ->
               (ns ** (Env Term ns, Term ns))
-    dropEnv env (Bind _ n b@(Pi {}) sc) = dropEnv (b :: env) sc
-    dropEnv env (Bind _ n b@(Let {}) sc) = dropEnv (b :: env) sc
+    dropEnv env (Bind _ n b@(Pi {}) sc) = dropEnv (Env.bind env b) sc
+    dropEnv env (Bind _ n b@(Let {}) sc) = dropEnv (Env.bind env b) sc
     dropEnv env tm = (_ ** (env, tm))
 
 perrorRaw (DeterminingArg fc n i env g)
diff --git a/src/Idris/IDEMode/CaseSplit.idr b/src/Idris/IDEMode/CaseSplit.idr
index 3fc52bf417b..aa5591f72db 100644
--- a/src/Idris/IDEMode/CaseSplit.idr
+++ b/src/Idris/IDEMode/CaseSplit.idr
@@ -2,7 +2,9 @@ module Idris.IDEMode.CaseSplit
 
 import Core.Env
 import Core.Metadata
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Parser.Lexer.Source
 import Parser.Unlit
@@ -373,7 +375,7 @@ getClause l n
          Just (loc, nidx, envlen, ty) <- findTyDeclAt (\p, n => onLine (l-1) p)
              | Nothing => pure Nothing
          n <- getFullName nidx
-         argns <- getEnvArgNames defs envlen !(nf defs Env.empty ty)
+         argns <- getEnvArgNames defs envlen !(expand !(nf Env.empty ty))
          Just srcLine <- getSourceLine l
            | Nothing => pure Nothing
          let (mark, src) = isLitLine srcLine
diff --git a/src/Idris/IDEMode/Holes.idr b/src/Idris/IDEMode/Holes.idr
index 9da5ff38ee3..714cff31724 100644
--- a/src/Idris/IDEMode/Holes.idr
+++ b/src/Idris/IDEMode/Holes.idr
@@ -1,6 +1,7 @@
 module Idris.IDEMode.Holes
 
 import Core.Env
+import Core.Evaluate
 
 import Data.String
 
@@ -74,7 +75,7 @@ isHole : GlobalDef -> Maybe Nat
 isHole def
     = case definition def of
            Hole locs _ => Just locs
-           PMDef pi _ _ _ _ =>
+           Function pi _ _ _ =>
                  case holeInfo pi of
                       NotHole => Nothing
                       SolvedHole n => Just n
@@ -92,21 +93,21 @@ export
 extractHoleData : {vars : _} ->
                   {auto c : Ref Ctxt Defs} ->
                   {auto s : Ref Syn SyntaxInfo} ->
-                  Defs -> Env Term vars -> Name -> Nat -> Term vars ->
+                  Env Term vars -> Name -> Nat -> Term vars ->
                   Core Holes.Data
-extractHoleData defs env fn (S args) (Bind fc x (Let _ c val ty) sc)
-  = extractHoleData defs env fn args (subst val sc)
-extractHoleData defs env fn (S args) (Bind fc x b sc)
-  = do rest <- extractHoleData defs (b :: env) fn args sc
+extractHoleData env fn (S args) (Bind fc x (Let _ c val ty) sc)
+  = extractHoleData env fn args (subst val sc)
+extractHoleData env fn (S args) (Bind fc x b sc)
+  = do rest <- extractHoleData (Env.bind env b) fn args sc
        let True = showName x
          | False => do log "ide-mode.hole" 10 $ "Not showing name: " ++ show x
                        pure rest
        log "ide-mode.hole" 10 $ "Showing name: " ++ show x
-       ity <- resugar env !(normalise defs env (binderType b))
+       ity <- resugar env !(normalise env (binderType b))
        let premise = MkHolePremise x ity (multiplicity b) (isImplicit b)
        pure $ { context $= (premise ::)  } rest
-extractHoleData defs env fn args ty
-  = do nty <- normalise defs env ty
+extractHoleData env fn args ty
+  = do nty <- normalise env ty
        ity <- resugar env nty
        log "ide-mode.hole" 20 $
           "Return type: " ++ show !(toFullNames ty)
@@ -119,11 +120,11 @@ export
 holeData : {vars : _} ->
            {auto c : Ref Ctxt Defs} ->
            {auto s : Ref Syn SyntaxInfo} ->
-           Defs -> Env Term vars -> Name -> Nat -> Term vars ->
+           Env Term vars -> Name -> Nat -> Term vars ->
            Core Holes.Data
 
-holeData gam env fn args ty
-  = do hdata <- extractHoleData gam env fn args ty
+holeData env fn args ty
+  = do hdata <- extractHoleData env fn args ty
        pp <- getPPrint
        pure $ if showImplicits pp
               then hdata
@@ -152,18 +153,18 @@ getUserHolesData
          traverse (\n_gdef_args =>
                      -- Inference can't deal with this for now :/
                      let (n, gdef, args) = the (Name, GlobalDef, Nat) n_gdef_args in
-                     holeData defs Env.empty n args (type gdef))
+                     holeData Env.empty n args (type gdef))
                   holesWithArgs
 
 export
 showHole : {vars : _} ->
           {auto c : Ref Ctxt Defs} ->
           {auto s : Ref Syn SyntaxInfo} ->
-          Defs -> Env Term vars -> Name -> Nat -> Term vars ->
+          Env Term vars -> Name -> Nat -> Term vars ->
           Core String
 
-showHole defs env fn args ty
-    = do hdata <- holeData defs env fn args ty
+showHole env fn args ty
+    = do hdata <- holeData env fn args ty
          case hdata.context of
            [] => pure $ show (hdata.name) ++ " : " ++ show hdata.type
            _  => pure $
@@ -175,10 +176,10 @@ export
 prettyHole : {vars : _} ->
              {auto c : Ref Ctxt Defs} ->
              {auto s : Ref Syn SyntaxInfo} ->
-             Defs -> Env Term vars -> Name -> Nat -> Term vars ->
+             Env Term vars -> Name -> Nat -> Term vars ->
              Core (Doc IdrisSyntax)
-prettyHole defs env fn args ty
-  = do hdata <- holeData defs env fn args ty
+prettyHole env fn args ty
+  = do hdata <- holeData env fn args ty
        case hdata.context of
          [] => pure $ pretty0 hdata.name <++> colon <++> pretty hdata.type
          _  => pure $ indent 1 (vsep $ map pretty hdata.context) <+> hardline
diff --git a/src/Idris/IDEMode/REPL.idr b/src/Idris/IDEMode/REPL.idr
index 72cd819c2e8..2ded91ede46 100644
--- a/src/Idris/IDEMode/REPL.idr
+++ b/src/Idris/IDEMode/REPL.idr
@@ -20,7 +20,6 @@ import Idris.IDEMode.SyntaxHighlight
 import Idris.IDEMode.Pretty
 
 import Protocol.Hex
-import Libraries.Utils.Path
 
 import Data.String
 import System
@@ -33,6 +32,8 @@ import Network.Socket.Raw
 
 import TTImp.Interactive.Completion
 
+import Libraries.Utils.Path
+
 %default covering
 
 export
@@ -290,7 +291,6 @@ Cast REPLEval String where
   cast EvalTC = "typecheck"
   cast NormaliseAll = "normalise"
   cast Execute = "execute"
-  cast Scheme = "scheme"
 
 Cast REPLOpt REPLOption where
   cast (ShowImplicits impl)  = MkOption "show-implicits" BOOL impl
@@ -353,11 +353,11 @@ displayIDEResult outf i  (REPL $ ProofFound x)
   = printIDEResult outf i $ AString $ show x
 displayIDEResult outf i  (REPL $ Missed cases)
   = printIDEResult outf i
-  $ AString $ showSep "\n"
+  $ AString $ joinBy "\n"
   $ map handleMissing' cases
 displayIDEResult outf i  (REPL $ CheckedTotal xs)
   = printIDEResult outf i
-  $ AString $ showSep "\n"
+  $ AString $ joinBy "\n"
   $ map (\ (fn, tot) => (show fn ++ " is " ++ show tot)) xs
 displayIDEResult outf i  (REPL $ LogLevelSet k)
   = printIDEResult outf i
@@ -383,10 +383,10 @@ displayIDEResult outf i (REPL $ Edited (MadeLemma lit name pty pappstr))
       }
 displayIDEResult outf i (REPL $ Edited (MadeWith lit wapp))
   = printIDEResult outf i
-  $ AString $ showSep "\n" (map (relit lit) wapp)
+  $ AString $ joinBy "\n" (map (relit lit) wapp)
 displayIDEResult outf i (REPL $ (Edited (MadeCase lit cstr)))
   = printIDEResult outf i
-  $ AString $ showSep "\n" (map (relit lit) cstr)
+  $ AString $ joinBy "\n" (map (relit lit) cstr)
 displayIDEResult outf i (FoundHoles holes)
   = printIDEResult outf i $ AHoleList $ map holeIDE holes
 displayIDEResult outf i (CompletionList ns r)
diff --git a/src/Idris/ModTree.idr b/src/Idris/ModTree.idr
index a59e1fd3504..8e3334eb835 100644
--- a/src/Idris/ModTree.idr
+++ b/src/Idris/ModTree.idr
@@ -48,7 +48,7 @@ record BuildMod where
 
 export
 Show BuildMod where
-  show t = buildFile t ++ " [" ++ showSep ", " (map show (imports t)) ++ "]"
+  show t = buildFile t ++ " [" ++ joinBy ", " (map show (imports t)) ++ "]"
 
 data AllMods : Type where
 
diff --git a/src/Idris/Package.idr b/src/Idris/Package.idr
index 4ec97b82134..f02ed9206c1 100644
--- a/src/Idris/Package.idr
+++ b/src/Idris/Package.idr
@@ -1014,6 +1014,7 @@ partitionOpts opts = foldr pOptUpdate (MkPFR [] [] False) opts
     optType Verbose                = POpt
     optType (Timing l)             = POpt
     optType (Logging l)            = POpt
+    optType (LoggingTree)          = POpt
     optType CaseTreeHeuristics     = POpt
     optType (DumpANF f)            = POpt
     optType (DumpCases f)          = POpt
@@ -1048,6 +1049,7 @@ errorMsg = unlines
   , "    --verbose"
   , "    --timing"
   , "    --log <log level>"
+  , "    --log-tree"
   , "    --dumpcases <file>"
   , "    --dumplifted <file>"
   , "    --dumpvmcode <file>"
diff --git a/src/Idris/Package/Types.idr b/src/Idris/Package/Types.idr
index 4266699caac..34f739af66a 100644
--- a/src/Idris/Package/Types.idr
+++ b/src/Idris/Package/Types.idr
@@ -2,10 +2,13 @@ module Idris.Package.Types
 
 import Core.FC
 import Core.Name.Namespace
+
+import Idris.Version
+
 import Data.List
 import Data.Maybe
 import Data.String
-import Idris.Version
+
 import Libraries.Text.PrettyPrint.Prettyprinter
 import Libraries.Text.PrettyPrint.Prettyprinter.Util
 
@@ -19,7 +22,7 @@ data PkgVersion = MkPkgVersion (List1 Nat)
 
 export
 Show PkgVersion where
-  show (MkPkgVersion vs) = showSep "." (map show (forget vs))
+  show (MkPkgVersion vs) = joinBy "." (map show (forget vs))
 
 export
 Pretty Void PkgVersion where
diff --git a/src/Idris/Parser.idr b/src/Idris/Parser.idr
index 1ad2d7e2a5d..7fd611faf41 100644
--- a/src/Idris/Parser.idr
+++ b/src/Idris/Parser.idr
@@ -6,14 +6,15 @@ import Idris.Syntax.Traversals
 import public Parser.Source
 import TTImp.TTImp
 
-import public Libraries.Text.Parser
 import Data.Either
-import Libraries.Data.IMaybe
 import Data.List.Quantifiers
 import Data.List1
 import Data.Maybe
 import Data.Nat
 import Data.String
+
+import public Libraries.Text.Parser
+import Libraries.Data.IMaybe
 import Libraries.Utils.String
 import Libraries.Data.WithDefault
 
@@ -1114,7 +1115,7 @@ mutual
           let fc = boundToFC fname x in
           toLines xs [< StrLiteral fc (last strs)]
             $ acc :< (line <>> [StrLiteral fc str])
-            <>< map (\str => [StrLiteral fc str]) (init strs)
+            <>< (the (List _) $ map (\str => [StrLiteral fc str]) (init strs))
 
   fnDirectOpt : OriginDesc -> Rule PFnOpt
   fnDirectOpt fname
@@ -2024,8 +2025,6 @@ parseMode
           pure Execute
    <|> do exactIdent "exec"
           pure Execute
-   <|> do exactIdent "scheme"
-          pure Scheme
 
 setVarOption : Rule REPLOpt
 setVarOption
@@ -2148,7 +2147,7 @@ mutual
   Show CmdArg where
     show NoArg = ""
     show OnOffArg = "(on|off)"
-    show (Args args) = showSep " " (map show args)
+    show (Args args) = joinBy " " (map show args)
     show arg = "<" ++ showCmdArg arg ++ ">"
 
 public export
diff --git a/src/Idris/ProcessIdr.idr b/src/Idris/ProcessIdr.idr
index 8056d69cd82..9b53031c1a3 100644
--- a/src/Idris/ProcessIdr.idr
+++ b/src/Idris/ProcessIdr.idr
@@ -81,13 +81,13 @@ processDecl (MkWithData _ $ PMutual ps)
 
 processDecl decl
     = catch (do impdecls <- desugarDecl [] decl
-                traverse_ (Check.processDecl [] (MkNested []) Env.empty) impdecls
+                traverse_ (Check.processDecl [] (NestedNames.empty) Env.empty) impdecls
                 pure [])
             (\err => do giveUpConstraints -- or we'll keep trying...
                         pure [err])
 
 processDecls decls
-    = do errs <- concat <$> traverse processDecl decls
+    = do errs <- concat <$> traverse (logDepthWrap processDecl) decls
          Nothing <- checkDelayedHoles
              | Just err => pure (if null errs then [err] else errs)
          pure errs
@@ -377,23 +377,26 @@ processMod sourceFileName ttcFileName msg sourcecode origin
                 -- a phase before this which builds the dependency graph
                 -- (also that we only build child dependencies if rebuilding
                 -- changes the interface - will need to store a hash in .ttc!)
+                logDepthIncrease
                 logTime 2 "Reading imports" $
-                   traverse_ (readImport False) allImports
+                   logDepthDecrease $ traverse_ (readImport False) allImports
 
                 -- Before we process the source, make sure the "hide_everywhere"
                 -- names are set to private (TODO, maybe if we want this?)
 --                 defs <- get Ctxt
 --                 traverse (\x => setVisibility emptyFC x Private) (hiddenNames defs)
                 setNS (miAsNamespace ns)
+                logDepthIncrease
                 errs <- logTime 2 "Processing decls" $
-                            processDecls (decls mod)
+                            logDepthDecrease $ processDecls (decls mod)
                 totErrs <- logTime 3 ("Totality check overall")
                             getTotalityErrors
                 let errs = errs ++ totErrs
 --                 coreLift $ gc
 
                 when (isNil errs) $
-                   logTime 2 "Compile defs" $ compileAndInlineAll
+                   do logDepthIncrease
+                      logTime 2 "Compile defs" $ logDepthDecrease $ compileAndInlineAll
 
                 -- Save the import hashes for the imports we just read.
                 -- If they haven't changed next time, and the source
diff --git a/src/Idris/REPL.idr b/src/Idris/REPL.idr
index 84c00483b05..604674ecc4f 100644
--- a/src/Idris/REPL.idr
+++ b/src/Idris/REPL.idr
@@ -3,7 +3,6 @@ module Idris.REPL
 import Compiler.Common
 import Compiler.Inline
 
-import Core.Case.CaseTree
 import Core.CompileExpr
 import Core.CompileExpr.Pretty
 import Core.Context.Pretty
@@ -14,9 +13,8 @@ import Core.Metadata
 import Core.TT.Views
 import Core.Termination
 import Core.Unify
-import Core.Value
-
-import Core.SchemeEval
+import Core.Evaluate.Value
+import Core.Evaluate
 
 import Parser.Unlit
 
@@ -56,21 +54,22 @@ import TTImp.BindImplicits
 import TTImp.ProcessDecls
 
 import Data.Maybe
+import Data.Stream
+import Data.String
+
+import System
+import System.File
+
 import Libraries.Data.NatSet
 import Libraries.Data.NameMap
 import Libraries.Data.PosMap
 import Libraries.Data.String as L
-import Data.Stream
-import Data.String
 import Libraries.Data.SparseMatrix
 import Libraries.Data.Tap
 import Libraries.Data.WithDefault
 import Libraries.Utils.Path
 import Libraries.System.Directory.Tree
 
-import System
-import System.File
-
 %default covering
 
 -- Do NOT remove: it can be used instead of prettyInfo in case the prettier output
@@ -96,7 +95,7 @@ showInfo (n, idx, d)
             let scinfo = map (\s => show (fnCall s) ++ ": " ++
                                     show (fnArgs s)) !(traverse toFullNames (sizeChange d)) in
                 coreLift_ $ putStrLn $
-                        "Size change: " ++ showSep ", " scinfo
+                        "Size change: " ++ joinBy ", " scinfo
 
 prettyInfo : {auto c : Ref Ctxt Defs} ->
              {auto s : Ref Syn SyntaxInfo} ->
@@ -150,7 +149,7 @@ getEnvTerm : {vars : _} ->
              (vars' ** (Env Term vars', Term vars'))
 getEnvTerm (n :: ns) env (Bind fc x b sc)
     = if n == x
-         then getEnvTerm ns (b :: env) sc
+         then getEnvTerm ns (Env.bind env b) sc
          else (_ ** (env, Bind fc x b sc))
 getEnvTerm _ env tm = (_ ** (env, tm))
 
@@ -159,7 +158,7 @@ displayPatTerm : {auto c : Ref Ctxt Defs} ->
                  Defs -> ClosedTerm ->
                  Core String
 displayPatTerm defs tm
-    = do ptm <- resugarNoPatvars Env.empty !(normaliseHoles defs Env.empty tm)
+    = do ptm <- resugarNoPatvars Env.empty !(normaliseHoles Env.empty tm)
          pure (show ptm)
 
 setOpt : {auto c : Ref Ctxt Defs} ->
@@ -221,7 +220,7 @@ printClause l i (WithClause _ lhsraw rig wvraw prf flags csraw)
                    -- TODO: remove `the` after fix idris-lang/Idris2#3418
                 ++ maybe "" (the (_ -> _) $ \(rg, nm) => " proof " ++ showCount rg ++ show nm) prf
                 ++ "\n")
-               ++ showSep "\n" cs)
+               ++ joinBy "\n" cs)
 printClause l i (ImpossibleClause _ lhsraw)
     = do lhs <- pterm $ map defaultKindedName lhsraw -- hack
          pure (relit l (pack (replicate i ' ') ++ show lhs ++ " impossible"))
@@ -340,7 +339,7 @@ dropLamsTm : {vars : _} ->
              Nat -> Env Term vars -> Term vars ->
              (vars' ** (Env Term vars', Term vars'))
 dropLamsTm Z env tm = (_ ** (env, tm))
-dropLamsTm (S k) env (Bind _ _ b sc) = dropLamsTm k (b :: env) sc
+dropLamsTm (S k) env (Bind _ _ b sc) = dropLamsTm k (Env.bind env b) sc
 dropLamsTm _ env tm = (_ ** (env, tm))
 
 findInTree : FilePos -> Name -> PosMap (NonEmptyFC, Name) -> Maybe Name
@@ -418,8 +417,8 @@ inferAndElab emode itm env
        catch (do hide replFC (NS primIONS (UN $ Basic "::"))
                  hide replFC (NS primIONS (UN $ Basic "Nil")))
              (\err => pure ())
-       (tm , gty) <- elabTerm inidx emode [] (MkNested []) env ttimpWithIt Nothing
-       ty <- getTerm gty
+       (tm , gty) <- elabTerm inidx emode [] (NestedNames.empty) env ttimpWithIt Nothing
+       ty <- quote env gty
        pure (tm `WithType` ty)
 
 processEdit : {auto c : Ref Ctxt Defs} ->
@@ -443,7 +442,7 @@ processEdit (TypeAt line col name)
          -- Get the Doc for the result
          globalResult <- case globals of
            [] => pure Nothing
-           ts => do tys <- traverse (displayType False defs) ts
+           ts => do tys <- traverse (displayType False) ts
                     pure $ Just (vsep $ map (reAnnotate Pretty.Syntax) tys)
 
          -- Lookup the name locally (The name at the specified position)
@@ -452,7 +451,7 @@ processEdit (TypeAt line col name)
          case (globalResult, localResult) of
               -- Give precedence to the local name, as it shadows the others
               (_, Just (n, _, type)) => pure $ DisplayEdit $
-                prettyLocalName n <++> colon <++> !(reAnnotate Syntax <$> displayTerm defs type)
+                prettyLocalName n <++> colon <++> !(reAnnotate Syntax <$> displayTerm type)
               (Just globalDoc, Nothing) => pure $ DisplayEdit $ globalDoc
               (Nothing, Nothing) => undefinedName replFC name
 
@@ -582,19 +581,19 @@ processEdit (Refine upd line hole e)
                     let pcall = papply replFC e new_holes
 
                     -- We're desugaring it to the corresponding TTImp
-                    icall <- desugar AnyExpr (lhsCtxt <>> []) pcall
+                    icall <- desugar AnyExpr lhsCtxt pcall
 
                     -- We're checking this term full of holes against the type of the hole
                     -- TODO: branch before checking the expression fits
                     --       so that we can cleanly recover in case of error
-                    let gty = gnf env htyInLhsCtxt
-                    ccall <- checkTerm hidx {-is this correct?-} InExpr [] (MkNested []) env icall gty
+                    let gty = !(nf env htyInLhsCtxt)
+                    ccall <- checkTerm hidx {-is this correct?-} InExpr [] (NestedNames.empty) env icall gty
 
                     -- And then we normalise, unelab, resugar the resulting term so
                     -- that solved holes are replaced with their solutions
                     -- (we need to re-read the context because elaboration may have added solutions to it)
                     defs <- get Ctxt
-                    ncall <- normaliseHoles defs env ccall
+                    ncall <- normaliseHoles env ccall
                     pcall <- resugar env ncall
                     syn <- get Syn
                     let brack = elemBy (\x, y => dropNS x == dropNS y) hole (bracketholes syn)
@@ -620,11 +619,11 @@ processEdit (ExprSearch upd line name hints)
                      if upd
                         then updateFile (proofSearch name (show itm') (integerToNat (cast (line - 1))))
                         else pure $ DisplayEdit (prettyBy Syntax itm')
-              [(n, nidx, PMDef pi [] (STerm _ tm) _ _)] =>
+              [(n, nidx, Function pi tm _ _)] =>
                   case holeInfo pi of
                        NotHole => pure $ EditError "Not a searchable hole"
                        SolvedHole locs =>
-                          do let (_ ** (env, tm')) = dropLamsTm locs Env.empty !(normaliseHoles defs Env.empty tm)
+                          do let (_ ** (env, tm')) = dropLamsTm locs Env.empty !(normaliseHoles Env.empty tm)
                              itm <- resugar env tm'
                              let itm'= ifThenElse brack (addBracket replFC itm) itm
                              if upd
@@ -734,11 +733,11 @@ prepareExp ctm
     = do ttimp <- desugar AnyExpr [] (PApp replFC (PRef replFC (UN $ Basic "unsafePerformIO")) ctm)
          let ttimpWithIt = ILocal replFC !getItDecls ttimp
          inidx <- resolveName (UN $ Basic "[input]")
-         (tm, ty) <- elabTerm inidx InExpr [] (MkNested [])
+         (tm, ty) <- elabTerm inidx InExpr [] (NestedNames.empty)
                                  Env.empty ttimpWithIt Nothing
-         tm_erased <- linearCheck replFC linear True Env.empty tm
+         linearCheck replFC linear Env.empty tm
          compileAndInlineAll
-         pure tm_erased
+         pure tm
 
 processLocal : {vars : _} ->
              {auto c : Ref Ctxt Defs} ->
@@ -787,7 +786,7 @@ execDecls decls = do
       i <- desugarDecl [] decl
       inidx <- resolveName (UN $ Basic "[defs]")
       _ <- newRef EST (initEStateSub inidx Env.empty Refl)
-      processLocal [] (MkNested []) Env.empty !getItDecls i
+      processLocal [] (NestedNames.empty) Env.empty !getItDecls i
 
 export
 compileExp : {auto c : Ref Ctxt Defs} ->
@@ -834,8 +833,8 @@ loadMainFile f
 ||| using that evaluation mode
 replEval : {auto c : Ref Ctxt Defs} ->
            {vs : _} ->
-           REPLEval -> Defs -> Env Term vs -> Term vs -> Core (Term vs)
-replEval NormaliseAll = normaliseOpts ({ strategy := CBV } withAll)
+           REPLEval -> Env Term vs -> Term vs -> Core (Term vs)
+replEval NormaliseAll = normaliseAll
 replEval _ = normalise
 
 ||| Produce the normal form of a PTerm, along with its inferred type
@@ -852,7 +851,7 @@ inferAndNormalize emode itm
        logTerm "repl.eval" 10 "Elaborated input" tm
        defs <- get Ctxt
        let norm = replEval emode
-       ntm <- norm defs Env.empty tm
+       ntm <- norm Env.empty tm
        logTermNF "repl.eval" 5 "Normalised" Env.empty ntm
        pure $ ntm `WithType` ty
   where
@@ -878,13 +877,6 @@ process (Eval itm)
          let emode = evalMode opts
          case emode of
             Execute => do ignore (execExp itm); pure (Executed itm)
-            Scheme =>
-              do (tm `WithType` ty) <- inferAndElab InExpr itm Env.empty
-                 qtm <- logTimeWhen !getEvalTiming 0 "Evaluation" $
-                           (do nf <- snfAll Env.empty tm
-                               quote Env.empty nf)
-                 itm <- logTimeWhen False 0 "Resugar" $ resugar Env.empty qtm
-                 pure (Evaluated itm Nothing)
             _ =>
               do (ntm `WithType` ty) <- logTimeWhen !getEvalTiming 0 "Evaluation" $
                                            inferAndNormalize emode itm
@@ -895,11 +887,11 @@ process (Eval itm)
                  evalResultName <- DN "it" <$> genName "evalResult"
                  ignore $ addDef evalResultName
                    $ newDef replFC evalResultName top Scope.empty ty defaulted
-                   $ PMDef defaultPI Scope.empty (STerm 0 ntm) (STerm 0 ntm) []
+                   $ Function defaultPI ntm ntm Nothing
                  addToSave evalResultName
                  put ROpts ({ evalResultName := Just evalResultName } opts)
                  if showTypes opts
-                    then do ity <- resugar Env.empty !(norm defs Env.empty ty)
+                    then do ity <- resugar Env.empty !(norm Env.empty ty)
                             pure (Evaluated itm (Just ity))
                     else pure (Evaluated itm Nothing)
 process (Check (PRef fc (UN (Basic "it"))))
@@ -911,14 +903,14 @@ process (Check (PRef fc fn))
     = do defs <- get Ctxt
          case !(lookupCtxtName fn (gamma defs)) of
               [] => undefinedName fc fn
-              ts => do tys <- traverse (displayType False defs) ts
+              ts => do tys <- traverse (displayType False) ts
                        pure (Printed $ vsep $ map (reAnnotate Syntax) tys)
 process (Check itm)
     = do (tm `WithType` ty) <- inferAndElab InExpr itm Env.empty
          defs <- get Ctxt
-         itm <- resugar Env.empty !(normaliseHoles defs Env.empty tm)
-         -- ty <- getTerm gty
-         ity <- resugar Env.empty !(normalise defs Env.empty ty)
+         itm <- resugar Env.empty !(normaliseHoles Env.empty tm)
+         -- ty <- quote env gty
+         ity <- resugar Env.empty !(normalise Env.empty ty)
          pure (TermChecked itm ity)
 process (CheckWithImplicits itm)
     = do showImplicits <- showImplicits <$> getPPrint
@@ -930,7 +922,7 @@ process (PrintDef (PRef fc fn))
     = do defs <- get Ctxt
          case !(lookupCtxtName fn (gamma defs)) of
               [] => undefinedName fc fn
-              ts => do defs <- traverse (displayPats False defs) ts
+              ts => do defs <- traverse (displayPats False) ts
                        pure (Printed $ vsep $ map (reAnnotate Syntax) defs)
 process (PrintDef t)
     = case !(getDocsForImplementation t) of
@@ -978,7 +970,7 @@ process (TypeSearch searchTerm)
          let ctxt = gamma defs
          rawTy <- desugar AnyExpr [] searchTerm
          bound <- piBindNames replFC [] rawTy
-         (ty, _) <- elabTerm 0 InType [] (MkNested []) Env.empty bound Nothing
+         (ty, _) <- elabTerm 0 InType [] (NestedNames.empty) Env.empty bound Nothing
          ty' <- toResolvedNames ty
          filteredDefs <-
            do names   <- allNames ctxt
@@ -1186,15 +1178,14 @@ mutual
       prompt EvalTC = "[tc] "
       prompt NormaliseAll = ""
       prompt Execute = "[exec] "
-      prompt Scheme = "[scheme] "
 
   export
   handleMissing' : MissedResult -> String
-  handleMissing' (CasesMissing x xs) = show x ++ ":\n" ++ showSep "\n" xs
+  handleMissing' (CasesMissing x xs) = show x ++ ":\n" ++ joinBy "\n" xs
   handleMissing' (CallsNonCovering fn ns) = (show fn ++ ": Calls non covering function"
                                            ++ (case ns of
                                                  [f] => " " ++ show f
-                                                 _ => "s: " ++ showSep ", " (map show ns)))
+                                                 _ => "s: " ++ joinBy ", " (map show ns)))
   handleMissing' (AllCasesCovered fn) = show fn ++ ": All cases covered"
 
   export
@@ -1267,9 +1258,9 @@ mutual
   displayResult (Edited (EditError x)) = printResult x
   displayResult (Edited (MadeLemma lit name pty pappstr))
     = printResult $ pretty0 (relit lit (show name ++ " : " ++ show pty ++ "\n") ++ pappstr)
-  displayResult (Edited (MadeWith lit wapp)) = printResult $ pretty0 $ showSep "\n" (map (relit lit) wapp)
-  displayResult (Edited (MadeCase lit cstr)) = printResult $ pretty0 $ showSep "\n" (map (relit lit) cstr)
-  displayResult (Edited (MadeIntro is)) = printResult $ pretty0 $ showSep "\n" (toList is)
+  displayResult (Edited (MadeWith lit wapp)) = printResult $ pretty0 $ joinBy "\n" (map (relit lit) wapp)
+  displayResult (Edited (MadeCase lit cstr)) = printResult $ pretty0 $ joinBy "\n" (map (relit lit) cstr)
+  displayResult (Edited (MadeIntro is)) = printResult $ pretty0 $ joinBy "\n" (toList is)
   displayResult (OptionsSet opts) = printResult (vsep (pretty0 <$> opts))
 
   -- do not use a catchall so that we are warned when a new constructor is added
@@ -1281,7 +1272,7 @@ mutual
   export
   displayHelp : String
   displayHelp =
-    showSep "\n" $ map cmdInfo help
+    joinBy "\n" $ map cmdInfo help
     where
       makeSpace : Nat -> String
       makeSpace n = pack $ take n (repeat ' ')
@@ -1292,7 +1283,7 @@ mutual
         m ++ (makeSpace $ c2 `minus` length m) ++ r
 
       cmdInfo : (List String, CmdArg, String) -> String
-      cmdInfo (cmds, args, text) = " " ++ col 18 36 (showSep " " cmds) (show args) text
+      cmdInfo (cmds, args, text) = " " ++ col 18 36 (joinBy " " cmds) (show args) text
 
   ||| Display errors that may occur when starting the REPL.
   ||| Does not force the REPL to exit, just prints the error(s).
diff --git a/src/Idris/REPL/Common.idr b/src/Idris/REPL/Common.idr
index c10fe8d9010..0504c7e8c6f 100644
--- a/src/Idris/REPL/Common.idr
+++ b/src/Idris/REPL/Common.idr
@@ -5,6 +5,7 @@ import Core.Env
 import Core.InitPrimitives
 import Core.Metadata
 import Core.Unify
+import Core.Evaluate
 
 import Idris.Doc.Annotations
 import Idris.Doc.String
@@ -254,7 +255,7 @@ docsOrSignature fc n
     typeSummary : Defs -> Core (Doc IdrisDocAnn)
     typeSummary defs = do Just def <- lookupCtxtExact n (gamma defs)
                             | Nothing => pure ""
-                          ty <- resugar Env.empty !(normaliseHoles defs Env.empty (type def))
+                          ty <- resugar Env.empty !(normaliseHoles Env.empty (type def))
                           pure $ pretty0 n <++> ":" <++> prettyBy Syntax ty
 
 export
@@ -267,7 +268,7 @@ equivTypes ty1 ty2 =
           | _ => pure False
      logTerm "typesearch.equiv" 10 "Candidate: " ty1
      defs <- get Ctxt
-     True <- pure (!(getArity defs Env.empty ty1) == !(getArity defs Env.empty ty2))
+     True <- pure (!(getArity Env.empty ty1) == !(getArity Env.empty ty2))
        | False => pure False
      _ <- newRef UST initUState
      b <- catch
diff --git a/src/Idris/REPL/FuzzySearch.idr b/src/Idris/REPL/FuzzySearch.idr
index e402721e36b..aab1b8b7d0a 100644
--- a/src/Idris/REPL/FuzzySearch.idr
+++ b/src/Idris/REPL/FuzzySearch.idr
@@ -9,6 +9,7 @@ import Idris.Syntax
 import public Idris.REPL.Common
 
 import Data.String
+import Data.Vect
 import Libraries.Data.List.Extra
 import Libraries.Data.WithDefault
 
@@ -104,29 +105,45 @@ fuzzySearch expr = do
     isApproximationOf x y
   isApproximationOf' a b = eqConst a b
 
+  doFindAlt : List NameOrConst -> CaseAlt vars -> List NameOrConst
+
   ||| Find all name and type literal occurrences.
   export
   doFind : List NameOrConst -> Term vars -> List NameOrConst
   doFind ns (Local fc x idx y) = ns
   doFind ns (Ref fc x name) = AName name :: ns
   doFind ns (Meta fc n i xs)
-      = foldl doFind ns xs
+      = foldl doFind ns $ map snd xs
   doFind ns (Bind fc x (Let _ c val ty) scope)
       = doFind (doFind (doFind ns val) ty) scope
   doFind ns (Bind fc x b scope)
       = doFind (doFind ns (binderType b)) scope
-  doFind ns (App fc fn arg)
+  doFind ns (App fc fn _ arg)
       = doFind (doFind ns fn) arg
   doFind ns (As fc s as tm) = doFind ns tm
+  doFind ns (Case fc ct c sc scty alts)
+      = foldl doFindAlt (doFind (doFind ns sc) scty) alts
   doFind ns (TDelayed fc x y) = doFind ns y
   doFind ns (TDelay fc x t y)
       = doFind (doFind ns t) y
   doFind ns (TForce fc r x) = doFind ns x
   doFind ns (PrimVal fc c) =
     fromMaybe [] ((:: []) <$> parseNameOrConst (PPrimVal fc c)) ++ ns
+  doFind ns (PrimOp fc fn args) =
+    foldl doFind ns (toList args)
   doFind ns (Erased fc i) = ns
+  doFind ns (Unmatched fc str) = ns
   doFind ns (TType fc _) = AType :: ns
 
+  doFindScope : List NameOrConst -> CaseScope vars -> List NameOrConst
+  doFindScope ns (RHS _ tm) = doFind ns tm
+  doFindScope ns (Arg c x tm) = doFindScope ns tm
+
+  doFindAlt ns (ConCase _ n t sc) = doFindScope ns sc
+  doFindAlt ns (DelayCase _ t a tm) = doFind ns tm
+  doFindAlt ns (ConstCase _ c tm) = doFind ns tm
+  doFindAlt ns (DefaultCase _ tm) = doFind ns tm
+
   toFullNames' : NameOrConst -> Core NameOrConst
   toFullNames' (AName x) = AName <$> toFullNames x
   toFullNames' x = pure x
diff --git a/src/Idris/Resugar.idr b/src/Idris/Resugar.idr
index e26c9da3a75..f6b9a6e2cd2 100644
--- a/src/Idris/Resugar.idr
+++ b/src/Idris/Resugar.idr
@@ -176,14 +176,14 @@ sugarPrimAppM : {auto c : Ref Ctxt Defs} ->
 sugarPrimAppM (PApp fc (PApp fc' (PRef opFC (MkKindedName nt (UN $ Basic n) rn)) l) r) = do
   defs <- get Ctxt
   case definition <$> !(lookupCtxtExact rn defs.gamma) of
-      Just (Builtin {arity=2} f) =>
+      Just (Function _ (Bind _ _ _ (Bind _ _ _ (PrimOp {arity=2} _ f _))) _ _) =>
          let nm' = (UN $ Basic $ show @{Sugared} f)
              l'  = (MkFCVal fc' $ NoBinder l)
              op' = (MkFCVal opFC (OpSymbols $ (MkKindedName nt nm' nm')))
              in  do log "resugar.var" 80
                           "Resugaring primitive op \{show n} to \{show nm'}"
                     pure . Just $ POp fc l' op' r
-      _ => pure Nothing
+      d => pure Nothing
 sugarPrimAppM _ = pure Nothing
 
 sugarPrimApp : {auto c : Ref Ctxt Defs} ->
diff --git a/src/Idris/SetOptions.idr b/src/Idris/SetOptions.idr
index 6e87ce6aac0..76e3749dc0d 100644
--- a/src/Idris/SetOptions.idr
+++ b/src/Idris/SetOptions.idr
@@ -6,8 +6,6 @@ import Core.Binary
 import Core.Directory
 import Core.Metadata
 import Core.Unify
-import Libraries.Utils.Path
-import Libraries.Data.List.Extra
 
 import Idris.CommandLine
 import Idris.Package.Types
@@ -24,6 +22,9 @@ import Data.String
 import System
 import System.Directory
 
+import Libraries.Utils.Path
+import Libraries.Data.List.Extra
+
 %default covering
 
 ||| Dissected information about a package directory
@@ -397,7 +398,7 @@ setIncrementalCG failOnError cgn
               if failOnError
                  then do coreLift $ putStrLn "No such code generator"
                          coreLift $ putStrLn $ "Code generators available: " ++
-                                         showSep ", " (map fst (availableCGs (options defs)))
+                                         joinBy ", " (map fst (availableCGs (options defs)))
                          coreLift $ exitWith (ExitFailure 1)
                  else pure ()
 
@@ -443,7 +444,7 @@ preOptions (SetCG e :: opts)
             Nothing =>
               do coreLift $ putStrLn "No such code generator"
                  coreLift $ putStrLn $ "Code generators available: " ++
-                                 showSep ", " (map fst (availableCGs (options defs)))
+                                 joinBy ", " (map fst (availableCGs (options defs)))
                  coreLift $ exitWith (ExitFailure 1)
 preOptions (Directive d :: opts)
     = do setSession ({ directives $= (d::) } !getSession)
@@ -502,6 +503,9 @@ preOptions (Logging n :: opts)
     = do setSession ({ logEnabled := True,
                        logLevel $= insertLogLevel n } !getSession)
          preOptions opts
+preOptions (LoggingTree :: opts)
+    = do updateSession ({ logTreeEnabled := True })
+         preOptions opts
 preOptions (ConsoleWidth n :: opts)
     = do setConsoleWidth n
          preOptions opts
diff --git a/src/Idris/Syntax.idr b/src/Idris/Syntax.idr
index 49b75928d46..645b0c3597a 100644
--- a/src/Idris/Syntax.idr
+++ b/src/Idris/Syntax.idr
@@ -2,16 +2,15 @@ module Idris.Syntax
 
 import public Core.Context
 import public Core.Context.Log
-import public Core.Normalise
 import public Core.Options
 
 import TTImp.TTImp
 
+import public Idris.Syntax.Pragmas
+
 import Data.SortedMap
 import Data.String
 
-import public Idris.Syntax.Pragmas
-
 import Libraries.Data.ANameMap
 import Libraries.Data.NameMap
 import Libraries.Data.String.Extra
@@ -625,21 +624,18 @@ data REPLEval : Type where
      EvalTC : REPLEval -- Evaluate as if part of the typechecker
      NormaliseAll : REPLEval -- Normalise everything (default)
      Execute : REPLEval -- Evaluate then pass to an executer
-     Scheme : REPLEval -- Use the scheme evaluator
 
 export
 Show REPLEval where
   show EvalTC = "typecheck"
   show NormaliseAll = "normalise"
   show Execute = "execute"
-  show Scheme = "scheme"
 
 export
 Pretty Void REPLEval where
   pretty EvalTC = pretty "typecheck"
   pretty NormaliseAll = pretty "normalise"
   pretty Execute = pretty "execute"
-  pretty Scheme = pretty "scheme"
 
 public export
 data REPLOpt : Type where
@@ -819,8 +815,8 @@ parameters {0 nm : Type} (toName : nm -> Name)
   showPStr (StrLiteral _ str) = show str
   showPStr (StrInterp _ tm) = showPTerm tm
 
-  showUpdate (PSetField p v) = showSep "." p ++ " = " ++ showPTerm v
-  showUpdate (PSetFieldApp p v) = showSep "." p ++ " $= " ++ showPTerm v
+  showUpdate (PSetField p v) = joinBy "." p ++ " = " ++ showPTerm v
+  showUpdate (PSetFieldApp p v) = joinBy "." p ++ " $= " ++ showPTerm v
 
   showBasicMultiBinder (MkBasicMultiBinder rig names type)
         = "\{showCount rig} \{showNames}: \{showPTerm type}"
@@ -869,7 +865,7 @@ parameters {0 nm : Type} (toName : nm -> Name)
                  " in " ++ showPTermPrec d sc
   showPTermPrec _ (PCase _ _ tm cs)
         = "case " ++ showPTerm tm ++ " of { " ++
-            showSep " ; " (map showCase cs) ++ " }"
+            joinBy " ; " (map showCase cs) ++ " }"
       where
         showCase : PClause' nm -> String
         showCase (MkPatClause _ lhs rhs _) = showPTerm lhs ++ " => " ++ showPTerm rhs
@@ -878,7 +874,7 @@ parameters {0 nm : Type} (toName : nm -> Name)
   showPTermPrec d (PLocal _ ds sc) -- We'll never see this when displaying a normal form...
         = "let { << definitions >>  } in " ++ showPTermPrec d sc
   showPTermPrec d (PUpdate _ fs)
-        = "record { " ++ showSep ", " (map showUpdate fs) ++ " }"
+        = "record { " ++ joinBy ", " (map showUpdate fs) ++ " }"
   showPTermPrec d (PApp _ f a) =
       let catchall : Lazy String := showPTermPrec App f ++ " " ++ showPTermPrec App a in
       case f of
@@ -933,14 +929,14 @@ parameters {0 nm : Type} (toName : nm -> Name)
   showPTermPrec d (PString _ _ xs) = join " ++ " $ showPStr <$> xs
   showPTermPrec d (PMultiline _ _ indent xs) = "multiline (" ++ (join " ++ " $ showPStr <$> concat xs) ++ ")"
   showPTermPrec d (PDoBlock _ ns ds)
-        = "do " ++ showSep " ; " (map showDo ds)
+        = "do " ++ joinBy " ; " (map showDo ds)
   showPTermPrec d (PBang _ tm) = "!" ++ showPTermPrec d tm
   showPTermPrec d (PIdiom _ Nothing tm) = "[|" ++ showPTermPrec d tm ++ "|]"
   showPTermPrec d (PIdiom _ (Just ns) tm) = show ns ++ ".[|" ++ showPTermPrec d tm ++ "|]"
   showPTermPrec d (PList _ _ xs)
-        = "[" ++ showSep ", " (map (showPTermPrec d . snd) xs) ++ "]"
+        = "[" ++ joinBy ", " (map (showPTermPrec d . snd) xs) ++ "]"
   showPTermPrec d (PSnocList _ _ xs)
-        = "[<" ++ showSep ", " (map (showPTermPrec d . snd) (xs <>> [])) ++ "]"
+        = "[<" ++ joinBy ", " (map (showPTermPrec d . snd) (xs <>> [])) ++ "]"
   showPTermPrec d (PPair _ l r) = "(" ++ showPTermPrec d l ++ ", " ++ showPTermPrec d r ++ ")"
   showPTermPrec d (PDPair _ _ l (PImplicit _) r) = "(" ++ showPTermPrec d l ++ " ** " ++ showPTermPrec d r ++ ")"
   showPTermPrec d (PDPair _ _ l ty r) = "(" ++ showPTermPrec d l ++ " : " ++ showPTermPrec d ty ++
@@ -950,7 +946,7 @@ parameters {0 nm : Type} (toName : nm -> Name)
                                  " else " ++ showPTermPrec d e
   showPTermPrec d (PComprehension _ ret es)
         = "[" ++ showPTermPrec d (dePure ret) ++ " | " ++
-                 showSep ", " (map (showDo . deGuard) es) ++ "]"
+                 joinBy ", " (map (showDo . deGuard) es) ++ "]"
       where
         dePure : PTerm' nm -> PTerm' nm
         dePure tm@(PApp _ (PRef _ n) arg)
diff --git a/src/Libraries/Data/List/Thin.idr b/src/Libraries/Data/List/Thin.idr
index 56fdb8b4660..2dd433476bb 100644
--- a/src/Libraries/Data/List/Thin.idr
+++ b/src/Libraries/Data/List/Thin.idr
@@ -1,44 +1,66 @@
 module Libraries.Data.List.Thin
 
+import Data.String
+
 import Libraries.Data.NatSet
+import Libraries.Data.SnocList.SizeOf
 
 %default total
 
--- TODO implement:
--- Guillaume Allais: Builtin Types Viewed as Inductive Families
--- https://doi.org/10.48550/arXiv.2301.02194
 public export
-data Thin : List a -> List a -> Type where
+data Thin : SnocList a -> SnocList a -> Type where
   Refl : Thin xs xs
-  Drop : Thin xs ys -> Thin xs (y :: ys)
-  Keep : Thin xs ys -> Thin (x :: xs) (x :: ys)
+  Drop : Thin xs ys -> Thin xs (ys :< y)
+  Keep : Thin xs ys -> Thin (xs :< x) (ys :< x)
+
+-- At runtime, Thin's `Refl` does not carry any additional
+-- information. So this is safe!
+export
+embed : Thin xs ys -> Thin (outer ++ xs) (outer ++ ys)
+embed = believe_me
 
 export
-none : {xs : List a} -> Thin [] xs
-none {xs = []} = Refl
-none {xs = _ :: _} = Drop none
+covering
+{xs, ys : _} -> Show (Thin xs ys) where
+  show x = joinBy " " $ showAll [] x
+    where
+      showAll : {free, vars : _} -> List String -> Thin free vars -> List String
+      showAll str Refl = str ++ ["ThinRefl"]
+      showAll str (Drop t) = showAll ("ThinDrop" :: str) t
+      showAll str (Keep t) = showAll ("ThinKeep" :: str) t
+
+export
+none : {xs : SnocList a} -> Thin [<] xs
+none {xs = [<]} = Refl
+none {xs = _ :< _} = Drop none
 
 ||| Smart constructor. We should use this to maximise the length
 ||| of the Refl segment thus getting more short-circuiting behaviours
 export
-keep : Thin xs ys -> Thin (x :: xs) (x :: ys)
+keep : Thin xs ys -> Thin (xs :< x) (ys :< x)
 keep Refl = Refl
 keep p = Keep p
 
 export
-keeps : (args : List a) -> Thin xs ys -> Thin (args ++ xs) (args ++ ys)
-keeps [] th = th
-keeps (x :: xs) th = Keep (keeps xs th)
+keeps : (args : SnocList a) -> Thin xs ys -> Thin (xs ++ args) (ys ++ args)
+keeps [<] th = th
+keeps (sx :< x) th = Keep (keeps sx th)
+
+export
+keepz : (args : List a) -> Thin xs ys -> Thin (xs <>< args) (ys <>< args)
+keepz [] th = th
+keepz (x :: xs) th = keepz xs (keep th)
 
 export
-fromNatSet : NatSet -> (xs : List a) -> (xs' ** Thin xs' xs)
+fromNatSet : NatSet -> (xs : SnocList a) -> (xs' ** Thin xs' xs)
 fromNatSet ns xs =
-  if isEmpty ns then (_ ** Refl) else go 0 xs
+  if isEmpty ns then (_ ** Refl) else go xs (mkSizeOf xs)
   where
-    go : Nat -> (xs : List a) -> (xs' ** Thin xs' xs)
-    go i [] = (_ ** Refl)
-    go i (x :: xs)
-        = let (xs' ** th) = go (S i) xs in
+    go : (xs : SnocList a) -> SizeOf xs -> (xs' ** Thin xs' xs)
+    go l s with (sizedView s)
+      go _ _ | Z = (_ ** Refl)
+      go (xs :< x) _ | (S s@(MkSizeOf i _))
+        = let (xs' ** th) = go xs s in
               if i `elem` ns
                  then (xs' ** Drop th)
-                 else (x :: xs' ** Keep th)
+                 else (xs' :< x ** Keep th)
diff --git a/src/Libraries/Data/NatSet.idr b/src/Libraries/Data/NatSet.idr
index 5511b052a20..657dfbe5116 100644
--- a/src/Libraries/Data/NatSet.idr
+++ b/src/Libraries/Data/NatSet.idr
@@ -2,6 +2,8 @@ module Libraries.Data.NatSet
 
 import Data.Bits
 
+import Libraries.Data.SnocList.SizeOf
+
 %default total
 
 export
@@ -16,17 +18,32 @@ export %inline
 elem : Nat -> NatSet -> Bool
 elem = flip testBit
 
-export
-drop : NatSet -> List a -> List a
-drop 0  xs = xs
-drop ds xs = go 0 xs
-  where
-    go : Nat -> List a -> List a
-    go _ [] = []
-    go i (x :: xs)
-        = if i `elem` ds
-             then go (S i) xs
-             else x :: go (S i) xs
+namespace List
+  export
+  drop : NatSet -> List a -> List a
+  drop 0  xs = xs
+  drop ds xs = go 0 xs
+    where
+      go : Nat -> List a -> List a
+      go _ [] = []
+      go i (x :: xs)
+          = if i `elem` ds
+              then go (S i) xs
+              else x :: go (S i) xs
+
+namespace SnocList
+  export
+  drop : NatSet -> SnocList a -> SnocList a
+  drop 0  xs = xs
+  drop ds xs = go xs (mkSizeOf xs)
+    where
+      go : (sl : SnocList a) -> SizeOf sl -> SnocList a
+      go l s with (sizedView s)
+        go _ _ | Z = [<]
+        go (xs :< x) _ | (S s@(MkSizeOf i _))
+          = if i `elem` ds
+              then go xs s
+              else go xs s :< x
 
 export %inline
 take : NatSet -> List a -> List a
@@ -82,16 +99,17 @@ Show NatSet where
   show ns = show (toList ns)
 
 export
-partition : NatSet -> List a -> (List a , List a)
-partition ps = go 0
+partition : NatSet -> SnocList a -> (SnocList a , SnocList a)
+partition ps l = go l (mkSizeOf l)
   where
-    go : Nat -> List a -> (List a , List a)
-    go i [] = ([], [])
-    go i (x :: xs)
-      = let xys = go (S i) xs in
-        if i `elem` ps
-           then mapFst (x ::) xys
-           else mapSnd (x ::) xys
+    go : (sl : SnocList a) -> SizeOf sl -> (SnocList a , SnocList a)
+    go l s with (sizedView s)
+      go _ _ | Z = ([<], [<])
+      go (xs :< x) _ | (S s@(MkSizeOf i _))
+        = let (ps', ds') = go xs s in
+          if i `elem` ps
+            then (ps' :< x, ds')
+            else (ps', ds' :< x)
 
 export
 intersection : NatSet -> NatSet -> NatSet
@@ -117,18 +135,17 @@ allLessThanSpecEmpty = Refl
 allLessThanSpecNonEmpty = Refl
 
 export
-overwrite : a -> NatSet -> List a -> List a
+overwrite : a -> NatSet -> SnocList a -> SnocList a
 overwrite c 0  xs = xs
-overwrite c ds xs = go 0 xs
+overwrite c ds xs = go xs (mkSizeOf xs)
   where
-    go : Nat -> List a -> List a
-    go _ [] = []
-    go i (x :: xs)
+    go : (sl : SnocList a) -> SizeOf sl -> SnocList a
+    go l s with (sizedView s)
+      go _ _ | Z = [<]
+      go (xs :< x) _ | (S s@(MkSizeOf i _))
         = if i `elem` ds
-             then c :: go (S i) xs
-             else x :: go (S i) xs
-
-
+             then go xs s :< c
+             else go xs s :< x
 
 -- Pop the zero (whether or not in the set) and shift all the
 -- other positions by -1 (useful when coming back from under
diff --git a/src/Libraries/Data/SnocList/Extra.idr b/src/Libraries/Data/SnocList/Extra.idr
index 82956cea2a6..c5700e2ee25 100644
--- a/src/Libraries/Data/SnocList/Extra.idr
+++ b/src/Libraries/Data/SnocList/Extra.idr
@@ -2,16 +2,15 @@ module Libraries.Data.SnocList.Extra
 
 import Data.Nat
 import Data.SnocList
+
 import Syntax.PreorderReasoning
 
 -- TODO left-to-right reversal of the stream
 --      is this what we want?
-{-
 public export
 take : (n : Nat) -> (xs : Stream a) -> SnocList a
 take Z xs = [<]
 take (S k) (x :: xs) = take k xs :< x
--}
 
 public export
 snocAppendFishAssociative :
@@ -28,16 +27,12 @@ snocAppendAsFish sx sy = sym
           (cong (sx ++) (castToList sy))
 
 export
-lookup : Eq a => a -> SnocList (a, b) -> Maybe b
-lookup n [<] = Nothing
-lookup n (ns :< (x, n')) = if x == n then Just n' else lookup n ns
-
-lengthDistributesOverAppend
-  : (xs, ys : SnocList a)
-  -> length (ys ++ xs) = length xs + length ys
-lengthDistributesOverAppend [<] ys = Refl
-lengthDistributesOverAppend (xs :< x) ys =
-  cong S $ lengthDistributesOverAppend xs ys
+revOnto : (xs, vs : SnocList a) -> reverseOnto xs vs = xs ++ reverse vs
+revOnto xs [<] = Refl
+revOnto xs (vs :< v)
+    = rewrite Extra.revOnto (xs :< v) vs in
+        rewrite Extra.revOnto [<v] vs in
+          rewrite appendAssociative xs [<v] (reverse vs) in Refl
 
 export
 lengthDistributesOverFish : (sx : SnocList a) -> (ys : List a) ->
@@ -49,3 +44,26 @@ lengthDistributesOverFish sx (y :: ys) = Calc $
   ~~ S (length sx) + length ys    ...( Refl )
   ~~ length sx + S (length ys)    ...( plusSuccRightSucc _ _ )
   ~~ length sx + length (y :: ys) ...( Refl )
+
+||| Insert some separator between the elements of a snoc-list.
+|||
+||| @ sep the value to intersperse
+||| @ xs  the snoc-list of elements to intersperse with the separator
+|||
+||| ```idris example
+||| > with SnocList (intersperse ',' [<'a', 'b', 'c', 'd', 'e'])
+||| [<'a', ',', 'b', ',', 'c', ',', 'd', ',', 'e']
+||| ```
+public export
+intersperse : (sep : a) -> (xs : SnocList a) -> SnocList a
+intersperse sep [<]     = [<]
+intersperse sep [<x]    = [<x]
+intersperse sep (xs:<x) = intersperse sep xs :< sep :< x
+
+||| Joins the strings using the provided separator
+||| ```idris example
+||| joinBy ", " [<"A", "BC", "D"] === "A, BC, D"
+||| ```
+public export
+joinBy : String -> SnocList String -> String
+joinBy sep ws = concat (intersperse sep ws)
diff --git a/src/Libraries/Data/SnocList/HasLength.idr b/src/Libraries/Data/SnocList/HasLength.idr
index b46ac1151da..3c5af2c19f0 100644
--- a/src/Libraries/Data/SnocList/HasLength.idr
+++ b/src/Libraries/Data/SnocList/HasLength.idr
@@ -5,6 +5,8 @@ import Data.Nat
 -- horrible hack
 import Data.List.HasLength as L
 
+import Libraries.Data.SnocList.Extra
+
 public export
 LHasLength : Nat -> List a -> Type
 LHasLength = L.HasLength
@@ -52,12 +54,13 @@ hlChips {m = S m} {n} (S x) y
   = rewrite plusSuccRightSucc m n in
     hlChips x (S y)
 
-{-
+
+-- TODO left-to-right reversal of the stream
+--      is this what we want?
 export
 take : (n : Nat) -> (xs : Stream a) -> HasLength n (take n xs)
 take Z _ = Z
-take (S n) (x :: xs) = S (take n xs)
--}
+take (S n) (x :: sx) = S (take n sx)
 
 export
 cast : {sy : _} -> (0 _ : SnocList.length sx = SnocList.length sy) ->
diff --git a/src/Libraries/Data/SnocList/Quantifiers/Extra.idr b/src/Libraries/Data/SnocList/Quantifiers/Extra.idr
new file mode 100644
index 00000000000..6b81683614e
--- /dev/null
+++ b/src/Libraries/Data/SnocList/Quantifiers/Extra.idr
@@ -0,0 +1,20 @@
+module Libraries.Data.SnocList.Quantifiers.Extra
+
+import Data.SnocList
+import Data.SnocList.Quantifiers
+import Decidable.Equality
+
+%default total
+
+export
+tail : All p (xs :< x) -> All p xs
+tail (pxs :< _) = pxs
+
+export
+head : All p (xs :< x) -> p x
+head (_ :< px) = px
+
+export
+tabulate : ((x : a) -> p x) -> (xs : SnocList a) -> All p xs
+tabulate f [<] = [<]
+tabulate f (xs :< x) = tabulate f xs :< f x
diff --git a/src/Libraries/Data/SnocList/SizeOf.idr b/src/Libraries/Data/SnocList/SizeOf.idr
index 2aee090eef6..896e4dc5172 100644
--- a/src/Libraries/Data/SnocList/SizeOf.idr
+++ b/src/Libraries/Data/SnocList/SizeOf.idr
@@ -1,6 +1,8 @@
 module Libraries.Data.SnocList.SizeOf
 
 import Data.SnocList
+
+import Libraries.Data.SnocList.Extra
 import Libraries.Data.SnocList.HasLength
 
 ---------------------------------------
@@ -42,7 +44,7 @@ public export
 suc : SizeOf as -> SizeOf (as :< a)
 suc (MkSizeOf n p) = MkSizeOf (S n) (S p)
 
--- ||| suc but from the right
+-- ||| suc but from the left
 export
 sucL : SizeOf as -> SizeOf ([<a] ++ as)
 sucL (MkSizeOf n p) = MkSizeOf (S n) (sucL p)
@@ -79,11 +81,11 @@ map (MkSizeOf n p) = MkSizeOf n (cast (sym $ lengthMap sx) p) where
   lengthMap [<] = Refl
   lengthMap (sx :< x) = cong S (lengthMap sx)
 
-{-
+-- TODO left-to-right reversal of the stream
+--      is this what we want?
 public export
 take : {n : Nat} -> {0 sx : Stream a} -> SizeOf (take n sx)
 take = MkSizeOf n (take n sx)
--}
 
 namespace SizedView
 
diff --git a/src/Libraries/Data/SparseMatrix.idr b/src/Libraries/Data/SparseMatrix.idr
index 0defea0fc0b..50267bb76a6 100644
--- a/src/Libraries/Data/SparseMatrix.idr
+++ b/src/Libraries/Data/SparseMatrix.idr
@@ -109,6 +109,19 @@ public export
 Matrix : Type -> Type
 Matrix a = Vector (Vector1 a)
 
+export
+fromSparseList : List (Maybe (Nat, a)) -> Matrix a
+fromSparseList xs =
+    let inner_vector = withIndex $ map (Data.List1.fromList . toList) xs
+    in mapMaybe (\(i, m) => map (i,) m) inner_vector
+  where
+    withIndex : List b -> List (Nat, b)
+    withIndex = go 0
+      where
+        go : Nat -> List b -> List (Nat, b)
+        go _ [] = []
+        go i (x :: xs) = (i, x) :: go (S i) xs
+
 export
 fromListList : (Eq a, Semiring a) => List (List a) -> Matrix a
 fromListList = mapMaybe (\(i, xs) => map (i,) (Vector1.fromList xs)) . withIndex
diff --git a/src/Libraries/Data/String/Extra.idr b/src/Libraries/Data/String/Extra.idr
index 48db1ba6170..f0b6bb847dd 100644
--- a/src/Libraries/Data/String/Extra.idr
+++ b/src/Libraries/Data/String/Extra.idr
@@ -71,13 +71,6 @@ public export
 shrink : (n : Nat) -> (input : String) -> String
 shrink n str = dropLast n (drop n str)
 
-||| Concatenate the strings from a `Foldable` containing strings, separated by
-||| the given string.
-public export
-join : (sep : String) -> Foldable t => (xs : t String) -> String
-join sep xs = drop (length sep)
-                   (foldl (\acc, x => acc ++ sep ++ x) "" xs)
-
 ||| Get a character from a string if the string is long enough.
 public export
 index : (n : Nat) -> (input : String) -> Maybe Char
@@ -94,4 +87,11 @@ indent n x = replicate n ' ' ++ x
 ||| Indent each line of a given string by `n` spaces.
 public export
 indentLines : (n : Nat) -> String -> String
-indentLines n str = (join "\n") $ map (Extra.indent n) $ lines str
+indentLines n str = joinBy "\n" $ map (Extra.indent n) $ lines str
+
+-- Copied from libs/contrib/Data/String/Extra.idr
+-- TODO: move/reuse
+public export
+join : (sep : String) -> Foldable t => (xs : t String) -> String
+join sep xs = drop (length sep)
+                  (foldl (\acc, x => acc ++ sep ++ x) "" xs)
diff --git a/src/Libraries/Data/VarSet.idr b/src/Libraries/Data/VarSet.idr
index ed4bf416372..e2efe934476 100644
--- a/src/Libraries/Data/VarSet.idr
+++ b/src/Libraries/Data/VarSet.idr
@@ -9,7 +9,7 @@ module Libraries.Data.VarSet
 import Core.Name.Scoped
 import Core.TT.Var
 
-import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
 
 import public Libraries.Data.VarSet.Core as VarSet
 
@@ -21,14 +21,19 @@ singleton v = insert v Core.empty
 
 export %inline
 append : SizeOf inner -> VarSet inner -> VarSet outer ->
-         VarSet (inner ++ outer)
+         VarSet (addInner outer inner)
 append p inn out = union (embed {tm = VarSet} inn) (weakenNs {tm = VarSet} p out)
 
 export
 fromVarSet : (vars : Scope) -> VarSet vars -> (newvars ** Thin newvars vars)
-fromVarSet [] xs = (Scope.empty ** Refl)
-fromVarSet (n :: ns) xs =
+fromVarSet [<] xs = (Scope.empty ** Refl)
+fromVarSet (ns :< n) xs =
     let (_ ** svs) = fromVarSet ns (VarSet.dropFirst xs) in
     if first `VarSet.elem` xs
       then (_ ** Keep svs)
       else (_ ** Drop svs)
+
+-- If it was constructed from SnocList-like structure
+export %inline
+asList : {vs : Scope} -> VarSet vs -> List (Var vs)
+asList = reverse . Core.toList
diff --git a/src/Libraries/Data/VarSet/Core.idr b/src/Libraries/Data/VarSet/Core.idr
index 98b6c4a62f9..728c76a5593 100644
--- a/src/Libraries/Data/VarSet/Core.idr
+++ b/src/Libraries/Data/VarSet/Core.idr
@@ -7,7 +7,7 @@ import Libraries.Data.NatSet
 import Core.Name.Scoped
 import Core.TT.Var
 
-import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
 
 %default total
 
@@ -23,6 +23,10 @@ export %inline
 elem : Var vs -> VarSet vs -> Bool
 elem (MkVar {varIdx} _) = NatSet.elem varIdx
 
+export %inline
+elemNat : Nat -> VarSet vs -> Bool
+elemNat v = NatSet.elem v
+
 export %inline
 isEmpty : VarSet vs -> Bool
 isEmpty = NatSet.isEmpty
@@ -63,11 +67,11 @@ toList = mapMaybe (`isDeBruijn` vs) . NatSet.toList
 -- other positions by -1 (useful when coming back from under
 -- a binder)
 export %inline
-dropFirst : VarSet (v :: vs) -> VarSet vs
+dropFirst : VarSet (vs :< v) -> VarSet vs
 dropFirst = NatSet.popZ
 
 export %inline
-dropInner : SizeOf inner -> VarSet (inner ++ vs) -> VarSet vs
+dropInner : SizeOf inner -> VarSet (Scope.addInner vs inner) -> VarSet vs
 dropInner p = NatSet.popNs p.size
 
 export %hint
diff --git a/src/Libraries/Utils/Path.idr b/src/Libraries/Utils/Path.idr
index 047a18ecb3e..5be6cf3e058 100644
--- a/src/Libraries/Utils/Path.idr
+++ b/src/Libraries/Utils/Path.idr
@@ -123,7 +123,7 @@ Show Path where
       sep = String.singleton dirSeparator
       showVol = maybe "" show path.volume
       showRoot = if path.hasRoot then sep else ""
-      showBody = join sep $ map show path.body
+      showBody = joinBy sep $ map show path.body
       showTrail = if path.hasTrailSep then sep else ""
     in
       showVol ++ showRoot ++ showBody ++ showTrail
diff --git a/src/Libraries/Utils/Scheme.idr b/src/Libraries/Utils/Scheme.idr
index 29af6335287..10c493371fa 100644
--- a/src/Libraries/Utils/Scheme.idr
+++ b/src/Libraries/Utils/Scheme.idr
@@ -1,5 +1,7 @@
 module Libraries.Utils.Scheme
 
+import Data.String
+
 export
 data ForeignObj : Type where [external]
 
@@ -196,65 +198,6 @@ data SchemeObj : Direction -> Type where
             SchemeObj Write
      Apply : SchemeObj Write -> List (SchemeObj Write) -> SchemeObj Write
 
-export
-evalSchemeObj : SchemeObj Write -> IO (Maybe ForeignObj)
-evalSchemeObj obj
-    = do let str = toString obj
-         evalSchemeStr str
-  where
-    showSep : String -> List String -> String
-    showSep sep [] = ""
-    showSep sep [x] = x
-    showSep sep (x :: xs) = x ++ sep ++ showSep sep xs
-
-    toString : SchemeObj Write -> String
-    toString Null = "'()"
-    toString (Cons x y) = "(cons " ++ toString x ++ " " ++ toString y ++ ")"
-    toString (IntegerVal x) = show x
-    toString (FloatVal x) = show x
-    toString (StringVal x) = show x
-    toString (CharVal x)
-       = if (the Int (cast x) >= 32 && the Int (cast x) < 127)
-            then "#\\" ++ cast x
-            else "(integer->char " ++ show (the Int (cast x)) ++ ")"
-    toString (Symbol x) = "'" ++ x
-    toString (Vector i xs) = "(vector " ++ show i ++ " " ++ showSep " " (map toString xs) ++ ")"
-    toString (Box x) = "(box " ++ toString x ++ ")"
-    toString (Define x body) = "(define (" ++ x ++ ") " ++ toString body ++ ")"
-    toString (Var x) = x
-    toString (Lambda xs x)
-        = "(lambda (" ++ showSep " " xs ++ ") " ++ toString x ++ ")"
-    toString (Let var val x)
-        = "(let ((" ++ var ++ " " ++ toString val ++ ")) " ++ toString x ++ ")"
-    toString (If x t e)
-        = "(if " ++ toString x ++ " " ++ toString t ++ " " ++ toString e ++ ")"
-    toString (Case x alts def)
-        = "(case " ++ toString x ++ " " ++
-              showSep " " (map showAlt alts) ++
-              showDef def ++ ")"
-      where
-        showAlt : (SchemeObj Write, SchemeObj Write) -> String
-        showAlt (opt, go)
-           = "((" ++ toString opt ++ ") " ++ toString go ++ ")"
-
-        showDef : Maybe (SchemeObj Write) -> String
-        showDef Nothing = ""
-        showDef (Just e) = " (else " ++ toString e ++ ")"
-    toString (Cond alts def)
-        = "(cond " ++
-              showSep " " (map showAlt alts) ++
-              showDef def ++ ")"
-      where
-        showAlt : (SchemeObj Write, SchemeObj Write) -> String
-        showAlt (opt, go)
-           = "(" ++ toString opt ++ " " ++ toString go ++ ")"
-
-        showDef : Maybe (SchemeObj Write) -> String
-        showDef Nothing = ""
-        showDef (Just e) = " (else " ++ toString e ++ ")"
-    toString (Apply x xs)
-        = "(" ++ toString x ++ " " ++ showSep " " (map toString xs) ++ ")"
-
 export
 decodeObj : ForeignObj -> SchemeObj Readback
 decodeObj obj
@@ -278,6 +221,65 @@ decodeObj obj
              else decodeObj (unsafeVectorRef obj i) ::
                      readVector len (i + 1) obj
 
+toString : SchemeObj direction -> String
+toString Null = "'()"
+toString (Cons x y) = "(cons " ++ toString x ++ " " ++ toString y ++ ")"
+toString (IntegerVal x) = show x
+toString (FloatVal x) = show x
+toString (StringVal x) = show x
+toString (CharVal x)
+    = if (the Int (cast x) >= 32 && the Int (cast x) < 127)
+        then "#\\" ++ cast x
+        else "(integer->char " ++ show (the Int (cast x)) ++ ")"
+toString (Symbol x) = "'" ++ x
+toString (Vector i xs) = "(vector " ++ show i ++ " " ++ joinBy " " (map toString xs) ++ ")"
+toString (Box x) = "(box " ++ toString x ++ ")"
+toString (Define x body) = "(define (" ++ x ++ ") " ++ toString body ++ ")"
+toString (Var x) = x
+toString (Lambda xs x)
+    = "(lambda (" ++ joinBy " " xs ++ ") " ++ toString x ++ ")"
+toString (Let var val x)
+    = "(let ((" ++ var ++ " " ++ toString val ++ ")) " ++ toString x ++ ")"
+toString (If x t e)
+    = "(if " ++ toString x ++ " " ++ toString t ++ " " ++ toString e ++ ")"
+toString (Case x alts def)
+    = "(case " ++ toString x ++ " " ++
+          joinBy " " (map showAlt alts) ++
+          showDef def ++ ")"
+  where
+    showAlt : (SchemeObj Write, SchemeObj Write) -> String
+    showAlt (opt, go)
+        = "((" ++ toString opt ++ ") " ++ toString go ++ ")"
+
+    showDef : Maybe (SchemeObj Write) -> String
+    showDef Nothing = ""
+    showDef (Just e) = " (else " ++ toString e ++ ")"
+toString (Cond alts def)
+    = "(cond " ++
+          joinBy " " (map showAlt alts) ++
+          showDef def ++ ")"
+  where
+    showAlt : (SchemeObj Write, SchemeObj Write) -> String
+    showAlt (opt, go)
+        = "(" ++ toString opt ++ " " ++ toString go ++ ")"
+
+    showDef : Maybe (SchemeObj Write) -> String
+    showDef Nothing = ""
+    showDef (Just e) = " (else " ++ toString e ++ ")"
+toString (Apply x xs)
+    = "(" ++ toString x ++ " " ++ joinBy " " (map toString xs) ++ ")"
+toString (Procedure o) = toString $ decodeObj o
+
+export
+evalSchemeObj : SchemeObj Write -> IO (Maybe ForeignObj)
+evalSchemeObj obj
+    = do let str = toString obj
+         evalSchemeStr str
+
+export
+Show (SchemeObj p) where
+  show = (assert_total toString)
+
 public export
 interface Scheme a where
   toScheme : a -> SchemeObj Write
diff --git a/src/Parser/Rule/Source.idr b/src/Parser/Rule/Source.idr
index 1708debeef5..90470d56df3 100644
--- a/src/Parser/Rule/Source.idr
+++ b/src/Parser/Rule/Source.idr
@@ -360,6 +360,7 @@ holeName
                  HoleIdent str => Just str
                  _ => Nothing
 
+export
 reservedNames : List String
 reservedNames
     = [ "Type", "Int", "Int8", "Int16", "Int32", "Int64", "Integer"
diff --git a/src/TTImp/Elab.idr b/src/TTImp/Elab.idr
index 439f4684440..cb9ca48d204 100644
--- a/src/TTImp/Elab.idr
+++ b/src/TTImp/Elab.idr
@@ -4,6 +4,8 @@ import Core.Env
 import Core.LinearCheck
 import Core.Metadata
 import Core.Unify
+import Core.Evaluate.Value
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -48,31 +50,6 @@ getRigNeeded (InLHS r) = if isErased r then erased
                                      else linear
 getRigNeeded _ = linear
 
--- Make sure the types of holes have the references to solved holes normalised
--- away (since solved holes don't get written to .tti)
-export
-normaliseHoleTypes : {auto c : Ref Ctxt Defs} ->
-                     {auto u : Ref UST UState} ->
-                     Core ()
-normaliseHoleTypes
-    = do ust <- get UST
-         let hs = keys (holes ust)
-         defs <- get Ctxt
-         traverse_ (normaliseH defs) hs
-  where
-    updateType : Defs -> Int -> GlobalDef -> Core ()
-    updateType defs i def
-        = do ty' <- catch (tryNormaliseSizeLimit defs 10 Env.empty (type def))
-                          (\err => normaliseHoles defs Env.empty (type def))
-             ignore $ addDef (Resolved i) ({ type := ty' } def)
-
-    normaliseH : Defs -> Int -> Core ()
-    normaliseH defs i
-        = whenJust !(lookupCtxtExact (Resolved i) (gamma defs)) $ \ gdef =>
-            case definition gdef of
-              Hole {} => updateType defs i gdef
-              _ => pure ()
-
 export
 addHoleToSave : {auto c : Ref Ctxt Defs} ->
                 Name -> Core ()
@@ -116,6 +93,8 @@ elabTermSub {vars} defining mode opts nest env env' sub tm ty
          let rigc = getRigNeeded mode
 
          (chktm, chkty) <- check {e} rigc (initElabInfo mode) nest env tm ty
+         logNF "elab" 10 "Checked chkty" env chkty
+
          -- Final retry of constraints and delayed elaborations
          -- - Solve any constraints, then retry any delayed elaborations
          -- - Finally, last attempts at solving constraints, but this
@@ -133,7 +112,9 @@ elabTermSub {vars} defining mode opts nest env env' sub tm ty
                     do update UST { delayedElab := olddelayed }
                        throw err)
          update UST { delayedElab := olddelayed }
-         solveConstraintsAfter constart solvemode MatchArgs
+         case mode of
+              InLHS _ => pure ()
+              _ => solveConstraintsAfter constart solvemode MatchArgs
 
          -- As long as we're not in the RHS of a case block,
          -- finish off constraint solving
@@ -149,10 +130,10 @@ elabTermSub {vars} defining mode opts nest env env' sub tm ty
 
          dumpConstraints "elab" 4 False
          defs <- get Ctxt
-         chktm <- if inPE -- Need to fully normalise holes in partial evaluation
-                          -- because the holes don't have types saved to ttc
-                     then normaliseHoles defs env chktm
-                     else normaliseArgHoles defs env chktm
+
+         logTerm "elab" 10 "Term before nfHolesArgs" chktm
+         chktm <- quote env !(nfHolesArgs env chktm)
+         logTerm "elab" 5 "Term after nfHolesArgs PE:\{show inPE}" chktm
 
          -- Linearity and hole checking.
          -- on the LHS, all holes need to have been solved
@@ -164,13 +145,13 @@ elabTermSub {vars} defining mode opts nest env env' sub tm ty
               -- elsewhere, all unification problems must be
               -- solved, though we defer that if it's a case block since we
               -- might learn a bit more later.
-              _ => if (not incase)
-                      then do checkUserHolesAfter constart (inTrans || inPE)
-                              linearCheck (getFC tm) rigc False env chktm
-                          -- Linearity checking looks in case blocks, so no
-                          -- need to check here.
-                      else pure chktm
-         normaliseHoleTypes
+              _ => do if (not incase)
+                         then do checkUserHolesAfter constart (inTrans || inPE)
+                                 linearCheck (getFC tm) rigc env chktm
+                             -- Linearity checking looks in case blocks, so no
+                             -- need to check here.
+                         else pure ()
+                      pure chktm
          -- Put the current hole state back to what it was (minus anything
          -- which has been solved in the meantime)
          when (not incase) $
@@ -189,7 +170,7 @@ elabTermSub {vars} defining mode opts nest env env' sub tm ty
               InLHS _ =>
                  do let vs = findPLetRenames chktm
                     let ret = doPLetRenames vs [] chktm
-                    pure (ret, gnf env (doPLetRenames vs [] !(getTerm chkty)))
+                    pure (ret, !(nf env (doPLetRenames vs [] !(quote env chkty))))
               _ => do dumpConstraints "elab" 2 False
                       pure (chktm, chkty)
   where
diff --git a/src/TTImp/Elab/Ambiguity.idr b/src/TTImp/Elab/Ambiguity.idr
index aa553395f7f..d95d97db1e5 100644
--- a/src/TTImp/Elab/Ambiguity.idr
+++ b/src/TTImp/Elab/Ambiguity.idr
@@ -1,9 +1,13 @@
 module TTImp.Elab.Ambiguity
 
 import Core.Env
+import Core.Evaluate
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Quote
+import Core.Evaluate.Expand
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -38,6 +42,7 @@ expandAmbigName mode nest env orig args (IVar fc x) exp
                        pure orig
           Nothing => do
              defs <- get Ctxt
+             logC "elab.ambiguous" 50 $ pure "expandAmbigName Not-Nested: \{show x} @ \{show args}"
              case defined x env of
                   Just _ =>
                     if isNil args || notLHS mode
@@ -55,6 +60,7 @@ expandAmbigName mode nest env orig args (IVar fc x) exp
                             pure $ mkAlt primApp est xr
                           Nothing => do
                             ns <- lookupCtxtName x (gamma defs)
+                            logC "elab.ambiguous" 50 $ pure "expandAmbigName Not-Nested Not-In-Env Not-PrimName: \{show x} @ \{show $ map fst ns}"
                             ns' <- filterM visible ns
                             case ns' of
                                [] => do log "elab.ambiguous" 50 $ "Failed to find " ++ show orig
@@ -170,9 +176,10 @@ expandAmbigName elabmode nest env orig args tm exp
     = do log "elab.ambiguous" 50 $ "No ambiguity " ++ show orig
          pure orig
 
-stripDelay : NF vars -> NF vars
-stripDelay (NDelayed fc r t) = stripDelay t
-stripDelay tm = tm
+stripDelay : {vars: _} -> {auto c : Ref Ctxt Defs} ->
+             NF vars -> Core (NF vars)
+stripDelay (VDelayed fc r t) = stripDelay !(expand t)
+stripDelay tm = pure tm
 
 data TypeMatch = Concrete | Poly | NoMatch
 
@@ -184,57 +191,60 @@ Show TypeMatch where
 mutual
   mightMatchD : {auto c : Ref Ctxt Defs} ->
                 {vars : _} ->
-                Defs -> NF vars -> ClosedNF -> Core TypeMatch
-  mightMatchD defs l r
-      = mightMatch defs (stripDelay l) (stripDelay r)
+                NF vars -> ClosedNF -> Core TypeMatch
+  mightMatchD l r
+      = mightMatch !(stripDelay l) !(stripDelay r)
+
 
   mightMatchArg : {auto c : Ref Ctxt Defs} ->
                   {vars : _} ->
-                  Defs ->
-                  Closure vars -> ClosedClosure ->
+                  Glued vars -> Glued [<] ->
                   Core Bool
-  mightMatchArg defs l r
-      = pure $ case !(mightMatchD defs !(evalClosure defs l) !(evalClosure defs r)) of
+  mightMatchArg l r
+      = pure $ case !(mightMatchD !(expand l) !(expand r)) of
              NoMatch => False
              _ => True
 
   mightMatchArgs : {auto c : Ref Ctxt Defs} ->
                    {vars : _} ->
-                   Defs ->
-                   Scopeable (Closure vars) -> Scopeable ClosedClosure ->
+                   SnocList (Core (Glued vars)) -> SnocList (Core (Glued [<])) ->
                    Core Bool
-  mightMatchArgs defs [] [] = pure True
-  mightMatchArgs defs (x :: xs) (y :: ys)
-      = do amatch <- mightMatchArg defs x y
+  mightMatchArgs [<] [<] = pure True
+  mightMatchArgs (xs :< x) (ys :< y)
+      = do amatch <- mightMatchArg !x !y
            if amatch
-              then mightMatchArgs defs xs ys
+              then mightMatchArgs xs ys
               else pure False
-  mightMatchArgs _ _ _ = pure False
+  mightMatchArgs _ _ = pure False
 
   mightMatch : {auto c : Ref Ctxt Defs} ->
                {vars : _} ->
-               Defs -> NF vars -> ClosedNF -> Core TypeMatch
-  mightMatch defs target (NBind fc n (Pi {}) sc)
-      = mightMatchD defs target !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
-  mightMatch defs (NBind {}) (NBind {}) = pure Poly -- lambdas might match
-  mightMatch defs (NTCon _ n a args) (NTCon _ n' a' args')
+               NF vars -> ClosedNF -> Core TypeMatch
+  mightMatch target (VBind fc n (Pi {}) sc)
+      = mightMatchD target !(expand !(sc (pure (VErased fc Placeholder))))
+  mightMatch (VBind {}) (VBind {}) = pure Poly -- lambdas might match
+  mightMatch (VTCon _ n a args) (VTCon _ n' a' args')
       = if n == n'
-           then do amatch <- mightMatchArgs defs (map snd args) (map snd args')
+           then do amatch <- mightMatchArgs (map value args) (map value args')
                    if amatch then pure Concrete else pure NoMatch
            else pure NoMatch
-  mightMatch defs (NDCon _ n t a args) (NDCon _ n' t' a' args')
+  mightMatch (VDCon _ n t a args) (VDCon _ n' t' a' args')
       = if t == t'
-           then do amatch <- mightMatchArgs defs (map snd args) (map snd args')
+           then do amatch <- mightMatchArgs (map value args) (map value args')
                    if amatch then pure Concrete else pure NoMatch
            else pure NoMatch
-  mightMatch defs (NPrimVal _ x) (NPrimVal _ y)
+  mightMatch (VPrimVal _ x) (VPrimVal _ y)
       = if x == y then pure Concrete else pure NoMatch
-  mightMatch defs (NType {}) (NType {}) = pure Concrete
-  mightMatch defs (NApp {}) _ = pure Poly
-  mightMatch defs (NErased {}) _ = pure Poly
-  mightMatch defs _ (NApp {}) = pure Poly
-  mightMatch defs _ (NErased {}) = pure Poly
-  mightMatch _ _ _ = pure NoMatch
+  mightMatch (VType{}) (VType{}) = pure Concrete
+  mightMatch (VApp{}) _ = pure Poly
+  mightMatch (VMeta{}) _ = pure Poly
+  mightMatch (VLocal{}) _ = pure Poly
+  mightMatch (VErased{}) _ = pure Poly
+  mightMatch _ (VApp{}) = pure Poly
+  mightMatch _ (VMeta{}) = pure Poly
+  mightMatch _ (VLocal{}) = pure Poly
+  mightMatch _ (VErased{}) = pure Poly
+  mightMatch _ _ = pure NoMatch
 
 -- Return true if the given name could return something of the given target type
 couldBeName : {auto c : Ref Ctxt Defs} ->
@@ -243,7 +253,7 @@ couldBeName : {auto c : Ref Ctxt Defs} ->
 couldBeName defs target n
     = case !(lookupTyExact n (gamma defs)) of
            Nothing => pure Poly -- could be a local name, don't rule it out
-           Just ty => mightMatchD defs target !(nf defs Env.empty ty)
+           Just ty => mightMatchD target !(expand !(nf Env.empty ty))
 
 couldBeFn : {auto c : Ref Ctxt Defs} ->
             {vars : _} ->
@@ -259,17 +269,17 @@ couldBeFn defs ty _ = pure Poly
 couldBe : {auto c : Ref Ctxt Defs} ->
           {vars : _} ->
           Defs -> NF vars -> RawImp -> Core (Maybe (Bool, RawImp))
-couldBe {vars} defs ty@(NTCon _ n _ _) app
+couldBe {vars} defs ty@(VTCon _ n _ _) app
    = case !(couldBeFn {vars} defs ty (getFn app)) of
           Concrete => pure $ Just (True, app)
           Poly => pure $ Just (False, app)
           NoMatch => pure Nothing
-couldBe {vars} defs ty@(NPrimVal {}) app
+couldBe {vars} defs ty@(VPrimVal {}) app
    = case !(couldBeFn {vars} defs ty (getFn app)) of
           Concrete => pure $ Just (True, app)
           Poly => pure $ Just (False, app)
           NoMatch => pure Nothing
-couldBe {vars} defs ty@(NType {}) app
+couldBe {vars} defs ty@(VType {}) app
    = case !(couldBeFn {vars} defs ty (getFn app)) of
           Concrete => pure $ Just (True, app)
           Poly => pure $ Just (False, app)
@@ -306,7 +316,7 @@ pruneByType : {vars : _} ->
               Core (List RawImp)
 pruneByType env target alts
     = do defs <- get Ctxt
-         matches_in <- traverse (couldBe defs (stripDelay target)) alts
+         matches_in <- traverse (couldBe defs !(stripDelay target)) alts
          let matches = mapMaybe id matches_in
          logNF "elab.prune" 10 "Prune by" env target
          log "elab.prune" 10 (show matches)
@@ -362,7 +372,7 @@ checkAlternative rig elabinfo nest env fc (UniqueDefault def) alts mexpected
          expected <- maybe (do nm <- genName "altTy"
                                u <- uniVar fc
                                ty <- metaVar fc erased env nm (TType fc u)
-                               pure (gnf env ty))
+                               nf env ty)
                            pure mexpected
          let solvemode = case elabMode elabinfo of
                               InLHS c => inLHS
@@ -370,20 +380,19 @@ checkAlternative rig elabinfo nest env fc (UniqueDefault def) alts mexpected
          delayOnFailure fc rig env (Just expected) ambiguous Ambiguity $
              \delayed =>
                do solveConstraints solvemode Normal
-                  exp <- getTerm expected
-
                   -- We can't just use the old NF on the second attempt,
                   -- because we might know more now, so recalculate it
-                  let exp' = if delayed
-                                then gnf env exp
-                                else expected
+                  exp' <- ifThenElse delayed
+                             (do exp <- quote env expected
+                                 nf env exp)
+                             (pure expected)
 
-                  logGlueNF "elab.ambiguous" 5 (fastConcat
+                  logNF "elab.ambiguous" 5 (fastConcat
                     [ "Ambiguous elaboration at ", show fc, ":\n"
                     , unlines (map (("  " ++) . show) alts)
                     , "With default. Target type "
                     ]) env exp'
-                  alts' <- pruneByType env !(getNF exp') alts
+                  alts' <- pruneByType env !(expand exp') alts
                   log "elab.prune" 5 $
                     "Pruned " ++ show (minus (length alts) (length alts')) ++ " alts."
                     ++ " Kept:\n" ++ unlines (map show alts')
@@ -408,31 +417,32 @@ checkAlternative rig elabinfo nest env fc (UniqueDefault def) alts mexpected
 checkAlternative rig elabinfo nest env fc uniq alts mexpected
     = do checkAmbigDepth fc elabinfo
          alts' <- maybe (Core.pure [])
-                        (\exp => pruneByType env !(getNF exp) alts) mexpected
+                        (\exp => do logNF "elab.ambiguous" 5 "checkAlternative exp_backtick" env exp
+                                    pruneByType env !(expand exp) alts) mexpected
          case alts' of
            [alt] => checkImp rig elabinfo nest env alt mexpected
            _ =>
              do expected <- maybe (do nm <- genName "altTy"
                                       u <- uniVar fc
                                       ty <- metaVar fc erased env nm (TType fc u)
-                                      pure (gnf env ty))
+                                      nf env ty)
                                   pure mexpected
                 let solvemode = case elabMode elabinfo of
                                       InLHS c => inLHS
                                       _ => inTerm
                 delayOnFailure fc rig env (Just expected) ambiguous Ambiguity $
                      \delayed =>
-                       do exp <- getTerm expected
-
-                          -- We can't just use the old NF on the second attempt,
+                       do -- We can't just use the old NF on the second attempt,
                           -- because we might know more now, so recalculate it
-                          let exp' = if delayed
-                                        then gnf env exp
-                                        else expected
+                          exp' <- ifThenElse delayed
+                                     (do exp <- quote env expected
+                                         nf env exp)
+                                     (pure expected)
+                          logNF "elab.ambiguous" 5 "checkAlternative delayOnFailure exp_backtick" env exp'
 
-                          alts' <- pruneByType env !(getNF exp') alts
+                          alts' <- pruneByType env !(expand exp') alts
 
-                          logGlueNF "elab.ambiguous" 5 (fastConcat
+                          logNF "elab.ambiguous" 5 (fastConcat
                               [ "Ambiguous elaboration"
                               , " (kept ", show (length alts'), " out of "
                               , show (length alts), " candidates)"
diff --git a/src/TTImp/Elab/App.idr b/src/TTImp/Elab/App.idr
index af74ab8e44d..b19ea732c88 100644
--- a/src/TTImp/Elab/App.idr
+++ b/src/TTImp/Elab/App.idr
@@ -3,7 +3,12 @@ module TTImp.Elab.App
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Convert
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -12,7 +17,7 @@ import TTImp.Elab.Check
 import TTImp.Elab.Dot
 import TTImp.TTImp
 
-import Data.List
+import Data.SnocList
 import Data.Maybe
 
 import Libraries.Data.List.Extra
@@ -66,7 +71,7 @@ getNameType elabMode rigc env fc x
                      log "ide-mode.highlight" 7 $ "getNameType is adding Bound: " ++ show x
                      addSemanticDecorations [(nfc, Bound, Just x)]
 
-                 pure (Local fc (Just (isLet binder)) _ lv, gnf env bty)
+                 pure (Local fc (Just (isLet binder)) _ lv, !(nf env bty))
            Nothing =>
               do defs <- get Ctxt
                  [(pname, i, def)] <- lookupCtxtName x (gamma defs)
@@ -80,6 +85,8 @@ getNameType elabMode rigc env fc x
                  log "ide-mode.highlight" 8
                      $ "getNameType is trying to add something for: "
                       ++ show def.fullname ++ " (" ++ show fc ++ ")"
+                 logEnv "ide-mode.highlight" 8 "getNameType Nothing Env" env
+                 logTerm "ide-mode.highlight" 8 "getNameType Nothing type def of \{show x}" (type def)
 
                  when (isSourceName def.fullname) $
                    whenJust (isConcreteFC fc) $ \nfc => do
@@ -88,7 +95,8 @@ getNameType elabMode rigc env fc x
                        $ "getNameType is adding " ++ show decor ++ ": " ++ show def.fullname
                      addSemanticDecorations [(nfc, decor, Just def.fullname)]
 
-                 pure (Ref fc nt (Resolved i), gnf env (embed (type def)))
+                 logTerm "ide-mode.highlight" 8 "def" (embed {outer=vars} (type def))
+                 pure (Ref fc nt (Resolved i), !(nf env (embed (type def))))
   where
     rigSafe : RigCount -> RigCount -> Core ()
     rigSafe lhs rhs = when (lhs < rhs)
@@ -143,7 +151,7 @@ getVarType elabMode rigc nest env fc x
                                                                  ++ show ndef.fullname
                                     addSemanticDecorations [(nfc, decor, Just ndef.fullname)]
 
-                                pure (tm, arglen, gnf env tyenv)
+                                pure (tm, arglen, !(nf env tyenv))
     where
       useVars : {vars : _} ->
                 List (Term vars) -> Term vars -> Term vars
@@ -155,7 +163,7 @@ getVarType elabMode rigc nest env fc x
       useVars _ sc = sc -- Can't happen?
 
 isHole : NF vars -> Bool
-isHole (NApp _ (NMeta {}) _) = True
+isHole (VMeta{}) = True
 isHole _ = False
 
 mutual
@@ -168,8 +176,8 @@ mutual
                  {auto o : Ref ROpts REPLOpts} ->
                  RigCount -> RigCount -> ElabInfo ->
                  NestedNames vars -> Env Term vars ->
-                 FC -> (fntm : Term vars) ->
-                 Name -> Closure vars -> (Defs -> Closure vars -> Core (NF vars)) ->
+                 FC -> (fntm : Term vars) -> RigCount ->
+                 Name -> Glued vars -> (Core (Glued vars) -> Core (Glued vars)) ->
                  (argdata : (Maybe Name, Nat)) ->
                  (expargs : List RawImp) ->
                  (autoargs : List RawImp) ->
@@ -177,14 +185,14 @@ mutual
                  (knownret : Bool) ->
                  (expected : Maybe (Glued vars)) ->
                  Core (Term vars, Glued vars)
-  makeImplicit rig argRig elabinfo nest env fc tm x aty sc (n, argpos) expargs autoargs namedargs kr expty
+  makeImplicit rig argRig elabinfo nest env fc tm tmrig x aty sc (n, argpos) expargs autoargs namedargs kr expty
       = do defs <- get Ctxt
            nm <- genMVName x
            empty <- clearDefs defs
-           metaty <- quote empty env aty
+           metaty <- quote env aty
            metaval <- metaVar fc argRig env nm metaty
-           let fntm = App fc tm metaval
-           fnty <- sc defs (toClosure defaultOpts env metaval)
+           let fntm = App fc tm tmrig metaval
+           fnty <- expand !(sc (nf env metaval))
            when (bindingVars elabinfo) $ update EST $
              addBindIfUnsolved nm (getLoc (getFn tm)) argRig Implicit env metaval metaty
            checkAppWith rig elabinfo nest env fc
@@ -199,8 +207,8 @@ mutual
                      {auto o : Ref ROpts REPLOpts} ->
                      RigCount -> RigCount -> ElabInfo ->
                      NestedNames vars -> Env Term vars ->
-                     FC -> (fntm : Term vars) ->
-                     Name -> Closure vars -> (Defs -> Closure vars -> Core (NF vars)) ->
+                     FC -> (fntm : Term vars) -> RigCount ->
+                     Name -> Glued vars -> (Core (Glued vars) -> Core (Glued vars)) ->
                      (argpos : (Maybe Name, Nat)) ->
                      (expargs : List RawImp) ->
                      (autoargs : List RawImp) ->
@@ -208,36 +216,30 @@ mutual
                      (knownret : Bool) ->
                      (expected : Maybe (Glued vars)) ->
                      Core (Term vars, Glued vars)
-  makeAutoImplicit rig argRig elabinfo nest env fc tm x aty sc (n, argpos) expargs autoargs namedargs kr expty
+  makeAutoImplicit rig argRig elabinfo nest env fc tm tmrig x aty sc (n, argpos) expargs autoargs namedargs kr expty
   -- on the LHS, just treat it as an implicit pattern variable.
   -- on the RHS, add a searchable hole
       = if metavarImp (elabMode elabinfo)
            then do defs <- get Ctxt
                    nm <- genMVName x
                    empty <- clearDefs defs
-                   metaty <- quote empty env aty
+                   metaty <- quote env aty
                    metaval <- metaVar fc argRig env nm metaty
-                   let fntm = App fc tm metaval
-                   fnty <- sc defs (toClosure defaultOpts env metaval)
+                   let fntm = App fc tm tmrig metaval
+                   fnty <- expand !(sc (nf env metaval))
                    update EST $ addBindIfUnsolved nm (getLoc (getFn tm)) argRig AutoImplicit env metaval metaty
                    checkAppWith rig elabinfo nest env fc
                                 fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
            else do defs <- get Ctxt
                    nm <- genMVName x
                    empty <- clearDefs defs
-                   -- Normalise fully, but only if it's cheap enough.
-                   -- We have to get the normal form eventually anyway, but
-                   -- it might be too early to do it now if something is
-                   -- blocking it and we're not yet ready to search.
-                   metaty <- catch (quoteOpts (MkQuoteOpts False False (Just 10))
-                                              defs env aty)
-                                   (\err => quote empty env aty)
+                   metaty <- quote env aty
                    est <- get EST
                    lim <- getAutoImplicitLimit
                    metaval <- searchVar fc argRig lim (Resolved (defining est))
                                         env nest nm metaty
-                   let fntm = App fc tm metaval
-                   fnty <- sc defs (toClosure defaultOpts env metaval)
+                   let fntm = App fc tm tmrig metaval
+                   fnty <- expand !(sc (nf env metaval))
                    checkAppWith rig elabinfo nest env fc
                                 fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
     where
@@ -255,9 +257,9 @@ mutual
                     {auto o : Ref ROpts REPLOpts} ->
                     RigCount -> RigCount -> ElabInfo ->
                     NestedNames vars -> Env Term vars ->
-                    FC -> (fntm : Term vars) ->
-                    Name -> Closure vars -> Closure vars ->
-                    (Defs -> Closure vars -> Core (NF vars)) ->
+                    FC -> (fntm : Term vars) -> RigCount ->
+                    Name -> Glued vars -> Glued vars ->
+                    (Core (Glued vars) -> Core (Glued vars)) ->
                     (argpos : (Maybe Name, Nat)) ->
                     (expargs : List RawImp) ->
                     (autoargs : List RawImp) ->
@@ -265,25 +267,25 @@ mutual
                     (knownret : Bool) ->
                     (expected : Maybe (Glued vars)) ->
                     Core (Term vars, Glued vars)
-  makeDefImplicit rig argRig elabinfo nest env fc tm x arg aty sc (n, argpos) expargs autoargs namedargs kr expty
+  makeDefImplicit rig argRig elabinfo nest env fc tm tmrig x arg aty sc (n, argpos) expargs autoargs namedargs kr expty
   -- on the LHS, just treat it as an implicit pattern variable.
   -- on the RHS, use the default
       = if metavarImp (elabMode elabinfo)
            then do defs <- get Ctxt
                    nm <- genMVName x
                    empty <- clearDefs defs
-                   metaty <- quote empty env aty
+                   metaty <- quote env aty
                    metaval <- metaVar fc argRig env nm metaty
-                   let fntm = App fc tm metaval
-                   fnty <- sc defs (toClosure defaultOpts env metaval)
+                   let fntm = App fc tm tmrig metaval
+                   fnty <- expand !(sc (nf env metaval))
                    update EST $ addBindIfUnsolved nm (getLoc (getFn tm)) argRig AutoImplicit env metaval metaty
                    checkAppWith rig elabinfo nest env fc
                                 fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
            else do defs <- get Ctxt
                    empty <- clearDefs defs
-                   aval <- quote empty env arg
-                   let fntm = App fc tm aval
-                   fnty <- sc defs (toClosure defaultOpts env aval)
+                   aval <- quote env arg
+                   let fntm = App fc tm tmrig aval
+                   fnty <- expand !(sc (pure arg))
                    checkAppWith rig elabinfo nest env fc
                                 fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
     where
@@ -355,7 +357,7 @@ mutual
            _ => pure (tm, ty)
 
   dotErased : {vars : _} ->
-              {auto c : Ref Ctxt Defs} -> (argty : Closure vars) ->
+              {auto c : Ref Ctxt Defs} -> (argty : Glued vars) ->
               Maybe Name -> Nat -> ElabMode -> RigCount -> RawImp -> Core RawImp
   dotErased argty mn argpos (InLHS lrig ) rig tm
       = if not (isErased lrig) && isErased rig
@@ -363,7 +365,7 @@ mutual
             -- if the argument type aty has a single constructor, there's no need
             -- to dot it
             defs <- get Ctxt
-            nfargty <- evalClosure defs argty
+            nfargty <- expand argty
             mconsCount <- countConstructors nfargty
             logNF "elab.app.dot" 50
               "Found \{show mconsCount} constructors for type"
@@ -385,7 +387,7 @@ mutual
       -- meta, shouldn't we delay the check instead of declaring the tm dotted?
       ||| Count the constructors of a fully applied concrete datatype
       countConstructors : NF vars -> Core (Maybe Nat)
-      countConstructors (NTCon _ tycName n args) =
+      countConstructors (VTCon _ tycName n args) =
         if length args == n
         then do defs <- get Ctxt
                 Just gdef <- lookupCtxtExact tycName (gamma defs)
@@ -424,7 +426,7 @@ mutual
                  RigCount -> RigCount -> ElabInfo ->
                  NestedNames vars -> Env Term vars ->
                  FC -> (fntm : Term vars) -> Name ->
-                 (aty : Closure vars) -> (sc : Defs -> Closure vars -> Core (NF vars)) ->
+                 RigCount -> (aty : Glued vars) -> (sc : Core (Glued vars) -> Core (Glued vars)) ->
                  (argdata : (Maybe Name, Nat)) ->
                  (arg : RawImp) ->
                  (expargs : List RawImp) ->
@@ -433,20 +435,21 @@ mutual
                  (knownret : Bool) ->
                  (expected : Maybe (Glued vars)) ->
                  Core (Term vars, Glued vars)
-  checkRestApp rig argRig elabinfo nest env fc tm x aty sc
+  checkRestApp rig argRig elabinfo nest env fc tm x rigb aty sc
                (n, argpos) arg_in expargs autoargs namedargs knownret expty
-     = do defs <- get Ctxt
+     = do log "elab" 10 ("arg_in: " ++ show arg_in)
           arg <- dotErased aty n argpos (elabMode elabinfo) argRig arg_in
+          log "elab" 10 ("arg: " ++ show arg)
           kr <- if knownret
                    then pure True
-                   else do sc' <- sc defs (toClosure defaultOpts env (Erased fc Placeholder))
-                           concrete defs env sc'
+                   else do sc' <- sc (pure (VErased fc Placeholder))
+                           concrete env !(expand sc')
           -- In theory we can check the arguments in any order. But it turns
           -- out that it's sometimes better to do the rightmost arguments
           -- first to give ambiguity resolution more to work with. So
           -- we do that if the target type is unknown, or if we see that
           -- the raw term is otherwise worth delaying.
-          if (isHole !(evalClosure defs aty) && kr) || !(needsDelay (elabMode elabinfo) kr arg_in)
+          if (isHole !(expand aty) && kr) || !(needsDelay (elabMode elabinfo) kr arg_in)
              then handle (checkRtoL kr arg)
                   -- if the type isn't resolved, we might encounter an
                   -- implicit that we can't use yet because we don't know
@@ -464,35 +467,42 @@ mutual
                   RawImp -> -- argument currently being checked
                   Core (Term vars, Glued vars)
       checkRtoL kr arg
-        = do defs <- get Ctxt
-             nm <- genMVName x
-             empty <- clearDefs defs
-             metaty <- quote empty env aty
+        = do nm <- genMVName x
+             metaty <- quote env aty
+             logTerm "elab" 10 "metaty: " metaty
              (idx, metaval) <- argVar (getFC arg) argRig env nm metaty
-             let fntm = App fc tm metaval
+             let fntm = App fc tm rigb metaval
              logTerm "elab" 10 "...as" metaval
-             fnty <- sc defs (toClosure defaultOpts env metaval)
+             fnty <- expand !(sc (nf env metaval))
              (tm, gty) <- checkAppWith rig elabinfo nest env fc
                                        fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
+             logEnv "elab" 10 "Metaty Env" env
              defs <- get Ctxt
-             aty' <- nf defs env metaty
+             logMetatyCtxt defs metaty
+             aty' <- nf env metaty
              logNF "elab" 10 ("Now trying " ++ show nm ++ " " ++ show arg) env aty'
+             atyNF <- if onLHS (elabMode elabinfo)
+                         then Just <$> expand aty'
+                         else pure Nothing
 
              -- On the LHS, checking an argument can't resolve its own type,
              -- it must be resolved from elsewhere. Otherwise we might match
              -- on things which are too specific for their polymorphic type.
-             when (onLHS (elabMode elabinfo)) $
-                case aty' of
-                     NApp _ (NMeta _ i _) _ =>
-                          do Just gdef <- lookupCtxtExact (Resolved i) (gamma defs)
+             case atyNF of
+                  Just (VMeta _ _ i _ _ _) =>
+                          do defs <- get Ctxt
+                             Just gdef <- lookupCtxtExact (Resolved i) (gamma defs)
                                   | Nothing => pure ()
                              when (isErased (multiplicity gdef)) $ addNoSolve i
-                     _ => pure ()
-             res <- check argRig ({ topLevel := False } elabinfo) nest env arg (Just $ glueBack defs env aty')
-             when (onLHS (elabMode elabinfo)) $
-                case aty' of
-                     NApp _ (NMeta _ i _) _ => removeNoSolve i
-                     _ => pure ()
+                  _ => pure ()
+             case atyNF of
+                  Just x => logNF "elab" 50 "checkRtoL atyNF" env x
+                  _      => log   "elab" 50 "checkRtoL atyNF Nothing"
+
+             res <- logDepth $ check argRig ({ topLevel := False } elabinfo) nest env arg (Just aty')
+             case atyNF of
+                  Just (VMeta _ _ i _ _ _) => removeNoSolve i
+                  _ => pure ()
 
              (argv, argt) <-
                if not (onLHS (elabMode elabinfo))
@@ -500,25 +510,26 @@ mutual
                  else do let (argv, argt) = res
                          checkValidPattern rig env fc argv argt
 
-             defs <- get Ctxt
              -- If we're on the LHS, reinstantiate it with 'argv' because it
              -- *may* have as patterns in it and we need to retain them.
              -- (As patterns are a bit of a hack but I don't yet see a
              -- better way that leads to good code...)
-             logTerm "elab" 10 ("Solving " ++ show metaval ++ " with") argv
+             logTerm "elab" 10 ("Solving " ++ show !(toFullNames !(toFullNames metaval)) ++ " with") !(toFullNames !(toFullNames argv))
+             logEnv "elab" 10 "In env" env
              ok <- solveIfUndefined env metaval argv
              -- If there's a constraint, make a constant, but otherwise
              -- just return the term as expected
              tm <- if not ok
                       then do res <- convert fc elabinfo env
-                                                 (gnf env metaval)
-                                                 (gnf env argv)
+                                                 !(nf env metaval)
+                                                 !(nf env argv)
                               let [] = constraints res
-                                  | cs => do tmty <- getTerm gty
+                                  | cs => do tmty <- quote env gty
                                              newConstant fc rig env tm tmty cs
                               ignore $ updateSolution env metaval argv
                               pure tm
                       else pure tm
+             logTerm "elab" 10 "Solved tm ok=\{show ok}" tm
              when (onLHS $ elabMode elabinfo) $
                  -- reset hole and redo it with the unexpanded definition
                  do updateDef (Resolved idx) (const (Just (Hole 0 (holeInit False))))
@@ -526,37 +537,43 @@ mutual
              -- Mark for reduction when we finish elaborating
              updateDef (Resolved idx)
                   (\def => case def of
-                        (PMDef pminfo args treeCT treeRT pats) =>
-                           Just (PMDef ({alwaysReduce := True} pminfo) args treeCT treeRT pats)
+                        (Function pminfo treeCT treeRT pats) =>
+                           Just (Function ({alwaysReduce := True} pminfo) treeCT treeRT pats)
                         _ => Nothing
                         )
              removeHole idx
              pure (tm, gty)
+        where
+          logMetatyCtxt : Defs -> Term vars -> Core ()
+          logMetatyCtxt defs (Meta _ _ idx _) = do
+            m_metagdef <- lookupCtxtExact (Resolved idx) (gamma defs)
+            log "elab" 10 $ "Meta definition from " ++ show idx ++ ": " ++ show (map definition m_metagdef)
+            pure ()
+          logMetatyCtxt _ _ = pure ()
 
       checkLtoR : Bool -> -- return type is known
                   RawImp -> -- argument currently being checked
                   Core (Term vars, Glued vars)
       checkLtoR kr arg
-        = do defs <- get Ctxt
-             logNF "elab" 10 ("Full function type") env
-                      (NBind fc x (Pi fc argRig Explicit aty) sc)
+        = do logNF "elab" 10 ("Full function type") env
+                   (VBind {f=Normal} fc x (Pi fc argRig Explicit aty) sc)
              logC "elab" 10
                      (do ety <- maybe (pure Nothing)
-                                     (\t => pure (Just !(toFullNames!(getTerm t))))
+                                     (\t => pure (Just !(toFullNames !(quote env t))))
                                      expty
                          pure ("Overall expected type: " ++ show ety))
-             res <- check argRig ({ topLevel := False } elabinfo)
-                                   nest env arg (Just (glueClosure defs env aty))
+             res <- logDepth $ check argRig ({ topLevel := False } elabinfo)
+                                   nest env arg (Just aty)
              (argv, argt) <-
                if not (onLHS (elabMode elabinfo))
                  then pure res
                  else do let (argv, argt) = res
                          checkValidPattern rig env fc argv argt
 
-             logGlueNF "elab" 10 "Got arg type" env argt
-             defs <- get Ctxt
-             let fntm = App fc tm argv
-             fnty <- sc defs (toClosure defaultOpts env argv)
+             logNF "elab" 10 "Got arg type" env argt
+             let fntm = App fc tm rigb argv
+             logTerm "elab" 10 "Got fntm" fntm
+             fnty <- expand !(sc (nf env argv))
              checkAppWith rig elabinfo nest env fc
                           fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
 
@@ -576,6 +593,61 @@ mutual
   isBindAllExpPattern (UN Underscore) = True
   isBindAllExpPattern _ = False
 
+  checkAppNotFnType : {vars : _} ->
+                  {auto c : Ref Ctxt Defs} ->
+                  {auto m : Ref MD Metadata} ->
+                  {auto u : Ref UST UState} ->
+                  {auto e : Ref EST (EState vars)} ->
+                  {auto s : Ref Syn SyntaxInfo} ->
+                  {auto o : Ref ROpts REPLOpts} ->
+                  RigCount -> ElabInfo ->
+                  NestedNames vars -> Env Term vars ->
+                  FC -> (fntm : Term vars) -> (fnty : NF vars) ->
+                  (argdata : (Maybe Name, Nat)) ->
+                       -- function we're applying, and argument position, for
+                       -- checking if it's okay to erase against 'safeErase'
+                  (expargs : List RawImp) ->
+                  (autoargs : List RawImp) ->
+                  (namedargs : List (Name, RawImp)) ->
+                  (knownret : Bool) -> -- Do we know what the return type is yet?
+                               -- if we do, we might be able to use it to work
+                               -- out the types of arguments before elaborating them
+                  (expected : Maybe (Glued vars)) ->
+                  Core (Term vars, Glued vars)
+  -- Invent a function type if we have extra explicit arguments but type is further unknown
+  checkAppNotFnType {vars} rig elabinfo nest env fc tm ty (n, argpos) (arg :: expargs) autoargs namedargs kr expty
+      = -- Invent a function type,  and hope that we'll know enough to solve it
+        -- later when we unify with expty
+        do logNF "elab.with" 10 "Function type" env ty
+           logTerm "elab.with" 10 "Function " tm
+           argn <- genName "argTy"
+           retn <- genName "retTy"
+           u <- uniVar fc
+           argTy <- metaVar fc erased env argn (TType fc u)
+           argTyG <- nf env argTy
+           retTy <- metaVar -- {vars = argn :: vars}
+                            fc erased env -- (Pi RigW Explicit argTy :: env)
+                            retn (TType fc u)
+           (argv, argt) <- logDepth $ check rig elabinfo
+                                 nest env arg (Just argTyG)
+           let fntm = App fc tm top argv
+           fnty <- nf env retTy
+           expfnty <- nf env (Bind fc argn (Pi fc top Explicit argTy) (weaken retTy))
+           logNF "elab.with" 10 "Expected function type" env expfnty
+           -- whenJust expty (logNF "elab.with" 10 "Expected result type" env)
+           res <- logDepth $ checkAppWith' rig elabinfo nest env fc fntm !(expand fnty) (n, 1 + argpos) expargs autoargs namedargs kr expty
+           cres <- Check.convert fc elabinfo env (asGlued ty) expfnty
+           let [] = constraints cres
+              | cs => do cty <- quote env expfnty
+                         ctm <- newConstant fc rig env (fst res) cty cs
+                         pure (ctm, !(nf env retTy))
+           pure res
+  -- Only non-user implicit `as` bindings are allowed to be present as arguments at this stage
+  checkAppNotFnType rig elabinfo nest env fc tm ty argdata [] autoargs namedargs kr expty
+      = if all isImplicitAs (autoargs ++ map snd (filter (not . isBindAllExpPattern . fst) namedargs))
+           then checkExp rig elabinfo env fc tm (asGlued ty) expty
+           else throw (InvalidArgs fc env (map (const (UN $ Basic "<auto>")) autoargs ++ map fst namedargs) tm)
+
   -- Check an application of 'fntm', with type 'fnty' to the given list
   -- of explicit and implicit arguments.
   -- Returns the checked term and its (weakly) normalised type
@@ -601,26 +673,26 @@ mutual
                  (expected : Maybe (Glued vars)) ->
                  Core (Term vars, Glued vars)
    -- Explicit Pi, we use provided unnamed explicit argument
-  checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb Explicit aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb Explicit aty) sc)
                argdata (arg :: expargs') autoargs namedargs kr expty
      = do let argRig = rig |*| rigb
           checkRestApp rig argRig elabinfo nest env fc
-                       tm x aty sc argdata arg expargs' autoargs namedargs kr expty
-  checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb Explicit aty) sc)
+                       tm x rigb aty sc argdata arg expargs' autoargs namedargs kr expty
+  checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb Explicit aty) sc)
                argdata [] autoargs namedargs kr expty with (findNamed x namedargs)
    -- We found a compatible named argument
-   checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb Explicit aty) sc)
+   checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb Explicit aty) sc)
                 argdata [] autoargs namedargs kr expty | Just ((_, arg), namedargs')
     = do let argRig = rig |*| rigb
          checkRestApp rig argRig elabinfo nest env fc
-                      tm x aty sc argdata arg [] autoargs namedargs' kr expty
-   checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb Explicit aty) sc)
+                      tm x rigb aty sc argdata arg [] autoargs namedargs' kr expty
+   checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb Explicit aty) sc)
                 argdata [] autoargs namedargs kr expty | Nothing
     = case findBindAllExpPattern namedargs of
            Just arg => -- Bind-all-explicit pattern is present - implicitly bind
              do let argRig = rig |*| rigb
                 checkRestApp rig argRig elabinfo nest env fc
-                             tm x aty sc argdata arg [] autoargs namedargs kr expty
+                             tm x rigb aty sc argdata arg [] autoargs namedargs kr expty
            _ =>
              do defs <- get Ctxt
                 if all isImplicitAs (autoargs
@@ -628,131 +700,98 @@ mutual
                                                                     -- Only non-user implicit `as` bindings added by
                                                                     -- the compiler are allowed here
                    then -- We are done
-                        checkExp rig elabinfo env fc tm (glueBack defs env ty) expty
+                        checkExp rig elabinfo env fc tm (asGlued ty) expty
                    else -- Some user defined binding is present while we are out of explicit arguments, that's an error
                         throw (InvalidArgs fc env (map (const (UN $ Basic "<auto>")) autoargs ++ map fst namedargs) tm)
   -- Function type is delayed:
   --   RHS: force the term
   --   LHS: strip off delay but only for explicit functions and disallow any further patterns
-  checkAppWith' rig elabinfo nest env fc tm (NDelayed dfc r ty@(NBind _ _ (Pi _ _ i _) sc)) argdata expargs autoargs namedargs kr expty
-      = if onLHS (elabMode elabinfo)
-           then do when (isImplicit i) $ throw (LazyImplicitFunction fc)
-                   let ([], [], []) = (expargs, autoargs, namedargs)
-                       | _ => throw (LazyPatternVar fc)
-                   (tm, gfty) <- checkAppWith' rig elabinfo nest env fc tm ty argdata expargs autoargs namedargs kr expty
-                   fty <- getTerm gfty
-                   pure (tm, gnf env (TDelayed dfc r fty))
-           else checkAppWith' rig elabinfo nest env fc (TForce dfc r tm) ty argdata expargs autoargs namedargs kr expty
+  checkAppWith' rig elabinfo nest env fc tm dty@(VDelayed dfc r ty) argdata expargs autoargs namedargs kr expty
+      = do ty' <- expand ty
+           case ty' of
+                VBind _ _ (Pi _ _ _ _) sc =>
+                  checkAppWith' rig elabinfo nest env fc (TForce dfc r tm) !(expand ty)
+                        argdata expargs autoargs namedargs kr expty
+                _ => checkAppNotFnType rig elabinfo nest env fc tm dty argdata expargs autoargs namedargs kr expty
   -- If there's no more arguments given, and the plicities of the type and
   -- the expected type line up, stop
-  checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb Implicit aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb Implicit aty) sc)
                argdata [] [] [] kr (Just expty_in)
       = do let argRig = rig |*| rigb
-           expty <- getNF expty_in
+           expty <- expand expty_in
            defs <- get Ctxt
            case expty of
-                NBind tfc' x' (Pi _ rigb' Implicit aty') sc'
-                   => checkExp rig elabinfo env fc tm (glueBack defs env ty) (Just expty_in)
+                VBind tfc' x' (Pi _ rigb' Implicit aty') sc'
+                   => checkExp rig elabinfo env fc tm (asGlued ty) (Just expty_in)
                 _ => if not (preciseInf elabinfo)
-                        then makeImplicit rig argRig elabinfo nest env fc tm x aty sc argdata [] [] [] kr (Just expty_in)
+                        then makeImplicit rig argRig elabinfo nest env fc tm rigb x aty sc argdata [] [] [] kr (Just expty_in)
                         -- in 'preciseInf' mode blunder on anyway, and hope
                         -- that we can resolve the implicits
-                        else handle (checkExp rig elabinfo env fc tm (glueBack defs env ty) (Just expty_in))
-                               (\err => makeImplicit rig argRig elabinfo nest env fc tm x aty sc argdata [] [] [] kr (Just expty_in))
+                        else handle (checkExp rig elabinfo env fc tm (asGlued ty) (Just expty_in))
+                               (\err => makeImplicit rig argRig elabinfo nest env fc tm rigb x aty sc argdata [] [] [] kr (Just expty_in))
   -- Same for auto
-  checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb AutoImplicit aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb AutoImplicit aty) sc)
                argdata [] [] [] kr (Just expty_in)
       = do let argRig = rig |*| rigb
-           expty <- getNF expty_in
+           expty <- expand expty_in
            defs <- get Ctxt
            case expty of
-                NBind tfc' x' (Pi _ rigb' AutoImplicit aty') sc'
-                   => checkExp rig elabinfo env fc tm (glueBack defs env ty) (Just expty_in)
-                _ => makeAutoImplicit rig argRig elabinfo nest env fc tm x aty sc argdata [] [] [] kr (Just expty_in)
+                VBind tfc' x' (Pi _ rigb' AutoImplicit aty') sc'
+                   => checkExp rig elabinfo env fc tm (asGlued ty) (Just expty_in)
+                _ => makeAutoImplicit rig argRig elabinfo nest env fc tm rigb x aty sc argdata [] [] [] kr (Just expty_in)
   -- Same for default
-  checkAppWith' rig elabinfo nest env fc tm ty@(NBind tfc x (Pi _ rigb (DefImplicit aval) aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm ty@(VBind tfc x (Pi _ rigb (DefImplicit aval) aty) sc)
                argdata [] [] [] kr (Just expty_in)
       = do let argRig = rigMult rig rigb
-           expty <- getNF expty_in
+           expty <- expand expty_in
            defs <- get Ctxt
            case expty of
-                NBind tfc' x' (Pi _ rigb' (DefImplicit aval') aty') sc'
-                   => if !(convert defs env aval aval')
-                         then checkExp rig elabinfo env fc tm (glueBack defs env ty) (Just expty_in)
-                         else makeDefImplicit rig argRig elabinfo nest env fc tm x aval aty sc argdata [] [] [] kr (Just expty_in)
-                _ => makeDefImplicit rig argRig elabinfo nest env fc tm x aval aty sc argdata [] [] [] kr (Just expty_in)
+                VBind tfc' x' (Pi _ rigb' (DefImplicit aval') aty') sc'
+                   => if !(convert env aval aval')
+                         then checkExp rig elabinfo env fc tm (asGlued ty) (Just expty_in)
+                         else makeDefImplicit rig argRig elabinfo nest env fc tm rigb x aval aty sc argdata [] [] [] kr (Just expty_in)
+                _ => makeDefImplicit rig argRig elabinfo nest env fc tm rigb x aval aty sc argdata [] [] [] kr (Just expty_in)
 
   -- Check next unnamed auto implicit argument
-  checkAppWith' rig elabinfo nest env fc tm (NBind tfc x (Pi _ rigb AutoImplicit aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm (VBind tfc x (Pi _ rigb AutoImplicit aty) sc)
                argdata expargs (arg :: autoargs') namedargs kr expty
       = checkRestApp rig (rig |*| rigb) elabinfo nest env fc
-                         tm x aty sc argdata arg expargs autoargs' namedargs kr expty
+                         tm x rigb aty sc argdata arg expargs autoargs' namedargs kr expty
   -- Check next named auto implicit argument
-  checkAppWith' rig elabinfo nest env fc tm (NBind tfc x (Pi _ rigb AutoImplicit aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm (VBind tfc x (Pi _ rigb AutoImplicit aty) sc)
                argdata expargs [] namedargs kr expty
       = let argRig = rig |*| rigb in
             case findNamed x namedargs of
                  Just ((_, arg), namedargs') =>
                     checkRestApp rig argRig elabinfo nest env fc
-                                 tm x aty sc argdata arg expargs [] namedargs' kr expty
+                                 tm x rigb aty sc argdata arg expargs [] namedargs' kr expty
                  Nothing =>
-                         makeAutoImplicit rig argRig elabinfo nest env fc tm
+                         makeAutoImplicit rig argRig elabinfo nest env fc tm rigb
                                               x aty sc argdata expargs [] namedargs kr expty
   -- Check next implicit argument
-  checkAppWith' rig elabinfo nest env fc tm (NBind tfc x (Pi _ rigb Implicit aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm (VBind tfc x (Pi _ rigb Implicit aty) sc)
                argdata expargs autoargs namedargs kr expty
       = let argRig = rig |*| rigb in
             case findNamed x namedargs of
-               Nothing => makeImplicit rig argRig elabinfo nest env fc tm
+               Nothing => makeImplicit rig argRig elabinfo nest env fc tm rigb
                                        x aty sc argdata expargs autoargs namedargs kr expty
                Just ((_, arg), namedargs') =>
-                     checkRestApp rig argRig elabinfo nest env fc
-                                  tm x aty sc argdata arg expargs autoargs namedargs' kr expty
+                     checkRestApp rig argRig elabinfo nest env fc tm
+                                  x rigb aty sc argdata arg expargs autoargs namedargs' kr expty
   -- Check next default argument
-  checkAppWith' rig elabinfo nest env fc tm (NBind tfc x (Pi _ rigb (DefImplicit arg) aty) sc)
+  checkAppWith' rig elabinfo nest env fc tm (VBind tfc x (Pi _ rigb (DefImplicit arg) aty) sc)
                argdata expargs autoargs namedargs kr expty
       = let argRig = rigMult rig rigb in
             case findNamed x namedargs of
-               Nothing => makeDefImplicit rig argRig elabinfo nest env fc tm
+               Nothing => makeDefImplicit rig argRig elabinfo nest env fc tm rigb
                                           x arg aty sc argdata expargs autoargs namedargs kr expty
                Just ((_, arg), namedargs') =>
                      checkRestApp rig argRig elabinfo nest env fc
-                                  tm x aty sc argdata arg expargs autoargs namedargs' kr expty
+                                  tm x rigb aty sc argdata arg expargs autoargs namedargs' kr expty
   -- Invent a function type if we have extra explicit arguments but type is further unknown
-  checkAppWith' {vars} rig elabinfo nest env fc tm ty (n, argpos) (arg :: expargs) autoargs namedargs kr expty
-      = -- Invent a function type,  and hope that we'll know enough to solve it
-        -- later when we unify with expty
-        do logNF "elab.with" 10 "Function type" env ty
-           logTerm "elab.with" 10 "Function " tm
-           argn <- genName "argTy"
-           retn <- genName "retTy"
-           u <- uniVar fc
-           argTy <- metaVar fc erased env argn (TType fc u)
-           let argTyG = gnf env argTy
-           retTy <- metaVar -- {vars = argn :: vars}
-                            fc erased env -- (Pi RigW Explicit argTy :: env)
-                            retn (TType fc u)
-           (argv, argt) <- check rig elabinfo
-                                 nest env arg (Just argTyG)
-           let fntm = App fc tm argv
-           defs <- get Ctxt
-           fnty <- nf defs env retTy -- (Bind fc argn (Let RigW argv argTy) retTy)
-           let expfnty = gnf env (Bind fc argn (Pi fc top Explicit argTy) (weaken retTy))
-           logGlue "elab.with" 10 "Expected function type" expfnty
-           whenJust expty (logGlue "elab.with" 10 "Expected result type")
-           res <- checkAppWith' rig elabinfo nest env fc fntm fnty (n, 1 + argpos) expargs autoargs namedargs kr expty
-           cres <- Check.convert fc elabinfo env (glueBack defs env ty) expfnty
-           let [] = constraints cres
-              | cs => do cty <- getTerm expfnty
-                         ctm <- newConstant fc rig env (fst res) cty cs
-                         pure (ctm, gnf env retTy)
-           pure res
-  -- Only non-user implicit `as` bindings are allowed to be present as arguments at this stage
-  checkAppWith' rig elabinfo nest env fc tm ty argdata [] autoargs namedargs kr expty
-      = do defs <- get Ctxt
-           if all isImplicitAs (autoargs ++ map snd (filter (not . isBindAllExpPattern . fst) namedargs))
-              then checkExp rig elabinfo env fc tm (glueBack defs env ty) expty
-              else throw (InvalidArgs fc env (map (const (UN $ Basic "<auto>")) autoargs ++ map fst namedargs) tm)
+  -- Invent a function type if we have extra explicit arguments but type is further unknown
+  checkAppWith' rig elabinfo nest env fc tm ty argdata expargs autoargs namedargs kr expty
+      = checkAppNotFnType rig elabinfo nest env fc tm ty argdata expargs autoargs namedargs kr expty
 
   ||| Entrypoint for checkAppWith: run the elaboration first and, if we're
   ||| on the LHS and the result is an under-applied constructor then insist
@@ -815,8 +854,13 @@ checkApp rig elabinfo nest env fc (IAutoApp fc' fn arg) expargs autoargs namedar
 checkApp rig elabinfo nest env fc (INamedApp fc' fn nm arg) expargs autoargs namedargs exp
    = checkApp rig elabinfo nest env fc' fn expargs autoargs ((nm, arg) :: namedargs) exp
 checkApp rig elabinfo nest env fc (IVar fc' n) expargs autoargs namedargs exp
-   = do (ntm, arglen, nty_in) <- getVarType elabinfo.elabMode rig nest env fc' n
-        nty <- getNF nty_in
+   = do logEnv "elab" 50 "checkApp-IVar Env for \{show !(getFullName n)}" env
+        (ntm, arglen, nty_in) <- getVarType elabinfo.elabMode rig nest env fc' n
+        logTerm "elab" 50 "checkApp-IVar ntm arglen: \{show arglen}" ntm
+        logNF "elab" 50 "checkApp-IVar nty_in" env nty_in
+        nty <- expand nty_in
+        logNF "elab" 50 "checkApp-IVar nty" env nty
+
         prims <- getPrimitiveNames
         elabinfo <- updateElabInfo prims elabinfo.elabMode n expargs elabinfo
 
@@ -824,10 +868,10 @@ checkApp rig elabinfo nest env fc (IVar fc' n) expargs autoargs namedargs exp
 
         logC "elab" 10
                 (do defs <- get Ctxt
-                    fnty <- quote defs env nty
+                    fnty <- logQuiet $ quote env nty
                     exptyt <- maybe (pure Nothing)
-                                       (\t => do ety <- getTerm t
-                                                 etynf <- normaliseHoles defs env ety
+                                       (\t => do ety <- quote env t
+                                                 etynf <- normaliseHoles env ety
                                                  pure (Just !(toFullNames etynf)))
                                        exp
                     pure ("Checking application of " ++ show !(getFullName n) ++
@@ -847,10 +891,10 @@ checkApp rig elabinfo nest env fc (IVar fc' n) expargs autoargs namedargs exp
                      (Term vs, Glued vs) ->
                      Core (Term vs, Glued vs)
     normalisePrims prims env res
-        = do tm <- Normalise.normalisePrims (`boundSafe` elabMode elabinfo)
+        = do tm <- Evaluate.normalisePrims (`boundSafe` elabMode elabinfo)
                                             isIPrimVal
                                             (onLHS (elabMode elabinfo))
-                                            prims n expargs (fst res) env
+                                            prims n (cast {to=SnocList RawImp} expargs) (fst res) env
              pure (fromMaybe (fst res) tm, snd res)
 
       where
@@ -877,5 +921,5 @@ checkApp rig elabinfo nest env fc (IVar fc' n) expargs autoargs namedargs exp
 
 checkApp rig elabinfo nest env fc fn expargs autoargs namedargs exp
    = do (fntm, fnty_in) <- checkImp rig elabinfo nest env fn Nothing
-        fnty <- getNF fnty_in
+        fnty <- expand fnty_in
         checkAppWith rig elabinfo nest env fc fntm fnty (Nothing, 0) expargs autoargs namedargs False exp
diff --git a/src/TTImp/Elab/As.idr b/src/TTImp/Elab/As.idr
index bc6eb22d2ee..bef7d382685 100644
--- a/src/TTImp/Elab/As.idr
+++ b/src/TTImp/Elab/As.idr
@@ -3,6 +3,9 @@ module TTImp.Elab.As
 import Core.Env
 import Core.Metadata
 import Core.Unify
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Quote
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -44,12 +47,12 @@ checkAs rig elabinfo nest env fc nameFC side n_in pat topexp
                     defs <- get Ctxt
                     update EST { boundNames $= ((n, AsBinding rigAs Explicit tm exp pattm) :: ),
                                  toBind $= ((n, AsBinding rigAs Explicit tm bty pattm) ::) }
-                    (ntm, nty) <- checkExp rig elabinfo env nameFC tm (gnf env exp)
+                    (ntm, nty) <- checkExp rig elabinfo env nameFC tm !(nf env exp)
                                            (Just patty)
 
                     -- Add the name type to the metadata
                     log "metadata.names" 7 $ "checkAs is adding ↓"
-                    addNameType nameFC n_in env !(getTerm nty)
+                    addNameType nameFC n_in env !(quote env nty)
 
                     pure (As fc side ntm pattm, patty)
               Just bty => throw (NonLinearPattern fc n_in)
diff --git a/src/TTImp/Elab/Binders.idr b/src/TTImp/Elab/Binders.idr
index dcf28e42438..1030360d2e6 100644
--- a/src/TTImp/Elab/Binders.idr
+++ b/src/TTImp/Elab/Binders.idr
@@ -3,7 +3,10 @@ module TTImp.Elab.Binders
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -64,8 +67,8 @@ checkPi rig elabinfo nest env fc rigf info n argTy retTy expTy
          tyu <- uniVar fc
          (tyv, tyt) <- check pirig elabinfo nest env argTy
                              (Just (gType fc tyu))
-         info' <- checkPiInfo rigf elabinfo nest env info (Just (gnf env tyv))
-         let env' : Env Term (n :: _) = Pi fc rigf info' tyv :: env
+         info' <- checkPiInfo rigf elabinfo nest env info (Just !(nf env tyv))
+         let env' : Env Term (_ :< n) = Env.bind env $ Pi fc rigf info' tyv
          let nest' = weaken (dropName n nest)
          scu <- uniVar fc
          (scopev, scopet) <-
@@ -81,13 +84,13 @@ checkPi rig elabinfo nest env fc rigf info n argTy retTy expTy
     getRig (InLHS _) = rig
     getRig _ = erased
 
-findLamRig : {auto c : Ref Ctxt Defs} ->
+findLamRig : {vars: _} -> {auto c : Ref Ctxt Defs} ->
              Maybe (Glued vars) -> Core RigCount
 findLamRig Nothing = pure top
 findLamRig (Just expty)
-    = do tynf <- getNF expty
+    = do tynf <- expand expty
          case tynf of
-              NBind _ _ (Pi _ c _ _) sc => pure c
+              VBind _ _ (Pi _ c _ _) sc => pure c
               _ => pure top
 
 inferLambda : {vars : _} ->
@@ -109,30 +112,20 @@ inferLambda rig elabinfo nest env fc rigl info n argTy scope expTy
          let rigb = rigb_in `glb` rigl
          u <- uniVar fc
          (tyv, tyt) <- check erased elabinfo nest env argTy (Just (gType fc u))
-         info' <- checkPiInfo rigl elabinfo nest env info (Just (gnf env tyv))
-         let env' : Env Term (n :: _) = Lam fc rigb info' tyv :: env
+         info' <- checkPiInfo rigl elabinfo nest env info (Just !(nf env tyv))
+         let env' : Env Term (_ :< n) = Env.bind env $ Lam fc rigb info' tyv
          let nest' = weaken (dropName n nest)
          (scopev, scopet) <- inScope fc env' (\e' =>
                                 check {e=e'} rig elabinfo
                                       nest' env' scope Nothing)
-         let lamty = gnf env (Bind fc n (Pi fc rigb info' tyv) !(getTerm scopet))
-         logGlue "elab.binder" 5 "Inferred lambda type" lamty
+         lamty <- nf env (Bind fc n (Pi fc rigb info' tyv) !(quote env' scopet))
+         logValue "elab.binder" 5 "Inferred lambda type" lamty
          maybe (pure ())
-               (logGlueNF "elab.binder" 5 "Expected lambda type" env) expTy
+               (logNF "elab.binder" 5 "Expected lambda type" env) expTy
          checkExp rig elabinfo env fc
                   (Bind fc n (Lam fc rigb info' tyv) scopev)
                   lamty expTy
 
-getTyNF : {vars : _} ->
-          {auto c : Ref Ctxt Defs} ->
-          Env Term vars -> Term vars -> Core (Term vars)
-getTyNF env x@(Bind {}) = pure x
-getTyNF env x
-    = do defs <- get Ctxt
-         xnf <- nf defs env x
-         empty <- clearDefs defs
-         quote empty env xnf
-
 export
 checkLambda : {vars : _} ->
               {auto c : Ref Ctxt Defs} ->
@@ -157,26 +150,34 @@ checkLambda rig_in elabinfo nest env fc rigl info n argTy scope (Just expty_in)
                               InLHS _ => inLHS
                               _ => inTerm
          solveConstraints solvemode Normal
-         expty <- getTerm expty_in
-         exptynf <- getTyNF env expty
-         defs <- get Ctxt
-         case exptynf of
+         -- `quoteOnePi` introduction requires to make a weaker version of
+         -- visibility checker: `getVisibilityWeaked`
+         expty_in' <- expand expty_in
+         logNF "elab.binder" 50 "checkLambda getTerm expty*" env expty_in'
+         expty <- quoteOnePi env expty_in'
+         logTerm "elab.binder" 50 "checkLambda quoteOnePi expty*" expty
+         case expty of
               Bind bfc bn (Pi fc' c _ pty) psc =>
                  do u <- uniVar fc'
                     (tyv, tyt) <- check erased elabinfo nest env
                                         argTy (Just (gType fc u))
-                    info' <- checkPiInfo rigl elabinfo nest env info (Just (gnf env tyv))
+                    logTermNF "elab.binder" 10 "check tyv" env tyv
+                    logNF "elab.binder" 10 "check tyt" env tyt
+
+                    info' <- checkPiInfo rigl elabinfo nest env info (Just !(nf env tyv))
                     let rigb = rigl `glb` c
-                    let env' : Env Term (n :: _) = Lam fc rigb info' tyv :: env
-                    ignore $ convert fc elabinfo env (gnf env tyv) (gnf env pty)
+                    let env' : Env Term (_ :< n) = Env.bind env $ Lam fc rigb info' tyv
+                    ignore $ convert fc elabinfo env !(nf env tyv) !(nf env pty)
                     let nest' = weaken (dropName n nest)
-                    pscnf <- normaliseHoles defs env' $ compat psc
+                    let scopetTm = renameTop n psc
+                    scopet <- nf env' scopetTm
+                    pscnf <- normaliseHoles env' $ compat psc
                     (scopev, scopet) <-
                        inScope fc env' (\e' =>
                           check {e=e'} rig elabinfo nest' env' scope
-                                (Just $ gnf env' pscnf))
-                    logTermNF "elab.binder" 10 "Lambda type" env exptynf
-                    logGlueNF "elab.binder" 10 "Got scope type" env' scopet
+                                (Just !(nf env' (compat psc))))
+                    logTermNF "elab.binder" 10 "Lambda type" env expty
+                    logNF "elab.binder" 10 "Got scope type" env' scopet
 
                     -- Currently, the fc a PLam holds (and that ILam gets as a consequence)
                     -- is the file context of the argument to the lambda. This fits nicely
@@ -186,21 +187,24 @@ checkLambda rig_in elabinfo nest env fc rigl info n argTy scope (Just expty_in)
 
                     -- We've already checked the argument and scope types,
                     -- so we just need to check multiplicities
+                    defs <- get Ctxt
                     when (rigb /= c) $
-                        throw (CantConvert fc (gamma defs) env
-                                  (Bind fc n (Pi fc' rigb info' tyv) !(getTerm scopet))
-                                  (Bind fc bn (Pi fc' c info' pty) psc))
+                           throw (CantConvert fc (gamma defs) env
+                                    (Bind fc n (Pi fc' rigb info' tyv) scopetTm)
+                                    (Bind fc bn (Pi fc' c info' pty) psc))
+
                     pure (Bind fc n (Lam fc' rigb info' tyv) scopev,
-                          gnf env (Bind fc n (Pi fc' rigb info' tyv) !(getTerm scopet)))
+                          !(nf env (Bind fc n (Pi fc' rigb info' tyv) scopetTm)))
               _ => inferLambda rig elabinfo nest env fc rigl info n argTy scope (Just expty_in)
 
 weakenExp : {x, vars : _} ->
-            Env Term (x :: vars) ->
-            Maybe (Glued vars) -> Core (Maybe (Glued (x :: vars)))
+            {auto c : Ref Ctxt Defs} ->
+            Env Term (vars :< x) ->
+            Maybe (Glued vars) -> Core (Maybe (Glued (Scope.bind vars x)))
 weakenExp env Nothing = pure Nothing
-weakenExp env (Just gtm)
-    = do tm <- getTerm gtm
-         pure (Just (gnf env (weaken tm)))
+weakenExp env@(env' :< _) (Just gtm)
+    = do tm <- quote env' gtm
+         pure (Just !(nf env (weaken tm)))
 
 export
 checkLet : {vars : _} ->
@@ -227,30 +231,30 @@ checkLet rigc_in elabinfo nest env fc lhsFC rigl n nTy nVal scope expty {vars}
          (valv, valt, rigb) <- handle
               (do c <- runDelays (==CaseBlock) $ check (rigl |*| rigc)
                              ({ preciseInf := True } elabinfo)
-                             nest env nVal (Just (gnf env tyv))
+                             nest env nVal (Just !(nf env tyv))
                   pure (fst c, snd c, rigl |*| rigc))
               (\err => case linearErr err of
                             Just r
                               => do branchOne
                                      (do c <- runDelays (==CaseBlock) $ check linear elabinfo
-                                                  nest env nVal (Just (gnf env tyv))
+                                                  nest env nVal (Just !(nf env tyv))
                                          pure (fst c, snd c, linear))
                                      (do c <- check (rigl |*| rigc)
                                                   elabinfo -- without preciseInf
-                                                  nest env nVal (Just (gnf env tyv))
+                                                  nest env nVal (Just !(nf env tyv))
                                          pure (fst c, snd c, rigMult rigl rigc))
                                      r
                             _ => do c <- check (rigl |*| rigc)
                                                elabinfo -- without preciseInf
-                                               nest env nVal (Just (gnf env tyv))
+                                               nest env nVal (Just !(nf env tyv))
                                     pure (fst c, snd c, rigl |*| rigc))
-         let env' : Env Term (n :: _) = Lam fc rigb Explicit tyv :: env
+         let env' : Env Term (_ :< n) = Env.bind env $ Lam fc rigb Explicit tyv
          let nest' = weaken (dropName n nest)
          expScope <- weakenExp env' expty
          (scopev, gscopet) <-
             inScope fc env' (\e' =>
               check {e=e'} rigc elabinfo nest' env' scope expScope)
-         scopet <- getTerm gscopet
+         scopet <- quote env' gscopet
 
          -- No need to 'checkExp' here - we've already checked scopet
          -- against the expected type when checking the scope, so just
@@ -261,7 +265,7 @@ checkLet rigc_in elabinfo nest env fc lhsFC rigl n nTy nVal scope expty {vars}
          addNameType lhsFC n env tyv
 
          pure (Bind fc n (Let fc rigb valv tyv) scopev,
-               gnf env (Bind fc n (Let fc rigb valv tyv) scopet))
+               !(nf env (Bind fc n (Let fc rigb valv tyv) scopet)))
   where
     linearErr : Error -> Maybe RigCount
     linearErr (LinearMisuse _ _ r _) = Just r
diff --git a/src/TTImp/Elab/Case.idr b/src/TTImp/Elab/Case.idr
index f4e6873b99a..c1c0dfc52b6 100644
--- a/src/TTImp/Elab/Case.idr
+++ b/src/TTImp/Elab/Case.idr
@@ -3,7 +3,11 @@ module TTImp.Elab.Case
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.Syntax
 import Idris.REPL.Opts
@@ -25,35 +29,12 @@ import Libraries.Data.WithDefault
 
 %default covering
 
-export
-changeVar : (old : Var vs) -> (new : Var vs) -> Term vs -> Term vs
-changeVar old (MkVar new) (Local fc r idx p)
-    = if old == MkVar p
-         then Local fc r _ new
-         else Local fc r _ p
-changeVar old new (Meta fc nm i args)
-    = Meta fc nm i (map (changeVar old new) args)
-changeVar (MkVar old) (MkVar new) (Bind fc x b sc)
-    = Bind fc x (assert_total (map (changeVar (MkVar old) (MkVar new)) b))
-           (changeVar (MkVar (Later old)) (MkVar (Later new)) sc)
-changeVar old new (App fc fn arg)
-    = App fc (changeVar old new fn) (changeVar old new arg)
-changeVar old new (As fc s nm p)
-    = As fc s (changeVar old new nm) (changeVar old new p)
-changeVar old new (TDelayed fc r p)
-    = TDelayed fc r (changeVar old new p)
-changeVar old new (TDelay fc r t p)
-    = TDelay fc r (changeVar old new t) (changeVar old new p)
-changeVar old new (TForce fc r p)
-    = TForce fc r (changeVar old new p)
-changeVar old new tm = tm
-
 toRig1 : {idx : Nat} -> (0 p : IsVar nm idx vs) -> Env Term vs -> Env Term vs
-toRig1 First (b :: bs)
+toRig1 First (bs :< b)
     = if isErased (multiplicity b)
-         then setMultiplicity b linear :: bs
-         else b :: bs
-toRig1 (Later p) (b :: bs) = b :: toRig1 p bs
+         then bs :< setMultiplicity b linear
+         else bs :< b
+toRig1 (Later p) (bs :< b) = toRig1 p bs :< b
 
 allow : Maybe (Var vs) -> Env Term vs -> Env Term vs
 allow Nothing env = env
@@ -68,43 +49,31 @@ updateMults vars env
   where
 
   go : {0 vs : Scope} -> VarSet vs -> Env Term vs -> Env Term vs
-  go vars [] = []
-  go vars (b :: env)
-    = (if first `VarSet.elem` vars
+  go vars [<] = Env.empty
+  go vars (env :< b)
+    = updateMults (VarSet.dropFirst vars) env
+      :< (if first `VarSet.elem` vars
         then setMultiplicity b erased
         else b)
-    :: updateMults (VarSet.dropFirst vars) env
 
 findImpsIn : {vars : _} ->
              FC -> Env Term vars -> List (Name, Term vars) -> Term vars ->
              Core ()
 findImpsIn fc env ns (Bind _ n b@(Pi _ _ Implicit ty) sc)
-    = findImpsIn fc (b :: env)
+    = findImpsIn fc (env :< b)
                  ((n, weaken ty) :: map (\x => (fst x, weaken (snd x))) ns)
                  sc
 findImpsIn fc env ns (Bind _ n b sc)
-    = findImpsIn fc (b :: env)
+    = findImpsIn fc (env :< b)
                  (map (\x => (fst x, weaken (snd x))) ns)
                  sc
 findImpsIn fc env ns ty
     = when (not (isNil ns)) $
            throw (TryWithImplicits fc env (reverse ns))
 
--- Extend the list of variables we need in the environment so far, removing
--- duplicates
-extendNeeded : {vs : _} ->
-               Binder (Term vs) ->
-               Env Term vs -> VarSet vs -> VarSet vs
-extendNeeded (Let _ _ ty val) env needed
-    = VarSet.union (findUsedLocs env ty) (VarSet.union (findUsedLocs env val) needed)
-extendNeeded (PLet _ _ ty val) env needed
-    = VarSet.union (findUsedLocs env ty) (VarSet.union (findUsedLocs env val) needed)
-extendNeeded b env needed
-    = VarSet.union (findUsedLocs env (binderType b)) needed
-
 findScrutinee : {vs : _} ->
                 Env Term vs -> RawImp -> Maybe (Var vs)
-findScrutinee {vs = n' :: _} (b :: bs) (IVar loc' n)
+findScrutinee {vs = _ :< n'} (bs :< b) (IVar loc' n)
     = if n' == n && not (isLet b)
          then Just first
          else do MkVar p <- findScrutinee bs (IVar loc' n)
@@ -184,7 +153,7 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
          let splitOn = findScrutinee env scr
 
          caseretty_in <- case expected of
-                           Just ty => getTerm ty
+                           Just ty => quote env ty
                            _ =>
                               do nmty <- genName "caseTy"
                                  u <- uniVar fc
@@ -198,10 +167,6 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
                             (maybe (Bind fc scrn (Pi fc caseRig Explicit scrty)
                                        (weaken caseretty))
                                    (const caseretty) splitOn)
-         -- If we can normalise the type without the result being excessively
-         -- big do it. It's the depth of stuck applications - 10 is already
-         -- pretty much unreadable!
-         casefnty <- normaliseSizeLimit defs 10 Env.empty casefnty
          (erasedargs, _) <- findErased casefnty
 
          logEnv "elab.case" 10 "Case env" env
@@ -231,7 +196,10 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
 
          let applyEnv = applyToFull fc caseRef env
          let appTm : Term vars
-                   = maybe (App fc applyEnv scrtm)
+                   = maybe (Bind fc (MN "sc" 0)
+                                 (Let fc caseRig scrtm scrty)
+                                 (App fc (weaken applyEnv) caseRig
+                                         (Local fc Nothing _ First)))
                            (const applyEnv)
                            splitOn
 
@@ -242,7 +210,7 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
 
          -- Start with empty nested names, since we've extended the rhs with
          -- ICaseLocal so they'll get rebuilt with the right environment
-         let nest' = MkNested []
+         let nest' = NestedNames.empty
          ust <- get UST
          -- We don't want to keep rechecking delayed elaborators in the
          -- case block, because they're not going to make progress until
@@ -251,28 +219,25 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
          put UST ({ delayedElab := [] } ust)
          processDecl [InCase] nest' Env.empty (IDef fc casen alts')
 
-         -- If there's no duplication of the scrutinee in the block,
-         -- flag it as inlinable.
-         -- This will be the case either if the scrutinee is a variable, in
-         -- which case the duplication won't hurt, or if there's no variable
-         -- duplicated in the body (what ghc calls W-safe)
-         -- We'll check that second condition later, after generating the
-         -- runtime (erased) case trees
-         let inlineOK = maybe False (const True) splitOn
-         when inlineOK $ setFlag fc casen Inline
+         -- Set the case block to always reduce, so we get the core 'Case'
+         updateDef casen
+            (\d => case d of
+                        Function fi ct rt cs =>
+                          Just (Function ({ alwaysReduce := True } fi) ct rt cs)
+                        _ => Nothing)
 
          ust <- get UST
          put UST ({ delayedElab := olddelayed } ust)
 
-         pure (appTm, gnf env caseretty)
+         pure (appTm, !(nf env caseretty))
   where
     mkLocalEnv : Env Term vs -> Env Term vs
-    mkLocalEnv [] = Env.empty
-    mkLocalEnv (b :: bs)
+    mkLocalEnv [<] = Env.empty
+    mkLocalEnv (bs :< b)
         = let b' = if isLinear (multiplicity b)
                       then setMultiplicity b erased
                       else b in
-              b' :: mkLocalEnv bs
+              mkLocalEnv bs :< b'
 
     -- Return the original name in the environment, and what it needs to be
     -- called in the case block. We need to mapping to build the ICaseLocal
@@ -288,8 +253,8 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
     -- the LHS of the case to be applied to.
     addEnv : {vs : _} ->
              Int -> Env Term vs -> List Name -> (List (Name, Name), List RawImp)
-    addEnv idx [] used = ([], [])
-    addEnv idx {vs = v :: vs} (b :: bs) used
+    addEnv idx [<] used = ([], [])
+    addEnv idx {vs = vs :< v} (bs :< b) used
         = let n = getBindName idx v used
               (ns, rest) = addEnv (idx + 1) bs (snd n :: used)
               ns' = n :: ns in
@@ -328,7 +293,7 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
     -- the constructors are applied to the environment in the case block)
     nestLHS : FC -> (Name, (Maybe Name, List (Var vars), a)) -> (Name, RawImp)
     nestLHS fc (n, (mn, ns, t))
-        = (n, apply (IVar fc (fromMaybe n mn))
+        = (n, TTImp.TTImp.apply (IVar fc (fromMaybe n mn))
                     (map (const (Implicit fc False)) ns))
 
     applyNested : NestedNames vars -> RawImp -> RawImp
@@ -358,7 +323,6 @@ caseBlock {vars} rigc elabinfo fc nest env opts scr scrtm scrty caseRig alts exp
               lhs' = apply (IVar loc' casen) args' in
               ImpossibleClause loc' (applyNested nest lhs')
 
-
 export
 checkCase : {vars : _} ->
             {auto c : Ref Ctxt Defs} ->
@@ -388,49 +352,49 @@ checkCase rig elabinfo nest env fc opts scr scrty_in alts exp
            log "elab.case" 5 $ "Checking " ++ show scr ++ " at " ++ show chrig
 
            (scrtm_in, gscrty, caseRig) <- handle
-              (do c <- runDelays (const True) $ check chrig elabinfo nest env scr (Just (gnf env scrtyv))
+              (do c <- runDelays (const True) $ check chrig elabinfo nest env scr (Just !(nf env scrtyv))
                   pure (fst c, snd c, chrig))
             $ \case
                 e@(LinearMisuse _ _ r _)
                   => branchOne
                      (do c <- runDelays (const True) $ check linear elabinfo nest env scr
-                              (Just (gnf env scrtyv))
+                              (Just !(nf env scrtyv))
                          pure (fst c, snd c, linear))
                      (throw e)
                      r
                 e => throw e
 
-           scrty <- getTerm gscrty
+           scrty <- quote env gscrty
            logTermNF "elab.case" 5 "Scrutinee type" env scrty
            defs <- get Ctxt
-           checkConcrete !(nf defs env scrty)
+           checkConcrete !(expand !(nf env scrty))
            caseBlock rig elabinfo fc nest env opts scr scrtm_in scrty caseRig alts exp
   where
     -- For the moment, throw an error if we haven't been able to work out
     -- the type of the case scrutinee, because we'll need it to build the
     -- type of the case block. But (TODO) consider delaying on failure?
     checkConcrete : NF vs -> Core ()
-    checkConcrete (NApp _ (NMeta n i _) _)
+    checkConcrete (VMeta{})
         = throw (GenericMsg fc "Can't infer type for case scrutinee")
     checkConcrete _ = pure ()
 
     applyTo : Defs -> RawImp -> ClosedNF -> Core RawImp
-    applyTo defs ty (NBind fc _ (Pi _ _ Explicit _) sc)
+    applyTo defs ty (VBind fc _ (Pi _ _ Explicit _) sc)
         = applyTo defs (IApp fc ty (Implicit fc False))
-               !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
-    applyTo defs ty (NBind _ x (Pi {}) sc)
+               !(expand !(sc (pure (VErased fc Placeholder))))
+    applyTo defs ty (VBind _ x (Pi {}) sc)
         = applyTo defs (INamedApp fc ty x (Implicit fc False))
-               !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
+               !(expand !(sc (pure (VErased fc Placeholder))))
     applyTo defs ty _ = pure ty
 
     -- Get the name and type of the family the scrutinee is in
     getRetTy : Defs -> ClosedNF -> Core (Maybe (Name, ClosedNF))
-    getRetTy defs (NBind fc _ (Pi {}) sc)
-        = getRetTy defs !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
-    getRetTy defs (NTCon _ n arity _)
+    getRetTy defs (VBind fc _ (Pi {}) sc)
+        = getRetTy defs !(expand !(sc (pure (VErased fc Placeholder))))
+    getRetTy defs (VTCon _ n arity _)
         = do Just ty <- lookupTyExact n (gamma defs)
                   | Nothing => pure Nothing
-             pure (Just (n, !(nf defs Env.empty ty)))
+             pure (Just (n, !(expand !(nf Env.empty ty))))
     getRetTy _ _ = pure Nothing
 
     -- Guess a scrutinee type by looking at the alternatives, so that we
@@ -443,7 +407,7 @@ checkCase rig elabinfo nest env fc opts scr scrty_in alts exp
                   do defs <- get Ctxt
                      [(_, (_, ty))] <- lookupTyName (mapNestedName nest n) (gamma defs)
                          | _ => guessScrType xs
-                     Just (tyn, tyty) <- getRetTy defs !(nf defs Env.empty ty)
+                     Just (tyn, tyty) <- getRetTy defs !(expand !(nf Env.empty ty))
                          | _ => guessScrType xs
                      applyTo defs (IVar fc tyn) tyty
                _ => guessScrType xs
diff --git a/src/TTImp/Elab/Check.idr b/src/TTImp/Elab/Check.idr
index 186632e3f4e..6febdaf8f8e 100644
--- a/src/TTImp/Elab/Check.idr
+++ b/src/TTImp/Elab/Check.idr
@@ -6,7 +6,9 @@ module TTImp.Elab.Check
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -18,9 +20,7 @@ import Libraries.Data.IntMap
 import Libraries.Data.NameMap
 import Libraries.Data.UserNameMap
 import Libraries.Data.WithDefault
-
-import Libraries.Data.List.SizeOf
-
+import Libraries.Data.SnocList.SizeOf
 import Libraries.Data.VarSet
 
 %default covering
@@ -74,6 +74,14 @@ Show (ImplBinding vars) where
   show (NameBinding _ c p tm ty) = show (tm, ty)
   show (AsBinding c p tm ty pat) = show (tm, ty) ++ "@" ++ show tm
 
+export
+HasNames (ImplBinding vars) where
+  full gam (NameBinding fc c p tm ty) = pure (NameBinding fc c p !(full gam tm) !(full gam ty))
+  full gam (AsBinding c p tm ty pat) = pure (AsBinding c p tm !(full gam ty) !(full gam pat))
+
+  resolved gam (NameBinding fc c p tm ty) = pure (NameBinding fc c p !(resolved gam tm) !(resolved gam ty))
+  resolved gam (AsBinding c p tm ty pat) = pure (AsBinding c p tm !(resolved gam ty) !(resolved gam pat))
+
 export
 bindingMetas : ImplBinding vars -> NameMap Bool
 bindingMetas (NameBinding _ c p tm ty) = getMetas ty
@@ -186,7 +194,7 @@ saveHole n = update EST { saveHoles $= insert n () }
 
 weakenedEState : {n, vars : _} ->
                  {auto e : Ref EST (EState vars)} ->
-                 Core (Ref EST (EState (n :: vars)))
+                 Core (Ref EST (EState (vars :< n)))
 weakenedEState {e}
     = do est <- get EST
          eref <- newRef EST $
@@ -199,7 +207,7 @@ weakenedEState {e}
          pure eref
   where
     wknTms : (Name, ImplBinding vs) ->
-             (Name, ImplBinding (n :: vs))
+             (Name, ImplBinding (vs :< n))
     wknTms (f, NameBinding fc c p x y)
         = (f, NameBinding fc c (map weaken p) (weaken x) (weaken y))
     wknTms (f, AsBinding c p x y z)
@@ -207,15 +215,14 @@ weakenedEState {e}
 
 strengthenedEState : {n, vars : _} ->
                      Ref Ctxt Defs ->
-                     Ref EST (EState (n :: vars)) ->
-                     FC -> Env Term (n :: vars) ->
+                     Ref EST (EState (Scope.bind vars n)) ->
+                     FC -> Env Term (Scope.bind vars n) ->
                      Core (EState vars)
 strengthenedEState {n} {vars} c e fc env
     = do est <- get EST
-         defs <- get Ctxt
          svs <- dropSub (subEnv est)
-         bns <- traverse (strTms defs) (boundNames est)
-         todo <- traverse (strTms defs) (toBind est)
+         bns <- traverse (strTms) (boundNames est)
+         todo <- traverse (strTms) (toBind est)
          pure $ { subEnv := svs
                 , boundNames := bns
                 , toBind := todo
@@ -224,7 +231,7 @@ strengthenedEState {n} {vars} c e fc env
                 } est
 
   where
-    dropSub : Thin xs (y :: ys) -> Core (Thin xs ys)
+    dropSub : Thin xs (ys :< y) -> Core (Thin xs ys)
     dropSub (Drop sub) = pure sub
     dropSub _ = throw (InternalError "Badly formed weakened environment")
 
@@ -235,41 +242,42 @@ strengthenedEState {n} {vars} c e fc env
     -- never actualy *use* that hole - this process is only to ensure that the
     -- unbound implicit doesn't depend on any variables it doesn't have
     -- in scope.
-    removeArgVars : List (Term (n :: vs)) -> Maybe (List (Term vs))
-    removeArgVars [] = pure []
-    removeArgVars (Local fc r (S k) p :: args)
+    removeArgVars : SnocList (RigCount, Term (Scope.bind vs n)) ->
+                    Maybe (SnocList (RigCount, Term vs))
+    removeArgVars [<] = pure [<]
+    removeArgVars (args :< (c, Local fc r (S k) p))
         = do args' <- removeArgVars args
-             pure (Local fc r _ (dropLater p) :: args')
-    removeArgVars (Local fc r Z p :: args)
+             pure (args' :< (c, Local fc r _ (dropLater p)))
+    removeArgVars (args :< (_, Local fc r Z p))
         = removeArgVars args
-    removeArgVars (a :: args)
+    removeArgVars (args :< (c, a))
         = do a' <- shrink a (Drop Refl)
              args' <- removeArgVars args
-             pure (a' :: args')
+             pure (args' :< (c, a'))
 
-    removeArg : Term (n :: vs) -> Maybe (Term vs)
+    removeArg : Term (vs :< n) -> Maybe (Term vs)
     removeArg tm
-        = case getFnArgs tm of
+        = case getFnArgsSpine tm of
                (f, args) =>
                    do args' <- removeArgVars args
                       f' <- shrink f (Drop Refl)
-                      pure (apply (getLoc f) f' args')
+                      pure (applySpine (getLoc f) f' args')
 
-    strTms : Defs -> (Name, ImplBinding (n :: vars)) ->
+    strTms : (Name, ImplBinding (Scope.bind vars n)) ->
              Core (Name, ImplBinding vars)
-    strTms defs (f, NameBinding fc c p x y)
-        = do xnf <- normaliseHoles defs env x
-             ynf <- normaliseHoles defs env y
+    strTms (f, NameBinding fc c p x y)
+        = do xnf <- normaliseHoles env x
+             ynf <- normaliseHoles env y
              case (shrinkPi p (Drop Refl),
                    removeArg xnf,
                    shrink ynf (Drop Refl)) of
                (Just p', Just x', Just y') =>
                     pure (f, NameBinding fc c p' x' y')
                _ => throw (BadUnboundImplicit fc env f y)
-    strTms defs (f, AsBinding c p x y z)
-        = do xnf <- normaliseHoles defs env x
-             ynf <- normaliseHoles defs env y
-             znf <- normaliseHoles defs env z
+    strTms (f, AsBinding c p x y z)
+        = do xnf <- normaliseHoles env x
+             ynf <- normaliseHoles env y
+             znf <- normaliseHoles env z
              case (shrinkPi p (Drop Refl),
                    shrink xnf (Drop Refl),
                    shrink ynf (Drop Refl),
@@ -282,8 +290,8 @@ export
 inScope : {n, vars : _} ->
           {auto c : Ref Ctxt Defs} ->
           {auto e : Ref EST (EState vars)} ->
-          FC -> Env Term (n :: vars) ->
-          (Ref EST (EState (n :: vars)) -> Core a) ->
+          FC -> Env Term (Scope.bind vars n) ->
+          (Ref EST (EState (Scope.bind vars n)) -> Core a) ->
           Core a
 inScope {c} {e} fc env elab
     = do e' <- weakenedEState
@@ -302,15 +310,16 @@ mustBePoly fc env tm ty = update EST { polyMetavars $= ((fc, env, tm, ty) :: ) }
 -- type. If we know this, we can possibly infer some argument types before
 -- elaborating them, which might help us disambiguate things more easily.
 export
-concrete : Defs -> Env Term vars -> NF vars -> Core Bool
-concrete defs env (NBind fc _ (Pi {}) sc)
-    = do sc' <- sc defs (toClosure defaultOpts env (Erased fc Placeholder))
-         concrete defs env sc'
-concrete defs env (NDCon {}) = pure True
-concrete defs env (NTCon {}) = pure True
-concrete defs env (NPrimVal {}) = pure True
-concrete defs env (NType {}) = pure True
-concrete defs env _ = pure False
+concrete : {vars: _} -> {auto c : Ref Ctxt Defs} ->
+           Env Term vars -> NF vars -> Core Bool
+concrete env (VBind fc _ (Pi {}) sc)
+    = do sc' <- sc (pure (VErased fc Placeholder))
+         concrete env !(expand sc')
+concrete env (VDCon {}) = pure True
+concrete env (VTCon {}) = pure True
+concrete env (VPrimVal {}) = pure True
+concrete env (VType {}) = pure True
+concrete env _ = pure False
 
 export
 updateEnv : {new : _} ->
@@ -383,12 +392,7 @@ metaVarI : {vars : _} ->
            Env Term vars -> Name -> Term vars -> Core (Int, Term vars)
 metaVarI fc rig env n ty
     = do defs <- get Ctxt
-         tynf <- nf defs env ty
-         let hinf = case tynf of
-                         NApp _ (NMeta {}) _ =>
-                              { precisetype := True } (holeInit False)
-                         _ => holeInit False
-         newMeta fc rig env n ty (Hole (length env) hinf) True
+         newMeta fc rig env n ty (Hole (length env) (holeInit False)) True
 
 export
 argVar : {vars : _} ->
@@ -444,7 +448,7 @@ searchVar fc rig depth def env nest n ty
                                          else find x xs
 
     envHints : List Name -> Env Term vars ->
-               Core (vars' ** (Term (vars' ++ vars) -> Term vars, Env Term (vars' ++ vars)))
+               Core (vars' ** (Term (Scope.addInner vars vars') -> Term vars, Env Term (Scope.addInner vars vars')))
     envHints [] env = pure (Scope.empty ** (id, env))
     envHints (n :: ns) env
         = do (vs ** (f, env')) <- envHints ns env
@@ -460,9 +464,9 @@ searchVar fc rig depth def env nest n ty
              let binder = Let fc top (weakenNs (mkSizeOf vs) app)
                                      (weakenNs (mkSizeOf vs) tyenv)
              varn <- toFullNames n'
-             pure ((varn :: vs) **
+             pure ((Scope.bind vs varn) **
                     (\t => f (Bind fc varn binder t),
-                       binder :: env'))
+                       Env.bind env' binder))
 
 -- Elaboration info (passed to recursive calls)
 public export
@@ -732,30 +736,24 @@ convertWithLazy withLazy fc elabinfo env x y
                        _ => inTerm in
           catch
             (do let lazy = !isLazyActive && withLazy
-                logGlueNF "elab.unify" 5 ("Unifying " ++ show withLazy ++ " "
+                logNF "elab.unify" 5 ("Unifying " ++ show lazy ++ " "
                              ++ show (elabMode elabinfo)) env x
-                logGlueNF "elab.unify" 5 "....with" env y
-                vs <- if isFromTerm x && isFromTerm y
-                         then do xtm <- getTerm x
-                                 ytm <- getTerm y
-                                 if lazy
-                                    then unifyWithLazy umode fc env xtm ytm
-                                    else unify umode fc env xtm ytm
-                         else do xnf <- getNF x
-                                 ynf <- getNF y
-                                 if lazy
-                                    then unifyWithLazy umode fc env xnf ynf
-                                    else unify umode fc env xnf ynf
+                logNF "elab.unify" 5 "....with" env y
+                logEnv "elab.unify" 5 "convertWithLazy in Env" env
+                vs <- if lazy
+                         then logDepth $ unifyWithLazy umode fc env x y
+                         else logDepth $ unify umode fc env x y
+                logC "elab.unify" 5 $ pure "....result: \{show vs}"
                 when (holesSolved vs) $
                     solveConstraints umode Normal
                 pure vs)
             (\err =>
-               do xtm <- getTerm x
-                  ytm <- getTerm y
-                  -- See if we can improve the error message by
+               do -- See if we can improve the error message by
                   -- resolving any more constraints
                   catch (solveConstraints umode Normal)
                         (\err => pure ())
+                  xtm <- logQuiet $ quote env x
+                  ytm <- logQuiet $ quote env y
                   -- We need to normalise the known holes before
                   -- throwing because they may no longer be known
                   -- by the time we look at the error
@@ -785,26 +783,25 @@ checkExp : {vars : _} ->
            Core (Term vars, Glued vars)
 checkExp rig elabinfo env fc tm got (Just exp)
     = do vs <- convertWithLazy True fc elabinfo env got exp
+         logC "elab" 10 $ pure "checkExp vs: \{show vs}"
          case (constraints vs) of
               [] => case addLazy vs of
                          NoLazy => do logTerm "elab" 5 "Solved" tm
                                       pure (tm, got)
                          AddForce r => do logTerm "elab" 5 "Force" tm
-                                          logGlue "elab" 5 "Got" got
-                                          logGlue "elab" 5 "Exp" exp
+                                          logNF "elab" 5 "Got" env got
+                                          logNF "elab" 5 "Exp" env exp
                                           pure (TForce fc r tm, exp)
-                         AddDelay r => do ty <- getTerm got
+                         AddDelay r => do ty <- quote env got
                                           logTerm "elab" 5 "Delay" tm
                                           pure (TDelay fc r ty tm, exp)
               cs => do logTerm "elab" 5 "Not solved" tm
-                       defs <- get Ctxt
-                       empty <- clearDefs defs
-                       cty <- getTerm exp
+                       cty <- logQuiet $ quote env exp
                        ctm <- newConstant fc rig env tm cty cs
                        dumpConstraints "elab" 5 False
                        case addLazy vs of
                             NoLazy => pure (ctm, got)
                             AddForce r => pure (TForce fc r tm, exp)
-                            AddDelay r => do ty <- getTerm got
+                            AddDelay r => do ty <- quote env got
                                              pure (TDelay fc r ty tm, exp)
 checkExp rig elabinfo env fc tm got Nothing = pure (tm, got)
diff --git a/src/TTImp/Elab/Delayed.idr b/src/TTImp/Elab/Delayed.idr
index 0e33395bf96..df3ff23e97d 100644
--- a/src/TTImp/Elab/Delayed.idr
+++ b/src/TTImp/Elab/Delayed.idr
@@ -1,15 +1,18 @@
 module TTImp.Elab.Delayed
 
-import Core.Case.CaseTree
 import Core.Context.Log
 import Core.Env
 import Core.Metadata
-import Core.Normalise
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import TTImp.Elab.Check
 
+import Data.SnocList
+
 import Libraries.Data.IntMap
 import Libraries.Data.NameMap
 
@@ -21,10 +24,10 @@ mkClosedElab : {vars : _} ->
                FC -> Env Term vars ->
                (Core (Term vars, Glued vars)) ->
                Core ClosedTerm
-mkClosedElab fc [] elab
+mkClosedElab fc [<] elab
     = do (tm, _) <- elab
          pure tm
-mkClosedElab {vars = x :: vars} fc (b :: env) elab
+mkClosedElab {vars = vars :< x} fc (env :< b) elab
     = mkClosedElab fc env
           (do (sc', _) <- elab
               let b' = newBinder b
@@ -73,10 +76,10 @@ delayOnFailure fc rig env exp pred pri elab
                  if pred err
                     then
                       do nm <- genName "delayed"
-                         (ci, dtm) <- newDelayed fc linear env nm !(getTerm expected)
-                         logGlueNF "elab.delay" 5 ("Postponing elaborator " ++ show nm ++
-                                      " at " ++ show fc ++
-                                      " for") env expected
+                         (ci, dtm) <- newDelayed fc linear env nm !(quote env expected)
+                         logNF "elab.delay" 5 ("Postponing elaborator " ++ show nm ++
+                                       " at " ++ show fc ++
+                                       " for") env expected
                          log "elab.delay" 10 ("Due to error " ++ show err)
                          defs <- get Ctxt
                          update UST { delayedElab $=
@@ -99,7 +102,7 @@ delayOnFailure fc rig env exp pred pri elab
         = do nm <- genName "delayTy"
              u <- uniVar fc
              ty <- metaVar fc erased env nm (TType fc u)
-             pure (gnf env ty)
+             nf env ty
 
 export
 delayElab : {vars : _} ->
@@ -117,9 +120,8 @@ delayElab {vars} fc rig env exp pri elab
          let nos = noSolve ust -- remember the holes we shouldn't solve
          nm <- genName "delayed"
          expected <- mkExpected exp
-         (ci, dtm) <- newDelayed fc linear env nm !(getTerm expected)
-         logGlueNF "elab.delay" 5 ("Postponing elaborator " ++ show nm ++
-                      " for") env expected
+         (ci, dtm) <- newDelayed fc linear env nm !(quote env expected)
+         logNF "elab.delay" 5 ("Postponing elaborator " ++ show nm ++ " for") env expected
          defs <- get Ctxt
          update UST { delayedElab $=
                  ((pri, ci, localHints defs, mkClosedElab fc env
@@ -138,7 +140,7 @@ delayElab {vars} fc rig env exp pri elab
         = do nm <- genName "delayTy"
              u <- uniVar fc
              ty <- metaVar fc erased env nm (TType fc u)
-             pure (gnf env ty)
+             nf env ty
 
 export
 ambiguous : Error -> Bool
@@ -152,46 +154,54 @@ ambiguous (InRHS _ _ err) = ambiguous err
 ambiguous (WhenUnifying _ _ _ _ _ err) = ambiguous err
 ambiguous _ = False
 
+zipArgs : {vars: _} -> {auto c : Ref Ctxt Defs} ->
+          Spine vars -> Spine vars -> Core (List (NF vars, NF vars))
+zipArgs [<] _ = pure []
+zipArgs _ [<] = pure []
+zipArgs (as :< a) (bs :< b)
+   = do sp <- zipArgs as bs
+        pure $ (!(spineVal a), !(spineVal b)) :: sp
+
 mutual
   mismatchNF : {auto c : Ref Ctxt Defs} ->
                {vars : _} ->
-               Defs -> NF vars -> NF vars -> Core Bool
-  mismatchNF defs (NTCon _ xn _ xargs) (NTCon _ yn _ yargs)
+               NF vars -> NF vars -> Core Bool
+  mismatchNF (VTCon _ xn _ xargs) (VTCon _ yn _ yargs)
       = if xn /= yn
            then pure True
-           else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-  mismatchNF defs (NDCon _ _ xt _ xargs) (NDCon _ _ yt _ yargs)
+           else anyM mismatch !(zipArgs xargs yargs)
+  mismatchNF (VDCon _ _ xt _ xargs) (VDCon _ _ yt _ yargs)
       = if xt /= yt
            then pure True
-           else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-  mismatchNF defs (NPrimVal _ xc) (NPrimVal _ yc) = pure (xc /= yc)
-  mismatchNF defs (NDelayed _ _ x) (NDelayed _ _ y) = mismatchNF defs x y
-  mismatchNF defs (NDelay _ _ _ x) (NDelay _ _ _ y)
-      = mismatchNF defs !(evalClosure defs x) !(evalClosure defs y)
-  mismatchNF _ _ _ = pure False
+           else anyM mismatch !(zipArgs xargs yargs)
+  mismatchNF (VPrimVal _ xc) (VPrimVal _ yc) = pure (xc /= yc)
+  mismatchNF (VDelayed _ _ x) (VDelayed _ _ y)
+      = mismatchNF !(expand x) !(expand y)
+  mismatchNF (VDelay _ _ _ x) (VDelay _ _ _ y)
+      = mismatchNF !(expand x) !(expand y)
+  mismatchNF _ _ = pure False
 
   mismatch : {auto c : Ref Ctxt Defs} ->
              {vars : _} ->
-             Defs -> (Closure vars, Closure vars) -> Core Bool
-  mismatch defs (x, y)
-      = mismatchNF defs !(evalClosure defs x) !(evalClosure defs y)
+             (NF vars, NF vars) -> Core Bool
+  mismatch (x, y) = mismatchNF x y
 
 contra : {auto c : Ref Ctxt Defs} ->
          {vars : _} ->
-         Defs -> NF vars -> NF vars -> Core Bool
+         NF vars -> NF vars -> Core Bool
 -- Unlike 'impossibleOK', any mismatch indicates an unrecoverable error
-contra defs (NTCon _ xn xa xargs) (NTCon _ yn ya yargs)
+contra (VTCon _ xn xa xargs) (VTCon _ yn ya yargs)
     = if xn /= yn
          then pure True
-         else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-contra defs (NDCon _ _ xt _ xargs) (NDCon _ _ yt _ yargs)
+         else anyM mismatch !(zipArgs xargs yargs)
+contra (VDCon _ _ xt _ xargs) (VDCon _ _ yt _ yargs)
     = if xt /= yt
          then pure True
-         else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-contra defs (NPrimVal _ x) (NPrimVal _ y) = pure (x /= y)
-contra defs (NDCon {}) (NPrimVal {}) = pure True
-contra defs (NPrimVal {}) (NDCon {}) = pure True
-contra defs x y = pure False
+         else anyM mismatch !(zipArgs xargs yargs)
+contra (VPrimVal _ x) (VPrimVal _ y) = pure (x /= y)
+contra (VDCon {}) (VPrimVal {}) = pure True
+contra (VPrimVal {}) (VDCon {}) = pure True
+contra x y = pure False
 
 -- Errors that might be recoverable later if we try again. Generally -
 -- ambiguity errors, type inference errors
@@ -200,12 +210,18 @@ recoverable : {auto c : Ref Ctxt Defs} ->
               Error -> Core Bool
 recoverable (CantConvert _ gam env l r)
    = do defs <- get Ctxt
-        let defs = { gamma := gam } defs
-        pure $ not !(contra defs !(nf defs env l) !(nf defs env r))
+        let defs_from_err = { gamma := gam } defs
+        put Ctxt defs_from_err
+        let res = not !(contra !(expand !(nf env l)) !(expand !(nf env r)))
+        put Ctxt defs
+        pure res
 recoverable (CantSolveEq _ gam env l r)
    = do defs <- get Ctxt
-        let defs = { gamma := gam } defs
-        pure $ not !(contra defs !(nf defs env l) !(nf defs env r))
+        let defs_from_err = { gamma := gam } defs
+        put Ctxt defs_from_err
+        let res = not !(contra !(expand !(nf env l)) !(expand !(nf env r)))
+        put Ctxt defs
+        pure res
 recoverable (UndefinedName {}) = pure False
 recoverable (LinearMisuse {}) = pure False
 recoverable (InType _ _ err) = recoverable err
@@ -253,8 +269,7 @@ retryDelayed' errmode p acc (d@(_, i, hints, elab) :: ds)
                let ds' = reverse (delayedElab ust) ++ ds
 
                updateDef (Resolved i) (const (Just
-                    (PMDef (MkPMDefInfo NotHole True False)
-                           Scope.empty (STerm 0 tm) (STerm 0 tm) [])))
+                    (Function (MkPMDefInfo NotHole True False) tm tm Nothing)))
                logTerm "elab.update" 5 ("Resolved delayed hole " ++ show i) tm
                logTermNF "elab.update" 5 ("Resolved delayed hole NF " ++ show i) Env.empty tm
                removeHole i
diff --git a/src/TTImp/Elab/Dot.idr b/src/TTImp/Elab/Dot.idr
index 2ef0f44300f..8c8d2bb2320 100644
--- a/src/TTImp/Elab/Dot.idr
+++ b/src/TTImp/Elab/Dot.idr
@@ -3,6 +3,8 @@ module TTImp.Elab.Dot
 import Core.Env
 import Core.Metadata
 import Core.UnifyState
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -22,7 +24,7 @@ registerDot : {vars : _} ->
               Core (Term vars, Glued vars)
 registerDot rig env fc reason wantedTm gexpty
     = do nm <- genName "dotTm"
-         expty <- getTerm gexpty
+         expty <- quote env gexpty
          metaval <- metaVar fc rig env nm expty
          addDot fc env nm wantedTm reason metaval
          let tm = case reason of
diff --git a/src/TTImp/Elab/Hole.idr b/src/TTImp/Elab/Hole.idr
index d3d383d091a..b0d59e11ee4 100644
--- a/src/TTImp/Elab/Hole.idr
+++ b/src/TTImp/Elab/Hole.idr
@@ -3,9 +3,11 @@ module TTImp.Elab.Hole
 import Core.Context.Log
 import Core.Env
 import Core.Metadata
-import Core.Normalise
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import TTImp.Elab.Check
 import TTImp.TTImp
@@ -17,7 +19,7 @@ import TTImp.TTImp
 -- for the hole
 mkPrecise : {auto c : Ref Ctxt Defs} ->
             NF vars -> Core ()
-mkPrecise (NApp _ (NMeta n i _) _)
+mkPrecise (VMeta _ n i _ _ _)
     = updateDef (Resolved i)
                 (\case
                     Hole i p => Just (Hole i ({ precisetype := True} p))
@@ -40,14 +42,14 @@ checkHole rig elabinfo nest env fc n_in (Just gexpty)
          Nothing <- lookupCtxtExact nm (gamma defs)
              | _ => do log "elab.hole" 1 $ show nm ++ " already defined"
                        throw (AlreadyDefined fc nm)
-         expty <- getTerm gexpty
+         expty <- quote env gexpty
          -- Turn lets into lambda before making the hole so that they
          -- get abstracted over in the hole (it's fine here, unlike other
          -- holes, because we're not trying to unify it so it's okay if
          -- applying the metavariable isn't a pattern form)
          let env' = letToLam env
          (idx, metaval) <- metaVarI fc rig env' nm expty
-         mkPrecise !(getNF gexpty)
+         mkPrecise !(expand gexpty)
          -- Record the LHS for this hole in the metadata
          withCurrentLHS (Resolved idx)
          addNameLoc fc nm
@@ -61,7 +63,7 @@ checkHole rig elabinfo nest env fc n_in exp
          ty <- metaVar fc erased env' nmty (TType fc u)
          nm <- inCurrentNS (UN n_in)
          defs <- get Ctxt
-         mkPrecise !(nf defs env' ty)
+         mkPrecise !(expand !(nf env' ty))
 
          Nothing <- lookupCtxtExact nm (gamma defs)
              | _ => do log "elab.hole" 1 $ show nm ++ " already defined"
@@ -71,4 +73,4 @@ checkHole rig elabinfo nest env fc n_in exp
          addNameLoc fc nm
          addUserHole False nm
          saveHole nm
-         pure (metaval, gnf env ty)
+         pure (metaval, !(nf env' ty))
diff --git a/src/TTImp/Elab/ImplicitBind.idr b/src/TTImp/Elab/ImplicitBind.idr
index f4a3f7bdc77..b61c6b9728b 100644
--- a/src/TTImp/Elab/ImplicitBind.idr
+++ b/src/TTImp/Elab/ImplicitBind.idr
@@ -6,7 +6,10 @@ import Core.Coverage
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -15,8 +18,11 @@ import TTImp.Elab.Check
 import TTImp.Elab.Delayed
 import TTImp.TTImp
 
+import Data.Vect
 import Libraries.Data.NameMap
 import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.HasLength
+import Libraries.Data.List.SizeOf
 
 %default covering
 
@@ -32,7 +38,7 @@ mkOuterHole : {vars : _} ->
 mkOuterHole loc rig n topenv (Just expty_in)
     = do est <- get EST
          let sub = subEnv est
-         expected <- getTerm expty_in
+         expected <- quote topenv expty_in
          case shrink expected sub of
               -- Can't shrink so rely on unification with expected type later
               Nothing => mkOuterHole loc rig n topenv Nothing
@@ -72,21 +78,21 @@ mkPatternHole {vars'} loc rig n topenv imode (Just expty_in)
     = do est <- get EST
          let sub = subEnv est
          let env = outerEnv est
-         expected <- getTerm expty_in
+         expected <- quote topenv expty_in
          case bindInner topenv expected sub of
               Nothing => mkPatternHole loc rig n topenv imode Nothing
               Just exp' =>
                   do tm <- implBindVar loc rig env n exp'
-                     pure (apply loc (thin tm sub) (mkArgs [<] sub),
+                     pure (Core.TT.Term.apply loc (thin tm sub) (mkArgs zero topenv sub),
                            expected,
                            thin exp' sub)
   where
-    mkArgs : {0 vs : _} -> SizeOf seen -> Thin newvars vs -> List (Term (seen <>> vs))
-    mkArgs p Refl = []
-    mkArgs p (Drop th) =
-      let MkVar v := mkVarChiply p in
-      Local loc Nothing _ v :: mkArgs (p :< _) th
-    mkArgs p _ = []
+    mkArgs : {0 vs : _} -> SizeOf seen -> Env Term vs -> Thin newvars vs -> List (RigCount, Term (vs <>< seen))
+    mkArgs p _ Refl = []
+    mkArgs p (env :< b) (Drop th) =
+      let MkVar v := mkVarFishily {inner=seen} p in
+      (multiplicity b, Local loc Nothing _ v) :: mkArgs (suc p) env th
+    mkArgs p _ _ = []
 
     -- This is for the specific situation where we're pattern matching on
     -- function types, which is realistically the only time we'll legitimately
@@ -95,7 +101,7 @@ mkPatternHole {vars'} loc rig n topenv imode (Just expty_in)
                 Env Term vs -> Term vs -> Thin newvars vs ->
                 Maybe (Term newvars)
     bindInner env ty Refl = Just ty
-    bindInner {vs = x :: _} (b :: env) ty (Drop p)
+    bindInner {vs = _ :< x} (env :< b) ty (Drop p)
         = bindInner env (Bind loc x b ty) p
     bindInner _ _ _ = Nothing
 
@@ -107,11 +113,8 @@ mkPatternHole loc rig n env _ _
 export
 normaliseType : {auto c : Ref Ctxt Defs} ->
                 {free : _} ->
-                Defs -> Env Term free -> Term free -> Core (Term free)
-normaliseType defs env tm
-    = catch (do tm' <- nfOpts withHoles defs env tm
-                quoteOpts (MkQuoteOpts False False (Just 5)) defs env tm')
-            (\err => normalise defs env tm)
+                Env Term free -> Term free -> Core (Term free)
+normaliseType = normaliseHoles
 
 -- For any of the 'bindIfUnsolved' - these were added as holes during
 -- elaboration, but are as yet unsolved, so create a pattern variable for
@@ -157,57 +160,82 @@ bindUnsolved {vars} fc elabmode _
                   | _ => pure ()
              bindtm <- makeBoundVar n loc rig p outerEnv
                                     sub subEnv
-                                    !(normaliseHoles defs env exp)
+                                    !(normaliseHoles env exp)
              logTerm "elab.implicits" 5 ("Added unbound implicit") bindtm
              ignore $ unify (case elabmode of
                          InLHS _ => inLHS
                          _ => inTerm)
                    fc env tm bindtm
 
-swapIsVarH : {idx : Nat} -> (0 p : IsVar nm idx (x :: y :: xs)) ->
-             Var (y :: x :: xs)
+swapIsVarH : {idx : Nat} -> (0 p : IsVar nm idx (xs :< y :< x)) ->
+             Var (xs :< x :< y)
 swapIsVarH First = MkVar (Later First)
 swapIsVarH (Later p) = swapP p -- it'd be nice to do this all at the top
                                -- level, but that will need an improvement
                                -- in erasability checking
   where
-    swapP : forall name . {idx : _} -> (0 p : IsVar name idx (y :: xs)) ->
-            Var (y :: x :: xs)
+    swapP : forall name . {idx : _} -> (0 p : IsVar name idx (xs :< y)) ->
+            Var (xs :< x :< y)
     swapP First = first
     swapP (Later x) = MkVar (Later (Later x))
 
 swapIsVar : (vs : Scope) ->
-            {idx : Nat} -> (0 p : IsVar nm idx (vs ++ x :: y :: xs)) ->
-            Var (vs ++ y :: x :: xs)
-swapIsVar [] prf = swapIsVarH prf
-swapIsVar (x :: xs) First = first
-swapIsVar (x :: xs) (Later p)
+            {idx : Nat} -> (0 p : IsVar nm idx (xs :< y :< x ++ vs)) ->
+            Var (xs :< x :< y ++ vs)
+swapIsVar [<] prf = swapIsVarH prf
+swapIsVar (xs :< x) First = first
+swapIsVar (xs :< x) (Later p)
     = let MkVar p' = swapIsVar xs p in MkVar (Later p')
 
 swapVars : {vs : Scope} ->
-           Term (vs ++ x :: y :: ys) -> Term (vs ++ y :: x :: ys)
+           Term (ys :< y :< x ++ vs) -> Term (ys :< x :< y ++ vs)
 swapVars (Local fc x idx p)
     = let MkVar p' = swapIsVar _ p in Local fc x _ p'
 swapVars (Ref fc x name) = Ref fc x name
-swapVars (Meta fc n i xs) = Meta fc n i (map swapVars xs)
+swapVars (Meta fc n i xs) = Meta fc n i (map @{Compose} swapVars xs)
 swapVars {vs} (Bind fc x b scope)
-    = Bind fc x (map swapVars b) (swapVars {vs = x :: vs} scope)
-swapVars (App fc fn arg) = App fc (swapVars fn) (swapVars arg)
+    = Bind fc x (map swapVars b) (swapVars {vs = vs :< x} scope)
+swapVars (App fc fn c arg) = App fc (swapVars fn) c (swapVars arg)
 swapVars (As fc s nm pat) = As fc s (swapVars nm) (swapVars pat)
+swapVars (Case fc ct c sc scty alts)
+    = Case fc ct c (swapVars sc) (swapVars scty) (map swapAlt alts)
+  where
+    swapForced : {vs : _} -> forall ys, x, y .
+                 (Var (ys :< y :< x ++ vs), Term (ys :< y :< x ++ vs)) ->
+                 (Var (ys :< x :< y ++ vs), Term (ys :< x :< y ++ vs))
+    swapForced (MkVar v, tm) = (swapIsVar _ v, swapVars tm)
+
+    swapScope : {vs : _} -> forall ys, x, y .
+              CaseScope (ys :< y :< x ++ vs) ->
+              CaseScope (ys :< x :< y ++ vs)
+    swapScope (RHS fs tm) = RHS (map swapForced fs) (swapVars tm)
+    swapScope {vs} (Arg c x sc) = Arg c x (swapScope {vs = vs :< x} sc)
+
+    swapAlt : {vs : _} -> forall ys, x, y .
+              CaseAlt (ys :< y :< x ++ vs) ->
+              CaseAlt (ys :< x :< y ++ vs)
+    swapAlt (ConCase fc n t sc) = ConCase fc n t (swapScope sc)
+    swapAlt {vs} (DelayCase fc t a tm)
+        = DelayCase fc t a (swapVars {vs = vs :< t :< a} tm)
+    swapAlt (ConstCase fc c tm) = ConstCase fc c (swapVars tm)
+    swapAlt (DefaultCase fc tm) = DefaultCase fc (swapVars tm)
+
 swapVars (TDelayed fc x tm) = TDelayed fc x (swapVars tm)
 swapVars (TDelay fc x ty tm) = TDelay fc x (swapVars ty) (swapVars tm)
 swapVars (TForce fc r tm) = TForce fc r (swapVars tm)
 swapVars (PrimVal fc c) = PrimVal fc c
+swapVars (PrimOp fc f args) = PrimOp fc f (map swapVars args)
 swapVars (Erased fc Impossible) = Erased fc Impossible
 swapVars (Erased fc Placeholder) = Erased fc Placeholder
 swapVars (Erased fc (Dotted t)) = Erased fc $ Dotted (swapVars t)
+swapVars (Unmatched fc s) = Unmatched fc s
 swapVars (TType fc u) = TType fc u
 
 -- Push an explicit pi binder as far into a term as it'll go. That is,
 -- move it under implicit binders that don't depend on it, and stop
 -- when hitting any non-implicit binder
 push : {vs : _} ->
-       FC -> (n : Name) -> Binder (Term vs) -> Term (n :: vs) -> Term vs
+       FC -> (n : Name) -> Binder (Term vs) -> Term (vs :< n) -> Term vs
 push ofc n b tm@(Bind fc (PV x i) (Pi fc' c Implicit ty) sc) -- only push past 'PV's
     = case shrink ty (Drop Refl) of
            Nothing => -- needs explicit pi, do nothing
@@ -254,7 +282,7 @@ bindImplVars {vars} fc mode gam env imps_in scope scty
 
     getBinds : (imps : List (Name, Name, ImplBinding vs)) ->
                Bounds new -> (tm : Term vs) -> (ty : Term vs) ->
-               (Term (new ++ vs), Term (new ++ vs))
+               (Term (Scope.addInner vs new), Term (Scope.addInner vs new))
     getBinds [] bs tm ty = (refsToLocals bs tm, refsToLocals bs ty)
     getBinds {new} ((n, metan, NameBinding loc c p _ bty) :: imps) bs tm ty
         = let (tm', ty') = getBinds imps (Add n metan bs) tm ty
@@ -273,16 +301,6 @@ bindImplVars {vars} fc mode gam env imps_in scope scty
               (Bind fc _ (PLet fc c bpat' bty') tm',
                Bind fc _ (PLet fc c bpat' bty') ty')
 
-normaliseHolesScope : {auto c : Ref Ctxt Defs} ->
-                      {vars : _} ->
-                      Defs -> Env Term vars -> Term vars -> Core (Term vars)
-normaliseHolesScope defs env (Bind fc n b sc)
-    = pure $ Bind fc n b
-                  !(normaliseHolesScope defs
-                   -- use Lam because we don't want it reducing in the scope
-                   (Lam fc (multiplicity b) Explicit (binderType b) :: env) sc)
-normaliseHolesScope defs env tm = normaliseHoles defs env tm
-
 export
 bindImplicits : {vars : _} ->
                 FC -> BindMode ->
@@ -344,19 +362,19 @@ getToBind {vars} fc elabmode impmode env excepts
     normBindingTy : Defs -> ImplBinding vars -> Core (ImplBinding vars)
     normBindingTy defs (NameBinding loc c p tm ty)
         = do case impmode of
-                  COVERAGE => do tynf <- nf defs env ty
+                  COVERAGE => do tynf <- expand !(nf env ty)
                                  when !(isEmpty defs env tynf) $
                                     throw ImpossibleCase
                   _ => pure ()
-             pure $ NameBinding loc c p tm !(normaliseType defs env ty)
+             pure $ NameBinding loc c p tm !(normaliseType env ty)
     normBindingTy defs (AsBinding c p tm ty pat)
         = do case impmode of
-                  COVERAGE => do tynf <- nf defs env ty
+                  COVERAGE => do tynf <- expand !(nf env ty)
                                  when !(isEmpty defs env tynf) $
                                     throw ImpossibleCase
                   _ => pure ()
-             pure $ AsBinding c p tm !(normaliseType defs env ty)
-                                     !(normaliseHoles defs env pat)
+             pure $ AsBinding c p tm !(normaliseType env ty)
+                                     !(normaliseHoles env pat)
 
     normImps : Defs -> List Name -> List (Name, ImplBinding vars) ->
                Core (List (Name, ImplBinding vars))
@@ -369,7 +387,7 @@ getToBind {vars} fc elabmode impmode env excepts
                 else do rest <- normImps defs (PV n i :: ns) ts
                         pure ((PV n i, !(normBindingTy defs bty)) :: rest)
     normImps defs ns ((n, bty) :: ts)
-        = do tmnf <- normaliseHoles defs env (bindingTerm bty)
+        = do tmnf <- normaliseHoles env (bindingTerm bty)
              logTerm "elab.implicits" 10 ("Normalising implicit " ++ show n) tmnf
              case getFnArgs tmnf of
                 -- n reduces to another hole, n', so treat it as that as long
@@ -457,7 +475,7 @@ checkBindVar rig elabinfo nest env fc nm topexp
                    addNameType fc nm env exp
                    addNameLoc fc nm
 
-                   checkExp rig elabinfo env fc tm (gnf env exp) topexp
+                   checkExp rig elabinfo env fc tm !(nf env exp) topexp
               Just bty =>
                 do -- Check rig is consistent with the one in bty, and
                    -- update if necessary
@@ -469,7 +487,7 @@ checkBindVar rig elabinfo nest env fc nm topexp
                    addNameType fc nm env ty
                    addNameLoc fc nm
 
-                   checkExp rig elabinfo env fc tm (gnf env ty) topexp
+                   checkExp rig elabinfo env fc tm !(nf env ty) topexp
   where
     updateRig : Name -> RigCount -> List (Name, ImplBinding vars) ->
                 List (Name, ImplBinding vars)
@@ -494,17 +512,15 @@ checkPolyConstraint :
             {auto c : Ref Ctxt Defs} ->
             PolyConstraint -> Core ()
 checkPolyConstraint (MkPolyConstraint fc env arg x y)
-    = do defs <- get Ctxt
-         -- If 'x' is a metavariable and 'y' is concrete, that means we've
+    = do -- If 'x' is a metavariable and 'y' is concrete, that means we've
          -- ended up putting something too concrete in for a polymorphic
          -- argument
-         xnf <- continueNF defs env x
+         xnf <- expand !(nf env !(quote env x))
          case xnf of
-              NApp _ (NMeta {}) _ =>
-                   do ynf <- continueNF defs env y
-                      if !(concrete defs env ynf)
-                         then do empty <- clearDefs defs
-                                 throw (MatchTooSpecific fc env arg)
+              VMeta {} _ _ _ =>
+                   do ynf <- expand !(nf env y)
+                      if !(concrete env ynf)
+                         then do throw (MatchTooSpecific fc env arg)
                          else pure ()
               _ => pure ()
 
@@ -516,9 +532,9 @@ solvePolyConstraint (MkPolyConstraint fc env arg x y)
     = do defs <- get Ctxt
          -- If the LHS of the constraint isn't a metavariable, we can solve
          -- the constraint
-         case !(continueNF defs env x) of
-              xnf@(NApp _ (NMeta {}) _) => pure ()
-              t => do res <- unify inLHS fc env t !(continueNF defs env y)
+         case !(expand !(nf env !(quote env x))) of
+              xnf@(VMeta {} _ _ _) => pure ()
+              t => do res <- unify inLHS fc env t !(nf env y)
                       -- If there's any constraints, it just means we didn't
                       -- solve anything and it won't help the check
                       pure ()
@@ -582,11 +598,12 @@ checkBindHere rig elabinfo nest env fc bindmode tm exp
                               bindmode env dontbind
          clearToBind dontbind
          update EST $ updateEnv oldenv oldsub oldbif . { boundNames := [] }
-         ty <- getTerm tmt
+         ty <- quote env tmt
+         logTerm "elab.implicits" 5 "Checked" ty
          defs <- get Ctxt
          (bv, bt) <- bindImplicits fc bindmode
                                    defs env argImps
-                                   !(normaliseHoles defs env tmv)
-                                   !(normaliseHoles defs env ty)
+                                   !(normaliseHoles env tmv)
+                                   !(normaliseHoles env ty)
          traverse_ implicitBind (map fst argImps)
-         checkExp rig elabinfo env fc bv (gnf env bt) exp
+         checkExp rig elabinfo env fc bv !(nf env bt) exp
diff --git a/src/TTImp/Elab/Lazy.idr b/src/TTImp/Elab/Lazy.idr
index ec31b1bf747..733578b07c8 100644
--- a/src/TTImp/Elab/Lazy.idr
+++ b/src/TTImp/Elab/Lazy.idr
@@ -3,7 +3,9 @@ module TTImp.Elab.Lazy
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -47,7 +49,7 @@ checkDelay rig elabinfo nest env fc tm mexpected
     = do expected <- maybe (do nm <- genName "delayTy"
                                u <- uniVar fc
                                ty <- metaVar fc erased env nm (TType fc u)
-                               pure (gnf env ty))
+                               nf env ty)
                            pure mexpected
          let solvemode = case elabMode elabinfo of
                               InLHS c => inLHS
@@ -57,15 +59,18 @@ checkDelay rig elabinfo nest env fc tm mexpected
          -- need to infer the delay reason
          delayOnFailure fc rig env (Just expected) delayError LazyDelay
             (\delayed =>
-                 case !(getNF expected) of
-                      NDelayed _ r expnf =>
+                do expected <- ifThenElse delayed
+                                 (do exp <- quote env expected
+                                     nf env exp)
+                                 (pure expected)
+                   case !(expand expected) of
+                      VDelayed _ r expnf =>
                          do defs <- get Ctxt
                             (tm', gty) <- check rig elabinfo nest env tm
-                                                (Just (glueBack defs env expnf))
-                            tynf <- getNF gty
-                            ty <- getTerm gty
+                                                (Just expnf)
+                            ty <- quote env gty
                             pure (TDelay fc r ty tm',
-                                  glueBack defs env (NDelayed fc r tynf))
+                                  VDelayed fc r gty)
                       ty => do logNF "elab.delay" 5 "Expected delay type" env ty
                                throw (GenericMsg fc ("Can't infer delay type")))
   where
@@ -87,14 +92,12 @@ checkForce : {vars : _} ->
              Core (Term vars, Glued vars)
 checkForce rig elabinfo nest env fc tm exp
     = do defs <- get Ctxt
-         expf <- maybe (pure Nothing)
-                       (\gty => do tynf <- getNF gty
-                                   pure (Just (glueBack defs env
-                                         (NDelayed fc LUnknown tynf))))
+         let expf = maybe Nothing
+                       (\gty => Just (VDelayed fc LUnknown gty))
                        exp
          (tm', gty) <- check rig elabinfo nest env tm expf
-         tynf <- getNF gty
+         tynf <- expand gty
          case tynf of
-              NDelayed _ r expnf =>
-                 pure (TForce fc r tm', glueBack defs env expnf)
+              VDelayed _ r expnf =>
+                 pure (TForce fc r tm', expnf)
               _ => throw (GenericMsg fc "Forcing a non-delayed type")
diff --git a/src/TTImp/Elab/Local.idr b/src/TTImp/Elab/Local.idr
index 93809c89234..84f2a612c5e 100644
--- a/src/TTImp/Elab/Local.idr
+++ b/src/TTImp/Elab/Local.idr
@@ -1,8 +1,10 @@
 module TTImp.Elab.Local
 
 import Core.Env
+import Core.Evaluate
 import Core.Metadata
 import Core.Unify
+import Core.Evaluate.Value
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -49,14 +51,16 @@ localHelper {vars} nest env nestdecls_in func
               else nestdeclsVis
 
          let defNames = definedInBlock emptyNS nestdeclsMult
-         names' <- traverse (applyEnv f) defNames
-         let nest' = { names $= (names' ++) } nest
+
          -- TODO is this comment still up-to-date?
          -- For the local definitions, don't allow access to linear things
          -- unless they're explicitly passed.
          -- This is because, at the moment, we don't have any mechanism of
          -- ensuring the nested definition is used exactly once
          let env' = eraseLinear env
+
+         names' <- traverse (applyEnv env' f) defNames
+         let nest' = { names $= (names' ++) } nest
          -- We don't want to keep rechecking delayed elaborators in the
          -- locals block, because they're not going to make progress until
          -- we come out again, so save them
@@ -77,15 +81,15 @@ localHelper {vars} nest env nestdecls_in func
          update Ctxt { localHints := oldhints }
          pure res
   where
-    applyEnv : Int -> Name ->
+    applyEnv : Env Term vars -> Int -> Name ->
                Core (Name, (Maybe Name, List (Var vars), FC -> NameType -> Term vars))
-    applyEnv outer inner
+    applyEnv env outer inner
           = do ust <- get UST
                put UST ({ nextName $= (+1) } ust)
                let nestedName_in = Nested (outer, nextName ust) inner
                nestedName <- inCurrentNS nestedName_in
                n' <- addName nestedName
-               pure (inner, (Just nestedName, reverse (allVars env),
+               pure (inner, (Just nestedName, VarSet.asList $ allVars env,
                         \fc, nt => applyToFull fc
                                (Ref fc nt (Resolved n')) env))
 
@@ -174,7 +178,7 @@ getLocalTerm fc env f (a :: as)
     = case defined a env of
            Just (MkIsDefined rigb lv) =>
                 do (tm, vs) <- getLocalTerm fc env
-                                   (App fc f (Local fc Nothing _ lv)) as
+                                   (App fc f rigb (Local fc Nothing _ lv)) as
                    pure (tm, MkVar lv :: vs)
            Nothing => throw (InternalError "Case Local failed")
 
diff --git a/src/TTImp/Elab/Quote.idr b/src/TTImp/Elab/Quote.idr
index bcd0d450916..edf5ed79bc4 100644
--- a/src/TTImp/Elab/Quote.idr
+++ b/src/TTImp/Elab/Quote.idr
@@ -4,6 +4,9 @@ import Core.Env
 import Core.Metadata
 import Core.Reflect
 import Core.UnifyState
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -161,10 +164,10 @@ bindUnqs ((qvar, fc, esctm) :: qs) rig elabinfo nest env tm
          Just (idx, gdef) <- lookupCtxtExactI (reflectionttimp "TTImp") (gamma defs)
               | _ => throw (UndefinedName fc (reflectionttimp "TTImp"))
          (escv, escty) <- check rig elabinfo nest env esctm
-                                (Just (gnf env (Ref fc (TyCon 0)
+                                (Just !(nf env (Ref fc (TyCon 0)
                                            (Resolved idx))))
          sc <- bindUnqs qs rig elabinfo nest env tm
-         pure (Bind fc qvar (Let fc (rigMult top rig) escv !(getTerm escty))
+         pure (Bind fc qvar (Let fc (rigMult top rig) escv !(quote env escty))
                     (refToLocal qvar qvar sc))
 
 onLHS : ElabMode -> Bool
@@ -191,8 +194,8 @@ checkQuote rig elabinfo nest env fc tm exp
          unqs <- get Unq
          qty <- getCon fc defs (reflectionttimp "TTImp")
          qtm <- bindUnqs unqs rig elabinfo nest env qtm
-         fullqtm <- normalise defs env qtm
-         checkExp rig elabinfo env fc fullqtm (gnf env qty) exp
+         fullqtm <- normalise env qtm
+         checkExp rig elabinfo env fc fullqtm !(nf env qty) exp
 
 export
 checkQuoteName : {vars : _} ->
@@ -206,7 +209,7 @@ checkQuoteName rig elabinfo nest env fc n exp
     = do defs <- get Ctxt
          qnm <- reflect fc defs (onLHS (elabMode elabinfo)) env n
          qty <- getCon fc defs (reflectiontt "Name")
-         checkExp rig elabinfo env fc qnm (gnf env qty) exp
+         checkExp rig elabinfo env fc qnm !(nf env qty) exp
 
 export
 checkQuoteDecl : {vars : _} ->
@@ -227,7 +230,7 @@ checkQuoteDecl rig elabinfo nest env fc ds exp
          qds <- reflect fc defs (onLHS (elabMode elabinfo)) env ds'
          unqs <- get Unq
          qd <- getCon fc defs (reflectionttimp "Decl")
-         qty <- appCon fc defs (basics "List") [qd]
+         qty <- appConTop fc defs (basics "List") [qd]
          checkExp rig elabinfo env fc
                   !(bindUnqs unqs rig elabinfo nest env qds)
-                  (gnf env qty) exp
+                  !(nf env qty) exp
diff --git a/src/TTImp/Elab/Record.idr b/src/TTImp/Elab/Record.idr
index 7f1694d0fe6..28f8a9c1b1e 100644
--- a/src/TTImp/Elab/Record.idr
+++ b/src/TTImp/Elab/Record.idr
@@ -3,7 +3,11 @@ module TTImp.Elab.Record
 import Core.Env
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -13,28 +17,25 @@ import TTImp.Elab.Delayed
 import TTImp.TTImp
 
 import Data.SortedSet
+import Data.SnocList
 
 %default covering
 
-getRecordType : Env Term vars -> NF vars -> Maybe Name
-getRecordType env (NTCon _ n _ _) = Just n
-getRecordType env _ = Nothing
+getRecordType : NF vars -> Maybe Name
+getRecordType (VTCon _ n _ _) = Just n
+getRecordType _ = Nothing
 
 getNames : {auto c : Ref Ctxt Defs} -> Defs -> ClosedNF -> Core $ SortedSet Name
-getNames defs (NApp _ hd args)
-    = do eargs <- traverse (evalClosure defs . snd) args
-         pure $ nheadNames hd `union` concat !(traverse (getNames defs) eargs)
-  where
-    nheadNames : NHead Scope.empty -> SortedSet Name
-    nheadNames (NRef Bound n) = singleton n
-    nheadNames _ = empty
-getNames defs (NDCon _ _ _ _ args)
-    = do eargs <- traverse (evalClosure defs . snd) args
+getNames defs (VApp _ nt n args _)
+    = do eargs <- traverseSnocList spineVal args
+         pure $ singleton n `union` concat !(traverse (getNames defs) eargs)
+getNames defs (VDCon _ _ _ _ args)
+    = do eargs <- traverseSnocList spineVal args
          pure $ concat !(traverse (getNames defs) eargs)
-getNames defs (NTCon _ _ _ args)
-  = do eargs <- traverse (evalClosure defs . snd) args
+getNames defs (VTCon _ _ _ args)
+  = do eargs <- traverseSnocList spineVal args
        pure $ concat !(traverse (getNames defs) eargs)
-getNames defs (NDelayed _ _ tm) = getNames defs tm
+getNames defs (VDelayed _ _ tm) = getNames defs !(expand tm)
 getNames {} = pure empty
 
 data Rec : Type where
@@ -81,21 +82,21 @@ findFieldsAndTypeArgs : {auto c : Ref Ctxt Defs} ->
                         Core $ Maybe (List (String, Maybe Name, Maybe Name), SortedSet Name)
 findFieldsAndTypeArgs defs con
     = case !(lookupTyExact con (gamma defs)) of
-           Just t => pure (Just !(getExpNames empty [] !(nf defs Env.empty t)))
+           Just t => pure (Just !(getExpNames empty [] !(expand !(nf Env.empty t))))
            _ => pure Nothing
   where
     getExpNames : SortedSet Name ->
                   List (String, Maybe Name, Maybe Name) ->
                   ClosedNF ->
                   Core (List (String, Maybe Name, Maybe Name), SortedSet Name)
-    getExpNames names expNames (NBind fc x (Pi _ _ p ty) sc)
+    getExpNames names expNames (VBind fc x (Pi _ _ p ty) sc)
         = do let imp = case p of
                             Explicit => Nothing
                             _ => Just x
-             nfty <- evalClosure defs ty
+             nfty <- expand ty
              let names = !(getNames defs nfty) `union` names
-             let expNames = (nameRoot x, imp, getRecordType Env.empty nfty) :: expNames
-             getExpNames names expNames !(sc defs (toClosure defaultOpts Env.empty (Ref fc Bound x)))
+             let expNames = (nameRoot x, imp, getRecordType nfty) :: expNames
+             getExpNames names expNames !(expand !(sc (pure (vRef fc Bound x))))
     getExpNames names expNames nfty = pure (reverse expNames, (!(getNames defs nfty) `union` names))
 
 genFieldName : {auto u : Ref UST UState} ->
@@ -206,8 +207,8 @@ recUpdate rigc elabinfo iloc nest env flds rec grecty
            unless (null dups) $
              throw (DuplicatedRecordUpdatePath iloc $ Prelude.toList dups)
            defs <- get Ctxt
-           rectynf <- getNF grecty
-           let Just rectyn = getRecordType env rectynf
+           rectynf <- expand grecty
+           let Just rectyn = getRecordType rectynf
                     | Nothing => throw (RecordTypeNeeded iloc env)
            fldn <- genFieldName "__fld"
            sides <- getAllSides iloc flds rectyn rec
@@ -253,13 +254,13 @@ checkUpdate rig elabinfo nest env fc upds rec expected
          delayOnFailure fc rig env (Just recty) needType RecordUpdate $
            \delayed =>
              do solveConstraints solvemode Normal
-                exp <- getTerm recty
+                exp <- expand recty
                 -- We can't just use the old NF on the second attempt,
                 -- because we might know more now, so recalculate it
-                let recty' = if delayed
-                                then gnf env exp
-                                else recty
-                logGlueNF "elab.record" 5 (show delayed ++ " record type " ++ show rec) env recty'
+                recty' <- if delayed
+                                then nf env !(quote env exp)
+                                else pure recty
+                logNF "elab.record" 5 (show delayed ++ " record type " ++ show rec) env recty'
                 rcase <- recUpdate rig elabinfo fc nest env upds rec recty'
                 log "elab.record" 5 $ "Record update: " ++ show rcase
                 check rig elabinfo nest env rcase expected
diff --git a/src/TTImp/Elab/Rewrite.idr b/src/TTImp/Elab/Rewrite.idr
index 7c901ed2bd2..4bdab64e783 100644
--- a/src/TTImp/Elab/Rewrite.idr
+++ b/src/TTImp/Elab/Rewrite.idr
@@ -1,10 +1,14 @@
 module TTImp.Elab.Rewrite
 
 import Core.Env
-import Core.GetType
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Quote
+import Core.Evaluate.Convert
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -13,7 +17,9 @@ import TTImp.Elab.Check
 import TTImp.Elab.Delayed
 import TTImp.TTImp
 
-import Libraries.Data.List.SizeOf
+import Data.SnocList
+
+import Libraries.Data.SnocList.SizeOf
 
 %default covering
 
@@ -30,14 +36,12 @@ findRewriteLemma loc rulety
 getRewriteTerms : {vars : _} ->
                   {auto c : Ref Ctxt Defs} ->
                   FC -> Defs -> NF vars -> Error ->
-                  Core (NF vars, NF vars, NF vars)
-getRewriteTerms loc defs (NTCon nfc eq a args) err
+                  Core (Glued vars, Glued vars, Glued vars)
+getRewriteTerms loc defs (VTCon nfc eq a args) err
     = if !(isEqualTy eq)
-         then case reverse $ map snd args of
-                   (rhs :: lhs :: rhsty :: lhsty :: _) =>
-                        pure (!(evalClosure defs lhs),
-                              !(evalClosure defs rhs),
-                              !(evalClosure defs lhsty))
+         then case map value args of
+                   (_ :< lhsty :< rhsty :< lhs :< rhs) =>
+                        pure (!lhs, !rhs, !lhsty)
                    _ => throw err
          else throw err
 getRewriteTerms loc defs ty err
@@ -72,31 +76,30 @@ elabRewrite : {vars : _} ->
 elabRewrite loc env expected rulety
     = do defs <- get Ctxt
          parg <- genVarName "rwarg"
-         tynf <- nf defs env rulety
+         tynf <- expand !(nf env rulety)
          (lt, rt, lty) <- getRewriteTerms loc defs tynf (NotRewriteRule loc env rulety)
          lemn <- findRewriteLemma loc rulety
 
          -- Need to normalise again, since we might have been delayed and
          -- the metavariables might have been updated
-         expnf <- nf defs env expected
+         expnf <- nf env expected
 
          logNF "elab.rewrite" 5 "Rewriting" env lt
          logNF "elab.rewrite" 5 "Rewriting in" env expnf
-         rwexp_sc <- replace defs env lt (Ref loc Bound parg) expnf
+         rwexp_sc <- replace env lt (Ref loc Bound parg) expnf
          logTerm "elab.rewrite" 5 "Rewritten to" rwexp_sc
 
          empty <- clearDefs defs
-         let pred = Bind loc parg (Lam loc top Explicit
-                          !(quote empty env lty))
+         ltyTm <- quote env lty
+         let pred = Bind loc parg (Lam loc top Explicit ltyTm)
                           (refsToLocals (Add parg parg None) rwexp_sc)
-         gpredty <- getType env pred
-         predty <- getTerm gpredty
-         exptm <- quote defs env expected
+         let predty = Bind loc parg (Pi loc top Explicit ltyTm)
+                          (TType loc (MN "top" 0))
 
          -- if the rewritten expected type converts with the original,
          -- then the rewrite did nothing, which is an error
-         when !(convert defs env rwexp_sc exptm) $
-             throw (RewriteNoChange loc env rulety exptm)
+         when !(convert env rwexp_sc expected) $
+             throw (RewriteNoChange loc env rulety expected)
          pure (MkLemma lemn pred predty)
 
 export
@@ -121,8 +124,8 @@ checkRewrite {vars} rigc elabinfo nest env ifc rule tm (Just expected)
            (rulev, grulet) <- check erased elabinfo nest env rule Nothing
            solveConstraintsAfter constart inTerm Normal
 
-           rulet <- getTerm grulet
-           expTy <- getTerm expected
+           rulet <- quote env grulet
+           expTy <- quote env expected
            when delayed $ log "elab.rewrite" 5 "Retrying rewrite"
            lemma <- elabRewrite vfc env expTy rulet
 
@@ -132,7 +135,7 @@ checkRewrite {vars} rigc elabinfo nest env ifc rule tm (Just expected)
            let pbind = Let vfc erased lemma.pred lemma.predTy
            let rbind = Let vfc erased (weaken rulev) (weaken rulet)
 
-           let env' = rbind :: pbind :: env
+           let env' =  env :< pbind :< rbind
 
            -- Nothing we do in this last part will affect the EState,
            -- we're only doing the application this way to make sure the
@@ -140,15 +143,15 @@ checkRewrite {vars} rigc elabinfo nest env ifc rule tm (Just expected)
            -- we still need the right type for the EState, so weaken it once
            -- for each of the let bindings above.
            (rwtm, grwty) <-
-              inScope vfc (pbind :: env) $ \e' =>
+              inScope vfc (env :< pbind) $ \e' =>
                 inScope {e=e'} vfc env' $ \e'' =>
-                  let offset = mkSizeOf [rname, pname] in
+                  let offset = mkSizeOf [<pname, rname] in
                   check {e = e''} rigc elabinfo (weakenNs offset nest) env'
                     (apply (IVar vfc lemma.name)
                       [ IVar vfc pname
                       , IVar vfc rname
                       , tm ])
-                    (Just (gnf env' (weakenNs offset expTy)))
-           rwty <- getTerm grwty
+                    (Just !(nf env' (weakenNs offset expTy)))
+           rwty <- quote env' grwty
            let binding = Bind vfc pname pbind . Bind vfc rname rbind
-           pure (binding rwtm, gnf env (binding rwty))
+           pure (binding rwtm, !(nf env (binding rwty)))
diff --git a/src/TTImp/Elab/RunElab.idr b/src/TTImp/Elab/RunElab.idr
index 73c517efa17..a89cfddb967 100644
--- a/src/TTImp/Elab/RunElab.idr
+++ b/src/TTImp/Elab/RunElab.idr
@@ -2,16 +2,22 @@ module TTImp.Elab.RunElab
 
 import Core.Directory
 import Core.Env
+import Core.Evaluate
 import Core.Metadata
 import Core.Reflect
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Idris.Resugar
 import Idris.REPL.Opts
 import Idris.Pretty
 import Idris.Syntax
 
+import Data.SnocList
+
 import Libraries.Data.NameMap
 import Libraries.Data.WithDefault
 import Libraries.Text.PrettyPrint.Prettyprinter.Doc -- for PageWidth
@@ -42,7 +48,7 @@ lookupNameInfo n ctxt
 Reflect NameInfo where
   reflect fc defs lhs env inf
       = do nt <- reflect fc defs lhs env (nametype inf)
-           appCon fc defs (reflectiontt "MkNameInfo") [nt]
+           appConTop fc defs (reflectiontt "MkNameInfo") [nt]
 
 deepRefersTo : {auto c : Ref Ctxt Defs} ->
                GlobalDef -> Core (List Name)
@@ -75,14 +81,16 @@ elabScript : {vars : _} ->
              {auto o : Ref ROpts REPLOpts} ->
              RigCount -> FC -> NestedNames vars ->
              Env Term vars -> NF vars -> Maybe (Glued vars) ->
-             Core (NF vars)
-elabScript rig fc nest env script@(NDCon nfc nm t ar args) exp
+             Core (Glued vars)
+elabScript rig fc nest env script@(VDCon nfc nm t ar args) exp
     = do defs <- get Ctxt
          fnm <- toFullNames nm
+         log "reflection.reify" 10 $ "elabScript fnm: \{show fnm}"
+         flip traverse_ args $ \v => logNF "reflection.reify" 10 "fnm arg \{show fnm}" env !(v.value)
          case fnm of
               NS ns (UN (Basic n))
                  => if ns == reflectionNS
-                      then elabCon defs n (map snd args)
+                      then elabCon defs n !(traverseSnocList value args)
                              `catch` \case -- wrap into `RunElabFail` any non-elab error
                                e@(BadRunElab {})  => throw e
                                e@(RunElabFail {}) => throw e
@@ -93,21 +101,16 @@ elabScript rig fc nest env script@(NDCon nfc nm t ar args) exp
     failWith : Defs -> String -> Core a
     failWith defs desc
       = do empty <- clearDefs defs
-           throw (BadRunElab fc env !(quote empty env script) desc)
+           throw (BadRunElab fc env !(quote env script) desc)
 
-    scriptRet : Reflect a => a -> Core (NF vars)
+    scriptRet : Reflect a => a -> Core (Glued vars)
     scriptRet tm
         = do defs <- get Ctxt
-             nfOpts withAll defs env !(reflect fc defs False env tm)
-
-    reifyFC : Defs -> Closure vars -> Core FC
-    reifyFC defs mbfc = pure $ case !(evalClosure defs mbfc >>= reify defs) of
-      EmptyFC => fc
-      x       => x
+             nf env !(reflect fc defs False env tm)
 
     -- parses and resolves `Language.Reflection.LookupDir`
-    lookupDir : Defs -> NF vars -> Core String
-    lookupDir defs (NDCon _ conName _ _ [])
+    lookupDir : Defs -> Glued vars -> Core String
+    lookupDir defs (VDCon _ conName _ _ [<])
         = do defs <- get Ctxt
              NS ns (UN (Basic n)) <- toFullNames conName
                | fnm => failWith defs $ "bad lookup dir fullnames " ++ show fnm
@@ -130,7 +133,7 @@ elabScript rig fc nest env script@(NDCon nfc nm t ar args) exp
     lookupDir defs lk
         = do defs <- get Ctxt
              empty <- clearDefs defs
-             throw (BadRunElab fc env !(quote empty env lk) "lookup dir is not a data value")
+             throw (BadRunElab fc env !(quote env lk) "lookup dir is not a data value")
 
     validatePath : Defs -> String -> Core ()
     validatePath defs path = do
@@ -147,153 +150,146 @@ elabScript rig fc nest env script@(NDCon nfc nm t ar args) exp
         pathDoesNotEscape n     ("." ::rest) = pathDoesNotEscape n rest
         pathDoesNotEscape n     (_   ::rest) = pathDoesNotEscape (S n) rest
 
-    elabCon : Defs -> String -> List (Closure vars) -> Core (NF vars)
-    elabCon defs "Pure" [_,val]
-        = do empty <- clearDefs defs
-             evalClosure empty val
-    elabCon defs "Map" [_,_,fm,act]
+    elabCon : Defs -> String -> SnocList (Glued vars) -> Core (Glued vars)
+    elabCon defs "Pure" [<_,val] = pure val
+    elabCon defs "Map" [<_,_,fm,act]
         -- fm : A -> B
         -- elab : A
-        = do act <- elabScript rig fc nest env !(evalClosure defs act) exp
-             act <- quote defs env act
-             fm <- evalClosure defs fm
-             applyToStack defs withHoles env fm [(getLoc act, toClosure withAll env act)]
-    elabCon defs "Ap" [_,_,actF,actX]
+        = do act <- elabScript rig fc nest env !(expandFull act) exp
+             fm <- expandFull fm
+             apply fc fm top (pure act)
+    elabCon defs "Ap" [<_,_,actF,actX]
         -- actF : Elab (A -> B)
         -- actX : Elab A
-        = do actF <- elabScript rig fc nest env !(evalClosure defs actF) exp
-             actX <- elabScript rig fc nest env !(evalClosure defs actX) exp
-             actX <- quote defs env actX
-             applyToStack defs withHoles env actF [(getLoc actX, toClosure withAll env actX)]
-    elabCon defs "Bind" [_,_,act,k]
+        = do actF <- elabScript rig fc nest env !(expandFull actF) exp
+             actX <- elabScript rig fc nest env !(expandFull actX) exp
+             apply fc actF top (pure actX)
+    elabCon defs "Bind" [<_,_,act,k]
         -- act : Elab A
         -- k : A -> Elab B
         -- 1) Run elabScript on act stripping off Elab
         -- 2) Evaluate the resulting act
         -- 3) apply k to the result of (2)
         -- 4) Run elabScript on the result stripping off Elab
-        = do act <- elabScript rig fc nest env
-                                !(evalClosure defs act) exp
-             act <- quote defs env act
-             k <- evalClosure defs k
-             r <- applyToStack defs withAll env k [(getLoc act, toClosure withAll env act)]
-             elabScript rig fc nest env r exp
-    elabCon defs "Fail" [_, mbfc, msg]
-        = do msg' <- evalClosure defs msg
-             throw $ RunElabFail $ GenericMsg !(reifyFC defs mbfc) !(reify defs msg')
-    elabCon defs "Warn" [mbfc, msg]
-        = do msg' <- evalClosure defs msg
-             recordWarning $ GenericWarn !(reifyFC defs mbfc) !(reify defs msg')
+        = do act <- elabScript rig fc nest env !(expandFull act) exp
+             r <- apply fc k top (pure act)
+             elabScript rig fc nest env !(expandFull r) exp
+    elabCon defs "Fail" [<_, mbfc, msg]
+        = do msg' <- expandFull msg
+             let customFC = case !(expandFull mbfc >>= reify defs) of
+                               EmptyFC => fc
+                               x       => x
+             throw $ RunElabFail $ GenericMsg customFC !(reify defs msg')
+    elabCon defs "Warn" [<mbfc, msg]
+        = do msg' <- expandFull msg
+             let customFC = case !(expandFull mbfc >>= reify defs) of
+                               EmptyFC => fc
+                               x       => x
+             recordWarning $ GenericWarn customFC !(reify defs msg')
              scriptRet ()
-    elabCon defs "Try" [_, elab1, elab2]
+    elabCon defs "Try" [<_, elab1, elab2]
         = tryUnify (do constart <- getNextEntry
-                       res <- elabScript rig fc nest env !(evalClosure defs elab1) exp
+                       res <- elabScript rig fc nest env !(expandFull elab1) exp
                        -- We ensure that all of the constraints introduced during the elab script
                        -- have been solved. This guarantees that we do not mistakenly succeed even
                        -- though e.g. a proof search got delayed.
                        solveConstraintsAfter constart inTerm LastChance
                        pure res)
-                   (elabScript rig fc nest env !(evalClosure defs elab2) exp)
-    elabCon defs "LogMsg" [topic, verb, str]
-        = do topic' <- evalClosure defs topic
-             verb' <- evalClosure defs verb
+                   (elabScript rig fc nest env !(expandFull elab2) exp)
+    elabCon defs "LogMsg" [<topic, verb, str]
+        = do topic' <- expandFull topic
+             verb' <- expandFull verb
              unverifiedLogC !(reify defs topic') !(reify defs verb') $
-                  do str' <- evalClosure defs str
+                  do str' <- expandFull str
                      reify defs str'
              scriptRet ()
-    elabCon defs "LogTerm" [topic, verb, str, tm]
-        = do topic' <- evalClosure defs topic
-             verb' <- evalClosure defs verb
+    elabCon defs "LogTerm" [<topic, verb, str, tm]
+        = do topic' <- expandFull topic
+             verb' <- expandFull verb
              unverifiedLogC !(reify defs topic') !(reify defs verb') $
-                  do str' <- evalClosure defs str
-                     tm' <- evalClosure defs tm
+                  do str' <- expandFull str
+                     tm' <- expandFull tm
                      pure $ !(reify defs str') ++ ": " ++
                              show (the RawImp !(reify defs tm'))
              scriptRet ()
-    elabCon defs "LogSugaredTerm" [topic, verb, str, tm]
-        = do topic' <- evalClosure defs topic
-             verb' <- evalClosure defs verb
+    elabCon defs "LogSugaredTerm" [<topic, verb, str, tm]
+        = do topic' <- expandFull topic
+             verb' <- expandFull verb
              unverifiedLogC !(reify defs topic') !(reify defs verb') $
-                  do str' <- evalClosure defs str
-                     tm' <- reify defs !(evalClosure defs tm)
+                  do str' <- expandFull str
+                     tm' <- reify defs !(expandFull tm)
                      ptm <- pterm (map defaultKindedName tm')
                      pure $ !(reify defs str') ++ ": " ++ show ptm
              scriptRet ()
-    elabCon defs "ResugarTerm" [maxLineWidth, tm]
-        = do ptm <- pterm . map defaultKindedName =<< reify defs !(evalClosure defs tm)
-             mlw : Maybe Nat <- reify defs !(evalClosure defs maxLineWidth)
+    elabCon defs "ResugarTerm" [<maxLineWidth, tm]
+        = do ptm <- pterm . map defaultKindedName =<< reify defs !(expandFull tm)
+             mlw : Maybe Nat <- reify defs !(expandFull maxLineWidth)
              let pw = maybe Unbounded (\w => AvailablePerLine (cast w) 1) mlw
              scriptRet $ render' pw Nothing $ pretty {ann=IdrisSyntax} ptm
-    elabCon defs "Check" [exp, ttimp]
-        = do exp' <- evalClosure defs exp
-             ttimp' <- evalClosure defs ttimp
+    elabCon defs "Check" [<exp, ttimp]
+        = do ttimp' <- expandFull ttimp
              tidx <- resolveName (UN $ Basic "[elaborator script]")
              e <- newRef EST (initEState tidx env)
              (checktm, _) <- runDelays (const True) $
                      check rig (initElabInfo InExpr) nest env !(reify defs ttimp')
-                           (Just (glueBack defs env exp'))
-             empty <- clearDefs defs
-             nf empty env checktm
-    elabCon defs "Quote" [exp, tm]
-        = do tm' <- evalClosure defs tm
-             defs <- get Ctxt
-             empty <- clearDefs defs
-             scriptRet $ map rawName !(unelabUniqueBinders env !(quote empty env tm'))
-    elabCon defs "Lambda" [x, _, scope]
-        = do empty <- clearDefs defs
-             NBind bfc x (Lam fc' c p ty) sc <- evalClosure defs scope
+                           (Just exp)
+             nf env checktm
+    elabCon defs "Quote" [<exp, tm]
+        = do tm' <- expand tm
+             scriptRet $ map rawName !(unelabUniqueBinders env !(quote env tm'))
+    elabCon defs "Lambda" [<x, _, scope]
+        = do VBind bfc x (Lam fc' c p ty) sc <- expandFull scope
                    | _ => failWith defs "Not a lambda"
              n <- genVarName "x"
-             sc' <- sc defs (toClosure withAll env (Ref bfc Bound n))
-             qsc <- quote empty env sc'
+             sc' <- sc (pure (vRef bfc Bound n))
+             qsc <- quote env sc'
              let lamsc = refToLocal n x qsc
              qp <- quotePi p
-             qty <- quote empty env ty
-             let env' = Lam fc' c qp qty :: env
-
+             qty <- quote env ty
+             let env' = env :< Lam fc' c qp qty
              runsc <- elabScript rig fc (weaken nest) env'
-                                 !(nf defs env' lamsc) Nothing -- (map weaken exp)
-             nf empty env (Bind bfc x (Lam fc' c qp qty) !(quote empty env' runsc))
+                                 !(expandFull !(nf env' lamsc)) Nothing
+             nf env (Bind bfc x (Lam fc' c qp qty) !(quote env' runsc))
        where
-         quotePi : PiInfo (Closure vars) -> Core (PiInfo (Term vars))
+         quotePi : PiInfo (Glued vars) -> Core (PiInfo (Term vars))
          quotePi Explicit = pure Explicit
          quotePi Implicit = pure Implicit
          quotePi AutoImplicit = pure AutoImplicit
          quotePi (DefImplicit t) = failWith defs "Can't add default lambda"
-    elabCon defs "Goal" []
+    elabCon defs "Goal" [<]
         = do let Just gty = exp
-                 | Nothing => nfOpts withAll defs env
-                                     !(reflect fc defs False env (the (Maybe RawImp) Nothing))
-             ty <- getTerm gty
+                 | Nothing => nf env
+                                !(reflect fc defs False env (the (Maybe RawImp) Nothing))
+             ty <- quote env gty
              scriptRet (Just $ map rawName $ !(unelabUniqueBinders env ty))
-    elabCon defs "LocalVars" []
-        = scriptRet vars
-    elabCon defs "GenSym" [str]
-        = do str' <- evalClosure defs str
+    elabCon defs "LocalVars" [<]
+        = scriptRet $ asList vars
+    elabCon defs "GenSym" [<str]
+        = do str' <- expandFull str
              n <- genVarName !(reify defs str')
              scriptRet n
-    elabCon defs "InCurrentNS" [n]
-        = do n' <- evalClosure defs n
+    elabCon defs "InCurrentNS" [<n]
+        = do n' <- expandFull n
              nsn <- inCurrentNS !(reify defs n')
              scriptRet nsn
-    elabCon defs "GetType" [n]
-        = do n' <- evalClosure defs n
+    elabCon defs "GetType" [<n]
+        = do n' <- expandFull n
              res <- lookupTyName !(reify defs n') (gamma defs)
              scriptRet !(traverse unelabType res)
       where
         unelabType : (Name, Int, ClosedTerm) -> Core (Name, RawImp)
         unelabType (n, _, ty)
             = pure (n, map rawName !(unelabUniqueBinders Env.empty ty))
-    elabCon defs "GetInfo" [n]
-        = do n' <- evalClosure defs n
+    elabCon defs "GetInfo" [<n]
+        = do n' <- expandFull n
              res <- lookupNameInfo !(reify defs n') (gamma defs)
              scriptRet res
-    elabCon defs "GetVis" [n]
-        = do dn <- reify defs !(evalClosure defs n)
+    elabCon defs "GetVis" [<n]
+        = do dn <- reify defs !(expandFull n)
              ds <- lookupCtxtName dn (gamma defs)
              scriptRet $ map (\(n,_,d) => (n, collapseDefault $ visibility d)) ds
-    elabCon defs "GetLocalType" [n]
-        = do n' <- evalClosure defs n
+    elabCon defs "GetLocalType" [<n]
+        = do n' <- expandFull n
              n <- reify defs n'
              case defined n env of
                   Just (MkIsDefined rigb lv) =>
@@ -301,53 +297,51 @@ elabScript rig fc nest env script@(NDCon nfc nm t ar args) exp
                           let bty = binderType binder
                           scriptRet $ map rawName !(unelabUniqueBinders env bty)
                   _ => failWith defs $ show n ++ " is not a local variable"
-    elabCon defs "GetCons" [n]
-        = do n' <- evalClosure defs n
+    elabCon defs "GetCons" [<n]
+        = do n' <- expandFull n
              cn <- reify defs n'
              Just (TCon _ _ _ _ _ cons _) <-
                      lookupDefExact cn (gamma defs)
                  | _ => failWith defs $ show cn ++ " is not a type"
              scriptRet $ fromMaybe [] cons
-    elabCon defs "GetReferredFns" [n]
-        = do dn <- reify defs !(evalClosure defs n)
+    elabCon defs "GetReferredFns" [<n]
+        = do dn <- reify defs !(expandFull n)
              Just def <- lookupCtxtExact dn (gamma defs)
                  | Nothing => failWith defs $ show dn ++ " is not a definition"
              ns <- deepRefersTo def
              scriptRet ns
-    elabCon defs "GetCurrentFn" []
+    elabCon defs "GetCurrentFn" [<]
         = do defs <- get Ctxt
              scriptRet defs.defsStack
-    elabCon defs "Declare" [d]
-        = do d' <- evalClosure defs d
-             decls <- reify defs d'
-             List.traverse_ (processDecl [] (MkNested []) Env.empty) decls
+    elabCon defs "Declare" [<d]
+        = do d' <- expandFull d
+             decls <- reify {a=List _} defs d'
+             traverse_ (processDecl [] (NestedNames.empty) Env.empty) decls
              scriptRet ()
-    elabCon defs "ReadFile" [lk, pth]
-        = do pathPrefix <- lookupDir defs !(evalClosure defs lk)
-             path <- reify defs !(evalClosure defs pth)
+    elabCon defs "ReadFile" [<lk, pth]
+        = do pathPrefix <- lookupDir defs lk
+             path <- reify defs !(expandFull pth)
              validatePath defs path
              let fullPath = joinPath [pathPrefix, path]
              True <- coreLift $ exists fullPath
                | False => scriptRet $ Nothing {ty=String}
              contents <- readFile fullPath
              scriptRet $ Just contents
-    elabCon defs "WriteFile" [lk, pth, contents]
-        = do pathPrefix <- lookupDir defs !(evalClosure defs lk)
-             path <- reify defs !(evalClosure defs pth)
+    elabCon defs "WriteFile" [<lk, pth, contents]
+        = do pathPrefix <- lookupDir defs lk
+             path <- reify defs !(expandFull pth)
              validatePath defs path
-             contents <- reify defs !(evalClosure defs contents)
+             contents <- reify defs !(expandFull contents)
              let fullPath = joinPath [pathPrefix, path]
              whenJust (parent fullPath) ensureDirectoryExists
              writeFile fullPath contents
              scriptRet ()
-    elabCon defs "IdrisDir" [lk]
-        = do evalClosure defs lk >>= lookupDir defs >>= scriptRet
+    elabCon defs "IdrisDir" [<lk]
+        = do lookupDir defs lk >>= scriptRet
     elabCon defs n args = failWith defs $ "unexpected Elab constructor " ++ n ++
                                           ", or incorrect count of arguments: " ++ show (length args)
 elabScript rig fc nest env script exp
-    = do defs <- get Ctxt
-         empty <- clearDefs defs
-         throw (BadRunElab fc env !(quote empty env script) "script is not a data value")
+    = throw (BadRunElab fc env !(quote env script) "script is not a data value")
 
 export
 checkRunElab : {vars : _} ->
@@ -367,20 +361,21 @@ checkRunElab rig elabinfo nest env fc reqExt script exp
          unless (not reqExt || isExtension ElabReflection defs) $
              throw (GenericMsg fc "%language ElabReflection not enabled")
          let n = NS reflectionNS (UN $ Basic "Elab")
-         elabtt <- appCon fc defs n [expected]
+         elabtt <- appConTop fc defs n [expected]
          (stm, sty) <- runDelays (const True) $
-                           check rig elabinfo nest env script (Just (gnf env elabtt))
+                           check rig elabinfo nest env script (Just !(nf env elabtt))
          solveConstraints inTerm Normal
          defs <- get Ctxt -- checking might have resolved some holes
-         nfstm <- nfOpts withAll defs env stm
+         logTerm "reflection.reify" 10 "checkRunElab stm" stm
+         logEnv "reflection.reify" 10 "checkRunElab env" env
          ntm <- logTime 2 "Elaboration script" $
-                  elabScript rig fc nest env nfstm $ Just (gnf env expected)
+                    elabScript rig fc nest env !(expandFull !(nf env stm)) (Just !(nf env expected))
          defs <- get Ctxt -- might have updated as part of the script
          empty <- clearDefs defs
-         pure (!(quote empty env ntm), gnf env expected)
+         pure (!(quote env ntm), !(nf env expected))
   where
     mkExpected : Maybe (Glued vars) -> Core (Term vars)
-    mkExpected (Just ty) = pure !(getTerm ty)
+    mkExpected (Just ty) = pure !(quote env ty)
     mkExpected Nothing
         = do nm <- genName "scriptTy"
              u <- uniVar fc
diff --git a/src/TTImp/Elab/Term.idr b/src/TTImp/Elab/Term.idr
index 1ee5becdd63..e0b5712857b 100644
--- a/src/TTImp/Elab/Term.idr
+++ b/src/TTImp/Elab/Term.idr
@@ -5,7 +5,11 @@ import Libraries.Data.UserNameMap
 import Core.Env
 import Core.Metadata
 import Core.UnifyState
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -34,77 +38,37 @@ import TTImp.TTImp
 -- implicit lambdas if they aren't there already.
 insertImpLam : {auto c : Ref Ctxt Defs} ->
                {auto u : Ref UST UState} ->
+               {vars: _} ->
                Env Term vars ->
                (term : RawImp) -> (expected : Maybe (Glued vars)) ->
                Core RawImp
-insertImpLam {vars} env tm (Just ty) = bindLam tm ty
+insertImpLam {vars} env tm (Just ty) = bindLamNF tm !(expand ty)
   where
-    -- If we can decide whether we need implicit lambdas without looking
-    -- at the normal form, do so
-    bindLamTm : RawImp -> Term vs -> Core (Maybe RawImp)
-    bindLamTm tm@(ILam _ _ Implicit _ _ _) (Bind fc n (Pi _ _ Implicit _) sc)
-        = pure (Just tm)
-    bindLamTm tm@(ILam _ _ AutoImplicit _ _ _) (Bind fc n (Pi _ _ AutoImplicit _) sc)
-        = pure (Just tm)
-    bindLamTm tm@(ILam _ _ (DefImplicit _) _ _ _) (Bind fc n (Pi _ _ (DefImplicit _) _) sc)
-        = pure (Just tm)
-    bindLamTm tm (Bind fc n (Pi _ c Implicit ty) sc)
-        = do n' <- genVarName (nameRoot n)
-             Just sc' <- bindLamTm tm sc
-                 | Nothing => pure Nothing
-             pure $ Just (ILam fc c Implicit (Just n') (Implicit fc False) sc')
-    bindLamTm tm (Bind fc n (Pi _ c AutoImplicit ty) sc)
-        = do n' <- genVarName (nameRoot n)
-             Just sc' <- bindLamTm tm sc
-                 | Nothing => pure Nothing
-             pure $ Just (ILam fc c AutoImplicit (Just n') (Implicit fc False) sc')
-    bindLamTm tm (Bind fc n (Pi _ c (DefImplicit _) ty) sc)
-        = do n' <- genVarName (nameRoot n)
-             Just sc' <- bindLamTm tm sc
-                 | Nothing => pure Nothing
-             pure $ Just (ILam fc c (DefImplicit (Implicit fc False))
-                                    (Just n') (Implicit fc False) sc')
-    bindLamTm tm exp
-        = case getFn exp of
-               Ref _ Func _ => pure Nothing -- might still be implicit
-               TForce {} => pure Nothing
-               Bind _ _ (Lam {}) _ => pure Nothing
-               _ => pure $ Just tm
-
     bindLamNF : RawImp -> NF vars -> Core RawImp
-    bindLamNF tm@(ILam _ _ Implicit _ _ _) (NBind fc n (Pi _ _ Implicit _) sc)
+    bindLamNF tm@(ILam _ _ Implicit _ _ _) (VBind fc n (Pi _ _ Implicit _) sc)
         = pure tm
-    bindLamNF tm@(ILam _ _ AutoImplicit _ _ _) (NBind fc n (Pi _ _ AutoImplicit _) sc)
+    bindLamNF tm@(ILam _ _ AutoImplicit _ _ _) (VBind fc n (Pi _ _ AutoImplicit _) sc)
         = pure tm
-    bindLamNF tm (NBind fc n (Pi fc' c Implicit ty) sc)
+    bindLamNF tm (VBind fc n (Pi fc' c Implicit ty) sc)
         = do defs <- get Ctxt
              n' <- genVarName (nameRoot n)
-             sctm <- sc defs (toClosure defaultOpts env (Ref fc Bound n'))
+             sctm <- expand !(sc (pure (vRef fc Bound n')))
              sc' <- bindLamNF tm sctm
              pure $ ILam fc c Implicit (Just n') (Implicit fc False) sc'
-    bindLamNF tm (NBind fc n (Pi fc' c AutoImplicit ty) sc)
+    bindLamNF tm (VBind fc n (Pi fc' c AutoImplicit ty) sc)
         = do defs <- get Ctxt
              n' <- genVarName (nameRoot n)
-             sctm <- sc defs (toClosure defaultOpts env (Ref fc Bound n'))
+             sctm <- expand !(sc (pure (vRef fc Bound n')))
              sc' <- bindLamNF tm sctm
              pure $ ILam fc c AutoImplicit (Just n') (Implicit fc False) sc'
-    bindLamNF tm (NBind fc n (Pi _ c (DefImplicit _) ty) sc)
+    bindLamNF tm (VBind fc n (Pi _ c (DefImplicit _) ty) sc)
         = do defs <- get Ctxt
              n' <- genVarName (nameRoot n)
-             sctm <- sc defs (toClosure defaultOpts env (Ref fc Bound n'))
+             sctm <- expand !(sc (pure (vRef fc Bound n')))
              sc' <- bindLamNF tm sctm
              pure $ ILam fc c (DefImplicit (Implicit fc False))
                               (Just n') (Implicit fc False) sc'
     bindLamNF tm sc = pure tm
-
-    bindLam : RawImp -> Glued vars -> Core RawImp
-    bindLam tm gty
-        = do ty <- getTerm gty
-             Just tm' <- bindLamTm tm ty
-                | Nothing =>
-                    do nf <- getNF gty
-                       bindLamNF tm nf
-             pure tm'
 insertImpLam env tm _ = pure tm
 
 -- Main driver for checking terms, after implicits have been added.
@@ -161,7 +125,7 @@ checkTerm rig elabinfo nest env (INamedApp fc fn nm arg) exp
 checkTerm rig elabinfo nest env (ISearch fc depth) (Just gexpty)
     = do est <- get EST
          nm <- genName "search"
-         expty <- getTerm gexpty
+         expty <- quote env gexpty
          sval <- searchVar fc rig depth (Resolved (defining est)) env nest nm expty
          pure (sval, gexpty)
 checkTerm rig elabinfo nest env (ISearch fc depth) Nothing
@@ -171,7 +135,7 @@ checkTerm rig elabinfo nest env (ISearch fc depth) Nothing
          ty <- metaVar fc erased env nmty (TType fc u)
          nm <- genName "search"
          sval <- searchVar fc rig depth (Resolved (defining est)) env nest nm ty
-         pure (sval, gnf env ty)
+         pure (sval, !(nf env ty))
 checkTerm rig elabinfo nest env (IAlternative fc uniq alts) exp
     = checkAlternative rig elabinfo nest env fc uniq alts exp
 checkTerm rig elabinfo nest env (IRewrite fc rule tm) exp
@@ -204,7 +168,7 @@ checkTerm rig elabinfo nest env (IRunElab fc re tm) exp
     = checkRunElab rig elabinfo nest env fc re tm exp
 checkTerm {vars} rig elabinfo nest env (IPrimVal fc c) exp
     = do let (cval, cty) = checkPrim {vars} fc c
-         checkExp rig elabinfo env fc cval (gnf env cty) exp
+         checkExp rig elabinfo env fc cval !(nf env cty) exp
 checkTerm rig elabinfo nest env (IType fc) exp
     = do u <- uniVar fc
          checkExp rig elabinfo env fc (TType fc u) (gType fc u) exp
@@ -214,11 +178,11 @@ checkTerm rig elabinfo nest env (IUnifyLog fc lvl tm) exp
     = withLogLevel lvl $ check rig elabinfo nest env tm exp
 checkTerm rig elabinfo nest env (Implicit fc b) (Just gexpty)
     = do nm <- genName "_"
-         expty <- getTerm gexpty
+         expty <- quote env gexpty
          metaval <- metaVar fc rig env nm expty
          -- Add to 'bindIfUnsolved' if 'b' set
          when (b && bindingVars elabinfo) $
-            do expty <- getTerm gexpty
+            do expty <- quote env gexpty
                -- Explicit because it's an explicitly given thing!
                update EST $ addBindIfUnsolved nm fc rig Explicit env metaval expty
          pure (metaval, gexpty)
@@ -231,7 +195,7 @@ checkTerm rig elabinfo nest env (Implicit fc b) Nothing
          -- Add to 'bindIfUnsolved' if 'b' set
          when (b && bindingVars elabinfo) $
             update EST $ addBindIfUnsolved nm fc rig Explicit env metaval ty
-         pure (metaval, gnf env ty)
+         pure (metaval, !(nf env ty))
 checkTerm rig elabinfo nest env (IWithUnambigNames fc ns rhs) exp
     = do -- enter the scope -> add unambiguous names
          est <- get EST
@@ -294,10 +258,12 @@ TTImp.Elab.Check.check rigc elabinfo nest env tm@(IUpdate {}) exp
     = checkImp rigc elabinfo nest env tm exp
 TTImp.Elab.Check.check rigc elabinfo nest env tm_in exp
     = do tm <- expandAmbigName (elabMode elabinfo) nest env tm_in [] tm_in exp
+         logC "elab" 50 $ pure "expandAmbigName tm: \{show tm}"
          case elabMode elabinfo of
               InLHS _ => -- Don't expand implicit lambda on lhs
                  checkImp rigc elabinfo nest env tm exp
               _ => do tm' <- insertImpLam env tm exp
+                      logC "elab" 50 $ pure "insertImpLam tm_backtick: \{show tm'}"
                       checkImp rigc elabinfo nest env tm' exp
 
 onLHS : ElabMode -> Bool
@@ -324,5 +290,5 @@ TTImp.Elab.Check.checkImp rigc elabinfo nest env tm exp
             do let (argv, argt) = res
                let Just expty = exp
                         | Nothing => pure ()
-               addPolyConstraint (getFC tm) env argv !(getNF expty) !(getNF argt)
+               addPolyConstraint (getFC tm) env argv expty !(quote env argt)
          pure res
diff --git a/src/TTImp/Elab/Utils.idr b/src/TTImp/Elab/Utils.idr
index 7e6c4c649e7..82d94b470cc 100644
--- a/src/TTImp/Elab/Utils.idr
+++ b/src/TTImp/Elab/Utils.idr
@@ -1,48 +1,53 @@
 module TTImp.Elab.Utils
 
-import Core.Case.CaseTree
 import Core.Context
+import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import TTImp.Elab.Check
 import TTImp.TTImp
 
+import Data.SnocList
+import Data.SnocList.Quantifiers
+
 import Libraries.Data.NatSet
 import Libraries.Data.VarSet
-
 import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
+import Libraries.Data.SnocList.Quantifiers.Extra as Lib
 
 %default covering
 
 detagSafe : {auto c : Ref Ctxt Defs} ->
             Defs -> ClosedNF -> Core Bool
-detagSafe defs (NTCon _ n _ args)
+detagSafe defs (VTCon _ n _ args)
     = do Just (TCon _ _ _ _ _ _ (Just detags)) <- lookupDefExact n (gamma defs)
               | _ => pure False
-         args' <- traverse (evalClosure defs . snd) args
+         args' <- traverseSnocList spineVal (reverse args)
          pure $ NatSet.isEmpty detags || notErased 0 detags args'
   where
     -- if any argument positions are in the non-empty(!) detaggable set, and unerased, then
     -- detagging is safe
-    notErased : Nat -> NatSet -> List ClosedNF -> Bool
-    notErased i ns [] = False
-    notErased i ns (NErased _ Impossible :: rest)
+    notErased : Nat -> NatSet -> SnocList (NF [<]) -> Bool
+    notErased i ns [<] = False
+    notErased i ns (rest :< VErased _ Impossible)
         = notErased (i + 1) ns rest -- Can't detag here, look elsewhere
-    notErased i ns (_ :: rest) -- Safe to detag via this argument
+    notErased i ns (rest :< _) -- Safe to detag via this argument
         = elem i ns || notErased (i + 1) ns rest
 detagSafe defs _ = pure False
 
 findErasedFrom : {auto c : Ref Ctxt Defs} ->
-                 Defs -> Nat -> ClosedNF -> Core (NatSet, NatSet)
-findErasedFrom defs pos (NBind fc x (Pi _ c _ aty) scf)
-    = do -- In the scope, use 'Erased fc Impossible' to mean 'argument is erased'.
+                 Defs -> Nat -> NF [<] -> Core (NatSet, NatSet)
+findErasedFrom defs pos (VBind fc x (Pi _ c _ aty) scf)
+    = do -- In the scope, use 'Erased fc True' to mean 'argument is erased'.
          -- It's handy here, because we can use it to tell if a detaggable
          -- argument position is available
-         sc <- scf defs (toClosure defaultOpts Env.empty (Erased fc (ifThenElse (isErased c) Impossible Placeholder)))
-         (erest, dtrest) <- findErasedFrom defs (1 + pos) sc
-         let dt' = if !(detagSafe defs !(evalClosure defs aty))
+         sc <- scf (pure (VErased fc (ifThenElse (isErased c) Impossible Placeholder)))
+         (erest, dtrest) <- findErasedFrom defs (1 + pos) !(expand sc)
+         let dt' = if !(detagSafe defs !(expand aty))
                       then (insert pos dtrest) else dtrest
          pure $ if isErased c
                    then (insert pos erest, dt')
@@ -56,8 +61,7 @@ findErased : {auto c : Ref Ctxt Defs} ->
              ClosedTerm -> Core (NatSet, NatSet)
 findErased tm
     = do defs <- get Ctxt
-         tmnf <- nf defs Env.empty tm
-         findErasedFrom defs 0 tmnf
+         findErasedFrom defs 0 !(expand !(nf Env.empty tm))
 
 export
 updateErasable : {auto c : Ref Ctxt Defs} ->
@@ -88,16 +92,16 @@ bindNotReq : {vs : _} ->
              FC -> Int -> Env Term vs -> (sub : Thin pre vs) ->
              List (PiInfo RawImp, Name) ->
              Term vs -> (List (PiInfo RawImp, Name), Term pre)
-bindNotReq fc i [] Refl ns tm = (ns, embed tm)
-bindNotReq fc i (b :: env) Refl ns tm
+bindNotReq fc i [<] Refl ns tm = (ns, embed tm)
+bindNotReq {vs = _ :< _} fc i (env :< b) Refl ns tm
    = let tmptm = subst (Ref fc Bound (MN "arg" i)) tm
          (ns', btm) = bindNotReq fc (1 + i) env Refl ns tmptm in
          (ns', refToLocal (MN "arg" i) _ btm)
-bindNotReq fc i (b :: env) (Keep p) ns tm
+bindNotReq {vs = _ :< _} fc i (env :< b) (Keep p) ns tm
    = let tmptm = subst (Ref fc Bound (MN "arg" i)) tm
          (ns', btm) = bindNotReq fc (1 + i) env p ns tmptm in
          (ns', refToLocal (MN "arg" i) _ btm)
-bindNotReq {vs = n :: _} fc i (b :: env) (Drop p) ns tm
+bindNotReq {vs = _ :< n} fc i (env :< b) (Drop p) ns tm
    = bindNotReq fc i env p ((plicit b, n) :: ns)
        (Bind fc _ (Pi (binderLoc b) (multiplicity b) Explicit (binderType b)) tm)
 
@@ -110,24 +114,32 @@ bindReq {vs} fc env Refl ns tm
     = pure (ns, notLets [] _ env, abstractEnvType fc env tm)
   where
     notLets : List Name -> (vars : Scope) -> Env Term vars -> List Name
-    notLets acc [] _ = acc
-    notLets acc (v :: vs) (b :: env) = if isLet b then notLets acc vs env
+    notLets acc [<] _ = acc
+    notLets acc (vs :< v) (env :< b) = if isLet b then notLets acc vs env
                                        else notLets (v :: acc) vs env
-bindReq {vs = n :: _} fc (b :: env) (Keep p) ns tm
+bindReq {vs = _ :< n} fc (env :< b) (Keep p) ns tm
     = do b' <- shrinkBinder b p
          bindReq fc env p ((plicit b, n) :: ns)
             (Bind fc _ (Pi (binderLoc b) (multiplicity b) Explicit (binderType b')) tm)
-bindReq fc (b :: env) (Drop p) ns tm
+bindReq {vs = _ :< _} fc (env :< b) (Drop p) ns tm
     = bindReq fc env p ns tm
 
 -- This machinery is to calculate whether any top level argument is used
 -- more than once in a case block, in which case inlining wouldn't be safe
 -- since it might duplicate work.
+-- TODO: Not sure the rest of this is needed any more. Will port if it turns
+-- out it is!
+{-
 
 data ArgUsed = Used1 -- been used
              | Used0 -- not used
              | LocalVar -- don't care if it's used
 
+Show ArgUsed where
+  show Used1 = "Used1"
+  show Used0 = "Used0"
+  show LocalVar = "LocalVar"
+
 record Usage (vs : Scope) where
   constructor MkUsage
   isUsedSet : VarSet vs -- whether it's been used
@@ -142,7 +154,9 @@ initUsed = MkUsage
 initUsedCase : SizeOf vs -> Usage vs
 initUsedCase p = MkUsage
   { isUsedSet = VarSet.empty
-  , isLocalSet = maybe id VarSet.delete (last p) (VarSet.full p)
+  , isLocalSet = case sizedView p of
+    Z => VarSet.empty
+    S _ => VarSet.delete first (VarSet.full p)
   }
 
 setUsedVar : Var vs -> Usage vs -> Usage vs
@@ -162,20 +176,29 @@ setUsed : {auto u : Ref Used (Usage vars)} ->
           Var vars -> Core ()
 setUsed p = update Used $ setUsedVar p
 
-extendUsed : ArgUsed -> SizeOf inner -> Usage vars -> Usage (inner ++ vars)
+extendUsed : ArgUsed -> SizeOf inner -> Usage vars -> Usage (Scope.ext vars inner)
 extendUsed LocalVar p (MkUsage iu il)
-  = MkUsage (weakenNs {tm = VarSet} p iu) (append p (full p) il)
+  = let p' = cast p in
+    rewrite fishAsSnocAppend vars inner in
+    MkUsage (weakenNs {tm = VarSet} p' iu) (append p' (full p') il)
 extendUsed Used0 p (MkUsage iu il)
-  = MkUsage (weakenNs {tm = VarSet} p iu) (weakenNs {tm = VarSet} p il)
+  = let p' = cast p in
+    rewrite fishAsSnocAppend vars inner in
+    MkUsage (weakenNs {tm = VarSet} p' iu) (weakenNs {tm = VarSet} p' il)
 extendUsed Used1 p (MkUsage iu il)
-  = MkUsage (append p (full p) iu) (weakenNs {tm = VarSet} p il)
+  = let p' = cast p in
+    rewrite fishAsSnocAppend vars inner in
+    MkUsage (append p' (full p') iu) (weakenNs {tm = VarSet} p' il)
 
-dropUsed : SizeOf inner -> Usage (inner ++ vars) -> Usage vars
-dropUsed p (MkUsage iu il) = MkUsage (VarSet.dropInner p iu) (dropInner p il)
+dropUsed : SizeOf inner -> Usage (Scope.ext vars inner) -> Usage vars
+dropUsed p (MkUsage iu il) = let p' = cast p in
+                             MkUsage
+                               (VarSet.dropInner {vs = vars} p' (rewrite sym $ fishAsSnocAppend vars inner in iu))
+                               (dropInner {vs = vars} p' (rewrite sym $ fishAsSnocAppend vars inner in il))
 
 inExtended : ArgUsed -> SizeOf new ->
              {auto u : Ref Used (Usage vars)} ->
-             (Ref Used (Usage (new ++ vars)) -> Core a) ->
+             (Ref Used (Usage (Scope.ext vars new)) -> Core a) ->
              Core a
 inExtended a new sc
     = do used <- get Used
@@ -199,7 +222,7 @@ termInlineSafe (Local fc isLet idx p)
          else do setUsed v
                  pure True
 termInlineSafe (Meta fc x y xs)
-    = termsInlineSafe xs
+    = termsInlineSafe (map snd xs)
 termInlineSafe (Bind fc x b scope)
    = do bok <- binderInlineSafe b
         if bok
@@ -209,7 +232,7 @@ termInlineSafe (Bind fc x b scope)
     binderInlineSafe : Binder (Term vars) -> Core Bool
     binderInlineSafe (Let _ _ val _) = termInlineSafe val
     binderInlineSafe _ = pure True
-termInlineSafe (App fc fn arg)
+termInlineSafe (App fc fn _ arg)
     = do fok <- termInlineSafe fn
          if fok
             then termInlineSafe arg
@@ -289,4 +312,7 @@ canInlineCaseBlock n
          Just (PMDef _ vars _ rtree _) <- lookupDefExact n (gamma defs)
              | _ => pure False
          u <- newRef Used (initUsedCase (mkSizeOf vars))
-         caseInlineSafe rtree
+         log "compiler.inline.eval" 5 "canInlineCaseBlock init n: \{show n}, u: \{show (initUsedCase vars)}"
+         result <- caseInlineSafe rtree
+         log "compiler.inline.eval" 5 "canInlineCaseBlock updated n: \{show n}, result: \{show result}"
+         pure result
diff --git a/src/TTImp/Impossible.idr b/src/TTImp/Impossible.idr
index 23ca46626b1..68e8dcbff11 100644
--- a/src/TTImp/Impossible.idr
+++ b/src/TTImp/Impossible.idr
@@ -1,7 +1,12 @@
 module TTImp.Impossible
 
 import Core.Env
-import Core.Value
+
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import TTImp.TTImp
 import TTImp.TTImp.Functor
@@ -24,20 +29,20 @@ match : {auto c : Ref Ctxt Defs} ->
         ClosedNF -> (Name, Int, ClosedTerm) -> Core Bool
 match nty (n, i, rty)
     = do defs <- get Ctxt
-         rtynf <- nf defs Env.empty rty
+         rtynf <- expand !(nf Env.empty rty)
          sameRet nty rtynf
   where
     sameRet : ClosedNF -> ClosedNF -> Core Bool
-    sameRet _ (NApp {}) = pure True
-    sameRet _ (NErased {}) = pure True
-    sameRet (NApp {}) _ = pure True
-    sameRet (NErased {}) _ = pure True
-    sameRet (NTCon _ n _ _) (NTCon _ n' _ _) = pure (n == n')
-    sameRet (NPrimVal _ c) (NPrimVal _ c') = pure (c == c')
-    sameRet (NType {}) (NType {}) = pure True
-    sameRet nf (NBind fc _ (Pi {}) sc)
+    sameRet _ (VApp{}) = pure True
+    sameRet _ (VErased{}) = pure True
+    sameRet (VApp{}) _ = pure True
+    sameRet (VErased{}) _ = pure True
+    sameRet (VTCon _ n _ _) (VTCon _ n' _ _) = pure (n == n')
+    sameRet (VPrimVal _ c) (VPrimVal _ c') = pure (c == c')
+    sameRet (VType{}) (VType{}) = pure True
+    sameRet nf (VBind fc _ (Pi {}) sc)
         = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+             sc' <- expand !(sc (pure (VErased fc Placeholder)))
              sameRet nf sc'
     sameRet _ _ = pure False
 
@@ -49,6 +54,8 @@ dropNoMatch (Just nty) ts
     = -- if the return type of a thing in ts doesn't match nty, drop it
       filterM (match nty . map (map type)) ts
 
+data QVar : Type where
+
 nextVar : {auto q : Ref QVar Int} ->
           FC -> Core ClosedTerm
 nextVar fc
@@ -81,19 +88,17 @@ mutual
                 (namedargs : List (Name, WithFC RawImp)) ->
                 Core ClosedTerm
   -- unnamed takes priority
-  processArgs con fn (NBind _ x (Pi _ _ Explicit ty) sc) (e :: exps) autos named
+  processArgs con fn (VBind _ x (Pi _ c Explicit ty) sc) (e :: exps) autos named
      = do e' <- mkTerm e.val (Just ty)
           defs <- get Ctxt
-          processArgs con (App e.fc fn e')
-                      !(sc defs (toClosure defaultOpts Env.empty e'))
+          processArgs con (App e.fc fn c e') !(expand !(sc (nf Env.empty e')))
                       exps autos named
-  processArgs con fn (NBind _ x (Pi _ _ Explicit ty) sc) [] autos named
+  processArgs con fn (VBind _ x (Pi _ c Explicit ty) sc) [] autos named
      = do defs <- get Ctxt
           case findNamed x named of
             Just ((_, e), named') =>
                do e' <- mkTerm e.val (Just ty)
-                  processArgs con (App e.fc fn e')
-                              !(sc defs (toClosure defaultOpts Env.empty e'))
+                  processArgs con (App e.fc fn c e') !(expand !(sc (nf Env.empty e')))
                               [] autos named'
             Nothing => -- Expected an explicit argument, but only implicits left
                        do let False = con
@@ -103,39 +108,36 @@ mutual
                           let True = null autos && null named
                             | False => badClause fn [] autos named -- unexpected arguments
                           pure fn
-  processArgs con fn (NBind _ x (Pi _ _ Implicit ty) sc) exps autos named
+  processArgs con fn (VBind _ x (Pi _ c Implicit ty) sc) exps autos named
      = do defs <- get Ctxt
           case findNamed x named of
             Nothing => do let fc = getLoc fn
                           e' <- nextVar fc
-                          processArgs con (App fc fn e')
-                                      !(sc defs (toClosure defaultOpts Env.empty e'))
+                          processArgs con (App fc fn c e')
+                                      !(expand !(sc (nf Env.empty e')))
                                       exps autos named
             Just ((_, e), named') =>
                do e' <- mkTerm e.val (Just ty)
-                  processArgs con (App e.fc fn e')
-                              !(sc defs (toClosure defaultOpts Env.empty e'))
+                  processArgs con (App e.fc fn c e') !(expand !(sc (nf Env.empty e')))
                               exps autos named'
-  processArgs con fn (NBind _ x (Pi _ _ AutoImplicit ty) sc) exps autos named
+  processArgs con fn (VBind _ x (Pi _ c AutoImplicit ty) sc) exps autos named
      = do defs <- get Ctxt
           case autos of
                (e :: autos') => -- unnamed takes priority
                    do e' <- mkTerm e.val (Just ty)
-                      processArgs con (App e.fc fn e')
-                                  !(sc defs (toClosure defaultOpts Env.empty e'))
+                      processArgs con (App e.fc fn c e') !(expand !(sc (nf Env.empty e')))
                                   exps autos' named
                [] =>
                   case findNamed x named of
                      Nothing =>
                         do let fc = getLoc fn
                            e' <- nextVar fc
-                           processArgs con (App fc fn e')
-                                       !(sc defs (toClosure defaultOpts Env.empty e'))
+                           processArgs con (App fc fn c e')
+                                       !(expand !(sc (nf Env.empty e')))
                                        exps [] named
                      Just ((_, e), named') =>
                         do e' <- mkTerm e.val (Just ty)
-                           processArgs con (App e.fc fn e')
-                                       !(sc defs (toClosure defaultOpts Env.empty e'))
+                           processArgs con (App e.fc fn c e') !(expand !(sc (nf Env.empty e')))
                                        exps [] named'
   processArgs _ fn _ [] [] [] = pure fn
   processArgs _ fn _ (x :: _) autos named
@@ -146,7 +148,7 @@ mutual
   buildApp : {auto c : Ref Ctxt Defs} ->
              {auto s : Ref Syn SyntaxInfo} ->
              {auto q : Ref QVar Int} ->
-             FC -> Name -> Maybe ClosedClosure ->
+             FC -> Name -> Maybe (Glued [<]) ->
              (expargs : List (WithFC RawImp)) ->
              (autoargs : List (WithFC RawImp)) ->
              (namedargs : List (Name, WithFC RawImp)) ->
@@ -158,13 +160,9 @@ mutual
                throw (GenericMsg fc "Can't deal with \{show n} in impossible clauses yet")
 
            gdefs <- lookupNameBy id n (gamma defs)
-           mty' <- traverseOpt (evalClosure defs) mty
-           [(n', i, gdef)] <- dropNoMatch mty' gdefs
-              | [] => if length gdefs == 0
-                        then undefinedName fc n
-                        else throw $ GenericMsg fc "\{show n} does not match expected type"
-              | ts => throw $ AmbiguousName fc (map fst ts)
-           tynf <- nf defs Env.empty (type gdef)
+           [(n', i, gdef)] <- dropNoMatch !(traverseOpt expand mty) gdefs
+              | ts => ambiguousName fc n (map fst ts)
+           tynf <- expand !(nf Env.empty (type gdef))
            -- #899 we need to make sure that type & data constructors are marked
            -- as such so that the coverage checker actually uses the matches in
            -- `impossible` branches to generate parts of the case tree.
@@ -179,7 +177,7 @@ mutual
   mkTerm : {auto c : Ref Ctxt Defs} ->
            {auto s : Ref Syn SyntaxInfo} ->
            {auto q : Ref QVar Int} ->
-           RawImp -> Maybe ClosedClosure ->
+           RawImp -> Maybe (Glued [<]) ->
            Core ClosedTerm
   mkTerm tm mty = go tm [] [] []
     where
@@ -211,15 +209,15 @@ mutual
           isValidPrimType : Core Bool
           isValidPrimType
             = do defs <- get Ctxt
-                 Just ty <- traverseOpt (evalClosure defs) mty
+                 Just ty <- traverseOpt expand mty
                    | _ => pure False
                  case (primType c, ty) of
-                      (Nothing, NType {}) => pure True
-                      (Just t1, NPrimVal _ (PrT t2)) => pure (t1 == t2)
+                      (Nothing, VType {}) => pure True
+                      (Just t1, VPrimVal _ (PrT t2)) => pure (t1 == t2)
                       _ => pure False
       go (IType fc) _ _ _
           = do defs <- get Ctxt
-               Just (NType {}) <- traverseOpt (evalClosure defs) mty
+               Just (VType {}) <- traverseOpt expand mty
                  | _ => throw $ GenericMsg fc "Type does not match expected type"
                pure (TType fc $ MN "top" 0)
       -- We're taking UniqueDefault here, _and_ we're falling through to error otherwise, which is sketchy.
@@ -247,8 +245,8 @@ getImpossibleTerm env nest tm
   where
     addEnv : {vars : _} ->
              FC -> Env Term vars -> List RawImp
-    addEnv fc [] = []
-    addEnv fc (b :: env) =
+    addEnv fc [<] = []
+    addEnv {vars = _ :< _} fc (env :< b) =
        if isLet b
           then addEnv fc env
           else Implicit fc False :: addEnv fc env
diff --git a/src/TTImp/Interactive/CaseSplit.idr b/src/TTImp/Interactive/CaseSplit.idr
index 2a34be93414..978b5235919 100644
--- a/src/TTImp/Interactive/CaseSplit.idr
+++ b/src/TTImp/Interactive/CaseSplit.idr
@@ -3,7 +3,9 @@ module TTImp.Interactive.CaseSplit
 import Core.Env
 import Core.Metadata
 import Core.UnifyState
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -65,12 +67,12 @@ findTyName : {vars : _} ->
 findTyName defs env n (Bind _ x b@(PVar _ c p ty) sc)
       -- Take the first one, which is the most recently bound
     = if n == x
-         then do tynf <- nf defs env ty
+         then do tynf <- expand !(nf env ty)
                  case tynf of
-                      NTCon _ tyn _ _ => pure $ Just tyn
+                      VTCon _ tyn _ _ => pure $ Just tyn
                       _ => pure Nothing
-         else findTyName defs (b :: env) n sc
-findTyName defs env n (Bind _ x b sc) = findTyName defs (b :: env) n sc
+         else findTyName defs (env :< b) n sc
+findTyName defs env n (Bind _ x b sc) = findTyName defs (Env.bind env b) n sc
 findTyName _ _ _ _ = pure Nothing
 
 getDefining : Term vars -> Maybe Name
@@ -114,18 +116,19 @@ findAllVars (Bind _ x (PLet {}) sc)
 findAllVars t = toList (dropNS <$> getDefining t)
 
 export
-explicitlyBound : Defs -> ClosedNF -> Core (List Name)
-explicitlyBound defs (NBind fc x (Pi {}) sc)
+explicitlyBound : {auto c : Ref Ctxt Defs} ->
+                  Defs -> ClosedNF -> Core (List Name)
+explicitlyBound defs (VBind fc x (Pi {}) sc)
     = pure $ x :: !(explicitlyBound defs
-                    !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))))
+                    !(expand !(sc (pure (VErased fc Placeholder)))))
 explicitlyBound defs _ = pure []
 
 export
 getEnvArgNames : {auto c : Ref Ctxt Defs} ->
                  Defs -> Nat -> ClosedNF -> Core (List String)
 getEnvArgNames defs Z sc = getArgNames defs !(explicitlyBound defs sc) [] Env.empty sc
-getEnvArgNames defs (S k) (NBind fc n _ sc)
-    = getEnvArgNames defs k !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
+getEnvArgNames defs (S k) (VBind fc n _ sc)
+    = getEnvArgNames defs k !(expand !(sc (pure (VErased fc Placeholder))))
 getEnvArgNames defs n ty = pure []
 
 expandCon : {auto c : Ref Ctxt Defs} ->
@@ -137,7 +140,7 @@ expandCon fc usedvars con
          pure (apply (IVar fc con)
                 (map (IBindVar fc . UN . Basic)
                      !(getArgNames defs [] usedvars Env.empty
-                                   !(nf defs Env.empty ty))))
+                                   !(expand !(nf Env.empty ty)))))
 
 updateArg : {auto c : Ref Ctxt Defs} ->
             List Name -> -- all the variable names
@@ -264,7 +267,7 @@ mkCase {c} {u} fn orig lhs_raw
                -- be an erased name in a case block (which will be bound elsewhere
                -- once split and turned into a pattern)
                (lhs, _) <- elabTerm {c} {m} {u}
-                                    fn (InLHS erased) [] (MkNested [])
+                                    fn (InLHS erased) [] (NestedNames.empty)
                                     Env.empty (IBindHere (getFC lhs_raw) PATTERN lhs_raw)
                                     Nothing
                -- Revert all public back to false
@@ -282,9 +285,8 @@ mkCase {c} {u} fn orig lhs_raw
                   put UST ust
                   case err of
                        WhenUnifying _ gam env l r err
-                         => do let defs = { gamma := gam } defs
-                               if !(impossibleOK defs !(nf defs env l)
-                                                      !(nf defs env r))
+                         => do if !(impossibleOK !(expand !(nf env l))
+                                                 !(expand !(nf env r)))
                                   then pure (Impossible lhs_raw)
                                   else pure Invalid
                        _ => pure Invalid)
@@ -325,7 +327,16 @@ getSplitsLHS fc envlen lhs_in n
 
          let Just idx = getNameID fn (gamma defs)
              | Nothing => undefinedName fc fn
+
+         gdef <- lookupCtxtExact (Resolved idx) (gamma defs)
+         updateDef (Resolved idx)
+            (\d => case d of
+                        Function fi ct rt cs =>
+                          Just (Function ({ alwaysReduce := False } fi) ct rt cs)
+                        _ => Just d)
          cases <- traverse (mkCase idx rawlhs) trycases
+         updateDef (Resolved idx) $ const $ definition <$> gdef
+
          log "interaction.casesplit" 3 $ "Found cases: " ++ show cases
 
          pure (combine cases [])
diff --git a/src/TTImp/Interactive/ExprSearch.idr b/src/TTImp/Interactive/ExprSearch.idr
index 89e9bd81215..f7f0cb159e3 100644
--- a/src/TTImp/Interactive/ExprSearch.idr
+++ b/src/TTImp/Interactive/ExprSearch.idr
@@ -11,12 +11,13 @@ module TTImp.Interactive.ExprSearch
 -- depth.
 
 import Core.AutoSearch
-import Core.Case.CaseTree
 import Core.Env
 import Core.LinearCheck
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -27,7 +28,9 @@ import TTImp.TTImp.Functor
 import TTImp.Unelab
 import TTImp.Utils
 
-import Libraries.Data.List.SizeOf
+import Data.SnocList
+
+import Libraries.Data.SnocList.SizeOf
 import Libraries.Data.Tap
 import Libraries.Data.WithDefault
 
@@ -141,18 +144,18 @@ getAllEnv : {vars : _} -> FC ->
             SizeOf done ->
             Env Term vars ->
             -- TODO should be `vars <>< done`
-            List (Term (done ++ vars), Term (done ++ vars))
-getAllEnv fc done [] = []
-getAllEnv {vars = v :: vs} {done} fc p (b :: env)
-   = let rest = getAllEnv fc (sucR p) env
+            List (Term (Scope.addInner vars done), Term (Scope.addInner vars done))
+getAllEnv fc done [<] = []
+getAllEnv {vars = vs :< v} {done} fc p (env :< b)
+   = let rest = getAllEnv fc (sucL p) env
          0 var = mkIsVar (hasLength p)
          usable = usableName v in
          if usable
             then (Local fc Nothing _ var,
-                     rewrite appendAssociative done [v] vs in
-                        weakenNs (sucR p) (binderType b)) ::
-                             rewrite appendAssociative done [v] vs in rest
-            else rewrite appendAssociative done [v] vs in rest
+                     rewrite sym (appendAssociative vs (Scope.single v) done) in
+                        weakenNs (sucL p) (binderType b)) ::
+                             rewrite sym (appendAssociative vs (Scope.single v) done) in rest
+            else rewrite sym (appendAssociative vs (Scope.single v) done) in rest
   where
     usableName : Name -> Bool
     usableName (UN _) = True
@@ -164,7 +167,7 @@ searchIfHole : {vars : _} ->
                {auto u : Ref UST UState} ->
                FC -> SearchOpts -> List Name -> ClosedTerm ->
                Env Term vars -> ArgInfo vars ->
-               Core (Search (Term vars, ExprDefs))
+               Core (Search (RigCount, Term vars, ExprDefs))
 searchIfHole fc opts hints topty env arg
     = case depth opts of
            Z => noResult
@@ -175,7 +178,8 @@ searchIfHole fc opts hints topty env arg
                  Just gdef <- lookupCtxtExact (Resolved hole) (gamma defs)
                       | Nothing => noResult
                  let Hole _ _ = definition gdef
-                      | _ => one (!(normaliseHoles defs env (metaApp arg)), [])
+                      | _ => one (fst (metaApp arg),
+                                  !(normaliseHoles env (snd $ metaApp arg)), [])
                                 -- already solved
                  res <- search fc rig ({ depth := k,
                                          inArg := True } opts) hints
@@ -184,7 +188,8 @@ searchIfHole fc opts hints topty env arg
                  -- expression for its environment, so we need to apply it to
                  -- the current environment to use it as an argument.
                  traverse (\(tm, ds) =>
-                    pure (!(normaliseHoles defs env
+                    pure (fst (metaApp arg),
+                          !(normaliseHoles env
                              (applyTo fc (embed tm) env)), ds)) res
 
 explicit : ArgInfo vars -> Bool
@@ -249,16 +254,16 @@ mkCandidates : {vars : _} ->
                {auto c : Ref Ctxt Defs} ->
                {auto u : Ref UST UState} ->
                FC -> Term vars -> ExprDefs ->
-               List (Search (Term vars, ExprDefs)) ->
+               List (Search (RigCount, Term vars, ExprDefs)) ->
                Core (Search (Term vars, ExprDefs))
 -- out of arguments, we have a candidate
 mkCandidates fc f ds [] = one (f, ds)
 -- argument has run out of ideas, we're stuck
 mkCandidates fc f ds ([] :: argss) = noResult
 -- make a candidate from 'f arg' applied to the rest of the arguments
-mkCandidates fc f ds (((arg, ds') :: next) :: argss)
+mkCandidates fc f ds (((c, arg, ds') :: next) :: argss)
     = firstSuccess
-           [mkCandidates fc (App fc f arg) (ds ++ ds') argss,
+           [mkCandidates fc (App fc f c arg) (ds ++ ds') argss,
             do next' <- next
                mkCandidates fc f ds (next' :: argss)]
 
@@ -282,7 +287,7 @@ searchName fc rigc opts hints env target topty (n, ndef)
          let True = usableName (fullname ndef)
              | _ => noResult
          log "interaction.search" 5 $ "Trying " ++ show (fullname ndef)
-         nty <- nf defs env (embed ty)
+         nty <- expand !(nf env (embed ty))
          (args, appTy) <- mkArgs fc rigc env nty
          logNF "interaction.search" 5 "Target" env target
          logNF "interaction.search" 10 "App type" env appTy
@@ -341,7 +346,7 @@ searchNames fc rig opts hints env ty topty (n :: ns)
          checkTimer
          vis <- traverse (visible (gamma defs) (currentNS defs :: nestedNS defs)) (n :: ns)
          let visns = mapMaybe id vis
-         nfty <- nf defs env ty
+         nfty <- expand !(nf env ty)
          logTerm "interaction.search" 10 ("Searching " ++ show (map fst visns) ++ " for ") ty
          getSuccessful fc rig opts False env ty topty
             (map (searchName fc rig opts hints env nfty topty) visns)
@@ -367,7 +372,7 @@ tryRecursive fc rig opts hints env ty topty rdata
               Nothing => noResult
               Just def =>
                 do res <- searchName fc rig ({ recData := Nothing } opts) hints
-                                     env !(nf defs env ty)
+                                     env !(expand !(nf env ty))
                                      topty (recname rdata, def)
                    res' <- traverse (\ (t, ds) => pure (!(toFullNames t), ds)) res
                    filter (structDiffTm (lhsapp rdata)) res'
@@ -383,7 +388,7 @@ tryRecursive fc rig opts hints env ty topty rdata
       argDiff (Ref _ _ fn) (Ref _ _ fn') = fn /= fn'
       argDiff (Bind {}) _ = False
       argDiff _ (Bind {}) = False
-      argDiff (App _ f a) (App _ f' a')
+      argDiff (App _ f _ a) (App _ f' _ a')
          = structDiff f f' || structDiff a a'
       argDiff (PrimVal _ c) (PrimVal _ c') = c /= c'
       argDiff (Erased {}) _ = False
@@ -420,7 +425,7 @@ tryRecursive fc rig opts hints env ty topty rdata
 
 -- A local is usable as long as its type isn't a hole
 usableLocal : FC -> Env Term vars -> NF vars -> Bool
-usableLocal loc env (NApp _ (NMeta {}) args) = False
+usableLocal loc env (VMeta{}) = False
 usableLocal loc _ _ = True
 
 searchLocalWith : {vars : _} ->
@@ -436,9 +441,9 @@ searchLocalWith fc nofn rig opts hints env [] ty topty
 searchLocalWith {vars} fc nofn rig opts hints env ((p, pty) :: rest) ty topty
     = do defs <- get Ctxt
          checkTimer
-         nty <- nf defs env ty
+         nty <- expand !(nf env ty)
          getSuccessful fc rig opts False env ty topty
-                       [findPos defs p id !(nf defs env pty) nty,
+                       [findPos defs p id !(expand !(nf env pty)) nty,
                         searchLocalWith fc nofn rig opts hints env rest ty
                                         topty]
   where
@@ -471,7 +476,7 @@ searchLocalWith {vars} fc nofn rig opts hints env ((p, pty) :: rest) ty topty
     findPos : Defs -> Term vars ->
               (Term vars -> Term vars) ->
               NF vars -> NF vars -> Core (Search (Term vars, ExprDefs))
-    findPos defs prf f x@(NTCon pfc pn _ [(fc1, xty), (fc2, yty)]) target
+    findPos defs prf f x@(VTCon pfc pn _ [< MkSpineEntry fc1 xc xty, MkSpineEntry fc2 yc yty]) target
         = getSuccessful fc rig opts False env ty topty
               [findDirect defs prf f x target,
                  (do fname <- maybe (throw (InternalError "No fst"))
@@ -481,23 +486,24 @@ searchLocalWith {vars} fc nofn rig opts hints env ((p, pty) :: rest) ty topty
                                     pure
                                     !sndName
                      if !(isPairType pn)
-                        then do empty <- clearDefs defs
-                                xtytm <- quote empty env xty
-                                ytytm <- quote empty env yty
+                        then do xty' <- xty
+                                yty' <- yty
+                                xtytm <- quote env xty'
+                                ytytm <- quote env yty'
                                 getSuccessful fc rig opts False env ty topty
-                                  [(do xtynf <- evalClosure defs xty
+                                  [(do xtynf <- expand xty'
                                        findPos defs prf
                                          (\arg => applyStackWithFC (Ref fc Func fname)
-                                                          [(fc1, xtytm),
-                                                           (fc2, ytytm),
-                                                           (fc, f arg)])
+                                                          [(fc1, erased, xtytm),
+                                                           (fc2, erased, ytytm),
+                                                           (fc, top, f arg)])
                                          xtynf target),
-                                   (do ytynf <- evalClosure defs yty
+                                   (do ytynf <- expand yty'
                                        findPos defs prf
                                            (\arg => applyStackWithFC (Ref fc Func sname)
-                                                          [(fc1, xtytm),
-                                                           (fc2, ytytm),
-                                                           (fc, f arg)])
+                                                          [(fc1, erased, xtytm),
+                                                           (fc2, erased, ytytm),
+                                                           (fc, top, f arg)])
                                            ytynf target)]
                          else noResult)]
     findPos defs prf f nty target = findDirect defs prf f nty target
@@ -533,7 +539,7 @@ makeHelper fc rig opts env letty targetty ((locapp, ds) :: next)
          intn <- genVarName "cval"
          helpern_in <- genCaseName "search"
          helpern <- inCurrentNS helpern_in
-         let env' = Lam fc top Explicit letty :: env
+         let env' = Env.bind env $ Lam fc top Explicit letty
          scopeMeta <- metaVar fc top env' helpern
                              (weaken targetty)
          let scope = toApp scopeMeta
@@ -541,7 +547,7 @@ makeHelper fc rig opts env letty targetty ((locapp, ds) :: next)
          -- Apply the intermediate result to the helper function we're
          -- about to generate.
          let def = App fc (Bind fc intn (Lam fc top Explicit letty) scope)
-                          locapp
+                          top locapp
 
          logTermNF "interaction.search" 10 "Binding def" env def
          defs <- get Ctxt
@@ -588,27 +594,24 @@ tryIntermediateWith fc rig opts hints env [] ty topty = noResult
 tryIntermediateWith fc rig opts hints env ((p, pty) :: rest) ty topty
     = do defs <- get Ctxt
          getSuccessful fc rig opts False env ty topty
-                       [applyLocal defs p !(nf defs env pty) ty,
+                       [applyLocal defs p !(expand !(nf env pty)) ty,
                         tryIntermediateWith fc rig opts hints env rest ty
                                             topty]
   where
     matchable : Defs -> NF vars -> Core Bool
-    matchable defs (NBind fc x (Pi {}) sc)
-        = matchable defs !(sc defs (toClosure defaultOpts env
-                                              (Erased fc Placeholder)))
-    matchable defs (NTCon {}) = pure True
+    matchable defs (VBind fc x (Pi {}) sc)
+        = matchable defs !(expand !(sc (pure (VErased fc Placeholder))))
+    matchable defs (VTCon {}) = pure True
     matchable _ _ = pure False
 
     applyLocal : Defs -> Term vars ->
                  NF vars -> Term vars -> Core (Search (Term vars, ExprDefs))
-    applyLocal defs tm locty@(NBind _ x (Pi fc' _ _ _) sc) targetty
+    applyLocal defs tm locty@(VBind _ x (Pi fc' _ _ _) sc) targetty
         = -- If the local has a function type, and the return type is
           -- something we can pattern match on (so, NTCon) then apply it,
           -- let bind the result, and try to generate a definition for
           -- the scope of the let binding
-          do True <- matchable defs
-                           !(sc defs (toClosure defaultOpts env
-                                                (Erased fc Placeholder)))
+          do True <- matchable defs !(expand !(sc (pure (VErased fc Placeholder))))
                  | False => noResult
              intnty <- genVarName "cty"
              u <- uniVar fc
@@ -648,7 +651,7 @@ tryIntermediateRec fc rig opts hints env ty topty (Just rd)
     = do defs <- get Ctxt
          Just rty <- lookupTyExact (recname rd) (gamma defs)
               | Nothing => noResult
-         True <- isSingleCon defs !(nf defs Env.empty rty)
+         True <- isSingleCon defs !(expand !(nf Env.empty rty))
               | _ => noResult
          intnty <- genVarName "cty"
          u <- uniVar fc
@@ -662,10 +665,9 @@ tryIntermediateRec fc rig opts hints env ty topty (Just rd)
          makeHelper fc rig opts' env letty ty recsearch
   where
     isSingleCon : Defs -> ClosedNF -> Core Bool
-    isSingleCon defs (NBind fc x (Pi {}) sc)
-        = isSingleCon defs !(sc defs (toClosure defaultOpts Env.empty
-                                              (Erased fc Placeholder)))
-    isSingleCon defs (NTCon _ n _ _)
+    isSingleCon defs (VBind fc x (Pi {}) sc)
+        = isSingleCon defs !(expand !(sc (pure (VErased fc Placeholder))))
+    isSingleCon defs (VTCon _ n _ _)
         = do Just (TCon _ _ _ _ _ (Just [con]) _) <- lookupDefExact n (gamma defs)
                   | _ => pure False
              pure True
@@ -678,7 +680,7 @@ searchType : {vars : _} ->
              ClosedTerm ->
              Nat -> Term vars -> Core (Search (Term vars, ExprDefs))
 searchType fc rig opts hints env topty (S k) (Bind bfc n b@(Pi fc' c info ty) sc)
-    = do let env' : Env Term (n :: _) = b :: env
+    = do let env' : Env Term (_ :< n) = Env.bind env b
          log "interaction.search" 10 $ "Introduced lambda, search for " ++ show sc
          scVal <- searchType fc rig opts hints env' topty k sc
          pure (map (\ (sc, ds) => (Bind bfc n (Lam fc' c info ty) sc, ds)) scVal)
@@ -687,8 +689,8 @@ searchType {vars} fc rig opts hints env topty Z (Bind bfc n b@(Pi fc' c info ty)
       getSuccessful fc rig opts False env ty topty
            [searchLocal fc rig opts hints env (Bind bfc n b sc) topty,
             (do defs <- get Ctxt
-                let n' = UN $ Basic !(getArgName defs n [] (toList vars) !(nf defs env ty))
-                let env' : Env Term (n' :: _) = b :: env
+                let n' = UN $ Basic !(getArgName defs n [] (toList vars) !(nf env ty))
+                let env' : Env Term (_ :< n') = Env.bind env b
                 let sc' = compat sc
                 log "interaction.search" 10 $ "Introduced lambda, search for " ++ show sc'
                 scVal <- searchType fc rig opts hints env' topty Z sc'
@@ -750,7 +752,7 @@ searchHole : {auto c : Ref Ctxt Defs} ->
              Nat -> ClosedTerm ->
              Defs -> GlobalDef -> Core (Search (ClosedTerm, ExprDefs))
 searchHole fc rig opts hints n locs topty defs glob
-    = do searchty <- normalise defs Env.empty (type glob)
+    = do searchty <- normalise Env.empty (type glob)
          logTerm "interaction.search" 10 "Normalised type" searchty
          checkTimer
          searchType fc rig opts hints Env.empty topty locs searchty
@@ -765,7 +767,7 @@ search fc rig opts hints topty n_in
                    case definition gdef of
                         Hole locs _ => searchHole fc rig opts hints n locs topty defs gdef
                         BySearch {} => searchHole fc rig opts hints n
-                                                   !(getArity defs Env.empty (type gdef))
+                                                   !(getArity Env.empty (type gdef))
                                                    topty defs gdef
                         _ => do log "interaction.search" 10 $ show n_in ++ " not a hole"
                                 throw (InternalError $ "Not a hole: " ++ show n ++ " in " ++
@@ -786,7 +788,7 @@ getLHSData : {auto c : Ref Ctxt Defs} ->
              Defs -> Maybe ClosedTerm -> Core (Maybe RecData)
 getLHSData defs Nothing = pure Nothing
 getLHSData defs (Just tm)
-    = pure $ getLHS !(toFullNames !(normaliseHoles defs Env.empty tm))
+    = pure $ getLHS !(toFullNames !(normaliseHoles Env.empty tm))
   where
     getLHS : {vars : _} -> Term vars -> Maybe RecData
     getLHS (Bind _ _ (PVar {}) sc) = getLHS sc
@@ -807,10 +809,10 @@ firstLinearOK fc [] = noResult
 firstLinearOK fc ((t, ds) :: next)
     = handleUnify
             (do unless (isNil ds) $
-                   traverse_ (processDecl [InCase] (MkNested []) Env.empty) ds
-                ignore $ linearCheck fc linear False Env.empty t
+                   traverse_ (processDecl [InCase] (NestedNames.empty) Env.empty) ds
+                linearCheck fc linear Env.empty t
                 defs <- get Ctxt
-                nft <- normaliseHoles defs Env.empty t
+                nft <- normaliseHoles Env.empty t
                 raw <- unelab Env.empty !(toFullNames nft)
                 pure (map rawName raw :: firstLinearOK fc !next))
             (\err =>
@@ -832,8 +834,8 @@ exprSearchOpts opts fc n_in hints
          -- the REPL does this step, but doing it here too because
          -- expression search might be invoked some other way
          let Hole _ _ = definition gdef
-             | PMDef pi [] (STerm _ tm) _ _
-                 => do raw <- unelab Env.empty !(toFullNames !(normaliseHoles defs Env.empty tm))
+             | Function pi tm _ _
+                 => do raw <- unelab Env.empty !(toFullNames !(normaliseHoles Env.empty tm))
                        one (map rawName raw)
              | _ => throw (GenericMsg fc "Name is already defined")
          lhs <- findHoleLHS !(getFullName (Resolved idx))
diff --git a/src/TTImp/Interactive/GenerateDef.idr b/src/TTImp/Interactive/GenerateDef.idr
index e47fb662fc0..79c2d70c2f2 100644
--- a/src/TTImp/Interactive/GenerateDef.idr
+++ b/src/TTImp/Interactive/GenerateDef.idr
@@ -3,9 +3,12 @@ module TTImp.Interactive.GenerateDef
 -- Attempt to generate a complete definition from a type
 
 import Core.Env
+import Core.Evaluate
 import Core.Metadata
 import Core.Unify
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -57,7 +60,7 @@ expandClause : {auto c : Ref Ctxt Defs} ->
                Core (Search (List ImpClause))
 expandClause loc opts n c
     = do c <- uniqueRHS c
-         Right clause <- checkClause linear Private PartialOK False n [] (MkNested []) Env.empty c
+         Right clause <- checkClause linear Private PartialOK False n [] (NestedNames.empty) Env.empty c
             | Left err => noResult -- TODO: impossible clause, do something
                                    -- appropriate
 
@@ -152,7 +155,7 @@ generateSplits loc opts fn (ImpossibleClause fc lhs) = pure []
 generateSplits loc opts fn (WithClause fc lhs rig wval prf flags cs) = pure []
 generateSplits loc opts fn (PatClause fc lhs rhs)
     = do (lhstm, _) <-
-                elabTerm fn (InLHS linear) [] (MkNested []) Env.empty
+                elabTerm fn (InLHS linear) [] (NestedNames.empty) Env.empty
                          (IBindHere loc PATTERN lhs) Nothing
          let splitnames =
                  if ltor opts then splittableNames lhs
@@ -222,7 +225,7 @@ makeDefFromType loc opts n envlen ty
          (do defs <- branch
              meta <- get MD
              ust <- get UST
-             argns <- getEnvArgNames defs envlen !(nf defs Env.empty ty)
+             argns <- getEnvArgNames defs envlen !(expand !(nf Env.empty ty))
              -- Need to add implicit patterns for the outer environment.
              -- We won't try splitting on these
              let pre_env = replicate envlen (Implicit loc True)
diff --git a/src/TTImp/Interactive/Intro.idr b/src/TTImp/Interactive/Intro.idr
index 241a782117a..dc869b77e70 100644
--- a/src/TTImp/Interactive/Intro.idr
+++ b/src/TTImp/Interactive/Intro.idr
@@ -4,6 +4,8 @@ import Core.Env
 import Core.Metadata
 import Core.TT.Views
 import Core.Unify
+import Core.Evaluate.Normalise
+import Core.Evaluate
 
 import Idris.Desugar
 import Idris.REPL.Opts
@@ -16,6 +18,8 @@ import TTImp.TTImp
 import TTImp.Unelab
 import TTImp.Utils
 
+import Data.SnocList
+
 import Libraries.Data.NatSet
 
 %default covering
@@ -48,20 +52,18 @@ parameters
     -- for now we only handle types with a unique constructor
     let TCon _ _ _ _ _ cs _ = definition gdef
       | _ => pure []
-    let gty = gnf env ty
+    gty <- nf env ty
     ics <- for (fromMaybe [] cs) $ \ cons => do
       Just gdef <- lookupCtxtExact cons (gamma defs)
         | _ => pure Nothing
       let nargs = lengthExplicitPi $ fst $ snd $ underPis (-1) Env.empty (type gdef)
       new_hole_names <- uniqueHoleNames defs nargs (nameRoot hole)
-      let new_holes = PHole replFC True <$> new_hole_names
-      let pcons = papply replFC (PRef replFC cons) new_holes
+      let new_holes = IHole replFC <$> new_hole_names
+      let icons = apply (IVar replFC cons) new_holes
       res <- catch
         (do -- We're desugaring it to the corresponding TTImp
-            icons <- desugar AnyExpr (toList lhsCtxt) pcons
-            ccons <- checkTerm hidx {-is this correct?-} InExpr [] (MkNested []) env icons gty
-            newdefs <- get Ctxt
-            ncons <- normaliseHoles newdefs env ccons
+            ccons <- checkTerm hidx {-is this correct?-} InExpr [] (NestedNames.empty) env icons gty
+            ncons <- normaliseHoles env ccons
             icons <- unelab env ncons
             pure (Just icons))
         (\ _ => pure Nothing)
diff --git a/src/TTImp/Interactive/MakeLemma.idr b/src/TTImp/Interactive/MakeLemma.idr
index f854a59af8f..d88b11d5c32 100644
--- a/src/TTImp/Interactive/MakeLemma.idr
+++ b/src/TTImp/Interactive/MakeLemma.idr
@@ -2,6 +2,7 @@ module TTImp.Interactive.MakeLemma
 
 import Core.Env
 import Core.Metadata
+import Core.Evaluate
 
 import Idris.Syntax
 
@@ -10,6 +11,8 @@ import TTImp.TTImp
 import TTImp.TTImp.Functor
 import TTImp.Utils
 
+import Data.SnocList
+
 %default covering
 
 used : RigCount -> Bool
@@ -43,9 +46,9 @@ getArgs : {vars : _} ->
           Core (List (Name, Maybe Name, PiInfo RawImp, RigCount, RawImp), RawImp)
 getArgs {vars} env (S k) (Bind _ x b@(Pi _ c _ ty) sc)
     = do defs <- get Ctxt
-         ty' <- map (map rawName) $ unelab env !(normalise defs env ty)
+         ty' <- map (map rawName) $ unelab env !(normalise env ty)
          let x' = UN $ Basic !(uniqueBasicName defs (toList $ map nameRoot vars) (nameRoot x))
-         (sc', ty) <- getArgs (b :: env) k (compat {n = x'} sc)
+         (sc', ty) <- getArgs (env :< b) k (compat {n = x'} sc)
          -- Don't need to use the name if it's not used in the scope type
          let mn = if c == top
                        then case shrink sc (Drop Refl) of
@@ -58,7 +61,7 @@ getArgs {vars} env (S k) (Bind _ x b@(Pi _ c _ ty) sc)
          pure ((x, mn, p', c, ty') :: sc', ty)
 getArgs env k ty
       = do defs <- get Ctxt
-           ty' <- map (map rawName) $ unelab env !(normalise defs env ty)
+           ty' <- map (map rawName) $ unelab env !(normalise env ty)
            pure ([], ty')
 
 mkType : FC -> List (Name, Maybe Name, PiInfo RawImp, RigCount, RawImp) ->
@@ -86,5 +89,5 @@ makeLemma : {auto c : Ref Ctxt Defs} ->
             Core (RawImp, RawImp)
 makeLemma loc n nlocs ty
     = do defs <- get Ctxt
-         (args, ret) <- getArgs Env.empty nlocs !(normalise defs Env.empty ty)
+         (args, ret) <- getArgs Env.empty nlocs !(normalise Env.empty ty)
          pure (mkType loc args ret, mkApp loc n args)
diff --git a/src/TTImp/PartialEval.idr b/src/TTImp/PartialEval.idr
deleted file mode 100644
index 1b1940f7a06..00000000000
--- a/src/TTImp/PartialEval.idr
+++ /dev/null
@@ -1,718 +0,0 @@
-module TTImp.PartialEval
-
-import Core.Env
-import Core.Hash
-import Core.Metadata
-import Core.Value
-import Core.UnifyState
-
-import Idris.REPL.Opts
-import Idris.Syntax
-
-import TTImp.Elab.Check
-import TTImp.TTImp
-import TTImp.TTImp.Functor
-import TTImp.TTImp.Traversals
-import TTImp.Unelab
-
-import Protocol.Hex
-
-import Libraries.Data.NameMap
-import Libraries.Data.NatSet
-import Libraries.Data.WithDefault
-import Libraries.Data.SnocList.SizeOf
-
-%default covering
-
-data ArgMode' tm = Static tm | Dynamic
-
-ArgMode : Type
-ArgMode = ArgMode' ClosedTerm
-
-traverseArgMode : (a -> Core b) -> ArgMode' a -> Core (ArgMode' b)
-traverseArgMode f (Static t) = Static <$> f t
-traverseArgMode f Dynamic = pure Dynamic
-
-covering
-Show a => Show (ArgMode' a) where
-  show (Static tm) = "Static " ++ show tm
-  show Dynamic = "Dynamic"
-
-
-getStatic : ArgMode -> Maybe ClosedTerm
-getStatic Dynamic = Nothing
-getStatic (Static t) = Just t
-
-specialiseTy : {vars : _} ->
-               Nat -> List (Nat, ClosedTerm) -> Term vars -> Term vars
-specialiseTy i specs (Bind fc x (Pi fc' c p ty) sc)
-    = case lookup i specs of
-           Nothing => Bind fc x (Pi fc' c p ty) $ -- easier later if everything explicit
-                        specialiseTy (1 + i) specs sc
-           Just tm => specialiseTy (1 + i) specs (subst (embed tm) sc)
-specialiseTy i specs tm = tm
-
-substLoc : {vs : _} ->
-           Nat -> Term vs -> Term vs -> Term vs
-substLoc i tm (Local fc l idx p)
-    = if i == idx then tm else (Local fc l idx p)
-substLoc i tm (Bind fc x b sc)
-    = Bind fc x (map (substLoc i tm) b) (substLoc (1 + i) (weaken tm) sc)
-substLoc i tm (Meta fc n r args)
-    = Meta fc n r (map (substLoc i tm) args)
-substLoc i tm (App fc f a) = App fc (substLoc i tm f) (substLoc i tm a)
-substLoc i tm (As fc s f a) = As fc s (substLoc i tm f) (substLoc i tm a)
-substLoc i tm (TDelayed fc r d) = TDelayed fc r (substLoc i tm d)
-substLoc i tm (TDelay fc r ty d) = TDelay fc r (substLoc i tm ty) (substLoc i tm d)
-substLoc i tm (TForce fc r d) = TForce fc r (substLoc i tm d)
-substLoc i tm x = x
-
-substLocs : {vs : _} ->
-            List (Nat, Term vs) -> Term vs -> Term vs
-substLocs [] tm = tm
-substLocs ((i, tm') :: subs) tm = substLocs subs (substLoc i tm' tm)
-
-mkSubsts : Nat -> List (Nat, ClosedTerm) ->
-           List (Term vs) -> Term vs -> Maybe (List (Nat, Term vs))
-mkSubsts i specs [] rhs = Just []
-mkSubsts i specs (arg :: args) rhs
-    = do subs <- mkSubsts (1 + i) specs args rhs
-         case lookup i specs of
-              Nothing => Just subs
-              Just tm => case arg of
-                              Local _ _ idx _ =>
-                                   Just ((idx, embed tm) :: subs)
-                              As _ _ (Local _ _ idx1 _) (Local _ _ idx2 _) =>
-                                   Just ((idx1, embed tm) :: (idx2, embed tm) :: subs)
-                              As _ _ _ (Local _ _ idx _) =>
-                                   Just ((idx, embed tm) :: subs)
-                              _ => Nothing
-
--- In the case where all the specialised positions are variables on the LHS,
--- substitute the term in on the RHS
-specPatByVar : List (Nat, ClosedTerm) ->
-                (vs ** (Env Term vs, Term vs, Term vs)) ->
-                Maybe (vs ** (Env Term vs, Term vs, Term vs))
-specPatByVar specs (vs ** (env, lhs, rhs))
-    = do let (fn, args) = getFnArgs lhs
-         psubs <- mkSubsts 0 specs args rhs
-         let lhs' = apply (getLoc fn) fn args
-         pure (vs ** (env, substLocs psubs lhs', substLocs psubs rhs))
-
-specByVar : List (Nat, ClosedTerm) ->
-            List (vs ** (Env Term vs, Term vs, Term vs)) ->
-            Maybe (List (vs ** (Env Term vs, Term vs, Term vs)))
-specByVar specs [] = pure []
-specByVar specs (p :: ps)
-    = do p' <- specPatByVar specs p
-         ps' <- specByVar specs ps
-         pure (p' :: ps')
-
-dropSpec : Nat -> List (Nat, ClosedTerm) -> List a -> List a
-dropSpec i sargs [] = []
-dropSpec i sargs (x :: xs)
-    = case lookup i sargs of
-           Nothing => x :: dropSpec (1 + i) sargs xs
-           Just _ => dropSpec (1 + i) sargs xs
-
-getSpecPats : {auto c : Ref Ctxt Defs} ->
-              {auto u : Ref UST UState} ->
-              FC -> Name ->
-              (fn : Name) -> (stk : List (FC, Term vars)) ->
-              ClosedNF -> -- Type of 'fn'
-              List (Nat, ArgMode) -> -- All the arguments
-              List (Nat, ClosedTerm) -> -- Just the static ones
-              List (vs ** (Env Term vs, Term vs, Term vs)) ->
-              Core (Maybe (List ImpClause))
-getSpecPats fc pename fn stk fnty args sargs pats
-   = do -- First, see if all the specialised positions are variables. If so,
-        -- substitute the arguments directly into the RHS
-        let Nothing = specByVar sargs pats
-            | Just specpats =>
-                   do ps <- traverse (unelabPat pename) specpats
-                      pure (Just ps)
-        -- Otherwise, build a new definition by taking the remaining arguments
-        -- on the lhs, and using the specialised function application on the rhs.
-        -- Then, this will get evaluated on elaboration.
-        dynnames <- mkDynNames args
-        let lhs = apply (IVar fc pename) (map (IBindVar fc) dynnames)
-        rhs <- mkRHSargs fnty (IVar fc fn) dynnames args
-        pure (Just [PatClause fc lhs rhs])
-  where
-    mkDynNames : List (Nat, ArgMode) -> Core (List Name)
-    mkDynNames [] = pure []
-    mkDynNames ((_, Dynamic) :: as) = [| genVarName "_pe" :: mkDynNames as |]
-    mkDynNames (_ :: as) = mkDynNames as
-
-    -- Build a RHS from the type of the function to be specialised, the
-    -- dynamic argument names, and the list of given arguments. We assume
-    -- the latter two correspond appropriately.
-    mkRHSargs : ClosedNF -> RawImp -> List Name -> List (Nat, ArgMode) ->
-                Core RawImp
-    mkRHSargs (NBind _ x (Pi _ _ Explicit _) sc) app (a :: as) ((_, Dynamic) :: ds)
-        = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             mkRHSargs sc' (IApp fc app (IVar fc a)) as ds
-    mkRHSargs (NBind _ x (Pi {}) sc) app (a :: as) ((_, Dynamic) :: ds)
-        = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             mkRHSargs sc' (INamedApp fc app x (IVar fc a)) as ds
-    mkRHSargs (NBind _ x (Pi _ _ Explicit _) sc) app as ((_, Static tm) :: ds)
-        = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             tm' <- unelabNoSugar Env.empty tm
-             mkRHSargs sc' (IApp fc app (map rawName tm')) as ds
-    mkRHSargs (NBind _ x (Pi _ _ Implicit _) sc) app as ((_, Static tm) :: ds)
-        = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             tm' <- unelabNoSugar Env.empty tm
-             mkRHSargs sc' (INamedApp fc app x (map rawName tm')) as ds
-    mkRHSargs (NBind _ _ (Pi _ _ AutoImplicit _) sc) app as ((_, Static tm) :: ds)
-        = do defs <- get Ctxt
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             tm' <- unelabNoSugar Env.empty tm
-             mkRHSargs sc' (IAutoApp fc app (map rawName tm')) as ds
-    -- Type will depend on the value here (we assume a variadic function) but
-    -- the argument names are still needed
-    mkRHSargs ty app (a :: as) ((_, Dynamic) :: ds)
-        = mkRHSargs ty (IApp fc app (IVar fc a)) as ds
-    mkRHSargs _ app _ _
-        = pure app
-
-    getRawArgs : List (Arg' Name) -> RawImp -> List (Arg' Name)
-    getRawArgs args (IApp fc f arg) = getRawArgs (Explicit fc arg :: args) f
-    getRawArgs args (INamedApp fc f n arg)
-        = getRawArgs (Named fc n arg :: args) f
-    getRawArgs args (IAutoApp fc f arg)
-        = getRawArgs (Auto fc arg :: args) f
-    getRawArgs args tm = args
-
-    reapply : RawImp -> List (Arg' Name) -> RawImp
-    reapply f [] = f
-    reapply f (Explicit fc arg :: args) = reapply (IApp fc f arg) args
-    reapply f (Named fc n arg :: args)
-        = reapply (INamedApp fc f n arg) args
-    reapply f (Auto fc arg :: args)
-        = reapply (IAutoApp fc f arg) args
-
-    dropArgs : Name -> RawImp -> RawImp
-    dropArgs pename tm = reapply (IVar fc pename) (dropSpec 0 sargs (getRawArgs [] tm))
-
-    unelabPat : Name -> (vs ** (Env Term vs, Term vs, Term vs)) ->
-                Core ImpClause
-    unelabPat pename (_ ** (env, lhs, rhs))
-        = do logTerm "specialise" 20 "Unelaborating LHS:" lhs
-             lhsapp <- unelabNoSugar env lhs
-             log "specialise" 20 $ "Unelaborating LHS to: \{show lhsapp}"
-             let lhs' = dropArgs pename (map rawName lhsapp)
-             defs <- get Ctxt
-             rhs <- normaliseArgHoles defs env rhs
-             rhs <- unelabNoSugar env rhs
-             let rhs = flip mapTTImp rhs $ \case
-                      IHole fc _ => Implicit fc False
-                      tm => tm
-             pure (PatClause fc lhs' (map rawName rhs))
-
-    unelabLHS : Name -> (vs ** (Env Term vs, Term vs, Term vs)) ->
-                Core RawImp
-    unelabLHS pename (_ ** (env, lhs, rhs))
-        = do lhsapp <- unelabNoSugar env lhs
-             pure $ dropArgs pename (map rawName lhsapp)
-
--- Get the reducible names in a function to be partially evaluated. In practice,
--- that's all the functions it refers to
--- TODO: May want to take care with 'partial' names?
-getReducible : List Name -> -- calls to check
-               NameMap Nat -> -- which nodes have been visited. If the entry is
-                              -- present, it's visited
-               Defs -> Core (NameMap Nat)
-getReducible [] refs defs = pure refs
-getReducible (n :: rest) refs defs
-  = do let Nothing = lookup n refs
-           | Just _ => getReducible rest refs defs
-       case !(lookupCtxtExact n (gamma defs)) of
-            Nothing => getReducible rest refs defs
-            Just def =>
-              do let refs' = insert n 65536 refs
-                 let calls = refersTo def
-                 getReducible (keys calls ++ rest) refs' defs
-
-mkSpecDef : {auto c : Ref Ctxt Defs} ->
-            {auto m : Ref MD Metadata} ->
-            {auto u : Ref UST UState} ->
-            {auto s : Ref Syn SyntaxInfo} ->
-            {auto o : Ref ROpts REPLOpts} ->
-            FC -> GlobalDef ->
-            Name -> List (Nat, ArgMode) -> Name -> List (FC, Term vars) ->
-            Core (Term vars)
-mkSpecDef {vars} fc gdef pename sargs fn stk
-    = handleUnify {unResolve = True}
-       (do defs <- get Ctxt
-           setAllPublic True
-           let staticargs
-                 = mapMaybe (\ (x, s) => case s of
-                                              Dynamic => Nothing
-                                              Static t => Just (x, t)) sargs
-           let peapp = applyStackWithFC (Ref fc Func pename) (dropSpec 0 staticargs stk)
-           Nothing <- lookupCtxtExact pename (gamma defs)
-               | Just _ => -- already specialised
-                           do log "specialise" 5 $ "Already specialised " ++ show pename
-                              pure peapp
-           logC "specialise.declare" 5 $
-                   do fnfull <- toFullNames fn
-                      args' <- traverse (\ (i, arg) =>
-                                   do arg' <- the (Core ArgMode) $ case arg of
-                                                   Static a =>
-                                                      pure $ Static !(toFullNames a)
-                                                   Dynamic => pure Dynamic
-                                      pure (show (i, arg'))) sargs
-                      pure $ "Specialising " ++ show fnfull ++
-                             " (" ++ show fn ++ ") -> \{show pename} by " ++
-                             showSep ", " args'
-           let sty = specialiseTy 0 staticargs (type gdef)
-           logTermNF "specialise" 3 ("Specialised type " ++ show pename) Env.empty sty
-
-           -- Add as RigW - if it's something else, we don't need it at
-           -- runtime anyway so this is wasted effort, therefore a failure
-           -- is okay!
-           let defflags := propagateFlags (flags gdef)
-           log "specialise.flags" 20 "Defining \{show pename} with flags: \{show defflags}"
-           peidx <- addDef pename
-                  $ the (GlobalDef -> GlobalDef) { flags := defflags }
-                  $ newDef fc pename top Scope.empty sty (specified Public) None
-           addToSave (Resolved peidx)
-
-           -- Reduce the function to be specialised, and reduce any name in
-           -- the arguments at most once (so that recursive definitions aren't
-           -- unfolded forever)
-           let specnames = getAllRefs empty (map snd sargs)
-           specLimits <- traverse (\n => pure (n, 1))
-                                  (keys specnames)
-
-           defs <- get Ctxt
-           reds <- getReducible [fn] empty defs
-           setFlag fc (Resolved peidx) (PartialEval (specLimits ++ toList reds))
-
-           let PMDef pminfo pmargs ct tr pats = definition gdef
-               | _ => pure (applyStackWithFC (Ref fc Func fn) stk)
-           logC "specialise" 5 $
-                   do inpats <- traverse unelabDef pats
-                      pure $ "Attempting to specialise:\n" ++
-                             showSep "\n" (map showPat inpats)
-
-           Just newpats <- getSpecPats fc pename fn stk !(nf defs Env.empty (type gdef))
-                                       sargs staticargs pats
-                | Nothing => pure (applyStackWithFC (Ref fc Func fn) stk)
-           log "specialise" 5 $ "New patterns for " ++ show pename ++ ":\n" ++
-                    showSep "\n" (map showPat newpats)
-           processDecl [InPartialEval] (MkNested []) Env.empty
-                       (IDef fc (Resolved peidx) newpats)
-           setAllPublic False
-           pure peapp)
-           -- If the partially evaluated definition fails, just use the initial
-           -- application. It might indicates a bug in the P.E. function generation
-           -- if it fails, but I don't want the whole system to be dependent on
-           -- the correctness of PE!
-        (\err =>
-           do logC "specialise.fail" 1 $ do
-                 fn <- toFullNames fn
-                 pure "Partial evaluation of \{show fn} failed:\n\{show err}"
-              update Ctxt { peFailures $= insert pename () }
-              pure (applyStackWithFC (Ref fc Func fn) stk))
-  where
-
-    identityFlag : List (Nat, ArgMode) -> Nat -> Maybe Nat
-    identityFlag [] k = pure k
-    identityFlag ((pos, mode) :: sargs) k
-      = k <$ guard (k < pos)
-      <|> (case mode of { Static _ => (`minus` 1); Dynamic => id }) <$> identityFlag sargs k
-
-
-    propagateFlags : List DefFlag -> List DefFlag
-    propagateFlags = mapMaybe $ \case
-      Deprecate => Nothing
-      Overloadable => Nothing
-      Identity k => Identity <$> identityFlag sargs k
-      fl => Just fl
-
-    getAllRefs : NameMap Bool -> List ArgMode -> NameMap Bool
-    getAllRefs ns (Dynamic :: xs) = getAllRefs ns xs
-    getAllRefs ns (Static t :: xs)
-        = addRefs False (UN Underscore) (getAllRefs ns xs) t
-    getAllRefs ns [] = ns
-
-    updateApp : Name -> RawImp -> RawImp
-    updateApp n (IApp fc f a) = IApp fc (updateApp n f) a
-    updateApp n (IAutoApp fc f a) = IAutoApp fc (updateApp n f) a
-    updateApp n (INamedApp fc f m a) = INamedApp fc (updateApp n f) m a
-    updateApp n f = IVar fc n
-
-    unelabDef : (vs ** (Env Term vs, Term vs, Term vs)) ->
-                Core ImpClause
-    unelabDef (_ ** (env, lhs, rhs))
-        = do lhs' <- unelabNoSugar env lhs
-             defs <- get Ctxt
-             rhsnf <- normaliseArgHoles defs env rhs
-             rhs' <- unelabNoSugar env rhsnf
-             pure (PatClause fc (map rawName lhs') (map rawName rhs'))
-
-    showPat : ImpClause -> String
-    showPat (PatClause _ lhs rhs) = show lhs ++ " = " ++ show rhs
-    showPat _ = "Can't happen"
-
-eraseInferred : {auto c : Ref Ctxt Defs} ->
-                Term vars -> Core (Term vars)
-eraseInferred (Bind fc x b tm)
-    = do b' <- traverse eraseInferred b
-         tm' <- eraseInferred tm
-         pure (Bind fc x b' tm')
-eraseInferred tm
-    = case getFnArgs tm of
-           (f, []) => pure f
-           (Ref fc Func n, args) =>
-                do defs <- get Ctxt
-                   Just gdef <- lookupCtxtExact n (gamma defs)
-                        | Nothing => pure tm
-                   let argsE = NatSet.overwrite (Erased fc Placeholder) (inferrable gdef) args
-                   argsE' <- traverse eraseInferred argsE
-                   pure (apply fc (Ref fc Func n) argsE')
-           (f, args) =>
-                do args' <- traverse eraseInferred args
-                   pure (apply (getLoc f) f args)
-
--- Specialise a function name according to arguments. Return the specialised
--- application on success, or Nothing if it's not specialisable (due to static
--- arguments not being concrete)
-specialise : {vars : _} ->
-             {auto c : Ref Ctxt Defs} ->
-             {auto m : Ref MD Metadata} ->
-             {auto u : Ref UST UState} ->
-             {auto s : Ref Syn SyntaxInfo} ->
-             {auto o : Ref ROpts REPLOpts} ->
-             FC -> Env Term vars -> GlobalDef ->
-             Name -> List (FC, Term vars) ->
-             Core (Maybe (Term vars))
-specialise {vars} fc env gdef fn stk
-    = let specs = specArgs gdef in
-      if NatSet.isEmpty specs then pure Nothing else do
-        fnfull <- toFullNames fn
-        -- If all the arguments are concrete (meaning, no local variables
-        -- or holes in them, so they can be a ClosedTerm) we can specialise
-        Just sargs <- getSpecArgs 0 specs stk
-            | Nothing => pure Nothing
-        defs <- get Ctxt
-        sargs <- for sargs $ traversePair $ traverseArgMode $ \ tm =>
-                   normalise defs Env.empty tm
-        let nhash = hash !(traverse toFullNames $ mapMaybe getStatic $ map snd sargs)
-                       `hashWithSalt` fnfull -- add function name to hash to avoid namespace clashes
-        let pename = NS partialEvalNS
-                     (UN $ Basic ("PE_" ++ nameRoot fnfull ++ "_" ++ asHex (cast nhash)))
-        defs <- get Ctxt
-        case lookup pename (peFailures defs) of
-             Nothing => Just <$> mkSpecDef fc gdef pename sargs fn stk
-             Just _ => pure Nothing
-  where
-    concrete : {vars : _} ->
-               Term vars -> Maybe ClosedTerm
-    concrete tm = shrink tm none
-
-    getSpecArgs : Nat -> NatSet -> List (FC, Term vars) ->
-                  Core (Maybe (List (Nat, ArgMode)))
-    getSpecArgs i specs [] = pure (Just [])
-    getSpecArgs i specs ((_, x) :: xs)
-        = do Just xs' <- getSpecArgs (1 + i) specs xs
-                 | Nothing => pure Nothing
-             if i `elem` specs
-                then do defs <- get Ctxt
-                        x' <- normaliseHoles defs env x
-                        x' <- eraseInferred x'
-                        let Just xok = concrete x'
-                            | Nothing => pure Nothing
-                        pure $ Just ((i, Static xok) :: xs')
-                else pure $ Just ((i, Dynamic) :: xs')
-
-findSpecs : {vars : _} ->
-            {auto c : Ref Ctxt Defs} ->
-            {auto m : Ref MD Metadata} ->
-            {auto u : Ref UST UState} ->
-            {auto s : Ref Syn SyntaxInfo} ->
-            {auto o : Ref ROpts REPLOpts} ->
-            Env Term vars -> List (FC, Term vars) -> Term vars ->
-            Core (Term vars)
-findSpecs env stk (Ref fc Func fn)
-    = do defs <- get Ctxt
-         Just gdef <- lookupCtxtExact fn (gamma defs)
-              | Nothing => pure (applyStackWithFC (Ref fc Func fn) stk)
-         Just r <- specialise fc env gdef fn stk
-              | Nothing => pure (applyStackWithFC (Ref fc Func fn) stk)
-         pure r
-findSpecs env stk (Meta fc n i args)
-    = do args' <- traverse (findSpecs env []) args
-         pure $ applyStackWithFC (Meta fc n i args') stk
-findSpecs env stk (Bind fc x b sc)
-    = do b' <- traverse (findSpecs env []) b
-         sc' <- findSpecs (b' :: env) [] sc
-         pure $ applyStackWithFC (Bind fc x b' sc') stk
-findSpecs env stk (App fc fn arg)
-    = do arg' <- findSpecs env [] arg
-         findSpecs env ((fc, arg') :: stk) fn
-findSpecs env stk (TDelayed fc r tm)
-    = do tm' <- findSpecs env [] tm
-         pure $ applyStackWithFC (TDelayed fc r tm') stk
-findSpecs env stk (TDelay fc r ty tm)
-    = do ty' <- findSpecs env [] ty
-         tm' <- findSpecs env [] tm
-         pure $ applyStackWithFC (TDelay fc r ty' tm') stk
-findSpecs env stk (TForce fc r tm)
-    = do tm' <- findSpecs env [] tm
-         pure $ applyStackWithFC (TForce fc r tm') stk
-findSpecs env stk tm = pure $ applyStackWithFC tm stk
-
-bName : {auto q : Ref QVar Int} -> String -> Core Name
-bName n
-    = do i <- get QVar
-         put QVar (i + 1)
-         pure (MN n i)
-
--- This is like 'quote' in 'Normalise', except that when we encounter a
--- function name we need to check whether to specialise.
--- (Sorry about all the repetition - I don't really want to export those
--- internal details, and there is a small but crucial change where we call
--- quoteHead as compared with the version in Core.Normalise, to deal with
--- checking for specialised applications.)
-mutual
-  quoteArgs : {bound, free : _} ->
-              {auto c : Ref Ctxt Defs} ->
-              {auto m : Ref MD Metadata} ->
-              {auto u : Ref UST UState} ->
-              {auto s : Ref Syn SyntaxInfo} ->
-              {auto o : Ref ROpts REPLOpts} ->
-              Ref QVar Int -> Defs -> Bounds bound ->
-              Env Term free -> List (Closure free) ->
-              Core (List (Term (bound ++ free)))
-  quoteArgs q defs bounds env [] = pure []
-  quoteArgs q defs bounds env (a :: args)
-      = pure $ (!(quoteGenNF q defs bounds env !(evalClosure defs a)) ::
-                !(quoteArgs q defs bounds env args))
-
-  quoteArgsWithFC : {auto c : Ref Ctxt Defs} ->
-                    {auto m : Ref MD Metadata} ->
-                    {auto u : Ref UST UState} ->
-                    {auto s : Ref Syn SyntaxInfo} ->
-                    {auto o : Ref ROpts REPLOpts} ->
-                    {bound, free : _} ->
-                    Ref QVar Int -> Defs -> Bounds bound ->
-                    Env Term free -> List (FC, Closure free) ->
-                    Core (List (FC, Term (bound ++ free)))
-  quoteArgsWithFC q defs bounds env terms
-      = pure $ zip (map fst terms) !(quoteArgs q defs bounds env (map snd terms))
-
-  quoteHead : {bound, free : _} ->
-              {auto c : Ref Ctxt Defs} ->
-              {auto m : Ref MD Metadata} ->
-              {auto u : Ref UST UState} ->
-              {auto s : Ref Syn SyntaxInfo} ->
-              {auto o : Ref ROpts REPLOpts} ->
-              Ref QVar Int -> Defs ->
-              FC -> Bounds bound -> Env Term free -> NHead free ->
-              Core (Term (bound ++ free))
-  quoteHead {bound} q defs fc bounds env (NLocal mrig _ prf)
-      = let MkVar prf' = addLater bound prf in
-            pure $ Local fc mrig _ prf'
-    where
-      addLater : {idx : _} -> (ys : List Name) -> (0 p : IsVar n idx xs) ->
-                 Var (ys ++ xs)
-      addLater [] isv = MkVar isv
-      addLater (x :: xs) isv
-          = let MkVar isv' = addLater xs isv in
-                MkVar (Later isv')
-  quoteHead q defs fc bounds env (NRef Bound (MN n i))
-      = case findName bounds of
-             Just (MkVar p) => pure $ Local fc Nothing _ (embedIsVar p)
-             Nothing => pure $ Ref fc Bound (MN n i)
-    where
-      findName : Bounds bound' -> Maybe (Var bound')
-      findName None = Nothing
-      findName (Add x (MN n' i') ns)
-          = if i == i' -- this uniquely identifies it, given how we
-                       -- generated the names, and is a faster test!
-               then Just first
-               else do MkVar p <-findName ns
-                       Just (MkVar (Later p))
-      findName (Add x _ ns)
-          = do MkVar p <-findName ns
-               Just (MkVar (Later p))
-  quoteHead q defs fc bounds env (NRef nt n) = pure $ Ref fc nt n
-  quoteHead q defs fc bounds env (NMeta n i args)
-      = do args' <- quoteArgs q defs bounds env args
-           pure $ Meta fc n i args'
-
-  quotePi : {bound, free : _} ->
-            {auto c : Ref Ctxt Defs} ->
-            {auto m : Ref MD Metadata} ->
-            {auto u : Ref UST UState} ->
-            {auto s : Ref Syn SyntaxInfo} ->
-            {auto o : Ref ROpts REPLOpts} ->
-            Ref QVar Int -> Defs -> Bounds bound ->
-            Env Term free -> PiInfo (Closure free) ->
-            Core (PiInfo (Term (bound ++ free)))
-  quotePi q defs bounds env Explicit = pure Explicit
-  quotePi q defs bounds env Implicit = pure Implicit
-  quotePi q defs bounds env AutoImplicit = pure AutoImplicit
-  quotePi q defs bounds env (DefImplicit t)
-      = do t' <- quoteGenNF q defs bounds env !(evalClosure defs t)
-           pure (DefImplicit t')
-
-  quoteBinder : {bound, free : _} ->
-                {auto c : Ref Ctxt Defs} ->
-                {auto m : Ref MD Metadata} ->
-                {auto u : Ref UST UState} ->
-                {auto s : Ref Syn SyntaxInfo} ->
-                {auto o : Ref ROpts REPLOpts} ->
-                Ref QVar Int -> Defs -> Bounds bound ->
-                Env Term free -> Binder (Closure free) ->
-                Core (Binder (Term (bound ++ free)))
-  quoteBinder q defs bounds env (Lam fc r p ty)
-      = do ty' <- quoteGenNF q defs bounds env !(evalClosure defs ty)
-           p' <- quotePi q defs bounds env p
-           pure (Lam fc r p' ty')
-  quoteBinder q defs bounds env (Let fc r val ty)
-      = do val' <- quoteGenNF q defs bounds env !(evalClosure defs val)
-           ty' <- quoteGenNF q defs bounds env !(evalClosure defs ty)
-           pure (Let fc r val' ty')
-  quoteBinder q defs bounds env (Pi fc r p ty)
-      = do ty' <- quoteGenNF q defs bounds env !(evalClosure defs ty)
-           p' <- quotePi q defs bounds env p
-           pure (Pi fc r p' ty')
-  quoteBinder q defs bounds env (PVar fc r p ty)
-      = do ty' <- quoteGenNF q defs bounds env !(evalClosure defs ty)
-           p' <- quotePi q defs bounds env p
-           pure (PVar fc r p' ty')
-  quoteBinder q defs bounds env (PLet fc r val ty)
-      = do val' <- quoteGenNF q defs bounds env !(evalClosure defs val)
-           ty' <- quoteGenNF q defs bounds env !(evalClosure defs ty)
-           pure (PLet fc r val' ty')
-  quoteBinder q defs bounds env (PVTy fc r ty)
-      = do ty' <- quoteGenNF q defs bounds env !(evalClosure defs ty)
-           pure (PVTy fc r ty')
-
-  quoteGenNF : {bound, vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               {auto m : Ref MD Metadata} ->
-               {auto u : Ref UST UState} ->
-               {auto s : Ref Syn SyntaxInfo} ->
-               {auto o : Ref ROpts REPLOpts} ->
-               Ref QVar Int ->
-               Defs -> Bounds bound ->
-               Env Term vars -> NF vars -> Core (Term (bound ++ vars))
-  quoteGenNF q defs bound env (NBind fc n b sc)
-      = do var <- bName "qv"
-           sc' <- quoteGenNF q defs (Add n var bound) env
-                       !(sc defs (toClosure defaultOpts env (Ref fc Bound var)))
-           b' <- quoteBinder q defs bound env b
-           pure (Bind fc n b' sc')
-  -- IMPORTANT CASE HERE
-  -- If fn is to be specialised, quote the args directly (no further
-  -- reduction) then call specialise. Otherwise, quote as normal
-  quoteGenNF q defs bound env (NApp fc (NRef Func fn) args)
-      = do Just gdef <- lookupCtxtExact fn (gamma defs)
-                | Nothing => do args' <- quoteArgsWithFC q defs bound env args
-                                pure $ applyStackWithFC (Ref fc Func fn) args'
-           args' <- quoteArgsWithFC q defs bound env args
-           let False = NatSet.isEmpty (specArgs gdef)
-               | _ => pure $ applyStackWithFC (Ref fc Func fn) args'
-           Just r <- specialise fc (extendEnv bound env) gdef fn args'
-                | Nothing =>
-                     -- can't specialise, keep the arguments
-                     -- unreduced
-                     do empty <- clearDefs defs
-                        args' <- quoteArgsWithFC q empty bound env args
-                        pure $ applyStackWithFC (Ref fc Func fn) args'
-           pure r
-     where
-       extendEnv : Bounds bs -> Env Term vs -> Env Term (bs ++ vs)
-       extendEnv None env = env
-       extendEnv (Add x n bs) env
-           -- We're just using this to evaluate holes in the right scope, so
-           -- a placeholder binder is fine
-           = Lam fc top Explicit (Erased fc Placeholder) :: extendEnv bs env
-  quoteGenNF q defs bound env (NApp fc f args)
-      = do f' <- quoteHead q defs fc bound env f
-           args' <- quoteArgsWithFC q defs bound env args
-           pure $ applyStackWithFC f' args'
-  quoteGenNF q defs bound env (NDCon fc n t ar args)
-      = do args' <- quoteArgsWithFC q defs bound env args
-           pure $ applyStackWithFC (Ref fc (DataCon t ar) n) args'
-  quoteGenNF q defs bound env (NTCon fc n ar args)
-      = do args' <- quoteArgsWithFC q defs bound env args
-           pure $ applyStackWithFC (Ref fc (TyCon ar) n) args'
-  quoteGenNF q defs bound env (NAs fc s n pat)
-      = do n' <- quoteGenNF q defs bound env n
-           pat' <- quoteGenNF q defs bound env pat
-           pure (As fc s n' pat')
-  quoteGenNF q defs bound env (NDelayed fc r arg)
-      = do argQ <- quoteGenNF q defs bound env arg
-           pure (TDelayed fc r argQ)
-  quoteGenNF q defs bound env (NDelay fc r ty arg)
-      -- unlike main evaluator, we want to look under Delays
-      = do argNF <- evalClosure defs arg
-           argQ <- quoteGenNF q defs bound env argNF
-           tyNF <- evalClosure defs ty
-           tyQ <- quoteGenNF q defs bound env tyNF
-           pure (TDelay fc r tyQ argQ)
-    where
-      toHolesOnly : Closure vs -> Closure vs
-      toHolesOnly (MkClosure _ locs env tm)
-          = MkClosure withHoles locs env tm
-      toHolesOnly c = c
-  quoteGenNF q defs bound env (NForce fc r arg args)
-      = do args' <- quoteArgsWithFC q defs bound env args
-           case arg of
-                NDelay fc _ _ arg =>
-                   do argNF <- evalClosure defs arg
-                      pure $ applyStackWithFC !(quoteGenNF q defs bound env argNF) args'
-                _ => do arg' <- quoteGenNF q defs bound env arg
-                        pure $ applyStackWithFC (TForce fc r arg') args'
-  quoteGenNF q defs bound env (NPrimVal fc c) = pure $ PrimVal fc c
-  quoteGenNF q defs bound env (NErased fc Impossible) = pure $ Erased fc Impossible
-  quoteGenNF q defs bound env (NErased fc Placeholder) = pure $ Erased fc Placeholder
-  quoteGenNF q defs bound env (NErased fc (Dotted t))
-    = pure $ Erased fc $ Dotted !(quoteGenNF q defs bound env t)
-  quoteGenNF q defs bound env (NType fc u) = pure $ TType fc u
-
-evalRHS : {vars : _} ->
-          {auto c : Ref Ctxt Defs} ->
-          {auto m : Ref MD Metadata} ->
-          {auto u : Ref UST UState} ->
-          {auto s : Ref Syn SyntaxInfo} ->
-          {auto o : Ref ROpts REPLOpts} ->
-          Env Term vars -> NF vars -> Core (Term vars)
-evalRHS env nf
-    = do q <- newRef QVar 0
-         defs <- get Ctxt
-         quoteGenNF q defs None env nf
-
-export
-applySpecialise : {vars : _} ->
-                  {auto c : Ref Ctxt Defs} ->
-                  {auto m : Ref MD Metadata} ->
-                  {auto u : Ref UST UState} ->
-                  {auto s : Ref Syn SyntaxInfo} ->
-                  {auto o : Ref ROpts REPLOpts} ->
-                  Env Term vars ->
-                  Maybe (List (Name, Nat)) ->
-                        -- ^ If we're specialising, names to reduce in the RHS
-                        -- with their reduction limits
-                  Term vars -> -- initial RHS
-                  Core (Term vars)
-applySpecialise env Nothing tm
-    = findSpecs env [] tm -- not specialising, just search through RHS
-applySpecialise env (Just ls) tmin -- specialising, evaluate RHS while looking
-                                 -- for names to specialise
-    = do defs <- get Ctxt
-         tm <- toResolvedNames tmin
-         nf <- nf defs env tm
-         tm' <- evalRHS env nf
-         tmfull <- toFullNames tm'
-         logTermNF "specialise" 5 ("New RHS") env tmfull
-         pure tmfull
diff --git a/src/TTImp/ProcessBuiltin.idr b/src/TTImp/ProcessBuiltin.idr
index a9ff79adbe6..ce9acca49d7 100644
--- a/src/TTImp/ProcessBuiltin.idr
+++ b/src/TTImp/ProcessBuiltin.idr
@@ -14,15 +14,14 @@ import TTImp.TTImp
 
 showDefType : Def -> String
 showDefType None = "undefined"
-showDefType (PMDef {}) = "function"
-showDefType (ExternDef {}) = "external function"
-showDefType (ForeignDef {}) = "foreign function"
-showDefType (Builtin {}) = "builtin function"
+showDefType (Function {}) = "function"
 showDefType (DCon {}) = "data constructor"
 showDefType (TCon {}) = "type constructor"
 showDefType (Hole {}) = "hole"
 showDefType (BySearch {}) = "search"
 showDefType (Guess {}) = "guess"
+showDefType (ExternDef {}) = "external function"
+showDefType (ForeignDef {}) = "foreign function"
 showDefType ImpBind = "bound name"
 showDefType (UniverseLevel {}) = "universe level"
 showDefType Delayed = "delayed"
@@ -43,7 +42,7 @@ getTypeCons (Meta {}) = Nothing
 getTypeCons (Bind _ x b scope) = case b of
     Let _ _ val _ => getTypeCons $ subst {x} val scope
     _ => Nothing
-getTypeCons (App _ fn _) = getTypeCons fn
+getTypeCons (App _ fn _ _) = getTypeCons fn
 getTypeCons _ = Nothing
 
 ||| Get the arguments of a `Term` representing a type.
@@ -99,11 +98,11 @@ termConMatch : Term vs -> Term vs' -> Bool
 termConMatch (Local _ _ x _) (Local _ _ y _) = x == y
 termConMatch (Ref _ _ n) (Ref _ _ m) = n == m
 termConMatch (Meta _ _ i args0) (Meta _ _ j args1)
-    = i == j && all (uncurry termConMatch) (zip args0 args1)
+    = i == j && all (uncurry termConMatch) (zip (map snd args0) (map snd args1))
     -- I don't understand how they're equal if args are different lengths
     -- but this is what's in Core.TT.
 termConMatch (Bind _ _ b s) (Bind _ _ c t) = eqBinderBy termConMatch b c && termConMatch s t
-termConMatch (App _ f _) (App _ g _) = termConMatch f g
+termConMatch (App _ f _ _) (App _ g _ _) = termConMatch f g
 termConMatch (As _ _ a p) (As _ _ b q) = termConMatch a b && termConMatch p q
 termConMatch (TDelayed _ _ tm0) tm1 = termConMatch tm0 tm1
 termConMatch tm0 (TDelayed _ _ tm1) = termConMatch tm0 tm1
@@ -120,16 +119,29 @@ termConMatch _ _ = False
 isStrict : Term vs -> Bool
 isStrict (Local {}) = True
 isStrict (Ref {}) = True
-isStrict (Meta _ _ i args) = all isStrict args
+isStrict (Meta _ _ i args) = all (isStrict . snd) args
 isStrict (Bind _ _ b s) = isStrict (binderType b) && isStrict s
-isStrict (App _ f x) = isStrict f && isStrict x
+isStrict (App _ f _ x) = isStrict f && isStrict x
 isStrict (As _ _ a p) = isStrict a && isStrict p
+isStrict (Case _ _ _ _ _ alts) = all isStrictAlt alts
+  where
+    isStrictScope : forall vs . CaseScope vs -> Bool
+    isStrictScope (RHS _ tm) = isStrict tm
+    isStrictScope (Arg _ _ sc) = isStrictScope sc
+
+    isStrictAlt : forall vs . CaseAlt vs -> Bool
+    isStrictAlt (ConCase _ _ _ sc) = isStrictScope sc
+    isStrictAlt (DelayCase _ _ _ tm) = isStrict tm
+    isStrictAlt (ConstCase _ _ tm) = isStrict tm
+    isStrictAlt (DefaultCase _ tm) = isStrict tm
 isStrict (TDelayed {}) = False
 isStrict (TDelay _ _ f x) = isStrict f && isStrict x
 isStrict (TForce _ _ tm) = isStrict tm
 isStrict (PrimVal {}) = True
+isStrict (PrimOp _ _ _) = True
 isStrict (Erased {}) = True
 isStrict (TType {}) = True
+isStrict (Unmatched _ _) = True
 
 ||| Get the name and definition of a list of names.
 getConsGDef :
@@ -195,7 +207,7 @@ checkNatCons c cons ty fc = case !(foldr checkCon (pure (Nothing, Nothing)) cons
     checkCon : (Name, GlobalDef) -> Core (Maybe Name, Maybe Name) -> Core (Maybe Name, Maybe Name)
     checkCon (n, gdef) cons = do
         (zero, succ) <- cons
-        let DCon _ arity _ = gdef.definition
+        let DCon _ _ arity = gdef.definition
             | def => throw $ GenericMsg fc $ "Expected data constructor, found:" ++ showDefType def
         case arity `minus` size gdef.eraseArgs of
             0 => case zero of
@@ -235,7 +247,7 @@ processNatToInteger fc fn = do
     log "builtin.NaturalToInteger" 5 $ "Processing %builtin NaturalToInteger " ++ show_fn ++ "."
     [(_ , i, gdef)] <- lookupCtxtName fn ds.gamma
         | ns => ambiguousName fc fn $ (\(n, _, _) => n) <$> ns
-    let PMDef _ args _ cases _ = gdef.definition
+    let Function _ _ cases _ = gdef.definition
         | def => throw $ GenericMsg fc
             $ "Expected function definition, found " ++ showDefType def ++ "."
     type <- toFullNames gdef.type
@@ -263,7 +275,7 @@ processIntegerToNat fc fn = do
     [(_, i, gdef)] <- lookupCtxtName fn ds.gamma
         | ns => ambiguousName fc fn $ (\(n, _, _) => n) <$> ns
     type <- toFullNames gdef.type
-    let PMDef _ _ _ _ _ = gdef.definition
+    let Function _ _ _ _ = gdef.definition
         | def => throw $ GenericMsg fc
             $ "Expected function definition, found " ++ showDefType def ++ "."
     logTerm "builtin.IntegerToNatural" 25 ("Type of " ++ show_fn) type
diff --git a/src/TTImp/ProcessData.idr b/src/TTImp/ProcessData.idr
index 43c9a9ab63e..9e63b1602ef 100644
--- a/src/TTImp/ProcessData.idr
+++ b/src/TTImp/ProcessData.idr
@@ -6,7 +6,10 @@ import Core.Env
 import Core.Hash
 import Core.Metadata
 import Core.UnifyState
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Convert
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -18,6 +21,8 @@ import TTImp.Elab
 import TTImp.TTImp
 
 import Data.DPair
+import Data.SnocList
+
 import Libraries.Data.NameMap
 import Libraries.Data.NatSet
 import Libraries.Data.WithDefault
@@ -38,28 +43,31 @@ processDataOpt fc ndef NoNewtype
     = pure ()
 
 checkRetType : {auto c : Ref Ctxt Defs} ->
+               {vars: _} ->
                Env Term vars -> NF vars ->
                (NF vars -> Core ()) -> Core ()
-checkRetType env (NBind fc x (Pi _ _ _ ty) sc) chk
+checkRetType env (VBind fc x (Pi _ _ _ ty) sc) chk
     = do defs <- get Ctxt
-         checkRetType env !(sc defs (toClosure defaultOpts env (Erased fc Placeholder))) chk
+         checkRetType env !(expand !(sc (pure (VErased fc Placeholder)))) chk
 checkRetType env nf chk = chk nf
 
 checkIsType : {auto c : Ref Ctxt Defs} ->
-              FC -> Name -> Env Term vars -> NF vars -> Core ()
-checkIsType loc n env nf
-    = checkRetType env nf $
+              {vars: _} ->
+              FC -> Name -> Env Term vars -> Term vars -> Core ()
+checkIsType loc n env ty
+    = checkRetType env !(expand !(nf env ty)) $
          \case
-           NType {} => pure ()
+           VType {} => pure ()
            _ => throw $ BadTypeConType loc n
 
 checkFamily : {auto c : Ref Ctxt Defs} ->
-              FC -> Name -> Name -> Env Term vars -> NF vars -> Core ()
-checkFamily loc cn tn env nf
-    = checkRetType env nf $
+              {vars: _} ->
+              FC -> Name -> Name -> Env Term vars -> Term vars -> Core ()
+checkFamily loc cn tn env ty
+    = checkRetType env !(expand !(nf env ty)) $
          \case
-           NType {} => throw $ BadDataConType loc cn tn
-           NTCon _ n' _ _ =>
+           VType {} => throw $ BadDataConType loc cn tn
+           VTCon _ n' _ _ =>
                  if tn == n'
                     then pure ()
                     else throw $ BadDataConType loc cn tn
@@ -108,7 +116,7 @@ checkCon {vars} opts nest env vis tn_in tn ty_raw
                               (gType fc u)
 
          -- Check 'ty' returns something in the right family
-         checkFamily fc cn tn env !(nf defs env ty)
+         checkFamily fc cn tn env ty
          let fullty = abstractEnvType fc env ty
          logTermNF "declare.data.constructor" 5 ("Constructor " ++ show cn) Env.empty fullty
 
@@ -121,26 +129,25 @@ checkCon {vars} opts nest env vis tn_in tn ty_raw
                            addHashWithNames fullty
                            log "module.hash" 15 "Adding hash for data constructor: \{show cn}"
               _ => pure ()
-         pure (Mk [fc, NoFC cn, !(getArity defs Env.empty fullty)] fullty)
+         pure (Mk [fc, NoFC cn, !(getArity Env.empty fullty)] fullty)
 
 -- Get the indices of the constructor type (with non-constructor parts erased)
 getIndexPats : {auto c : Ref Ctxt Defs} ->
                ClosedTerm -> Core (List ClosedNF)
 getIndexPats tm
     = do defs <- get Ctxt
-         tmnf <- nf defs Env.empty tm
-         ret <- getRetType defs tmnf
+         ret <- getRetType defs !(expand !(nf Env.empty tm))
          getPats defs ret
   where
     getRetType : Defs -> ClosedNF -> Core ClosedNF
-    getRetType defs (NBind fc _ (Pi {}) sc)
-        = do sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
-             getRetType defs sc'
+    getRetType defs (VBind fc _ (Pi {}) sc)
+        = do sc' <- sc (pure (VErased fc Placeholder))
+             getRetType defs !(expand sc')
     getRetType defs t = pure t
 
     getPats : Defs -> ClosedNF -> Core (List ClosedNF)
-    getPats defs (NTCon fc _ _ args)
-        = do args' <- traverse (evalClosure defs . snd) args
+    getPats defs (VTCon fc _ _ args)
+        = do args' <- traverseSnocList spineVal args
              pure (toList args')
     getPats defs _ = pure [] -- Can't happen if we defined the type successfully!
 
@@ -154,35 +161,35 @@ getDetags fc tys
         pure $ ds <$ guard (not (isEmpty ds))
   where
     mutual
-      disjointArgs : List ClosedNF -> List ClosedNF -> Core Bool
-      disjointArgs [] _ = pure False
-      disjointArgs _ [] = pure False
-      disjointArgs (a :: args) (a' :: args')
+      disjointArgs : SnocList ClosedNF -> SnocList ClosedNF -> Core Bool
+      disjointArgs [<] _ = pure False
+      disjointArgs _ [<] = pure False
+      disjointArgs (args :< a) (args' :< a')
           = if !(disjoint a a')
                then pure True
                else disjointArgs args args'
 
       disjoint : ClosedNF -> ClosedNF -> Core Bool
-      disjoint (NDCon _ _ t _ args) (NDCon _ _ t' _ args')
+      disjoint (VDCon _ _ t _ args) (VDCon _ _ t' _ args')
           = if t /= t'
                then pure True
                else do defs <- get Ctxt
-                       argsnf <- traverse (evalClosure defs . snd) args
-                       args'nf <- traverse (evalClosure defs . snd) args'
+                       argsnf <- traverseSnocList spineVal args
+                       args'nf <- traverseSnocList spineVal args'
                        disjointArgs argsnf args'nf
-      disjoint (NTCon _ n _ args) (NTCon _ n' _ args')
+      disjoint (VTCon _ n _ args) (VTCon _ n' _ args')
           = if n /= n'
                then pure True
                else do defs <- get Ctxt
-                       argsnf <- traverse (evalClosure defs . snd) args
-                       args'nf <- traverse (evalClosure defs . snd) args'
+                       argsnf <- traverseSnocList spineVal args
+                       args'nf <- traverseSnocList spineVal args'
                        disjointArgs argsnf args'nf
-      disjoint (NPrimVal _ c) (NPrimVal _ c') = pure (c /= c')
+      disjoint (VPrimVal _ c) (VPrimVal _ c') = pure (c /= c')
       disjoint _ _ = pure False
 
     allDisjointWith : ClosedNF -> List ClosedNF -> Core Bool
     allDisjointWith val [] = pure True
-    allDisjointWith (NErased {}) _ = pure False
+    allDisjointWith (VErased {}) _ = pure False
     allDisjointWith val (nf :: nfs)
         = do ok <- disjoint val nf
              if ok then allDisjointWith val nfs
@@ -190,7 +197,7 @@ getDetags fc tys
 
     allDisjoint : List ClosedNF -> Core Bool
     allDisjoint [] = pure True
-    allDisjoint (NErased _ _ :: _) = pure False
+    allDisjoint (VErased _ _ :: _) = pure False
     allDisjoint (nf :: nfs)
         = do ok <- allDisjoint nfs
              if ok then allDisjointWith nf nfs
@@ -209,27 +216,27 @@ getDetags fc tys
 getRelevantArg : {auto c : Ref Ctxt Defs} ->
                  Defs -> Nat -> Maybe Nat -> Bool -> ClosedNF ->
                  Core (Maybe (Bool, Nat))
-getRelevantArg defs i rel world (NBind fc _ (Pi _ rig _ val) sc)
+getRelevantArg defs i rel world (VBind fc _ (Pi _ rig _ val) sc)
     = branchZero (getRelevantArg defs (1 + i) rel world
-                              !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))))
-                 (case !(evalClosure defs val) of
+                      !(expand !(sc (pure (VErased fc Placeholder)))))
+                 (case !(expand val) of
                        -- %World is never inspected, so might as well be deleted from data types,
                        -- although it needs care when compiling to ensure that the function that
                        -- returns the IO/%World type isn't erased
-                       (NPrimVal _ $ PrT WorldType) =>
+                       (VPrimVal _ $ PrT WorldType) =>
                            getRelevantArg defs (1 + i) rel False
-                               !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
+                               !(expand !(sc (pure (VErased fc Placeholder))))
                        _ =>
                        -- if we haven't found a relevant argument yet, make
                        -- a note of this one and keep going. Otherwise, we
                        -- have more than one, so give up.
-                           maybe (do sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+                           maybe (do sc' <- expand !(sc (pure (VErased fc Placeholder)))
                                      getRelevantArg defs (1 + i) (Just i) False sc')
                                  (const (pure Nothing))
                                  rel)
                  rig
 getRelevantArg defs i rel world tm
-    = pure ((world,) <$> rel)
+    = pure (maybe Nothing (\r => Just (world, r)) rel)
 
 -- If there's one constructor with only one non-erased argument, flag it as
 -- a newtype for optimisation
@@ -238,11 +245,11 @@ findNewtype : {auto c : Ref Ctxt Defs} ->
               List Constructor -> Core ()
 findNewtype [con]
     = do defs <- get Ctxt
-         Just arg <- getRelevantArg defs 0 Nothing True !(nf defs Env.empty con.val)
+         Just arg <- getRelevantArg defs 0 Nothing True !(expand !(nf Env.empty con.val))
               | Nothing => pure ()
          updateDef con.name.val $
                \case
-                 DCon t a _ => Just $ DCon t a $ Just arg
+                 DCon di t a => Just $ DCon ({ newTypeArg := Just arg } di) t a
                  _ => Nothing
 findNewtype _ = pure ()
 
@@ -268,7 +275,7 @@ firstArg tm = Nothing
 
 typeCon : Term vs -> Maybe Name
 typeCon (Ref _ (TyCon _) n) = Just n
-typeCon (App _ fn _) = typeCon fn
+typeCon (App _ fn _ _) = typeCon fn
 typeCon _ = Nothing
 
 shaped : {auto c : Ref Ctxt Defs} ->
@@ -277,7 +284,7 @@ shaped : {auto c : Ref Ctxt Defs} ->
 shaped as [] = pure Nothing
 shaped as (c :: cs)
     = do defs <- get Ctxt
-         if as !(normalise defs Env.empty c.val)
+         if as !(normalise Env.empty c.val)
             then pure (Just c.name.val)
             else shaped as cs
 
@@ -330,7 +337,7 @@ calcEnum fc cs
     isNullary : Constructor -> Core Bool
     isNullary c
         = do defs <- get Ctxt
-             pure $ hasArgs 0 !(normalise defs Env.empty c.val)
+             pure $ hasArgs 0 !(normalise Env.empty c.val)
 
 calcRecord : {auto c : Ref Ctxt Defs} ->
              FC -> List Constructor -> Core Bool
@@ -419,8 +426,8 @@ processData {vars} eopts nest env fc def_vis mbtot (MkImpLater dfc n_in ty_raw)
          let fullty = abstractEnvType dfc env ty
          logTermNF "declare.data" 5 ("data " ++ show n) Env.empty fullty
 
-         checkIsType fc n env !(nf defs env ty)
-         arity <- getArity defs Env.empty fullty
+         checkIsType fc n env ty
+         arity <- getArity Env.empty fullty
 
          -- Add the type constructor as a placeholder
          tidx <- addDef n (newDef fc n top vars fullty def_vis
@@ -458,7 +465,7 @@ processData {vars} eopts nest env fc def_vis mbtot (MkImpData dfc n_in mty_raw o
                       elabTerm !(resolveName n) InType eopts nest env
                                 (IBindHere fc (PI erased) ty_raw)
                                 (Just (gType dfc u))
-           checkIsType fc n env !(nf defs env ty)
+           checkIsType fc n env ty
 
            pure (keys (getMetas ty), abstractEnvType dfc env ty)
 
@@ -500,7 +507,7 @@ processData {vars} eopts nest env fc def_vis mbtot (MkImpData dfc n_in mty_raw o
                       TCon _ _ _ flags mw Nothing _ => case mfullty of
                         Nothing => pure (mw, vis, tot, type ndef)
                         Just fullty =>
-                            do ok <- convert defs Env.empty fullty (type ndef)
+                            do ok <- convert Env.empty fullty (type ndef)
                                if ok then pure (mw, vis, tot, fullty)
                                      else do logTermNF "declare.data" 1 "Previous" Env.empty (type ndef)
                                              logTermNF "declare.data" 1 "Now" Env.empty fullty
@@ -509,7 +516,7 @@ processData {vars} eopts nest env fc def_vis mbtot (MkImpData dfc n_in mty_raw o
 
          logTermNF "declare.data" 5 ("data " ++ show n) Env.empty fullty
 
-         arity <- getArity defs Env.empty fullty
+         arity <- getArity Env.empty fullty
 
          -- Add the type constructor as a placeholder while checking
          -- data constructors
diff --git a/src/TTImp/ProcessDecls.idr b/src/TTImp/ProcessDecls.idr
index c79bbf429d2..5d3105af794 100644
--- a/src/TTImp/ProcessDecls.idr
+++ b/src/TTImp/ProcessDecls.idr
@@ -27,6 +27,8 @@ import TTImp.TTImp
 
 import TTImp.ProcessDecls.Totality
 
+import Data.SnocList
+
 import Libraries.Text.PrettyPrint.Prettyprinter.Doc
 
 %default covering
@@ -203,7 +205,7 @@ processTTImpFile fname
                                 pure False
          traverse_ recordWarning ws
          logTime 0 "Elaboration" $
-            catch (do ignore $ processTTImpDecls (MkNested []) Env.empty tti
+            catch (do ignore $ processTTImpDecls (NestedNames.empty) Env.empty tti
                       Nothing <- checkDelayedHoles
                           | Just err => throw err
                       pure True)
diff --git a/src/TTImp/ProcessDef.idr b/src/TTImp/ProcessDef.idr
index b74e3920989..43cf4e501d2 100644
--- a/src/TTImp/ProcessDef.idr
+++ b/src/TTImp/ProcessDef.idr
@@ -1,17 +1,22 @@
 module TTImp.ProcessDef
 
+import Core.Context.Pretty
 import Core.Case.CaseBuilder
 import Core.Case.CaseTree
-import Core.Case.CaseTree.Pretty
 import Core.Coverage
 import Core.Env
+import Core.Erase
 import Core.Hash
 import Core.LinearCheck
 import Core.Metadata
 import Core.Termination
 import Core.Termination.CallGraph
 import Core.Transform
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Quote
+import Core.Evaluate.Expand
+import Core.Evaluate
 import Core.UnifyState
 
 import Idris.REPL.Opts
@@ -24,7 +29,6 @@ import TTImp.Elab.Binders
 import TTImp.Elab.Check
 import TTImp.Elab.Utils
 import TTImp.Impossible
-import TTImp.PartialEval
 import TTImp.TTImp
 import TTImp.TTImp.Functor
 import TTImp.ProcessType
@@ -35,57 +39,63 @@ import Data.Either
 import Data.List
 import Data.String
 import Data.Maybe
+
 import Libraries.Data.NameMap
 import Libraries.Data.WithDefault
 import Libraries.Text.PrettyPrint.Prettyprinter
-import Libraries.Data.List.SizeOf
+import Libraries.Data.SnocList.SizeOf
 
 %default covering
 
 mutual
   mismatchNF : {auto c : Ref Ctxt Defs} ->
                {vars : _} ->
-               Defs -> NF vars -> NF vars -> Core Bool
-  mismatchNF defs (NTCon _ xn _ xargs) (NTCon _ yn _ yargs)
+               NF vars -> NF vars -> Core Bool
+  mismatchNF (VTCon _ xn _ xargs) (VTCon _ yn _ yargs)
       = if xn /= yn
-           then pure True
-           else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-  mismatchNF defs (NDCon _ _ xt _ xargs) (NDCon _ _ yt _ yargs)
+          then pure True
+          else do xargsNF <- traverseSnocList value xargs
+                  yargsNF <- traverseSnocList value yargs
+                  anyM mismatch (zip xargsNF yargsNF)
+  mismatchNF (VDCon _ _ xt _ xargs) (VDCon _ _ yt _ yargs)
       = if xt /= yt
-           then pure True
-           else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-  mismatchNF defs (NPrimVal _ xc) (NPrimVal _ yc) = pure (xc /= yc)
-  mismatchNF defs (NDelayed _ _ x) (NDelayed _ _ y) = mismatchNF defs x y
-  mismatchNF defs (NDelay _ _ _ x) (NDelay _ _ _ y)
-      = mismatchNF defs !(evalClosure defs x) !(evalClosure defs y)
+          then pure True
+          else do xargsNF <- traverseSnocList value xargs
+                  yargsNF <- traverseSnocList value yargs
+                  anyM mismatch (zip xargsNF yargsNF)
+  mismatchNF (VPrimVal _ xc) (VPrimVal _ yc) = pure (xc /= yc)
+  mismatchNF (VDelayed _ _ x) (VDelayed _ _ y)
+      = mismatchNF !(expand x) !(expand y)
+  mismatchNF (VDelay _ _ _ x) (VDelay _ _ _ y)
+      = mismatchNF !(expand x) !(expand y)
 
   -- NPrimVal is apart from NDCon, NTCon, NBind, and NType
-  mismatchNF defs (NPrimVal {}) (NDCon {}) = pure True
-  mismatchNF defs (NDCon {}) (NPrimVal {}) = pure True
-  mismatchNF defs (NPrimVal {}) (NBind {}) = pure True
-  mismatchNF defs (NBind {}) (NPrimVal {}) = pure True
-  mismatchNF defs (NPrimVal {}) (NTCon {}) = pure True
-  mismatchNF defs (NTCon {}) (NPrimVal {}) = pure True
-  mismatchNF defs (NPrimVal {}) (NType {}) = pure True
-  mismatchNF defs (NType {}) (NPrimVal {}) = pure True
-
--- NTCon is apart from NBind, and NType
-  mismatchNF defs (NTCon {}) (NBind {}) = pure True
-  mismatchNF defs (NBind {}) (NTCon {}) = pure True
-  mismatchNF defs (NTCon {}) (NType {}) = pure True
-  mismatchNF defs (NType {}) (NTCon {}) = pure True
-
--- NBind is apart from NType
-  mismatchNF defs (NBind {}) (NType {}) = pure True
-  mismatchNF defs (NType {}) (NBind {}) = pure True
-
-  mismatchNF _ _ _ = pure False
+  mismatchNF (VPrimVal {}) (VDCon {}) = pure True
+  mismatchNF (VDCon {}) (VPrimVal {}) = pure True
+  mismatchNF (VPrimVal {}) (VBind {}) = pure True
+  mismatchNF (VBind {}) (VPrimVal {}) = pure True
+  mismatchNF (VPrimVal {}) (VTCon {}) = pure True
+  mismatchNF (VTCon {}) (VPrimVal {}) = pure True
+  mismatchNF (VPrimVal {}) (VType {}) = pure True
+  mismatchNF (VType {}) (VPrimVal {}) = pure True
+
+  -- NTCon is apart from NBind, and NType
+  mismatchNF (VTCon {}) (VBind {}) = pure True
+  mismatchNF (VBind {}) (VTCon {}) = pure True
+  mismatchNF (VTCon {}) (VType {}) = pure True
+  mismatchNF (VType {}) (VTCon {}) = pure True
+
+  -- NBind is apart from NType
+  mismatchNF (VBind {}) (VType {}) = pure True
+  mismatchNF (VType {}) (VBind {}) = pure True
+
+  mismatchNF _ _ = pure False
 
   mismatch : {auto c : Ref Ctxt Defs} ->
              {vars : _} ->
-             Defs -> (Closure vars, Closure vars) -> Core Bool
-  mismatch defs (x, y)
-      = mismatchNF defs !(evalClosure defs x) !(evalClosure defs y)
+             (Glued vars, Glued vars) -> Core Bool
+  mismatch (x, y)
+      = mismatchNF !(expand x) !(expand y)
 
 -- If the terms have the same type constructor at the head, and one of
 -- the argument positions has different constructors at its head, then this
@@ -93,58 +103,150 @@ mutual
 export
 impossibleOK : {auto c : Ref Ctxt Defs} ->
                {vars : _} ->
-               Defs -> NF vars -> NF vars -> Core Bool
-impossibleOK defs (NTCon _ xn xa xargs) (NTCon _ yn ya yargs)
+               NF vars -> NF vars -> Core Bool
+impossibleOK (VTCon _ xn xa xargs) (VTCon _ yn ya yargs)
     = if xn /= yn
          then pure True
-         else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
+         else do xargsNF <- traverseSnocList value xargs
+                 yargsNF <- traverseSnocList value yargs
+                 anyM mismatch (zip xargsNF yargsNF)
 -- If it's a data constructor, any mismatch will do
-impossibleOK defs (NDCon _ _ xt _ xargs) (NDCon _ _ yt _ yargs)
+impossibleOK (VDCon _ _ xt _ xargs) (VDCon _ _ yt _ yargs)
     = if xt /= yt
          then pure True
-         else anyM (mismatch defs) (zipWith (curry $ mapHom snd) xargs yargs)
-impossibleOK defs (NPrimVal _ x) (NPrimVal _ y) = pure (x /= y)
-
--- NPrimVal is apart from NDCon, NTCon, NBind, and NType
-impossibleOK defs (NPrimVal {}) (NDCon {}) = pure True
-impossibleOK defs (NDCon {}) (NPrimVal {}) = pure True
-impossibleOK defs (NPrimVal {}) (NBind {}) = pure True
-impossibleOK defs (NBind {}) (NPrimVal {}) = pure True
-impossibleOK defs (NPrimVal {}) (NTCon {}) = pure True
-impossibleOK defs (NTCon {}) (NPrimVal {}) = pure True
-impossibleOK defs (NPrimVal {}) (NType {}) = pure True
-impossibleOK defs (NType {}) (NPrimVal {}) = pure True
-
--- NTCon is apart from NBind, and NType
-impossibleOK defs (NTCon {}) (NBind {}) = pure True
-impossibleOK defs (NBind {}) (NTCon {}) = pure True
-impossibleOK defs (NTCon {}) (NType {}) = pure True
-impossibleOK defs (NType {}) (NTCon {}) = pure True
-
--- NBind is apart from NType
-impossibleOK defs (NBind {}) (NType {}) = pure True
-impossibleOK defs (NType {}) (NBind {}) = pure True
-
-impossibleOK defs x y = pure False
+         else do xargsNF <- traverseSnocList value xargs
+                 yargsNF <- traverseSnocList value yargs
+                 anyM mismatch (zip xargsNF yargsNF)
+impossibleOK (VPrimVal _ x) (VPrimVal _ y) = pure (x /= y)
+
+-- VPrimVal is apart from VDCon, VTCon, VBind, and VType
+impossibleOK (VPrimVal {}) (VDCon {}) = pure True
+impossibleOK (VDCon {}) (VPrimVal {}) = pure True
+impossibleOK (VPrimVal {}) (VBind {}) = pure True
+impossibleOK (VBind {}) (VPrimVal {}) = pure True
+impossibleOK (VPrimVal {}) (VTCon {}) = pure True
+impossibleOK (VTCon {}) (VPrimVal {}) = pure True
+impossibleOK (VPrimVal {}) (VType {}) = pure True
+impossibleOK (VType {}) (VPrimVal {}) = pure True
+
+-- VTCon is apart from VBind, and VType
+impossibleOK (VTCon {}) (VBind {}) = pure True
+impossibleOK (VBind {}) (VTCon {}) = pure True
+impossibleOK (VTCon {}) (VType {}) = pure True
+impossibleOK (VType {}) (VTCon {}) = pure True
+
+-- VBind is apart from VType
+impossibleOK (VBind {}) (VType {}) = pure True
+impossibleOK (VType {}) (VBind {}) = pure True
+
+impossibleOK x y = pure False
 
 export
 impossibleErrOK : {auto c : Ref Ctxt Defs} ->
-                  Defs -> Error -> Core Bool
-impossibleErrOK defs (CantConvert fc gam env l r)
-    = do let defs = { gamma := gam } defs
-         impossibleOK defs !(nf defs env l)
-                           !(nf defs env r)
-impossibleErrOK defs (CantSolveEq fc gam env l r)
-    = do let defs = { gamma := gam } defs
-         impossibleOK defs !(nf defs env l)
-                           !(nf defs env r)
-impossibleErrOK defs (CyclicMeta {}) = pure True
-impossibleErrOK defs (AllFailed errs)
-    = allM (impossibleErrOK defs) (map snd errs)
-impossibleErrOK defs (WhenUnifying _ _ _ _ _ err)
-    = impossibleErrOK defs err
-impossibleErrOK defs ImpossibleCase = pure True
-impossibleErrOK defs _ = pure False
+                  Error -> Core Bool
+impossibleErrOK (CantConvert fc gam env l r)
+    = do defs' <- get Ctxt
+         put Ctxt ({ gamma := gam } defs')
+         res <- impossibleOK !(expand !(nf env l))
+                             !(expand !(nf env r))
+         put Ctxt defs'
+         pure res
+impossibleErrOK (CantSolveEq fc gam env l r)
+    = do defs' <- get Ctxt
+         put Ctxt ({ gamma := gam } defs')
+         res <- impossibleOK !(expand !(nf env l))
+                             !(expand !(nf env r))
+         put Ctxt defs'
+         pure res
+impossibleErrOK (BadDotPattern _ _ ErasedArg _ _) = pure True
+impossibleErrOK (CyclicMeta _ _ _ _) = pure True
+impossibleErrOK (AllFailed errs)
+    = anyM impossibleErrOK (map snd errs)
+impossibleErrOK (WhenUnifying _ _ _ _ _ err)
+    = impossibleErrOK err
+impossibleErrOK ImpossibleCase = pure True
+impossibleErrOK _ = pure False
+
+-- If it's a clause we've generated, see if the error is recoverable. That
+-- is, if we have a concrete thing, and we're expecting the same concrete
+-- thing, or a function of something, then we might have a match.
+export
+recoverable : {auto c : Ref Ctxt Defs} ->
+              {vars : _} ->
+              NF vars -> NF vars -> Core Bool
+-- Unlike the above, any mismatch will do
+
+-- TYPE CONSTRUCTORS
+recoverable (VTCon _ xn xa xargs) (VTCon _ yn ya yargs)
+    = if xn /= yn
+         then pure False
+         else do xargsNF <- traverseSnocList value xargs
+                 yargsNF <- traverseSnocList value yargs
+                 pure $ not !(anyM mismatch (zip xargsNF yargsNF))
+-- Type constructor vs. primitive type
+recoverable (VTCon _ _ _ _) (VPrimVal _ _) = pure False
+recoverable (VPrimVal _ _) (VTCon _ _ _ _) = pure False
+-- Type constructor vs. type
+recoverable (VTCon _ _ _ _) (VType _ _) = pure False
+recoverable (VType _ _) (VTCon _ _ _ _) = pure False
+-- Type constructor vs. binder
+recoverable (VTCon _ _ _ _) (VBind _ _ _ _) = pure False
+recoverable (VBind _ _ _ _) (VTCon _ _ _ _) = pure False
+
+recoverable (VTCon _ _ _ _) _ = pure True
+recoverable _ (VTCon _ _ _ _) = pure True
+
+-- DATA CONSTRUCTORS
+recoverable (VDCon _ _ xt _ xargs) (VDCon _ _ yt _ yargs)
+    = if xt /= yt
+         then pure False
+         else do xargsNF <- traverseSnocList value xargs
+                 yargsNF <- traverseSnocList value yargs
+                 pure $ not !(anyM mismatch (zip xargsNF yargsNF))
+-- Data constructor vs. primitive constant
+recoverable (VDCon _ _ _ _ _) (VPrimVal _ _) = pure False
+recoverable (VPrimVal _ _) (VDCon _ _ _ _ _) = pure False
+
+recoverable (VDCon _ _ _ _ _) _ = pure True
+recoverable _ (VDCon _ _ _ _ _) = pure True
+
+-- FUNCTION CALLS
+recoverable (VApp _ _ _ _ _) (VApp _ _ _ _ _)
+    = pure True -- both functions; recoverable
+
+-- PRIMITIVES
+recoverable (VPrimVal _ x) (VPrimVal _ y) = pure (x == y)
+-- primitive vs. binder
+recoverable (VPrimVal _ _) (VBind _ _ _ _) = pure False
+recoverable (VBind _ _ _ _) (VPrimVal _ _) = pure False
+
+-- OTHERWISE: no
+recoverable x y = pure False
+
+export
+recoverableErr : {auto c : Ref Ctxt Defs} ->
+                 Error -> Core Bool
+recoverableErr (CantConvert fc gam env l r)
+  = do defs' <- get Ctxt
+       put Ctxt ({ gamma := gam } defs')
+       ok <- recoverable !(expand !(nf env l))
+                         !(expand !(nf env r))
+       put Ctxt defs'
+       pure ok
+
+recoverableErr (CantSolveEq fc gam env l r)
+  = do defs' <- get Ctxt
+       put Ctxt ({ gamma := gam } defs')
+       ok <- recoverable !(expand !(nf env l))
+                         !(expand !(nf env r))
+       put Ctxt defs'
+       pure ok
+recoverableErr (BadDotPattern _ _ ErasedArg _ _) = pure True
+recoverableErr (AllFailed errs)
+    = anyM recoverableErr (map snd errs)
+recoverableErr (WhenUnifying _ _ _ _ _ err)
+    = recoverableErr err
+recoverableErr _ = pure False
 
 -- Given a type checked LHS and its type, return the environment in which we
 -- should check the RHS, the LHS and its type in that environment,
@@ -164,13 +266,13 @@ extendEnv env p nest (Bind _ n (PVar fc c pi tmty) sc) (Bind _ n' (PVTy {}) tysc
   extendEnv env p nest (Bind _ n (PVar fc c pi tmty) sc) (Bind _ n' (PVTy {}) tysc) | Nothing
       = throw (InternalError "Can't happen: names don't match in pattern type")
   extendEnv env p nest (Bind _ n (PVar fc c pi tmty) sc) (Bind _ n (PVTy {}) tysc) | (Just Refl)
-      = extendEnv (PVar fc c pi tmty :: env) (Drop p) (weaken (dropName n nest)) sc tysc
+      = extendEnv (Env.bind env $ PVar fc c pi tmty) (Drop p) (weaken (dropName n nest)) sc tysc
 extendEnv env p nest (Bind _ n (PLet fc c tmval tmty) sc) (Bind _ n' (PLet {}) tysc) with (nameEq n n')
   extendEnv env p nest (Bind _ n (PLet fc c tmval tmty) sc) (Bind _ n' (PLet {}) tysc) | Nothing
       = throw (InternalError "Can't happen: names don't match in pattern type")
   -- PLet on the left becomes Let on the right, to give it computational force
   extendEnv env p nest (Bind _ n (PLet fc c tmval tmty) sc) (Bind _ n (PLet {}) tysc) | (Just Refl)
-      = extendEnv (Let fc c tmval tmty :: env) (Drop p) (weaken (dropName n nest)) sc tysc
+      = extendEnv (Env.bind env $ Let fc c tmval tmty) (Drop p) (weaken (dropName n nest)) sc tysc
 extendEnv env p nest tm ty
       = pure (_ ** (p, env, nest, tm, ty))
 
@@ -195,7 +297,10 @@ findLinear top bound rig tm
               => do defs <- get Ctxt
                     Just nty <- lookupTyExact n (gamma defs)
                          | Nothing => pure []
-                    findLinArg (accessible nt rig) !(nf defs Env.empty nty) args
+                    logTerm "declare.def.lhs" 5 ("Type of " ++ show !(toFullNames n)) nty
+                    logTermNF "declare.def.lhs" 5 ("Type NF of " ++ show !(toFullNames n)) Env.empty nty
+                    log "declare.def.lhs" 5 ("Args: " ++ show !(traverse toFullNames args))
+                    findLinArg (accessible nt rig) !(expand !(nf Env.empty nty)) args
            _ => pure []
     where
       accessible : NameType -> RigCount -> RigCount
@@ -205,25 +310,26 @@ findLinear top bound rig tm
       findLinArg : {vars : _} ->
                    RigCount -> ClosedNF -> List (Term vars) ->
                    Core (List (Name, RigCount))
-      findLinArg rig ty@(NBind _ _ (Pi _ c _ _) _) (As fc u a p :: as)
+      findLinArg rig ty@(VBind _ _ (Pi _ c _ _) _) (As fc u a p :: as)
           = if isLinear c
                then case u of
                          UseLeft => findLinArg rig ty (p :: as)
                          UseRight => findLinArg rig ty (a :: as)
+               -- Yaffle: else findLinArg rig ty (as :< p :< a)
                else pure $ !(findLinArg rig ty [a]) ++ !(findLinArg rig ty (p :: as))
-      findLinArg rig (NBind _ x (Pi _ c _ _) sc) (Local {name=a} fc _ idx prf :: as)
+      findLinArg rig (VBind _ x (Pi _ c _ _) sc) (Local {name=a} fc _ idx prf :: as)
           = do defs <- get Ctxt
                let a = nameAt prf
                if idx < bound
-                 then do sc' <- sc defs (toClosure defaultOpts Env.empty (Ref fc Bound x))
+                 then do sc' <- expand !(sc (pure (vRef fc Bound x)))
                          pure $ (a, rigMult c rig) ::
                                     !(findLinArg rig sc' as)
-                 else do sc' <- sc defs (toClosure defaultOpts Env.empty (Ref fc Bound x))
+                 else do sc' <- expand !(sc (pure (vRef fc Bound x)))
                          findLinArg rig sc' as
-      findLinArg rig (NBind fc x (Pi _ c _ _) sc) (a :: as)
+      findLinArg rig (VBind fc x (Pi _ c _ _) sc) (a :: as)
           = do defs <- get Ctxt
                pure $ !(findLinear False bound (c |*| rig) a) ++
-                      !(findLinArg rig !(sc defs (toClosure defaultOpts Env.empty (Ref fc Bound x))) as)
+                      !(findLinArg rig !(expand !(sc (pure (vRef fc Bound x)))) as)
       findLinArg rig ty (a :: as)
           = pure $ !(findLinear False bound rig a) ++ !(findLinArg rig ty as)
       findLinArg _ _ [] = pure []
@@ -309,7 +415,7 @@ checkLHS {vars} trans mult n opts nest env fc lhs_in
 
          lhs <- if trans
                    then pure lhs_bound
-                   else implicitsAs n defs vars lhs_bound
+                   else implicitsAs n defs (asList vars) lhs_bound
 
          logC "declare.def.lhs" 5 $ do pure $ "Checking LHS of " ++ show !(getFullName (Resolved n))
 -- todo: add Pretty RawImp instance
@@ -324,7 +430,7 @@ checkLHS {vars} trans mult n opts nest env fc lhs_in
                      elabTerm n lhsMode opts nest env
                                 (IBindHere fc PATTERN lhs) Nothing
          logTerm "declare.def.lhs" 5 "Checked LHS term" lhstm
-         lhsty <- getTerm lhstyg
+         lhsty <- quote env lhstyg
 
          defs <- get Ctxt
          let lhsenv = letToLam env
@@ -332,13 +438,14 @@ checkLHS {vars} trans mult n opts nest env fc lhs_in
          -- patterns were allowed, but now they're fully normalised anyway
          -- so we only need to do the holes. If there's a lot of type level
          -- computation, this is a huge saving!
-         lhstm <- normaliseHoles defs lhsenv lhstm
-         lhsty <- normaliseHoles defs env lhsty
+         lhstm <- normaliseHoles lhsenv lhstm
+         lhsty <- normaliseHoles env lhsty
          linvars_in <- findLinear True 0 linear lhstm
          logTerm "declare.def.lhs" 10 "Checked LHS term after normalise" lhstm
          log "declare.def.lhs" 5 $ "Linearity of names in " ++ show n ++ ": " ++
                  show linvars_in
 
+         logTerm "declare.def.lhs" 10 "lhsty" lhsty
          linvars <- combineLinear fc linvars_in
          let lhstm_lin = setLinear linvars lhstm
          let lhsty_lin = setLinear linvars lhsty
@@ -359,8 +466,8 @@ hasEmptyPat : {vars : _} ->
               {auto c : Ref Ctxt Defs} ->
               Defs -> Env Term vars -> Term vars -> Core Bool
 hasEmptyPat defs env (Bind fc x b sc)
-   = pure $ !(isEmpty defs env !(nf defs env (binderType b)))
-            || !(hasEmptyPat defs (b :: env) sc)
+   = pure $ !(isEmpty defs env !(expand !(nf env (binderType b))))
+            || !(hasEmptyPat defs (Env.bind env b) sc)
 hasEmptyPat defs env _ = pure False
 
 -- For checking with blocks as nested names
@@ -370,7 +477,7 @@ applyEnv : {vars : _} ->
            Core (Name, (Maybe Name, List (Var vars), FC -> NameType -> Term vars))
 applyEnv env withname
     = do n' <- resolveName withname
-         pure (withname, (Just withname, reverse (allVarsNoLet env),
+         pure (withname, (Just withname, VarSet.asList $ allVarsNoLet env,
                   \fc, nt => applyTo fc
                          (Ref fc nt (Resolved n')) env))
 
@@ -401,15 +508,14 @@ checkClause mult vis totreq hashit n opts nest env (ImpossibleClause fc lhs)
                            elabTerm n (InLHS mult) opts nest env
                                       (IBindHere fc COVERAGE lhs) Nothing
                defs <- get Ctxt
-               lhs <- normaliseHoles defs env lhstm
+               lhs <- normaliseHoles env lhstm
                if !(hasEmptyPat defs env lhs)
                   then pure (Left lhs_raw)
                   else throw (ValidCase fc env (Left lhs)))
            (\err =>
               case err of
                    ValidCase {} => throw err
-                   _ => do defs <- get Ctxt
-                           if !(impossibleErrOK defs err)
+                   _ => do if !(impossibleErrOK err)
                               then pure (Left lhs_raw)
                               else throw (ValidCase fc env (Right err)))
 checkClause {vars} mult vis totreq hashit n opts nest env (PatClause fc lhs_in rhs)
@@ -418,10 +524,14 @@ checkClause {vars} mult vis totreq hashit n opts nest env (PatClause fc lhs_in r
          let rhsMode = if isErased mult then InType else InExpr
          log "declare.def.clause" 5 $ "Checking RHS " ++ show rhs
          logEnv "declare.def.clause" 5 "In env" env'
+         logTerm "declare.def.clause" 5 "lhsty_backtick" lhsty'
+
+         lhsty' <- nf env' lhsty'
+         logNF "declare.def.clause" 5 "lhsty_backtick NF" env' lhsty'
 
          rhstm <- logTime 3 ("Check RHS " ++ show fc) $
                     wrapErrorC opts (InRHS fc !(getFullName (Resolved n))) $
-                       checkTermSub n rhsMode opts nest' env' env sub' rhs (gnf env' lhsty')
+                       checkTermSub n rhsMode opts nest' env' env sub' rhs lhsty'
          clearHoleLHS
 
          logTerm "declare.def.clause" 3 "RHS term" rhstm
@@ -452,10 +562,9 @@ checkClause {vars} mult vis totreq hashit n opts nest env
 
          logTerm "declare.def.clause.with" 5 "With value (at quantity \{show rig})" wval
          logTerm "declare.def.clause.with" 3 "Required type" reqty
-         wvalTy <- getTerm gwvalTy
-         defs <- get Ctxt
-         wval <- normaliseHoles defs env' wval
-         wvalTy <- normaliseHoles defs env' wvalTy
+         wvalTy <- quote env' gwvalTy
+         wval <- normaliseHoles env' wval
+         wvalTy <- normaliseHoles env' wvalTy
 
          let (wevars ** withSub) = keepOldEnv sub' (snd (findSubEnv env' wval))
          logTerm "declare.def.clause.with" 5 "With value type" wvalTy
@@ -477,14 +586,17 @@ checkClause {vars} mult vis totreq hashit n opts nest env
          let bnr = bindNotReq vfc 0 env' withSub [] reqty
          let notreqns = fst bnr
          let notreqty = snd bnr
+         logTerm "declare.def.clause.with" 5 "notreqty" notreqty
 
-         rdefs <- if Syntactic `elem` flags
-                     then clearDefs defs
-                     else pure defs
-         wtyScope <- replace rdefs scenv !(nf rdefs scenv (weakenNs (mkSizeOf wargs) wval))
+         let repFn = if Syntactic `elem` flags
+                       then replaceSyn
+                       else replace
+         wtyScope <- repFn scenv !(nf scenv (weakenNs (mkSizeOf wargs) wval))
                             var
-                            !(nf rdefs scenv
+                            !(nf scenv
                                  (weakenNs (mkSizeOf wargs) notreqty))
+         logTerm "declare.def.clause.with" 3 "wtyScope" wtyScope
+
          let bNotReq = binder wtyScope
 
          -- The environment has some implicit and some explcit args, potentially,
@@ -529,7 +641,7 @@ checkClause {vars} mult vis totreq hashit n opts nest env
          log "declare.def.clause.with" 3 $ "Applying to with argument " ++ show rhs_in
          rhs <- wrapErrorC opts (InRHS ifc !(getFullName (Resolved n))) $
              checkTermSub n wmode opts nest' env' env sub' rhs_in
-                          (gnf env' reqty)
+                          !(nf env' reqty)
 
          -- Generate new clauses by rewriting the matched arguments
          cs' <- traverse (mkClauseWith 1 wname wargNames lhs) cs
@@ -551,23 +663,23 @@ checkClause {vars} mult vis totreq hashit n opts nest env
        (rig : RigCount) -> (wvalTy : Term xs) -> Maybe ((RigCount, Name), Term xs) ->
        (wvalEnv : Env Term xs) ->
        Core (ext : Scope
-         ** ( Env Term (ext ++ xs)
-            , Term (ext ++ xs)
-            , (Term (ext ++ xs) -> Term xs)
+         ** ( Env Term (Scope.addInner xs ext)
+            , Term (Scope.addInner xs ext)
+            , (Term (Scope.addInner xs ext) -> Term xs)
             ))
     bindWithArgs {xs} rig wvalTy Nothing wvalEnv =
       let wargn : Name
           wargn = MN "warg" 0
           wargs : Scope
-          wargs = [wargn]
+          wargs = [<wargn]
 
-          scenv : Env Term (wargs ++ xs)
-                := Pi vfc top Explicit wvalTy :: wvalEnv
+          scenv : Env Term (Scope.addInner xs wargs)
+                := wvalEnv :< Pi vfc top Explicit wvalTy
 
-          var : Term (wargs ++ xs)
+          var : Term (Scope.addInner xs wargs)
               := Local vfc (Just False) Z First
 
-          binder : Term (wargs ++ xs) -> Term xs
+          binder : Term (Scope.addInner xs wargs) -> Term xs
                  := Bind vfc wargn (Pi vfc rig Explicit wvalTy)
 
       in pure (wargs ** (scenv, var, binder))
@@ -583,26 +695,26 @@ checkClause {vars} mult vis totreq hashit n opts nest env
       let wargn : Name
           wargn = MN "warg" 0
           wargs : Scope
-          wargs = [name, wargn]
+          wargs = [<wargn, name]
 
           wvalTy' := weaken wvalTy
-          eqTy : Term (MN "warg" 0 :: xs)
+          eqTy : Term (xs :< MN "warg" 0)
                := apply vfc eqTyCon
-                           [ wvalTy'
-                           , wvalTy'
-                           , weaken wval
-                           , Local vfc (Just False) Z First
+                           [ (erased, wvalTy')
+                           , (erased, wvalTy')
+                           , (top, weaken wval)
+                           , (top, Local vfc (Just False) Z First)
                            ]
 
-          scenv : Env Term (wargs ++ xs)
-                := Pi vfc top Implicit eqTy
-                :: Pi vfc top Explicit wvalTy
-                :: wvalEnv
+          scenv : Env Term (Scope.addInner xs wargs)
+                := wvalEnv
+                :< Pi vfc top Explicit wvalTy
+                :< Pi vfc top Implicit eqTy
 
-          var : Term (wargs ++ xs)
+          var : Term (Scope.addInner xs wargs)
               := Local vfc (Just False) (S Z) (Later First)
 
-          binder : Term (wargs ++ xs) -> Term xs
+          binder : Term (Scope.addInner xs wargs) -> Term xs
                  := \ t => Bind vfc wargn (Pi vfc rig Explicit wvalTy)
                          $ Bind vfc name  (Pi vfc rigPrf Implicit eqTy) t
 
@@ -616,16 +728,16 @@ checkClause {vars} mult vis totreq hashit n opts nest env
                  (vs'' : Scope ** Thin vs'' vs)
     keepOldEnv {vs} Refl p = (vs ** Refl)
     keepOldEnv {vs} p Refl = (vs ** Refl)
-    keepOldEnv (Drop p) (Drop p')
+    keepOldEnv {vs = _ :< _} (Drop p) (Drop p')
         = let (_ ** rest) = keepOldEnv p p' in
               (_ ** Drop rest)
-    keepOldEnv (Drop p) (Keep p')
+    keepOldEnv {vs = _ :< _} (Drop p) (Keep p')
         = let (_ ** rest) = keepOldEnv p p' in
               (_ ** Keep rest)
-    keepOldEnv (Keep p) (Drop p')
+    keepOldEnv {vs = _ :< _} (Keep p) (Drop p')
         = let (_ ** rest) = keepOldEnv p p' in
               (_ ** Keep rest)
-    keepOldEnv (Keep p) (Keep p')
+    keepOldEnv {vs = _ :< _} (Keep p) (Keep p')
         = let (_ ** rest) = keepOldEnv p p' in
               (_ ** Keep rest)
 
@@ -660,16 +772,16 @@ calcRefs rt at fn
     = do defs <- get Ctxt
          Just gdef <- lookupCtxtExact fn (gamma defs)
               | _ => pure ()
-         let PMDef r cargs tree_ct tree_rt pats = definition gdef
+         let Function r tree_ct tree_rt pats = definition gdef
               | _ => pure () -- not a function definition
          let refs : Maybe (NameMap Bool)
                   = if rt then refersToRuntimeM gdef else refersToM gdef
          let Nothing = refs
               | Just _ => pure () -- already done
-         let tree : CaseTree cargs = if rt then tree_rt else tree_ct
-         let metas = CaseTree.getMetas tree
+         let tree : Term [<] = if rt then tree_rt else tree_ct
+         let metas = TT.getMetas tree
          traverse_ addToSave (keys metas)
-         let refs_all = addRefs at metas tree
+         let refs_all = TT.addRefs False at metas tree
          refs <- ifThenElse rt
                     (dropErased (keys refs_all) refs_all)
                     (pure refs_all)
@@ -694,8 +806,8 @@ mkRunTime : {auto c : Ref Ctxt Defs} ->
             {auto u : Ref UST UState} ->
             {auto s : Ref Syn SyntaxInfo} ->
             {auto o : Ref ROpts REPLOpts} ->
-            FC -> Name -> Core ()
-mkRunTime fc n
+            FC -> (CaseType, Name) -> Core ()
+mkRunTime fc (ct, n)
     = do logC "compile.casetree" 5 $ do pure $ "Making run time definition for " ++ show !(toFullNames n)
          defs <- get Ctxt
          Just gdef <- lookupCtxtExact n (gamma defs)
@@ -703,21 +815,19 @@ mkRunTime fc n
          let cov = gdef.totality.isCovering
          -- If it's erased at run time, don't build the tree
          when (not (isErased $ multiplicity gdef)) $ do
-           let PMDef r cargs tree_ct _ pats = definition gdef
+           let Function r tree_ct _ (Just pats) = definition gdef
                 | _ => pure () -- not a function definition
            let ty = type gdef
            -- Prepare RHS of definitions, by erasing 0-multiplicities, and
            -- finding any applications to specialise (partially evaluate)
-           pats' <- traverse (toErased (location gdef) (getSpec (flags gdef)))
-                             pats
+           pats' <- traverse (toErased (location gdef) (getSpec (flags gdef))) pats
 
-           let clauses_init = map (toClause (location gdef)) pats'
            clauses <- case cov of
-                           MissingCases _ => do log "compile.casetree.missing" 5 $ "Adding uncovered error to \{show clauses_init}"
-                                                pure $ addErrorCase clauses_init
-                           _ => pure clauses_init
+                           MissingCases _ => do log "compile.casetree.missing" 5 $ "Adding uncovered error to \{show pats'}"
+                                                pure $ addErrorCase pats'
+                           _ => pure pats'
 
-           (rargs ** (tree_rt, _)) <- getPMDef (location gdef) RunTime n ty clauses
+           (tree_rt, _) <- getPMDef (location gdef) ct RunTime n ty clauses
            logC "compile.casetree" 5 $ do
              tree_rt <- toFullNames tree_rt
              pure $ unlines
@@ -725,41 +835,18 @@ mkRunTime fc n
                , "Runtime tree for " ++ show (fullname gdef) ++ ":"
                , show (indent 2 $ prettyTree tree_rt)
                ]
-           log "compile.casetree" 10 $ show tree_rt
-           log "compile.casetree.measure" 15 $ show (measure tree_rt)
-
-           let Just Refl = scopeEq cargs rargs
-                   | Nothing => throw (InternalError "WAT")
            ignore $ addDef n $
-                       { definition := PMDef r rargs tree_ct tree_rt pats
+                       { definition := Function r tree_ct tree_rt (Just pats)
                        } gdef
-           -- If it's a case block, and not already set as inlinable or forced
-           -- to not be inlinable, check if it's safe to inline
-           when (caseName !(toFullNames n) && noInline (flags gdef)) $
-             do inl <- canInlineCaseBlock n
-                when inl $ do
-                  logC "compiler.inline.eval" 5 $ do pure "Marking \{show !(toFullNames n)} for inlining in runtime case tree."
-                  setFlag fc n Inline
   where
-    -- check if the flags contain explicit inline or noinline directives:
-    noInline : List DefFlag -> Bool
-    noInline (Inline :: _)   = False
-    noInline (NoInline :: _) = False
-    noInline (x :: xs) = noInline xs
-    noInline _ = True
-
-    caseName : Name -> Bool
-    caseName (CaseBlock {}) = True
-    caseName (NS _ n) = caseName n
-    caseName _ = False
-
     mkCrash : {vars : _} -> String -> Term vars
     mkCrash msg
        = apply fc (Ref fc Func (UN $ Basic "prim__crash"))
-               [Erased fc Placeholder, PrimVal fc (Str msg)]
+               [(erased, Erased fc Placeholder),
+                (top, PrimVal fc (Str msg))]
 
     matchAny : Term vars -> Term vars
-    matchAny (App fc f a) = App fc (matchAny f) (Erased fc Placeholder)
+    matchAny (App fc f c a) = App fc (matchAny f) c (Erased fc Placeholder)
     matchAny tm = tm
 
     makeErrorClause : {vars : _} -> Env Term vars -> Term vars -> Clause
@@ -779,19 +866,16 @@ mkRunTime fc n
     getSpec (x :: xs) = getSpec xs
 
     toErased : FC -> Maybe (List (Name, Nat)) ->
-               (vars ** (Env Term vars, Term vars, Term vars)) ->
-               Core (vars ** (Env Term vars, Term vars, Term vars))
-    toErased fc spec (_ ** (env, lhs, rhs))
-        = do lhs_erased <- linearCheck fc linear True env lhs
+               Clause ->
+               Core Clause
+    toErased fc spec (MkClause env lhs rhs)
+        = do lhs_erased <- erase linear env lhs
              -- Partially evaluate RHS here, where appropriate
              rhs' <- applyTransforms env rhs
-             rhs' <- applySpecialise env spec rhs'
-             rhs_erased <- linearCheck fc linear True env rhs'
-             pure (_ ** (env, lhs_erased, rhs_erased))
-
-    toClause : FC -> (vars ** (Env Term vars, Term vars, Term vars)) -> Clause
-    toClause fc (_ ** (env, lhs, rhs))
-        = MkClause env lhs rhs
+             -- Yaffle has no it
+             -- rhs' <- applySpecialise env spec rhs'
+             rhs_erased <- erase linear env rhs'
+             pure (MkClause env lhs_erased rhs_erased)
 
 compileRunTime : {auto c : Ref Ctxt Defs} ->
                  {auto m : Ref MD Metadata} ->
@@ -802,14 +886,10 @@ compileRunTime : {auto c : Ref Ctxt Defs} ->
 compileRunTime fc atotal
     = do defs <- get Ctxt
          traverse_ (mkRunTime fc) (toCompileCase defs)
-         traverse_ (calcRefs True atotal) (toCompileCase defs)
+         traverse_ (calcRefs True atotal) (map snd $ toCompileCase defs)
 
          update Ctxt { toCompileCase := [] }
 
-toPats : Clause -> (vs ** (Env Term vs, Term vs, Term vs))
-toPats (MkClause {vars} env lhs rhs)
-    = (_ ** (env, lhs, rhs))
-
 warnUnreachable : {auto c : Ref Ctxt Defs} ->
                   Clause -> Core ()
 warnUnreachable (MkClause env lhs rhs)
@@ -889,6 +969,8 @@ processDef : {vars : _} ->
 processDef opts nest env fc n_in cs_in
   = do n <- inCurrentNS n_in
        withDefStacked n $ do
+         logC "declare.def" 50 $ do pure "For \{show n} NS: \{show $ (!getNS :: !getNestedNS)}"
+
          defs <- get Ctxt
          Just gdef <- lookupOrAddAlias opts nest env fc n cs_in
            | Nothing => noDeclaration fc n
@@ -907,24 +989,27 @@ processDef opts nest env fc n_in cs_in
 
          -- Dynamically rebind default totality requirement to this function's totality requirement
          -- and use this requirement when processing `with` blocks
-         log "declare.def" 5 $ "Traversing clauses of " ++ show n ++ " with mult " ++ show mult
+         log "declare.def" 5 $ "Traversing clauses of " ++ show n ++ " with mult " ++ show mult ++ " in " ++ show cs_in
          let treq = fromMaybe !getDefaultTotalityOption (findSetTotal (flags gdef))
          cs <- withTotality treq $
                traverse (checkClause mult (collapseDefault $ visibility gdef) treq
                                      hashit nidx opts nest env) cs_in
 
-         let pats = map toPats (rights cs)
+         let pats = rights cs
 
-         (cargs ** (tree_ct, unreachable)) <-
+         let ct = if elem InCase opts then CaseBlock n else PatMatch
+         (tree_ct, unreachable) <-
              logTime 3 ("Building compile time case tree for " ++ show n) $
-                getPMDef fc (CompileTime mult) n ty (rights cs)
+                getPMDef fc ct (CompileTime mult) n ty pats
 
          traverse_ warnUnreachable unreachable
 
          logC "declare.def" 2 $
                  do t <- toFullNames tree_ct
-                    pure ("Case tree for " ++ show n ++ ": " ++ show t)
-
+                    pure $ unlines
+                      [ "Compile time tree for " ++ show (fullname gdef) ++ ":"
+                      , show (indent 2 $ prettyTree t)
+                      ]
          -- check whether the name was declared in a different source file
          defs <- get Ctxt
          let pi = case lookup n (userHoles defs) of
@@ -934,7 +1019,7 @@ processDef opts nest env fc n_in cs_in
          -- but we'll rebuild that in a later pass once all the case
          -- blocks etc are resolved
          ignore $ addDef (Resolved nidx)
-                  ({ definition := PMDef pi cargs tree_ct tree_ct pats
+                  ({ definition := Function pi tree_ct tree_ct (Just pats)
                    } gdef)
 
          when (collapseDefault (visibility gdef) == Public) $
@@ -947,7 +1032,7 @@ processDef opts nest env fc n_in cs_in
          addToSave n
 
          -- Flag this name as one which needs compiling
-         update Ctxt { toCompileCase $= (n ::) }
+         update Ctxt { toCompileCase $= ((ct, n) ::) }
 
          atotal <- toResolvedNames (NS builtinNS (UN $ Basic "assert_total"))
          logTime 3 ("Building size change graphs " ++ show n) $
@@ -1008,30 +1093,33 @@ processDef opts nest env fc n_in cs_in
                    setUnboundImplicits True
                    (_, lhstm) <- bindNames False itm
                    setUnboundImplicits autoimp
-                   (lhstm, _) <- elabTerm n (InLHS mult) [] (MkNested []) Env.empty
+                   (lhstm, _) <- elabTerm n (InLHS mult) [] (NestedNames.empty) Env.empty
                                     (IBindHere fc COVERAGE lhstm) Nothing
                    defs <- get Ctxt
-                   lhs <- normaliseHoles defs Env.empty lhstm
+                   lhs <- normaliseHoles Env.empty lhstm
                    if !(hasEmptyPat defs Env.empty lhs)
                       then do log "declare.def.impossible" 5 "Some empty pat"
                               put Ctxt ctxt
                               pure Nothing
                       else do log "declare.def.impossible" 5 "No empty pat"
                               empty <- clearDefs ctxt
-                              rtm <- closeEnv empty !(nf empty Env.empty lhs)
+                              rtm <- closeEnv !(nf Env.empty lhs)
                               put Ctxt ctxt
                               pure (Just rtm))
                (\err => do defs <- get Ctxt
-                           if !(impossibleErrOK defs err)
+                           if !(impossibleErrOK err)
                               then do
                                 log "declare.def.impossible" 5 "impossible because \{show err}"
                                 pure Nothing
                               else pure (Just tm))
       where
-        closeEnv : Defs -> ClosedNF -> Core ClosedTerm
-        closeEnv defs (NBind _ x (PVar {}) sc)
-            = closeEnv defs !(sc defs (toClosure defaultOpts Env.empty (Ref fc Bound x)))
-        closeEnv defs nf = quote defs Env.empty nf
+        -- They'll be 'Bind' at the top level already, and we really don't
+        -- want to expand when we get to the clause, so 'Glued' is what we
+        -- want here.
+        closeEnv : Glued Scope.empty -> Core ClosedTerm
+        closeEnv (VBind _ x (PVar {}) sc)
+            = closeEnv !(sc (pure (vRef fc Bound x)))
+        closeEnv nf = quote Env.empty nf
 
     getClause : Either RawImp Clause -> Core (Maybe Clause)
     getClause (Left rawlhs)
@@ -1052,8 +1140,8 @@ processDef opts nest env fc n_in cs_in
                $ "Using clauses :"
                :: map (("  " ++) . show) !(traverse toFullNames covcs')
              let covcs = mapMaybe id covcs'
-             (_ ** (ctree, _)) <-
-                 getPMDef fc (CompileTime mult) (Resolved n) ty covcs
+             (ctree, _) <-
+                 getPMDef fc PatMatch (CompileTime mult) (Resolved n) ty covcs
              logC "declare.def" 3 $ do pure $ "Working from " ++ show !(toFullNames ctree)
              missCase <- if any catchAll covcs
                             then do logC "declare.def" 3 $ do pure "Catch all case in \{show !(getFullName (Resolved n))}"
@@ -1063,7 +1151,7 @@ processDef opts nest env fc n_in cs_in
                      do mc <- traverse toFullNames missCase
                         pure ("Initially missing in " ++
                                  show !(getFullName (Resolved n)) ++ ":\n" ++
-                                showSep "\n" (map show mc))
+                                joinBy "\n" (map show mc))
              -- Filter out the ones which are impossible
              missImp <- traverse (checkImpossible n mult) missCase
              -- Filter out the ones which are actually matched (perhaps having
diff --git a/src/TTImp/ProcessFnOpt.idr b/src/TTImp/ProcessFnOpt.idr
index 0b019ab1916..c3d36b0c662 100644
--- a/src/TTImp/ProcessFnOpt.idr
+++ b/src/TTImp/ProcessFnOpt.idr
@@ -2,19 +2,23 @@ module TTImp.ProcessFnOpt
 
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Quote
+import Core.Evaluate.Expand
 
 import TTImp.TTImp
 
+import Data.SnocList
+
 import Libraries.Data.NameMap
 import Libraries.Data.NatSet
 
-getRetTy : Defs -> ClosedNF -> Core Name
-getRetTy defs (NBind fc _ (Pi {}) sc)
-    = getRetTy defs !(sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder)))
-getRetTy defs (NTCon _ n _ _) = pure n
-getRetTy defs ty
+getRetTy : {auto c : Ref Ctxt Defs} -> ClosedNF -> Core Name
+getRetTy (VBind fc _ (Pi {}) sc)
+    = getRetTy !(expand !(sc (pure (VErased fc Placeholder))))
+getRetTy (VTCon _ n _ _) = pure n
+getRetTy ty
     = throw (GenericMsg (getLoc ty)
              "Can only add hints for concrete return types")
 
@@ -50,7 +54,7 @@ processFnOpt fc True ndef (Hint d)
     = do defs <- get Ctxt
          Just ty <- lookupTyExact ndef (gamma defs)
               | Nothing => undefinedName fc ndef
-         target <- getRetTy defs !(nf defs Env.empty ty)
+         target <- getRetTy !(expand !(nf Env.empty ty))
          addHintFor fc target ndef d False
 processFnOpt fc _ ndef (Hint d)
     = do logC "elab" 5 $ do pure $ "Adding local hint " ++ show !(toFullNames ndef)
@@ -78,7 +82,7 @@ processFnOpt fc _ ndef (SpecArgs ns)
     = do defs <- get Ctxt
          Just gdef <- lookupCtxtExact ndef (gamma defs)
               | Nothing => undefinedName fc ndef
-         nty <- nf defs Env.empty (type gdef)
+         nty <- expand !(nf Env.empty (type gdef))
          ps <- getNamePos 0 nty
          ddeps <- collectDDeps nty
          specs <- collectSpec NatSet.empty ddeps ps nty
@@ -95,13 +99,13 @@ processFnOpt fc _ ndef (SpecArgs ns)
 
     -- Collect the argument names which the dynamic args depend on
     collectDDeps : ClosedNF -> Core (List Name)
-    collectDDeps (NBind tfc x (Pi _ _ _ nty) sc)
+    collectDDeps (VBind tfc x (Pi _ _ _ nty) sc)
         = do defs <- get Ctxt
              empty <- clearDefs defs
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Ref tfc Bound x))
+             sc' <- expand !(sc (pure (vRef tfc Bound x)))
              if x `elem` ns
                 then collectDDeps sc'
-                else do aty <- quote empty Env.empty nty
+                else do aty <- quote Env.empty nty
                         -- Get names depended on by nty
                         let deps = keys (getRefs (UN Underscore) aty)
                         rest <- collectDDeps sc'
@@ -110,41 +114,42 @@ processFnOpt fc _ ndef (SpecArgs ns)
 
     -- Return names the type depends on, and whether it's a parameter
     mutual
-      getDepsArgs : Bool -> List ClosedNF -> NameMap Bool ->
+      getDepsArgs : Bool -> SnocList ClosedNF -> NameMap Bool ->
                     Core (NameMap Bool)
-      getDepsArgs inparam [] ns = pure ns
-      getDepsArgs inparam (a :: as) ns
+      getDepsArgs inparam [<] ns = pure ns
+      getDepsArgs inparam (as :< a) ns
           = do ns' <- getDeps inparam a ns
                getDepsArgs inparam as ns'
 
-      getDeps : Bool -> ClosedNF -> NameMap Bool ->
+      getDeps : Bool -> NF [<] -> NameMap Bool ->
                 Core (NameMap Bool)
-      getDeps inparam (NBind _ x (Pi _ _ _ pty) sc) ns
+      getDeps inparam (VBind _ x (Pi _ _ _ pty) sc) ns
           = do defs <- get Ctxt
-               ns' <- getDeps inparam !(evalClosure defs pty) ns
-               sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+               ns' <- getDeps inparam !(expand pty) ns
+               sc' <- expand !(sc (pure (VErased fc Placeholder)))
                getDeps inparam sc' ns'
-      getDeps inparam (NBind _ x b sc) ns
+      getDeps inparam (VBind _ x b sc) ns
           = do defs <- get Ctxt
-               ns' <- getDeps False !(evalClosure defs (binderType b)) ns
-               sc' <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+               ns' <- getDeps False !(expand (binderType b)) ns
+               sc' <- expand !(sc (pure (VErased fc Placeholder)))
                getDeps False sc' ns
-      getDeps inparam (NApp _ (NRef Bound n) args) ns
+      getDeps inparam (VApp _ Bound n args _) ns
           = do defs <- get Ctxt
-               ns' <- getDepsArgs False !(traverse (evalClosure defs . snd) args) ns
+               ns' <- getDepsArgs False !(traverseSnocList spineVal args) ns
                pure (insert n inparam ns')
-      getDeps inparam (NDCon _ n t a args) ns
+      getDeps inparam (VDCon _ n t a args) ns
           = do defs <- get Ctxt
-               getDepsArgs False !(traverse (evalClosure defs . snd) args) ns
-      getDeps inparam (NTCon _ n a args) ns
+               getDepsArgs False !(traverseSnocList spineVal args) ns
+      getDeps inparam (VTCon _ n a args) ns
           = do defs <- get Ctxt
                params <- case !(lookupDefExact n (gamma defs)) of
                               Just (TCon _ ps _ _ _ _ _) => pure ps
                               _ => pure NatSet.empty
-               let (ps, ds) = NatSet.partition params (map snd args)
-               ns' <- getDepsArgs True !(traverse (evalClosure defs) ps) ns
-               getDepsArgs False !(traverse (evalClosure defs) ds) ns'
-      getDeps inparam (NDelayed _ _ t) ns = getDeps inparam t ns
+               let (ps, ds) = NatSet.partition params
+                                      (cast !(traverseSnocList spineVal args))
+               ns' <- getDepsArgs True ps ns
+               getDepsArgs False ds ns'
+      getDeps inparam (VDelayed _ _ t) ns = getDeps inparam !(expand t) ns
       getDeps inparams nf ns = pure ns
 
     -- If the name of an argument is in the list of specialisable arguments,
@@ -155,12 +160,12 @@ processFnOpt fc _ ndef (SpecArgs ns)
                                -- We're assuming it's a short list, so just use
                                -- List and don't worry about duplicates.
                   List (Name, Nat) -> ClosedNF -> Core NatSet
-    collectSpec acc ddeps ps (NBind tfc x (Pi _ _ _ nty) sc)
+    collectSpec acc ddeps ps (VBind tfc x (Pi _ _ _ nty) sc)
         = do defs <- get Ctxt
              empty <- clearDefs defs
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Ref tfc Bound x))
+             sc' <- expand !(sc (pure (vRef tfc Bound x)))
              if x `elem` ns
-                then do deps <- getDeps True !(evalClosure defs nty) NameMap.empty
+                then do deps <- getDeps True !(expand nty) NameMap.empty
                         -- Get names depended on by nty
                         -- Keep the ones which are either:
                         --  * parameters
@@ -174,8 +179,8 @@ processFnOpt fc _ ndef (SpecArgs ns)
     collectSpec acc ddeps ps _ = pure acc
 
     getNamePos : Nat -> ClosedNF -> Core (List (Name, Nat))
-    getNamePos i (NBind tfc x (Pi {}) sc)
+    getNamePos i (VBind tfc x (Pi {}) sc)
         = do defs <- get Ctxt
-             ns' <- getNamePos (1 + i) !(sc defs (toClosure defaultOpts Env.empty (Erased tfc Placeholder)))
+             ns' <- getNamePos (1 + i) !(expand !(sc (pure (VErased tfc Placeholder))))
              pure ((x, i) :: ns')
     getNamePos _ _ = pure []
diff --git a/src/TTImp/ProcessParams.idr b/src/TTImp/ProcessParams.idr
index 35ca12f8b54..b0f0ae0de09 100644
--- a/src/TTImp/ProcessParams.idr
+++ b/src/TTImp/ProcessParams.idr
@@ -3,6 +3,8 @@ module TTImp.ProcessParams
 import Core.Env
 import Core.UnifyState
 import Core.Metadata
+import Core.Evaluate.Value
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -12,6 +14,8 @@ import TTImp.Elab
 import TTImp.Elab.Check
 import TTImp.TTImp
 
+import Data.SnocList
+
 %default covering
 
 extend : {extvs : _} ->
@@ -20,7 +24,7 @@ extend : {extvs : _} ->
          Term extvs ->
          (vars' ** (Thin vs vars', Env Term vars', NestedNames vars'))
 extend env p nest (Bind _ n b@(Pi fc c pi ty) sc)
-    = extend (b :: env) (Drop p) (weaken nest) sc
+    = extend (env :< b) (Drop p) (weaken nest) sc
 extend env p nest tm = (_ ** (p, env, nest))
 
 export
@@ -65,6 +69,6 @@ processParams {vars} {c} {m} {u} nest env fc ps ds
                Core (Name, (Maybe Name, List (Var vs), FC -> NameType -> Term vs))
     applyEnv {vs} env n
           = do n' <- resolveName n -- it'll be Resolved by expandAmbigName
-               pure (Resolved n', (Nothing, reverse (allVars env),
+               pure (Resolved n', (Nothing, VarSet.asList $ allVars env,
                         \fc, nt => applyToFull fc
                                (Ref fc nt (Resolved n')) env))
diff --git a/src/TTImp/ProcessRecord.idr b/src/TTImp/ProcessRecord.idr
index 7f1712befd2..72bff9c0f3b 100644
--- a/src/TTImp/ProcessRecord.idr
+++ b/src/TTImp/ProcessRecord.idr
@@ -164,7 +164,7 @@ elabRecord {vars} eopts fc env nest newns def_vis mbtot tn_in params0 opts conNa
         -- We'll use the `env` thus obtained to unelab the remaining scope
         dropLeadingPis : {vs : _} -> (vars : Scope) -> Term vs -> Env Term vs ->
                          Core (vars' : Scope ** (Env Term vars', Term vars'))
-        dropLeadingPis [] ty env
+        dropLeadingPis [<] ty env
           = do unless (null vars) $
                  logC "declare.record.parameters" 60 $ pure $ unlines
                    [ "We elaborated \{show tn} in a non-empty local context."
@@ -172,8 +172,8 @@ elabRecord {vars} eopts fc env nest newns def_vis mbtot tn_in params0 opts conNa
                    , "  Remaining type: \{show !(toFullNames ty)}"
                    ]
                pure (_ ** (env, ty))
-        dropLeadingPis (var :: vars) (Bind fc n b@(Pi {}) ty) env
-          = dropLeadingPis vars ty (b :: env)
+        dropLeadingPis (vars :< var) (Bind fc n b@(Pi {}) ty) env
+          = dropLeadingPis vars ty (Env.bind env b)
         dropLeadingPis _ ty _ = throw (InternalError "Malformed record type \{show ty}")
 
         getParameters :
@@ -251,7 +251,7 @@ elabRecord {vars} eopts fc env nest newns def_vis mbtot tn_in params0 opts conNa
              then elabGetters tn con params
                               (if imp == Explicit && not (n `elem` vars)
                                   then S done else done)
-                              upds (b :: tyenv) sc
+                              upds (Env.bind tyenv b) sc
              else
                 do let fldNameStr = nameRoot n
                    let unName = UN $ Basic fldNameStr
@@ -334,7 +334,7 @@ elabRecord {vars} eopts fc env nest newns def_vis mbtot tn_in params0 opts conNa
                    elabGetters tn con params
                                (if imp == Explicit
                                    then S done else done)
-                               upds' (b :: tyenv) sc
+                               upds' (Env.bind tyenv b) sc
 
     elabGetters tn con _ done upds _ _ = pure ()
 
diff --git a/src/TTImp/ProcessRunElab.idr b/src/TTImp/ProcessRunElab.idr
index fca31cf56a2..0461e79853a 100644
--- a/src/TTImp/ProcessRunElab.idr
+++ b/src/TTImp/ProcessRunElab.idr
@@ -4,7 +4,9 @@ import Core.Env
 import Core.Metadata
 import Core.Reflect
 import Core.UnifyState
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -32,9 +34,8 @@ processRunElab eopts nest env fc tm
          tidx <- resolveName (UN $ Basic "[elaborator script]")
          let n = NS reflectionNS (UN $ Basic "Elab")
          unit <- getCon fc defs (builtin "Unit")
-         exp <- appCon fc defs n [unit]
+         exp <- appConTop fc defs n [unit]
 
-         stm <- checkTerm tidx InExpr eopts nest env tm (gnf env exp)
-         nfstm <- nfOpts withAll defs env stm
+         stm <- checkTerm tidx InExpr eopts nest env tm !(nf env exp)
          ignore $ logTime 2 "Elaboration script" $
-           elabScript top fc nest env nfstm Nothing
+           elabScript top fc nest env !(expandFull !(nf env stm)) Nothing
diff --git a/src/TTImp/ProcessTransform.idr b/src/TTImp/ProcessTransform.idr
index 54bb5af2989..58752fa2fcb 100644
--- a/src/TTImp/ProcessTransform.idr
+++ b/src/TTImp/ProcessTransform.idr
@@ -3,6 +3,8 @@ module TTImp.ProcessTransform
 import Core.Env
 import Core.Metadata
 import Core.UnifyState
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -30,7 +32,8 @@ processTransform eopts nest env fc tn_in lhs rhs
              checkLHS True top tidx eopts nest env fc lhs
          logTerm "transform.lhs" 3 "Transform LHS" lhstm
          rhstm <- wrapError (InRHS fc tn_in) $
-                       checkTermSub tidx InExpr (InTrans :: eopts) nest' env' env sub' rhs (gnf env' lhsty)
+                       checkTermSub tidx InExpr (InTrans :: eopts) nest' env' env sub' rhs
+                       !(nf env' lhsty)
          clearHoleLHS
          logTerm "transform.rhs" 3 "Transform RHS" rhstm
          addTransform fc (MkTransform tn env' lhstm rhstm)
diff --git a/src/TTImp/ProcessType.idr b/src/TTImp/ProcessType.idr
index 6fd5105bb9c..5bbc98295a4 100644
--- a/src/TTImp/ProcessType.idr
+++ b/src/TTImp/ProcessType.idr
@@ -4,7 +4,10 @@ import Core.Env
 import Core.Hash
 import Core.Metadata
 import Core.UnifyState
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -33,11 +36,11 @@ getFnString (IPrimVal _ (Str st)) = pure st
 getFnString tm
     = do inidx <- resolveName (UN $ Basic "[foreign]")
          let fc = getFC tm
-         let gstr = gnf Env.empty (PrimVal fc $ PrT StringType)
-         etm <- checkTerm inidx InExpr [] (MkNested []) Env.empty tm gstr
+         gstr <- nf Env.empty (PrimVal fc $ PrT StringType)
+         etm <- checkTerm inidx InExpr [] (NestedNames.empty) Env.empty tm gstr
          defs <- get Ctxt
-         case !(nf defs Env.empty etm) of
-              NPrimVal fc (Str st) => pure st
+         case !(expand !(nf Env.empty etm)) of
+              VPrimVal fc (Str st) => pure st
               _ => throw (GenericMsg fc "%foreign calling convention must evaluate to a String")
 
 -- If it's declared as externally defined, set the definition to
@@ -56,11 +59,11 @@ initDef fc n env ty []
          pure None
 initDef fc n env ty (ExternFn :: opts)
     = do defs <- get Ctxt
-         a <- getArity defs env ty
+         a <- getArity env ty
          pure (ExternDef a)
 initDef fc n env ty (ForeignFn cs :: opts)
     = do defs <- get Ctxt
-         a <- getArity defs env ty
+         a <- getArity env ty
          cs' <- traverse getFnString cs
          pure (ForeignDef a cs')
 -- In this case, nothing to initialise to, but we do need to process the
@@ -85,36 +88,36 @@ initDef fc n env ty (_ :: opts) = initDef fc n env ty opts
 -- generalising partially evaluated definitions and (potentially) in interactive
 -- editing
 findInferrable : {auto c : Ref Ctxt Defs} ->
-                 Defs -> ClosedNF -> Core NatSet
-findInferrable defs ty = fi 0 0 [] NatSet.empty ty
+                 ClosedNF -> Core NatSet
+findInferrable ty = fi 0 0 [] NatSet.empty ty
   where
     mutual
       -- Add to the inferrable arguments from the given type. An argument is
       -- inferrable if it's guarded by a constructor, or on its own
       findInf : NatSet -> List (Name, Nat) ->
-                ClosedNF -> Core NatSet
-      findInf acc pos (NApp _ (NRef Bound n) [])
+                NF [<] -> Core NatSet
+      findInf acc pos (VApp _ Bound n [<] _)
           = case lookup n pos of
                  Nothing => pure acc
                  Just p => if p `elem` acc then pure acc else pure (NatSet.insert p acc)
-      findInf acc pos (NDCon _ _ _ _ args)
-          = do args' <- traverse (evalClosure defs . snd) args
+      findInf acc pos (VDCon _ _ _ _ args)
+          = do args' <- traverseSnocList spineVal args
                findInfs acc pos args'
-      findInf acc pos (NTCon _ _ _ args)
-          = do args' <- traverse (evalClosure defs . snd) args
+      findInf acc pos (VTCon _ _ _ args)
+          = do args' <- traverseSnocList spineVal args
                findInfs acc pos args'
-      findInf acc pos (NDelayed _ _ t) = findInf acc pos t
+      findInf acc pos (VDelayed _ _ t) = findInf acc pos !(expand t)
       findInf acc _ _ = pure acc
 
-      findInfs : NatSet -> List (Name, Nat) -> List ClosedNF -> Core NatSet
-      findInfs acc pos [] = pure acc
-      findInfs acc pos (n :: ns) = findInf !(findInfs acc pos ns) pos n
+      findInfs : NatSet -> List (Name, Nat) -> SnocList ClosedNF -> Core NatSet
+      findInfs acc pos [<] = pure acc
+      findInfs acc pos (ns :< n) = findInf !(findInfs acc pos ns) pos n
 
     fi : Nat -> Int -> List (Name, Nat) -> NatSet -> ClosedNF -> Core NatSet
-    fi pos i args acc (NBind fc x (Pi _ _ _ aty) sc)
+    fi pos i args acc (VBind fc x (Pi _ _ _ aty) sc)
         = do let argn = MN "inf" i
-             sc' <- sc defs (toClosure defaultOpts Env.empty (Ref fc Bound argn))
-             acc' <- findInf acc args !(evalClosure defs aty)
+             sc' <- expand !(sc (pure (vRef fc Bound argn)))
+             acc' <- findInf acc args !(expand aty)
              rest <- fi (1 + pos) (1 + i) ((argn, pos) :: args) acc' sc'
              pure rest
     fi pos i args acc ret = findInf acc args ret
@@ -150,7 +153,7 @@ processType {vars} eopts nest env fc rig vis opts ty_raw
          addNameLoc typeName.fc n
 
          log "declare.type" 1 $ "Processing " ++ show n
-         log "declare.type" 5 $ unwords ["Checking type decl:", show rig, show n, ":", show ty_raw]
+         log "declare.type" 5 $ unwords ["Checking type decl:", show rig, show n, ":", show ty_raw.val]
          idx <- resolveName n
 
          -- Check 'n' is undefined
@@ -170,9 +173,7 @@ processType {vars} eopts nest env fc rig vis opts ty_raw
          let fullty = abstractFullEnvType tfc env ty
 
          (erased, dterased) <- findErased fullty
-         defs <- get Ctxt
-         empty <- clearDefs defs
-         infargs <- findInferrable empty !(nf defs Env.empty fullty)
+         infargs <- findInferrable !(expand !(nf Env.empty fullty))
 
          ignore $ addDef (Resolved idx)
                 ({ eraseArgs := erased,
diff --git a/src/TTImp/Reflect.idr b/src/TTImp/Reflect.idr
index 55d8f6ea40a..9798f504abf 100644
--- a/src/TTImp/Reflect.idr
+++ b/src/TTImp/Reflect.idr
@@ -2,21 +2,24 @@ module TTImp.Reflect
 
 import Core.Context
 import Core.Env
-import Core.Normalise
 import Core.Reflect
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
 
 import TTImp.TTImp
+
+import Data.SnocList
+
 import Libraries.Data.WithDefault
 
 %default covering
 
 export
 Reify BindMode where
-  reify defs val@(NDCon _ n _ _ args)
-      = case (dropAllNS !(full (gamma defs) n), args) of
-             (UN (Basic "PI"), [(_, c)])
-                 => do c' <- reify defs !(evalClosure defs c)
+  reify defs val@(VDCon _ n _ _ args)
+      = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+             (UN (Basic "PI"), [c])
+                 => do c' <- reify defs !(expandFull c)
                        pure (PI c')
              (UN (Basic "PATTERN"), _) => pure PATTERN
              (UN (Basic "COVERAGE"), _) => pure COVERAGE
@@ -28,7 +31,7 @@ export
 Reflect BindMode where
   reflect fc defs lhs env (PI c)
       = do c' <- reflect fc defs lhs env c
-           appCon fc defs (reflectionttimp "PI") [c']
+           appConTop fc defs (reflectionttimp "PI") [c']
   reflect fc defs lhs env PATTERN
       = getCon fc defs (reflectionttimp "PATTERN")
   reflect fc defs lhs env COVERAGE
@@ -38,7 +41,7 @@ Reflect BindMode where
 
 export
 Reify UseSide where
-  reify defs val@(NDCon _ n _ _ args)
+  reify defs val@(VDCon _ n _ _ args)
       = case (dropAllNS !(full (gamma defs) n), args) of
              (UN (Basic "UseLeft"), _) => pure UseLeft
              (UN (Basic "UseRight"), _) => pure UseRight
@@ -54,7 +57,7 @@ Reflect UseSide where
 
 export
 Reify DotReason where
-  reify defs val@(NDCon _ n _ _ args)
+  reify defs val@(VDCon _ n _ _ args)
       = case (dropAllNS !(full (gamma defs) n), args) of
              (UN (Basic "NonLinearVar"), _) => pure NonLinearVar
              (UN (Basic "VarApplied"), _) => pure VarApplied
@@ -87,242 +90,242 @@ Reflect DotReason where
 mutual
   export
   Reify RawImp where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "IVar"), [fc, n])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          n' <- reify defs !(evalClosure defs n)
+                    => do fc' <- reify defs !(expandFull fc)
+                          n' <- reify defs !(expandFull n)
                           pure (IVar fc' n')
                (UN (Basic "IPi"), [fc, c, p, mn, aty, rty])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          c' <- reify defs !(evalClosure defs c)
-                          p' <- reify defs !(evalClosure defs p)
-                          mn' <- reify defs !(evalClosure defs mn)
-                          aty' <- reify defs !(evalClosure defs aty)
-                          rty' <- reify defs !(evalClosure defs rty)
+                    => do fc' <- reify defs !(expandFull fc)
+                          c' <- reify defs !(expandFull c)
+                          p' <- reify defs !(expandFull p)
+                          mn' <- reify defs !(expandFull mn)
+                          aty' <- reify defs !(expandFull aty)
+                          rty' <- reify defs !(expandFull rty)
                           pure (IPi fc' c' p' mn' aty' rty')
                (UN (Basic "ILam"), [fc, c, p, mn, aty, lty])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          c' <- reify defs !(evalClosure defs c)
-                          p' <- reify defs !(evalClosure defs p)
-                          mn' <- reify defs !(evalClosure defs mn)
-                          aty' <- reify defs !(evalClosure defs aty)
-                          lty' <- reify defs !(evalClosure defs lty)
+                    => do fc' <- reify defs !(expandFull fc)
+                          c' <- reify defs !(expandFull c)
+                          p' <- reify defs !(expandFull p)
+                          mn' <- reify defs !(expandFull mn)
+                          aty' <- reify defs !(expandFull aty)
+                          lty' <- reify defs !(expandFull lty)
                           pure (ILam fc' c' p' mn' aty' lty')
                (UN (Basic "ILet"), [fc, lhsFC, c, n, ty, val, sc])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          lhsFC' <- reify defs !(evalClosure defs lhsFC)
-                          c' <- reify defs !(evalClosure defs c)
-                          n' <- reify defs !(evalClosure defs n)
-                          ty' <- reify defs !(evalClosure defs ty)
-                          val' <- reify defs !(evalClosure defs val)
-                          sc' <- reify defs !(evalClosure defs sc)
+                    => do fc' <- reify defs !(expandFull fc)
+                          lhsFC' <- reify defs !(expandFull lhsFC)
+                          c' <- reify defs !(expandFull c)
+                          n' <- reify defs !(expandFull n)
+                          ty' <- reify defs !(expandFull ty)
+                          val' <- reify defs !(expandFull val)
+                          sc' <- reify defs !(expandFull sc)
                           pure (ILet fc' lhsFC' c' n' ty' val' sc')
                (UN (Basic "ICase"), [fc, opts, sc, ty, cs])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          opts' <- reify defs !(evalClosure defs opts)
-                          sc' <- reify defs !(evalClosure defs sc)
-                          ty' <- reify defs !(evalClosure defs ty)
-                          cs' <- reify defs !(evalClosure defs cs)
+                    => do fc' <- reify defs !(expandFull fc)
+                          opts' <- reify defs !(expandFull opts)
+                          sc' <- reify defs !(expandFull sc)
+                          ty' <- reify defs !(expandFull ty)
+                          cs' <- reify defs !(expandFull cs)
                           pure (ICase fc' opts' sc' ty' cs')
                (UN (Basic "ILocal"), [fc, ds, sc])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          ds' <- reify defs !(evalClosure defs ds)
-                          sc' <- reify defs !(evalClosure defs sc)
+                    => do fc' <- reify defs !(expandFull fc)
+                          ds' <- reify defs !(expandFull ds)
+                          sc' <- reify defs !(expandFull sc)
                           pure (ILocal fc' ds' sc')
                (UN (Basic "IUpdate"), [fc, ds, sc])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          ds' <- reify defs !(evalClosure defs ds)
-                          sc' <- reify defs !(evalClosure defs sc)
+                    => do fc' <- reify defs !(expandFull fc)
+                          ds' <- reify defs !(expandFull ds)
+                          sc' <- reify defs !(expandFull sc)
                           pure (IUpdate fc' ds' sc')
                (UN (Basic "IApp"), [fc, f, a])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          f' <- reify defs !(evalClosure defs f)
-                          a' <- reify defs !(evalClosure defs a)
+                    => do fc' <- reify defs !(expandFull fc)
+                          f' <- reify defs !(expandFull f)
+                          a' <- reify defs !(expandFull a)
                           pure (IApp fc' f' a')
                (UN (Basic "INamedApp"), [fc, f, m, a])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          f' <- reify defs !(evalClosure defs f)
-                          m' <- reify defs !(evalClosure defs m)
-                          a' <- reify defs !(evalClosure defs a)
+                    => do fc' <- reify defs !(expandFull fc)
+                          f' <- reify defs !(expandFull f)
+                          m' <- reify defs !(expandFull m)
+                          a' <- reify defs !(expandFull a)
                           pure (INamedApp fc' f' m' a')
                (UN (Basic "IAutoApp"), [fc, f, a])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          f' <- reify defs !(evalClosure defs f)
-                          a' <- reify defs !(evalClosure defs a)
+                    => do fc' <- reify defs !(expandFull fc)
+                          f' <- reify defs !(expandFull f)
+                          a' <- reify defs !(expandFull a)
                           pure (IAutoApp fc' f' a')
                (UN (Basic "IWithApp"), [fc, f, a])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          f' <- reify defs !(evalClosure defs f)
-                          a' <- reify defs !(evalClosure defs a)
+                    => do fc' <- reify defs !(expandFull fc)
+                          f' <- reify defs !(expandFull f)
+                          a' <- reify defs !(expandFull a)
                           pure (IWithApp fc' f' a')
                (UN (Basic "ISearch"), [fc, d])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          d' <- reify defs !(evalClosure defs d)
+                    => do fc' <- reify defs !(expandFull fc)
+                          d' <- reify defs !(expandFull d)
                           pure (ISearch fc' d')
                (UN (Basic "IAlternative"), [fc, t, as])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
-                          as' <- reify defs !(evalClosure defs as)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
+                          as' <- reify defs !(expandFull as)
                           pure (IAlternative fc' t' as')
                (UN (Basic "IRewrite"), [fc, t, sc])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
-                          sc' <- reify defs !(evalClosure defs sc)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
+                          sc' <- reify defs !(expandFull sc)
                           pure (IRewrite fc' t' sc')
                (UN (Basic "IBindHere"), [fc, t, sc])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
-                          sc' <- reify defs !(evalClosure defs sc)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
+                          sc' <- reify defs !(expandFull sc)
                           pure (IBindHere fc' t' sc')
                (UN (Basic "IBindVar"), [fc, n])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          n' <- reify defs !(evalClosure defs n)
+                    => do fc' <- reify defs !(expandFull fc)
+                          n' <- reify defs !(expandFull n)
                           pure (IBindVar fc' n')
                (UN (Basic "IAs"), [fc, nameFC, s, n, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          nameFC' <- reify defs !(evalClosure defs nameFC)
-                          s' <- reify defs !(evalClosure defs s)
-                          n' <- reify defs !(evalClosure defs n)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          nameFC' <- reify defs !(expandFull nameFC)
+                          s' <- reify defs !(expandFull s)
+                          n' <- reify defs !(expandFull n)
+                          t' <- reify defs !(expandFull t)
                           pure (IAs fc' nameFC' s' n' t')
                (UN (Basic "IMustUnify"), [fc, r, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          r' <- reify defs !(evalClosure defs r)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          r' <- reify defs !(expandFull r)
+                          t' <- reify defs !(expandFull t)
                           pure (IMustUnify fc' r' t')
                (UN (Basic "IDelayed"), [fc, r, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          r' <- reify defs !(evalClosure defs r)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          r' <- reify defs !(expandFull r)
+                          t' <- reify defs !(expandFull t)
                           pure (IDelayed fc' r' t')
                (UN (Basic "IDelay"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IDelay fc' t')
                (UN (Basic "IForce"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IForce fc' t')
                (UN (Basic "IQuote"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IQuote fc' t')
                (UN (Basic "IQuoteName"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IQuoteName fc' t')
                (UN (Basic "IQuoteDecl"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IQuoteDecl fc' t')
                (UN (Basic "IUnquote"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IUnquote fc' t')
                (UN (Basic "IPrimVal"), [fc, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          t' <- reify defs !(expandFull t)
                           pure (IPrimVal fc' t')
                (UN (Basic "IType"), [fc])
-                    => do fc' <- reify defs !(evalClosure defs fc)
+                    => do fc' <- reify defs !(expandFull fc)
                           pure (IType fc')
                (UN (Basic "IHole"), [fc, n])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          n' <- reify defs !(evalClosure defs n)
+                    => do fc' <- reify defs !(expandFull fc)
+                          n' <- reify defs !(expandFull n)
                           pure (IHole fc' n')
                (UN (Basic "Implicit"), [fc, n])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          n' <- reify defs !(evalClosure defs n)
+                    => do fc' <- reify defs !(expandFull fc)
+                          n' <- reify defs !(expandFull n)
                           pure (Implicit fc' n')
                (UN (Basic "IWithUnambigNames"), [fc, ns, t])
-                    => do fc' <- reify defs !(evalClosure defs fc)
-                          ns' <- reify defs !(evalClosure defs ns)
-                          t' <- reify defs !(evalClosure defs t)
+                    => do fc' <- reify defs !(expandFull fc)
+                          ns' <- reify defs !(expandFull ns)
+                          t' <- reify defs !(expandFull t)
                           pure (IWithUnambigNames fc' ns' t')
                _ => cantReify val "TTImp"
     reify defs val = cantReify val "TTImp"
 
   export
   Reify IFieldUpdate where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), args) of
-               (UN (Basic "ISetField"), [(_, x), (_, y)])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+               (UN (Basic "ISetField"), [x, y])
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
                           pure (ISetField x' y')
-               (UN (Basic "ISetFieldApp"), [(_, x), (_, y)])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
+               (UN (Basic "ISetFieldApp"), [x, y])
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
                           pure (ISetFieldApp x' y')
                _ => cantReify val "IFieldUpdate"
     reify defs val = cantReify val "IFieldUpdate"
 
   export
   Reify AltType where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "FirstSuccess"), _)
                     => pure FirstSuccess
                (UN (Basic "Unique"), _)
                     => pure Unique
-               (UN (Basic "UniqueDefault"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "UniqueDefault"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (UniqueDefault x')
                _ => cantReify val "AltType"
     reify defs val = cantReify val "AltType"
 
   export
   Reify FnOpt where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "Inline"), _) => pure Inline
                (UN (Basic "Unsafe"), _) => pure Unsafe
                (UN (Basic "NoInline"), _) => pure NoInline
                (UN (Basic "Deprecate"), _) => pure Deprecate
                (UN (Basic "TCInline"), _) => pure TCInline
-               (UN (Basic "Hint"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "Hint"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (Hint x')
-               (UN (Basic "GlobalHint"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "GlobalHint"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (GlobalHint x')
                (UN (Basic "ExternFn"), _) => pure ExternFn
-               (UN (Basic "ForeignFn"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "ForeignFn"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (ForeignFn x')
-               (UN (Basic "ForeignExport"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "ForeignExport"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (ForeignExport x')
                (UN (Basic "Invertible"), _) => pure Invertible
-               (UN (Basic "Totality"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "Totality"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (Totality x')
                (UN (Basic "Macro"), _) => pure Macro
-               (UN (Basic "SpecArgs"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+               (UN (Basic "SpecArgs"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (SpecArgs x')
                _ => cantReify val "FnOpt"
     reify defs val = cantReify val "FnOpt"
 
   export
   Reify ImpTy where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "MkTy"), [w, y, z])
-                    => do fc' <- reify defs !(evalClosure defs w)
-                          name' <- the (Core (WithFC Name)) (reify defs !(evalClosure defs y))
-                          term' <- reify defs !(evalClosure defs z)
+                    => do fc' <- reify defs !(expandFull w)
+                          name' <- the (Core (WithFC Name)) (reify defs !(expandFull y))
+                          term' <- reify defs !(expandFull z)
                           pure (Mk [fc', name'] term')
                _ => cantReify val "ITy"
     reify defs val = cantReify val "ITy"
 
   export
   Reify DataOpt where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), args) of
-               (UN (Basic "SearchBy"), [(_, x)])
-                    => do x' <- reify defs !(evalClosure defs x)
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+               (UN (Basic "SearchBy"), [x])
+                    => do x' <- reify defs !(expandFull x)
                           pure (SearchBy x')
                (UN (Basic "NoHints"), _) => pure NoHints
                (UN (Basic "UniqueSearch"), _) => pure UniqueSearch
@@ -333,48 +336,48 @@ mutual
 
   export
   Reify ImpData where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "MkData"), [v,w,x,y,z])
-                    => do v' <- reify defs !(evalClosure defs v)
-                          w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+                    => do v' <- reify defs !(expandFull v)
+                          w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (MkImpData v' w' x' y' z')
                (UN (Basic "MkLater"), [x,y,z])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (MkImpLater x' y' z')
                _ => cantReify val "Data"
     reify defs val = cantReify val "Data"
 
   export
   Reify IField where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "MkIField"), [v,w,x,y,z])
-                    => do fc <- reify defs !(evalClosure defs v)
-                          rig <- reify defs !(evalClosure defs w)
-                          info <- reify defs !(evalClosure defs x)
-                          name <- reify defs !(evalClosure defs y)
-                          type <- reify defs !(evalClosure defs z)
+                    => do fc <- reify defs !(expandFull v)
+                          rig <- reify defs !(expandFull w)
+                          info <- reify defs !(expandFull x)
+                          name <- reify defs !(expandFull y)
+                          type <- reify defs !(expandFull z)
                           pure (Mk [fc, rig, NoFC name] (MkPiBindData info type))
                _ => cantReify val "IField"
     reify defs val = cantReify val "IField"
 
   export
   Reify ImpRecord where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "MkRecord"), [v,w,x,y,z,a])
-                    => do fc <- reify defs !(evalClosure defs v)
-                          tyName <- reify defs !(evalClosure defs w)
-                          params <- reify defs !(evalClosure defs x)
-                          opts <- reify defs !(evalClosure defs y)
-                          conName <- reify defs !(evalClosure defs z)
-                          fields <- reify defs !(evalClosure defs a)
+                    => do fc <- reify defs !(expandFull v)
+                          tyName <- reify defs !(expandFull w)
+                          params <- reify defs !(expandFull x)
+                          opts <- reify defs !(expandFull y)
+                          conName <- reify defs !(expandFull z)
+                          fields <- reify defs !(expandFull a)
                           pure (Mk [fc] $ MkImpRecord (Mk [NoFC tyName] (map fromOldParams params))
                                                       (Mk [NoFC conName, opts] fields))
                _ => cantReify val "Record"
@@ -382,8 +385,8 @@ mutual
 
   export
   Reify WithFlag where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "Syntactic"), [])
                     => pure Syntactic
                _ => cantReify val "WithFlag"
@@ -391,90 +394,90 @@ mutual
 
   export
   Reify ImpClause where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "PatClause"), [x,y,z])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (PatClause x' y' z')
                (UN (Basic "WithClause"), [u,v,w,x,y,z,a])
-                    => do u' <- reify defs !(evalClosure defs u)
-                          v' <- reify defs !(evalClosure defs v)
-                          w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
-                          a' <- reify defs !(evalClosure defs a)
+                    => do u' <- reify defs !(expandFull u)
+                          v' <- reify defs !(expandFull v)
+                          w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
+                          a' <- reify defs !(expandFull a)
                           pure (WithClause u' v' w' x' y' z' a')
                (UN (Basic "ImpossibleClause"), [x,y])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
                           pure (ImpossibleClause x' y')
                _ => cantReify val "Clause"
     reify defs val = cantReify val "Clause"
 
   export
   Reify (IClaimData Name) where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
-               (UN (Basic "MkIClaimData"), [w, x, y, z])
-                    => do w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
+               (UN (Basic "MkIClaimData"), [w,x,y,z])
+                    => do w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (MkIClaimData w' x' y' z')
                _ => cantReify val "IClaimData"
     reify defs val = cantReify val "IClaimData"
 
   export
   Reify ImpDecl where
-    reify defs val@(NDCon _ n _ _ args)
-        = case (dropAllNS !(full (gamma defs) n), map snd args) of
+    reify defs val@(VDCon _ n _ _ args)
+        = case (dropAllNS !(full (gamma defs) n), !(spineFull args)) of
                (UN (Basic "IClaim"), [v])
-                    => do v' <- reify defs !(evalClosure defs v)
+                    => do v' <- reify defs !(expandFull v)
                           pure (IClaim v')
                (UN (Basic "IData"), [x,y,z,w])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
-                          w' <- reify defs !(evalClosure defs w)
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
+                          w' <- reify defs !(expandFull w)
                           pure (IData x' y' z' w')
                (UN (Basic "IDef"), [x,y,z])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (IDef x' y' z')
                (UN (Basic "IParameters"), [x,y,z])
-                    => do x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+                    => do x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (IParameters x' (map fromOldParams y') z')
                (UN (Basic "IRecord"), [w,x,y,z,u])
-                    => do w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
-                          u' <- reify defs !(evalClosure defs u)
+                    => do w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
+                          u' <- reify defs !(expandFull u)
                           pure (IRecord w' x' y' z' u')
                (UN (Basic "IFail"), [w,x,y])
-                    => do w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
+                    => do w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
                           pure (IFail w' x' y')
                (UN (Basic "INamespace"), [w,x,y])
-                    => do w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
+                    => do w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
                           pure (INamespace w' x' y')
                (UN (Basic "ITransform"), [w,x,y,z])
-                    => do w' <- reify defs !(evalClosure defs w)
-                          x' <- reify defs !(evalClosure defs x)
-                          y' <- reify defs !(evalClosure defs y)
-                          z' <- reify defs !(evalClosure defs z)
+                    => do w' <- reify defs !(expandFull w)
+                          x' <- reify defs !(expandFull x)
+                          y' <- reify defs !(expandFull y)
+                          z' <- reify defs !(expandFull z)
                           pure (ITransform w' x' y' z')
                (UN (Basic "ILog"), [x])
-                    => do x' <- reify defs !(evalClosure defs x)
+                    => do x' <- reify defs !(expandFull x)
                           pure (ILog x')
                _ => cantReify val "Decl"
     reify defs val = cantReify val "Decl"
@@ -485,7 +488,7 @@ mutual
     reflect fc defs lhs env (IVar tfc n)
         = do fc' <- reflect fc defs lhs env tfc
              n' <- reflect fc defs lhs env n
-             appCon fc defs (reflectionttimp "IVar") [fc', n']
+             appConTop fc defs (reflectionttimp "IVar") [fc', n']
     reflect fc defs lhs env (IPi tfc c p mn aty rty)
         = do fc' <- reflect fc defs lhs env tfc
              c' <- reflect fc defs lhs env c
@@ -493,7 +496,7 @@ mutual
              mn' <- reflect fc defs lhs env mn
              aty' <- reflect fc defs lhs env aty
              rty' <- reflect fc defs lhs env rty
-             appCon fc defs (reflectionttimp "IPi") [fc', c', p', mn', aty', rty']
+             appConTop fc defs (reflectionttimp "IPi") [fc', c', p', mn', aty', rty']
     reflect fc defs lhs env (ILam tfc c p mn aty rty)
         = do fc' <- reflect fc defs lhs env tfc
              c' <- reflect fc defs lhs env c
@@ -501,7 +504,7 @@ mutual
              mn' <- reflect fc defs lhs env mn
              aty' <- reflect fc defs lhs env aty
              rty' <- reflect fc defs lhs env rty
-             appCon fc defs (reflectionttimp "ILam") [fc', c', p', mn', aty', rty']
+             appConTop fc defs (reflectionttimp "ILam") [fc', c', p', mn', aty', rty']
     reflect fc defs lhs env (ILet tfc lhsFC c n aty aval sc)
         = do fc' <- reflect fc defs lhs env tfc
              lhsFC' <- reflect fc defs lhs env lhsFC
@@ -510,108 +513,108 @@ mutual
              aty' <- reflect fc defs lhs env aty
              aval' <- reflect fc defs lhs env aval
              sc' <- reflect fc defs lhs env sc
-             appCon fc defs (reflectionttimp "ILet") [fc', lhsFC', c', n', aty', aval', sc']
+             appConTop fc defs (reflectionttimp "ILet") [fc', lhsFC', c', n', aty', aval', sc']
     reflect fc defs lhs env (ICase tfc opts sc ty cs)
         = do fc' <- reflect fc defs lhs env tfc
              opts' <- reflect fc defs lhs env opts
              sc' <- reflect fc defs lhs env sc
              ty' <- reflect fc defs lhs env ty
              cs' <- reflect fc defs lhs env cs
-             appCon fc defs (reflectionttimp "ICase") [fc', opts', sc', ty', cs']
+             appConTop fc defs (reflectionttimp "ICase") [fc', opts', sc', ty', cs']
     reflect fc defs lhs env (ILocal tfc ds sc)
         = do fc' <- reflect fc defs lhs env tfc
              ds' <- reflect fc defs lhs env ds
              sc' <- reflect fc defs lhs env sc
-             appCon fc defs (reflectionttimp "ILocal") [fc', ds', sc']
+             appConTop fc defs (reflectionttimp "ILocal") [fc', ds', sc']
     reflect fc defs lhs env (ICaseLocal tfc u i args t)
         = reflect fc defs lhs env t -- shouldn't see this anyway...
     reflect fc defs lhs env (IUpdate tfc ds sc)
         = do fc' <- reflect fc defs lhs env tfc
              ds' <- reflect fc defs lhs env ds
              sc' <- reflect fc defs lhs env sc
-             appCon fc defs (reflectionttimp "IUpdate") [fc', ds', sc']
+             appConTop fc defs (reflectionttimp "IUpdate") [fc', ds', sc']
     reflect fc defs lhs env (IApp tfc f a)
         = do fc' <- reflect fc defs lhs env tfc
              f' <- reflect fc defs lhs env f
              a' <- reflect fc defs lhs env a
-             appCon fc defs (reflectionttimp "IApp") [fc', f', a']
+             appConTop fc defs (reflectionttimp "IApp") [fc', f', a']
     reflect fc defs lhs env (IAutoApp tfc f a)
         = do fc' <- reflect fc defs lhs env tfc
              f' <- reflect fc defs lhs env f
              a' <- reflect fc defs lhs env a
-             appCon fc defs (reflectionttimp "IAutoApp") [fc', f', a']
+             appConTop fc defs (reflectionttimp "IAutoApp") [fc', f', a']
     reflect fc defs lhs env (INamedApp tfc f m a)
         = do fc' <- reflect fc defs lhs env tfc
              f' <- reflect fc defs lhs env f
              m' <- reflect fc defs lhs env m
              a' <- reflect fc defs lhs env a
-             appCon fc defs (reflectionttimp "INamedApp") [fc', f', m', a']
+             appConTop fc defs (reflectionttimp "INamedApp") [fc', f', m', a']
     reflect fc defs lhs env (IWithApp tfc f a)
         = do fc' <- reflect fc defs lhs env tfc
              f' <- reflect fc defs lhs env f
              a' <- reflect fc defs lhs env a
-             appCon fc defs (reflectionttimp "IWithApp") [fc', f', a']
+             appConTop fc defs (reflectionttimp "IWithApp") [fc', f', a']
     reflect fc defs lhs env (ISearch tfc d)
         = do fc' <- reflect fc defs lhs env tfc
              d' <- reflect fc defs lhs env d
-             appCon fc defs (reflectionttimp "ISearch") [fc', d']
+             appConTop fc defs (reflectionttimp "ISearch") [fc', d']
     reflect fc defs lhs env (IAlternative tfc t as)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
              as' <- reflect fc defs lhs env as
-             appCon fc defs (reflectionttimp "IAlternative") [fc', t', as']
+             appConTop fc defs (reflectionttimp "IAlternative") [fc', t', as']
     reflect fc defs lhs env (IRewrite tfc t sc)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
              sc' <- reflect fc defs lhs env sc
-             appCon fc defs (reflectionttimp "IRewrite") [fc', t', sc']
+             appConTop fc defs (reflectionttimp "IRewrite") [fc', t', sc']
     reflect fc defs lhs env (ICoerced tfc d) = reflect fc defs lhs env d
     reflect fc defs lhs env (IBindHere tfc n sc)
         = do fc' <- reflect fc defs lhs env tfc
              n' <- reflect fc defs lhs env n
              sc' <- reflect fc defs lhs env sc
-             appCon fc defs (reflectionttimp "IBindHere") [fc', n', sc']
+             appConTop fc defs (reflectionttimp "IBindHere") [fc', n', sc']
     reflect fc defs lhs env (IBindVar tfc n)
         = do fc' <- reflect fc defs lhs env tfc
              n' <- reflect fc defs lhs env n
-             appCon fc defs (reflectionttimp "IBindVar") [fc', n']
+             appConTop fc defs (reflectionttimp "IBindVar") [fc', n']
     reflect fc defs lhs env (IAs tfc nameFC s n t)
         = do fc' <- reflect fc defs lhs env tfc
              nameFC' <- reflect fc defs lhs env nameFC
              s' <- reflect fc defs lhs env s
              n' <- reflect fc defs lhs env n
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IAs") [fc', nameFC', s', n', t']
+             appConTop fc defs (reflectionttimp "IAs") [fc', nameFC', s', n', t']
     reflect fc defs lhs env (IMustUnify tfc r t)
         = do fc' <- reflect fc defs lhs env tfc
              r' <- reflect fc defs lhs env r
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IMustUnify") [fc', r', t']
+             appConTop fc defs (reflectionttimp "IMustUnify") [fc', r', t']
     reflect fc defs lhs env (IDelayed tfc r t)
         = do fc' <- reflect fc defs lhs env tfc
              r' <- reflect fc defs lhs env r
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IDelayed") [fc', r', t']
+             appConTop fc defs (reflectionttimp "IDelayed") [fc', r', t']
     reflect fc defs lhs env (IDelay tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IDelay") [fc', t']
+             appConTop fc defs (reflectionttimp "IDelay") [fc', t']
     reflect fc defs lhs env (IForce tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IForce") [fc', t']
+             appConTop fc defs (reflectionttimp "IForce") [fc', t']
     reflect fc defs lhs env (IQuote tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IQuote") [fc', t']
+             appConTop fc defs (reflectionttimp "IQuote") [fc', t']
     reflect fc defs lhs env (IQuoteName tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IQuoteName") [fc', t']
+             appConTop fc defs (reflectionttimp "IQuoteName") [fc', t']
     reflect fc defs lhs env (IQuoteDecl tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IQuoteDecl") [fc', t']
+             appConTop fc defs (reflectionttimp "IQuoteDecl") [fc', t']
     reflect fc defs lhs env (IUnquote tfc (IVar _ t))
         = pure (Ref tfc Bound t)
     reflect fc defs lhs env (IUnquote tfc t)
@@ -621,14 +624,14 @@ mutual
     reflect fc defs lhs env (IPrimVal tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IPrimVal") [fc', t']
+             appConTop fc defs (reflectionttimp "IPrimVal") [fc', t']
     reflect fc defs lhs env (IType tfc)
         = do fc' <- reflect fc defs lhs env tfc
-             appCon fc defs (reflectionttimp "IType") [fc']
+             appConTop fc defs (reflectionttimp "IType") [fc']
     reflect fc defs lhs env (IHole tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IHole") [fc', t']
+             appConTop fc defs (reflectionttimp "IHole") [fc', t']
     reflect fc defs lhs env (IUnifyLog tfc _ t)
         = reflect fc defs lhs env t
     reflect fc defs True env (Implicit tfc t)
@@ -636,23 +639,23 @@ mutual
     reflect fc defs lhs env (Implicit tfc t)
         = do fc' <- reflect fc defs lhs env tfc
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "Implicit") [fc', t']
+             appConTop fc defs (reflectionttimp "Implicit") [fc', t']
     reflect fc defs lhs env (IWithUnambigNames tfc ns t)
         = do fc' <- reflect fc defs lhs env tfc
              ns' <- reflect fc defs lhs env ns
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "IWithUnambigNames") [fc', ns', t']
+             appConTop fc defs (reflectionttimp "IWithUnambigNames") [fc', ns', t']
 
   export
   Reflect IFieldUpdate where
     reflect fc defs lhs env (ISetField p t)
         = do p' <- reflect fc defs lhs env p
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "ISetField") [p', t']
+             appConTop fc defs (reflectionttimp "ISetField") [p', t']
     reflect fc defs lhs env (ISetFieldApp p t)
         = do p' <- reflect fc defs lhs env p
              t' <- reflect fc defs lhs env t
-             appCon fc defs (reflectionttimp "ISetFieldApp") [p', t']
+             appConTop fc defs (reflectionttimp "ISetFieldApp") [p', t']
 
   export
   Reflect AltType where
@@ -660,7 +663,7 @@ mutual
     reflect fc defs lhs env Unique = getCon fc defs (reflectionttimp "Unique")
     reflect fc defs lhs env (UniqueDefault x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "UniqueDefault") [x']
+             appConTop fc defs (reflectionttimp "UniqueDefault") [x']
 
   export
   Reflect FnOpt where
@@ -671,25 +674,25 @@ mutual
     reflect fc defs lhs env TCInline = getCon fc defs (reflectionttimp "TCInline")
     reflect fc defs lhs env (Hint x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "Hint") [x']
+             appConTop fc defs (reflectionttimp "Hint") [x']
     reflect fc defs lhs env (GlobalHint x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "GlobalHint") [x']
+             appConTop fc defs (reflectionttimp "GlobalHint") [x']
     reflect fc defs lhs env ExternFn = getCon fc defs (reflectionttimp "ExternFn")
     reflect fc defs lhs env (ForeignFn x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "ForeignFn") [x']
+             appConTop fc defs (reflectionttimp "ForeignFn") [x']
     reflect fc defs lhs env (ForeignExport x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "ForeignExport") [x']
+             appConTop fc defs (reflectionttimp "ForeignExport") [x']
     reflect fc defs lhs env Invertible = getCon fc defs (reflectionttimp "Invertible")
     reflect fc defs lhs env (Totality r)
         = do r' <- reflect fc defs lhs env r
-             appCon fc defs (reflectionttimp "Totality") [r']
+             appConTop fc defs (reflectionttimp "Totality") [r']
     reflect fc defs lhs env Macro = getCon fc defs (reflectionttimp "Macro")
     reflect fc defs lhs env (SpecArgs r)
         = do r' <- reflect fc defs lhs env r
-             appCon fc defs (reflectionttimp "SpecArgs") [r']
+             appConTop fc defs (reflectionttimp "SpecArgs") [r']
 
   export
   Reflect ImpTy where
@@ -697,13 +700,13 @@ mutual
         = do w' <- reflect fc defs lhs env ty.fc
              x' <- reflect fc defs lhs env ty.tyName
              z' <- reflect fc defs lhs env ty.val
-             appCon fc defs (reflectionttimp "MkTy") [w', x', z']
+             appConTop fc defs (reflectionttimp "MkTy") [w', x', z']
 
   export
   Reflect DataOpt where
     reflect fc defs lhs env (SearchBy x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "SearchBy") [x']
+             appConTop fc defs (reflectionttimp "SearchBy") [x']
     reflect fc defs lhs env NoHints = getCon fc defs (reflectionttimp "NoHints")
     reflect fc defs lhs env UniqueSearch = getCon fc defs (reflectionttimp "UniqueSearch")
     reflect fc defs lhs env External = getCon fc defs (reflectionttimp "External")
@@ -717,12 +720,12 @@ mutual
              x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "MkData") [v', w', x', y', z']
+             appConTop fc defs (reflectionttimp "MkData") [v', w', x', y', z']
     reflect fc defs lhs env (MkImpLater x y z)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "MkLater") [x', y', z']
+             appConTop fc defs (reflectionttimp "MkLater") [x', y', z']
 
   export
   Reflect IField where
@@ -732,7 +735,7 @@ mutual
              x' <- reflect fc defs lhs env field.val.info
              y' <- reflect fc defs lhs env field.name.val
              z' <- reflect fc defs lhs env field.val.boundType
-             appCon fc defs (reflectionttimp "MkIField") [v', w', x', y', z']
+             appConTop fc defs (reflectionttimp "MkIField") [v', w', x', y', z']
   export
   Reflect ImpRecord where
     reflect fc defs lhs env r@(MkWithData _ $ MkImpRecord header body)
@@ -742,7 +745,7 @@ mutual
              y' <- reflect fc defs lhs env body.opts
              z' <- reflect fc defs lhs env body.name.val
              a' <- reflect fc defs lhs env body.val
-             appCon fc defs (reflectionttimp "MkRecord") [v', w', x', y', z', a']
+             appConTop fc defs (reflectionttimp "MkRecord") [v', w', x', y', z', a']
 
   export
   Reflect WithFlag where
@@ -755,7 +758,7 @@ mutual
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "PatClause") [x', y', z']
+             appConTop fc defs (reflectionttimp "PatClause") [x', y', z']
     reflect fc defs lhs env (WithClause u v w x y z a)
         = do u' <- reflect fc defs lhs env u
              v' <- reflect fc defs lhs env v
@@ -764,11 +767,11 @@ mutual
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
              a' <- reflect fc defs lhs env a
-             appCon fc defs (reflectionttimp "WithClause") [u', v', w', x', y', z', a']
+             appConTop fc defs (reflectionttimp "WithClause") [u', v', w', x', y', z', a']
     reflect fc defs lhs env (ImpossibleClause x y)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
-             appCon fc defs (reflectionttimp "ImpossibleClause") [x', y']
+             appConTop fc defs (reflectionttimp "ImpossibleClause") [x', y']
 
   export
   Reflect (IClaimData Name) where
@@ -777,58 +780,58 @@ mutual
              x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "MkIClaimData") [w', x', y', z']
+             appConTop fc defs (reflectionttimp "MkIClaimData") [w', x', y', z']
 
   export
   Reflect ImpDecl where
     reflect fc defs lhs env (IClaim v)
         = do v' <- reflect fc defs lhs env v
-             appCon fc defs (reflectionttimp "IClaim") [v']
+             appConTop fc defs (reflectionttimp "IClaim") [v']
     reflect fc defs lhs env (IData x y z w)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
              w' <- reflect fc defs lhs env w
-             appCon fc defs (reflectionttimp "IData") [x', y', z', w']
+             appConTop fc defs (reflectionttimp "IData") [x', y', z', w']
     reflect fc defs lhs env (IDef x y z)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "IDef") [x', y', z']
+             appConTop fc defs (reflectionttimp "IDef") [x', y', z']
     reflect fc defs lhs env (IParameters x y z)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env (map toOldParams y)
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "IParameters") [x', y', z']
+             appConTop fc defs (reflectionttimp "IParameters") [x', y', z']
     reflect fc defs lhs env (IRecord w x y z u)
         = do w' <- reflect fc defs lhs env w
              x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
              u' <- reflect fc defs lhs env u
-             appCon fc defs (reflectionttimp "IRecord") [w', x', y', z', u']
+             appConTop fc defs (reflectionttimp "IRecord") [w', x', y', z', u']
     reflect fc defs lhs env (IFail x y z)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "IFail") [x', y', z']
+             appConTop fc defs (reflectionttimp "IFail") [x', y', z']
     reflect fc defs lhs env (INamespace x y z)
         = do x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "INamespace") [x', y', z']
+             appConTop fc defs (reflectionttimp "INamespace") [x', y', z']
     reflect fc defs lhs env (ITransform w x y z)
         = do w' <- reflect fc defs lhs env w
              x' <- reflect fc defs lhs env x
              y' <- reflect fc defs lhs env y
              z' <- reflect fc defs lhs env z
-             appCon fc defs (reflectionttimp "ITransform") [w', x', y', z']
+             appConTop fc defs (reflectionttimp "ITransform") [w', x', y', z']
     reflect fc defs lhs env (IRunElabDecl w x)
         = throw (GenericMsg fc "Can't reflect a %runElab")
     reflect fc defs lhs env (IPragma _ _ x)
         = throw (GenericMsg fc "Can't reflect a pragma")
     reflect fc defs lhs env (ILog x)
         = do x' <- reflect fc defs lhs env x
-             appCon fc defs (reflectionttimp "ILog") [x']
+             appConTop fc defs (reflectionttimp "ILog") [x']
     reflect fc defs lhs env (IBuiltin {})
         = throw (GenericMsg fc "Can't reflect a %builtin")
diff --git a/src/TTImp/TTImp.idr b/src/TTImp/TTImp.idr
index 708ad506640..ee598ddda00 100644
--- a/src/TTImp/TTImp.idr
+++ b/src/TTImp/TTImp.idr
@@ -2,13 +2,16 @@ module TTImp.TTImp
 
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
 
+import Data.String
 import public Data.List1
 import Data.SortedSet
 
-import Libraries.Data.List.SizeOf
+import Core.Evaluate.Value
+import Core.Evaluate.Normalise
+import Core.Evaluate.Expand
+
+import Libraries.Data.SnocList.SizeOf
 import Libraries.Data.WithDefault
 
 %default covering
@@ -25,12 +28,17 @@ record NestedNames (vars : Scope) where
                        List (Var vars), -- names used from the environment
                        FC -> NameType -> Term vars))
 
+namespace NestedNames
+  public export
+  empty : NestedNames vars
+  empty = MkNested []
+
 export
 Weaken NestedNames where
-  weakenNs {ns = wkns} s (MkNested ns) = MkNested (map wknName ns)
+  weakenNs {inner = wkns} s (MkNested ns) = MkNested (map wknName ns)
     where
       wknName : (Name, (Maybe Name, List (Var vars), FC -> NameType -> Term vars)) ->
-                (Name, (Maybe Name, List (Var (wkns ++ vars)), FC -> NameType -> Term (wkns ++ vars)))
+                (Name, (Maybe Name, List (Var (Scope.addInner vars wkns)), FC -> NameType -> Term (Scope.addInner vars wkns)))
       wknName (n, (mn, vars, rep))
           = (n, (mn, map (weakenNs s) vars, \fc, nt => weakenNs s (rep fc nt)))
 
@@ -174,7 +182,7 @@ mutual
          = "(%caselocal (" ++ show uname ++ " " ++ show iname
                ++ " " ++ show args ++ ") " ++ show sc ++ ")"
       show (IUpdate _ flds rec)
-         = "(%record " ++ showSep ", " (map show flds) ++ " " ++ show rec ++ ")"
+         = "(%record " ++ joinBy ", " (map show flds) ++ " " ++ show rec ++ ")"
       show (IApp fc f a)
          = "(" ++ show f ++ " " ++ show a ++ ")"
       show (INamedApp fc f n a)
@@ -186,7 +194,7 @@ mutual
       show (ISearch fc d)
          = "%search"
       show (IAlternative fc ty alts)
-         = "(|" ++ showSep "," (map show alts) ++ "|)"
+         = "(|" ++ joinBy "," (map show alts) ++ "|)"
       show (IRewrite _ rule tm)
          = "(%rewrite (" ++ show rule ++ ") (" ++ show tm ++ "))"
       show (ICoerced _ tm) = "(%coerced " ++ show tm ++ ")"
@@ -215,8 +223,8 @@ mutual
   export
   covering
   Show nm => Show (IFieldUpdate' nm) where
-    show (ISetField p val) = showSep "->" p ++ " = " ++ show val
-    show (ISetFieldApp p val) = showSep "->" p ++ " $= " ++ show val
+    show (ISetField p val) = joinBy "->" p ++ " = " ++ show val
+    show (ISetFieldApp p val) = joinBy "->" p ++ " $= " ++ show val
 
   public export
   FnOpt : Type
@@ -272,14 +280,14 @@ mutual
     show (Hint t) = "%hint " ++ show t
     show (GlobalHint t) = "%globalhint " ++ show t
     show ExternFn = "%extern"
-    show (ForeignFn cs) = "%foreign " ++ showSep " " (map show cs)
-    show (ForeignExport cs) = "%export " ++ showSep " " (map show cs)
+    show (ForeignFn cs) = "%foreign " ++ joinBy " " (map show cs)
+    show (ForeignExport cs) = "%export " ++ joinBy " " (map show cs)
     show Invertible = "%invertible"
     show (Totality Total) = "total"
     show (Totality CoveringOnly) = "covering"
     show (Totality PartialOK) = "partial"
     show Macro = "%macro"
-    show (SpecArgs ns) = "%spec " ++ showSep " " (map show ns)
+    show (SpecArgs ns) = "%spec " ++ joinBy " " (map show ns)
 
   export
   Eq FnOpt where
@@ -402,7 +410,7 @@ mutual
     show (MkImpRecord header body)
         = "record " ++ show header.name.val ++ " " ++ show header.val ++
           " " ++ show body.name.val ++ "\n\t" ++
-          showSep "\n\t" (map show body.val) ++ "\n"
+          joinBy "\n\t" (map show body.val) ++ "\n"
 
   public export
   data WithFlag
@@ -496,14 +504,14 @@ mutual
     show (IDef _ n cs) = "(%def " ++ show n ++ " " ++ show cs ++ ")"
     show (IParameters _ ps ds)
         = "parameters " ++ show ps ++ "\n\t" ++
-          showSep "\n\t" (assert_total $ map show ds)
+          joinBy "\n\t" (assert_total $ map show ds)
     show (IRecord _ _ _ _ d) = show d.val
     show (IFail _ msg decls)
         = "fail" ++ maybe "" ((" " ++) . show) msg ++ "\n" ++
-          showSep "\n" (assert_total $ map (("  " ++) . show) decls)
+          joinBy "\n" (assert_total $ map (("  " ++) . show) decls)
     show (INamespace _ ns decls)
         = "namespace " ++ show ns ++
-          showSep "\n" (assert_total $ map show decls)
+          joinBy "\n" (assert_total $ map show decls)
     show (ITransform _ n lhs rhs)
         = "%transform " ++ show n ++ " " ++ show lhs ++ " ==> " ++ show rhs
     show (IRunElabDecl _ tm)
@@ -705,8 +713,7 @@ implicitsAs n defs ns tm
                     "Could not find variable " ++ show n
                   pure $ IVar loc nm
             Just ty =>
-               do ty' <- nf defs Env.empty ty
-                  implicits <- findImps is es ns ty'
+               do implicits <- findImps is es ns !(expand !(nf Env.empty ty))
                   log "declare.def.lhs.implicits" 30 $
                     "\n  In the type of " ++ show n ++ ": " ++ show ty ++
                     "\n  Using locals: " ++ show ns ++
@@ -734,20 +741,22 @@ implicitsAs n defs ns tm
         -- in the lhs: this is used to determine when to stop searching for further
         -- implicits to add.
         findImps : List (Maybe Name) -> List (Maybe Name) ->
-                   List Name -> ClosedNF ->
+                   List Name -> NF [<] ->
                    Core (List (Name, PiInfo RawImp))
         -- #834 When we are in a local definition, we have an explicit telescope
         -- corresponding to the variables bound in the parent function.
         -- Parameter blocks also introduce additional telescope of implicit, auto,
         -- and explicit variables. So we first peel off all of the quantifiers
         -- corresponding to these variables.
-        findImps ns es (_ :: locals) (NBind fc x (Pi {}) sc)
-          = do body <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+        findImps ns es (_ :: locals) (VBind fc x (Pi {}) sc)
+          = do body <- sc (pure (VErased fc Placeholder))
+               body <- expand body
                findImps ns es locals body
                -- ^ TODO? check that name of the pi matches name of local?
         -- don't add implicits coming after explicits that aren't given
-        findImps ns es [] (NBind fc x (Pi _ _ Explicit _) sc)
-            = do body <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+        findImps ns es [] (VBind fc x (Pi _ _ Explicit _) sc)
+            = do body <- sc (pure (VErased fc Placeholder))
+                 body <- expand body
                  case es of
                    -- Explicits were skipped, therefore all explicits are given anyway
                    Just (UN Underscore) :: _ => findImps ns es [] body
@@ -756,14 +765,16 @@ implicitsAs n defs ns tm
                           Nothing => pure [] -- explicit wasn't given
                           Just es' => findImps ns es' [] body
         -- if the implicit was given, skip it
-        findImps ns es [] (NBind fc x (Pi _ _ AutoImplicit _) sc)
-            = do body <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+        findImps ns es [] (VBind fc x (Pi _ _ AutoImplicit _) sc)
+            = do body <- sc (pure (VErased fc Placeholder))
+                 body <- expand body
                  case updateNs x ns of
                    Nothing => -- didn't find explicit call
                       pure $ (x, AutoImplicit) :: !(findImps ns es [] body)
                    Just ns' => findImps ns' es [] body
-        findImps ns es [] (NBind fc x (Pi _ _ p _) sc)
-            = do body <- sc defs (toClosure defaultOpts Env.empty (Erased fc Placeholder))
+        findImps ns es [] (VBind fc x (Pi _ _ p _) sc)
+            = do body <- sc (pure (VErased fc Placeholder))
+                 body <- expand body
                  if Just x `elem` ns
                    then findImps ns es [] body
                    else pure $ (x, forgetDef p) :: !(findImps ns es [] body)
diff --git a/src/TTImp/Unelab.idr b/src/TTImp/Unelab.idr
index b5ddeb58096..85641f66b4f 100644
--- a/src/TTImp/Unelab.idr
+++ b/src/TTImp/Unelab.idr
@@ -1,18 +1,23 @@
 module TTImp.Unelab
 
-import Core.Case.CaseTree
 import Core.Context.Log
 import Core.Env
-import Core.Normalise
-import Core.Value
 
 import TTImp.TTImp
 
 import Data.String
+import Data.Vect
 
-import Libraries.Data.VarSet
+import Core.Evaluate.Value
+import Core.Evaluate.Quote
+import Core.Evaluate.Normalise
+import Core.Evaluate.Convert
+import Core.Evaluate.Expand
+import Core.Evaluate
+import Core.Name.CompatibleVars
 
-import Libraries.Data.List.SizeOf
+import Libraries.Data.VarSet
+import Libraries.Data.SnocList.SizeOf
 
 %default covering
 
@@ -23,12 +28,13 @@ used {vars} idx (Bind _ x b sc) = usedBinder b || used (1 + idx) sc
     usedBinder : Binder (Term vars) -> Bool
     usedBinder (Let _ _ val ty) = used idx val || used idx ty
     usedBinder b = used idx (binderType b)
-used idx (Meta _ _ _ args) = any (used idx) args
-used idx (App _ f a) = used idx f || used idx a
+used idx (Meta _ _ _ args) = any (used idx . snd) args
+used idx (App _ f _ a) = used idx f || used idx a
 used idx (As _ _ _ pat) = used idx pat
 used idx (TDelayed _ _ tm) = used idx tm
 used idx (TDelay _ _ _ tm) = used idx tm
 used idx (TForce _ _ tm) = used idx tm
+used idx (PrimOp _ _ args) = any (used idx) args
 used idx _ = False
 
 public export
@@ -36,132 +42,16 @@ data UnelabMode
      = Full
      | NoSugar Bool -- uniqify names
      | ImplicitHoles
+     | NoImplicits
 
 Eq UnelabMode where
    Full == Full = True
    NoSugar t == NoSugar u = t == u
    ImplicitHoles == ImplicitHoles = True
+   NoImplicits == NoImplicits = True
    _ == _ = False
 
 mutual
-
-  ||| Unelaborate a call to a case expression as an inline case.
-  ||| This should allow us to eventurally resugar case blocks and if-then-else calls.
-  |||
-  ||| This is really hard however because all we have access to is the
-  ||| clauses of the lifted case expression. So e.g.
-  |||      f x = case g x of p -> e
-  ||| became
-  |||      f x = f-case x (g x)
-  |||      f-case x p = e
-  ||| and so to display the
-  |||      f-case (h y) (g (p o))
-  ||| correctly we need to:
-  ||| 1. extract p from f-case x p
-  ||| 2. replace x with (h y) in e
-  |||
-  ||| However it can be the case that x has been split because it was forced by a
-  ||| pattern in p and so looking at (f-case x p) we may not be able to recover the
-  ||| name x.
-  |||
-  ||| We will try to do our best...
-  unelabCase : {vars : _} ->
-               {auto c : Ref Ctxt Defs} ->
-               List (Name, Nat) ->
-               Env Term vars ->
-               Name ->
-               List (Term vars) ->
-               Core (Maybe IRawImp)
-  unelabCase nest env n args
-      = do defs <- get Ctxt
-           Just glob <- lookupCtxtExact n (gamma defs)
-                | Nothing => pure Nothing
-           let PMDef _ pargs treect _ pats = definition glob
-                | _ => pure Nothing
-           let Just argpos = findArgPos treect
-                | _ => pure Nothing
-           if length args == length pargs
-              then mkCase pats argpos args
-              else pure Nothing
-    where
-      -- Need to find the position of the scrutinee to rebuild original
-      -- case correctly
-      findArgPos : CaseTree as -> Maybe Nat
-      findArgPos (Case idx p _ _) = Just idx
-      findArgPos _ = Nothing
-
-      -- TODO: some utility like this should probably be implemented in Core
-      substVars : List (VarSet vs, Term vs) -> Term vs -> Term vs
-      substVars xs tm@(Local fc _ idx prf)
-          = case find ((MkVar prf `VarSet.elem`) . fst) xs of
-                 Just (_, new) => new
-                 Nothing => tm
-      substVars xs (Meta fc n i args)
-          = Meta fc n i (map (substVars xs) args)
-      substVars xs (Bind fc y b scope)
-          = Bind fc y (map (substVars xs) b) (substVars (map (bimap (weaken {tm = VarSet}) weaken) xs) scope)
-      substVars xs (App fc fn arg)
-          = App fc (substVars xs fn) (substVars xs arg)
-      substVars xs (As fc s as pat)
-          = As fc s as (substVars xs pat)
-      substVars xs (TDelayed fc y z)
-          = TDelayed fc y (substVars xs z)
-      substVars xs (TDelay fc y t z)
-          = TDelay fc y (substVars xs t) (substVars xs z)
-      substVars xs (TForce fc r y)
-          = TForce fc r (substVars xs y)
-      substVars xs tm = tm
-
-      substArgs : SizeOf vs -> List (VarSet vs, Term vars) -> Term vs -> Term (vs ++ vars)
-      substArgs p substs tm =
-        let
-          substs' = map (bimap (embed {tm = VarSet} {outer = vars}) (weakenNs p)) substs
-          tm' = embed tm
-        in
-          substVars substs' tm'
-
-      argVars : {0 vs : _} -> VarSet vs -> Term vs -> VarSet vs
-      argVars acc (As _ _ as pat) = argVars (argVars acc as) pat
-      argVars acc (Local _ _ _ p) = VarSet.insert (MkVar p) acc
-      argVars acc _ = acc
-
-      mkClause : FC -> Nat ->
-                 List (Term vars) ->
-                 (vs ** (Env Term vs, Term vs, Term vs)) ->
-                 Core (Maybe IImpClause)
-      mkClause fc argpos args (vs ** (clauseEnv, lhs, rhs))
-          = do logTerm "unelab.case.clause" 20 "Unelaborating clause" lhs
-               let patArgs = snd (getFnArgs lhs)
-                   Just pat = getAt argpos patArgs
-                     | _ => pure Nothing
-                   rhs = substArgs (mkSizeOf vs) (zip (map (argVars (VarSet.empty {vs})) patArgs) args) rhs
-               logTerm "unelab.case.clause" 20 "Unelaborating LHS" pat
-               lhs' <- unelabTy Full nest clauseEnv pat
-               logTerm "unelab.case.clause" 20 "Unelaborating RHS" rhs
-               logEnv "unelab.case.clause" 20 "In Env" clauseEnv
-               rhs' <- unelabTy Full nest (clauseEnv ++ env) rhs
-               pure $ Just $ (PatClause fc (fst lhs') (fst rhs'))
-
-      ||| mkCase looks up the value passed as the scrutinee of the case-block.
-      ||| @ argpos is the index of the case-block's scrutinee in args
-      ||| @ args   is the list of arguments at the call site of the case-block
-      |||
-      ||| Once we have the scrutinee `e`, we can form `case e of` and so focus
-      ||| on manufacturing the clauses.
-      mkCase : List (vs ** (Env Term vs, Term vs, Term vs)) ->
-               (argpos : Nat) -> List (Term vars) -> Core (Maybe IRawImp)
-      mkCase pats argpos args
-          = do unless (null args) $ log "unelab.case.clause" 20 $
-                 unwords $ "Ignoring" :: map show args
-               let Just scrutinee = getAt argpos args
-                     | _ => pure Nothing
-                   fc = getLoc scrutinee
-               (tm, _) <- unelabTy Full nest env scrutinee
-               Just pats' <- map sequence $ traverse (mkClause fc argpos args) pats
-                 | _ => pure Nothing
-               -- TODO: actually grab the fnopts?
-               pure $ Just $ ICase fc [] tm (Implicit fc False) pats'
-
   dropParams : List (Name, Nat) -> (IRawImp, Glued vars) ->
                Core (IRawImp, Glued vars)
   dropParams nest (tm, ty)
@@ -201,7 +91,7 @@ mutual
   unelabTy' umode nest env (Local fc _ idx p)
       = do let nm = nameAt p
            log "unelab.case" 20 $ "Found local name: " ++ show nm
-           let ty = gnf env (binderType (getBinder p env))
+           ty <- nf env (binderType (getBinder p env))
            pure (IVar fc (MkKindedName (Just Bound) nm nm), ty)
   unelabTy' umode nest env (Ref fc nt n)
       = do defs <- get Ctxt
@@ -219,7 +109,7 @@ mutual
                      , "sugared to", show n'
                      ]
 
-           pure (IVar fc (MkKindedName (Just nt) fn n'), gnf env (embed ty))
+           pure (IVar fc (MkKindedName (Just nt) fn n'), !(nf env (embed ty)))
   unelabTy' umode nest env (Meta fc n i args)
       = do defs <- get Ctxt
            let mkn = nameRoot n
@@ -231,19 +121,22 @@ mutual
                | Nothing => case umode of
                                  ImplicitHoles => pure (Implicit fc True, gErased fc)
                                  _ => pure (term, gErased fc)
-           pure (term, gnf env (embed ty))
+           pure (term, !(nf env (embed ty)))
+
   unelabTy' umode nest env (Bind fc x b sc)
       = case umode of
           NoSugar True => do
             let x' = uniqueLocal vars x
-            let sc : Term (x' :: vars) = compat sc
-            (sc', scty) <- unelabTy umode nest (b :: env) sc
+            let sc : Term (vars :< x') = compat sc
+            let env' = Env.bind env b
+            (sc', scty) <- unelabTy umode nest env' sc
             unelabBinder umode nest fc env x' b
                          (compat sc) sc'
-                         (compat !(getTerm scty))
+                         (compat !(quote env' scty))
           _ => do
-            (sc', scty) <- unelabTy umode nest (b :: env) sc
-            unelabBinder umode nest fc env x b sc sc' !(getTerm scty)
+            let env' = Env.bind env b
+            (sc', scty) <- unelabTy umode nest env' sc
+            unelabBinder umode nest fc env x b sc sc' !(quote env' scty)
     where
       next : Name -> Name
       next (MN n i) = MN n (i + 1)
@@ -256,33 +149,20 @@ mutual
          = if n `elem` vs
               then uniqueLocal vs (next n)
               else n
-  unelabTy' umode nest env tm@(App fc fn arg)
+  unelabTy' umode nest env tm@(App fc fn c arg)
       = do (fn', gfnty) <- unelabTy umode nest env fn
            (arg', gargty) <- unelabTy umode nest env arg
-           fnty <- getNF gfnty
-           defs <- get Ctxt
-           Nothing <-
-              case umode of
-                (NoSugar _) => pure Nothing
-                ImplicitHoles => pure Nothing
-                _ => case getFnArgs tm of
-                     (Ref _ _ fnName, args) => do
-                       fullName <- getFullName fnName
-                       let (NS ns (CaseBlock n i)) = fullName
-                         | _ => pure Nothing
-                       unelabCase nest env fullName args
-                     _ => pure Nothing
-             | Just tm => pure (tm, gErased fc)
+           fnty <- expand gfnty
            case fnty of
-                NBind _ x (Pi _ rig Explicit ty) sc
-                  => do sc' <- sc defs (toClosure defaultOpts env arg)
-                        pure (IApp fc fn' arg',
-                                glueBack defs env sc')
-                NBind _ x (Pi _ rig p ty) sc
-                  => do sc' <- sc defs (toClosure defaultOpts env arg)
-                        pure (INamedApp fc fn' x arg',
-                                glueBack defs env sc')
-                _ => pure (IApp fc fn' arg', gErased fc)
+                VBind _ x (Pi _ rig Explicit ty) sc
+                  => do sc' <- sc (nf env arg)
+                        pure (IApp fc fn' arg', sc')
+                VBind _ x (Pi _ rig p ty) sc
+                  => do sc' <- sc (nf env arg)
+                        case umode of
+                             NoImplicits => pure (fn', sc')
+                             _ => pure (INamedApp fc fn' x arg', sc')
+                _ => pure (IApp fc fn' arg', VErased fc Placeholder)
   unelabTy' umode nest env (As fc s p tm)
       = do (p', _) <- unelabTy' umode nest env p
            (tm', ty) <- unelabTy' umode nest env tm
@@ -292,6 +172,73 @@ mutual
                          NoSugar _ => pure (IAs fc (getLoc p) s n.rawName tm', ty)
                          _ => pure (tm', ty)
                 _ => pure (tm', ty) -- Should never happen!
+  unelabTy' umode nest env (Case fc ty c sc scty alts)
+      = do (sc', _) <- unelabTy' umode nest env sc
+           (scty', _) <- unelabTy' umode nest env scty
+           alts' <- traverse unelabAlt alts
+           pure (ICase fc [] sc' scty' alts', gErased fc)
+    where
+      unelabScope : {vars : _} ->
+                    FC -> Name -> SnocList (Maybe Name, Name) ->
+                    Env Term vars -> NF [<] ->
+                    CaseScope vars -> Core IImpClause
+      unelabScope fc n args env _ (RHS _ tm)
+          = do (tm', _) <- unelabTy' umode nest env tm
+               let n' = MkKindedName (Just Bound) n n
+               pure (PatClause fc (applySpine (IVar fc n') args) tm')
+        where
+          applySpine : IRawImp -> SnocList (Maybe Name, Name) -> IRawImp
+          applySpine fn [<] = fn
+          applySpine fn (args :< (Nothing, arg))
+              = let arg' = MkKindedName (Just Bound) arg arg in
+                    IApp fc (applySpine fn args) (IVar fc arg')
+          applySpine fn (args :< (Just n, arg))
+              = let arg' = MkKindedName (Just Bound) arg arg in
+                    case umode of
+                        ImplicitHoles => applySpine fn args
+                        _ => INamedApp fc (applySpine fn args) n (IVar fc arg')
+
+      unelabScope fc n args env (VBind _ v (Pi _ rig p ty) tsc) (Arg c x sc)
+          = do p' <- the (Core (PiInfo (Term [<]))) $ case p of
+                          Explicit => pure Explicit
+                          Implicit => pure Implicit
+                          AutoImplicit => pure AutoImplicit
+                          DefImplicit t => pure $ DefImplicit !(quote [<] t)
+               vty <- quote [<] ty
+               let env' = env :< PVar fc rig (map embed p') (embed vty)
+               -- We only need the type to make sure we're getting the plicities
+               -- right, so use an explicit name to feed to the scope type
+               tsc' <- expand !(tsc (pure (vRef fc Bound n)))
+               let xn = case p' of
+                             Explicit => Nothing
+                             _ => Just v
+               unelabScope fc n (args :< (xn, x)) env' tsc' sc
+      unelabScope fc n args env ty (Arg c x sc)
+          = do let env' = env :< PVar fc top Explicit (Erased fc Placeholder)
+               unelabScope fc n (args :< (Nothing, x)) env' (VErased fc Placeholder) sc
+
+      unelabAlt : CaseAlt vars -> Core IImpClause
+      unelabAlt (ConCase fc n t sc)
+          = do defs <- get Ctxt
+               nty <- lookupTyExact n (gamma defs)
+               let ty = case nty of
+                             Nothing => Erased fc Placeholder
+                             Just t => t
+               unelabScope fc !(getFullName n) [<] env !(expand !(nf [<] ty)) sc
+      unelabAlt (DelayCase fc t a tm)
+          = do let env' = env :<
+                       PVar fc top Explicit (Erased fc Placeholder) :<
+                       PVar fc erased Implicit (Erased fc Placeholder)
+               (tm', _) <- unelabTy' umode nest env' tm
+               let a' = MkKindedName (Just Bound) a a
+               pure (PatClause fc (IDelay fc (IVar fc a')) tm')
+      unelabAlt (ConstCase fc c tm)
+          = do (tm', _) <- unelabTy' umode nest env tm
+               pure (PatClause fc (IPrimVal fc c) tm')
+      unelabAlt (DefaultCase fc tm)
+          = do (tm', _) <- unelabTy' umode nest env tm
+               pure (PatClause fc (Implicit fc False) tm')
+
   unelabTy' umode nest env (TDelayed fc r tm)
       = do (tm', ty) <- unelabTy' umode nest env tm
            defs <- get Ctxt
@@ -305,10 +252,14 @@ mutual
            defs <- get Ctxt
            pure (IForce fc tm', gErased fc)
   unelabTy' umode nest env (PrimVal fc c) = pure (IPrimVal fc c, gErased fc)
+  unelabTy' umode nest env (PrimOp fc fn args)
+      = -- If we ever see this in output, we've overevaluated
+        pure (Implicit fc True, gErased fc)
   unelabTy' umode nest env (Erased fc (Dotted t))
     = unelabTy' umode nest env t
   unelabTy' umode nest env (Erased fc _) = pure (Implicit fc True, gErased fc)
   unelabTy' umode nest env (TType fc _) = pure (IType fc, gType fc (MN "top" 0))
+  unelabTy' umode nest env (Unmatched fc msg) = pure (Implicit fc True, gUnmatched fc msg)
 
   unelabPi : {vars : _} ->
              {auto c : Ref Ctxt Defs} ->
@@ -328,19 +279,19 @@ mutual
                  (umode : UnelabMode) ->
                  (nest : List (Name, Nat)) ->
                  FC -> Env Term vars -> (x : Name) ->
-                 Binder (Term vars) -> Term (x :: vars) ->
-                 IRawImp -> Term (x :: vars) ->
+                 Binder (Term vars) -> Term (Scope.bind vars x) ->
+                 IRawImp -> Term (Scope.bind vars x) ->
                  Core (IRawImp, Glued vars)
   unelabBinder umode nest fc env x (Lam fc' rig p ty) sctm sc scty
       = do (ty', _) <- unelabTy umode nest env ty
            p' <- unelabPi umode nest env p
            pure (ILam fc rig p' (Just x) ty' sc,
-                    gnf env (Bind fc x (Pi fc' rig p ty) scty))
+                    !(nf env (Bind fc x (Pi fc' rig p ty) scty)))
   unelabBinder umode nest fc env x (Let fc' rig val ty) sctm sc scty
       = do (val', vty) <- unelabTy umode nest env val
            (ty', _) <- unelabTy umode nest env ty
            pure (ILet fc EmptyFC rig x ty' val' sc,
-                    gnf env (Bind fc x (Let fc' rig val ty) scty))
+                    !(nf env (Bind fc x (Let fc' rig val ty) scty)))
   unelabBinder umode nest fc env x (Pi _ rig p ty) sctm sc scty
       = do (ty', _) <- unelabTy umode nest env ty
            p' <- unelabPi umode nest env p
@@ -359,12 +310,12 @@ mutual
       isDefImp _ = False
   unelabBinder umode nest fc env x (PVar fc' rig _ ty) sctm sc scty
       = do (ty', _) <- unelabTy umode nest env ty
-           pure (sc, gnf env (Bind fc x (PVTy fc' rig ty) scty))
+           pure (sc, !(nf env (Bind fc x (PVTy fc' rig ty) scty)))
   unelabBinder umode nest fc env x (PLet fc' rig val ty) sctm sc scty
       = do (val', vty) <- unelabTy umode nest env val
            (ty', _) <- unelabTy umode nest env ty
            pure (ILet fc EmptyFC rig x ty' val' sc,
-                    gnf env (Bind fc x (PLet fc' rig val ty) scty))
+                    !(nf env (Bind fc x (PLet fc' rig val ty) scty)))
   unelabBinder umode nest fc env x (PVTy _ rig ty) sctm sc scty
       = do (ty', _) <- unelabTy umode nest env ty
            pure (sc, gType fc (MN "top" 0))
@@ -401,7 +352,7 @@ unelabNest : {vars : _} ->
              Env Term vars ->
              Term vars -> Core IRawImp
 unelabNest mode nest env (Meta fc n i args)
-    = do let mkn = nameRoot n ++ showScope args
+    = do let mkn = nameRoot n ++ ((showScope $ map snd args))
          pure (IHole fc mkn)
   where
     toName : Term vars -> Maybe Name
@@ -410,7 +361,7 @@ unelabNest mode nest env (Meta fc n i args)
 
     showNScope : List Name -> String
     showNScope [] = "[no locals in scope]"
-    showNScope ns = "[locals in scope: " ++ showSep ", " (map show (nub ns)) ++ "]"
+    showNScope ns = "[locals in scope: " ++ joinBy ", " (map show (nub ns)) ++ "]"
 
     showScope : List (Term vars) -> String
     showScope ts = " " ++ showNScope (mapMaybe toName ts)
diff --git a/src/TTImp/Utils.idr b/src/TTImp/Utils.idr
index 790d8e9d138..45f786ae007 100644
--- a/src/TTImp/Utils.idr
+++ b/src/TTImp/Utils.idr
@@ -1,7 +1,9 @@
 module TTImp.Utils
 
 import Core.Env
-import Core.Value
+import Core.Evaluate.Value
+import Core.Evaluate.Expand
+
 import Core.UnifyState
 import TTImp.TTImp
 
@@ -557,9 +559,9 @@ getArgName : {vars : _} ->
                           -- so we don't invent a default
                           -- name that duplicates it
              List Name -> -- names bound so far
-             NF vars -> Core String
+             Glued vars -> Core String
 getArgName defs x bound allvars ty
-    = do defnames <- findNames ty
+    = do defnames <- findNames !(expand ty)
          pure $ getName x defnames allvars
   where
     lookupName : Name -> List (Name, a) -> Core (Maybe a)
@@ -575,53 +577,34 @@ getArgName defs x bound allvars ty
     defaultNames : List String
     defaultNames = ["x", "y", "z", "w", "v", "s", "t", "u"]
 
-    namesFor : Name -> Core (Maybe (List String))
-    namesFor n = lookupName n (NameMap.toList (namedirectives defs))
-
-    findNamesM : NF vars -> Core (Maybe (List String))
-    findNamesM (NBind _ x (Pi {}) _)
-        = pure (Just ["f", "g"])
-    findNamesM (NTCon _ n d [(_, v)]) = do
-          case dropNS !(full (gamma defs) n) of
-            UN (Basic "List") =>
-              do nf <- evalClosure defs v
-                 case !(findNamesM nf) of
-                   Nothing => namesFor n
-                   Just ns => pure (Just (map (++ "s") ns))
-            UN (Basic "Maybe") =>
-              do nf <- evalClosure defs v
-                 case !(findNamesM nf) of
-                   Nothing => namesFor n
-                   Just ns => pure (Just (map ("m" ++) ns))
-            UN (Basic "SnocList") =>
-              do nf <- evalClosure defs v
-                 case !(findNamesM nf) of
-                   Nothing => namesFor n
-                   Just ns => pure (Just (map ("s" ++) ns))
-            _ => namesFor n
-    findNamesM (NTCon _ n _ _) = namesFor n
-    findNamesM (NPrimVal fc $ PrT c) = do
+    findNames : NF vars -> Core (List String)
+    findNames (VBind _ x (Pi {}) _)
+        = pure (filter notBound ["f", "g"])
+    findNames (VTCon _ n _ _)
+        = pure $ filter notBound
+        $ case !(lookupName n (NameMap.toList (namedirectives defs))) of
+               Nothing => defaultNames
+               Just ns => ns
+    findNames (VPrimVal fc c) = do
           let defaultPos = ["m", "n", "p", "q"]
           let defaultInts = ["i", "j", "k", "l"]
-          pure $ Just $ filter notBound $ case c of
-            IntType => defaultInts
-            Int8Type => defaultInts
-            Int16Type => defaultInts
-            Int32Type => defaultInts
-            Int64Type => defaultInts
-            IntegerType => defaultInts
-            Bits8Type => defaultPos
-            Bits16Type => defaultPos
-            Bits32Type => defaultPos
-            Bits64Type => defaultPos
-            StringType => ["str"]
-            CharType => ["c","d"]
-            DoubleType => ["dbl"]
-            WorldType => ["wrld", "w"]
-    findNamesM ty = pure Nothing
-
-    findNames : NF vars -> Core (List String)
-    findNames nf = pure $ filter notBound $ fromMaybe defaultNames !(findNamesM nf)
+          pure $ filter notBound $ case c of
+            PrT IntType => defaultInts
+            PrT Int8Type => defaultInts
+            PrT Int16Type => defaultInts
+            PrT Int32Type => defaultInts
+            PrT Int64Type => defaultInts
+            PrT IntegerType => defaultInts
+            PrT Bits8Type => defaultPos
+            PrT Bits16Type => defaultPos
+            PrT Bits32Type => defaultPos
+            PrT Bits64Type => defaultPos
+            PrT StringType => ["str"]
+            PrT CharType => ["c","d"]
+            PrT DoubleType => ["dbl"]
+            PrT WorldType => ["wrld", "w"]
+            _ => defaultNames -- impossible
+    findNames ty = pure (filter notBound defaultNames)
 
     getName : Name -> List String -> List Name -> String
     getName (UN (Basic n)) defs used =
@@ -636,11 +619,12 @@ getArgNames : {vars : _} ->
               {auto c : Ref Ctxt Defs} ->
               Defs -> List Name -> List Name -> Env Term vars -> NF vars ->
               Core (List String)
-getArgNames defs bound allvars env (NBind fc x (Pi _ _ p ty) sc)
+getArgNames defs bound allvars env (VBind fc x (Pi _ _ p ty) sc)
     = do ns <- case p of
-                    Explicit => pure [!(getArgName defs x bound allvars !(evalClosure defs ty))]
+                    Explicit => pure [!(getArgName defs x bound allvars ty)]
                     _ => pure []
-         sc' <- sc defs (toClosure defaultOpts env (Erased fc Placeholder))
+         sc' <- sc (pure (VErased fc Placeholder))
+         sc' <- expand sc'
          pure $ ns ++ !(getArgNames defs bound (map (UN . Basic) ns ++ allvars) env sc')
 getArgNames defs bound allvars env val = pure []
 
diff --git a/src/Yaffle/REPL.idr b/src/Yaffle/REPL.idr
index 03a4f68585a..a3c09e73771 100644
--- a/src/Yaffle/REPL.idr
+++ b/src/Yaffle/REPL.idr
@@ -5,6 +5,7 @@ import Core.Env
 import Core.Metadata
 import Core.Termination
 import Core.Unify
+import Core.Evaluate
 
 import Idris.REPL.Opts
 import Idris.Syntax
@@ -20,6 +21,8 @@ import TTImp.Unelab
 
 import Parser.Source
 
+import Data.String
+
 %default covering
 
 showInfo : (Name, Int, GlobalDef) -> Core ()
@@ -36,9 +39,9 @@ process : {auto c : Ref Ctxt Defs} ->
           {auto o : Ref ROpts REPLOpts} ->
           ImpREPL -> Core Bool
 process (Eval ttimp)
-    = do (tm, _) <- elabTerm 0 InExpr [] (MkNested []) Env.empty ttimp Nothing
+    = do (tm, _) <- elabTerm 0 InExpr [] (NestedNames.empty) Env.empty ttimp Nothing
          defs <- get Ctxt
-         tmnf <- normalise defs Env.empty tm
+         tmnf <- normalise Env.empty tm
          coreLift_ (printLn !(unelab Env.empty tmnf))
          pure True
 process (Check (IVar _ n))
@@ -50,14 +53,14 @@ process (Check (IVar _ n))
     printName : (Name, Int, ClosedTerm) -> Core ()
     printName (n, _, tyh)
         = do defs <- get Ctxt
-             ty <- normaliseHoles defs Env.empty tyh
+             ty <- normaliseHoles Env.empty tyh
              coreLift_ $ putStrLn $ show n ++ " : " ++
                                     show !(unelab Env.empty ty)
 process (Check ttimp)
-    = do (tm, gty) <- elabTerm 0 InExpr [] (MkNested []) Env.empty ttimp Nothing
+    = do (tm, gty) <- elabTerm 0 InExpr [] (NestedNames.empty) Env.empty ttimp Nothing
          defs <- get Ctxt
-         tyh <- getTerm gty
-         ty <- normaliseHoles defs Env.empty tyh
+         tyh <- quote Env.empty gty
+         ty <- normaliseHoles Env.empty tyh
          coreLift_ (printLn !(unelab Env.empty ty))
          pure True
 process (ProofSearch n_in)
@@ -66,7 +69,7 @@ process (ProofSearch n_in)
               | ns => ambiguousName (justFC defaultFC) n_in (map fst ns)
          def <- search (justFC defaultFC) top False 1000 n ty Env.empty
          defs <- get Ctxt
-         defnf <- normaliseHoles defs Env.empty def
+         defnf <- normaliseHoles Env.empty def
          coreLift_ (printLn !(toFullNames defnf))
          pure True
 process (ExprSearch n_in)
@@ -101,13 +104,13 @@ process (Missing n_in)
                              case isCovering tot of
                                   MissingCases cs =>
                                      coreLift_ (putStrLn (show fn ++ ":\n" ++
-                                                 showSep "\n" (map show cs)))
+                                                 joinBy "\n" (map show cs)))
                                   NonCoveringCall ns =>
                                      coreLift_ (putStrLn
                                          (show fn ++ ": Calls non covering function"
                                            ++ case ns of
                                                    [fn] => " " ++ show fn
-                                                   _ => "s: " ++ showSep ", " (map show ns)))
+                                                   _ => "s: " ++ joinBy ", " (map show ns)))
                                   _ => coreLift_ $ putStrLn (show fn ++ ": All cases covered"))
                         (map fst ts)
                        pure True
diff --git a/tests/Main.idr b/tests/Main.idr
index c8bb0050f7a..e03b73e8879 100644
--- a/tests/Main.idr
+++ b/tests/Main.idr
@@ -105,12 +105,6 @@ idrisTestsAllBackends cg = testsInDir "allbackends"
 idrisTestsTotality : IO TestPool
 idrisTestsTotality = testsInDir "idris2/total" "Totality checking"
 
--- This will only work with an Idris compiled via Chez or Racket, but at
--- least for the moment we're not officially supporting self hosting any
--- other way. If we do, we'll need to have a way to disable these.
-idrisTestsSchemeEval : IO TestPool
-idrisTestsSchemeEval = testsInDir "idris2/schemeeval" "Scheme Evaluator"
-
 idrisTestsReflection : IO TestPool
 idrisTestsReflection = testsInDir "idris2/reflection" "Quotation and Reflection"
 
@@ -200,7 +194,6 @@ main = (runner =<<) $ sequence $
   , idrisTestsEvaluator
   , idrisTestsREPL
   , idrisTestsTotality
-  , idrisTestsSchemeEval
   , idrisTestsReflection
   , idrisTestsWith
   , idrisTestsOperators
diff --git a/tests/codegen/builtin001/expected b/tests/codegen/builtin001/expected
index 148b69809f6..1eab2eef83b 100644
--- a/tests/codegen/builtin001/expected
+++ b/tests/codegen/builtin001/expected
@@ -1,3 +1,3 @@
 Dumping case trees to Main.cases
-Main.plus = [{arg:0}, {arg:1}]: (%case !{arg:0} [(%constcase 0 !{arg:1})] Just (%let {e:0} (-Integer [!{arg:0}, 1]) (+Integer [(Main.plus [!{e:0}, !{arg:1}]), 1])))
-Main.main = [{ext:0}]: (Main.plus [1, 2])
+Main.plus = [{arg:0}, {arg:1}]: (%case const !{arg:0} [(%constcase 0 !{arg:1})] Just (%let {e:0} (-Integer [!{arg:0}, 1]) (+Integer [(Main.plus [!{e:0}, !{arg:1}]), 1])))
+Main.main = [{eta:0}]: (Main.plus [1, 2])
diff --git a/tests/idris2/basic/basic019/expected b/tests/idris2/basic/basic019/expected
index 55c5e268160..d9d29aee5e5 100644
--- a/tests/idris2/basic/basic019/expected
+++ b/tests/idris2/basic/basic019/expected
@@ -1,7 +1,7 @@
 1/1: Building CaseBlock (CaseBlock.idr)
-Main> Main.foo : (x : Nat) -> (case x of { 0 => Nat -> Nat ; S k => Nat })
+Main> Main.foo : Nat -> (case x of { 0 => Nat -> Nat ; S e => Nat })
 Main> Prelude.elem : Foldable t => Eq a => a -> t a -> Bool
 elem = elemBy (==)
 Main> PrimIO.io_bind : (1 _ : IO a) -> (1 _ : (a -> IO b)) -> IO b
-io_bind (MkIO fn) k = MkIO (\1 w => let MkIORes x' w' = fn w in let MkIO res = k x' in res w')
+io_bind (MkIO fn) k = MkIO (\1 w => let 1 sc = fn w in let MkIORes e e = sc in let 1 sc = k e in let MkIO e = sc in e e)
 Main> Bye for now!
diff --git a/tests/idris2/basic/basic044/expected b/tests/idris2/basic/basic044/expected
index e6d7a545bdc..25d864d4bb4 100644
--- a/tests/idris2/basic/basic044/expected
+++ b/tests/idris2/basic/basic044/expected
@@ -1,128 +1,348 @@
 1/1: Building Term (Term.idr)
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.type:1: Processing Term.Typ
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.data:1: Processing Term.Bdr
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:cut:1}, (Term:1, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:vars:1}, (Term:2, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:cut:2}, (Term:3, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:vars:2}, (Term:4, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.data:1: Processing Term.Chk
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:cut:3}, (Term:5, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:vars:3}, (Term:6, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:cut:4}, (Term:7, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:vars:4}, (Term:8, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:n:1}, (Term:9, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.data:1: Processing Term.Syn
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:vars:5}, (Term:10, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:cut:5}, (Term:11, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG unify.meta:5: Adding new meta ({P:cut:6}, (Term:12, Rig0))
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:vars:6}, (Term:13, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
 LOG unify.meta:5: Adding new meta ({P:vars:7}, (Term:14, Rig0))
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.def.lhs:3: LHS term: Term.Typ
-LOG unify.equal:10: Skipped unification (equal already): (vars : $resolved1) -> Type and (vars : $resolved1) -> Type
+LOG unify.equal:10: Begin unification (non-application) True: (cut : Prelude.Basics.Bool) -> (vars : Prelude.Types.Nat) -> Type and (cut : Prelude.Basics.Bool) -> (vars : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: (cut : Prelude.Basics.Bool) -> (vars : Prelude.Types.Nat) -> Type and (cut : Prelude.Basics.Bool) -> (vars : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) False: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) False expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) False: (vars : Prelude.Types.Nat) -> Type and (vars : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) False expanded: (vars : Prelude.Types.Nat) -> Type and (vars : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) False: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) False expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) False: Type and Type
+LOG unify.equal:10: Begin unification (non-application) False expanded: Type and Type
 LOG declare.def.clause:3: RHS term: Term.Chk
-LOG declare.def:2: Case tree for Term.Typ: [0] Term.Chk
-LOG declare.def:3: Working from [0] Term.Chk
+LOG declare.def:2: Compile time tree for Term.Typ:
+  Term.Chk
+
+LOG declare.def:3: Working from Term.Chk
 LOG declare.def:3: Catch all case in Term.Typ
 LOG declare.def:3: Initially missing in Term.Typ:
 
 LOG declare.type:1: Processing Term.Term
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.def.lhs:3: LHS term: Term.Term
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG declare.def.clause:3: RHS term: (Term.Chk Prelude.Basics.True)
-LOG declare.def:2: Case tree for Term.Term: [0] (Term.Chk Prelude.Basics.True)
-LOG declare.def:3: Working from [0] (Term.Chk Prelude.Basics.True)
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: (vars : Prelude.Types.Nat) -> Type and ({arg:1} : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: (vars : Prelude.Types.Nat) -> Type and ({arg:1} : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) False: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) False expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) False: Type and Type
+LOG unify.equal:10: Begin unification (non-application) False expanded: Type and Type
+LOG declare.def.clause:3: RHS term: (Term.Chk (RigW, Prelude.Basics.True))
+LOG declare.def:2: Compile time tree for Term.Term:
+  (Term.Chk (RigW, Prelude.Basics.True))
+
+LOG declare.def:3: Working from (Term.Chk (RigW, Prelude.Basics.True))
 LOG declare.def:3: Catch all case in Term.Term
 LOG declare.def:3: Initially missing in Term.Term:
 
 LOG declare.type:1: Processing Term.NF
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True: Type and Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: Type and Type
 LOG declare.def.lhs:3: LHS term: Term.NF
-LOG unify.equal:10: Skipped unification (equal already): Type and Type
-LOG declare.def.clause:3: RHS term: (Term.Chk Prelude.Basics.False)
-LOG declare.def:2: Case tree for Term.NF: [0] (Term.Chk Prelude.Basics.False)
-LOG declare.def:3: Working from [0] (Term.Chk Prelude.Basics.False)
+LOG unify.equal:10: Begin unification (non-application) True: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True expanded: Prelude.Basics.Bool and Prelude.Basics.Bool
+LOG unify.equal:10: Begin unification (non-application) True: (vars : Prelude.Types.Nat) -> Type and ({arg:2} : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) True expanded: (vars : Prelude.Types.Nat) -> Type and ({arg:2} : Prelude.Types.Nat) -> Type
+LOG unify.equal:10: Begin unification (non-application) False: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) False expanded: Prelude.Types.Nat and Prelude.Types.Nat
+LOG unify.equal:10: Begin unification (non-application) False: Type and Type
+LOG unify.equal:10: Begin unification (non-application) False expanded: Type and Type
+LOG declare.def.clause:3: RHS term: (Term.Chk (RigW, Prelude.Basics.False))
+LOG declare.def:2: Compile time tree for Term.NF:
+  (Term.Chk (RigW, Prelude.Basics.False))
+
+LOG declare.def:3: Working from (Term.Chk (RigW, Prelude.Basics.False))
 LOG declare.def:3: Catch all case in Term.NF
 LOG declare.def:3: Initially missing in Term.NF:
 
 Term> Bye for now!
 1/1: Building Vec (Vec.idr)
 LOG declare.type:1: Processing Vec.Vec
-LOG declare.def:2: Case tree for Vec.Vec: [0] ({arg:1} : (Data.Fin.Fin {arg:2}[1])) -> {arg:3}[1]
+LOG declare.def:2: Compile time tree for Vec.Vec:
+  \({arg:1} : [__]) => \({arg:2} : [__]) => ({arg:3} : (Data.Fin.Fin (RigW, {arg:2}[0]))) -> {arg:1}[2]
+
 LOG declare.type:1: Processing Vec.Nil
-LOG declare.def:2: Case tree for Vec.Nil: [0] (Prelude.Uninhabited.absurd {arg:3}[0] (Data.Fin.Fin Prelude.Types.Z) Data.Fin.Uninhabited implementation at Data.Fin:1)
+LOG declare.def:2: Compile time tree for Vec.Nil:
+  \({arg:1} : [__]) => (Prelude.Uninhabited.absurd (Rig0, {arg:1}[0]) (Rig0, (Data.Fin.Fin (RigW, Prelude.Types.Z))) (RigW, Data.Fin.Uninhabited implementation at Data.Fin:1))
+
 LOG declare.type:1: Processing Vec.(::)
-LOG declare.def:2: Case tree for Vec.(::): case {arg:4}[4] : (Data.Fin.Fin (Prelude.Types.S {arg:3}[0])) of
- { Data.Fin.FZ {e:1} => [0] {arg:5}[3]
- | Data.Fin.FS {e:2} {e:3} => [1] ({arg:6}[5] {e:3}[1])
- }
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Data.Fin.Fin (RigW, (Prelude.Types.S (RigW, ?Vec.{_:1}_[]))))
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Data.Fin.Fin (RigW, (Prelude.Types.S (RigW, ?Vec.{_:2}_[]))))
+LOG declare.def:2: Compile time tree for Vec.(::):
+  \({arg:1} : [__]) => \({arg:2} : [__]) => \({arg:4} : [__]) => \({arg:5} : [__]) => \({arg:6} : [__]) => case RigW {arg:6}[0] : (Data.Fin.Fin (RigW, (Prelude.Types.S (RigW, {arg:1}[4])))) of [Data.Fin.FZ {e:1} => [(0, {arg:1}[5])] {arg:4}[3], Data.Fin.FS {e:2} {e:3} => [(1, {arg:1}[6])] ({arg:5}[3] (RigW, {e:3}[0]))]
+
 LOG declare.type:1: Processing Vec.test
 LOG elab.ambiguous:5: Ambiguous elaboration at Vec:1:
   ($resolved1 2)
   ($resolved2 2)
 With default. Target type : Prelude.Types.Nat
+LOG elab.ambiguous:5: checkAlternative exp_backtick: ({arg:3} : (Data.Fin.Fin (RigW, (Prelude.Types.S (RigW, (Prelude.Types.S (RigW, Prelude.Types.Z))))))) -> (Prelude.Basics.List (RigW, Prelude.Types.Nat))
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: ({arg:3} : (Data.Fin.Fin (RigW, (Prelude.Types.S (RigW, (Prelude.Types.S (RigW, Prelude.Types.Z))))))) -> (Prelude.Basics.List (RigW, Prelude.Types.Nat))
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 3 out of 3 candidates) (not delayed) at Vec:2:
 (($resolved3 Nil) ((:: ((:: (fromInteger 0)) Nil)) Nil))
 (($resolved4 Nil) ((:: ((:: (fromInteger 0)) Nil)) Nil))
 (($resolved5 Nil) ((:: ((:: (fromInteger 0)) Nil)) Nil))
-Target type : ({arg:1} : (Data.Fin.Fin (Prelude.Types.S (Prelude.Types.S Prelude.Types.Z)))) -> (Prelude.Basics.List Prelude.Types.Nat)
+Target type : ({arg:3} : (Data.Fin.Fin (RigW, (Prelude.Types.S (RigW, (Prelude.Types.S (RigW, Prelude.Types.Z))))))) -> (Prelude.Basics.List (RigW, Prelude.Types.Nat))
+LOG elab.ambiguous:5: checkAlternative exp_backtick: ?Vec.{a:1}_[]
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: ?Vec.{a:1}_[]
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 2 out of 2 candidates) (not delayed) at Vec:3:
 $resolved6
 $resolved7
 Target type : ?Vec.{a:1}_[]
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Vec.Vec (RigW, ?Vec.{a:1}_[]) (RigW, ?Vec.{n:1}_[]))
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: (Vec.Vec (RigW, ?Vec.{a:1}_[]) (RigW, ?Vec.{n:1}_[]))
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 3 out of 3 candidates) (not delayed) at Vec:4:
 (($resolved3 ((:: (fromInteger 0)) Nil)) Nil)
 (($resolved4 ((:: (fromInteger 0)) Nil)) Nil)
 (($resolved5 ((:: (fromInteger 0)) Nil)) Nil)
-Target type : (Vec.Vec ?Vec.{a:1}_[] ?Vec.{n:1}_[])
+Target type : (Vec.Vec (RigW, ?Vec.{a:1}_[]) (RigW, ?Vec.{n:1}_[]))
+LOG elab.ambiguous:5: checkAlternative exp_backtick: ?Vec.{a:2}_[]
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: ?Vec.{a:2}_[]
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 3 out of 3 candidates) (not delayed) at Vec:5:
 (($resolved3 (fromInteger 0)) Nil)
 (($resolved4 (fromInteger 0)) Nil)
@@ -132,27 +352,38 @@ LOG elab.ambiguous:5: Ambiguous elaboration at Vec:6:
   ($resolved1 0)
   ($resolved2 0)
 With default. Target type : ?Vec.{a:3}_[]
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Vec.Vec (RigW, ?Vec.{a:3}_[]) (RigW, ?Vec.{n:2}_[]))
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: (Vec.Vec (RigW, ?Vec.{a:3}_[]) (RigW, ?Vec.{n:2}_[]))
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 2 out of 2 candidates) (not delayed) at Vec:7:
 $resolved6
 $resolved7
-Target type : (Vec.Vec ?Vec.{a:3}_[] ?Vec.{n:2}_[])
+Target type : (Vec.Vec (RigW, ?Vec.{a:3}_[]) (RigW, ?Vec.{n:2}_[]))
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Prelude.Basics.List (RigW, ?Vec.{a:4}_[]))
 LOG elab.ambiguous:5: Ambiguous elaboration at Vec:6:
   ($resolved1 0)
   ($resolved2 0)
 With default. Target type : ?Vec.{a:4}_[]
+LOG elab.ambiguous:5: checkAlternative exp_backtick: %Delayed (Prelude.Types.Stream.Stream (RigW, ?Vec.{a:4}_[]))
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Vec.Vec (RigW, ?Vec.{a:2}_[]) (RigW, ?Vec.{n:3}_[]))
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: (Vec.Vec (RigW, ?Vec.{a:2}_[]) (RigW, ?Vec.{n:3}_[]))
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 2 out of 2 candidates) (not delayed) at Vec:8:
 $resolved6
 $resolved7
-Target type : (Vec.Vec ?Vec.{a:2}_[] ?Vec.{n:3}_[])
+Target type : (Vec.Vec (RigW, ?Vec.{a:2}_[]) (RigW, ?Vec.{n:3}_[]))
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: (Prelude.Basics.List (RigW, Prelude.Types.Nat))
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 1 out of 3 candidates) (delayed) at Vec:5:
 (($resolved4 (fromInteger 0)) Nil)
-Target type : (Prelude.Basics.List Prelude.Types.Nat)
+Target type : (Prelude.Basics.List (RigW, Prelude.Types.Nat))
+LOG elab.ambiguous:5: checkAlternative exp_backtick: (Prelude.Basics.List (RigW, Prelude.Types.Nat))
 LOG elab.ambiguous:5: Ambiguous elaboration at Vec:6:
   ($resolved1 0)
   ($resolved2 0)
 With default. Target type : Prelude.Types.Nat
+LOG elab.ambiguous:5: checkAlternative delayOnFailure exp_backtick: (Prelude.Basics.List (RigW, Prelude.Types.Nat))
 LOG elab.ambiguous:5: Ambiguous elaboration (kept 1 out of 2 candidates) (delayed) at Vec:3:
 $resolved7
-Target type : (Prelude.Basics.List Prelude.Types.Nat)
-LOG declare.def:2: Case tree for Vec.test: [0] (Vec.(::) (Prelude.Types.S Prelude.Types.Z) (Prelude.Basics.List Prelude.Types.Nat) (Prelude.Basics.Nil Prelude.Types.Nat) (Vec.(::) Prelude.Types.Z (Prelude.Basics.List Prelude.Types.Nat) (Prelude.Basics.(::) Prelude.Types.Nat Prelude.Types.Z (Prelude.Basics.Nil Prelude.Types.Nat)) (Vec.Nil (Prelude.Basics.List Prelude.Types.Nat))))
+Target type : (Prelude.Basics.List (RigW, Prelude.Types.Nat))
+LOG declare.def:2: Compile time tree for Vec.test:
+  (Vec.(::) (Rig0, (Prelude.Types.S (RigW, Prelude.Types.Z))) (Rig0, (Prelude.Basics.List (RigW, Prelude.Types.Nat))) (RigW, (Prelude.Basics.Nil (Rig0, Prelude.Types.Nat))) (RigW, (Vec.(::) (Rig0, Prelude.Types.Z) (Rig0, (Prelude.Basics.List (RigW, Prelude.Types.Nat))) (RigW, (Prelude.Basics.(::) (Rig0, Prelude.Types.Nat) (RigW, Prelude.Types.Z) (RigW, (Prelude.Basics.Nil (Rig0, Prelude.Types.Nat))))) (RigW, (Vec.Nil (Rig0, (Prelude.Basics.List (RigW, Prelude.Types.Nat))))))))
+
 Vec> Bye for now!
diff --git a/tests/idris2/basic/basic064/expected b/tests/idris2/basic/basic064/expected
index 0b8726d7669..c3f400c486e 100644
--- a/tests/idris2/basic/basic064/expected
+++ b/tests/idris2/basic/basic064/expected
@@ -1,6 +1,6 @@
 1/1: Building Issue2072 (Issue2072.idr)
 Main> 2 holes:
   Main.Types : (0 a : Type) -> Eq a => List Type
-  Main.body : {auto 0 conArg : Eq t1} -> {auto 0 _ : Elem Bool (Types t1)} -> (obj : t1) -> obj == obj = maybe (Delay True) (Delay (const False)) (if obj == obj then pure (let x = True in ()) else empty)
+  Main.body : {auto 0 conArg : Eq t1} -> {auto 0 _ : Elem Bool (Types t1)} -> (obj : t1) -> obj == obj = maybe (Delay True) (Delay (const False)) (if obj == obj then pure () else empty)
 Main> 
 Bye for now!
diff --git a/tests/idris2/casetree/casetree005/HeadEq.idr b/tests/idris2/casetree/casetree005/HeadEq.idr
new file mode 100644
index 00000000000..40abbf88403
--- /dev/null
+++ b/tests/idris2/casetree/casetree005/HeadEq.idr
@@ -0,0 +1,20 @@
+data D : Type where
+  MkD : (DPair (Pair Unit Unit) (const Bool) -> Type) -> D
+
+shape : D -> Type
+shape (MkD _) = DPair (Pair Unit Unit) (const Bool)
+
+position : (c : D) -> shape c -> Type
+position (MkD p) s = p s
+
+data Extension : (c : D) -> Type where
+  MkExtension : (s : shape c) -> (payloads : position c s -> Unit) -> Extension c
+
+Derivative : D
+Derivative = MkD $ \(MkDPair s p) => (the (_ -> Type) (\(u1, u2) => Bool)) s
+
+toPairSimple : Extension Derivative
+toPairSimple =
+    MkExtension (MkDPair ((), ()) True) $ \case
+      True  => MkUnit
+      False => MkUnit
diff --git a/tests/idris2/casetree/casetree005/expected b/tests/idris2/casetree/casetree005/expected
new file mode 100644
index 00000000000..04da06156ba
--- /dev/null
+++ b/tests/idris2/casetree/casetree005/expected
@@ -0,0 +1 @@
+1/1: Building HeadEq (HeadEq.idr)
diff --git a/tests/idris2/casetree/casetree005/run b/tests/idris2/casetree/casetree005/run
new file mode 100755
index 00000000000..9aa431a176d
--- /dev/null
+++ b/tests/idris2/casetree/casetree005/run
@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+check HeadEq.idr
diff --git a/tests/idris2/data/record019/expected b/tests/idris2/data/record019/expected
index 73808c60e6e..110655fdfa1 100644
--- a/tests/idris2/data/record019/expected
+++ b/tests/idris2/data/record019/expected
@@ -11,7 +11,7 @@ LOG declare.record.parameters:50: Decided to bind the following extra parameters
   {0 ys : ((Main.Vect a) n)}
 
 LOG declare.record.parameters:60: We elaborated Main.EtaProof in a non-empty local context.
-  Dropped: [b, a]
-  Remaining type: (p : (Main.Product a[1] b[0])) -> Type
+  Dropped: [< a, b]
+  Remaining type: (p : (Main.Product (RigW, a[1]) (RigW, b[0]))) -> Type
 
 LOG declare.record.parameters:30: Unelaborated type: (%pi RigW Explicit (Just p) Main.Product %type)
diff --git a/tests/idris2/evaluator/evaluator002/expected b/tests/idris2/evaluator/evaluator002/expected
index 25f61dd2e64..a0ef0d0798a 100644
--- a/tests/idris2/evaluator/evaluator002/expected
+++ b/tests/idris2/evaluator/evaluator002/expected
@@ -1,94 +1,37 @@
 1/2: Building Lib (Lib.idr)
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:1}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:1}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:1}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:1}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:1}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:2}
-LOG eval.stuck.outofscope:5: Stuck function: {_:3}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:3}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:3}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:3}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:3}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:3}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:5}
-LOG eval.stuck.outofscope:5: Stuck function: {_:6}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{b:1}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:4}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:5}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:5}
-LOG eval.stuck.outofscope:5: Stuck function: Prelude.Types.List.reverse
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:7}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{_:8}
-LOG eval.stuck.outofscope:5: Stuck function: {_:9}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{b:2}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:6}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:6}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:6}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:7}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.{a:7}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.accMapAux
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {e:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {e:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {e:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: {arg:1}
+LOG eval.stuck.outofscope:5: Stuck function: a
+LOG eval.stuck.outofscope:5: Stuck function: a
+LOG eval.stuck.outofscope:5: Stuck function: b
+LOG eval.stuck.outofscope:5: Stuck function: a
+LOG eval.stuck.outofscope:5: Stuck function: a
+LOG eval.stuck.outofscope:5: Stuck function: b
+LOG eval.stuck.outofscope:5: Stuck function: b
+LOG eval.stuck.outofscope:5: Stuck function: a
+LOG eval.stuck.outofscope:5: Stuck function: a
+LOG eval.stuck.outofscope:5: Stuck function: b
+LOG eval.stuck.outofscope:5: Stuck function: b
 2/2: Building Main (Main.idr)
-LOG eval.stuck.outofscope:5: Stuck function: Main.{b:3}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{b:3}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{b:3}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:9}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:9}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:9}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:10}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:10}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:10}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:11}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:11}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:12}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:11}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:11}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{ty:1}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{ty:1}
-LOG eval.stuck.outofscope:5: Stuck function: Main.{a:8}
-LOG eval.stuck.outofscope:5: Stuck function: Lib.accMap
-Main> LOG eval.stuck:5: Stuck function: Lib.accMapAux
-LOG eval.stuck:5: Stuck function: Lib.accMapAux
-LOG eval.stuck:5: Stuck function: Lib.accMapAux
-LOG eval.stuck:5: Stuck function: Lib.accMapAux
-[2, 3, 4]
-Main> 
+Main> [2, 3, 4]
+Main>
 Bye for now!
diff --git a/tests/idris2/evaluator/expand001/M0.idr b/tests/idris2/evaluator/expand001/M0.idr
new file mode 100644
index 00000000000..b31f4c2da48
--- /dev/null
+++ b/tests/idris2/evaluator/expand001/M0.idr
@@ -0,0 +1,55 @@
+namespace XX
+    export
+    g : Nat -> Nat
+    g = S . S
+
+    export
+    H : Nat
+    H = Z
+
+-- InTerm
+w : Equal H Z
+failing "Can't solve constraint"
+    w = Refl
+
+f : Nat -> Nat
+f = S
+
+u : Equal (f (f Z)) (g Z)
+failing "Can't solve constraint"
+    u = Refl
+
+data H2 : (a : Nat) -> Type where
+    MkH2 : a -> H2 Z
+
+-- InLHS
+hh : H2 H -> Nat
+failing "Can't solve constraint"
+  hh (MkH2 _) = Z
+
+-- InMatch
+test : Nat -> Nat
+failing "Can't match on H"
+    test x = case x of
+        H => 0
+        _ => 1
+
+data FN : a -> Type where
+    MkFN : (0 a : _) -> FN a
+
+namespace XX2
+    export
+    FN2 : (a: _) -> FN a
+    FN2 a = MkFN a
+
+    export
+    0 FN3 : (0 a: _) -> FN a
+    FN3 a = MkFN a
+
+w2 : Equal (FN2 Z) (MkFN Z)
+failing "Can't solve constraint"
+    w2 = Refl
+
+w3 : Equal (FN3 Z) (MkFN Z)
+failing "Can't solve constraint"
+    w3 = Refl
diff --git a/tests/idris2/evaluator/expand001/expected b/tests/idris2/evaluator/expand001/expected
new file mode 100644
index 00000000000..532c485f143
--- /dev/null
+++ b/tests/idris2/evaluator/expand001/expected
@@ -0,0 +1 @@
+1/1: Building M0 (M0.idr)
diff --git a/tests/idris2/schemeeval/schemeeval001/run b/tests/idris2/evaluator/expand001/run
similarity index 62%
rename from tests/idris2/schemeeval/schemeeval001/run
rename to tests/idris2/evaluator/expand001/run
index 404d7d47c63..be1a7187765 100755
--- a/tests/idris2/schemeeval/schemeeval001/run
+++ b/tests/idris2/evaluator/expand001/run
@@ -1,3 +1,3 @@
 . ../../../testutils.sh
 
-idris2 < input
+check M0.idr
diff --git a/tests/idris2/evaluator/expand002/M0.idr b/tests/idris2/evaluator/expand002/M0.idr
new file mode 100644
index 00000000000..f58582ad593
--- /dev/null
+++ b/tests/idris2/evaluator/expand002/M0.idr
@@ -0,0 +1,24 @@
+module M0
+
+public export
+interface I t where
+  foo : (x1 : t) -> Unit
+
+public export
+[FromLabelFoo] I a where
+    foo _ = MkUnit
+
+public export
+I Unit where
+    foo = foo @{FromLabelFoo}
+
+export
+Unit' : Type
+Unit' = Unit
+
+UNIT : I Unit
+UNIT = %search
+
+export
+I Unit' where
+  foo = foo @{UNIT}
diff --git a/tests/idris2/evaluator/expand002/M1.idr b/tests/idris2/evaluator/expand002/M1.idr
new file mode 100644
index 00000000000..3df49d3e7cd
--- /dev/null
+++ b/tests/idris2/evaluator/expand002/M1.idr
@@ -0,0 +1,3 @@
+import M0
+
+aaa : Equal (foo @{%search} MkUnit) MkUnit
diff --git a/tests/idris2/evaluator/expand002/expected b/tests/idris2/evaluator/expand002/expected
new file mode 100644
index 00000000000..991213131ef
--- /dev/null
+++ b/tests/idris2/evaluator/expand002/expected
@@ -0,0 +1,2 @@
+1/2: Building M0 (M0.idr)
+2/2: Building M1 (M1.idr)
diff --git a/tests/idris2/schemeeval/schemeeval002/run b/tests/idris2/evaluator/expand002/run
similarity index 62%
rename from tests/idris2/schemeeval/schemeeval002/run
rename to tests/idris2/evaluator/expand002/run
index 404d7d47c63..cfee40d56aa 100755
--- a/tests/idris2/schemeeval/schemeeval002/run
+++ b/tests/idris2/evaluator/expand002/run
@@ -1,3 +1,3 @@
 . ../../../testutils.sh
 
-idris2 < input
+check M1.idr
diff --git a/tests/idris2/evaluator/expand003/M0.idr b/tests/idris2/evaluator/expand003/M0.idr
new file mode 100644
index 00000000000..359324eb1f5
--- /dev/null
+++ b/tests/idris2/evaluator/expand003/M0.idr
@@ -0,0 +1,21 @@
+data MyUnit : Type
+
+interface I a where
+  foo : a
+
+I MyUnit
+-- I Main.MyUnit
+-- TODO: https://github.com/idris-lang/Idris2/issues/3601
+
+namespace X
+  export
+  T : Type
+  T = MyUnit
+
+  export
+  I T
+
+  failing "Multiple solutions found in search"
+    x' = foo {a=MyUnit}
+
+x = foo {a=MyUnit}
diff --git a/tests/idris2/evaluator/expand003/expected b/tests/idris2/evaluator/expand003/expected
new file mode 100644
index 00000000000..532c485f143
--- /dev/null
+++ b/tests/idris2/evaluator/expand003/expected
@@ -0,0 +1 @@
+1/1: Building M0 (M0.idr)
diff --git a/tests/idris2/schemeeval/schemeeval003/run b/tests/idris2/evaluator/expand003/run
similarity index 62%
rename from tests/idris2/schemeeval/schemeeval003/run
rename to tests/idris2/evaluator/expand003/run
index 404d7d47c63..be1a7187765 100755
--- a/tests/idris2/schemeeval/schemeeval003/run
+++ b/tests/idris2/evaluator/expand003/run
@@ -1,3 +1,3 @@
 . ../../../testutils.sh
 
-idris2 < input
+check M0.idr
diff --git a/tests/idris2/evaluator/expand004/M0.idr b/tests/idris2/evaluator/expand004/M0.idr
new file mode 100644
index 00000000000..4a3b88fe9b1
--- /dev/null
+++ b/tests/idris2/evaluator/expand004/M0.idr
@@ -0,0 +1,20 @@
+module M0
+
+public export
+interface DecEq t where
+  decEq : (x1 : t) -> (x2 : t) -> Dec (x1 = x2)
+
+public export
+[FromEq] Eq a => DecEq a where
+    decEq x y = case x == y of
+                     True => Yes primitiveEq
+                     False => No primitiveNotEq
+       where primitiveEq : forall x, y . x = y
+             primitiveEq = believe_me (Refl {x})
+             primitiveNotEq : forall x, y . Not (x = y)
+             primitiveNotEq prf = believe_me {b = Void} ()
+
+public export
+DecEq String where
+    decEq = decEq @{FromEq}
+
diff --git a/tests/idris2/evaluator/expand004/M1.idr b/tests/idris2/evaluator/expand004/M1.idr
new file mode 100644
index 00000000000..89ab1a22336
--- /dev/null
+++ b/tests/idris2/evaluator/expand004/M1.idr
@@ -0,0 +1,19 @@
+module M1
+
+import M0
+
+export
+Name : Type
+Name = String
+
+export
+FromString Name where
+  fromString = id
+
+export
+STRING : DecEq String
+STRING = %search
+
+export
+DecEq Name where
+  decEq = decEq @{STRING}
diff --git a/tests/idris2/evaluator/expand004/M2.idr b/tests/idris2/evaluator/expand004/M2.idr
new file mode 100644
index 00000000000..edddffa7699
--- /dev/null
+++ b/tests/idris2/evaluator/expand004/M2.idr
@@ -0,0 +1,14 @@
+import M0
+import M1
+
+public export
+Scoped : Type
+Scoped = List Name -> SnocList Name -> Type
+
+data A2bs : Scoped -> Scoped where
+  Mk2Abs : (x : Name) -> t f (g :< x) -> A2bs t f g
+
+partial
+Eq (A2bs t f g) where
+  Mk2Abs  x@_ b == Mk2Abs x' b' with (decEq x x')
+    _ | _ = False
diff --git a/tests/idris2/evaluator/expand004/expected b/tests/idris2/evaluator/expand004/expected
new file mode 100644
index 00000000000..d89dd55a056
--- /dev/null
+++ b/tests/idris2/evaluator/expand004/expected
@@ -0,0 +1,3 @@
+1/3: Building M0 (M0.idr)
+2/3: Building M1 (M1.idr)
+3/3: Building M2 (M2.idr)
diff --git a/tests/idris2/schemeeval/schemeeval006/run b/tests/idris2/evaluator/expand004/run
old mode 100644
new mode 100755
similarity index 62%
rename from tests/idris2/schemeeval/schemeeval006/run
rename to tests/idris2/evaluator/expand004/run
index 404d7d47c63..8cf49edcb00
--- a/tests/idris2/schemeeval/schemeeval006/run
+++ b/tests/idris2/evaluator/expand004/run
@@ -1,3 +1,3 @@
 . ../../../testutils.sh
 
-idris2 < input
+check M2.idr
diff --git a/tests/idris2/evaluator/quote001/M0.idr b/tests/idris2/evaluator/quote001/M0.idr
new file mode 100644
index 00000000000..f58582ad593
--- /dev/null
+++ b/tests/idris2/evaluator/quote001/M0.idr
@@ -0,0 +1,24 @@
+module M0
+
+public export
+interface I t where
+  foo : (x1 : t) -> Unit
+
+public export
+[FromLabelFoo] I a where
+    foo _ = MkUnit
+
+public export
+I Unit where
+    foo = foo @{FromLabelFoo}
+
+export
+Unit' : Type
+Unit' = Unit
+
+UNIT : I Unit
+UNIT = %search
+
+export
+I Unit' where
+  foo = foo @{UNIT}
diff --git a/tests/idris2/evaluator/quote001/M1.idr b/tests/idris2/evaluator/quote001/M1.idr
new file mode 100644
index 00000000000..42e7b7ce71b
--- /dev/null
+++ b/tests/idris2/evaluator/quote001/M1.idr
@@ -0,0 +1,7 @@
+import M0
+
+data Abs2 : List Unit' -> Type where
+evalCheck : Abs2 f
+
+evalAbs : (f : List Unit') -> (ext : List Unit') -> Abs2 (ext ++ f)
+evalAbs f = \ ext => evalCheck {f = ext ++ f}
diff --git a/tests/idris2/evaluator/quote001/expected b/tests/idris2/evaluator/quote001/expected
new file mode 100644
index 00000000000..991213131ef
--- /dev/null
+++ b/tests/idris2/evaluator/quote001/expected
@@ -0,0 +1,2 @@
+1/2: Building M0 (M0.idr)
+2/2: Building M1 (M1.idr)
diff --git a/tests/idris2/evaluator/quote001/run b/tests/idris2/evaluator/quote001/run
new file mode 100755
index 00000000000..cfee40d56aa
--- /dev/null
+++ b/tests/idris2/evaluator/quote001/run
@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+check M1.idr
diff --git a/tests/idris2/evaluator/spec001/expected b/tests/idris2/evaluator/spec001/expected
index 1152f560510..d0761e5e8d8 100644
--- a/tests/idris2/evaluator/spec001/expected
+++ b/tests/idris2/evaluator/spec001/expected
@@ -56,30 +56,30 @@ LOG specialise:5: New patterns for _PE.PE_identity_1:
 (_PE.PE_identity_1 (Prelude.Basics.Nil [a = Prelude.Types.Nat])) = (Prelude.Basics.Nil [a = Prelude.Types.Nat])
 (_PE.PE_identity_1 (((Prelude.Basics.(::) [a = Prelude.Types.Nat]) x) xs)) = (((Prelude.Basics.(::) [a = Prelude.Types.Nat]) x) ((Main.identity [a = Prelude.Types.Nat]) xs))
 LOG specialise:5: New RHS: (Prelude.Basics.Nil Prelude.Types.Nat)
-LOG specialise:5: Already specialised _PE.PE_identity_1
-LOG specialise:5: New RHS: (Prelude.Basics.(::) Prelude.Types.Nat x[1] (_PE.PE_identity_1 xs[0]))
-LOG specialise:5: Already specialised _PE.PE_identity_1
-LOG compiler.identity:5: found identity flag for: _PE.PE_identity_1, 0
-	old def: Just [{arg:2}]: (%case !{arg:2} [(%concase [nil] _builtin.NIL Just 0 [] (%con [nil] _builtin.NIL Just 0 [])), (%concase [cons] _builtin.CONS Just 1 [{e:1}, {e:2}] (%con [cons] _builtin.CONS Just 1 [!{e:1}, (_PE.PE_identity_1 [!{e:2}])]))] Nothing)
-LOG compiler.identity:5: 	new def: [{arg:2}]: !{arg:2}
+LOG specialise:5: Already specialised _PE.PE_identity_3c7f5598e5c9b732
+LOG specialise:5: New RHS: (Prelude.Basics.(::) Prelude.Types.Nat x[1] (_PE.PE_identity_3c7f5598e5c9b732 xs[0]))
+LOG specialise:5: Already specialised _PE.PE_identity_3c7f5598e5c9b732
+LOG compiler.identity:5: found identity flag for: _PE.PE_identity_3c7f5598e5c9b732, 0
+	old def: Just [< {arg:11}]: (%case con !{arg:11} [(%concase [nil] _builtin.NIL Just 0 [] (%con [nil] _builtin.NIL Just 0 [])), (%concase [cons] _builtin.CONS Just 1 [{e:2}, {e:3}] (%con [cons] _builtin.CONS Just 1 [!{e:2}, (_PE.PE_identity_3c7f5598e5c9b732 [!{e:3}])]))] Nothing)
+LOG compiler.identity:5: 	new def: [< {arg:11}]: !{arg:11}
 LOG compiler.identity:5: found identity flag for: Main.identity, 0
-	old def: Just [{arg:3}]: (%case !{arg:3} [(%concase [nil] _builtin.NIL Just 0 [] (%con [nil] _builtin.NIL Just 0 [])), (%concase [cons] _builtin.CONS Just 1 [{e:1}, {e:2}] (%con [cons] _builtin.CONS Just 1 [!{e:1}, (Main.identity [!{e:2}])]))] Nothing)
-LOG compiler.identity:5: 	new def: [{arg:3}]: !{arg:3}
-LOG compiler.identity:5: found identity flag for: _PE.PE_identity_1, 0
-	old def: Just [{arg:2}]: !{arg:2}
-LOG compiler.identity:5: 	new def: [{arg:2}]: !{arg:2}
+	old def: Just [< {arg:12}]: (%case con !{arg:12} [(%concase [nil] _builtin.NIL Just 0 [] (%con [nil] _builtin.NIL Just 0 [])), (%concase [cons] _builtin.CONS Just 1 [{e:2}, {e:3}] (%con [cons] _builtin.CONS Just 1 [!{e:2}, (Main.identity [!{e:3}])]))] Nothing)
+LOG compiler.identity:5: 	new def: [< {arg:12}]: !{arg:12}
+LOG compiler.identity:5: found identity flag for: _PE.PE_identity_3c7f5598e5c9b732, 0
+	old def: Just [< {arg:11}]: !{arg:11}
+LOG compiler.identity:5: 	new def: [< {arg:11}]: !{arg:11}
 LOG compiler.identity:5: found identity flag for: Main.identity, 0
-	old def: Just [{arg:3}]: !{arg:3}
-LOG compiler.identity:5: 	new def: [{arg:3}]: !{arg:3}
+	old def: Just [< {arg:3}]: !{arg:3}
+LOG compiler.identity:5: 	new def: [< {arg:3}]: !{arg:3}
 LOG compiler.identity:5: found identity flag for: Main.test, 0
-	old def: Just [{arg:2}]: !{arg:2}
-LOG compiler.identity:5: 	new def: [{arg:2}]: !{arg:2}
+	old def: Just [< {arg:2}]: !{arg:2}
+LOG compiler.identity:5: 	new def: [< {arg:2}]: !{arg:2}
 LOG compiler.identity:5: found identity flag for: _PE.PE_identity_1, 0
-	old def: Just [{arg:2}]: !{arg:2}
-LOG compiler.identity:5: 	new def: [{arg:2}]: !{arg:2}
+	old def: Just [< {arg:2}]: !{arg:2}
+LOG compiler.identity:5: 	new def: [< {arg:2}]: !{arg:2}
 LOG compiler.identity:5: found identity flag for: Main.identity, 0
-	old def: Just [{arg:3}]: !{arg:3}
-LOG compiler.identity:5: 	new def: [{arg:3}]: !{arg:3}
+	old def: Just [< {arg:3}]: !{arg:3}
+LOG compiler.identity:5: 	new def: [< {arg:3}]: !{arg:3}
 LOG compiler.identity:5: found identity flag for: Main.test, 0
-	old def: Just [{arg:2}]: !{arg:2}
-LOG compiler.identity:5: 	new def: [{arg:2}]: !{arg:2}
+	old def: Just [< {arg:2}]: !{arg:2}
+LOG compiler.identity:5: 	new def: [< {arg:2}]: !{arg:2}
diff --git a/tests/idris2/misc/delayed001/MinimalSampleUnsolvedHoles.idr b/tests/idris2/misc/delayed001/MinimalSampleUnsolvedHoles.idr
new file mode 100644
index 00000000000..f02ddbaa03d
--- /dev/null
+++ b/tests/idris2/misc/delayed001/MinimalSampleUnsolvedHoles.idr
@@ -0,0 +1,25 @@
+%default total
+
+data E : Type -> Type -> Type where
+  L : a -> E a b
+
+data X : Type where
+  MkX : (DPair Unit (\MkUnit => E Unit Nat) -> Type) -> X
+
+getShape : (c : X) -> Type
+getShape (MkX _) = DPair Unit (\MkUnit => E Unit Nat)
+
+getPayloads : (c : X) -> getShape c -> Type
+getPayloads (MkX p) = p
+
+data Extension : (c : X) -> Type where
+  MkExtension :
+    (shape : getShape c) ->
+    (payloads : getPayloads c shape -> Unit) ->
+    Extension c
+
+Derivative : X
+Derivative = MkX (\(MkDPair MkUnit _) => E Unit Nat)
+
+toPairSimple : Extension Derivative
+toPairSimple = MkExtension (MkDPair () (L MkUnit)) $ \(L a) => a
diff --git a/tests/idris2/misc/delayed001/expected b/tests/idris2/misc/delayed001/expected
new file mode 100644
index 00000000000..5106760143f
--- /dev/null
+++ b/tests/idris2/misc/delayed001/expected
@@ -0,0 +1 @@
+1/1: Building MinimalSampleUnsolvedHoles (MinimalSampleUnsolvedHoles.idr)
diff --git a/tests/idris2/misc/delayed001/run b/tests/idris2/misc/delayed001/run
new file mode 100755
index 00000000000..33dae6ea970
--- /dev/null
+++ b/tests/idris2/misc/delayed001/run
@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+check MinimalSampleUnsolvedHoles.idr
diff --git a/tests/idris2/misc/golden001/expected b/tests/idris2/misc/golden001/expected
index f4feb63db0a..2539f2e8c87 100644
--- a/tests/idris2/misc/golden001/expected
+++ b/tests/idris2/misc/golden001/expected
@@ -7,5 +7,6 @@ Now compiling the executable: runtests
 Hello World
 ------------------------------------------------------------------------
 
+Running 000-hello
 000-hello: success
 1/1 tests successful
diff --git a/tests/idris2/misc/inlining001/expected b/tests/idris2/misc/inlining001/expected
index 6906d577892..5676dfca9ae 100644
--- a/tests/idris2/misc/inlining001/expected
+++ b/tests/idris2/misc/inlining001/expected
@@ -1,8 +1,7 @@
 1/1: Building Inlining (Inlining.idr)
 Main> Main.leaveAlone
-Arguments [{arg:1}]
-Compile time tree: {arg:1} ++ "!"
-Compiled: \ {arg:1} => {arg:1} ++ "!"
+Compile time tree: \{arg:0} => {arg:0} ++ "!"
+Compiled: \ {arg:0} => {arg:0} ++ "!"
 Refers to: Prelude.Types.String.(++)
 Flags: covering
 Size change:
@@ -11,10 +10,9 @@ Size change:
   r +--
   0 | =
 Main> Main.forceInline
-Arguments [{arg:1}]
-Compile time tree: {arg:1} + 10
-Compiled: \ {arg:1} => {arg:1} + 10
-Refers to: Prelude.Types.Num implementation at Prelude.Types:1, Prelude.Types.Z, Prelude.Types.S, Prelude.Types.Nat, Prelude.Num.(+)
+Compile time tree: \{arg:0} => {arg:0} + 10
+Compiled: \ {arg:0} => {arg:0} + 10
+Refers to: Prelude.Types.Num implementation at Prelude.Types:66:1--71:33, Prelude.Types.Z, Prelude.Types.S, Prelude.Types.Nat, Prelude.Num.(+)
 Flags: covering, inline
 Size change:
   Prelude.Num.(+):
@@ -38,7 +36,6 @@ Size change:
     l
   r +
 Main> Main.heuristicPublicInline
-Arguments []
 Compile time tree: 2
 Compiled: 2
 Refers to: Prelude.Types.Z, Prelude.Types.S
@@ -51,7 +48,6 @@ Size change:
     l
   r +
 Main> Main.exportedForced
-Arguments []
 Compile time tree: 33
 Compiled: 33
 Refers to: Prelude.Types.Z, Prelude.Types.S
@@ -64,7 +60,6 @@ Size change:
     l
   r +
 Main> Main.exportedUnforced
-Arguments []
 Compile time tree: 66
 Compiled: 66
 Refers to: Prelude.Types.Z, Prelude.Types.S
diff --git a/tests/idris2/misc/unification002/KrivineSmall.idr b/tests/idris2/misc/unification002/KrivineSmall.idr
new file mode 100644
index 00000000000..dcd562c1fa0
--- /dev/null
+++ b/tests/idris2/misc/unification002/KrivineSmall.idr
@@ -0,0 +1,14 @@
+data WrapUnit : Unit -> Type where
+  MkWrapUnit : WrapUnit MkUnit -> WrapUnit MkUnit
+
+extractUnit : (t : Unit) -> (WrapUnit t) -> Type
+extractUnit MkUnit (MkWrapUnit tr) = extractUnit MkUnit tr
+
+U : Unit
+isUnit : Builtin.Equal U MkUnit
+
+wrappedUnitIsUnit : (x: Unit) ->
+              (trace : WrapUnit x) ->
+              extractUnit x trace
+wrappedUnitIsUnit MkUnit (MkWrapUnit trace)
+  = wrappedUnitIsUnit U $ rewrite isUnit in trace
diff --git a/tests/idris2/misc/unification002/expected b/tests/idris2/misc/unification002/expected
new file mode 100644
index 00000000000..aeeb1b66a07
--- /dev/null
+++ b/tests/idris2/misc/unification002/expected
@@ -0,0 +1 @@
+1/1: Building KrivineSmall (KrivineSmall.idr)
diff --git a/tests/idris2/misc/unification002/run b/tests/idris2/misc/unification002/run
new file mode 100755
index 00000000000..bf492cd052d
--- /dev/null
+++ b/tests/idris2/misc/unification002/run
@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+check KrivineSmall.idr
diff --git a/tests/idris2/misc/unification003/KrivineSmall.idr b/tests/idris2/misc/unification003/KrivineSmall.idr
new file mode 100644
index 00000000000..d1061c46b79
--- /dev/null
+++ b/tests/idris2/misc/unification003/KrivineSmall.idr
@@ -0,0 +1,21 @@
+public export
+data EvalContext : Unit -> Type where
+  MkEvalContext : EvalContext MkUnit -> EvalContext MkUnit
+
+public export
+data Machine : EvalContext MkUnit -> Type where
+  Beta : (beta_ctx: EvalContext MkUnit) -> Machine (MkEvalContext beta_ctx)
+
+extract : EvalContext MkUnit -> Unit
+-- extract extract_ctx = MkUnit -- no issue
+extract (MkEvalContext extract_ctx) = MkUnit
+
+public export
+correctness :
+  (correctness_ctx : EvalContext MkUnit) ->
+  EvalContext (extract correctness_ctx) ->
+  Machine correctness_ctx ->
+  Unit
+
+correctness .(MkEvalContext eval_ctx) (MkEvalContext eval_ctx_2) (Beta eval_ctx)
+  = correctness (believe_me ()) (believe_me ()) (believe_me ())
diff --git a/tests/idris2/misc/unification003/expected b/tests/idris2/misc/unification003/expected
new file mode 100644
index 00000000000..aeeb1b66a07
--- /dev/null
+++ b/tests/idris2/misc/unification003/expected
@@ -0,0 +1 @@
+1/1: Building KrivineSmall (KrivineSmall.idr)
diff --git a/tests/idris2/misc/unification003/run b/tests/idris2/misc/unification003/run
new file mode 100755
index 00000000000..bf492cd052d
--- /dev/null
+++ b/tests/idris2/misc/unification003/run
@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+check KrivineSmall.idr
diff --git a/tests/idris2/misc/unification004/Bad.idr b/tests/idris2/misc/unification004/Bad.idr
new file mode 100644
index 00000000000..575b052759f
--- /dev/null
+++ b/tests/idris2/misc/unification004/Bad.idr
@@ -0,0 +1,11 @@
+U : Unit
+
+W = MkUnit
+
+data View : Unit -> Type where
+  X : View W
+  Y : View U
+
+foo : (v : Unit) -> View v -> Unit
+foo a X = MkUnit
+foo U Y = MkUnit
diff --git a/tests/idris2/misc/unification004/Good.idr b/tests/idris2/misc/unification004/Good.idr
new file mode 100644
index 00000000000..fbe43bb4fcd
--- /dev/null
+++ b/tests/idris2/misc/unification004/Good.idr
@@ -0,0 +1,15 @@
+U : Unit
+
+W = MkUnit
+
+data View : Unit -> Type where
+  X : View W
+  Y : View U
+
+foo : (v : Unit) -> View v -> Unit
+foo a@_ X = MkUnit
+foo U Y = MkUnit
+
+foo2 : (v : Unit) -> View v -> Unit
+foo2 _ X = MkUnit
+foo2 U Y = MkUnit
diff --git a/tests/idris2/misc/unification004/expected b/tests/idris2/misc/unification004/expected
new file mode 100644
index 00000000000..9f7b6d5b00f
--- /dev/null
+++ b/tests/idris2/misc/unification004/expected
@@ -0,0 +1,17 @@
+1/1: Building Good (Good.idr)
+1/1: Building Bad (Bad.idr)
+Error: While processing left hand side of foo. When unifying:
+    View W
+and:
+    View ?a
+Pattern variable a unifies with: W.
+
+Bad:6:12--10:8
+    |
+ 6 |   X : View W
+   |            ^
+ 07 |   Y : View U
+ 10 | foo a X = MkUnit
+    |       ^
+
+Suggestion: Use the same name for both pattern variables, since they unify.
diff --git a/tests/idris2/misc/unification004/run b/tests/idris2/misc/unification004/run
new file mode 100755
index 00000000000..5bac559500e
--- /dev/null
+++ b/tests/idris2/misc/unification004/run
@@ -0,0 +1,4 @@
+. ../../../testutils.sh
+
+check Good.idr
+check Bad.idr
diff --git a/tests/idris2/misc/unification005/Good1.idr b/tests/idris2/misc/unification005/Good1.idr
new file mode 100644
index 00000000000..7739ae711cd
--- /dev/null
+++ b/tests/idris2/misc/unification005/Good1.idr
@@ -0,0 +1,17 @@
+namespace AAA
+  public export
+  unit_no_body : Unit
+  public export
+  unit_filled : Unit
+  unit_filled = MkUnit
+
+data View : Unit -> Type where
+  V_unit_filled : View AAA.unit_filled
+  V_unit_no_body : View AAA.unit_no_body
+
+delete : (v : Unit) -> View v -> Unit
+delete _ V_unit_filled = MkUnit
+delete _ V_unit_no_body = MkUnit
+
+aaa : Equal (delete AAA.unit_no_body V_unit_no_body) MkUnit
+aaa = Refl
diff --git a/tests/idris2/misc/unification005/Good2.idr b/tests/idris2/misc/unification005/Good2.idr
new file mode 100644
index 00000000000..6631555a5b0
--- /dev/null
+++ b/tests/idris2/misc/unification005/Good2.idr
@@ -0,0 +1,12 @@
+record W where
+  constructor MkW
+  value : Unit
+
+refocus : Pair Unit Unit -> W
+refocus (MkPair MkUnit env) = MkW env
+
+data Trace : W -> Type where
+  Step : (r : W) -> Trace r
+
+trace : (t : Unit) -> (env : W) -> Trace (refocus (MkPair t (value env))) -> Unit
+trace MkUnit (MkW _) (Step (MkW env)) = MkUnit
diff --git a/tests/idris2/misc/unification005/expected b/tests/idris2/misc/unification005/expected
new file mode 100644
index 00000000000..3966a9961e1
--- /dev/null
+++ b/tests/idris2/misc/unification005/expected
@@ -0,0 +1,2 @@
+1/1: Building Good1 (Good1.idr)
+1/1: Building Good2 (Good2.idr)
diff --git a/tests/idris2/misc/unification005/run b/tests/idris2/misc/unification005/run
new file mode 100755
index 00000000000..500d2ff05e9
--- /dev/null
+++ b/tests/idris2/misc/unification005/run
@@ -0,0 +1,4 @@
+. ../../../testutils.sh
+
+check Good1.idr
+check Good2.idr
diff --git a/tests/idris2/perf/perf012/expected b/tests/idris2/perf/perf012/expected
index 05b89b94761..7ca1bd1fb97 100644
--- a/tests/idris2/perf/perf012/expected
+++ b/tests/idris2/perf/perf012/expected
@@ -1,5 +1,5 @@
 LOG compiler.identity:5: found identity flag for: Main.id, 0
-	old def: Just [{arg:1}]: (%case !{arg:1} [(%constcase 0 0)] Just (%let {e:1} (-Integer [!{arg:1}, 1]) (+Integer [(Main.id [!{e:1}]), 1])))
+	old def: Just [{arg:1}]: (%case const !{arg:1} [(%constcase 0 0)] Just (%let {e:1} (-Integer [!{arg:1}, 1]) (+Integer [(Main.id [!{e:1}]), 1])))
 LOG compiler.identity:5: 	new def: [{arg:1}]: !{arg:1}
 LOG compiler.identity:5: found identity flag for: Main.id, 0
 	old def: Just [{arg:1}]: !{arg:1}
diff --git a/tests/idris2/pkg/pkg003/expected b/tests/idris2/pkg/pkg003/expected
index 2aba71eb1b4..4a8dd0814d8 100644
--- a/tests/idris2/pkg/pkg003/expected
+++ b/tests/idris2/pkg/pkg003/expected
@@ -6,6 +6,7 @@ Overridable options are:
     --verbose
     --timing
     --log <log level>
+    --log-tree
     --dumpcases <file>
     --dumplifted <file>
     --dumpvmcode <file>
diff --git a/tests/idris2/reflection/reflection025/expected b/tests/idris2/reflection/reflection025/expected
index f35d864a3d4..996b9cb1d46 100644
--- a/tests/idris2/reflection/reflection025/expected
+++ b/tests/idris2/reflection/reflection025/expected
@@ -18,6 +18,7 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
 LOG elab:0: 
 LOG elab:0: Names `RefDefs.simpleRec` refers to:
@@ -57,6 +58,7 @@ LOG elab:0: === current fn: [< RefDefsDeep.n, RefDefsDeep.1:f] ===
 LOG elab:0: === current fn: [< RefDefsDeep.w, RefDefsDeep.with block in "w"] ===
 LOG elab:0: === current fn: [< RefDefsDeep.w, RefDefsDeep.with block in "w"] ===
 LOG elab:0: Names `RefDefsDeep.f` refers to:
+LOG elab:0:   - RefDefsDeep.case block in "f"
 LOG elab:0:   - prim__sub_Integer
 LOG elab:0:   - prim__lte_Integer
 LOG elab:0:   - Prelude.Types.case block in "integerToNat"
@@ -75,11 +77,13 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
+LOG elab:0:   - Builtin.Unit
 LOG elab:0:   - Builtin.MkUnit
-LOG elab:0:   - RefDefsDeep.case block in "f"
 LOG elab:0: 
 LOG elab:0: Names `RefDefsDeep.f'` refers to:
+LOG elab:0:   - RefDefsDeep.case block in "f'"
 LOG elab:0:   - prim__sub_Integer
 LOG elab:0:   - prim__lte_Integer
 LOG elab:0:   - Prelude.Types.case block in "integerToNat"
@@ -98,11 +102,14 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
+LOG elab:0:   - Builtin.Unit
 LOG elab:0:   - Builtin.MkUnit
-LOG elab:0:   - RefDefsDeep.case block in "f'"
 LOG elab:0: 
 LOG elab:0: Names `RefDefsDeep.f''` refers to:
+LOG elab:0:   - RefDefsDeep.case block in "f"
+LOG elab:0:   - RefDefsDeep.case block in "f''"
 LOG elab:0:   - prim__sub_Integer
 LOG elab:0:   - prim__lte_Integer
 LOG elab:0:   - Prelude.Types.case block in "integerToNat"
@@ -121,13 +128,16 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
+LOG elab:0:   - Builtin.Unit
 LOG elab:0:   - Builtin.MkUnit
 LOG elab:0:   - RefDefsDeep.f
-LOG elab:0:   - RefDefsDeep.case block in "f"
-LOG elab:0:   - RefDefsDeep.case block in "f''"
 LOG elab:0: 
 LOG elab:0: Names `RefDefsDeep.f'''` refers to:
+LOG elab:0:   - RefDefsDeep.case block in "f"
+LOG elab:0:   - RefDefsDeep.case block in "f'''"
+LOG elab:0:   - RefDefsDeep.case block in "case block in f'''"
 LOG elab:0:   - prim__sub_Integer
 LOG elab:0:   - prim__lte_Integer
 LOG elab:0:   - Prelude.Types.case block in "integerToNat"
@@ -146,14 +156,14 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
+LOG elab:0:   - Builtin.Unit
 LOG elab:0:   - Builtin.MkUnit
 LOG elab:0:   - RefDefsDeep.f
-LOG elab:0:   - RefDefsDeep.case block in "f"
-LOG elab:0:   - RefDefsDeep.case block in "f'''"
-LOG elab:0:   - RefDefsDeep.case block in "case block in f'''"
 LOG elab:0: 
 LOG elab:0: Names `RefDefsDeep.n` refers to:
+LOG elab:0:   - RefDefsDeep.case block in "n,f"
 LOG elab:0:   - prim__sub_Integer
 LOG elab:0:   - prim__lte_Integer
 LOG elab:0:   - Prelude.Types.case block in "integerToNat"
@@ -172,12 +182,16 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
+LOG elab:0:   - Builtin.Unit
 LOG elab:0:   - Builtin.MkUnit
 LOG elab:0:   - RefDefsDeep.1:f
-LOG elab:0:   - RefDefsDeep.case block in "n,f"
 LOG elab:0: 
 LOG elab:0: Names `RefDefsDeep.w` refers to:
+LOG elab:0:   - RefDefsDeep.case block in "f"
+LOG elab:0:   - RefDefsDeep.case block in "with block in w"
+LOG elab:0:   - RefDefsDeep.case block in "with block in w"
 LOG elab:0:   - prim__sub_Integer
 LOG elab:0:   - prim__lte_Integer
 LOG elab:0:   - Prelude.Types.case block in "integerToNat"
@@ -196,13 +210,12 @@ LOG elab:0:   - Prelude.Num.(+)
 LOG elab:0:   - Prelude.Basics.intToBool
 LOG elab:0:   - Prelude.Basics.True
 LOG elab:0:   - Prelude.Basics.False
+LOG elab:0:   - Prelude.Basics.Bool
 LOG elab:0:   - Builtin.assert_total
+LOG elab:0:   - Builtin.Unit
 LOG elab:0:   - Builtin.MkUnit
 LOG elab:0:   - RefDefsDeep.f
-LOG elab:0:   - RefDefsDeep.case block in "f"
 LOG elab:0:   - RefDefsDeep.with block in "w"
-LOG elab:0:   - RefDefsDeep.case block in "with block in w"
-LOG elab:0:   - RefDefsDeep.case block in "with block in w"
 LOG elab:0: 
 ------------
 1/1: Building InspectRec (InspectRec.idr)
diff --git a/tests/idris2/reg/reg039/expected b/tests/idris2/reg/reg039/expected
index 85b584276ce..a1bdc10a9a9 100644
--- a/tests/idris2/reg/reg039/expected
+++ b/tests/idris2/reg/reg039/expected
@@ -1,5 +1,5 @@
 1/1: Building dupdup (dupdup.idr)
-Error: While processing right hand side of dupLinear. Trying to use linear name x in non-linear context.
+Error: While processing right hand side of dupLinear. x is not accessible in this context.
 
 dupdup:2:24--2:32
  1 | dupLinear : (1 x : a) -> (a, a)
diff --git a/tests/idris2/reg/reg042/expected b/tests/idris2/reg/reg042/expected
index 92956987677..600dfe86353 100644
--- a/tests/idris2/reg/reg042/expected
+++ b/tests/idris2/reg/reg042/expected
@@ -1,8 +1,7 @@
 1/1: Building NatOpts (NatOpts.idr)
 Main> Main.doPlus
-Arguments [{arg:1}, {arg:2}]
-Compile time tree: plus {arg:1} {arg:2}
-Compiled: \ {arg:1}, {arg:2} => {arg:1} + {arg:2}
+Compile time tree: \{arg:0}, {arg:1} => plus {arg:0} {arg:1}
+Compiled: \ {arg:0}, {arg:1} => {arg:0} + {arg:1}
 Refers to: Prelude.Types.plus
 Flags: covering
 Size change:
@@ -12,9 +11,8 @@ Size change:
   0 | =
   1 |   =
 Main> Main.doMinus
-Arguments [{arg:1}, {arg:2}]
-Compile time tree: minus {arg:1} {arg:2}
-Compiled: \ {arg:1}, {arg:2} => Prelude.Types.prim__integerToNat ({arg:1} - {arg:2})
+Compile time tree: \{arg:0}, {arg:1} => minus {arg:0} {arg:1}
+Compiled: \ {arg:0}, {arg:1} => Prelude.Types.prim__integerToNat ({arg:0} - {arg:1})
 Refers to: Prelude.Types.minus
 Refers to (runtime): Prelude.Types.prim__integerToNat
 Flags: covering
@@ -25,9 +23,8 @@ Size change:
   0 | =
   1 |   =
 Main> Main.doMult
-Arguments [{arg:1}, {arg:2}]
-Compile time tree: mult {arg:1} {arg:2}
-Compiled: \ {arg:1}, {arg:2} => {arg:1} * {arg:2}
+Compile time tree: \{arg:0}, {arg:1} => mult {arg:0} {arg:1}
+Compiled: \ {arg:0}, {arg:1} => {arg:0} * {arg:1}
 Refers to: Prelude.Types.mult
 Flags: covering
 Size change:
@@ -37,9 +34,8 @@ Size change:
   0 | =
   1 |   =
 Main> Main.doCompare
-Arguments [{arg:1}, {arg:2}]
-Compile time tree: compareNat {arg:1} {arg:2}
-Compiled: \ {arg:1}, {arg:2} => Prelude.EqOrd.compare {arg:1} {arg:2}
+Compile time tree: \{arg:0}, {arg:1} => compareNat {arg:0} {arg:1}
+Compiled: \ {arg:0}, {arg:1} => Prelude.EqOrd.compare {arg:0} {arg:1}
 Refers to: Prelude.Types.compareNat
 Refers to (runtime): Prelude.EqOrd.compare
 Flags: covering
@@ -50,9 +46,8 @@ Size change:
   0 | =
   1 |   =
 Main> Main.doEqual
-Arguments [{arg:1}, {arg:2}]
-Compile time tree: equalNat {arg:1} {arg:2}
-Compiled: \ {arg:1}, {arg:2} => {arg:1} == {arg:2}
+Compile time tree: \{arg:0}, {arg:1} => equalNat {arg:0} {arg:1}
+Compiled: \ {arg:0}, {arg:1} => {arg:0} == {arg:1}
 Refers to: Prelude.Types.equalNat
 Flags: covering
 Size change:
diff --git a/tests/idris2/reg/reg055_2/Declaration.idr b/tests/idris2/reg/reg055_2/Declaration.idr
new file mode 100644
index 00000000000..6ca0ae34bab
--- /dev/null
+++ b/tests/idris2/reg/reg055_2/Declaration.idr
@@ -0,0 +1,4 @@
+module Declaration
+
+export
+f : String -> String -> IO ()
diff --git a/tests/idris2/reg/reg055_2/Main.idr b/tests/idris2/reg/reg055_2/Main.idr
new file mode 100644
index 00000000000..b83065e5a34
--- /dev/null
+++ b/tests/idris2/reg/reg055_2/Main.idr
@@ -0,0 +1,10 @@
+module Main
+
+import Declaration
+
+Declaration.f x y = do
+  putStrLn x
+  putStrLn y
+
+main : IO ()
+main = f "first" "second"
diff --git a/tests/idris2/reg/reg055_2/expected b/tests/idris2/reg/reg055_2/expected
new file mode 100644
index 00000000000..66a52ee7a1d
--- /dev/null
+++ b/tests/idris2/reg/reg055_2/expected
@@ -0,0 +1,2 @@
+first
+second
diff --git a/tests/idris2/reg/reg055_2/run b/tests/idris2/reg/reg055_2/run
new file mode 100644
index 00000000000..2f1eae173f3
--- /dev/null
+++ b/tests/idris2/reg/reg055_2/run
@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+run Main.idr
diff --git a/tests/idris2/schemeeval/schemeeval001/expected b/tests/idris2/schemeeval/schemeeval001/expected
deleted file mode 100644
index e88288353c6..00000000000
--- a/tests/idris2/schemeeval/schemeeval001/expected
+++ /dev/null
@@ -1,5 +0,0 @@
-Main> [scheme] Main> \x, y => plus x y
-[scheme] Main> \x, y => plus y x
-[scheme] Main> \x => S (S (plus x x))
-[scheme] Main> \x => plus x (S (S x))
-[scheme] Main> Bye for now!
diff --git a/tests/idris2/schemeeval/schemeeval001/input b/tests/idris2/schemeeval/schemeeval001/input
deleted file mode 100644
index 9f0d3faae93..00000000000
--- a/tests/idris2/schemeeval/schemeeval001/input
+++ /dev/null
@@ -1,6 +0,0 @@
-:set eval scheme
-\x, y => plus x y
-\x : Nat, y => y + x
-\x => plus (S (S x)) x
-\x => plus x (S (S x))
-:q
diff --git a/tests/idris2/schemeeval/schemeeval002/expected b/tests/idris2/schemeeval/schemeeval002/expected
deleted file mode 100644
index e292dc48ed3..00000000000
--- a/tests/idris2/schemeeval/schemeeval002/expected
+++ /dev/null
@@ -1,3 +0,0 @@
-Main> [scheme] Main> [scheme] Main> 700000
-[scheme] Main> 0.30000000000000004
-[scheme] Main> Bye for now!
diff --git a/tests/idris2/schemeeval/schemeeval002/input b/tests/idris2/schemeeval/schemeeval002/input
deleted file mode 100644
index 004bde0869b..00000000000
--- a/tests/idris2/schemeeval/schemeeval002/input
+++ /dev/null
@@ -1,5 +0,0 @@
-:set eval scheme
--- Partly a performance test, partly to test primitives
-natToInteger (plus (integerToNat 300000) (integerToNat 400000))
-the Double 0.1+0.2
-:q
diff --git a/tests/idris2/schemeeval/schemeeval003/expected b/tests/idris2/schemeeval/schemeeval003/expected
deleted file mode 100644
index e3659b74c05..00000000000
--- a/tests/idris2/schemeeval/schemeeval003/expected
+++ /dev/null
@@ -1,3 +0,0 @@
-Main> [scheme] Main> 1 :: Delay (countFrom (1 + 1) (\arg => 1 + arg))
-[scheme] Main> [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
-[scheme] Main> Bye for now!
diff --git a/tests/idris2/schemeeval/schemeeval003/input b/tests/idris2/schemeeval/schemeeval003/input
deleted file mode 100644
index ff53b2d154c..00000000000
--- a/tests/idris2/schemeeval/schemeeval003/input
+++ /dev/null
@@ -1,4 +0,0 @@
-:set eval scheme
-[1..]
-take 10 [1..]
-:q
diff --git a/tests/idris2/schemeeval/schemeeval004/expected b/tests/idris2/schemeeval/schemeeval004/expected
deleted file mode 100644
index d33358d4b5f..00000000000
--- a/tests/idris2/schemeeval/schemeeval004/expected
+++ /dev/null
@@ -1,5 +0,0 @@
-1/1: Building list (list.idr)
-Main> [scheme] Main> False :: (False :: (False :: (False :: (False :: (False :: (False :: (False :: (False :: (False :: ?help)))))))))
-[scheme] Main> S (S (S (S (S (S (S (S (S (S (length ?help))))))))))
-[scheme] Main> True
-[scheme] Main> Bye for now!
diff --git a/tests/idris2/schemeeval/schemeeval004/input b/tests/idris2/schemeeval/schemeeval004/input
deleted file mode 100644
index 1182cd2152c..00000000000
--- a/tests/idris2/schemeeval/schemeeval004/input
+++ /dev/null
@@ -1,5 +0,0 @@
-:set eval scheme
-mkList False 10
-length (mkList False 10)
-isEven (length (replicate 200000 False))
-:q
diff --git a/tests/idris2/schemeeval/schemeeval004/list.idr b/tests/idris2/schemeeval/schemeeval004/list.idr
deleted file mode 100644
index d9e0b5d5861..00000000000
--- a/tests/idris2/schemeeval/schemeeval004/list.idr
+++ /dev/null
@@ -1,11 +0,0 @@
-import Data.List
-
-mkList : a -> Nat -> List a
-mkList x Z = ?help
-mkList x (S k) = x :: mkList x k
-
--- For a performance test: make sure we evaluate the full list, and get
--- a result that we don't have to work hard to render
-isEven : Nat -> Bool
-isEven Z = True
-isEven (S k) = not (isEven k)
diff --git a/tests/idris2/schemeeval/schemeeval004/run b/tests/idris2/schemeeval/schemeeval004/run
deleted file mode 100755
index 11a21eb370d..00000000000
--- a/tests/idris2/schemeeval/schemeeval004/run
+++ /dev/null
@@ -1,3 +0,0 @@
-. ../../../testutils.sh
-
-idris2 list.idr < input
diff --git a/tests/idris2/schemeeval/schemeeval005/Printf.idr b/tests/idris2/schemeeval/schemeeval005/Printf.idr
deleted file mode 100644
index fdca3221543..00000000000
--- a/tests/idris2/schemeeval/schemeeval005/Printf.idr
+++ /dev/null
@@ -1,38 +0,0 @@
-module Printf
-
-import Prelude
-import Data.String
-
-data Arg
-    = AInt      Arg
-    | AOther    Char Arg
-    | AEnd
-
-buildArg : List Char -> Arg
-buildArg fmt = case fmt of
-    '%' :: 'i' :: fmtTail   => AInt (buildArg fmtTail)
-    c :: fmtTail            => AOther c (buildArg fmtTail)
-    Nil                     => AEnd
-
-argToType : Arg -> Type -> Type
-argToType a result = case a of
-    AInt fmtTail      => Int -> argToType fmtTail result
-    AOther _ fmtTail  => argToType fmtTail result
-    AEnd              => result
-
--- PrintfType "foo" result = result
--- PrintfType "%i\n" result = Int -> result
--- etc
-PrintfType : String -> Type -> Type
-PrintfType fmt result = argToType (buildArg (unpack fmt)) result
-
-sprintf : (fmt : String) -> PrintfType fmt String
-sprintf fmt = go "" (buildArg (unpack fmt)) where
-    go : String -> (arg : Arg) -> argToType arg String
-    go strTail arg = case arg of
-        AInt fmtTail        => \i : Int => go (strTail ++ show i) fmtTail
-        AOther c fmtTail    => go (strTail ++ singleton c) fmtTail
-        AEnd                => strTail
-
-test : ?result
-test = sprintf "%i%i%i%i%i%i"
diff --git a/tests/idris2/schemeeval/schemeeval005/expected b/tests/idris2/schemeeval/schemeeval005/expected
deleted file mode 100644
index 0fa72e0b145..00000000000
--- a/tests/idris2/schemeeval/schemeeval005/expected
+++ /dev/null
@@ -1,3 +0,0 @@
-1/1: Building Printf (Printf.idr)
-Printf> [scheme] Printf> \i, i, i, i, i, i => ((((("" ++ (prim__cast_IntString i)) ++ (prim__cast_IntString i)) ++ (prim__cast_IntString i)) ++ (prim__cast_IntString i)) ++ (prim__cast_IntString i)) ++ (prim__cast_IntString i)
-[scheme] Printf> Bye for now!
diff --git a/tests/idris2/schemeeval/schemeeval005/input b/tests/idris2/schemeeval/schemeeval005/input
deleted file mode 100644
index aa9149845d9..00000000000
--- a/tests/idris2/schemeeval/schemeeval005/input
+++ /dev/null
@@ -1,3 +0,0 @@
-:set eval scheme
-test
-:q
diff --git a/tests/idris2/schemeeval/schemeeval005/run b/tests/idris2/schemeeval/schemeeval005/run
deleted file mode 100755
index bc2f18c94b0..00000000000
--- a/tests/idris2/schemeeval/schemeeval005/run
+++ /dev/null
@@ -1,3 +0,0 @@
-. ../../../testutils.sh
-
-idris2 Printf.idr < input
diff --git a/tests/idris2/schemeeval/schemeeval006/expected b/tests/idris2/schemeeval/schemeeval006/expected
deleted file mode 100644
index 7725550e1f5..00000000000
--- a/tests/idris2/schemeeval/schemeeval006/expected
+++ /dev/null
@@ -1,3 +0,0 @@
-Main> [scheme] Main> ['f', 'o', 'o']
-[scheme] Main> 
-Bye for now!
diff --git a/tests/idris2/schemeeval/schemeeval006/input b/tests/idris2/schemeeval/schemeeval006/input
deleted file mode 100644
index 0a320224693..00000000000
--- a/tests/idris2/schemeeval/schemeeval006/input
+++ /dev/null
@@ -1,3 +0,0 @@
-:set eval scheme
-unpack "foo"
-:q
\ No newline at end of file
diff --git a/tests/idris2/total/positivity003/expected b/tests/idris2/total/positivity003/expected
index ab91034a53e..51a80eefad7 100644
--- a/tests/idris2/total/positivity003/expected
+++ b/tests/idris2/total/positivity003/expected
@@ -1,11 +1,11 @@
 1/1: Building Issue660 (Issue660.idr)
-LOG eval.eta:5: Attempting to eta contract subterms of: \(n : Prelude.Types.Nat) => (value[1] n[0])
-LOG eval.eta:5: Evaluated to: \(n : Prelude.Types.Nat) => (value[1] n[0])
+LOG eval.eta:5: Attempting to eta contract subterms of: \(n : Prelude.Types.Nat) => (value[1] (RigW, n[0]))
+LOG eval.eta:5: Evaluated to: \(n : Prelude.Types.Nat) => (value[1] (RigW, n[0]))
 LOG eval.eta:10:   Considering: Prelude.Types.Nat
 LOG eval.eta:10:   Considering: value[1]
 LOG eval.eta:10:   Considering: n[0]
-LOG eval.eta:10:   Considering: (value[1] n[0])
-LOG eval.eta:10:   Considering: \(n : Prelude.Types.Nat) => (value[1] n[0])
+LOG eval.eta:10:   Considering: (value[1] (RigW, n[0]))
+LOG eval.eta:10:   Considering: \(n : Prelude.Types.Nat) => (value[1] (RigW, n[0]))
 LOG eval.eta:10:   Shrinking candidate: value[1]
 LOG eval.eta:10:   Success!: value[0]
 LOG eval.eta:5: Result of eta-contraction: value[0]
diff --git a/tests/refc/callingConvention/expected b/tests/refc/callingConvention/expected
index eb8a50083df..7b275a560d6 100644
--- a/tests/refc/callingConvention/expected
+++ b/tests/refc/callingConvention/expected
@@ -23,7 +23,7 @@ Value *Main_last
 ,   Value * var_1
 )
 {
-    Value * tmp_70 = NULL;                                   // Main:8:8--8:14
+    Value * tmp_67 = NULL;                                   // Main:5:1--5:24
     if (NULL == var_0 /* _builtin.NIL [nil] */) {
         tmp_70 = var_1;
     } else if (NULL != var_0 /* _builtin.CONS [cons] */) {
@@ -43,79 +43,79 @@ Value *Main_last
 }
 Value *Main_main_0
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 );
 Value *Main_main_1
 (
-    Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
 );
 Value *Main_main_2
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 );
 Value *Main_main_3
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 );
 Value *Main_main_4
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 );
 Value *Main_main_5
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 );
 Value *Main_main_6
 (
-    Value * var_6
-,   Value * var_5
-,   Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
+,   Value * var_5
+,   Value * var_6
 );
 Value *Main_main_7
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 );
 Value *Main_main_8
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 );
 Value *Main_main_9
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 );
 Value *Main_main_10
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 );
 Value *Main_main_11
 (
@@ -190,12 +190,12 @@ Value *Main_main_11
 }
 Value *Main_main_10
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 )
 {
     Value * var_2 = idris2_getPredefinedInteger(0);          // Main:14:25--14:31
-    Value * var_3 = idris2_trampoline(Main_last(var_1, var_2));
+    Value * var_3 = idris2_trampoline(Main_last(var_0, var_2));
                                                              // Prelude.Show:110:1--112:50
     Value * var_4 = idris2_trampoline(Prelude_Show_show_Show_Integer(var_3));
     Value * var_5 = ((Value*)&idris2_constant_String_46);
@@ -206,21 +206,22 @@ Value *Main_main_10
     Value *closure_51 = (Value *)idris2_mkClosure((Value *(*)())Prelude_IO_prim__putStr, 2, 2);
                                                              // Prelude.IO:98:22--98:34
     ((Value_Closure*)closure_51)->args[0] = var_6;
-    ((Value_Closure*)closure_51)->args[1] = var_0;
+    ((Value_Closure*)closure_51)->args[1] = var_1;
     return closure_51;
 }
 Value *Main_main_9
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 )
 {
-    Value *closure_52 = (Value *)idris2_mkClosure((Value *(*)())Main_main_0, 5, 0);
-    Value * var_2 = closure_52;                              // Prelude.IO:19:1--26:30
-    Value *closure_53 = (Value *)idris2_mkClosure((Value *(*)())Main_main_1, 3, 0);
-    Value * var_3 = closure_53;                              // Prelude.IO:19:1--26:30
-    Value *closure_54 = (Value *)idris2_mkClosure((Value *(*)())Main_main_2, 5, 0);
-    Value * var_4 = closure_54;                              // Prelude.IO:19:1--26:30
+    Value *closure_49 = (Value *)idris2_mkClosure((Value *(*)())Main_main_0, 5, 0);
+                                                             // Prelude.IO:19:1--26:30
+    Value * var_2 = closure_49;                              // Prelude.IO:19:1--26:30
+    Value *closure_50 = (Value *)idris2_mkClosure((Value *(*)())Main_main_1, 3, 0);
+    Value * var_3 = closure_50;                              // Prelude.IO:19:1--26:30
+    Value *closure_51 = (Value *)idris2_mkClosure((Value *(*)())Main_main_2, 5, 0);
+    Value * var_4 = closure_51;                              // Prelude.IO:19:1--26:30
      // constructor Prelude.Interfaces.MkApplicative         // Prelude.IO:19:1--26:30
     Value_Constructor* constructor_55 = idris2_newConstructor(3, 0);
                                                              // Prelude.IO:19:1--26:30
@@ -254,128 +255,128 @@ Value *Main_main_9
                                                              // Main:14:8--14:12
     ((Value_Closure*)closure_63)->args[0] = var_11;
     ((Value_Closure*)closure_63)->args[1] = var_12;
-    ((Value_Closure*)closure_63)->args[2] = var_1;
-    ((Value_Closure*)closure_63)->args[3] = var_0;
+    ((Value_Closure*)closure_63)->args[2] = var_0;
+    ((Value_Closure*)closure_63)->args[3] = var_1;
     return closure_63;
 }
 Value *Main_main_8
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 )
 {
-    idris2_removeReference(var_3);
-    idris2_removeReference(var_4);
+    idris2_removeReference(var_0);
+    idris2_removeReference(var_1);
     Value *closure_64 = (Value *)idris2_mkClosure((Value *(*)())Prelude_Types_foldMap_Foldable_List, 3, 3);
                                                              // Prelude.Types:656:1--669:59
     ((Value_Closure*)closure_64)->args[0] = var_2;
-    ((Value_Closure*)closure_64)->args[1] = var_1;
-    ((Value_Closure*)closure_64)->args[2] = var_0;
+    ((Value_Closure*)closure_64)->args[1] = var_3;
+    ((Value_Closure*)closure_64)->args[2] = var_4;
     return closure_64;
 }
 Value *Main_main_7
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 )
 {
-    idris2_removeReference(var_1);
-    return var_0;
+    idris2_removeReference(var_0);
+    return var_1;
 }
 Value *Main_main_6
 (
-    Value * var_6
-,   Value * var_5
-,   Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
+,   Value * var_5
+,   Value * var_6
 )
 {
-    idris2_removeReference(var_4);
-    idris2_removeReference(var_5);
-    idris2_removeReference(var_6);
+    idris2_removeReference(var_0);
+    idris2_removeReference(var_1);
+    idris2_removeReference(var_2);
     Value *closure_65 = (Value *)idris2_mkClosure((Value *(*)())Prelude_Types_foldlM_Foldable_List, 4, 4);
                                                              // Prelude.Types:656:1--669:59
     ((Value_Closure*)closure_65)->args[0] = var_3;
-    ((Value_Closure*)closure_65)->args[1] = var_2;
-    ((Value_Closure*)closure_65)->args[2] = var_1;
-    ((Value_Closure*)closure_65)->args[3] = var_0;
+    ((Value_Closure*)closure_65)->args[1] = var_4;
+    ((Value_Closure*)closure_65)->args[2] = var_5;
+    ((Value_Closure*)closure_65)->args[3] = var_6;
     return closure_65;
 }
 Value *Main_main_5
 (
-    Value * var_1
-,   Value * var_0
+    Value * var_0
+,   Value * var_1
 )
 {
-    idris2_removeReference(var_1);
+    idris2_removeReference(var_0);
     Value *closure_66 = (Value *)idris2_mkClosure((Value *(*)())Prelude_Types_null_Foldable_List, 1, 1);
                                                              // Prelude.Types:656:1--669:59
-    ((Value_Closure*)closure_66)->args[0] = var_0;
+    ((Value_Closure*)closure_66)->args[0] = var_1;
     return closure_66;
 }
 Value *Main_main_4
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 )
 {
-    idris2_removeReference(var_3);
-    idris2_removeReference(var_4);
+    idris2_removeReference(var_0);
+    idris2_removeReference(var_1);
     Value *closure_67 = (Value *)idris2_mkClosure((Value *(*)())Prelude_Types_foldl_Foldable_List, 3, 3);
                                                              // Prelude.Types:656:1--669:59
     ((Value_Closure*)closure_67)->args[0] = var_2;
-    ((Value_Closure*)closure_67)->args[1] = var_1;
-    ((Value_Closure*)closure_67)->args[2] = var_0;
+    ((Value_Closure*)closure_67)->args[1] = var_3;
+    ((Value_Closure*)closure_67)->args[2] = var_4;
     return closure_67;
 }
 Value *Main_main_3
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 )
 {
-    idris2_removeReference(var_3);
-    idris2_removeReference(var_4);
+    idris2_removeReference(var_0);
+    idris2_removeReference(var_1);
     Value *closure_68 = (Value *)idris2_mkClosure((Value *(*)())Prelude_Types_foldr_Foldable_List, 3, 3);
                                                              // Prelude.Types:656:1--669:59
     ((Value_Closure*)closure_68)->args[0] = var_2;
-    ((Value_Closure*)closure_68)->args[1] = var_1;
-    ((Value_Closure*)closure_68)->args[2] = var_0;
+    ((Value_Closure*)closure_68)->args[1] = var_3;
+    ((Value_Closure*)closure_68)->args[2] = var_4;
     return closure_68;
 }
 Value *Main_main_2
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 )
 {
-    idris2_removeReference(var_3);
-    idris2_removeReference(var_4);
-    Value * var_5 = idris2_apply_closure(var_2, idris2_newReference(var_0));
+    idris2_removeReference(var_0);
+    idris2_removeReference(var_1);
+    Value * var_5 = idris2_apply_closure(var_2, idris2_newReference(var_4));
                                                              // Prelude.IO:24:9--24:16
-    Value * var_6 = idris2_apply_closure(var_1, var_0);      // Prelude.IO:25:11--25:18
+    Value * var_6 = idris2_apply_closure(var_3, var_4);      // Prelude.IO:25:11--25:18
     return idris2_tailcall_apply_closure(var_5, var_6);
 }
 Value *Main_main_1
 (
-    Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
 )
 {
     idris2_removeReference(var_0);
@@ -384,19 +385,19 @@ Value *Main_main_1
 }
 Value *Main_main_0
 (
-    Value * var_4
-,   Value * var_3
-,   Value * var_2
+    Value * var_0
 ,   Value * var_1
-,   Value * var_0
+,   Value * var_2
+,   Value * var_3
+,   Value * var_4
 )
 {
-    idris2_removeReference(var_3);
-    idris2_removeReference(var_4);
+    idris2_removeReference(var_0);
+    idris2_removeReference(var_1);
     Value *closure_69 = (Value *)idris2_mkClosure((Value *(*)())Prelude_IO_map_Functor_IO, 3, 3);
                                                              // Prelude.IO:15:1--17:38
     ((Value_Closure*)closure_69)->args[0] = var_2;
-    ((Value_Closure*)closure_69)->args[1] = var_1;
-    ((Value_Closure*)closure_69)->args[2] = var_0;
+    ((Value_Closure*)closure_69)->args[1] = var_3;
+    ((Value_Closure*)closure_69)->args[2] = var_4;
     return closure_69;
 }
diff --git a/tests/refc/reuse/expected b/tests/refc/reuse/expected
index 6206aac0adb..018c1c71e60 100644
--- a/tests/refc/reuse/expected
+++ b/tests/refc/reuse/expected
@@ -17,7 +17,7 @@ Value *Main_insert
 ,   Value * var_2
 )
 {
-    Value * tmp_35 = NULL;                                   // Main:6:24--6:31
+    Value * tmp_35 = NULL;                                   // Main:6:1--6:42
     if (((Value_Constructor *)var_2)->tag == 0 /* Main.Leaf */) {
         Value_Constructor* constructor_36 = NULL;
         if (idris2_isUnique(var_2)) {
@@ -59,38 +59,38 @@ Value *Main_insert
         }
         Value * tmp_40 = NULL;                               // Prelude.EqOrd:121:3--121:6
         if (((Value_Constructor *)var_0)->tag == 0 /* Prelude.EqOrd.MkOrd */) {
-            Value *var_8 = ((Value_Constructor*)var_0)->args[0];
-            Value *var_9 = ((Value_Constructor*)var_0)->args[1];
-            Value *var_10 = ((Value_Constructor*)var_0)->args[2];
-            Value *var_11 = ((Value_Constructor*)var_0)->args[3];
-            Value *var_12 = ((Value_Constructor*)var_0)->args[4];
-            Value *var_13 = ((Value_Constructor*)var_0)->args[5];
-            Value *var_14 = ((Value_Constructor*)var_0)->args[6];
-            Value *var_15 = ((Value_Constructor*)var_0)->args[7];
-            idris2_newReference(var_10);
-            Value * var_16 = idris2_apply_closure(var_10, idris2_newReference(var_1));
+            Value *var_9 = ((Value_Constructor*)var_0)->args[0];
+            Value *var_10 = ((Value_Constructor*)var_0)->args[1];
+            Value *var_11 = ((Value_Constructor*)var_0)->args[2];
+            Value *var_12 = ((Value_Constructor*)var_0)->args[3];
+            Value *var_13 = ((Value_Constructor*)var_0)->args[4];
+            Value *var_14 = ((Value_Constructor*)var_0)->args[5];
+            Value *var_15 = ((Value_Constructor*)var_0)->args[6];
+            Value *var_16 = ((Value_Constructor*)var_0)->args[7];
+            idris2_newReference(var_11);
+            Value * var_17 = idris2_apply_closure(var_11, idris2_newReference(var_1));
                                                              // Prelude.EqOrd:121:3--121:6
-            tmp_40 = idris2_apply_closure(var_16, idris2_newReference(var_6));
+            tmp_40 = idris2_apply_closure(var_17, idris2_newReference(var_6));
         }
-        Value * var_19 = tmp_40;
-        Value *tmp_41 = NULL;
-        int64_t tmp_42 = idris2_extractInt(var_19);
+        Value * var_8 = tmp_40;                              // Main:8:25--9:64
+        Value *tmp_41 = NULL;                                // Main:8:25--9:64
+        int64_t tmp_42 = idris2_extractInt(var_8);
         if (tmp_42 == UINT8_C(1)) {
-            idris2_removeReference(var_19);
-            Value * var_17 = idris2_trampoline(Main_insert(var_0, var_1, var_5));
+            idris2_removeReference(var_8);
+            Value * var_18 = idris2_trampoline(Main_insert(var_0, var_1, var_5));
                                                              // Main:8:42--8:46
              // constructor Main.Node                        // Main:8:42--8:46
             if (! constructor_39) {                          // Main:8:42--8:46
                 constructor_39 = idris2_newConstructor(3, 1);
                                                              // Main:8:42--8:46
             }                                                // Main:8:42--8:46
-            constructor_39->args[0] = var_17;
+            constructor_39->args[0] = var_18;
             constructor_39->args[1] = var_6;
             constructor_39->args[2] = var_7;
             tmp_41 = (Value*)constructor_39;
         } else if (tmp_42 == UINT8_C(0)) {
-            idris2_removeReference(var_19);
-            Value * var_18 = idris2_trampoline(Main_insert(var_0, var_1, var_7));
+            idris2_removeReference(var_8);
+            Value * var_19 = idris2_trampoline(Main_insert(var_0, var_1, var_7));
                                                              // Main:9:42--9:46
              // constructor Main.Node                        // Main:9:42--9:46
             if (! constructor_39) {                          // Main:9:42--9:46
@@ -99,7 +99,7 @@ Value *Main_insert
             }                                                // Main:9:42--9:46
             constructor_39->args[0] = var_5;
             constructor_39->args[1] = var_6;
-            constructor_39->args[2] = var_18;
+            constructor_39->args[2] = var_19;
             tmp_41 = (Value*)constructor_39;
         }
         tmp_35 = tmp_41;
diff --git a/tests/ttimp/basic006/expected b/tests/ttimp/basic006/expected
index a6f9c5f812f..50bd1141ffb 100644
--- a/tests/ttimp/basic006/expected
+++ b/tests/ttimp/basic006/expected
@@ -2,5 +2,5 @@ Processing as TTImp
 Written TTC
 Yaffle> ((Main.Just [a = ((Main.Vect.Vect (Main.S Main.Z)) Integer)]) ((((Main.Vect.Cons [k = Main.Z]) [a = Integer]) 1) (Main.Vect.Nil [a = Integer])))
 Yaffle> ((Main.MkInfer [a = (Main.List.List Integer)]) (((Main.List.Cons [a = Integer]) 1) (Main.List.Nil [a = Integer])))
-Yaffle> (Interactive):1:9--1:12:Ambiguous elaboration [($resolved1 ?Main.{a:1}_[]), ($resolved2 ?Main.{a:1}_[])]
+Yaffle> (Interactive):1:9--1:12:Ambiguous elaboration [($resolved1 (Rig0, ?Main.{a:1}_[])), ($resolved2 (Rig0, ?Main.{a:1}_[]))]
 Yaffle> Bye for now!
diff --git a/tests/ttimp/coverage002/expected b/tests/ttimp/coverage002/expected
index 9b26236a273..50add69dcfb 100644
--- a/tests/ttimp/coverage002/expected
+++ b/tests/ttimp/coverage002/expected
@@ -2,6 +2,6 @@ Processing as TTImp
 Written TTC
 Yaffle> Main.lookup: All cases covered
 Yaffle> Main.lookup':
-($resolved1 [__] [__] ($resolved2 [__]) {_:1})
+($resolved1 (Rig0, [__]) (Rig0, [__]) (RigW, ($resolved2 (Rig0, [__]))) (RigW, {_:1}))
 Yaffle> Main.lookup'': Calls non covering function Main.lookup'
 Yaffle> Bye for now!
diff --git a/tests/ttimp/dot001/expected b/tests/ttimp/dot001/expected
index b87823c3b3f..67ac8ed550f 100644
--- a/tests/ttimp/dot001/expected
+++ b/tests/ttimp/dot001/expected
@@ -3,11 +3,11 @@ Written TTC
 Yaffle> Bye for now!
 Processing as TTImp
 Dot2:15:1--16:1:When elaborating left hand side of Main.half:
-Dot2:15:28--15:30:Pattern variable {P:n:1} unifies with ?{P:m:1}_[]
+Dot2:15:10--15:15:Pattern variable {P:n:1} unifies with ?{P:m:1}_[]
 Yaffle> Bye for now!
 Processing as TTImp
 Dot3:18:1--19:1:When elaborating left hand side of Main.addBaz3:
-Dot3:18:10--18:15:Can't match on ($resolved1 ?{P:x:1}_[] ?{P:x:1}_[]) (Not a constructor application or primitive) - it elaborates to ($resolved1 ?Main.{_:1}_[] ?Main.{_:2}_[])
+Dot3:18:10--18:15:Can't match on ($resolved1 (RigW, ?{P:x:1}_[]) (RigW, ?{P:x:1}_[])) (Not a constructor application or primitive) - it elaborates to ?Main.{dotTm:1}_[]
 Yaffle> Bye for now!
 Processing as TTImp
 Dot4:17:1--18:1:When elaborating left hand side of Main.addBaz4: