diff --git a/.gitignore b/.gitignore
index 0b7a7aa..221f1d8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,5 +5,3 @@ result
 *~
 quox
 quox-tests
-golden-tests/tests/*/output
-golden-tests/tests/*/*.ss
diff --git a/examples/all.quox b/examples/all.quox
index 925429c..b24ebcf 100644
--- a/examples/all.quox
+++ b/examples/all.quox
@@ -5,6 +5,3 @@ load "maybe.quox"
 load "nat.quox"
 load "pair.quox"
 load "list.quox"
-load "eta.quox"
-load "fail.quox"
-load "qty.quox"
diff --git a/examples/bool.quox b/examples/bool.quox
index a6f8140..7d3a065 100644
--- a/examples/bool.quox
+++ b/examples/bool.quox
@@ -1,39 +1,35 @@
-load "misc.quox";
+load "misc.quox"
 
 namespace bool {
 
-def0 Bool : ★ = {true, false};
+def0 Bool : ★ = {true, false}
 
 def if-dep : 0.(P : Bool → ★) → (b : Bool) → ω.(P 'true) → ω.(P 'false) → P b =
-  λ P b t f ⇒ case b return b' ⇒ P b' of { 'true ⇒ t; 'false ⇒ f };
+  λ P b t f ⇒ case b return b' ⇒ P b' of { 'true ⇒ t; 'false ⇒ f }
 
-def if : 0.(A : ★) → (b : Bool) → ω.A → ω.A → A =
-  λ A ⇒ if-dep (λ _ ⇒ A);
+def if : 0.(A : ★) → Bool → ω.A → ω.A → A =
+  λ A ⇒ if-dep (λ _ ⇒ A)
 
 def0 if-same : (A : ★) → (b : Bool) → (x : A) → if A b x x ≡ x : A =
-  λ A b x ⇒ if-dep (λ b' ⇒ if A b' x x ≡ x : A) b (δ _ ⇒ x) (δ _ ⇒ x);
+  λ A b x ⇒ if-dep (λ b' ⇒ if A b' x x ≡ x : A) b (δ _ ⇒ x) (δ _ ⇒ x)
 
 def if2 : 0.(A B : ★) → (b : Bool) → ω.A → ω.B → if¹ ★ b A B =
-  λ A B ⇒ if-dep (λ b ⇒ if-dep¹ (λ _ ⇒ ★) b A B);
+  λ A B ⇒ if-dep (λ b ⇒ if¹ ★ b A B)
 
-def0 T : Bool → ★ = λ b ⇒ if¹ ★ b True False;
+def0 T : Bool → ★ = λ b ⇒ if¹ ★ b True False
 
-def dup! : (b : Bool) → [ω. Sing Bool b] =
-  λ b ⇒ if-dep (λ b ⇒ [ω. Sing Bool b]) b
-    [('true,  [δ _ ⇒ 'true])]
-    [('false, [δ _ ⇒ 'false])];
+def dup : Bool → [ω.Bool] =
+  λ b ⇒ if [ω.Bool] b ['true] ['false]
 
-def dup : Bool → [ω. Bool] =
-  λ b ⇒ appω (Sing Bool b) Bool (sing.val Bool b) (dup! b);
-
-def true-not-false : Not ('true ≡ 'false : Bool) =
-  λ eq ⇒ coe (𝑖 ⇒ T (eq @𝑖)) 'true;
+def0 true-not-false : Not ('true ≡ 'false : Bool) =
+  λ eq ⇒ coe (𝑖 ⇒ T (eq @𝑖)) 'true
 
 
 -- [todo] infix
-def and : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false;
-def or  : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a 'true b;
+def and : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false
+def or  : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a 'true b
 
 }
 
-def0 Bool = bool.Bool;
+def0 Bool = bool.Bool
+def if = bool.if
diff --git a/examples/eta.quox b/examples/eta.quox
deleted file mode 100644
index 67d1a8b..0000000
--- a/examples/eta.quox
+++ /dev/null
@@ -1,25 +0,0 @@
-load "misc.quox"
-
-namespace eta {
-
-def0 Π : (A : ★) → (A → ★) → ★ = λ A B ⇒ (x : A) → B x
-def0 Σ : (A : ★) → (A → ★) → ★ = λ A B ⇒ (x : A) × B x
-
-def0 function : (A : ★) → (B : A → Type) → (P : Π A B → ★) → (f : Π A B) →
-                P (λ x ⇒ f x) → P f =
-  λ A B P f p ⇒ p
-
-def0 box : (A : ★) → (P : [ω.A] → ★) → (e : [ω.A]) →
-           P [case1 e return A of {[x] ⇒ x}] → P e =
-  λ A P e p ⇒ p
-
-def0 pair : (A : ★) → (B : A → ★) → (P : Σ A B → ★) → (e : Σ A B) →
-            P (fst e, snd e) → P e =
-  λ A B P e p ⇒ p
-
--- not exactly η, but kinda related
-def0 from-false : (A : ★) → (P : (0.False → A) → ★) → (f : 0.False → A) →
-                  P (void A) → P f =
-  λ A P f p ⇒ p
-
-}
diff --git a/examples/fail.quox b/examples/fail.quox
deleted file mode 100644
index daf5c05..0000000
--- a/examples/fail.quox
+++ /dev/null
@@ -1,16 +0,0 @@
-#[fail "but cases for"]
-def missing-b : {a, b} → {a} =
-  λ x ⇒ case x return {a} of { 'a ⇒ 'a }
-
-#[fail "duplicate arms"]
-def repeat-enum-case : {a} → {a} =
-  λ x ⇒ case x return {a} of { 'a ⇒ 'a; 'a ⇒ 'a }
-
-#[fail "duplicate tags"]
-def repeat-enum-type : {a, a} = 'a
-
-#[fail "double-def.X has already been defined"]
-namespace double-def {
-  def0 X : ★ = {a}
-  def0 X : ★ = {a}
-}
diff --git a/examples/hello.quox b/examples/hello.quox
deleted file mode 100644
index db220cf..0000000
--- a/examples/hello.quox
+++ /dev/null
@@ -1,26 +0,0 @@
-def0 Unit : ★ = {tt}
-
-def drop-unit : 0.(A : ★) → Unit → A → A =
-  λ A u x ⇒ case u return A of {'tt ⇒ x}
-
-def0 IO : ★ → ★ = λ A ⇒ IOState → A × IOState
-
-def bind : 0.(A B : ★) → IO A → (A → IO B) → IO B =
-  λ A B m k s0 ⇒
-  case m s0 return B × IOState of { (x, s1) ⇒ k x s1 }
-
-def seq : IO Unit → IO Unit → IO Unit =
-  λ a b ⇒ bind Unit Unit a (λ u ⇒ drop-unit (IO Unit) u b)
-
-#[compile-scheme "(lambda (n) (builtin-io (printf \"~d~n\" n) 'tt))"]
-postulate print-ℕ : ℕ → IO Unit
-
-#[compile-scheme "(lambda (s) (builtin-io (printf \"~s~n\" s) 'tt))"]
-postulate print : String → IO Unit
-
-load "nat.quox"
-
-#[main]
-def main : IO Unit =
-  let1 sixty-nine = nat.plus 60 9 in
-  seq (print-ℕ sixty-nine) (print "(nice)")
diff --git a/examples/io.quox b/examples/io.quox
deleted file mode 100644
index 2b6ed66..0000000
--- a/examples/io.quox
+++ /dev/null
@@ -1,31 +0,0 @@
-load "misc.quox"
-
-namespace io {
-
-def0 IORes : ★ → ★ = λ A ⇒ A × IOState
-
-def0 IO : ★ → ★ = λ A ⇒ IOState → IORes A
-
-def pure : 0.(A : ★) → A → IO A = λ A x s ⇒ (x, s)
-
-def bind : 0.(A B : ★) → IO A → (A → IO B) → IO B =
-  λ A B m k s0 ⇒
-  case m s0 return IORes B of { (x, s1) ⇒ k x s1 }
-
-def seq : 0.(B : ★) → IO True → IO B → IO B =
-  λ B x y ⇒ bind True B x (λ u ⇒ case u return IO B of { 'true ⇒ y })
-
-def seq' : IO True → IO True → IO True = seq True
-
-#[compile-scheme "(lambda (str) (builtin-io (display str) 'true))"]
-postulate print : String → IO True
-
-def newline = print "\n"
-
-def println : String → IO True =
-  λ str ⇒ seq' (print str) newline
-
-#[compile-scheme "(builtin-io (get-line (current-input-port)))"]
-postulate readln : IO String
-
-}
diff --git a/examples/list.quox b/examples/list.quox
index ac45ba4..cb6ac1e 100644
--- a/examples/list.quox
+++ b/examples/list.quox
@@ -24,7 +24,6 @@ def elim : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
         }
     };
 
-#[compile-scheme "(lambda% (n xs) xs)"]
 def up : 0.(A : ★) → (n : ℕ) → Vec n A → Vec¹ n A =
   λ A n ⇒
     case n return n' ⇒ Vec n' A → Vec¹ n' A of {
@@ -64,7 +63,6 @@ def elim : 0.(A : ★) → 0.(P : List A → ★) →
     };
 
 -- [fixme] List A <: List¹ A should be automatic, imo
-#[compile-scheme "(lambda (xs) xs)"]
 def up : 0.(A : ★) → List A → List¹ A =
   λ A xs ⇒
   case xs return List¹ A of { (len, elems) ⇒
diff --git a/examples/misc.quox b/examples/misc.quox
index 8afbde9..8188a1d 100644
--- a/examples/misc.quox
+++ b/examples/misc.quox
@@ -6,26 +6,14 @@ def0 Not : ★ → ★ = λ A ⇒ ω.A → False
 def void : 0.(A : ★) → 0.False → A =
   λ A v ⇒ case0 v return A of { }
 
-def0 All : (A : ★) → (0.A → ★) → ★ =
+def0 All : (A : ★) → (0.A → ★) → ★¹ =
   λ A P ⇒ (x : A) → P x
 
-def0 cong :
-    (A : ★) → (P : 0.A → ★) → (p : All A P) →
-    (x y : A) → (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
+def cong :
+    0.(A : ★) → 0.(P : 0.A → ★) → (p : All A P) →
+    0.(x y : A) → (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
   λ A P p x y xy ⇒ δ 𝑖 ⇒ p (xy @𝑖)
 
-def0 cong' :
-    (A B : ★) → (f : A → B) →
-    (x y : A) → (xy : x ≡ y : A) → f x ≡ f y : B =
-  λ A B ⇒ cong A (λ _ ⇒ B)
-
-def0 coherence :
-    (A B : ★) → (AB : A ≡ B : ★) → (x : A) →
-    Eq (𝑖 ⇒ AB @𝑖) x (coe (𝑖 ⇒ AB @𝑖) x) =
-  λ A B AB x ⇒
-    δ 𝑗 ⇒ coe (𝑖 ⇒ AB @𝑖) @0 @𝑗 x
-
-
 def0 eq-f :
     0.(A : ★) → 0.(P : 0.A → ★) →
     0.(p : All A P) → 0.(q : All A P) →
@@ -37,8 +25,6 @@ def funext :
     (All A (eq-f A P p q)) → p ≡ q : All A P =
   λ A P p q eq ⇒ δ 𝑖 ⇒ λ x ⇒ eq x @𝑖
 
-def refl : 0.(A : ★) → (x : A) → x ≡ x : A = λ A x ⇒ δ _ ⇒ x
-
 def sym : 0.(A : ★) → 0.(x y : A) → (x ≡ y : A) → y ≡ x : A =
   λ A x y eq ⇒ δ 𝑖 ⇒ comp A (eq @0) @𝑖 { 0 𝑗 ⇒ eq @𝑗; 1 _ ⇒ eq @0 }
 
@@ -49,35 +35,29 @@ def trans : 0.(A : ★) → 0.(x y z : A) →
 
 def appω : 0.(A B : ★) → ω.(f : A → B) → [ω.A] → [ω.B] =
   λ A B f x ⇒
-  case x return [ω.B] of { [x'] ⇒ [f x'] }
-
-def0 HEq : (A B : ★) → A → B → ★¹ =
-  λ A B x y ⇒ (AB : A ≡ B : ★) × Eq (𝑖 ⇒ AB @𝑖) x y
+  case x return [ω.B] of { [x'] ⇒ [f x'] };
 
 
 def0 Sing : (A : ★) → A → ★ =
-  λ A x ⇒ (val : A) × [0. val ≡ x : A]
-
-def sing : 0.(A : ★) → (x : A) → Sing A x =
-  λ A x ⇒ (x, [δ _ ⇒ x])
+  λ A x ⇒ (val : A) × [0. val ≡ x : A];
 
 namespace sing {
 
 def val : 0.(A : ★) → 0.(x : A) → Sing A x → A =
   λ A _ sg ⇒
-  case sg return A of { (x, eq) ⇒ case eq return A of { [_] ⇒ x } }
+  case sg return A of { (x, eq) ⇒ case eq return A of { [_] ⇒ x } };
 
 def0 proof : (A : ★) → (x : A) → (sg : Sing A x) → val A x sg ≡ x : A =
   λ A x sg ⇒
   case sg return sg' ⇒ val A x sg' ≡ x : A of { (x', eq) ⇒
     case eq return eq' ⇒ val A x (x', eq') ≡ x : A of { [eq'] ⇒ eq' }
-  }
+  };
 
 def app : 0.(A B : ★) → 0.(x : A) →
           (f : A → B) → Sing A x → Sing B (f x) =
   λ A B x f sg ⇒
   case sg return Sing B (f x) of { (x_, eq) ⇒
     case eq return Sing B (f x) of { [eq] ⇒ (f x_, [δ 𝑖 ⇒ f (eq @𝑖)]) }
-  }
+  };
 
 }
diff --git a/examples/nat.quox b/examples/nat.quox
index efc834d..17715d4 100644
--- a/examples/nat.quox
+++ b/examples/nat.quox
@@ -4,27 +4,11 @@ load "either.quox";
 
 namespace nat {
 
-def elim-0-1 :
-    0.(P : ℕ → ★) →
-    ω.(P 0) → ω.(P 1) →
-    ω.(0.(n : ℕ) → P n → P (succ n)) →
-    (n : ℕ) → P n =
-  λ P p0 p1 ps n ⇒
-  case n return n' ⇒ P n' of {
-    zero    ⇒ p0;
-    succ n' ⇒
-      case n' return n'' ⇒ P (succ n'') of {
-        zero         ⇒ p1;
-        succ n'', IH ⇒ ps (succ n'') IH
-      }
-  }
-
-#[compile-scheme "(lambda (n) (cons n 'erased))"]
 def dup! : (n : ℕ) → [ω. Sing ℕ n] =
   λ n ⇒
   case n return n' ⇒ [ω. Sing ℕ n'] of {
     zero ⇒ [(zero, [δ _ ⇒ zero])];
-    succ n, d ⇒
+    succ n, 1.d ⇒
       appω (Sing ℕ n) (Sing ℕ (succ n))
         (sing.app ℕ ℕ n (λ n ⇒ succ n)) d
   };
@@ -32,20 +16,18 @@ def dup! : (n : ℕ) → [ω. Sing ℕ n] =
 def dup : ℕ → [ω.ℕ] =
   λ n ⇒ appω (Sing ℕ n) ℕ (sing.val ℕ n) (dup! n);
 
-#[compile-scheme "(lambda% (m n) (+ m n))"]
 def plus : ℕ → ℕ → ℕ =
   λ m n ⇒
   case m return ℕ of {
-    zero      ⇒ n;
-    succ _, p ⇒ succ p
+    zero        ⇒ n;
+    succ _, 1.p ⇒ succ p
   };
 
-#[compile-scheme "(lambda% (m n) (* m n))"]
 def timesω : ℕ → ω.ℕ → ℕ =
   λ m n ⇒
   case m return ℕ of {
-    zero      ⇒ zero;
-    succ _, t ⇒ plus n t
+    zero        ⇒ zero;
+    succ _, 1.t ⇒ plus n t
   };
 
 def times : ℕ → ℕ → ℕ =
@@ -59,14 +41,6 @@ def pred-succ : ω.(n : ℕ) → pred (succ n) ≡ n : ℕ =
 def0 succ-inj : (m n : ℕ) → succ m ≡ succ n : ℕ → m ≡ n : ℕ =
   λ m n eq ⇒ δ 𝑖 ⇒ pred (eq @𝑖);
 
-#[compile-scheme "(lambda% (m n) (max 0 (- m n)))"]
-def minus : ℕ → ℕ → ℕ =
-  λ m n ⇒
-  (case n return ℕ → ℕ of {
-    zero      ⇒ λ m ⇒ m;
-    succ _, f ⇒ λ m ⇒ f (pred m)
-  }) m;
-
 
 def0 IsSucc : ℕ → ★ =
   λ n ⇒ case n return ★ of { zero ⇒ False; succ _ ⇒ True };
@@ -93,7 +67,6 @@ def0 not-succ-self : (m : ℕ) → Not (m ≡ succ m : ℕ) =
   }
 
 
-#[compile-scheme "(lambda% (m n) (if (= m n) Yes No))"]
 def eq? : DecEq ℕ =
   λ m ⇒
   caseω m
@@ -121,45 +94,25 @@ def eqb : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ dec.bool (m ≡ n : ℕ) (eq?
 def0 plus-zero : (m : ℕ) → m ≡ plus m 0 : ℕ =
   λ m ⇒
   case m return m' ⇒ m' ≡ plus m' 0 : ℕ of {
-    zero        ⇒ δ _ ⇒ 0;
-    succ m', ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
+    zero         ⇒ δ _ ⇒ zero;
+    succ _, ω.ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
   };
 
 def0 plus-succ : (m n : ℕ) → succ (plus m n) ≡ plus m (succ n) : ℕ =
   λ m n ⇒
   case m return m' ⇒ succ (plus m' n) ≡ plus m' (succ n) : ℕ of {
-    zero       ⇒ δ _ ⇒ succ n;
-    succ _, ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
+    zero         ⇒ δ _ ⇒ succ n;
+    succ _, ω.ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
   };
 
 def0 plus-comm : (m n : ℕ) → plus m n ≡ plus n m : ℕ =
   λ m n ⇒
   case m return m' ⇒ plus m' n ≡ plus n m' : ℕ of {
     zero ⇒ plus-zero n;
-    succ m', ih ⇒
+    succ m', ω.ih ⇒
       trans ℕ (succ (plus m' n)) (succ (plus n m')) (plus n (succ m'))
         (δ 𝑖 ⇒ succ (ih @𝑖))
         (plus-succ n m')
   };
 
-def0 times-zero : (m : ℕ) → 0 ≡ timesω m 0 : ℕ =
-  λ m ⇒
-  case m return m' ⇒ 0 ≡ timesω m' 0 : ℕ of {
-    zero        ⇒ δ _ ⇒ zero;
-    succ m', ih ⇒ ih
-  };
-
-{-
--- unfinished
-def0 times-succ : (m n : ℕ) → plus m (timesω m n) ≡ timesω m (succ n) : ℕ =
-  λ m n ⇒
-  case m
-  return m' ⇒ plus m' (timesω m' n) ≡ timesω m' (succ n) : ℕ
-  of {
-    zero ⇒ δ _ ⇒ 0;
-    succ m', ih ⇒
-      δ 𝑖 ⇒ plus (succ n) (ih @𝑖)
-  };
--}
-
 }
diff --git a/examples/natw.quox b/examples/natw.quox
new file mode 100644
index 0000000..1922b87
--- /dev/null
+++ b/examples/natw.quox
@@ -0,0 +1,36 @@
+load "misc.quox"
+
+namespace natw {
+
+def0 Tag : ★ = {z, s}
+
+def0 Child : Tag → ★ =
+  λ t ⇒ case t return ★ of { 'z ⇒ {}; 's ⇒ {pred} }
+
+def0 NatW : ★ = (t : Tag) ⊲ Child t
+
+def Zero : NatW =
+  'z ⋄ (λ v ⇒ case v return NatW of {})
+
+def Suc : ω.NatW → NatW =
+  λ n ⇒ 's ⋄ (λ u ⇒ case u return NatW of { 'pred ⇒ n })
+
+def elim : 0.(P : NatW → ★) →
+           ω.(P Zero) →
+           ω.(0.(n : NatW) → ω.(P n) → P (Suc n)) →
+           ω.(n : NatW) → P n =
+  λ P pz ps n ⇒
+  caseω n return n' ⇒ P n' of {
+    t ⋄ f, ω.ih ⇒
+      (case t
+       return t' ⇒ 0.(eq : t ≡ t' : Tag) →
+         P (t' ⋄ coe (𝑖 ⇒ ω.(Child (eq @𝑖)) → NatW) f)
+       of {
+         'z ⇒ λ _ ⇒ pz;
+         's ⇒ λ eq ⇒
+           ps (f  (coe (𝑖 ⇒ Child (eq @𝑖)) @1 @0 'pred))
+              (ih (coe (𝑖 ⇒ Child (eq @𝑖)) @1 @0 'pred))
+       }) (δ 𝑖 ⇒ t)
+  }
+
+}
diff --git a/examples/pair.quox b/examples/pair.quox
index 4bf33c6..d37680b 100644
--- a/examples/pair.quox
+++ b/examples/pair.quox
@@ -1,74 +1,54 @@
 namespace pair {
 
-def0 Σ : (A : ★) → (A → ★) → ★ = λ A B ⇒ (x : A) × B x;
+def0 Σ : (A : ★) → (0.A → ★) → ★ = λ A B ⇒ (x : A) × B x;
 
-{-
--- now builtins
-def fst : 0.(A : ★) → 0.(B : A → ★) → ω.(Σ A B) → A =
+def fst : 0.(A : ★) → 0.(B : 0.A → ★) → ω.(Σ A B) → A =
   λ A B p ⇒ caseω p return A of { (x, _) ⇒ x };
 
-def snd : 0.(A : ★) → 0.(B : A → ★) → ω.(p : Σ A B) → B (fst A B p) =
+def snd : 0.(A : ★) → 0.(B : 0.A → ★) → ω.(p : Σ A B) → B (fst A B p) =
   λ A B p ⇒ caseω p return p' ⇒ B (fst A B p') of { (_, y) ⇒ y };
--}
 
 def uncurry :
-    0.(A : ★) → 0.(B : A → ★) → 0.(C : (x : A) → (B x) → ★) →
+    0.(A : ★) → 0.(B : 0.A → ★) → 0.(C : 0.(x : A) → 0.(B x) → ★) →
     (f : (x : A) → (y : B x) → C x y) →
-    (p : Σ A B) → C (fst p) (snd p) =
+    (p : Σ A B) → C (fst A B p) (snd A B p) =
   λ A B C f p ⇒
-    case p return p' ⇒ C (fst p') (snd p') of { (x, y) ⇒ f x y };
+    case p return p' ⇒ C (fst A B p') (snd A B p') of { (x, y) ⇒ f x y };
 
 def uncurry' :
     0.(A B C : ★) → (A → B → C) → (A × B) → C =
   λ A B C ⇒ uncurry A (λ _ ⇒ B) (λ _ _ ⇒ C);
 
 def curry :
-    0.(A : ★) → 0.(B : A → ★) → 0.(C : (Σ A B) → ★) →
+    0.(A : ★) → 0.(B : 0.A → ★) → 0.(C : 0.(Σ A B) → ★) →
     (f : (p : Σ A B) → C p) → (x : A) → (y : B x) → C (x, y) =
   λ A B C f x y ⇒ f (x, y);
 
 def curry' :
-    0.(A B C : ★) → (A × B → C) → A → B → C =
+    0.(A B C : ★) → ((A × B) → C) → A → B → C =
   λ A B C ⇒ curry A (λ _ ⇒ B) (λ _ ⇒ C);
 
 def0 fst-snd :
-    (A : ★) → (B : A → ★) →
-    (p : Σ A B) → p ≡ (fst p, snd p) : Σ A B =
+    (A : ★) → (B : 0.A → ★) →
+    (p : Σ A B) → p ≡ (fst A B p, snd A B p) : Σ A B =
   λ A B p ⇒
     case p
-    return p' ⇒ p' ≡ (fst p', snd p') : Σ A B
+    return p' ⇒ p' ≡ (fst A B p', snd A B p') : Σ A B
     of { (x, y) ⇒ δ 𝑖 ⇒ (x, y) };
 
-def0 fst-eq :
-    (A : ★) → (B : A → ★) →
-    (p q : Σ A B) → p ≡ q : Σ A B → fst p ≡ fst q : A =
-  λ A B p q eq ⇒ δ 𝑖 ⇒ fst (eq @𝑖);
-
-def0 snd-eq :
-    (A : ★) → (B : A → ★) →
-    (p q : Σ A B) → (eq : p ≡ q : Σ A B) →
-    Eq (𝑖 ⇒ B (fst-eq A B p q eq @𝑖)) (snd p) (snd q) =
-  λ A B p q eq ⇒ δ 𝑖 ⇒ snd (eq @𝑖);
-
 def map :
     0.(A A' : ★) →
-    0.(B : A → ★) → 0.(B' : A' → ★) →
+    0.(B : 0.A → ★) → 0.(B' : 0.A' → ★) →
     (f : A → A') → (g : 0.(x : A) → (B x) → B' (f x)) →
-    Σ A B → Σ A' B' =
+    (Σ A B) → Σ A' B' =
   λ A A' B B' f g p ⇒
     case p return Σ A' B' of { (x, y) ⇒ (f x, g x y) };
 
 def map' : 0.(A A' B B' : ★) → (A → A') → (B → B') → (A × B) → A' × B' =
   λ A A' B B' f g ⇒ map A A' (λ _ ⇒ B) (λ _ ⇒ B') f (λ _ ⇒ g);
 
-def map-fst : 0.(A A' B : ★) → (A → A') → A × B → A' × B =
-  λ A A' B f ⇒ map' A A' B B f (λ x ⇒ x);
-
-def map-snd : 0.(A B B' : ★) → (B → B') → A × B → A × B' =
-  λ A B B' f ⇒ map' A A B B' (λ x ⇒ x) f;
-
 }
 
 def0 Σ   = pair.Σ;
--- def  fst = pair.fst;
--- def  snd = pair.snd;
+def  fst = pair.fst;
+def  snd = pair.snd;
diff --git a/examples/qty.quox b/examples/qty.quox
deleted file mode 100644
index 9f5e529..0000000
--- a/examples/qty.quox
+++ /dev/null
@@ -1,77 +0,0 @@
-def0 Qty : ★ = {"zero", one, any}
-
-def dup : Qty → [ω.Qty] =
-  λ π ⇒ case π return [ω.Qty] of {
-    'zero ⇒ ['zero];
-    'one  ⇒ ['one];
-    'any  ⇒ ['any];
-  }
-
-def drop : 0.(A : ★) → Qty → A → A =
-  λ A π x ⇒ case π return A of {
-    'zero ⇒ x;
-    'one  ⇒ x;
-    'any  ⇒ x;
-  }
-
-def if-zero : 0.(A : ★) → Qty → ω.A → ω.A → A =
-  λ A π z nz ⇒
-  case π return A of { 'zero ⇒ z; 'one ⇒ nz; 'any ⇒ nz }
-
-def plus : Qty → Qty → Qty =
-  λ π ρ ⇒
-  case π return Qty of {
-    'zero ⇒ ρ;
-    'one  ⇒ if-zero Qty ρ 'one 'any;
-    'any  ⇒ drop Qty ρ 'any;
-  }
-
-def times : Qty → Qty → Qty =
-  λ π ρ ⇒
-  case π return Qty of {
-    'zero ⇒ drop Qty ρ 'zero;
-    'one  ⇒ ρ;
-    'any  ⇒ if-zero Qty ρ 'zero 'any;
-  }
-
-def0 FUN : Qty → (A : ★) → (A → ★) → ★ =
-  λ π A B ⇒
-  case π return ★ of {
-    'zero ⇒ 0.(x : A) → B x;
-    'one  ⇒ 1.(x : A) → B x;
-    'any  ⇒ ω.(x : A) → B x;
-  }
-
-def0 Fun : Qty → ★ → ★ → ★ =
-  λ π A B ⇒ FUN π A (λ _ ⇒ B)
-
-def0 Box : Qty → ★ → ★ =
-  λ π A ⇒
-  case π return ★ of {
-    'zero ⇒ [0.A];
-    'one  ⇒ [1.A];
-    'any  ⇒ [ω.A];
-  }
-
-def0 unbox : (π : Qty) → (A : ★) → Box π A → A =
-  λ π A ⇒
-  case π return π' ⇒ Box π' A → A of {
-    'zero ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-    'one  ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-    'any  ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-  }
-
-def0 unbox0 = unbox 'zero
-def0 unbox1 = unbox 'one
-def0 unboxω = unbox 'any
-
-def apply : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
-            FUN π A B → (x : Box π A) → B (unbox π A x) =
-  λ π A B ⇒
-  case π
-  return π' ⇒ FUN π' A B → (x : Box π' A) → B (unbox π' A x)
-  of {
-    'zero ⇒ λ f x ⇒ case x return x' ⇒ B (unbox0 A x') of { [x] ⇒ f x };
-    'one  ⇒ λ f x ⇒ case x return x' ⇒ B (unbox1 A x') of { [x] ⇒ f x };
-    'any  ⇒ λ f x ⇒ case x return x' ⇒ B (unboxω A x') of { [x] ⇒ f x };
-  }
diff --git a/exe/CompileMonad.idr b/exe/CompileMonad.idr
deleted file mode 100644
index bc0b3e5..0000000
--- a/exe/CompileMonad.idr
+++ /dev/null
@@ -1,164 +0,0 @@
-module CompileMonad
-
-import Quox.Syntax as Q
-import Quox.Definition as Q
-import Quox.Untyped.Syntax as U
-import Quox.Parser
-import Quox.Untyped.Erase
-import Quox.Untyped.Scheme
-import Quox.Pretty
-import Quox.Log
-import Options
-import Output
-import Error
-
-import System.File
-import Data.IORef
-import Data.Maybe
-import Control.Eff
-
-%default total
-
-%hide Doc.(>>=)
-%hide Core.(>>=)
-
-%hide FromParser.Error
-%hide Erase.Error
-%hide Lexer.Error
-%hide Parser.Error
-
-
-
-public export
-record State where
-  constructor MkState
-  seen : IORef SeenSet
-  defs : IORef Q.Definitions
-  ns   : IORef Mods
-  suf  : IORef NameSuf
-%name CompileMonad.State state
-
-export %inline
-newState : HasIO io => io State
-newState = pure $ MkState {
-  seen = !(newIORef empty),
-  defs = !(newIORef empty),
-  ns   = !(newIORef [<]),
-  suf  = !(newIORef 0)
-}
-
-
-public export
-data CompileTag = OPTS | STATE
-
-public export
-Compile : List (Type -> Type)
-Compile =
-  [Except Error,
-   ReaderL STATE State, ReaderL OPTS Options, Log,
-   LoadFile, IO]
-
-
-export %inline
-handleLog : IORef LevelStack -> OpenFile -> LogL x a -> IOErr Error a
-handleLog ref f l = case f of
-  OConsole ch => handleLogIO (const $ pure ()) ref (consoleHandle ch) l
-  OFile _ h   => handleLogIO (const $ pure ()) ref h l
-  ONone       => do
-    lvls   <- readIORef ref
-    lenRef <- newIORef (length lvls)
-    res    <- handleLogDiscardIO lenRef l
-    writeIORef ref $ fixupDiscardedLog !(readIORef lenRef) lvls
-    pure res
-
-private %inline
-withLogFile : Options ->
-              (IORef LevelStack -> OpenFile -> IO (Either Error a)) ->
-              IO (Either Error a)
-withLogFile opts act = do
-  lvlStack <- newIORef $ singleton opts.logLevels
-  withOutFile CErr opts.logFile fromError $ act lvlStack
-where
-  fromError : String -> FileError -> IO (Either Error a)
-  fromError file err = pure $ Left $ WriteError file err
-
-export covering %inline
-runCompile : Options -> State -> Eff Compile a -> IO (Either Error a)
-runCompile opts state act = do
-  withLogFile opts $ \lvls, logFile =>
-    fromIOErr $ runEff act $ with Union.(::)
-      [handleExcept (\e => ioLeft e),
-       handleReaderConst state,
-       handleReaderConst opts,
-       handleLog lvls logFile,
-       handleLoadFileIOE loadError ParseError state.seen opts.include,
-       liftIO]
-
-private %inline
-rethrowFileC : String -> Either FileError a -> Eff Compile a
-rethrowFileC f = rethrow . mapFst (WriteError f)
-
-
-export %inline
-outputStr : OpenFile -> Lazy String -> Eff Compile ()
-outputStr ONone           _   = pure ()
-outputStr (OConsole COut) str = putStr str
-outputStr (OConsole CErr) str = fPutStr stderr str >>= rethrowFileC "<stderr>"
-outputStr (OFile f h)     str = fPutStr h str >>= rethrowFileC f
-
-export %inline
-outputDocs : OpenFile ->
-             ({opts : LayoutOpts} -> Eff Pretty (List (Doc opts))) ->
-             Eff Compile ()
-outputDocs file docs = do
-  opts <- askAt OPTS
-  for_ (runPretty opts (toOutFile file) docs) $ \x =>
-    outputStr file $ render (Opts opts.width) x
-
-export %inline
-outputDoc : OpenFile ->
-            ({opts : LayoutOpts} -> Eff Pretty (Doc opts)) -> Eff Compile ()
-outputDoc file doc = outputDocs file $ singleton <$> doc
-
-
-public export
-data StopTag = STOP
-
-public export
-CompileStop : List (Type -> Type)
-CompileStop = FailL STOP :: Compile
-
-export %inline
-withEarlyStop : Eff CompileStop () -> Eff Compile ()
-withEarlyStop = ignore . runFailAt STOP
-
-export %inline
-stopHere : Has (FailL STOP) fs => Eff fs ()
-stopHere = failAt STOP
-
-
-export %inline
-liftFromParser : Eff FromParserIO a -> Eff Compile a
-liftFromParser act =
-  runEff act $ with Union.(::)
-    [handleExcept $ \err => throw $ FromParserError err,
-     handleStateIORef !(asksAt STATE defs),
-     handleStateIORef !(asksAt STATE ns),
-     handleStateIORef !(asksAt STATE suf),
-     \g => send g,
-     \g => send g]
-
-export %inline
-liftErase : Q.Definitions -> Eff Erase a -> Eff Compile a
-liftErase defs act =
-  runEff act
-    [handleExcept $ \err => throw $ EraseError err,
-     handleStateIORef !(asksAt STATE suf),
-     \g => send g]
-
-export %inline
-liftScheme : Eff Scheme a -> Eff Compile (a, List Id)
-liftScheme act = do
-  runEff [|MkPair act (getAt MAIN)|]
-    [handleStateIORef !(newIORef empty),
-     handleStateIORef !(newIORef [])]
diff --git a/exe/Error.idr b/exe/Error.idr
deleted file mode 100644
index 03d716c..0000000
--- a/exe/Error.idr
+++ /dev/null
@@ -1,49 +0,0 @@
-module Error
-
-import Quox.Pretty
-import Quox.Parser
-import Quox.Untyped.Erase
-import Quox.Untyped.Scheme
-import Options
-import Output
-
-import System.File
-
-
-public export
-data Error =
-  ParseError String Parser.Error
-| FromParserError FromParser.Error
-| EraseError Erase.Error
-| WriteError FilePath FileError
-| NoMain
-| MultipleMains (List Scheme.Id)
-
-%hide FromParser.Error
-%hide Erase.Error
-%hide Lexer.Error
-%hide Parser.Error
-
-
-export
-loadError : Loc -> FilePath -> FileError -> Error
-loadError loc file err = FromParserError $ LoadError loc file err
-
-export
-prettyError : {opts : LayoutOpts} -> Error -> Eff Pretty (Doc opts)
-prettyError (ParseError file e) = prettyParseError file e
-prettyError (FromParserError e) = FromParser.prettyError True e
-prettyError (EraseError      e) = Erase.prettyError True e
-prettyError NoMain              = pure "no #[main] function given"
-prettyError (MultipleMains xs)  =
-  pure $ sep ["multiple #[main] functions given:",
-              separateLoose "," !(traverse prettyId xs)]
-prettyError (WriteError file e) = pure $
-  hangSingle 2 (text "couldn't write file \{file}:") (pshow e)
-
-export
-dieError : Options -> Error -> IO a
-dieError opts e =
-  die (Opts opts.width) $
-  runPretty ({outFile := Console} opts) Console $
-  prettyError e
diff --git a/exe/Main.idr b/exe/Main.idr
index c9e7f0b..2329980 100644
--- a/exe/Main.idr
+++ b/exe/Main.idr
@@ -1,118 +1,46 @@
 module Main
 
-import Quox.Syntax as Q
-import Quox.Definition as Q
-import Quox.Untyped.Syntax as U
+import Quox.Syntax
 import Quox.Parser
-import Quox.Untyped.Erase
-import Quox.Untyped.Scheme
+import Quox.Definition
 import Quox.Pretty
-import Quox.Log
-import Options
-import Output
-import Error
-import CompileMonad
 
 import System
-import System.File
 import Data.IORef
+import Data.SortedSet
 import Control.Eff
 
-%default total
-
-%hide Doc.(>>=)
-%hide Core.(>>=)
-
-%hide FromParser.Error
-%hide Erase.Error
-%hide Lexer.Error
-%hide Parser.Error
-
+private
+Opts : LayoutOpts
+Opts = Opts 80
 
 private
-Step : Type -> Type -> Type
-Step a b = OpenFile -> a -> Eff Compile b
+putDoc : Doc Opts -> IO ()
+putDoc = putStr . render Opts
 
 private
-step : ConsoleChannel -> Phase -> OutFile -> Step a b -> a -> Eff CompileStop b
-step console phase file act x = do
-  opts <- askAt OPTS
-  res  <- withOutFile console file fromError $ \h => lift $ act h x
-  when (opts.until == Just phase) stopHere
-  pure res
-where
-  fromError : String -> FileError -> Eff CompileStop c
-  fromError file err = throw $ WriteError file err
+die : Doc Opts -> IO a
+die err = do putDoc err; exitFailure
 
+private
+prettySig : {opts : _} -> Name -> Definition -> Eff Pretty (Doc opts)
+prettySig name def = do
+  qty  <- prettyQty def.qty.fst
+  name <- prettyFree name
+  type <- prettyTerm [<] [<] def.type
+  hangDSingle (hsep [hcat [qty, !dotD, name], !colonD]) type
 
-private covering
-parse : Step String PFile
-parse h file = do
-  Just ast <- loadFile noLoc file
-    | Nothing => pure []
-  outputStr h $ show ast
-  pure ast
-
-private covering
-check : Step PFile (List Q.NDefinition)
-check h decls =
-  map concat $ for decls $ \decl => do
-    defs <- liftFromParser $ fromPTopLevel decl
-    outputDocs h $ traverse (\(x, d) => prettyDef x d) defs
-    pure defs
-
-private covering
-erase : Step (List Q.NDefinition) (List U.NDefinition)
-erase h defList =
-  for defList $ \(x, def) => do
-    def <- liftErase defs $ eraseDef defs x def
-    outputDoc h $ U.prettyDef x def
-    pure (x, def)
-where defs = SortedMap.fromList defList
-
-private covering
-scheme : Step (List U.NDefinition) (List Sexp, List Id)
-scheme h defs = do
-  sexps' <- for defs $ \(x, d) => do
-    (msexp, mains) <- liftScheme $ defToScheme x d
-    outputDoc h $ case msexp of
-      Just s  => prettySexp s
-      Nothing => pure $ hsep [";;", prettyName x, "erased"]
-    pure (msexp, mains)
-  pure $ bimap catMaybes concat $ unzip sexps'
-
-private covering
-output : Step (List Sexp, List Id) ()
-output h (sexps, mains) = do
-  main <- case mains of
-    [m] => pure m
-    []  => throw NoMain
-    _   => throw $ MultipleMains mains
-  lift $ outputDocs h $ do
-    res    <- traverse prettySexp sexps
-    runner <- makeRunMain main
-    pure $ text Scheme.prelude :: res ++ [runner]
-
-private covering
-processFile : String -> Eff Compile ()
-processFile file = withEarlyStop $ pipeline !(askAt OPTS) file where
-  pipeline : Options -> String -> Eff CompileStop ()
-  pipeline opts =
-    step CErr Parse  opts.dump.parse  Main.parse  >=>
-    step CErr Check  opts.dump.check  Main.check  >=>
-    step CErr Erase  opts.dump.erase  Main.erase  >=>
-    step CErr Scheme opts.dump.scheme Main.scheme >=>
-    step COut End    opts.outFile     Main.output
-
-
-export covering
+export
 main : IO ()
 main = do
-  (_, opts, files) <- options
-  case !(runCompile opts !newState $ traverse_ processFile files) of
-    Right () => pure ()
-    Left  e  => dieError opts e
-
+  seen <- newIORef SortedSet.empty
+  defs <- newIORef SortedMap.empty
+  suf  <- newIORef $ the Nat 0
+  for_ (drop 1 !getArgs) $ \file => do
+    putStrLn "checking \{file}"
+    Right res <- fromParserIO ["."] seen suf defs $ loadProcessFile noLoc file
+      | Left err => die $ runPrettyColor $ prettyError True err
+    for_ res $ \(name, def) => putDoc $ runPrettyColor $ prettySig name def
 
 -----------------------------------
 {-
@@ -127,13 +55,6 @@ text _ =
    #" /_/"#,
    ""]
 
---   ["",
---    #" __ _ _  _ _____ __"#,
---    #"/ _` | || / _ \ \ /"#,
---    #"\__, |\_,_\___/_\_\"#,
---    #"   |_|"#,
---    ""]
-
 private
 qtuwu : PrettyOpts -> List String
 qtuwu opts =
diff --git a/exe/Options.idr b/exe/Options.idr
deleted file mode 100644
index f1788df..0000000
--- a/exe/Options.idr
+++ /dev/null
@@ -1,258 +0,0 @@
-module Options
-
-import Quox.Pretty
-import Quox.Log
-import Data.DPair
-import Data.SortedMap
-import System
-import System.Console.GetOpt
-import System.File
-import System.Term
-import Derive.Prelude
-
-%default total
-%language ElabReflection
-
-public export
-data OutFile = File String | Console | NoOut
-%name OutFile f
-%runElab derive "OutFile" [Eq, Show]
-
-public export
-data Phase = Parse | Check | Erase | Scheme | End
-%name Phase p
-%runElab derive "Phase" [Eq, Show]
-
-||| a list of all intermediate `Phase`s (excluding `End`)
-public export %inline
-allPhases : List Phase
-allPhases = %runElab do
-  cs <- getCons $ fst !(lookupName "Phase")
-  traverse (check . var) $ fromMaybe [] $ init' cs
-
-||| `Guess` is `Term` for a terminal and `NoHL` for a file
-public export
-data HLType = Guess | NoHL | Term | Html
-%runElab derive "HLType" [Eq, Show]
-
-public export
-record Dump where
-  constructor MkDump
-  parse, check, erase, scheme : OutFile
-%name Dump dump
-%runElab derive "Dump" [Show]
-
-public export
-record Options where
-  constructor MkOpts
-  include   : List String
-  dump      : Dump
-  outFile   : OutFile
-  until     : Maybe Phase
-  hlType    : HLType
-  flavor    : Pretty.Flavor
-  width     : Nat
-  logLevels : LogLevels
-  logFile   : OutFile
-%name Options opts
-%runElab derive "Options" [Show]
-
-export
-defaultWidth : IO Nat
-defaultWidth = do
-  w <- cast {to = Nat} <$> getTermCols
-  pure $ if w == 0 then 80 else w
-
-export
-defaultOpts : IO Options
-defaultOpts = pure $ MkOpts {
-  include   = ["."],
-  dump      = MkDump NoOut NoOut NoOut NoOut,
-  outFile   = Console,
-  until     = Nothing,
-  hlType    = Guess,
-  flavor    = Unicode,
-  width     = !defaultWidth,
-  logLevels = defaultLogLevels,
-  logFile   = Console
-}
-
-private
-data HelpType = Common | All
-
-private
-data OptAction = ShowHelp HelpType | Err String | Ok (Options -> Options)
-%name OptAction act
-
-private
-toOutFile : String -> OutFile
-toOutFile ""  = NoOut
-toOutFile "-" = Console
-toOutFile f   = File f
-
-private
-toPhase : String -> OptAction
-toPhase str =
-  let lstr = toLower str in
-  case find (\p => toLower (show p) == lstr) allPhases of
-    Just p  => Ok $ setPhase p
-    Nothing => Err "unknown phase name \{show str}\nphases: \{phaseNames}"
-where
-  phaseNames = joinBy ", " $ map (toLower . show) allPhases
-
-  defConsole : OutFile -> OutFile
-  defConsole NoOut = Console
-  defConsole f     = f
-
-  setPhase : Phase -> Options -> Options
-  setPhase Parse  = {until := Just Parse,  dump.parse  $= defConsole}
-  setPhase Check  = {until := Just Check,  dump.check  $= defConsole}
-  setPhase Erase  = {until := Just Erase,  dump.erase  $= defConsole}
-  setPhase Scheme = {until := Just Scheme, dump.scheme $= defConsole}
-  setPhase End    = id
-
-private
-toWidth : String -> OptAction
-toWidth s = case parsePositive s of
-  Just n  => Ok {width := n}
-  Nothing => Err "invalid width: \{show s}"
-
-private
-toHLType : String -> OptAction
-toHLType str = case toLower str of
-  "none" => Ok {hlType := NoHL}
-  "term" => Ok {hlType := Term}
-  "html" => Ok {hlType := Html}
-  _      => Err "unknown highlighting type \{show str}\ntypes: term, html, none"
-
-||| like ghc, `-i ""` clears the search path;
-||| `-i a:b:c` adds `a`, `b`, `c` to the end
-private
-dirListFlag : String -> List String -> List String
-dirListFlag ""   val = []
-dirListFlag dirs val = val ++ toList (split (== ':') dirs)
-
-private
-splitLogFlag : String -> Either String (List (Maybe LogCategory, LogLevel))
-splitLogFlag = traverse flag1 . toList . split (== ':') where
-  parseLogCategory : String -> Either String LogCategory
-  parseLogCategory cat = do
-    let Just cat = toLogCategory cat
-      | _ => let catList = joinBy ", " logCategories in
-             Left "unknown log category. categories are:\n\{catList}"
-    pure cat
-
-  parseLogLevel : String -> Either String LogLevel
-  parseLogLevel lvl = do
-    let Just lvl = parsePositive lvl
-      | _ => Left "log level \{lvl} not a number"
-    let Just lvl = toLogLevel lvl
-      | _ => Left "log level \{show lvl} out of range 0–\{show maxLogLevel}"
-    pure lvl
-
-  flag1 : String -> Either String (Maybe LogCategory, LogLevel)
-  flag1 str = do
-    let (first, second) = break (== '=') str
-    case strM second of
-      StrCons '=' lvl => do
-        cat <- parseLogCategory first
-        lvl <- parseLogLevel lvl
-        pure (Just cat, lvl)
-      StrNil => (Nothing,) <$> parseLogLevel first
-      _      => Left "invalid log flag \{str}"
-
-private
-setLogFlag : LogLevels -> (Maybe LogCategory, LogLevel) -> LogLevels
-setLogFlag lvls (Nothing,   lvl) = {defLevel := lvl} lvls
-setLogFlag lvls (Just name, lvl) = {levels $= ((name, lvl) ::)} lvls
-
-private
-logFlag : String -> OptAction
-logFlag str = case splitLogFlag str of
-  Left  err   => Err err
-  Right flags => Ok $ \o => {logLevels := foldl setLogFlag o.logLevels flags} o
-
-private
-commonOptDescrs' : List (OptDescr OptAction)
-commonOptDescrs' = [
-  MkOpt ['i'] ["include"]
-    (ReqArg (\is => Ok {include $= dirListFlag is}) "<dir>:<dir>...")
-    "add directories to look for source files",
-  MkOpt ['o'] ["output"] (ReqArg (\s => Ok {outFile := toOutFile s}) "<file>")
-    "output file (\"-\" for stdout, \"\" for no output)",
-  MkOpt ['P'] ["phase"] (ReqArg toPhase "<phase>")
-    "stop after the given phase",
-  MkOpt ['l'] ["log"] (ReqArg logFlag "[<cat>=]<n>:...")
-    "set log level",
-  MkOpt ['L'] ["log-file"] (ReqArg (\s => Ok {logFile := toOutFile s}) "<file>")
-    "set log output file"
-]
-
-private
-extraOptDescrs : List (OptDescr OptAction)
-extraOptDescrs = [
-  MkOpt [] ["unicode"] (NoArg $ Ok {flavor := Unicode})
-    "use unicode syntax when printing (default)",
-  MkOpt [] ["ascii"] (NoArg $ Ok {flavor := Ascii})
-    "use ascii syntax when printing",
-  MkOpt [] ["width"] (ReqArg toWidth "<width>")
-    "max output width (defaults to terminal width)",
-  MkOpt [] ["color", "colour"] (ReqArg toHLType "<type>")
-    "select highlighting type",
-
-  MkOpt [] ["dump-parse"]
-    (ReqArg (\s => Ok {dump.parse := toOutFile s}) "<file>")
-    "dump AST",
-  MkOpt [] ["dump-check"]
-    (ReqArg (\s => Ok {dump.check := toOutFile s}) "<file>")
-    "dump typechecker output",
-  MkOpt [] ["dump-erase"]
-    (ReqArg (\s => Ok {dump.erase := toOutFile s}) "<file>")
-    "dump erasure output",
-  MkOpt [] ["dump-scheme"]
-    (ReqArg (\s => Ok {dump.scheme := toOutFile s}) "<file>")
-    "dump scheme output (without prelude)"
-]
-
-private
-helpOptDescrs : List (OptDescr OptAction)
-helpOptDescrs = [
-  MkOpt ['h'] ["help"]     (NoArg $ ShowHelp Common) "show common options",
-  MkOpt []    ["help-all"] (NoArg $ ShowHelp All)    "show all options"
-]
-
-commonOptDescrs = commonOptDescrs' ++ helpOptDescrs
-allOptDescrs    = commonOptDescrs' ++ extraOptDescrs ++ helpOptDescrs
-
-export
-usageHeader : String
-usageHeader = trim """
-quox [options] [file.quox ...]
-rawr
-"""
-
-export
-usage : List (OptDescr _) -> IO a
-usage ds = do
-  ignore $ fPutStr stderr $ usageInfo usageHeader ds
-  exitSuccess
-
-private
-applyAction : Options -> OptAction -> IO Options
-applyAction opts (ShowHelp Common) = usage commonOptDescrs
-applyAction opts (ShowHelp All)    = usage allOptDescrs
-applyAction opts (Err err)         = die err
-applyAction opts (Ok f)            = pure $ f opts
-
-export
-options : IO (String, Options, List String)
-options = do
-  app :: args <- getArgs
-    | [] => die "couldn't get command line arguments"
-  let res = getOpt Permute allOptDescrs args
-  unless (null res.errors) $
-    die $ trim $ concat res.errors
-  unless (null res.unrecognized) $
-    die "unrecognised options: \{joinBy ", " res.unrecognized}"
-  opts <- foldlM applyAction !defaultOpts res.options
-  pure (app, opts, res.nonOptions)
diff --git a/exe/Output.idr b/exe/Output.idr
deleted file mode 100644
index 77eed61..0000000
--- a/exe/Output.idr
+++ /dev/null
@@ -1,59 +0,0 @@
-module Output
-
-import Quox.Pretty
-import Options
-
-import System.File
-import System
-
-public export
-data ConsoleChannel = COut | CErr
-
-export
-consoleHandle : ConsoleChannel -> File
-consoleHandle COut = stdout
-consoleHandle CErr = stderr
-
-public export
-data OpenFile = OConsole ConsoleChannel | OFile String File | ONone
-
-export
-toOutFile : OpenFile -> OutFile
-toOutFile (OConsole _) = Console
-toOutFile (OFile f _)  = File f
-toOutFile ONone        = NoOut
-
-export
-withFile : HasIO m => String -> (String -> FileError -> m a) ->
-           (OpenFile -> m a) -> m a
-withFile f catch act = Prelude.do
-  res <- withFile f WriteTruncate pure (Prelude.map Right . act . OFile f)
-  either (catch f) pure res
-
-export
-withOutFile : HasIO m => ConsoleChannel -> OutFile ->
-              (String -> FileError -> m a) -> (OpenFile -> m a) -> m a
-withOutFile _  (File f) catch act = withFile f catch act
-withOutFile ch Console  catch act = act $ OConsole ch
-withOutFile _  NoOut    catch act = act ONone
-
-
-
-private
-hlFor : HLType -> OutFile -> HL -> Highlight
-hlFor Guess Console = highlightSGR
-hlFor Guess _       = noHighlight
-hlFor NoHL  _       = noHighlight
-hlFor Term  _       = highlightSGR
-hlFor Html  _       = highlightHtml
-
-export
-runPretty : Options -> OutFile -> Eff Pretty a -> a
-runPretty opts file act =
-  runPrettyWith Outer opts.flavor (hlFor opts.hlType file) 2 act
-
-export
-die : HasIO io => (opts : LayoutOpts) -> Doc opts -> io a
-die opts err = do
-  ignore $ fPutStr stderr $ render opts err
-  exitFailure
diff --git a/exe/quox.ipkg b/exe/quox.ipkg
index fed30f4..e20197a 100644
--- a/exe/quox.ipkg
+++ b/exe/quox.ipkg
@@ -1,7 +1,7 @@
 package quox
 version = 0
 
-depends = base, contrib, elab-util, pretty-show, quox-lib
+depends = base, contrib, elab-util, sop, quox-lib
 
 executable = quox
 main = Main
diff --git a/golden-tests/Tests.idr b/golden-tests/Tests.idr
deleted file mode 100644
index 60c7895..0000000
--- a/golden-tests/Tests.idr
+++ /dev/null
@@ -1,15 +0,0 @@
-module Tests
-
-import Test.Golden
-import Language.Reflection
-import System
-import System.Path
-
-%language ElabReflection
-
-projDir = %runElab idrisDir ProjectDir
-testDir = projDir </> "tests"
-
-tests = testsInDir { poolName = "quox golden tests", dirName = testDir }
-
-main = runner [!tests]
diff --git a/golden-tests/quox-golden-tests.ipkg b/golden-tests/quox-golden-tests.ipkg
deleted file mode 100644
index cd89728..0000000
--- a/golden-tests/quox-golden-tests.ipkg
+++ /dev/null
@@ -1,4 +0,0 @@
-package quox-golden-tests
-depends = quox, contrib, test
-executable = quox-golden-tests
-main = Tests
diff --git a/golden-tests/run-tests.sh b/golden-tests/run-tests.sh
deleted file mode 100755
index 67d86a1..0000000
--- a/golden-tests/run-tests.sh
+++ /dev/null
@@ -1,10 +0,0 @@
-#!/bin/bash
-
-set -e
-
-quox="$PWD/../exe/build/exec/quox"
-run_tests="$PWD/build/exec/quox-golden-tests"
-test -f "$quox"      || pack build quox
-test -f "$run_tests" || pack build quox-golden-tests
-
-"$run_tests" "$quox" "$@"
diff --git a/golden-tests/tests/empty/empty.quox b/golden-tests/tests/empty/empty.quox
deleted file mode 100644
index e69de29..0000000
diff --git a/golden-tests/tests/empty/expected b/golden-tests/tests/empty/expected
deleted file mode 100644
index e69de29..0000000
diff --git a/golden-tests/tests/empty/run b/golden-tests/tests/empty/run
deleted file mode 100644
index 195c208..0000000
--- a/golden-tests/tests/empty/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-scheme "$1" empty.quox
diff --git a/golden-tests/tests/eta-singleton/eta-sing.quox b/golden-tests/tests/eta-singleton/eta-sing.quox
deleted file mode 100644
index 5ae2daf..0000000
--- a/golden-tests/tests/eta-singleton/eta-sing.quox
+++ /dev/null
@@ -1,33 +0,0 @@
--- inspired by https://github.com/agda/agda/issues/2556
-
-postulate0 A : ★
-
-def0 ZZ : ★ = 0 ≡ 0 : ℕ
-
-def reflZ : ZZ = δ _ ⇒ 0
-
-
-namespace erased {
-  def0 ZZA : ★ = 0.ZZ → A
-
-  def propeq : (x : ZZA) → x ≡ (λ _ ⇒ x reflZ) : ZZA =
-    λ x ⇒ δ _ ⇒ x
-
-  def defeq : 0.(P : ZZA → ★) → 0.(x : ZZA) → P (λ _ ⇒ x reflZ) → P x =
-    λ P x p ⇒ p
-}
-
-namespace unrestricted {
-  def0 ZZA : ★ = ω.ZZ → A
-
-  def defeq : 0.(P : ZZA → ★) → 0.(x : ZZA) → P (λ _ ⇒ x reflZ) → P x =
-    λ P x p ⇒ p
-}
-
-namespace linear {
-  def0 ZZA : ★ = 1.ZZ → A
-
-  #[fail "λ _ ⇒ x reflZ is not equal to x"]
-  def defeq : 0.(P : ZZA → ★) → 0.(x : ZZA) → P (λ _ ⇒ x reflZ) → P x =
-    λ P x p ⇒ p
-}
diff --git a/golden-tests/tests/eta-singleton/expected b/golden-tests/tests/eta-singleton/expected
deleted file mode 100644
index 271242e..0000000
--- a/golden-tests/tests/eta-singleton/expected
+++ /dev/null
@@ -1,9 +0,0 @@
-0.A : ★
-0.ZZ : ★
-ω.reflZ : ZZ
-0.erased.ZZA : ★
-ω.erased.propeq : 1.(x : erased.ZZA) → x ≡ (λ _ ⇒ x reflZ) : erased.ZZA
-ω.erased.defeq : 0.(P : 1.erased.ZZA → ★) → 0.(x : erased.ZZA) → 1.(P (λ _ ⇒ (x reflZ))) → P x
-0.unrestricted.ZZA : ★
-ω.unrestricted.defeq : 0.(P : 1.unrestricted.ZZA → ★) → 0.(x : unrestricted.ZZA) → 1.(P (λ _ ⇒ (x reflZ))) → P x
-0.linear.ZZA : ★
diff --git a/golden-tests/tests/eta-singleton/run b/golden-tests/tests/eta-singleton/run
deleted file mode 100644
index 710aa1c..0000000
--- a/golden-tests/tests/eta-singleton/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-check "$1" eta-sing.quox
diff --git a/golden-tests/tests/file-not-found/expected b/golden-tests/tests/file-not-found/expected
deleted file mode 100644
index 33ee368..0000000
--- a/golden-tests/tests/file-not-found/expected
+++ /dev/null
@@ -1,3 +0,0 @@
-no location:
-couldn't load file nonexistent.quox
-File Not Found
diff --git a/golden-tests/tests/file-not-found/run b/golden-tests/tests/file-not-found/run
deleted file mode 100644
index b164730..0000000
--- a/golden-tests/tests/file-not-found/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-check "$1" nonexistent.quox
diff --git a/golden-tests/tests/hello/expected b/golden-tests/tests/hello/expected
deleted file mode 100644
index 7aea232..0000000
--- a/golden-tests/tests/hello/expected
+++ /dev/null
@@ -1,12 +0,0 @@
-0.IO : 1.★ → ★
-ω.print : 1.String → IO {ok}
-ω.main : IO {ok}
-IO = □
-print = scheme:(lambda (str) (builtin-io (display str) (newline)))
-#[main] main = print "hello 🐉"
-;; IO erased
-(define print
-   (lambda (str) (builtin-io (display str) (newline))))
-(define main
-   (print "hello \x1f409;"))
-hello 🐉
diff --git a/golden-tests/tests/hello/hello.quox b/golden-tests/tests/hello/hello.quox
deleted file mode 100644
index 3b45067..0000000
--- a/golden-tests/tests/hello/hello.quox
+++ /dev/null
@@ -1,7 +0,0 @@
-def0 IO : ★ → ★ = λ A ⇒ IOState → A × IOState
-
-#[compile-scheme "(lambda (str) (builtin-io (display str) (newline)))"]
-postulate print : String → IO {ok}
-
-#[main]
-def main = print "hello 🐉"
diff --git a/golden-tests/tests/hello/run b/golden-tests/tests/hello/run
deleted file mode 100644
index db7f834..0000000
--- a/golden-tests/tests/hello/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-compile_run "$1" hello.quox hello.ss
diff --git a/golden-tests/tests/ill-typed-main/expected b/golden-tests/tests/ill-typed-main/expected
deleted file mode 100644
index 25498fb..0000000
--- a/golden-tests/tests/ill-typed-main/expected
+++ /dev/null
@@ -1,3 +0,0 @@
-ill-typed-main.quox:1:11-1:12:
-    when checking a function declared as #[main] has type 1.IOState → {𝑎} × IOState
-    expected a function type, but got ℕ
diff --git a/golden-tests/tests/ill-typed-main/ill-typed-main.quox b/golden-tests/tests/ill-typed-main/ill-typed-main.quox
deleted file mode 100644
index 9ead5b5..0000000
--- a/golden-tests/tests/ill-typed-main/ill-typed-main.quox
+++ /dev/null
@@ -1,2 +0,0 @@
-#[main]
-def main : ℕ = 5
diff --git a/golden-tests/tests/ill-typed-main/run b/golden-tests/tests/ill-typed-main/run
deleted file mode 100644
index 5ad1fb7..0000000
--- a/golden-tests/tests/ill-typed-main/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-check "$1" ill-typed-main.quox
diff --git a/golden-tests/tests/isprop-subsing/expected b/golden-tests/tests/isprop-subsing/expected
deleted file mode 100644
index 8fbea7a..0000000
--- a/golden-tests/tests/isprop-subsing/expected
+++ /dev/null
@@ -1,2 +0,0 @@
-0.IsProp : 1.★ → ★
-0.feq : 1.(A : ★) → 1.(f : IsProp A) → 1.(g : IsProp A) → f ≡ g : IsProp A
diff --git a/golden-tests/tests/isprop-subsing/isprop-subsing.quox b/golden-tests/tests/isprop-subsing/isprop-subsing.quox
deleted file mode 100644
index 2117d08..0000000
--- a/golden-tests/tests/isprop-subsing/isprop-subsing.quox
+++ /dev/null
@@ -1,4 +0,0 @@
-def0 IsProp : ★ → ★ = λ A ⇒ (x y : A) → x ≡ y : A
-
-def0 feq : (A : ★) → (f g : IsProp A) → f ≡ g : IsProp A =
-  λ A f g ⇒ δ _ ⇒ f
diff --git a/golden-tests/tests/isprop-subsing/run b/golden-tests/tests/isprop-subsing/run
deleted file mode 100644
index feb762b..0000000
--- a/golden-tests/tests/isprop-subsing/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-check "$1" isprop-subsing.quox
diff --git a/golden-tests/tests/it-5/expected b/golden-tests/tests/it-5/expected
deleted file mode 100644
index 3644760..0000000
--- a/golden-tests/tests/it-5/expected
+++ /dev/null
@@ -1,4 +0,0 @@
-ω.five : ℕ
-five = 5
-(define five
-   5)
diff --git a/golden-tests/tests/it-5/five.quox b/golden-tests/tests/it-5/five.quox
deleted file mode 100644
index 365c1a7..0000000
--- a/golden-tests/tests/it-5/five.quox
+++ /dev/null
@@ -1 +0,0 @@
-def five : ℕ = 5
diff --git a/golden-tests/tests/it-5/run b/golden-tests/tests/it-5/run
deleted file mode 100644
index bb90a15..0000000
--- a/golden-tests/tests/it-5/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-scheme "$1" five.quox
diff --git a/golden-tests/tests/lib.sh b/golden-tests/tests/lib.sh
deleted file mode 100644
index 7dbfb7b..0000000
--- a/golden-tests/tests/lib.sh
+++ /dev/null
@@ -1,18 +0,0 @@
-FLAGS="--dump-check - --dump-erase - --dump-scheme - --color=none --width=100000"
-
-check() {
-  $1 $FLAGS "$2" -P check 2>&1
-}
-
-erase() {
-  $1 $FLAGS "$2" -P erase 2>&1
-}
-
-scheme() {
-  $1 $FLAGS "$2" -P scheme 2>&1
-}
-
-compile_run() {
-  $1 $FLAGS "$2" -o "$3" 2>&1
-  chezscheme --program "$3"
-}
diff --git a/golden-tests/tests/load/expected b/golden-tests/tests/load/expected
deleted file mode 100644
index b7dd6c9..0000000
--- a/golden-tests/tests/load/expected
+++ /dev/null
@@ -1,16 +0,0 @@
-0.lib.IO : 1.★ → ★
-ω.lib.print : 1.String → lib.IO {ok}
-ω.lib.main : lib.IO {ok}
-ω.main : lib.IO {ok}
-lib.IO = □
-lib.print = scheme:(lambda (str) (builtin-io (display str) (newline)))
-lib.main = lib.print "hello 🐉"
-#[main] main = lib.main
-;; lib.IO erased
-(define lib.print
-   (lambda (str) (builtin-io (display str) (newline))))
-(define lib.main
-   (lib.print "hello \x1f409;"))
-(define main
-   lib.main)
-hello 🐉
diff --git a/golden-tests/tests/load/lib.quox b/golden-tests/tests/load/lib.quox
deleted file mode 100644
index 5ba4344..0000000
--- a/golden-tests/tests/load/lib.quox
+++ /dev/null
@@ -1,8 +0,0 @@
-namespace lib {
-def0 IO : ★ → ★ = λ A ⇒ IOState → A × IOState
-
-#[compile-scheme "(lambda (str) (builtin-io (display str) (newline)))"]
-postulate print : String → IO {ok}
-
-def main = print "hello 🐉"
-}
diff --git a/golden-tests/tests/load/main.quox b/golden-tests/tests/load/main.quox
deleted file mode 100644
index c53d261..0000000
--- a/golden-tests/tests/load/main.quox
+++ /dev/null
@@ -1,4 +0,0 @@
-load "lib.quox"
-
-#[main]
-def main = lib.main
diff --git a/golden-tests/tests/load/run b/golden-tests/tests/load/run
deleted file mode 100644
index 677a01b..0000000
--- a/golden-tests/tests/load/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-compile_run "$1" main.quox load.ss
diff --git a/golden-tests/tests/regularity/expected b/golden-tests/tests/regularity/expected
deleted file mode 100644
index 5b9502a..0000000
--- a/golden-tests/tests/regularity/expected
+++ /dev/null
@@ -1 +0,0 @@
-0.reggie : 1.(A : ★) → 1.(AA : A ≡ A : ★) → 1.(s : A) → 1.(P : 1.A → ★) → 1.(P (coe (𝑖 ⇒ AA @𝑖) @0 @1 s)) → P s
diff --git a/golden-tests/tests/regularity/regularity.quox b/golden-tests/tests/regularity/regularity.quox
deleted file mode 100644
index 9a06dc7..0000000
--- a/golden-tests/tests/regularity/regularity.quox
+++ /dev/null
@@ -1,12 +0,0 @@
--- this definition depends on coercion regularity in xtt. which is this
--- (adapted to quox):
---
---           Ψ | Γ ⊢ 0 · A‹0/𝑖› = A‹1/𝑖› ⇐ ★
--- ---------------------------------------------------------
---  Ψ | Γ ⊢ π · coe (𝑖 ⇒ A) @p @q s ⇝ (s ∷ A‹1/𝑖›) ⇒ A‹1/𝑖›
---
--- otherwise, the types P (coe ⋯ s) and P s are incompatible
-
-def0 reggie : (A : ★) → (AA : A ≡ A : ★) → (s : A) →
-              (P : A → ★) → P (coe (𝑖 ⇒ AA @𝑖) s) → P s =
-  λ A AA s P p ⇒ p
diff --git a/golden-tests/tests/regularity/run b/golden-tests/tests/regularity/run
deleted file mode 100644
index cbfda48..0000000
--- a/golden-tests/tests/regularity/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-check "$1" regularity.quox
diff --git a/golden-tests/tests/useless-coe/coe.quox b/golden-tests/tests/useless-coe/coe.quox
deleted file mode 100644
index 85da306..0000000
--- a/golden-tests/tests/useless-coe/coe.quox
+++ /dev/null
@@ -1,9 +0,0 @@
--- non-dependent coe should reduce to its body
-
-def five  : ℕ = 5
-def five? : ℕ = coe ℕ 5
-
-def eq : five ≡ five? : ℕ = δ _ ⇒ 5
-
-def subst1 : 0.(P : ℕ → ★) → P five  → P five? = λ P p ⇒ p
-def subst2 : 0.(P : ℕ → ★) → P five? → P five  = λ P p ⇒ p
diff --git a/golden-tests/tests/useless-coe/expected b/golden-tests/tests/useless-coe/expected
deleted file mode 100644
index b0b14ce..0000000
--- a/golden-tests/tests/useless-coe/expected
+++ /dev/null
@@ -1,5 +0,0 @@
-ω.five : ℕ
-ω.five? : ℕ
-ω.eq : five ≡ five? : ℕ
-ω.subst1 : 0.(P : 1.ℕ → ★) → 1.(P five) → P five?
-ω.subst2 : 0.(P : 1.ℕ → ★) → 1.(P five?) → P five
diff --git a/golden-tests/tests/useless-coe/run b/golden-tests/tests/useless-coe/run
deleted file mode 100644
index aba005b..0000000
--- a/golden-tests/tests/useless-coe/run
+++ /dev/null
@@ -1,2 +0,0 @@
-. ../lib.sh
-check "$1" coe.quox
diff --git a/lib/Control/Monad/ST/Extra.idr b/lib/Control/Monad/ST/Extra.idr
deleted file mode 100644
index 7ddeef1..0000000
--- a/lib/Control/Monad/ST/Extra.idr
+++ /dev/null
@@ -1,82 +0,0 @@
-module Control.Monad.ST.Extra
-
-import public Control.Monad.ST
-import Data.IORef
-import Control.MonadRec
-
-%default total
-
-export %inline
-MonadRec (ST s) where
-  tailRecM seed (Access rec) st f = MkST $ do
-    let MkST io = f seed st
-    case !io of
-      Done res           => pure res
-      Cont seed2 prf vst =>
-        let MkST io = tailRecM seed2 (rec seed2 prf) vst f in io
-
-
-public export
-interface HasST (0 m : Type -> Type -> Type) where
-  liftST : ST s a -> m s a
-
-export %inline HasST ST where liftST = id
-
-
-public export
-record STErr e s a where
-  constructor STE
-  fromSTErr : ST s (Either e a)
-
-export
-Functor (STErr e s) where
-  map f (STE e) = STE $ map f <$> e
-
-export
-Applicative (STErr e s) where
-  pure x = STE $ pure $ pure x
-  STE f <*> STE x = STE [|f <*> x|]
-
-export
-Monad (STErr e s) where
-  STE m >>= k = STE $ do
-    case !m of
-      Left  err => pure $ Left err
-      Right x   => fromSTErr $ k x
-
-export
-MonadRec (STErr e s) where
-  tailRecM s (Access r) x k = STE $ do
-    let STE m = k s x
-    case !m of
-      Left  err           => pure $ Left err
-      Right (Cont s' p y) => fromSTErr $ tailRecM s' (r s' p) y k
-      Right (Done y)      => pure $ Right y
-
-export
-runSTErr : (forall s. STErr e s a) -> Either e a
-runSTErr ste = runST $ fromSTErr ste
-
-export %inline HasST (STErr e) where liftST = STE . map Right
-
-export
-stLeft : e -> STErr e s a
-stLeft e = STE $ pure $ Left e
-
-
-parameters {auto _ : HasST m}
-  export %inline
-  newSTRef' : a -> m s (STRef s a)
-  newSTRef' x = liftST $ newSTRef x
-
-  export %inline
-  readSTRef' : STRef s a -> m s a
-  readSTRef' r = liftST $ readSTRef r
-
-  export %inline
-  writeSTRef' : STRef s a -> a -> m s ()
-  writeSTRef' r x = liftST $ writeSTRef r x
-
-  export %inline
-  modifySTRef' : STRef s a -> (a -> a) -> m s ()
-  modifySTRef' r f = liftST $ modifySTRef r f
diff --git a/lib/Quox/BoolExtra.idr b/lib/Quox/BoolExtra.idr
index 7a34ac1..69a7495 100644
--- a/lib/Quox/BoolExtra.idr
+++ b/lib/Quox/BoolExtra.idr
@@ -3,8 +3,8 @@ module Quox.BoolExtra
 import public Data.Bool
 
 
-export infixr 5 `andM`
-export infixr 4 `orM`
+infixr 5 `andM`
+infixr 4 `orM`
 
 public export
 andM, orM : Monad m => m Bool -> m Bool -> m Bool
diff --git a/lib/Quox/CharExtra.idr b/lib/Quox/CharExtra.idr
index 48c1fab..a2a05a3 100644
--- a/lib/Quox/CharExtra.idr
+++ b/lib/Quox/CharExtra.idr
@@ -166,10 +166,3 @@ isWhitespace ch = ch == '\t' || ch == '\r' || ch == '\n' || isSeparator ch
 export
 %foreign "scheme:string-normalize-nfc"
 normalizeNfc : String -> String
-
-
-export
-isCodepoint : Int -> Bool
-isCodepoint n =
-  n <= 0x10FFFF &&
-  not (n >= 0xD800 && n <= 0xDBFF || n >= 0xDC00 && n <= 0xDFFF)
diff --git a/lib/Quox/CheckBuiltin.idr b/lib/Quox/CheckBuiltin.idr
deleted file mode 100644
index 44b4f08..0000000
--- a/lib/Quox/CheckBuiltin.idr
+++ /dev/null
@@ -1,33 +0,0 @@
-||| check that special functions (e.g. `main`) have the expected type
-module Quox.CheckBuiltin
-
-import Quox.Syntax
-import Quox.Typing
-import Quox.Whnf
-
-%default total
-
-
-export covering
-expectSingleEnum : Definitions -> TyContext d n -> SQty -> Loc ->
-                   Term d n -> Eff Whnf ()
-expectSingleEnum defs ctx sg loc s = do
-  let err = delay $ ExpectedSingleEnum loc ctx.names s
-  cases <- wrapErr (const err) $ expectEnum defs ctx sg loc s
-  unless (length (SortedSet.toList cases) == 1) $ throw err
-
-||| `main` should have a type `1.IOState → {𝑎} × IOState`,
-||| for some (single) tag `𝑎`
-export covering
-expectMainType : Definitions -> Term 0 0 -> Eff Whnf ()
-expectMainType defs ty =
-  wrapErr (WrongBuiltinType Main) $ do
-    let ctx = TyContext.empty
-    (qty, arg, res) <- expectPi defs ctx SZero ty.loc ty
-    expectEqualQ ty.loc qty One
-    expectIOState defs ctx SZero arg.loc arg
-    let ctx = extendTy qty res.name arg ctx
-    (ret, st) <- expectSig defs ctx SZero res.loc res.term
-    expectSingleEnum defs ctx SZero ret.loc ret
-    let ctx = extendTy qty st.name ret ctx
-    expectIOState defs ctx SZero st.loc st.term
diff --git a/lib/Quox/Context.idr b/lib/Quox/Context.idr
index 97daabd..b1a9376 100644
--- a/lib/Quox/Context.idr
+++ b/lib/Quox/Context.idr
@@ -6,7 +6,6 @@ import Quox.Name
 
 import Data.DPair
 import Data.Nat
-import Data.Singleton
 import Data.SnocList
 import Data.SnocVect
 import Data.Vect
@@ -58,7 +57,6 @@ public export
 tail : Context tm (S n) -> Context tm n
 tail = fst . unsnoc
 
-
 parameters {0 tm : Nat -> Type} (f : forall n. tm n -> a)
   export
   toSnocListWith : Telescope tm _ _ -> SnocList a
@@ -109,17 +107,10 @@ fromSnocVect [<]       = [<]
 fromSnocVect (sx :< x) = fromSnocVect sx :< x
 
 
-public export
-tabulateLT : (n : Nat) -> ((i : Nat) -> (0 p : i `LT` n) => tm i) ->
-             Context tm n
-tabulateLT 0     f = [<]
-tabulateLT (S k) f =
-  tabulateLT k (\i => f i @{lteSuccRight %search}) :< f k @{reflexive}
-
 public export
 tabulate : ((n : Nat) -> tm n) -> (n : Nat) -> Context tm n
-tabulate f n = tabulateLT n (\i => f i)
--- [todo] fixup argument order lol
+tabulate f 0     = [<]
+tabulate f (S k) = tabulate f k :< f k
 
 public export
 replicate : (n : Nat) -> a -> Context' a n
@@ -158,12 +149,12 @@ getWith : (forall from, to. tm from -> Shift from to -> tm to) ->
           Context tm len -> Var len -> tm len
 getWith shft = getShiftWith shft SZ
 
-export infixl 8 !!
+infixl 8 !!
 public export %inline
 (!!) : CanShift tm => Context tm len -> Var len -> tm len
 (!!) = getWith (//)
 
-export infixl 8 !!!
+infixl 8 !!!
 public export %inline
 (!!!) : Context' tm len -> Var len -> tm
 (!!!) = getWith const
@@ -189,12 +180,6 @@ export %hint
 succGT = LTESucc reflexive
 
 
-public export
-drop : (m : Nat) -> Context term (m + n) -> Context term n
-drop 0     ctx        = ctx
-drop (S m) (ctx :< _) = drop m ctx
-
-
 parameters {auto _ : Applicative f}
   export
   traverse : (forall n. tm1 n -> f (tm2 n)) ->
@@ -206,7 +191,7 @@ parameters {auto _ : Applicative f}
   traverse' : (a -> f b) -> Telescope' a from to -> f (Telescope' b from to)
   traverse' f = traverse f
 
-  export infixl 3 `app`
+  infixl 3 `app`
   ||| like `(<*>)` but with effects
   export
   app : Telescope (\n => tm1 n -> f (tm2 n)) from to ->
@@ -273,17 +258,16 @@ unzip3 (tel :< (x, y, z)) =
 
 
 public export
-lengthPrf : Telescope _ from to -> Subset Nat (\len => len + from = to)
-lengthPrf [<]        = Element 0 Refl
+lengthPrf : Telescope _ from to -> (len ** len + from = to)
+lengthPrf [<]        = (0 ** Refl)
 lengthPrf (tel :< _) =
-  let len = lengthPrf tel in Element (S len.fst) (cong S len.snd)
+  let len = lengthPrf tel in (S len.fst ** cong S len.snd)
 
 export
-lengthPrf0 : Context _ to -> Singleton to
+lengthPrf0 : Context _ to -> (len ** len = to)
 lengthPrf0 ctx =
-  let Element len prf = lengthPrf ctx in
-  rewrite sym prf `trans` plusZeroRightNeutral len in
-  [|len|]
+  let len = lengthPrf ctx in
+  (len.fst ** rewrite sym $ plusZeroRightNeutral len.fst in len.snd)
 
 public export %inline
 length : Telescope {} -> Nat
@@ -302,10 +286,6 @@ foldl : {0 acc : Nat -> Type} ->
 foldl f z [<]        = z
 foldl f z (tel :< t) = f (foldl f z tel) (rewrite (lengthPrf tel).snd in t)
 
-export %inline
-foldl_ : (acc -> tm -> acc) -> acc -> Telescope' tm from to -> acc
-foldl_ f z tel = foldl f z tel
-
 export %inline
 foldMap : Monoid a => (forall n. tm n -> a) -> Telescope tm from to -> a
 foldMap f = foldl (\acc, tm => acc <+> f tm) neutral
@@ -365,4 +345,4 @@ parameters {opts : LayoutOpts} {0 tm : Nat -> Type}
 namespace BContext
   export
   toNames : BContext n -> SnocList BaseName
-  toNames = foldl (\xs, x => xs :< x.val) [<]
+  toNames = foldl (\xs, x => xs :< x.name) [<]
diff --git a/lib/Quox/Definition.idr b/lib/Quox/Definition.idr
index 900536d..693012a 100644
--- a/lib/Quox/Definition.idr
+++ b/lib/Quox/Definition.idr
@@ -2,12 +2,9 @@ module Quox.Definition
 
 import public Quox.No
 import public Quox.Syntax
-import Quox.Displace
 import public Data.SortedMap
 import public Quox.Loc
-import Quox.Pretty
 import Control.Eff
-import Data.Singleton
 import Decidable.Decidable
 
 
@@ -26,24 +23,18 @@ namespace DefBody
 public export
 record Definition where
   constructor MkDef
-  qty    : GQty
-  type0  : Term 0 0
-  body0  : DefBody
-  scheme : Maybe String
-  isMain : Bool
-  loc_   : Loc
+  qty   : GQty
+  type0 : Term 0 0
+  body0 : DefBody
+  loc_  : Loc
 
 public export %inline
-mkPostulate : GQty -> (type0 : Term 0 0) -> Maybe String -> Bool -> Loc ->
-              Definition
-mkPostulate qty type0 scheme isMain loc_ =
-  MkDef {qty, type0, body0 = Postulate, scheme, isMain, loc_}
+mkPostulate : GQty -> (type0 : Term 0 0) -> Loc -> Definition
+mkPostulate qty type0 loc_ = MkDef {qty, type0, body0 = Postulate, loc_}
 
 public export %inline
-mkDef : GQty -> (type0, term0 : Term 0 0) -> Maybe String -> Bool -> Loc ->
-        Definition
-mkDef qty type0 term0 scheme isMain loc_ =
-  MkDef {qty, type0, body0 = Concrete term0, scheme, isMain, loc_}
+mkDef : GQty -> (type0, term0 : Term 0 0) -> Loc -> Definition
+mkDef qty type0 term0 loc_ = MkDef {qty, type0, body0 = Concrete term0, loc_}
 
 export Located Definition where def.loc = def.loc_
 export Relocatable Definition where setLoc loc = {loc_ := loc}
@@ -54,51 +45,27 @@ parameters {d, n : Nat}
   (.type) : Definition -> Term d n
   g.type = g.type0 // shift0 d // shift0 n
 
-  public export %inline
-  (.typeAt) : Definition -> Universe -> Term d n
-  g.typeAt u = displace u g.type
-
   public export %inline
   (.term) : Definition -> Maybe (Term d n)
   g.term = g.body0.term0 <&> \t => t // shift0 d // shift0 n
 
   public export %inline
-  (.termAt) : Definition -> Universe -> Maybe (Term d n)
-  g.termAt u = displace u <$> g.term
-
-  public export %inline
-  toElim : Definition -> Universe -> Maybe $ Elim d n
-  toElim def u = pure $ Ann !(def.termAt u) (def.typeAt u) def.loc
-
-public export
-(.typeWith) : Definition -> Singleton d -> Singleton n -> Term d n
-g.typeWith (Val d) (Val n) = g.type
-
-public export
-(.typeWithAt) : Definition -> Singleton d -> Singleton n -> Universe -> Term d n
-g.typeWithAt d n u = displace u $ g.typeWith d n
-
-public export
-(.termWith) : Definition -> Singleton d -> Singleton n -> Maybe (Term d n)
-g.termWith (Val d) (Val n) = g.term
+  toElim : Definition -> Maybe $ Elim d n
+  toElim def = pure $ Ann !def.term def.type def.loc
 
 
 public export %inline
 isZero : Definition -> Bool
-isZero g = g.qty == GZero
+isZero g = g.qty.fst == Zero
 
 
 public export
-NDefinition : Type
-NDefinition = (Name, Definition)
+data DefEnvTag = DEFS
 
 public export
 Definitions : Type
 Definitions = SortedMap Name Definition
 
-public export
-data DefEnvTag = DEFS
-
 public export
 DefsReader : Type -> Type
 DefsReader = ReaderL DEFS Definitions
@@ -107,21 +74,7 @@ public export
 DefsState : Type -> Type
 DefsState = StateL DEFS Definitions
 
-public export %inline
-lookupElim : {d, n : Nat} -> Name -> Universe -> Definitions -> Maybe (Elim d n)
-lookupElim x u defs = toElim !(lookup x defs) u
 
 public export %inline
-lookupElim0 : Name -> Universe -> Definitions -> Maybe (Elim 0 0)
-lookupElim0 = lookupElim
-
-
-export
-prettyDef : {opts : LayoutOpts} -> Name -> Definition -> Eff Pretty (Doc opts)
-prettyDef name def = withPrec Outer $ do
-  qty   <- prettyQty def.qty.qty
-  dot   <- dotD
-  name  <- prettyFree name
-  colon <- colonD
-  type  <- prettyTerm [<] [<] def.type
-  hangDSingle (hsep [hcat [qty, dot, name], colon]) type
+lookupElim : {d, n : Nat} -> Name -> Definitions -> Maybe (Elim d n)
+lookupElim x defs = toElim !(lookup x defs)
diff --git a/lib/Quox/Displace.idr b/lib/Quox/Displace.idr
index 6f8e1ed..5d3b2fb 100644
--- a/lib/Quox/Displace.idr
+++ b/lib/Quox/Displace.idr
@@ -2,8 +2,6 @@ module Quox.Displace
 
 import Quox.Syntax
 
-%default total
-
 
 parameters (k : Universe)
   namespace Term
@@ -16,29 +14,27 @@ parameters (k : Universe)
 
   namespace Term
     doDisplace (TYPE l loc) = TYPE (k + l) loc
-    doDisplace (IOState loc) = IOState loc
     doDisplace (Pi qty arg res loc) =
       Pi qty (doDisplace arg) (doDisplaceS res) loc
     doDisplace (Lam body loc) = Lam (doDisplaceS body) loc
     doDisplace (Sig fst snd loc) = Sig (doDisplace fst) (doDisplaceS snd) loc
     doDisplace (Pair fst snd loc) = Pair (doDisplace fst) (doDisplace snd) loc
+    doDisplace (W shape body loc) =
+      W (doDisplace shape) (doDisplaceS body) loc
+    doDisplace (Sup root sub loc) = Sup (doDisplace root) (doDisplace sub) loc
     doDisplace (Enum cases loc) = Enum cases loc
     doDisplace (Tag tag loc) = Tag tag loc
     doDisplace (Eq ty l r loc) =
       Eq (doDisplaceDS ty) (doDisplace l) (doDisplace r) loc
     doDisplace (DLam body loc) = DLam (doDisplaceDS body) loc
-    doDisplace (NAT loc) = NAT loc
-    doDisplace (Nat n loc) = Nat n loc
+    doDisplace (Nat loc) = Nat loc
+    doDisplace (Zero loc) = Zero loc
     doDisplace (Succ p loc) = Succ (doDisplace p) loc
-    doDisplace (STRING loc) = STRING loc
-    doDisplace (Str s loc) = Str s loc
     doDisplace (BOX qty ty loc) = BOX qty (doDisplace ty) loc
     doDisplace (Box val loc) = Box (doDisplace val) loc
-    doDisplace (Let qty rhs body loc) =
-      Let qty (doDisplace rhs) (doDisplaceS body) loc
     doDisplace (E e) = E (doDisplace e)
     doDisplace (CloT (Sub t th)) =
-      CloT (Sub (doDisplace t) (assert_total $ map doDisplace th))
+      CloT (Sub (doDisplace t) (map doDisplace th))
     doDisplace (DCloT (Sub t th)) =
       DCloT (Sub (doDisplace t) th)
 
@@ -54,11 +50,10 @@ parameters (k : Universe)
     doDisplace (App fun arg loc) = App (doDisplace fun) (doDisplace arg) loc
     doDisplace (CasePair qty pair ret body loc) =
       CasePair qty (doDisplace pair) (doDisplaceS ret) (doDisplaceS body) loc
-    doDisplace (Fst pair loc) = Fst (doDisplace pair) loc
-    doDisplace (Snd pair loc) = Snd (doDisplace pair) loc
+    doDisplace (CaseW qty qtyIH tree ret body loc) =
+      CaseW qty qtyIH (doDisplace tree) (doDisplaceS ret) (doDisplaceS body) loc
     doDisplace (CaseEnum qty tag ret arms loc) =
-      CaseEnum qty (doDisplace tag) (doDisplaceS ret)
-               (assert_total $ map doDisplace arms) loc
+      CaseEnum qty (doDisplace tag) (doDisplaceS ret) (map doDisplace arms) loc
     doDisplace (CaseNat qty qtyIH nat ret zero succ loc) =
       CaseNat qty qtyIH (doDisplace nat) (doDisplaceS ret)
               (doDisplace zero) (doDisplaceS succ) loc
@@ -75,9 +70,9 @@ parameters (k : Universe)
            (doDisplaceDS zero) (doDisplaceDS one) loc
     doDisplace (TypeCase ty ret arms def loc) =
       TypeCase (doDisplace ty) (doDisplace ret)
-               (assert_total $ map doDisplaceS arms) (doDisplace def) loc
+               (map doDisplaceS arms) (doDisplace def) loc
     doDisplace (CloE (Sub e th)) =
-      CloE (Sub (doDisplace e) (assert_total $ map doDisplace th))
+      CloE (Sub (doDisplace e) (map doDisplace th))
     doDisplace (DCloE (Sub e th)) =
       DCloE (Sub (doDisplace e) th)
 
diff --git a/lib/Quox/EffExtra.idr b/lib/Quox/EffExtra.idr
index 4090553..49479a3 100644
--- a/lib/Quox/EffExtra.idr
+++ b/lib/Quox/EffExtra.idr
@@ -2,7 +2,6 @@ module Quox.EffExtra
 
 import public Control.Eff
 
-import Control.Monad.ST.Extra
 import Data.IORef
 
 
@@ -27,40 +26,68 @@ local_ : Has (State s) fs => s -> Eff fs a -> Eff fs a
 local_ = localAt_ ()
 
 
-export %inline
-getsAt : (0 lbl : tag) -> Has (StateL lbl s) fs => (s -> a) -> Eff fs a
-getsAt lbl f = f <$> getAt lbl
+public export
+record StateRes s a where
+  constructor SR
+  state  : s
+  result : a
+
+export
+stateAt : (0 lbl : tag) -> Has (StateL lbl s) fs =>
+          (s -> StateRes s a) -> Eff fs a
+stateAt lbl f = do
+  s <- getAt lbl
+  let out = f s
+  putAt lbl out.state
+  pure out.result
 
 export %inline
-gets : Has (State s) fs => (s -> a) -> Eff fs a
-gets = getsAt ()
-
-
-export %inline
-stateAt : (0 lbl : tag) -> Has (StateL lbl s) fs => (s -> (a, s)) -> Eff fs a
-stateAt lbl f = do (res, x) <- getsAt lbl f; putAt lbl x $> res
-
-export %inline
-state : Has (State s) fs => (s -> (a, s)) -> Eff fs a
+state : Has (State s) fs => (s -> StateRes s a) -> Eff fs a
 state = stateAt ()
 
 
 export
-handleStateIORef : HasIO m => IORef st -> StateL lbl st a -> m a
-handleStateIORef r Get     = readIORef r
-handleStateIORef r (Put s) = writeIORef r s
+hasDrop : (0 neq : Not (a = b)) ->
+          (ha : Has a fs) => (hb : Has b fs) =>
+          Has a (drop fs hb)
+hasDrop neq {ha = Z}    {hb = Z}    = void $ neq Refl
+hasDrop neq {ha = S ha} {hb = Z}    = ha
+hasDrop neq {ha = Z}    {hb = S hb} = Z
+hasDrop neq {ha = S ha} {hb = S hb} = S $ hasDrop neq {ha, hb}
+
+private
+0 ioNotState : Not (IO = StateL _ _)
+ioNotState Refl impossible
 
 export
-handleStateSTRef : HasST m => STRef s st -> StateL lbl st a -> m s a
-handleStateSTRef r Get     = liftST $ readSTRef r
-handleStateSTRef r (Put s) = liftST $ writeSTRef r s
+runStateIORefAt : (0 lbl : tag) -> (Has IO fs, Has (StateL lbl s) fs) =>
+                  IORef s -> Eff fs a -> Eff (fs - StateL lbl s) a
+runStateIORefAt lbl ref act = do
+  let hh : Has IO (fs - StateL lbl s) := hasDrop ioNotState
+  (val, st) <- runStateAt lbl !(readIORef ref) act
+  writeIORef ref st $> val
+
+export %inline
+runStateIORef : (Has IO fs, Has (State s) fs) =>
+                IORef s -> Eff fs a -> Eff (fs - State s) a
+runStateIORef = runStateIORefAt ()
+
+
+export %inline
+evalStateAt : (0 lbl : tag) -> Has (StateL lbl s) fs =>
+              s -> Eff fs a -> Eff (fs - StateL lbl s) a
+evalStateAt lbl s act = map fst $ runStateAt lbl s act
+
+export %inline
+evalState : Has (State s) fs => s -> Eff fs a -> Eff (fs - State s) a
+evalState = evalStateAt ()
+
 
 
 public export
 data Length : List a -> Type where
   Z : Length []
   S : Length xs -> Length (x :: xs)
-%builtin Natural Length
 
 export
 subsetWith : Length xs => (forall z. Has z xs -> Has z ys) ->
@@ -73,77 +100,23 @@ subsetSelf : Length xs => Subset xs xs
 subsetSelf = subsetWith id
 
 export
-subsetTail : Length xs => (0 x : a) -> Subset xs (x :: xs)
-subsetTail _ = subsetWith S
-
+subsetTail : Length xs => Subset xs (x :: xs)
+subsetTail = subsetWith S
 
 
+-- [fixme] allow the error to be anywhere in the effect list
 export
-rethrowAtWith : (0 lbl : tag) -> Has (ExceptL lbl e') fs =>
-                (e -> e') -> Either e a -> Eff fs a
-rethrowAtWith lbl f = rethrowAt lbl . mapFst f
-
-export
-rethrowWith : Has (Except e') fs => (e -> e') -> Either e a -> Eff fs a
-rethrowWith = rethrowAtWith ()
-
-export
-wrapErr : Length fs => (e -> e') ->
-          Eff (ExceptL lbl e  :: fs) a ->
-          Eff (ExceptL lbl e' :: fs) a
-wrapErr f act =
-  catchAt lbl (throwAt lbl . f) @{S Z} $
-  lift @{subsetTail _} act
-
-
-export
-handleExcept : Functor m => (forall c. e -> m c) -> ExceptL lbl e a -> m a
-handleExcept thr (Err e) = thr e
-
-
-export
-handleReaderConst : Applicative m => r -> ReaderL lbl r a -> m a
-handleReaderConst x Ask = pure x
-
-export
-handleWriterSTRef : HasST m => STRef s (SnocList w) -> WriterL lbl w a -> m s a
-handleWriterSTRef ref (Tell w) = liftST $ modifySTRef ref (:< w)
-
-
-public export
-record IOErr e a where
-  constructor IOE
-  fromIOErr : IO (Either e a)
-
-export
-Functor (IOErr e) where
-  map f (IOE e) = IOE $ map f <$> e
-
-export
-Applicative (IOErr e) where
-  pure x = IOE $ pure $ pure x
-  IOE f <*> IOE x = IOE [|f <*> x|]
-
-export
-Monad (IOErr e) where
-  IOE m >>= k = IOE $ do
-    case !m of
-      Left  err => pure $ Left err
-      Right x   => fromIOErr $ k x
-
-export
-MonadRec (IOErr e) where
-  tailRecM s (Access r) x k = IOE $ do
-    let IOE m = k s x
-    case !m of
-      Left  err           => pure $ Left err
-      Right (Cont s' p y) => fromIOErr $ tailRecM s' (r s' p) y k
-      Right (Done y)      => pure $ Right y
-
-export
-HasIO (IOErr e) where
-  liftIO = IOE . map Right
+wrapErrAt : Length fs => (0 lbl : tag) -> (e -> e) ->
+            Eff (ExceptL lbl e :: fs) a -> Eff (ExceptL lbl e :: fs) a
+wrapErrAt lbl f act =
+  rethrowAt lbl . mapFst f =<< lift @{subsetTail} (runExceptAt lbl act)
 
 export %inline
-ioLeft : e -> IOErr e a
-ioLeft = IOE . pure . Left
+wrapErr : Length fs => (e -> e) ->
+          Eff (Except e :: fs) a -> Eff (Except e :: fs) a
+wrapErr = wrapErrAt ()
+
+
+export %inline
+runIO : (MonadRec io, HasIO io) => Eff [IO] a -> io a
+runIO act = runEff act [liftIO]
diff --git a/lib/Quox/Equal.idr b/lib/Quox/Equal.idr
index 5ac02b2..91a612a 100644
--- a/lib/Quox/Equal.idr
+++ b/lib/Quox/Equal.idr
@@ -2,13 +2,8 @@ module Quox.Equal
 
 import Quox.BoolExtra
 import public Quox.Typing
-import Quox.FreeVars
-import Quox.Pretty
-import Quox.EffExtra
-
-import Data.List1
 import Data.Maybe
-import Data.Either
+import Quox.EffExtra
 
 %default total
 
@@ -18,34 +13,59 @@ EqModeState : Type -> Type
 EqModeState = State EqMode
 
 public export
-Equal : List (Type -> Type)
-Equal = [ErrorEff, DefsReader, NameGen, Log]
+Equal : Type -> Type
+Equal = Eff [ErrorEff, DefsReader, NameGen]
 
 public export
-EqualInner : List (Type -> Type)
-EqualInner = [ErrorEff, NameGen, EqModeState, Log]
+Equal_ : Type -> Type
+Equal_ = Eff [ErrorEff, NameGen, EqModeState]
+
+export
+runEqualWith_ : EqMode -> NameSuf -> Equal_ a -> (Either Error a, NameSuf)
+runEqualWith_ mode suf act =
+  extract $
+  runNameGenWith suf $
+  runExcept $
+  evalState mode act
+
+export
+runEqual_ : EqMode -> Equal_ a -> Either Error a
+runEqual_ mode act = fst $ runEqualWith_ mode 0 act
+
+
+export
+runEqualWith : NameSuf -> Definitions -> Equal a -> (Either Error a, NameSuf)
+runEqualWith suf defs act =
+  extract $
+  runStateAt GEN suf $
+  runReaderAt DEFS defs $
+  runExcept act
+
+export
+runEqual : Definitions -> Equal a -> Either Error a
+runEqual defs act = fst $ runEqualWith 0 defs act
 
 
 export %inline
 mode : Has EqModeState fs => Eff fs EqMode
 mode = get
 
-private %inline
-withEqual : Has EqModeState fs => Eff fs a -> Eff fs a
-withEqual = local_ Equal
-
 
 parameters (loc : Loc) (ctx : EqContext n)
   private %inline
-  clashT : Term 0 n -> Term 0 n -> Term 0 n -> Eff EqualInner a
+  clashT : Term 0 n -> Term 0 n -> Term 0 n -> Equal_ a
   clashT ty s t = throw $ ClashT loc ctx !mode ty s t
 
   private %inline
-  clashTy : Term 0 n -> Term 0 n -> Eff EqualInner a
+  clashTy : Term 0 n -> Term 0 n -> Equal_ a
   clashTy s t = throw $ ClashTy loc ctx !mode s t
 
   private %inline
-  wrongType : Term 0 n -> Term 0 n -> Eff EqualInner a
+  clashE : Elim 0 n -> Elim 0 n -> Equal_ a
+  clashE e f = throw $ ClashE loc ctx !mode e f
+
+  private %inline
+  wrongType : Term 0 n -> Term 0 n -> Equal_ a
   wrongType ty s = throw $ WrongType loc ctx ty s
 
 
@@ -53,923 +73,689 @@ public export %inline
 sameTyCon : (s, t : Term d n) ->
             (0 ts : So (isTyConE s)) => (0 tt : So (isTyConE t)) =>
             Bool
-sameTyCon (TYPE    {}) (TYPE    {}) = True
-sameTyCon (TYPE    {}) _            = False
-sameTyCon (IOState {}) (IOState {}) = True
-sameTyCon (IOState {}) _            = False
-sameTyCon (Pi      {}) (Pi      {}) = True
-sameTyCon (Pi      {}) _            = False
-sameTyCon (Sig     {}) (Sig     {}) = True
-sameTyCon (Sig     {}) _            = False
-sameTyCon (Enum    {}) (Enum    {}) = True
-sameTyCon (Enum    {}) _            = False
-sameTyCon (Eq      {}) (Eq      {}) = True
-sameTyCon (Eq      {}) _            = False
-sameTyCon (NAT     {}) (NAT     {}) = True
-sameTyCon (NAT     {}) _            = False
-sameTyCon (STRING  {}) (STRING  {}) = True
-sameTyCon (STRING  {}) _            = False
-sameTyCon (BOX     {}) (BOX     {}) = True
-sameTyCon (BOX     {}) _            = False
-sameTyCon (E       {}) (E       {}) = True
-sameTyCon (E       {}) _            = False
-
-
-||| true if a type is known to be empty.
-|||
-||| * a pair is empty if either element is.
-||| * `{}` is empty.
-||| * `[π.A]` is empty if `A` is.
-||| * that's it.
-public export covering
-isEmpty :
-  {default 30 logLevel : Nat} -> (0 _ : So (isLogLevel logLevel)) =>
-  Definitions -> EqContext n -> SQty -> Term 0 n -> Eff EqualInner Bool
-
-private covering
-isEmptyNoLog :
-  Definitions -> EqContext n -> SQty -> Term 0 n -> Eff EqualInner Bool
-
-isEmpty defs ctx sg ty = do
-  sayMany "equal" ty.loc
-    [logLevel :> "isEmpty",
-     95       :> hsep ["ctx =", runPretty $ prettyEqContext ctx],
-     95       :> hsep ["sg =", runPretty $ prettyQty sg.qty],
-     logLevel :> hsep ["ty =", runPretty $ prettyTerm [<] ctx.tnames ty]]
-  res <- isEmptyNoLog defs ctx sg ty
-  say "equal" logLevel ty.loc $ hsep ["isEmpty ⇝", pshow res]
-  pure res
-
-isEmptyNoLog defs ctx sg ty0 = do
-  Element ty0 nc <- whnf defs ctx sg ty0.loc ty0
-  let Left  y = choose $ isTyConE ty0
-    | Right n => pure False
-  case ty0 of
-    TYPE {} => pure False
-    IOState {} => pure False
-    Pi {arg, res, _} => pure False
-    Sig {fst, snd, _} =>
-      isEmpty defs ctx sg fst {logLevel = 90} `orM`
-      isEmpty defs (extendTy0 snd.name fst ctx) sg snd.term {logLevel = 90}
-    Enum {cases, _} =>
-      pure $ null cases
-    Eq {} => pure False
-    NAT {} => pure False
-    STRING {} => pure False
-    BOX {ty, _} => isEmpty defs ctx sg ty {logLevel = 90}
-    E _ => pure False
+sameTyCon (TYPE {}) (TYPE {}) = True
+sameTyCon (TYPE {}) _         = False
+sameTyCon (Pi   {}) (Pi   {}) = True
+sameTyCon (Pi   {}) _         = False
+sameTyCon (Sig  {}) (Sig  {}) = True
+sameTyCon (Sig  {}) _         = False
+sameTyCon (W    {}) (W    {}) = True
+sameTyCon (W    {}) _         = False
+sameTyCon (Enum {}) (Enum {}) = True
+sameTyCon (Enum {}) _         = False
+sameTyCon (Eq   {}) (Eq   {}) = True
+sameTyCon (Eq   {}) _         = False
+sameTyCon (Nat  {}) (Nat  {}) = True
+sameTyCon (Nat  {}) _         = False
+sameTyCon (BOX  {}) (BOX  {}) = True
+sameTyCon (BOX  {}) _         = False
+sameTyCon (E    {}) (E    {}) = True
+sameTyCon (E    {}) _         = False
 
 
 ||| true if a type is known to be a subsingleton purely by its form.
 ||| a subsingleton is a type with only zero or one possible values.
 ||| equality/subtyping accepts immediately on values of subsingleton types.
 |||
-||| * a function type is a subsingleton if its codomain is,
-|||   or if its domain is empty.
+||| * a function type is a subsingleton if its codomain is.
 ||| * a pair type is a subsingleton if both its elements are.
 ||| * equality types are subsingletons because of uip.
 ||| * an enum type is a subsingleton if it has zero or one tags.
 ||| * a box type is a subsingleton if its content is
 public export covering
-isSubSing :
-  {default 30 logLevel : Nat} -> (0 _ : So (isLogLevel logLevel)) =>
-  Definitions -> EqContext n -> SQty -> Term 0 n -> Eff EqualInner Bool
-
-private covering
-isSubSingNoLog :
-  Definitions -> EqContext n -> SQty -> Term 0 n -> Eff EqualInner Bool
-
-isSubSing defs ctx sg ty = do
-  sayMany "equal" ty.loc
-    [logLevel :> "isSubSing",
-     95       :> hsep ["ctx =", runPretty $ prettyEqContext ctx],
-     95       :> hsep ["sg =", runPretty $ prettyQty sg.qty],
-     logLevel :> hsep ["ty =", runPretty $ prettyTerm [<] ctx.tnames ty]]
-  res <- isSubSingNoLog defs ctx sg ty
-  say "equal" logLevel ty.loc $ hsep ["isSubsing ⇝", pshow res]
-  pure res
-
-isSubSingNoLog defs ctx sg ty0 = do
-  Element ty0 nc <- whnf defs ctx sg ty0.loc ty0
-  let Left y = choose $ isTyConE ty0 | _ => pure False
+isSubSing : {n : Nat} -> Definitions -> EqContext n -> Term 0 n -> Equal_ Bool
+isSubSing defs ctx ty0 = do
+  Element ty0 nc <- whnf defs ctx ty0.loc ty0
   case ty0 of
     TYPE {} => pure False
-    IOState {} => pure False
     Pi {arg, res, _} =>
-      isEmpty defs ctx sg arg {logLevel = 90} `orM`
-      isSubSing defs (extendTy0 res.name arg ctx) sg res.term {logLevel = 90}
+      isSubSing defs (extendTy Zero res.name arg ctx) res.term
     Sig {fst, snd, _} =>
-      isSubSing defs ctx sg fst {logLevel = 90} `andM`
-      isSubSing defs (extendTy0 snd.name fst ctx) sg snd.term {logLevel = 90}
+      isSubSing defs ctx fst `andM`
+      isSubSing defs (extendTy Zero snd.name fst ctx) snd.term
+    W {} => pure False
     Enum {cases, _} =>
       pure $ length (SortedSet.toList cases) <= 1
     Eq {} => pure True
-    NAT {} => pure False
-    STRING {} => pure False
-    BOX {ty, _} => isSubSing defs ctx sg ty {logLevel = 90}
+    Nat {} => pure False
+    BOX {ty, _} => isSubSing defs ctx ty
+    E (Ann {tm, _}) => isSubSing defs ctx tm
     E _ => pure False
-
-
-||| the left argument if the current mode is `Super`; otherwise the right one.
-private %inline
-bigger : Has EqModeState fs => (left, right : Lazy a) -> Eff fs a
-bigger l r = gets $ \case Super => l; _ => r
+    Lam  {} => pure False
+    Pair {} => pure False
+    Sup  {} => pure False
+    Tag  {} => pure False
+    DLam {} => pure False
+    Zero {} => pure False
+    Succ {} => pure False
+    Box  {} => pure False
 
 
 export
-ensureTyCon, ensureTyConNoLog :
-  (Has Log fs, Has ErrorEff fs) =>
-  (loc : Loc) -> (ctx : EqContext n) -> (t : Term 0 n) ->
-  Eff fs (So (isTyConE t))
-ensureTyConNoLog loc ctx ty = do
-  case nchoose $ isTyConE ty of
-    Left  y => pure y
-    Right n => throw $ NotType loc (toTyContext ctx) (ty // shift0 ctx.dimLen)
-
-ensureTyCon loc ctx ty = do
-  sayMany "equal" ty.loc
-    [60 :> "ensureTyCon",
-     95 :> hsep ["ctx =", runPretty $ prettyEqContext ctx],
-     60 :> hsep ["ty =", runPretty $ prettyTerm [<] ctx.tnames ty]]
-  ensureTyConNoLog loc ctx ty
-
-
-namespace Term
-  ||| `compare0 ctx ty s t` compares `s` and `t` at type `ty`, according to
-  ||| the current variance `mode`.
-  |||
-  ||| ⚠ **assumes that `s`, `t` have already been checked against `ty`**. ⚠
-  export covering %inline
-  compare0 : Definitions -> EqContext n -> SQty -> (ty, s, t : Term 0 n) ->
-             Eff EqualInner ()
-
-namespace Elim
-  ||| compare two eliminations according to the given variance `mode`.
-  |||
-  ||| ⚠ **assumes that they have both been typechecked, and have
-  ||| equal types.** ⚠
-  export covering %inline
-  compare0 : Definitions -> EqContext n -> SQty -> (e, f : Elim 0 n) ->
-             Eff EqualInner (Term 0 n)
-
-||| compares two types, using the current variance `mode` for universes.
-||| fails if they are not types, even if they would happen to be equal.
-export covering %inline
-compareType : Definitions -> EqContext n -> (s, t : Term 0 n) ->
-              Eff EqualInner ()
-
-
-private
-0 NotRedexEq : {isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
-               Definitions -> EqContext n -> SQty -> Pred (tm 0 n)
-NotRedexEq defs ctx sg t = NotRedex defs (toWhnfContext ctx) sg t
-
-namespace Term
-  private covering
-  compare0' : (defs : Definitions) -> (ctx : EqContext n) -> (sg : SQty) ->
-              (ty, s, t : Term 0 n) ->
-              (0 _ : NotRedexEq defs ctx SZero ty) =>
-              (0 _ : So (isTyConE ty)) =>
-              (0 _ : NotRedexEq defs ctx sg s) =>
-              (0 _ : NotRedexEq defs ctx sg t) =>
-              Eff EqualInner ()
-  compare0' defs ctx sg (TYPE {}) s t = compareType defs ctx s t
-
-  compare0' defs ctx sg ty@(IOState {}) s t =
-    --   Γ ⊢ e = f ⇒ IOState
-    -- ----------------------
-    --   Γ ⊢ e = f ⇐ IOState
-    --
-    -- (no canonical values, ofc)
-    case (s, t) of
-      (E e, E f) => ignore $ Elim.compare0 defs ctx sg e f
-      (E _, _)   => wrongType t.loc ctx ty t
-      _          => wrongType s.loc ctx ty s
-
-  compare0' defs ctx sg ty@(Pi {qty, arg, res, _}) s t = withEqual $
-    --              Γ ⊢ A empty
-    -- -------------------------------------------
-    --  Γ ⊢ (λ x ⇒ s) = (λ x ⇒ t) ⇐ π.(x : A) → B
-    if !(isEmpty defs ctx sg arg) then pure () else
-    case (s, t) of
-      --           Γ, x : A ⊢ s = t ⇐ B
-      -- -------------------------------------------
-      --  Γ ⊢ (λ x ⇒ s) = (λ x ⇒ t) ⇐ π.(x : A) → B
-      (Lam b1 {}, Lam b2 {}) =>
-        compare0 defs ctx' sg res.term b1.term b2.term
-
-      --       Γ, x : A ⊢ s = e x ⇐ B
-      -- -----------------------------------
-      --  Γ ⊢ (λ x ⇒ s) = e ⇐ π.(x : A) → B
-      (E e,      Lam b {}) => eta s.loc e b
-      (Lam b {}, E e)      => eta s.loc e b
-
-      (E e, E f) => ignore $ Elim.compare0 defs ctx sg e f
-
-      (Lam {}, t) => wrongType t.loc ctx ty t
-      (E _,    t) => wrongType t.loc ctx ty t
-      (s,      _) => wrongType s.loc ctx ty s
-  where
-    ctx' : EqContext (S n)
-    ctx' = extendTy qty res.name arg ctx
-
-    toLamBody : Elim d n -> Term d (S n)
-    toLamBody e = E $ App (weakE 1 e) (BVT 0 e.loc) e.loc
-
-    eta : Loc -> Elim 0 n -> ScopeTerm 0 n -> Eff EqualInner ()
-    eta loc e (S _ (N b)) =
-      if !(pure (qty /= One) `andM` isSubSing defs ctx sg arg)
-         then compare0 defs ctx' sg res.term (toLamBody e) (weakT 1 b)
-         else clashT loc ctx ty s t
-    eta _ e (S _ (Y b)) =
-      compare0 defs ctx' sg res.term (toLamBody e) b
-
-  compare0' defs ctx sg ty@(Sig {fst, snd, _}) s t = withEqual $
-    case (s, t) of
-      --  Γ ⊢ s₁ = t₁ ⇐ A     Γ ⊢ s₂ = t₂ ⇐ B{s₁/x}
-      -- --------------------------------------------
-      --     Γ ⊢ (s₁, t₁) = (s₂,t₂) ⇐ (x : A) × B
-      (Pair sFst sSnd {}, Pair tFst tSnd {}) => do
-        compare0 defs ctx sg fst sFst tFst
-        compare0 defs ctx sg (sub1 snd (Ann sFst fst fst.loc)) sSnd tSnd
-
-      (E e, E f) => ignore $ Elim.compare0 defs ctx sg e f
-
-      (E e,            Pair fst snd _) => eta s.loc e fst snd
-      (Pair fst snd _, E f)            => eta s.loc f fst snd
-
-      (Pair {}, t) => wrongType t.loc ctx ty t
-      (E _,     t) => wrongType t.loc ctx ty t
-      (s,       _) => wrongType s.loc ctx ty s
-  where
-    eta : Loc -> Elim 0 n -> Term 0 n -> Term 0 n -> Eff EqualInner ()
-    eta loc e s t =
-      case sg of
-        SZero => do
-          compare0 defs ctx sg fst                          (E $ Fst e e.loc) s
-          compare0 defs ctx sg (sub1 snd (Ann s fst s.loc)) (E $ Snd e e.loc) t
-        SOne => clashT loc ctx ty s t
-
-  compare0' defs ctx sg ty@(Enum cases _) s t = withEqual $
-    -- η for empty & singleton enums
-    if length (SortedSet.toList cases) <= 1 then pure () else
-    case (s, t) of
-      -- --------------------
-      --  Γ ⊢ 't = 't ⇐ {ts}
-      --
-      -- t ∈ ts is in the typechecker, not here, ofc
-      (Tag t1 {}, Tag t2 {}) => unless (t1 == t2) $ clashT s.loc ctx ty s t
-      (E e,       E f)       => ignore $ Elim.compare0 defs ctx sg e f
-
-      (Tag {}, E _)    => clashT s.loc ctx ty s t
-      (E _,    Tag {}) => clashT s.loc ctx ty s t
-
-      (Tag {}, t) => wrongType t.loc ctx ty t
-      (E _,    t) => wrongType t.loc ctx ty t
-      (s,      _) => wrongType s.loc ctx ty s
-
-  compare0' _ _ _ (Eq {}) _ _ =
-    -- ✨ uip ✨
-    --
-    -- ----------------------------
-    --  Γ ⊢ e = f ⇐ Eq [i ⇒ A] s t
-    pure ()
-
-  compare0' defs ctx sg nat@(NAT {}) s t = withEqual $
-    case (s, t) of
-      -- ---------------
-      --  Γ ⊢ n = n ⇐ ℕ
-      (Nat x {}, Nat y {}) => unless (x == y) $ clashT s.loc ctx nat s t
-
-      --      Γ ⊢ s = t ⇐ ℕ
-      -- -------------------------
-      --  Γ ⊢ succ s = succ t ⇐ ℕ
-      (Succ s'   {}, Succ t'   {}) => compare0 defs ctx sg nat s' t'
-      (Nat (S x) {}, Succ t'   {}) => compare0 defs ctx sg nat (Nat x s.loc) t'
-      (Succ s'   {}, Nat (S y) {}) => compare0 defs ctx sg nat s' (Nat y t.loc)
-
-      (E e, E f) => ignore $ Elim.compare0 defs ctx sg e f
-
-      (Nat 0 {}, Succ  {}) => clashT s.loc ctx nat s t
-      (Nat 0 {}, E _)      => clashT s.loc ctx nat s t
-      (Succ  {}, Nat 0 {}) => clashT s.loc ctx nat s t
-      (Succ  {}, E _)      => clashT s.loc ctx nat s t
-      (E _,      Nat 0 {}) => clashT s.loc ctx nat s t
-      (E _,      Succ  {}) => clashT s.loc ctx nat s t
-
-      (Nat  {}, t) => wrongType t.loc ctx nat t
-      (Succ {}, t) => wrongType t.loc ctx nat t
-      (E _,     t) => wrongType t.loc ctx nat t
-      (s,       _) => wrongType s.loc ctx nat s
-
-  compare0' defs ctx sg str@(STRING {}) s t = withEqual $
-    case (s, t) of
-      (Str x _, Str y _) => unless (x == y) $ clashT s.loc ctx str s t
-
-      (E e, E f) => ignore $ Elim.compare0 defs ctx sg e f
-
-      (Str {}, E _) => clashT s.loc ctx str s t
-      (E _, Str {}) => clashT s.loc ctx str s t
-
-      (Str {}, _) => wrongType t.loc ctx str t
-      (E _,    _) => wrongType t.loc ctx str t
-      _           => wrongType s.loc ctx str s
-
-  compare0' defs ctx sg bty@(BOX q ty {}) s t = withEqual $
-    case (s, t) of
-      --     Γ ⊢ s = t ⇐ A
-      -- -----------------------
-      --  Γ ⊢ [s] = [t] ⇐ [π.A]
-      (Box s _, Box t _) => compare0 defs ctx sg ty s t
-
-      --   Γ ⊢ σ⨴ρ · s = (case1 e return A of {[x] ⇒ x}) ⇐ A
-      -- -----------------------------------------------------
-      --               Γ ⊢ σ · [s] = e ⇐ [ρ.A]
-      (Box s loc, E f)       => eta s f
-      (E e,       Box t loc) => eta t e
-
-      (E e, E f) => ignore $ Elim.compare0 defs ctx sg e f
-
-      (Box {}, _) => wrongType t.loc ctx bty t
-      (E   _,  _) => wrongType t.loc ctx bty t
-      _           => wrongType s.loc ctx bty s
-  where
-    eta : Term 0 n -> Elim 0 n -> Eff EqualInner ()
-    eta s e = do
-      nm <- mnb "inner" e.loc
-      let e = CaseBox One e (SN ty) (SY [< nm] (BVT 0 nm.loc)) e.loc
-      compare0 defs ctx (sg `subjMult` q) ty s (E e)
-
-  compare0' defs ctx sg ty@(E _) s t = do
-    -- a neutral type can only be inhabited by neutral values
-    -- e.g. an abstract value in an abstract type, bound variables, …
-    let E e = s | _ => wrongType s.loc ctx ty s
-        E f = t | _ => wrongType t.loc ctx ty t
-    ignore $ Elim.compare0 defs ctx sg e f
-
+ensureTyCon : Has ErrorEff fs =>
+              (loc : Loc) -> (ctx : EqContext n) -> (t : Term 0 n) ->
+              Eff fs (So (isTyConE t))
+ensureTyCon loc ctx t = case nchoose $ isTyConE t of
+  Left  y => pure y
+  Right n => throw $ NotType loc (toTyContext ctx) (t // shift0 ctx.dimLen)
 
+||| performs the minimum work required to recompute the type of an elim.
+|||
+||| ⚠ **assumes the elim is already typechecked.** ⚠
 private covering
-compareType' : (defs : Definitions) -> (ctx : EqContext n) ->
-               (s, t : Term 0 n) ->
-               (0 _ : NotRedexEq defs ctx SZero s) => (0 _ : So (isTyConE s)) =>
-               (0 _ : NotRedexEq defs ctx SZero t) => (0 _ : So (isTyConE t)) =>
-               (0 _ : So (sameTyCon s t)) =>
-               Eff EqualInner ()
--- equality is the same as subtyping, except with the
--- "≤" in the TYPE rule being replaced with "="
-compareType' defs ctx a@(TYPE k {}) (TYPE l {}) =
-  --        𝓀 ≤ ℓ
-  -- ----------------------
-  --  Γ ⊢ Type 𝓀 <: Type ℓ
-  expectModeU a.loc !mode k l
+computeElimTypeE : (defs : Definitions) -> EqContext n ->
+                   (e : Elim 0 n) -> (0 ne : NotRedex defs e) =>
+                   Equal_ (Term 0 n)
+computeElimTypeE defs ectx e =
+  let Val n = ectx.termLen in
+  lift $ computeElimType defs (toWhnfContext ectx) e
 
-compareType' defs ctx a@(IOState {}) (IOState {}) =
-  -- Γ ⊢ IOState <: IOState
-  pure ()
+parameters (defs : Definitions)
+  mutual
+    namespace Term
+      ||| `compare0 ctx ty s t` compares `s` and `t` at type `ty`, according to
+      ||| the current variance `mode`.
+      |||
+      ||| ⚠ **assumes that `s`, `t` have already been checked against `ty`**. ⚠
+      export covering %inline
+      compare0 : EqContext n -> (ty, s, t : Term 0 n) -> Equal_ ()
+      compare0 ctx ty s t =
+        wrapErr (WhileComparingT ctx !mode ty s t) $ do
+          let Val n = ctx.termLen
+          Element ty' _ <- whnf defs ctx ty.loc ty
+          Element s'  _ <- whnf defs ctx s.loc  s
+          Element t'  _ <- whnf defs ctx t.loc  t
+          tty <- ensureTyCon ty.loc ctx ty'
+          compare0' ctx ty' s' t'
 
-compareType' defs ctx (Pi {qty = sQty, arg = sArg, res = sRes, loc})
-                      (Pi {qty = tQty, arg = tArg, res = tRes, _}) = do
-  --   Γ ⊢ A₁ :> A₂    Γ, x : A₁ ⊢ B₁ <: B₂
-  -- ----------------------------------------
-  --  Γ ⊢ π.(x : A₁) → B₁ <: π.(x : A₂) → B₂
-  expectEqualQ loc sQty tQty
-  local flip $ compareType defs ctx sArg tArg -- contra
-  compareType defs (extendTy0 sRes.name sArg ctx) sRes.term tRes.term
+      ||| converts an elim "Γ ⊢ e" to "Γ, x ⊢ e x", for comparing with
+      ||| a lambda "Γ ⊢ λx ⇒ t" that has been converted to "Γ, x ⊢ t".
+      private %inline
+      toLamBody : Elim d n -> Term d (S n)
+      toLamBody e = E $ App (weakE 1 e) (BVT 0 e.loc) e.loc
 
-compareType' defs ctx (Sig {fst = sFst, snd = sSnd, _})
-                      (Sig {fst = tFst, snd = tSnd, _}) = do
-  --  Γ ⊢ A₁ <: A₂    Γ, x : A₁ ⊢ B₁ <: B₂
-  -- --------------------------------------
-  --   Γ ⊢ (x : A₁) × B₁ <: (x : A₂) × B₂
-  compareType defs ctx sFst tFst
-  compareType defs (extendTy0 sSnd.name sFst ctx) sSnd.term tSnd.term
+      private covering
+      compare0' : EqContext n ->
+                  (ty, s, t : Term 0 n) ->
+                  (0 _ : NotRedex defs ty) => (0 _ : So (isTyConE ty)) =>
+                  (0 _ : NotRedex defs s)  => (0 _ : NotRedex defs t) =>
+                  Equal_ ()
+      compare0' ctx (TYPE {}) s t = compareType ctx s t
 
-compareType' defs ctx (Eq {ty = sTy, l = sl, r = sr, _})
-                      (Eq {ty = tTy, l = tl, r = tr, _}) = do
-  --            Γ ⊢ A₁‹ε/i› <: A₂‹ε/i›
-  --  Γ ⊢ l₁ = l₂ : A₁‹𝟎/i›    Γ ⊢ r₁ = r₂ : A₁‹𝟏/i›
-  -- ------------------------------------------------
-  --    Γ ⊢ Eq [i ⇒ A₁] l₁ r₂ <: Eq [i ⇒ A₂] l₂ r₂
-  compareType defs (extendDim sTy.name Zero ctx) sTy.zero tTy.zero
-  compareType defs (extendDim sTy.name One  ctx) sTy.one  tTy.one
-  ty <- bigger sTy tTy
-  withEqual $ do
-    Term.compare0 defs ctx SZero ty.zero sl tl
-    Term.compare0 defs ctx SZero ty.one  sr tr
+      compare0' ctx ty@(Pi {qty, arg, res, _}) s t {n} = local_ Equal $
+        case (s, t) of
+          --           Γ, x : A ⊢ s = t : B
+          -- -------------------------------------------
+          --  Γ ⊢ (λ x ⇒ s) = (λ x ⇒ t) : (π·x : A) → B
+          (Lam b1 {}, Lam b2 {}) =>
+            compare0 ctx' res.term b1.term b2.term
 
-compareType' defs ctx s@(Enum tags1 {}) t@(Enum tags2 {}) = do
-  -- ------------------
-  --  Γ ⊢ {ts} <: {ts}
-  --
-  -- no subtyping based on tag subsets, since that would need
-  -- a runtime coercion
-  unless (tags1 == tags2) $ clashTy s.loc ctx s t
+          --       Γ, x : A ⊢ s = e x : B
+          -- -----------------------------------
+          --  Γ ⊢ (λ x ⇒ s) = e : (π·x : A) → B
+          (E e,      Lam b {}) => eta s.loc e b
+          (Lam b {}, E e)      => eta s.loc e b
 
-compareType' defs ctx (NAT {}) (NAT {}) =
-  -- ------------
-  --  Γ ⊢ ℕ <: ℕ
-  pure ()
+          (E e, E f) => Elim.compare0 ctx e f
 
-compareType' defs ctx (STRING {}) (STRING {}) =
-  -- ------------
-  --  Γ ⊢ String <: String
-  pure ()
+          (Lam {}, t) => wrongType t.loc ctx ty t
+          (E _,    t) => wrongType t.loc ctx ty t
+          (s,      _) => wrongType s.loc ctx ty s
+        where
+          ctx' : EqContext (S n)
+          ctx' = extendTy qty res.name arg ctx
 
-compareType' defs ctx (BOX pi a loc) (BOX rh b {}) = do
-  expectEqualQ loc pi rh
-  compareType defs ctx a b
+          eta : Loc -> Elim 0 n -> ScopeTerm 0 n -> Equal_ ()
+          eta _   e (S _ (Y b)) = compare0 ctx' res.term (toLamBody e) b
+          eta loc e (S _ (N _)) = clashT loc ctx ty s t
 
-compareType' defs ctx (E e) (E f) = do
-  -- no fanciness needed here cos anything other than a neutral
-  -- has been inlined by whnf
-  ignore $ Elim.compare0 defs ctx SZero e f
+      compare0' ctx ty@(Sig {fst, snd, _}) s t = local_ Equal $
+        case (s, t) of
+          --  Γ ⊢ s₁ = t₁ : A     Γ ⊢ s₂ = t₂ : B{s₁/x}
+          -- --------------------------------------------
+          --    Γ ⊢ (s₁, t₁) = (s₂, t₂) : (x : A) × B
+          --
+          -- [todo] η for π ≰ 1 maybe
+          (Pair sFst sSnd {}, Pair tFst tSnd {}) => do
+            compare0 ctx fst sFst tFst
+            compare0 ctx (sub1 snd (Ann sFst fst fst.loc)) sSnd tSnd
+
+          (E e, E f) => Elim.compare0 ctx e f
+
+          (Pair {}, E _)     => clashT s.loc ctx ty s t
+          (E _,     Pair {}) => clashT s.loc ctx ty s t
+
+          (Pair {}, t) => wrongType t.loc ctx ty t
+          (E _,     t) => wrongType t.loc ctx ty t
+          (s,       _) => wrongType s.loc ctx ty s
+
+      compare0' ctx ty@(W {shape, body, _}) s t =
+        case (s, t) of
+          --           Γ ⊢ s₁ = t₁ : A
+          --  Γ ⊢ s₂ = t₂ : ω.B[s₁∷A/x] → (x : A) ⊲ B
+          -- -----------------------------------------
+          --     Γ ⊢ s₁⋄s₂ = t₁⋄t₂ : (x : A) ⊲ B
+          (Sup sRoot sSub {}, Sup tRoot tSub {}) => do
+            compare0 ctx shape sRoot tRoot
+            let arg   = sub1 body (Ann sRoot shape sRoot.loc)
+                subTy = Arr Any arg ty ty.loc
+            compare0 ctx subTy sSub tSub
+
+          (E e, E f) => Elim.compare0 ctx e f
+
+          (Sup {}, E   {}) => clashT s.loc ctx ty s t
+          (E   {}, Sup {}) => clashT s.loc ctx ty s t
+
+          (Sup {}, t) => wrongType t.loc ctx ty t
+          (E   {}, t) => wrongType t.loc ctx ty t
+          (s,      _) => wrongType s.loc ctx ty s
+
+      compare0' ctx ty@(Enum {}) s t = local_ Equal $
+        case (s, t) of
+          -- --------------------
+          --  Γ ⊢ `t = `t : {ts}
+          --
+          -- t ∈ ts is in the typechecker, not here, ofc
+          (Tag t1 {}, Tag t2 {}) =>
+            unless (t1 == t2) $ clashT s.loc ctx ty s t
+          (E e, E f) => Elim.compare0 ctx e f
+
+          (Tag {}, E _)    => clashT s.loc ctx ty s t
+          (E _,    Tag {}) => clashT s.loc ctx ty s t
+
+          (Tag {}, t) => wrongType t.loc ctx ty t
+          (E _,    t) => wrongType t.loc ctx ty t
+          (s,      _) => wrongType s.loc ctx ty s
+
+      compare0' _ (Eq {}) _ _ =
+        -- ✨ uip ✨
+        --
+        -- ----------------------------
+        --  Γ ⊢ e = f : Eq [i ⇒ A] s t
+        pure ()
+
+      compare0' ctx nat@(Nat {}) s t = local_ Equal $
+        case (s, t) of
+          -- ---------------
+          --  Γ ⊢ 0 = 0 : ℕ
+          (Zero {}, Zero {}) => pure ()
+
+          --      Γ ⊢ s = t : ℕ
+          -- -------------------------
+          --  Γ ⊢ succ s = succ t : ℕ
+          (Succ s' {}, Succ t' {}) => compare0 ctx nat s' t'
+
+          (E e, E f) => Elim.compare0 ctx e f
+
+          (Zero {}, Succ {}) => clashT s.loc ctx nat s t
+          (Zero {}, E _)     => clashT s.loc ctx nat s t
+          (Succ {}, Zero {}) => clashT s.loc ctx nat s t
+          (Succ {}, E _)     => clashT s.loc ctx nat s t
+          (E _,     Zero {}) => clashT s.loc ctx nat s t
+          (E _,     Succ {}) => clashT s.loc ctx nat s t
+
+          (Zero {}, t) => wrongType t.loc ctx nat t
+          (Succ {}, t) => wrongType t.loc ctx nat t
+          (E _,     t) => wrongType t.loc ctx nat t
+          (s,       _) => wrongType s.loc ctx nat s
+
+      compare0' ctx ty@(BOX q ty' {}) s t = local_ Equal $
+        case (s, t) of
+          --     Γ ⊢ s = t : A
+          -- -----------------------
+          --  Γ ⊢ [s] = [t] : [π.A]
+          (Box s' {}, Box t' {}) => compare0 ctx ty' s' t'
+
+          (E e, E f) => Elim.compare0 ctx e f
+
+          (Box {}, t) => wrongType t.loc ctx ty t
+          (E   _,  t) => wrongType t.loc ctx ty t
+          (s,      _) => wrongType s.loc ctx ty s
+
+      compare0' ctx ty@(E _) s t = do
+        -- a neutral type can only be inhabited by neutral values
+        -- e.g. an abstract value in an abstract type, bound variables, …
+        let E e = s | _ => wrongType s.loc ctx ty s
+            E f = t | _ => wrongType t.loc ctx ty t
+        Elim.compare0 ctx e f
+
+    ||| compares two types, using the current variance `mode` for universes.
+    ||| fails if they are not types, even if they would happen to be equal.
+    export covering %inline
+    compareType : EqContext n -> (s, t : Term 0 n) -> Equal_ ()
+    compareType ctx s t = do
+      let Val n = ctx.termLen
+      Element s' _ <- whnf defs ctx s.loc s
+      Element t' _ <- whnf defs ctx t.loc t
+      ts <- ensureTyCon s.loc ctx s'
+      tt <- ensureTyCon t.loc ctx t'
+      st <- either pure (const $ clashTy s.loc ctx s' t') $
+            nchoose $ sameTyCon s' t'
+      compareType' ctx s' t'
+
+    private covering
+    compareType' : EqContext n -> (s, t : Term 0 n) ->
+                   (0 _ : NotRedex defs s) => (0 _ : So (isTyConE s)) =>
+                   (0 _ : NotRedex defs t) => (0 _ : So (isTyConE t)) =>
+                   (0 _ : So (sameTyCon s t)) =>
+                   Equal_ ()
+    -- equality is the same as subtyping, except with the
+    -- "≤" in the TYPE rule being replaced with "="
+    compareType' ctx a@(TYPE k {}) (TYPE l {}) =
+      --        𝓀 ≤ ℓ
+      -- ----------------------
+      --  Γ ⊢ Type 𝓀 <: Type ℓ
+      expectModeU a.loc !mode k l
+
+    compareType' ctx (Pi {qty = sQty, arg = sArg, res = sRes, loc})
+                     (Pi {qty = tQty, arg = tArg, res = tRes, _}) = do
+      --   Γ ⊢ A₁ :> A₂    Γ, x : A₁ ⊢ B₁ <: B₂
+      -- ----------------------------------------
+      --  Γ ⊢ π.(x : A₁) → B₁ <: π.(x : A₂) → B₂
+      --
+      -- no quantity subtyping since that would need a runtime coercion
+      -- e.g. if ⌊0.A → B⌋ ⇝ ⌊B⌋, then the promotion to ω.A → B would need
+      -- to re-add the abstraction
+      expectEqualQ loc sQty tQty
+      local flip $ compareType ctx sArg tArg -- contra
+      compareType (extendTy Zero sRes.name sArg ctx) sRes.term tRes.term
+
+    compareType' ctx (Sig {fst = sFst, snd = sSnd, _})
+                     (Sig {fst = tFst, snd = tSnd, _}) = do
+      --  Γ ⊢ A₁ <: A₂    Γ, x : A₁ ⊢ B₁ <: B₂
+      -- --------------------------------------
+      --   Γ ⊢ (x : A₁) × B₁ <: (x : A₂) × B₂
+      compareType ctx sFst tFst
+      compareType (extendTy Zero sSnd.name sFst ctx) sSnd.term tSnd.term
+
+    compareType' ctx (W {shape = sShape, body = sBody, loc})
+                     (W {shape = tShape, body = tBody, _}) = do
+      --  Γ ⊢ A₁ <: A₂    Γ, x : A₁ ⊢ B₁ <: B₂
+      -- --------------------------------------
+      --   Γ ⊢ (x : A₁) ⊲ B₁ <: (x : A₂) ⊲ B₂
+      compareType ctx sShape tShape
+      compareType (extendTy Zero sBody.name sShape ctx) sBody.term tBody.term
+
+    compareType' ctx (Eq {ty = sTy, l = sl, r = sr, _})
+                     (Eq {ty = tTy, l = tl, r = tr, _}) = do
+      --            Γ ⊢ A₁‹ε/i› <: A₂‹ε/i›
+      --  Γ ⊢ l₁ = l₂ : A₁‹0/i›    Γ ⊢ r₁ = r₂ : A₁‹1/i›
+      -- ------------------------------------------------
+      --    Γ ⊢ Eq (i ⇒ A₁) l₁ r₂ <: Eq (i ⇒ A₂) l₂ r₂
+      compareType (extendDim sTy.name Zero ctx) sTy.zero tTy.zero
+      compareType (extendDim sTy.name One  ctx) sTy.one  tTy.one
+      let ty = case !mode of Super => sTy; _ => tTy
+      local_ Equal $ do
+        Term.compare0 ctx ty.zero sl tl
+        Term.compare0 ctx ty.one  sr tr
+
+    compareType' ctx s@(Enum tags1 {}) t@(Enum tags2 {}) = do
+      -- ------------------
+      --  Γ ⊢ {ts} <: {ts}
+      --
+      -- no subtyping based on tag subsets, since that would need
+      -- a runtime coercion
+      unless (tags1 == tags2) $ clashTy s.loc ctx s t
+
+    compareType' ctx (Nat {}) (Nat {}) =
+      -- ------------
+      --  Γ ⊢ ℕ <: ℕ
+      pure ()
+
+    compareType' ctx (BOX pi a loc) (BOX rh b {}) = do
+      --     Γ ⊢ A <: B
+      -- --------------------
+      --  Γ ⊢ [π.A] <: [π.B]
+      expectEqualQ loc pi rh
+      compareType ctx a b
+
+    compareType' ctx (E e) (E f) = do
+      -- no fanciness needed here cos anything other than a neutral
+      -- has been inlined by whnf
+      Elim.compare0 ctx e f
 
 
-private
-lookupFree : Has ErrorEff fs =>
-             Definitions -> EqContext n -> Name -> Universe -> Loc ->
-             Eff fs (Term 0 n)
-lookupFree defs ctx x u loc =
-  case lookup x defs of
-    Nothing => throw $ NotInScope loc x
-    Just d  => pure $ d.typeWithAt [|Z|] ctx.termLen u
+    namespace Elim
+      -- [fixme] the following code ends up repeating a lot of work in the
+      -- computeElimType calls. the results should be shared better
 
+      ||| compare two eliminations according to the given variance `mode`.
+      |||
+      ||| ⚠ **assumes that they have both been typechecked, and have
+      ||| equal types.** ⚠
+      export covering %inline
+      compare0 : EqContext n -> (e, f : Elim 0 n) -> Equal_ ()
+      compare0 ctx e f =
+        wrapErr (WhileComparingE ctx !mode e f) $ do
+          let Val n = ctx.termLen
+          Element e' ne <- whnf defs ctx e.loc e
+          Element f' nf <- whnf defs ctx f.loc f
+          unless !(isSubSing defs ctx =<< computeElimTypeE defs ctx e') $
+            compare0' ctx e' f' ne nf
 
-export
-typecaseTel : (k : TyConKind) -> BContext (arity k) -> Universe ->
-              CtxExtension d n (arity k + n)
-typecaseTel k xs u = case k of
-  KTYPE => [<]
-  KIOState => [<]
-  -- A : ★ᵤ, B : 0.A → ★ᵤ
-  KPi =>
-    let [< a, b] = xs in
-    [< (Zero, a, TYPE u a.loc),
-       (Zero, b, Arr Zero (BVT 0 b.loc) (TYPE u b.loc) b.loc)]
-  KSig =>
-    let [< a, b] = xs in
-    [< (Zero, a, TYPE u a.loc),
-       (Zero, b, Arr Zero (BVT 0 b.loc) (TYPE u b.loc) b.loc)]
-  KEnum => [<]
-  -- A₀ : ★ᵤ, A₁ : ★ᵤ, A : (A₀ ≡ A₁ : ★ᵤ), L : A₀, R : A₀
-  KEq =>
-    let [< a0, a1, a, l, r] = xs in
-    [< (Zero, a0, TYPE u a0.loc),
-       (Zero, a1, TYPE u a1.loc),
-       (Zero, a,  Eq0 (TYPE u a.loc) (BVT 1 a.loc) (BVT 0 a.loc) a.loc),
-       (Zero, l,  BVT 2 l.loc),
-       (Zero, r,  BVT 2 r.loc)]
-  KNat => [<]
-  KString => [<]
-  -- A : ★ᵤ
-  KBOX => let [< a] = xs in [< (Zero, a, TYPE u a.loc)]
+      private covering
+      compare0' : EqContext n ->
+                  (e, f : Elim 0 n) ->
+                  (0 ne : NotRedex defs e) -> (0 nf : NotRedex defs f) ->
+                  Equal_ ()
 
+      compare0' ctx e@(F x u _) f@(F y v _) _ _ =
+        unless (x == y && u == v) $ clashE e.loc ctx e f
+      compare0' ctx e@(F {}) f _ _ = clashE e.loc ctx e f
 
-namespace Elim
-  private data InnerErr : Type where
+      compare0' ctx e@(B i _) f@(B j _) _ _ =
+        unless (i == j) $ clashE e.loc ctx e f
+      compare0' ctx e@(B {}) f _ _ = clashE e.loc ctx e f
 
-  private
-  InnerErrEff : Type -> Type
-  InnerErrEff = StateL InnerErr (Maybe Error)
+      --  Ψ | Γ ⊢ e = f ⇒ π.(x : A) → B
+      --  Ψ | Γ ⊢ s = t ⇐ A
+      -- -------------------------------
+      --  Ψ | Γ ⊢ e s = f t ⇒ B[s∷A/x]
+      compare0' ctx (App e s eloc) (App f t floc) ne nf =
+        local_ Equal $ do
+          compare0 ctx e f
+          (_, arg, _) <- expectPi defs ctx eloc =<<
+                         computeElimTypeE defs ctx e @{noOr1 ne}
+          Term.compare0 ctx arg s t
+      compare0' ctx e@(App {}) f _ _ = clashE e.loc ctx e f
 
-  private
-  EqualElim : List (Type -> Type)
-  EqualElim = InnerErrEff :: EqualInner
+      --  Ψ | Γ ⊢ e = f ⇒ (x : A) × B
+      --  Ψ | Γ, 0.p : (x : A) × B ⊢ Q = R
+      --  Ψ | Γ, x : A, y : B ⊢ s = t ⇐ Q[((x, y) ∷ (x : A) × B)/p]
+      -- -----------------------------------------------------------
+      --    Ψ | Γ ⊢ caseπ e return Q of { (x, y) ⇒ s }
+      --          = caseπ f return R of { (x, y) ⇒ t } ⇒ Q[e/p]
+      compare0' ctx (CasePair epi e eret ebody eloc)
+                    (CasePair fpi f fret fbody {}) ne nf =
+        local_ Equal $ do
+          compare0 ctx e f
+          ety <- computeElimTypeE defs ctx e @{noOr1 ne}
+          compareType (extendTy Zero eret.name ety ctx) eret.term fret.term
+          (fst, snd) <- expectSig defs ctx eloc ety
+          let [< x, y] = ebody.names
+          Term.compare0 (extendTyN [< (epi, x, fst), (epi, y, snd.term)] ctx)
+                        (substCasePairRet ebody.names ety eret)
+                        ebody.term fbody.term
+          expectEqualQ e.loc epi fpi
+      compare0' ctx e@(CasePair {}) f _ _ = clashE e.loc ctx e f
 
-  private covering %inline
-  computeElimTypeE : (defs : Definitions) -> (ctx : EqContext n) ->
-                     (sg : SQty) ->
-                     (e : Elim 0 n) -> (0 ne : NotRedexEq defs ctx sg e) =>
-                     Eff EqualElim (Term 0 n)
-  computeElimTypeE defs ectx sg e = lift $
-    computeElimType defs (toWhnfContext ectx) sg e
+      --  Ψ | Γ ⊢ e = f ⇒ (x : A) ⊲ B
+      --  Ψ | Γ, p : (x : A) ⊲ B ⊢ Q = R ⇐ Type
+      --  Ψ | Γ, x : A, y : ω.B → (x : A) ⊲ B, ih : 1.(z : B) → Q[y z/p]
+      --    ⊢ s = t ⇐ Q[(x⋄y ∷ (x : A) ⊲ B)/p]
+      -- ----------------------------------------------------------------
+      --  Ψ | Γ ⊢ caseπ e return Q of { x ⋄ y, ς.ih ⇒ s }
+      --        = caseπ f return R of { x ⋄ y, ς.ih ⇒ t } ⇒ Q[e/p]
+      compare0' ctx (CaseW epi epi' e eret ebody eloc)
+                    (CaseW fpi fpi' f fret fbody floc) ne nf =
+        local_ Equal $ do
+          compare0 ctx e f
+          ety <- computeElimTypeE defs ctx e @{noOr1 ne}
+          compareType (extendTy Zero eret.name ety ctx) eret.term fret.term
+          (shape, tbody) <- expectW defs ctx eloc ety
+          let [< x, y, ih] = ebody.names
+          z <- mnb "z" ih.loc
+          let xbind = (epi, x, shape)
+              ybind = (epi, y, Arr Any tbody.term (weakT 1 ety) y.loc)
+              ihbind = (epi', ih,
+                PiY One z
+                  (sub1 (weakS 2 tbody) (BV 1 x.loc))
+                  (sub1 (weakS 3 eret) (App (BV 1 y.loc) (BVT 0 z.loc) ih.loc))
+                  ih.loc)
+              ctx' = extendTyN [< xbind, ybind, ihbind] ctx
+          Term.compare0 ctx' (substCaseWRet ebody.names ety eret)
+            ebody.term fbody.term
+          expectEqualQ e.loc epi  fpi
+          expectEqualQ e.loc epi' fpi'
+      compare0' ctx e@(CaseW {}) f _ _ = clashE e.loc ctx e f
 
-  private %inline
-  putError : Has InnerErrEff fs => Error -> Eff fs ()
-  putError err = modifyAt InnerErr (<|> Just err)
+      --  Ψ | Γ ⊢ e = f ⇒ {𝐚s}
+      --  Ψ | Γ, x : {𝐚s} ⊢ Q = R
+      --  Ψ | Γ ⊢ sᵢ = tᵢ ⇐ Q[𝐚ᵢ∷{𝐚s}]
+      -- --------------------------------------------------
+      --  Ψ | Γ ⊢ caseπ e return Q of { '𝐚ᵢ ⇒ sᵢ }
+      --        = caseπ f return R of { '𝐚ᵢ ⇒ tᵢ } ⇒ Q[e/x]
+      compare0' ctx (CaseEnum epi e eret earms eloc)
+                    (CaseEnum fpi f fret farms floc) ne nf =
+        local_ Equal $ do
+          compare0 ctx e f
+          ety <- computeElimTypeE defs ctx e @{noOr1 ne}
+          compareType (extendTy Zero eret.name ety ctx) eret.term fret.term
+          for_ (SortedMap.toList earms) $ \(t, l) => do
+            r <- lookupArm floc t farms
+            compare0 ctx (sub1 eret $ Ann (Tag t l.loc) ety l.loc) l r
+          -- for_ !(expectEnum defs ctx eloc ety) $ \t => do
+          --   l <- lookupArm eloc t earms
+          --   r <- lookupArm floc t farms
+          --   compare0 ctx (sub1 eret $ Ann (Tag t l.loc) ety l.loc) l r
+          expectEqualQ eloc epi fpi
+        where
+          lookupArm : Loc -> TagVal -> CaseEnumArms d n -> Equal_ (Term d n)
+          lookupArm loc t arms = case lookup t arms of
+            Just arm => pure arm
+            Nothing  => throw $ TagNotIn loc t (fromList $ keys arms)
+      compare0' ctx e@(CaseEnum {}) f _ _ = clashE e.loc ctx e f
 
-  private %inline
-  try : Eff EqualInner () -> Eff EqualElim ()
-  try act = lift $ catch putError $ lift act {fs' = EqualElim}
+      --  Ψ | Γ ⊢ e = f ⇒ ℕ
+      --  Ψ | Γ, x : ℕ ⊢ Q = R
+      --  Ψ | Γ ⊢ s₀ = t₀ ⇐ Q[(0 ∷ ℕ)/x]
+      --  Ψ | Γ, x : ℕ, y : Q ⊢ s₁ = t₁ ⇐ Q[(succ x ∷ ℕ)/x]
+      -- -----------------------------------------------------
+      --  Ψ | Γ ⊢ caseπ e return Q of { 0 ⇒ s₀; x, π.y ⇒ s₁ }
+      --        = caseπ f return R of { 0 ⇒ t₀; x, π.y ⇒ t₁ }
+      --        ⇒ Q[e/x]
+      compare0' ctx (CaseNat epi epi' e eret ezer esuc eloc)
+                    (CaseNat fpi fpi' f fret fzer fsuc floc) ne nf =
+        local_ Equal $ do
+          compare0 ctx e f
+          ety <- computeElimTypeE defs ctx e @{noOr1 ne}
+          compareType (extendTy Zero eret.name ety ctx) eret.term fret.term
+          compare0 ctx
+            (sub1 eret (Ann (Zero ezer.loc) (Nat ezer.loc) ezer.loc))
+            ezer fzer
+          let [< p, ih] = esuc.names
+          compare0
+            (extendTyN [< (epi, p, Nat p.loc), (epi', ih, eret.term)] ctx)
+            (substCaseSuccRet esuc.names eret) esuc.term fsuc.term
+          expectEqualQ e.loc epi  fpi
+          expectEqualQ e.loc epi' fpi'
+      compare0' ctx e@(CaseNat {}) f _ _ = clashE e.loc ctx e f
 
-  private %inline
-  succeeds : Eff EqualInner a -> Eff EqualElim Bool
-  succeeds act = lift $ map isRight $ runExcept act
+      --  Ψ | Γ ⊢ e = f ⇒ [ρ. A]
+      --  Ψ | Γ, x : [ρ. A] ⊢ Q = R
+      --  Ψ | Γ, x : A ⊢ s = t ⇐ Q[([x] ∷ [ρ. A])/x]
+      -- --------------------------------------------------
+      --  Ψ | Γ ⊢ caseπ e return Q of { [x] ⇒ s }
+      --        = caseπ f return R of { [x] ⇒ t } ⇒ Q[e/x]
+      compare0' ctx (CaseBox epi e eret ebody eloc)
+                    (CaseBox fpi f fret fbody floc) ne nf =
+        local_ Equal $ do
+          compare0 ctx e f
+          ety <- computeElimTypeE defs ctx e @{noOr1 ne}
+          compareType (extendTy Zero eret.name ety ctx) eret.term fret.term
+          (q, ty) <- expectBOX defs ctx eloc ety
+          compare0 (extendTy (epi * q) ebody.name ty ctx)
+            (substCaseBoxRet ebody.name ety eret)
+            ebody.term fbody.term
+          expectEqualQ eloc epi fpi
+      compare0' ctx e@(CaseBox {}) f _ _ = clashE e.loc ctx e f
 
-  private covering %inline
-  clashE : (defs : Definitions) -> (ctx : EqContext n) -> (sg : SQty) ->
-           (e, f : Elim 0 n) -> (0 nf : NotRedexEq defs ctx sg f) =>
-           Eff EqualElim (Term 0 n)
-  clashE defs ctx sg e f = do
-    putError $ ClashE e.loc ctx !mode e f
-    computeElimTypeE defs ctx sg f
+      -- all dim apps replaced with ends by whnf
+      compare0' _ (DApp _ (K {}) _) _ ne _ = void $ absurd $ noOr2 $ noOr2 ne
+      compare0' _ _ (DApp _ (K {}) _) _ nf = void $ absurd $ noOr2 $ noOr2 nf
 
+      --  Ψ | Γ ⊢ s <: t : B
+      -- --------------------------------
+      --  Ψ | Γ ⊢ (s ∷ A) <: (t ∷ B) ⇒ B
+      --
+      -- and similar for :> and A
+      compare0' ctx (Ann s a _) (Ann t b _) _ _ =
+        let ty = case !mode of Super => a; _ => b in
+        Term.compare0 ctx ty s t
 
-  ||| compare two type-case branches, which came from the arms of the given
-  ||| kind. `ret` is the return type of the case expression, and `u` is the
-  ||| universe the head is in.
-  private covering
-  compareArm : Definitions -> EqContext n -> (k : TyConKind) ->
-               (ret : Term 0 n) -> (u : Universe) ->
-               (b1, b2 : Maybe (TypeCaseArmBody k 0 n)) ->
-               (def : Term 0 n) ->
-               Eff EqualElim ()
-  compareArm {b1 = Nothing, b2 = Nothing, _} = pure ()
-  compareArm defs ctx k ret u b1 b2 def = do
-    let def   = SN def
-        left  = fromMaybe def b1; right = fromMaybe def b2
-        names = (fromMaybe def $ b1 <|> b2).names
-    try $ compare0 defs (extendTyN (typecaseTel k names u) ctx)
-                   SZero (weakT (arity k) ret) left.term right.term
+      --  Ψ | Γ ⊢ A‹p₁/𝑖› <: B‹p₂/𝑖›
+      --  Ψ | Γ ⊢ A‹q₁/𝑖› <: B‹q₂/𝑖›
+      --  Ψ | Γ ⊢ s <: t ⇐ B‹p₂/𝑖›
+      -- -----------------------------------------------------------
+      --  Ψ | Γ ⊢ coe [𝑖 ⇒ A] @p₁ @q₁ s
+      --       <: coe [𝑖 ⇒ B] @p₂ @q₂ t ⇒ B‹q₂/𝑖›
+      compare0' ctx (Coe ty1 p1 q1 val1 _)
+                    (Coe ty2 p2 q2 val2 _) ne nf = do
+        let typ1 = dsub1 ty1 p1; tyq1 = dsub1 ty1 q1
+            typ2 = dsub1 ty2 p2; tyq2 = dsub1 ty2 q2
+        compareType ctx typ1 typ2
+        compareType ctx tyq1 tyq2
+        let ty = case !mode of Super => typ1; _ => typ2
+        Term.compare0 ctx ty val1 val2
+      compare0' ctx e@(Coe {}) f _ _ = clashE e.loc ctx e f
 
-  private covering
-  compare0Inner : Definitions -> EqContext n -> (sg : SQty) ->
-                  (e, f : Elim 0 n) -> Eff EqualElim (Term 0 n)
+      -- (no neutral compositions in a closed dctx)
+      compare0' _ (Comp {r = K e _, _}) _ ne _ = void $ absurd $ noOr2 ne
+      compare0' _ (Comp {r = B i _, _}) _ _ _ = absurd i
+      compare0' _ _ (Comp {r = K _ _, _}) _ nf = void $ absurd $ noOr2 nf
 
-  private covering
-  compare0Inner' : (defs : Definitions) -> (ctx : EqContext n) -> (sg : SQty) ->
-                   (e, f : Elim 0 n) ->
-                   (0 ne : NotRedexEq defs ctx sg e) ->
-                   (0 nf : NotRedexEq defs ctx sg f) ->
-                   Eff EqualElim (Term 0 n)
+      -- (type case equality purely structural)
+      compare0' ctx (TypeCase ty1 ret1 arms1 def1 eloc)
+                    (TypeCase ty2 ret2 arms2 def2 floc) ne _ =
+        local_ Equal $ do
+          compare0 ctx ty1 ty2
+          u <- expectTYPE defs ctx eloc =<<
+               computeElimTypeE defs ctx ty1 @{noOr1 ne}
+          compareType ctx ret1 ret2
+          compareType ctx def1 def2
+          for_ allKinds $ \k =>
+            compareArm ctx k ret1 u
+              (lookupPrecise k arms1) (lookupPrecise k arms2) def1
+      compare0' ctx e@(TypeCase {}) f _ _ = clashE e.loc ctx e f
 
-  -- (no neutral dim apps or comps in a closed dctx)
-  compare0Inner' _ _ _ (DApp _ (K {}) _) _ ne _ =
-    void $ absurd $ noOr2 $ noOr2 ne
-  compare0Inner' _ _ _ _ (DApp _ (K {}) _) _ nf =
-    void $ absurd $ noOr2 $ noOr2 nf
-  compare0Inner' _ _ _ (Comp {r = K {}, _}) _ ne _ = void $ absurd $ noOr2 ne
-  compare0Inner' _ _ _ (Comp {r = B i _, _}) _ _ _ = absurd i
-  compare0Inner' _ _ _ _ (Comp {r = K {}, _}) _ nf = void $ absurd $ noOr2 nf
+      --     Ψ | Γ ⊢ s <: f ⇐ A
+      -- --------------------------
+      --  Ψ | Γ ⊢ (s ∷ A) <: f ⇒ A
+      --
+      -- and vice versa
+      compare0' ctx (Ann s a _) f           _ _ = Term.compare0 ctx a s (E f)
+      compare0' ctx e           (Ann t b _) _ _ = Term.compare0 ctx b (E e) t
+      compare0' ctx e@(Ann {})  f           _ _ = clashE e.loc ctx e f
 
-  --  Ψ | Γ ⊢ A‹p₁/𝑖› <: B‹p₂/𝑖›
-  --  Ψ | Γ ⊢ A‹q₁/𝑖› <: B‹q₂/𝑖›
-  --  Ψ | Γ ⊢ s <: t ⇐ B‹p₂/𝑖›
-  -- -----------------------------------------------------------
-  --  Ψ | Γ ⊢ coe [𝑖 ⇒ A] @p₁ @q₁ s
-  --       <: coe [𝑖 ⇒ B] @p₂ @q₂ t ⇒ B‹q₂/𝑖›
-  compare0Inner' defs ctx sg (Coe ty1 p1 q1 val1 _)
-                             (Coe ty2 p2 q2 val2 _) ne nf = do
-    let ty1p = dsub1 ty1 p1; ty2p = dsub1 ty2 p2
-        ty1q = dsub1 ty1 q1; ty2q = dsub1 ty2 q2
-    (ty_p, ty_q) <- bigger (ty1p, ty1q) (ty2p, ty2q)
-    try $ do
-      compareType defs ctx ty1p ty2p
-      compareType defs ctx ty1q ty2q
-      Term.compare0 defs ctx sg ty_p val1 val2
-    pure $ ty_q
+      ||| compare two type-case branches, which came from the arms of the given
+      ||| kind. `ret` is the return type of the case expression, and `u` is the
+      ||| universe the head is in.
+      private covering
+      compareArm : EqContext n -> (k : TyConKind) ->
+                   (ret : Term 0 n) -> (u : Universe) ->
+                   (b1, b2 : Maybe (TypeCaseArmBody k 0 n)) ->
+                   (def : Term 0 n) ->
+                   Equal_ ()
+      compareArm {b1 = Nothing, b2 = Nothing, _} = pure ()
+      compareArm ctx k ret u b1 b2 def =
+        let def = SN def in
+        compareArm_ ctx k ret u (fromMaybe def b1) (fromMaybe def b2)
 
-  -- an adaptation of the rule
-  --
-  --  Ψ | Γ ⊢ A‹0/𝑖› = A‹1/𝑖› ⇐ ★
-  -- -----------------------------------------------------
-  --  Ψ | Γ ⊢ coe (𝑖 ⇒ A) @p @q s ⇝ (s ∷ A‹1/𝑖›) ⇒ A‹1/𝑖›
-  --
-  -- it's here so that whnf doesn't have to depend on the equality checker
-  compare0Inner' defs ctx sg (Coe ty p q val loc) f _ _ =
-    if !(succeeds $ withEqual $ compareType defs ctx ty.zero ty.one)
-       then compare0Inner defs ctx sg (Ann val (dsub1 ty q) loc) f
-       else clashE defs ctx sg (Coe ty p q val loc) f
+      private covering
+      compareArm_ : EqContext n -> (k : TyConKind) ->
+                    (ret : Term 0 n) -> (u : Universe) ->
+                    (b1, b2 : TypeCaseArmBody k 0 n) ->
+                    Equal_ ()
+      compareArm_ ctx KTYPE ret u b1 b2 =
+        compare0 ctx ret b1.term b2.term
 
-  -- symmetric version of the above
-  compare0Inner' defs ctx sg e (Coe ty p q val loc) _ _ =
-    if !(succeeds $ withEqual $ compareType defs ctx ty.zero ty.one)
-       then compare0Inner defs ctx sg e (Ann val (dsub1 ty q) loc)
-       else clashE defs ctx sg e (Coe ty p q val loc)
+      compareArm_ ctx KPi ret u b1 b2 = do
+        let [< a, b] = b1.names
+            ctx = extendTyN
+              [< (Zero, a, TYPE u a.loc),
+                 (Zero, b, Arr Zero (BVT 0 b.loc) (TYPE u b.loc) b.loc)] ctx
+        compare0 ctx (weakT 2 ret) b1.term b2.term
 
-  compare0Inner' defs ctx sg e@(F {}) f _ _ = do
-    if e == f then computeElimTypeE defs ctx sg f
-              else clashE defs ctx sg e f
+      compareArm_ ctx KSig ret u b1 b2 = do
+        let [< a, b] = b1.names
+            ctx = extendTyN
+              [< (Zero, a, TYPE u a.loc),
+                 (Zero, b, Arr Zero (BVT 0 b.loc) (TYPE u b.loc) b.loc)] ctx
+        compare0 ctx (weakT 2 ret) b1.term b2.term
 
-  compare0Inner' defs ctx sg e@(B {}) f _ _ = do
-    if e == f then computeElimTypeE defs ctx sg f
-              else clashE defs ctx sg e f
+      compareArm_ ctx KW ret u b1 b2 = do
+        let [< a, b] = b1.names
+            ctx = extendTyN
+              [< (Zero, a, TYPE u a.loc),
+                 (Zero, b, Arr Zero (BVT 0 b.loc) (TYPE u b.loc) b.loc)] ctx
+        compare0 ctx (weakT 2 ret) b1.term b2.term
 
-  --  Ψ | Γ ⊢ e = f ⇒ π.(x : A) → B
-  --  Ψ | Γ ⊢ s = t ⇐ A
-  -- -------------------------------
-  --  Ψ | Γ ⊢ e s = f t ⇒ B[s∷A/x]
-  compare0Inner' defs ctx sg (App e s eloc) (App f t floc) ne nf = do
-    ety <- compare0Inner defs ctx sg e f
-    (_, arg, res) <- expectPi defs ctx sg eloc ety
-    try $ Term.compare0 defs ctx sg arg s t
-    pure $ sub1 res $ Ann s arg s.loc
-  compare0Inner' defs ctx sg e'@(App {}) f' ne nf =
-    clashE defs ctx sg e' f'
+      compareArm_ ctx KEnum ret u b1 b2 =
+        compare0 ctx ret b1.term b2.term
 
-  --  Ψ | Γ ⊢ e = f ⇒ (x : A) × B
-  --  Ψ | Γ, 0.p : (x : A) × B ⊢ Q = R
-  --  Ψ | Γ, x : A, y : B ⊢ s = t ⇐ Q[((x, y) ∷ (x : A) × B)/p]
-  -- -----------------------------------------------------------
-  --    Ψ | Γ ⊢ caseπ e return Q of { (x, y) ⇒ s }
-  --          = caseπ f return R of { (x, y) ⇒ t } ⇒ Q[e/p]
-  compare0Inner' defs ctx sg (CasePair epi e eret ebody eloc)
-                             (CasePair fpi f fret fbody floc) ne nf =
-    withEqual $ do
-      ety <- compare0Inner defs ctx sg e f
-      (fst, snd) <- expectSig defs ctx sg eloc ety
-      let [< x, y] = ebody.names
-      try $ do
-        compareType defs (extendTy0 eret.name ety ctx) eret.term fret.term
-        Term.compare0 defs
-          (extendTyN [< (epi, x, fst), (epi, y, snd.term)] ctx) sg
-          (substCasePairRet ebody.names ety eret)
-          ebody.term fbody.term
-        expectEqualQ e.loc epi fpi
-      pure $ sub1 eret e
-  compare0Inner' defs ctx sg e'@(CasePair {}) f' ne nf =
-    clashE defs ctx sg e' f'
+      compareArm_ ctx KEq ret u b1 b2 = do
+        let [< a0, a1, a, l, r] = b1.names
+            ctx = extendTyN
+              [< (Zero, a0, TYPE u a0.loc),
+                 (Zero, a1, TYPE u a1.loc),
+                 (Zero, a,  Eq0 (TYPE u a.loc)
+                                (BVT 1 a0.loc) (BVT 0 a1.loc) a.loc),
+                 (Zero, l,  BVT 2 a0.loc),
+                 (Zero, r,  BVT 2 a1.loc)] ctx
+        compare0 ctx (weakT 5 ret) b1.term b2.term
 
-  --  Ψ | Γ ⊢ e = f ⇒ (x : A) × B
-  -- ------------------------------
-  --  Ψ | Γ ⊢ fst e = fst f ⇒ A
-  compare0Inner' defs ctx sg (Fst e eloc) (Fst f floc) ne nf =
-    withEqual $ do
-      ety <- compare0Inner defs ctx sg e f
-      fst <$> expectSig defs ctx sg eloc ety
-  compare0Inner' defs ctx sg e@(Fst {}) f _ _ =
-    clashE defs ctx sg e f
+      compareArm_ ctx KNat ret u b1 b2 =
+        compare0 ctx ret b1.term b2.term
 
-  --  Ψ | Γ ⊢ e = f ⇒ (x : A) × B
-  -- ------------------------------------
-  --  Ψ | Γ ⊢ snd e = snd f ⇒ B[fst e/x]
-  compare0Inner' defs ctx sg (Snd e eloc) (Snd f floc) ne nf =
-    withEqual $ do
-      ety <- compare0Inner defs ctx sg e f
-      (_, tsnd) <- expectSig defs ctx sg eloc ety
-      pure $ sub1 tsnd (Fst e eloc)
-  compare0Inner' defs ctx sg e@(Snd {}) f _ _ =
-    clashE defs ctx sg e f
+      compareArm_ ctx KBOX ret u b1 b2 = do
+        let ctx = extendTy Zero b1.name (TYPE u b1.name.loc) ctx
+        compare0 ctx (weakT 1 ret) b1.term b1.term
 
-  --  Ψ | Γ ⊢ e = f ⇒ {𝐚s}
-  --  Ψ | Γ, x : {𝐚s} ⊢ Q = R
-  --  Ψ | Γ ⊢ sᵢ = tᵢ ⇐ Q[𝐚ᵢ∷{𝐚s}]
-  -- --------------------------------------------------
-  --  Ψ | Γ ⊢ caseπ e return Q of { '𝐚ᵢ ⇒ sᵢ }
-  --        = caseπ f return R of { '𝐚ᵢ ⇒ tᵢ } ⇒ Q[e/x]
-  compare0Inner' defs ctx sg (CaseEnum epi e eret earms eloc)
-                             (CaseEnum fpi f fret farms floc) ne nf =
-    withEqual $ do
-      ety <- compare0Inner defs ctx sg e f
-      try $
-        compareType defs (extendTy0 eret.name ety ctx) eret.term fret.term
-      for_ (SortedMap.toList earms) $ \(t, l) => do
-        let Just r = lookup t farms
-          | Nothing => putError $ TagNotIn floc t (fromList $ keys farms)
-        let t' = Ann (Tag t l.loc) ety l.loc
-        try $ Term.compare0 defs ctx sg (sub1 eret t') l r
-      try $ expectEqualQ eloc epi fpi
-      pure $ sub1 eret e
-  compare0Inner' defs ctx sg e@(CaseEnum {}) f _ _ = clashE defs ctx sg e f
-
-  --  Ψ | Γ ⊢ e = f ⇒ ℕ
-  --  Ψ | Γ, x : ℕ ⊢ Q = R
-  --  Ψ | Γ ⊢ s₀ = t₀ ⇐ Q[(0 ∷ ℕ)/x]
-  --  Ψ | Γ, x : ℕ, y : Q ⊢ s₁ = t₁ ⇐ Q[(succ x ∷ ℕ)/x]
-  -- -----------------------------------------------------
-  --  Ψ | Γ ⊢ caseπ e return Q of { 0 ⇒ s₀; x, π.y ⇒ s₁ }
-  --        = caseπ f return R of { 0 ⇒ t₀; x, π.y ⇒ t₁ }
-  --        ⇒ Q[e/x]
-  compare0Inner' defs ctx sg (CaseNat epi epi' e eret ezer esuc eloc)
-                             (CaseNat fpi fpi' f fret fzer fsuc floc) ne nf =
-    withEqual $ do
-      ety <- compare0Inner defs ctx sg e f
-      let [< p, ih] = esuc.names
-      try $ do
-        compareType defs (extendTy0 eret.name ety ctx) eret.term fret.term
-        Term.compare0 defs ctx sg
-          (sub1 eret (Ann (Zero ezer.loc) (NAT ezer.loc) ezer.loc))
-          ezer fzer
-        Term.compare0 defs
-          (extendTyN [< (epi, p, NAT p.loc), (epi', ih, eret.term)] ctx) sg
-          (substCaseSuccRet esuc.names eret) esuc.term fsuc.term
-        expectEqualQ e.loc epi  fpi
-        expectEqualQ e.loc epi' fpi'
-      pure $ sub1 eret e
-  compare0Inner' defs ctx sg e@(CaseNat {}) f _ _ = clashE defs ctx sg e f
-
-  --  Ψ | Γ ⊢ e = f ⇒ [ρ. A]
-  --  Ψ | Γ, x : [ρ. A] ⊢ Q = R
-  --  Ψ | Γ, x : A ⊢ s = t ⇐ Q[([x] ∷ [ρ. A])/x]
-  -- --------------------------------------------------
-  --  Ψ | Γ ⊢ caseπ e return Q of { [x] ⇒ s }
-  --        = caseπ f return R of { [x] ⇒ t } ⇒ Q[e/x]
-  compare0Inner' defs ctx sg (CaseBox epi e eret ebody eloc)
-                             (CaseBox fpi f fret fbody floc) ne nf =
-    withEqual $ do
-      ety <- compare0Inner defs ctx sg e f
-      (q, ty) <- expectBOX defs ctx sg eloc ety
-      try $ do
-        compareType defs (extendTy0 eret.name ety ctx) eret.term fret.term
-        Term.compare0 defs (extendTy (epi * q) ebody.name ty ctx) sg
-          (substCaseBoxRet ebody.name ety eret)
-          ebody.term fbody.term
-        expectEqualQ eloc epi fpi
-      pure $ sub1 eret e
-  compare0Inner' defs ctx sg e@(CaseBox {}) f _ _ = clashE defs ctx sg e f
-
-  --  Ψ | Γ ⊢ s <: t : B
-  -- --------------------------------
-  --  Ψ | Γ ⊢ (s ∷ A) <: (t ∷ B) ⇒ B
-  --
-  -- and similar for :> and A
-  compare0Inner' defs ctx sg (Ann s a _) (Ann t b _) _ _ = do
-    ty <- bigger a b
-    try $ Term.compare0 defs ctx sg ty s t
-    pure ty
-
-  -- (type case equality purely structural)
-  compare0Inner' defs ctx sg (TypeCase ty1 ret1 arms1 def1 eloc)
-                             (TypeCase ty2 ret2 arms2 def2 floc) ne _ =
-    case sg `decEq` SZero of
-      Yes Refl => withEqual $ do
-        ety <- compare0Inner defs ctx SZero ty1 ty2
-        u   <- expectTYPE defs ctx SZero eloc ety
-        try $ do
-          compareType defs ctx ret1 ret2
-          compareType defs ctx def1 def2
-        for_ allKinds $ \k =>
-          compareArm defs ctx k ret1 u
-            (lookupPrecise k arms1) (lookupPrecise k arms2) def1
-        pure ret1
-      No _ => do
-        putError $ ClashQ eloc sg.qty Zero
-        computeElimTypeE defs ctx sg $ TypeCase ty1 ret1 arms1 def1 eloc
-  compare0Inner' defs ctx sg e@(TypeCase {}) f _ _ = clashE defs ctx sg e f
-
-  --     Ψ | Γ ⊢ s <: f ⇐ A
-  -- --------------------------
-  --  Ψ | Γ ⊢ (s ∷ A) <: f ⇒ A
-  --
-  -- and vice versa
-  compare0Inner' defs ctx sg (Ann s a _) f _ _ = do
-    try $ Term.compare0 defs ctx sg a s (E f)
-    pure a
-  compare0Inner' defs ctx sg e (Ann t b _) _ _ = do
-    try $ Term.compare0 defs ctx sg b (E e) t
-    pure b
-  compare0Inner' defs ctx sg e@(Ann {}) f _ _ =
-    clashE defs ctx sg e f
-
-  compare0Inner defs ctx sg e f = do
-    Element e ne <- whnf defs ctx sg e.loc e
-    Element f nf <- whnf defs ctx sg f.loc f
-    ty <- compare0Inner' defs ctx sg e f ne nf
-    if !(lift $ isSubSing defs ctx sg ty) && isJust !(getAt InnerErr)
-       then putAt InnerErr Nothing
-       else modifyAt InnerErr $ map $ WhileComparingE ctx !mode sg e f
-    pure ty
-
-
-namespace Term
-  export covering %inline
-  compare0NoLog :
-    Definitions -> EqContext n -> SQty -> (ty, s, t : Term 0 n) ->
-    Eff EqualInner ()
-  compare0NoLog defs ctx sg ty s t =
-    wrapErr (WhileComparingT ctx !mode sg ty s t) $ do
-      Element ty' _ <- whnf defs ctx SZero ty.loc ty
-      Element s'  _ <- whnf defs ctx sg s.loc  s
-      Element t'  _ <- whnf defs ctx sg t.loc  t
-      tty <- ensureTyCon ty.loc ctx ty'
-      compare0' defs ctx sg ty' s' t'
-
-  compare0 defs ctx sg ty s t = do
-    sayMany "equal" s.loc
-      [30 :> "Term.compare0",
-       30 :> hsep ["mode =", pshow !mode],
-       95 :> hsep ["ctx =", runPretty $ prettyEqContext ctx],
-       95 :> hsep ["sg =", runPretty $ prettyQty sg.qty],
-       31 :> hsep ["ty =", runPretty $ prettyTerm [<] ctx.tnames ty],
-       30 :> hsep ["s =", runPretty $ prettyTerm [<] ctx.tnames s],
-       30 :> hsep ["t =", runPretty $ prettyTerm [<] ctx.tnames t]]
-    compare0NoLog defs ctx sg ty s t
-
-namespace Elim
-  export covering %inline
-  compare0NoLog :
-    Definitions -> EqContext n -> SQty -> (e, f : Elim 0 n) ->
-    Eff EqualInner (Term 0 n)
-  compare0NoLog defs ctx sg e f = do
-    (ty, err) <- runStateAt InnerErr Nothing $ compare0Inner defs ctx sg e f
-    maybe (pure ty) throw err
-
-  compare0 defs ctx sg e f = do
-    sayMany "equal" e.loc
-      [30 :> "Elim.compare0",
-       30 :> hsep ["mode =", pshow !mode],
-       95 :> hsep ["ctx =", runPretty $ prettyEqContext ctx],
-       95 :> hsep ["sg =", runPretty $ prettyQty sg.qty],
-       30 :> hsep ["e =", runPretty $ prettyElim [<] ctx.tnames e],
-       30 :> hsep ["f =", runPretty $ prettyElim [<] ctx.tnames f]]
-    ty <- compare0NoLog defs ctx sg e f
-    say "equal" 31 e.loc $
-      hsep ["Elim.compare0 ⇝", runPretty $ prettyTerm [<] ctx.tnames ty]
-    pure ty
-
-export covering %inline
-compareTypeNoLog :
-  Definitions -> EqContext n -> (s, t : Term 0 n) -> Eff EqualInner ()
-compareTypeNoLog defs ctx s t = do
-  Element s' _ <- whnf defs ctx SZero s.loc s
-  Element t' _ <- whnf defs ctx SZero t.loc t
-  ts <- ensureTyCon s.loc ctx s'
-  tt <- ensureTyCon t.loc ctx t'
-  let Left _ = choose $ sameTyCon s' t' | _ => clashTy s.loc ctx s' t'
-  compareType' defs ctx s' t'
-
-compareType defs ctx s t = do
-  sayMany "equal" s.loc
-    [30 :> "compareType",
-     30 :> hsep ["mode =", pshow !mode],
-     95 :> hsep ["ctx =", runPretty $ prettyEqContext ctx],
-     30 :> hsep ["s =", runPretty $ prettyTerm [<] ctx.tnames s],
-     30 :> hsep ["t =", runPretty $ prettyTerm [<] ctx.tnames t]]
-  compareTypeNoLog defs ctx s t
-
-
-private
-getVars : TyContext d _ -> FreeVars d -> List BindName
-getVars ctx (FV fvs) = case ctx.dctx of
-  ZeroIsOne => []
-  C eqs     => toList $ getVars' ctx.dnames eqs fvs
-where
-  getVars' : BContext d' -> DimEq' d' -> FreeVars' d' -> SnocList BindName
-  getVars' (names :< name) (eqs :< eq) (fvs :< fv) =
-    let rest = getVars' names eqs fvs in
-    case eq of Nothing => rest :< name
-               Just _  => rest
-  getVars' [<] [<] [<] = [<]
 
 parameters (loc : Loc) (ctx : TyContext d n)
+  -- [todo] only split on the dvars that are actually used anywhere in
+  -- the calls to `splits`
+
   parameters (mode : EqMode)
     private
-    fromInner : Eff EqualInner a -> Eff Equal a
-    fromInner = lift . map fst . runState mode
+    fromEqual_ : Equal_ a -> Equal a
+    fromEqual_ act = lift $ evalState mode act
 
     private
-    eachCorner : Has Log fs => Loc -> FreeVars d ->
-                 (EqContext n -> DSubst d 0 -> Eff fs ()) -> Eff fs ()
-    eachCorner loc fvs act = do
-      say "equal" 50 loc $
-        let vars = map prettyBind' (getVars ctx fvs) in
-        hsep $ "eachCorner: split on" :: if null vars then ["(none)"] else vars
-      for_ (splits loc ctx.dctx fvs) $ \th =>
-        act (makeEqContext ctx th) th
+    eachFace : Applicative f => (EqContext n -> DSubst d 0 -> f ()) -> f ()
+    eachFace act =
+      for_ (splits loc ctx.dctx) $ \th => act (makeEqContext ctx th) th
 
     private
-    CompareAction : Nat -> Nat -> Type
-    CompareAction d n =
-      Definitions -> EqContext n -> DSubst d 0 -> Eff EqualInner ()
-
-    private
-    runCompare : Loc -> FreeVars d -> CompareAction d n -> Eff Equal ()
-    runCompare loc fvs act = fromInner $ eachCorner loc fvs $ act !(askAt DEFS)
-
-    private
-    foldMap1 : Semigroup b => (a -> b) -> List1 a -> b
-    foldMap1 f = foldl1By (\x, y => x <+> f y) f
-
-    private
-    fdvAll : HasFreeDVars t => (xs : List (t d n)) -> (0 _ : NonEmpty xs) =>
-             FreeVars d
-    fdvAll (x :: xs) = foldMap1 (fdvWith ctx.dimLen ctx.termLen) (x ::: xs)
+    runCompare : (Definitions -> EqContext n -> DSubst d 0 -> Equal_ ()) ->
+                 Equal ()
+    runCompare act = fromEqual_ $ eachFace $ act !(askAt DEFS)
 
     namespace Term
       export covering
-      compare : SQty -> (ty, s, t : Term d n) -> Eff Equal ()
-      compare sg ty s t = runCompare s.loc (fdvAll [ty, s, t]) $
-        \defs, ectx, th => compare0 defs ectx sg (ty // th) (s // th) (t // th)
+      compare : (ty, s, t : Term d n) -> Equal ()
+      compare ty s t = runCompare $ \defs, ectx, th =>
+        compare0 defs ectx (ty // th) (s // th) (t // th)
 
       export covering
-      compareType : (s, t : Term d n) -> Eff Equal ()
-      compareType s t = runCompare s.loc (fdvAll [s, t]) $
-        \defs, ectx, th => compareType defs ectx (s // th) (t // th)
+      compareType : (s, t : Term d n) -> Equal ()
+      compareType s t = runCompare $ \defs, ectx, th =>
+        compareType defs ectx (s // th) (t // th)
 
     namespace Elim
       ||| you don't have to pass the type in but the arguments must still be
       ||| of the same type!!
       export covering
-      compare : SQty -> (e, f : Elim d n) -> Eff Equal ()
-      compare sg e f = runCompare e.loc (fdvAll [e, f]) $
-        \defs, ectx, th => ignore $ compare0 defs ectx sg (e // th) (f // th)
+      compare : (e, f : Elim d n) -> Equal ()
+      compare e f = runCompare $ \defs, ectx, th =>
+        compare0 defs ectx (e // th) (f // th)
 
   namespace Term
     export covering %inline
-    equal, sub, super : SQty -> (ty, s, t : Term d n) -> Eff Equal ()
+    equal, sub, super : (ty, s, t : Term d n) -> Equal ()
     equal = compare Equal
     sub   = compare Sub
     super = compare Super
 
     export covering %inline
-    equalType, subtype, supertype : (s, t : Term d n) -> Eff Equal ()
+    equalType, subtype, supertype : (s, t : Term d n) -> Equal ()
     equalType = compareType Equal
     subtype   = compareType Sub
     supertype = compareType Super
 
   namespace Elim
     export covering %inline
-    equal, sub, super : SQty -> (e, f : Elim d n) -> Eff Equal ()
+    equal, sub, super : (e, f : Elim d n) -> Equal ()
     equal = compare Equal
     sub   = compare Sub
     super = compare Super
diff --git a/lib/Quox/FreeVars.idr b/lib/Quox/FreeVars.idr
deleted file mode 100644
index de52813..0000000
--- a/lib/Quox/FreeVars.idr
+++ /dev/null
@@ -1,310 +0,0 @@
-module Quox.FreeVars
-
-import Quox.Syntax.Term.Base
-import Data.Maybe
-import Data.Nat
-import Data.Singleton
-import Data.SortedSet
-import Derive.Prelude
-
-%language ElabReflection
-
-
-public export
-FreeVars' : Nat -> Type
-FreeVars' n = Context' Bool n
-
-public export
-record FreeVars n where
-  constructor FV
-  vars : FreeVars' n
-%name FreeVars xs
-
-%runElab deriveIndexed "FreeVars" [Eq, Ord, Show]
-
-
-export %inline
-(||) : FreeVars n -> FreeVars n -> FreeVars n
-FV s || FV t = FV $ zipWith (\x, y => x || y) s t
-
-export %inline
-(&&) : FreeVars n -> FreeVars n -> FreeVars n
-FV s && FV t = FV $ zipWith (\x, y => x && y) s t
-
-export %inline Semigroup (FreeVars n) where (<+>) = (||)
-
-export %inline [AndS] Semigroup (FreeVars n) where (<+>) = (&&)
-
-export
-only : {n : Nat} -> Var n -> FreeVars n
-only i = FV $ only' i where
-  only' : {n' : Nat} -> Var n' -> FreeVars' n'
-  only' VZ     = replicate (pred n') False :< True
-  only' (VS i) = only' i :< False
-
-export %inline
-all : {n : Nat} -> FreeVars n
-all = FV $ replicate n True
-
-export %inline
-none : {n : Nat} -> FreeVars n
-none = FV $ replicate n False
-
-
-export %inline
-uncons : FreeVars (S n) -> (FreeVars n, Bool)
-uncons (FV (xs :< x)) = (FV xs, x)
-
-
-export %inline {n : Nat} -> Monoid (FreeVars n) where neutral = none
-export %inline [AndM] {n : Nat} -> Monoid (FreeVars n) where neutral = all
-
-
-private
-self : {n : Nat} -> Context' (FreeVars n) n
-self = tabulate (\i => FV $ tabulate (== i) n) n
-
-export
-shift : forall from, to. Shift from to -> FreeVars from -> FreeVars to
-shift by (FV xs) = FV $ shift' by xs where
-  shift' : Shift from' to' -> FreeVars' from' -> FreeVars' to'
-  shift' SZ      ctx = ctx
-  shift' (SS by) ctx = shift' by ctx :< False
-
-
-export
-fromSet : {n : Nat} -> SortedSet (Var n) -> FreeVars n
-fromSet vs = FV $ tabulateLT n $ \i => contains (V i) vs
-
-export
-toSet : {n : Nat} -> FreeVars n -> SortedSet (Var n)
-toSet (FV vs) =
-  foldl_ (\s, i => maybe s (\i => insert i s) i) empty $
-  zipWith (\i, b => guard b $> i) (tabulateLT n V) vs
-
-
-public export
-interface HasFreeVars (0 tm : Nat -> Type) where
-  constructor HFV
-  fv : {n : Nat} -> tm n -> FreeVars n
-
-public export
-interface HasFreeDVars (0 tm : TermLike) where
-  constructor HFDV
-  fdv : {d, n : Nat} -> tm d n -> FreeVars d
-
-public export %inline
-fvWith : HasFreeVars tm => Singleton n -> tm n -> FreeVars n
-fvWith (Val n) = fv
-
-public export %inline
-fdvWith : HasFreeDVars tm => Singleton d -> Singleton n -> tm d n -> FreeVars d
-fdvWith (Val d) (Val n) = fdv
-
-export
-Fdv : (0 tm : TermLike) -> {n : Nat} ->
-      HasFreeDVars tm => HasFreeVars (\d => tm d n)
-Fdv tm @{HFDV fdv} = HFV fdv
-
-
-export
-fvEach : {n1, n2 : Nat} -> HasFreeVars env =>
-         Subst env n1 n2 -> Context' (Lazy (FreeVars n2)) n1
-fvEach (Shift by) = map (delay . shift by) self
-fvEach (t ::: th) = fvEach th :< fv t
-
-export
-fdvEach : {d, n1, n2 : Nat} -> HasFreeDVars env =>
-          Subst (env d) n1 n2 -> Context' (Lazy (FreeVars d)) n1
-fdvEach (Shift by) = replicate n1 none
-fdvEach (t ::: th) = fdvEach th :< fdv t
-
-
-export
-HasFreeVars Dim where
-  fv (K _ _) = none
-  fv (B i _) = only i
-
-
-export
-{s : Nat} -> HasFreeVars tm => HasFreeVars (Scoped s tm) where
-  fv (S _ (Y body)) = FV $ drop s (fv body).vars
-  fv (S _ (N body)) = fv body
-
-export
-implementation [DScope]
-  {s : Nat} -> HasFreeDVars tm =>
-  HasFreeDVars (\d, n => Scoped s (\d' => tm d' n) d)
-where
-  fdv (S _ (Y body)) = FV $ drop s (fdv body).vars
-  fdv (S _ (N body)) = fdv body
-
-export
-fvD : {0 tm : TermLike} -> {n : Nat} -> (forall d. HasFreeVars (tm d)) =>
-      Scoped s (\d => tm d n) d -> FreeVars n
-fvD (S _ (Y body)) = fv body
-fvD (S _ (N body)) = fv body
-
-export
-fdvT : HasFreeDVars tm => {s, d, n : Nat} -> Scoped s (tm d) n -> FreeVars d
-fdvT (S _ (Y body)) = fdv body
-fdvT (S _ (N body)) = fdv body
-
-
-private
-guardM : Monoid a => Bool -> Lazy a -> a
-guardM b x = if b then x else neutral
-
-export
-implementation
-  (HasFreeVars tm, HasFreeVars env) =>
-  HasFreeVars (WithSubst tm env)
-where
-  fv (Sub term subst) =
-    let Val from = getFrom subst in
-    foldMap (uncurry guardM) $ zipWith (,) (fv term).vars (fvEach subst)
-
-export
-implementation [WithSubst]
-  ((forall d. HasFreeVars (tm d)), HasFreeDVars tm, HasFreeDVars env) =>
-  HasFreeDVars (\d => WithSubst (tm d) (env d))
-where
-  fdv (Sub term subst) =
-    let Val from = getFrom subst in
-    fdv term <+>
-    foldMap (uncurry guardM) (zipWith (,) (fv term).vars (fdvEach subst))
-
-
-export HasFreeVars (Term d)
-export HasFreeVars (Elim d)
-
-export
-HasFreeVars (Term d) where
-  fv (TYPE    {})             = none
-  fv (IOState {})             = none
-  fv (Pi      {arg, res, _})  = fv arg <+> fv res
-  fv (Lam     {body, _})      = fv body
-  fv (Sig     {fst, snd, _})  = fv fst <+> fv snd
-  fv (Pair    {fst, snd, _})  = fv fst <+> fv snd
-  fv (Enum    {})             = none
-  fv (Tag     {})             = none
-  fv (Eq      {ty, l, r, _})  = fvD ty <+> fv l <+> fv r
-  fv (DLam    {body, _})      = fvD body
-  fv (NAT     {})             = none
-  fv (Nat     {})             = none
-  fv (Succ    {p, _})         = fv p
-  fv (STRING  {})             = none
-  fv (Str     {})             = none
-  fv (BOX     {ty, _})        = fv ty
-  fv (Box     {val, _})       = fv val
-  fv (Let     {rhs, body, _}) = fv rhs <+> fv body
-  fv (E       e)              = fv e
-  fv (CloT    s)              = fv s
-  fv (DCloT   s)              = fv s.term
-
-export
-HasFreeVars (Elim d) where
-  fv (F {}) = none
-  fv (B i _) = only i
-  fv (App {fun, arg, _}) = fv fun <+> fv arg
-  fv (CasePair {pair, ret, body, _}) = fv pair <+> fv ret <+> fv body
-  fv (Fst pair _) = fv pair
-  fv (Snd pair _) = fv pair
-  fv (CaseEnum {tag, ret, arms, _}) =
-    fv tag <+> fv ret <+> foldMap fv (values arms)
-  fv (CaseNat {nat, ret, zero, succ, _}) =
-    fv nat <+> fv ret <+> fv zero <+> fv succ
-  fv (CaseBox {box, ret, body, _}) =
-    fv box <+> fv ret <+> fv body
-  fv (DApp {fun, _}) = fv fun
-  fv (Ann {tm, ty, _}) = fv tm <+> fv ty
-  fv (Coe {ty, val, _}) = fvD ty <+> fv val
-  fv (Comp {ty, val, zero, one, _}) =
-    fv ty <+> fv val <+> fvD zero <+> fvD one
-  fv (TypeCase {ty, ret, arms, def, _}) =
-    fv ty <+> fv ret <+> fv def <+> foldMap (\x => fv x.snd) (toList arms)
-  fv (CloE s) = fv s
-  fv (DCloE s) = fv s.term
-
-
-
-private
-expandDShift : {d1 : Nat} -> Shift d1 d2 -> Loc -> Context' (Dim d2) d1
-expandDShift by loc = tabulateLT d1 (\i => BV i loc // by)
-
-private
-expandDSubst : {d1 : Nat} -> DSubst d1 d2 -> Loc -> Context' (Dim d2) d1
-expandDSubst (Shift by) loc = expandDShift by loc
-expandDSubst (t ::: th) loc = expandDSubst th loc :< t
-
-
-private
-fdvSubst' : {d1, d2, n : Nat} -> (Located2 tm, HasFreeDVars tm) =>
-            tm d1 n -> DSubst d1 d2 -> FreeVars d2
-fdvSubst' t th =
-  fold $ zipWith maybeOnly (fdv t).vars (expandDSubst th t.loc)
-where
-  maybeOnly : {d : Nat} -> Bool -> Dim d -> FreeVars d
-  maybeOnly True (B i _) = only i
-  maybeOnly _    _       = none
-
-private
-fdvSubst : {d, n : Nat} -> (Located2 tm, HasFreeDVars tm) =>
-           WithSubst (\d => tm d n) Dim d -> FreeVars d
-fdvSubst (Sub t th) = let Val from = getFrom th in fdvSubst' t th
-
-
-export HasFreeDVars Term
-export HasFreeDVars Elim
-
-export
-HasFreeDVars Term where
-  fdv (TYPE    {})             = none
-  fdv (IOState {})             = none
-  fdv (Pi      {arg, res, _})  = fdv arg <+> fdvT res
-  fdv (Lam     {body, _})      = fdvT body
-  fdv (Sig     {fst, snd, _})  = fdv fst <+> fdvT snd
-  fdv (Pair    {fst, snd, _})  = fdv fst <+> fdv snd
-  fdv (Enum    {})             = none
-  fdv (Tag     {})             = none
-  fdv (Eq      {ty, l, r, _})  = fdv @{DScope} ty <+> fdv l <+> fdv r
-  fdv (DLam    {body, _})      = fdv @{DScope} body
-  fdv (NAT     {})             = none
-  fdv (Nat     {})             = none
-  fdv (Succ    {p, _})         = fdv p
-  fdv (STRING  {})             = none
-  fdv (Str     {})             = none
-  fdv (BOX     {ty, _})        = fdv ty
-  fdv (Box     {val, _})       = fdv val
-  fdv (Let     {rhs, body, _}) = fdv rhs <+> fdvT body
-  fdv (E       e)              = fdv e
-  fdv (CloT    s)              = fdv s @{WithSubst}
-  fdv (DCloT   s)              = fdvSubst s
-
-export
-HasFreeDVars Elim where
-  fdv (F {}) = none
-  fdv (B {}) = none
-  fdv (App {fun, arg, _}) = fdv fun <+> fdv arg
-  fdv (CasePair {pair, ret, body, _}) = fdv pair <+> fdvT ret <+> fdvT body
-  fdv (Fst pair _) = fdv pair
-  fdv (Snd pair _) = fdv pair
-  fdv (CaseEnum {tag, ret, arms, _}) =
-    fdv tag <+> fdvT ret <+> foldMap fdv (values arms)
-  fdv (CaseNat {nat, ret, zero, succ, _}) =
-    fdv nat <+> fdvT ret <+> fdv zero <+> fdvT succ
-  fdv (CaseBox {box, ret, body, _}) =
-    fdv box <+> fdvT ret <+> fdvT body
-  fdv (DApp {fun, arg, _}) =
-    fdv fun <+> fv arg
-  fdv (Ann {tm, ty, _}) =
-    fdv tm <+> fdv ty
-  fdv (Coe {ty, p, q, val, _}) =
-    fdv @{DScope} ty <+> fv p <+> fv q <+> fdv val
-  fdv (Comp {ty, p, q, val, r, zero, one, _}) =
-    fdv ty <+> fv p <+> fv q <+> fdv val <+>
-    fv r <+> fdv @{DScope} zero <+> fdv @{DScope} one
-  fdv (TypeCase {ty, ret, arms, def, _}) =
-    fdv ty <+> fdv ret <+> fdv def <+> foldMap (\x => fdvT x.snd) (toList arms)
-  fdv (CloE s) = fdv s @{WithSubst}
-  fdv (DCloE s) = fdvSubst s
diff --git a/lib/Quox/Loc.idr b/lib/Quox/Loc.idr
index fae1bf8..7bf5151 100644
--- a/lib/Quox/Loc.idr
+++ b/lib/Quox/Loc.idr
@@ -1,7 +1,6 @@
 ||| file locations
 module Quox.Loc
 
-import Quox.PrettyValExtra
 import public Text.Bounded
 import Data.SortedMap
 import Derive.Prelude
@@ -13,12 +12,12 @@ public export
 FileName : Type
 FileName = String
 
-%runElab derive "Bounds" [Ord, PrettyVal]
+%runElab derive "Bounds" [Ord]
 
 public export
 data Loc_ = NoLoc | YesLoc FileName Bounds
 %name Loc_ loc
-%runElab derive "Loc_" [Eq, Ord, Show, PrettyVal]
+%runElab derive "Loc_" [Eq, Ord, Show]
 
 
 ||| a wrapper for locations which are always considered equal
@@ -40,18 +39,6 @@ public export %inline
 makeLoc : FileName -> Bounds -> Loc
 makeLoc = L .: YesLoc
 
-public export %inline
-loc : FileName -> (sl, sc, el, ec : Int) -> Loc
-loc file sl sc el ec = makeLoc file $ MkBounds sl sc el ec
-
-export
-PrettyVal Loc where
-  prettyVal (L NoLoc) = Con "noLoc" []
-  prettyVal (L (YesLoc file (MkBounds sl sc el ec))) =
-    Con "loc" [prettyVal file,
-               prettyVal sl, prettyVal sc,
-               prettyVal el, prettyVal ec]
-
 
 export
 onlyStart_ : Loc_ -> Loc_
@@ -108,7 +95,7 @@ extendL : Loc -> Loc -> Loc
 extendL l1 l2 = l1 `extend'` l2.bounds
 
 
-export infixr 1 `or_`, `or`
+infixr 1 `or_`, `or`
 export %inline
 or_ : Loc_ -> Loc_ -> Loc_
 or_ l1@(YesLoc {}) _  = l1
@@ -118,15 +105,12 @@ export %inline
 or : Loc -> Loc -> Loc
 or (L l1) (L l2) = L $ l1 `or_` l2
 
-export %inline
-extendOr : Loc -> Loc -> Loc
-extendOr l1 l2 = (l1 `extendL` l2) `or` l2
-
-
 
 public export
 interface Located a where (.loc) : a -> Loc
 
+export %inline Located Loc where l.loc = l
+
 public export
 0 Located1 : (a -> Type) -> Type
 Located1 f = forall x. Located (f x)
@@ -141,12 +125,3 @@ interface Located a => Relocatable a where setLoc : Loc -> a -> a
 public export
 0 Relocatable1 : (a -> Type) -> Type
 Relocatable1 f = forall x. Relocatable (f x)
-
-public export
-0 Relocatable2 : (a -> b -> Type) -> Type
-Relocatable2 f = forall x, y. Relocatable (f x y)
-
-
-export
-locs : Located a => Foldable t => t a -> Loc
-locs = foldl (\loc, y => loc `extendOr` y.loc) noLoc
diff --git a/lib/Quox/Log.idr b/lib/Quox/Log.idr
deleted file mode 100644
index 08d1873..0000000
--- a/lib/Quox/Log.idr
+++ /dev/null
@@ -1,317 +0,0 @@
-module Quox.Log
-
-import Quox.Loc
-import Quox.Pretty
-import Quox.PrettyValExtra
-
-import Data.So
-import Data.DPair
-import Data.Maybe
-import Data.List1
-import Control.Eff
-import Control.Monad.ST.Extra
-import Data.IORef
-import System.File
-import Derive.Prelude
-
-%default total
-%language ElabReflection
-
-
-public export %inline
-maxLogLevel : Nat
-maxLogLevel = 100
-
-public export %inline
-logCategories : List String
-logCategories = ["whnf", "equal", "check"]
-
-public export %inline
-isLogLevel : Nat -> Bool
-isLogLevel l = l <= maxLogLevel
-
-public export
-IsLogLevel : Nat -> Type
-IsLogLevel l = So $ isLogLevel l
-
-public export %inline
-isLogCategory : String -> Bool
-isLogCategory cat = cat `elem` logCategories
-
-public export
-IsLogCategory : String -> Type
-IsLogCategory cat = So $ isLogCategory cat
-
--- Q: why are you using `So` instead of `LT` and `Elem`
--- A: ① proof search gives up before finding a proof of e.g. ``99 `LT` 100``
---      (i.e. `LTESucc⁹⁹ LTEZero`)
---    ② the proofs aren't looked at in any way, i just wanted to make sure the
---      list of categories was consistent everywhere
-
-
-||| a verbosity level from 0–100. higher is noisier. each log entry has a
-||| verbosity level above which it will be printed, chosen, uh, based on vibes.
-public export
-LogLevel : Type
-LogLevel = Subset Nat IsLogLevel
-
-||| a logging category, like "check" (type checking), "whnf", or whatever.
-public export
-LogCategory : Type
-LogCategory = Subset String IsLogCategory
-
-
-public export %inline
-toLogLevel : Nat -> Maybe LogLevel
-toLogLevel l =
-  case choose $ isLogLevel l of
-    Left  y => Just $ Element l y
-    Right _ => Nothing
-
-public export %inline
-toLogCategory : String -> Maybe LogCategory
-toLogCategory c =
-  case choose $ isLogCategory c of
-    Left  y => Just $ Element c y
-    Right _ => Nothing
-
-
-||| verbosity levels for each category, if they differ from the default
-public export
-LevelMap : Type
-LevelMap = List (LogCategory, LogLevel)
-
--- Q: why `List` instead of `SortedMap`
--- A: oof ouch my constant factors (maybe this one was more obvious)
-
-
-public export
-record LogLevels where
-  constructor MkLogLevels
-  defLevel : LogLevel
-  levels   : LevelMap
-%name LogLevels lvls
-%runElab derive "LogLevels" [Eq, Show, PrettyVal]
-
-public export
-LevelStack : Type
-LevelStack = List LogLevels
-
-public export %inline
-defaultLevel : LogLevel
-defaultLevel = Element 0 Oh
-
-export %inline
-defaultLogLevels : LogLevels
-defaultLogLevels = MkLogLevels defaultLevel []
-
-export %inline
-initStack : LevelStack
-initStack = []
-
-export %inline
-getLevel1 : LogCategory -> LogLevels -> LogLevel
-getLevel1 cat (MkLogLevels def lvls) = fromMaybe def $ lookup cat lvls
-
-export %inline
-getLevel : LogCategory -> LevelStack -> LogLevel
-getLevel cat (lvls :: _) = getLevel1 cat lvls
-getLevel cat []          = defaultLevel
-
-export %inline
-getCurLevels : LevelStack -> LogLevels
-getCurLevels (lvls :: _) = lvls
-getCurLevels []          = defaultLogLevels
-
-
-public export
-LogDoc : Type
-LogDoc = Doc (Opts {lineLength = 80})
-
-
-private %inline
-replace : Eq a => a -> b -> List (a, b) -> List (a, b)
-replace k v kvs = (k, v) :: filter (\y => fst y /= k) kvs
-
-private %inline
-mergeLeft : Eq a => List (a, b) -> List (a, b) -> List (a, b)
-mergeLeft l r = foldl (\lst, (k, v) => replace k v lst) r l
-
-
-public export
-data PushArg =
-    SetDefault LogLevel
-  | SetCat     LogCategory LogLevel
-  | SetAll     LogLevel
-%runElab derive "PushArg" [Eq, Ord, Show, PrettyVal]
-%name PushArg push
-
-export %inline
-applyPush : LogLevels -> PushArg -> LogLevels
-applyPush lvls (SetDefault def)     = {defLevel := def} lvls
-applyPush lvls (SetCat     cat lvl) = {levels   $= replace cat lvl} lvls
-applyPush lvls (SetAll     lvl)     = MkLogLevels lvl []
-
-export %inline
-fromPush : PushArg -> LogLevels
-fromPush = applyPush defaultLogLevels
-
-
-public export
-record LogMsg where
-  constructor (:>)
-  level : Nat
-  {auto 0 levelOk : IsLogLevel level}
-  message : Lazy LogDoc
-export infix 0 :>
-%name Log.LogMsg msg
-
-public export
-data LogL : (lbl : tag) -> Type -> Type where
-  ||| print some log messages
-  SayMany : (cat : LogCategory) -> (loc : Loc) ->
-            (msgs : List LogMsg) -> LogL lbl ()
-  ||| set some verbosity levels
-  Push : (push : List PushArg) -> LogL lbl ()
-  ||| restore the previous verbosity levels.
-  ||| returns False if the stack was already empty
-  Pop : LogL lbl Bool
-  ||| returns the current verbosity levels
-  CurLevels : LogL lbl LogLevels
-
-public export
-Log : Type -> Type
-Log = LogL ()
-
-parameters (0 lbl : tag) {auto _ : Has (LogL lbl) fs}
-  public export %inline
-  sayManyAt : (cat : String) -> (0 catOk : IsLogCategory cat) =>
-              Loc -> List LogMsg -> Eff fs ()
-  sayManyAt cat loc msgs {catOk} =
-    send $ SayMany {lbl} (Element cat catOk) loc msgs
-
-  public export %inline
-  sayAt : (cat : String) -> (0 catOk : IsLogCategory cat) =>
-          (lvl : Nat)    -> (0 lvlOk : IsLogLevel lvl) =>
-          Loc -> Lazy LogDoc -> Eff fs ()
-  sayAt cat lvl loc msg = sayManyAt cat loc [lvl :> msg]
-
-  public export %inline
-  pushAt : List PushArg -> Eff fs ()
-  pushAt lvls = send $ Push {lbl} lvls
-
-  public export %inline
-  push1At : PushArg -> Eff fs ()
-  push1At lvl = pushAt [lvl]
-
-  public export %inline
-  popAt : Eff fs Bool
-  popAt = send $ Pop {lbl}
-
-  public export %inline
-  curLevelsAt : Eff fs LogLevels
-  curLevelsAt = send $ CurLevels {lbl}
-
-parameters {auto _ : Has Log fs}
-  public export %inline
-  sayMany : (cat : String) -> (0 catOk : IsLogCategory cat) =>
-            Loc -> List LogMsg -> Eff fs ()
-  sayMany = sayManyAt ()
-
-  public export %inline
-  say : (cat : String) -> (0 _ : IsLogCategory cat) =>
-        (lvl : Nat)    -> (0 _ : IsLogLevel lvl) =>
-        Loc -> Lazy LogDoc -> Eff fs ()
-  say = sayAt ()
-
-  public export %inline
-  push : List PushArg -> Eff fs ()
-  push = pushAt ()
-
-  public export %inline
-  push1 : PushArg -> Eff fs ()
-  push1 = push1At ()
-
-  public export %inline
-  pop : Eff fs Bool
-  pop = popAt ()
-
-  public export %inline
-  curLevels : Eff fs LogLevels
-  curLevels = curLevelsAt ()
-
-
-||| handles a `Log` effect with an existing `State` and `Writer`
-export %inline
-handleLogSW : (0 s : ts) -> (0 w : tw) ->
-              Has (StateL s LevelStack) fs => Has (WriterL w LogDoc) fs =>
-              LogL tag a -> Eff fs a
-handleLogSW s w = \case
-  Push push => modifyAt s $ \lst =>
-    foldl applyPush (fromMaybe defaultLogLevels (head' lst)) push :: lst
-  Pop => stateAt s $ maybe (False, []) (True,) . tail'
-  SayMany cat loc msgs => do
-    catLvl <- getsAt s $ fst . getLevel cat
-    let loc = runPretty $ prettyLoc loc
-    for_ msgs $ \(lvl :> msg) => when (lvl <= catLvl) $ tellAt w $
-      hcat [loc, text cat.fst, "@", pshow lvl, ":"] <++> msg
-  CurLevels =>
-    getsAt s getCurLevels
-
-export %inline
-handleLogSW_ : LogL tag a -> Eff [State LevelStack, Writer LogDoc] a
-handleLogSW_ = handleLogSW () ()
-
-export %inline
-handleLogIO : HasIO m => MonadRec m =>
-              (FileError -> m ()) -> IORef LevelStack -> File ->
-              LogL tag a -> m a
-handleLogIO th lvls h act =
-  runEff (handleLogSW_ act) [handleStateIORef lvls, handleWriter {m} printMsg]
-where printMsg : LogDoc -> m ()
-      printMsg msg = fPutStr h (render _ msg) >>= either th pure
-
-export %inline
-handleLogST : HasST m => MonadRec (m s) =>
-              STRef s (SnocList LogDoc) -> STRef s LevelStack ->
-              LogL tag a -> m s a
-handleLogST docs lvls act =
-  runEff (handleLogSW_ act) [handleStateSTRef lvls, handleWriterSTRef docs]
-
-export %inline
-handleLogDiscard : (0 s : ts) -> Has (StateL s Nat) fs =>
-                   LogL tag a -> Eff fs a
-handleLogDiscard s = \case
-  Push _     => modifyAt s S
-  Pop        => stateAt s $ \k => (k > 0, pred k)
-  SayMany {} => pure ()
-  CurLevels  => pure defaultLogLevels
-
-export %inline
-handleLogDiscard_ : LogL tag a -> Eff [State Nat] a
-handleLogDiscard_ = handleLogDiscard ()
-
-export %inline
-handleLogDiscardST : HasST m => MonadRec (m s) => STRef s Nat ->
-                     LogL tag a -> m s a
-handleLogDiscardST ref act =
-  runEff (handleLogDiscard_ act) [handleStateSTRef ref]
-
-export %inline
-handleLogDiscardIO : HasIO m => MonadRec m => IORef Nat ->
-                     LogL tag a -> m a
-handleLogDiscardIO ref act =
-  runEff (handleLogDiscard_ act) [handleStateIORef ref]
-
-
-||| approximate the push/pop effects in a discarded log by trimming a stack or
-||| repeating its most recent element
-export %inline
-fixupDiscardedLog : Nat -> LevelStack -> LevelStack
-fixupDiscardedLog want lvls =
-  let len = length lvls in
-  case compare len want of
-    EQ => lvls
-    GT => drop (len `minus` want) lvls
-    LT => let new = fromMaybe defaultLogLevels $ head' lvls in
-          replicate (want `minus` len) new ++ lvls
diff --git a/lib/Quox/Name.idr b/lib/Quox/Name.idr
index 8686e54..c6b3435 100644
--- a/lib/Quox/Name.idr
+++ b/lib/Quox/Name.idr
@@ -2,10 +2,9 @@ module Quox.Name
 
 import Quox.Loc
 import Quox.CharExtra
-import Quox.PrettyValExtra
 import public Data.SnocList
 import Data.List
-import Control.Eff
+import Quox.EffExtra
 import Text.Lexer
 import Derive.Prelude
 
@@ -24,7 +23,7 @@ data BaseName
 = UN String         -- user-given name
 | MN String NameSuf -- machine-generated name
 | Unused            -- "_"
-%runElab derive "BaseName" [Eq, Ord, PrettyVal]
+%runElab derive "BaseName" [Eq, Ord]
 
 export
 baseStr : BaseName -> String
@@ -43,14 +42,14 @@ Mods = SnocList String
 
 public export
 record Name where
-  constructor MkName
+  constructor MakeName
   mods : Mods
   base : BaseName
 %runElab derive "Name" [Eq, Ord]
 
 public export %inline
 unq : BaseName -> Name
-unq = MkName [<]
+unq = MakeName [<]
 
 ||| add some namespaces to the beginning of a name
 public export %inline
@@ -64,31 +63,31 @@ PBaseName = String
 
 public export
 record PName where
-  constructor MkPName
+  constructor MakePName
   mods : Mods
   base : PBaseName
-%runElab derive "PName" [Eq, Ord, PrettyVal]
+%runElab derive "PName" [Eq, Ord]
 
 export %inline
 fromPName : PName -> Name
-fromPName p = MkName p.mods $ UN p.base
+fromPName p = MakeName p.mods $ UN p.base
 
 export %inline
 toPName : Name -> PName
-toPName p = MkPName p.mods $ baseStr p.base
+toPName p = MakePName p.mods $ baseStr p.base
 
 export %inline
 fromPBaseName : PBaseName -> Name
-fromPBaseName = MkName [<] . UN
+fromPBaseName = MakeName [<] . UN
 
 export
 Show PName where
-  show (MkPName mods base) =
+  show (MakePName mods base) =
     show $ concat $ intersperse "." $ toList $ mods :< base
 
 export Show Name where show = show . toPName
 
-export FromString PName where fromString = MkPName [<]
+export FromString PName where fromString = MakePName [<]
 
 export FromString Name where fromString = fromPBaseName
 
@@ -96,9 +95,9 @@ export FromString Name where fromString = fromPBaseName
 public export
 record BindName where
   constructor BN
-  val  : BaseName
+  name : BaseName
   loc_ : Loc
-%runElab derive "BindName" [Eq, Ord, Show, PrettyVal]
+%runElab derive "BindName" [Eq, Ord, Show]
 
 export Located BindName where n.loc = n.loc_
 export Relocatable BindName where setLoc loc (BN x _) = BN x loc
@@ -116,7 +115,7 @@ export
 fromListP : List1 String -> PName
 fromListP (x ::: xs) = go [<] x xs where
   go : SnocList String -> String -> List String -> PName
-  go mods x []        = MkPName mods x
+  go mods x []        = MakePName mods x
   go mods x (y :: ys) = go (mods :< x) y ys
 
 export %inline
@@ -170,14 +169,23 @@ public export
 NameGen : Type -> Type
 NameGen = StateL GEN NameSuf
 
+export
+runNameGenWith : Has NameGen fs =>
+                 NameSuf -> Eff fs a -> Eff (fs - NameGen) (a, NameSuf)
+runNameGenWith = runStateAt GEN
+
+export
+runNameGen : Has NameGen fs => Eff fs a -> Eff (fs - NameGen) a
+runNameGen = map fst . runNameGenWith 0
+
+export
+gen : Has NameGen fs => Eff fs Nat
+gen = stateAt GEN $ \i => SR {result = i, state = S i}
 
 ||| generate a fresh name with the given base
 export
 mn : Has NameGen fs => PBaseName -> Eff fs BaseName
-mn base = do
-  i <- getAt GEN
-  modifyAt GEN S
-  pure $ MN base i
+mn base = MN base <$> gen
 
 ||| generate a fresh binding name with the given base and location `loc`
 export
diff --git a/lib/Quox/NatExtra.idr b/lib/Quox/NatExtra.idr
index 714add1..42f627e 100644
--- a/lib/Quox/NatExtra.idr
+++ b/lib/Quox/NatExtra.idr
@@ -4,7 +4,6 @@ import public Data.Nat
 import Data.Nat.Division
 import Data.SnocList
 import Data.Vect
-import Data.String
 
 %default total
 
@@ -53,42 +52,6 @@ parameters {base : Nat} {auto 0 _ : base `GTE` 2} (chars : Vect base Char)
   showAtBase : Nat -> String
   showAtBase = pack . showAtBase' []
 
-namespace Nat
-  export
-  showHex : Nat -> String
-  showHex = showAtBase $ fromList $ unpack "0123456789abcdef"
-
-namespace Int
-  export
-  showHex : Int -> String
-  showHex x =
-    if x < 0 then "-" ++ Nat.showHex (cast (-x)) else Nat.showHex (cast x)
-
-
-namespace Int
-  export
-  fromHexit : Char -> Maybe Int
-  fromHexit c =
-    if      c >= '0' && c <= '9' then Just $ ord c - ord '0'
-    else if c >= 'a' && c <= 'f' then Just $ ord c - ord 'a' + 10
-    else if c >= 'A' && c <= 'F' then Just $ ord c - ord 'A' + 10
-    else Nothing
-
-  private
-  fromHex' : Int -> String -> Maybe Int
-  fromHex' acc str = case strM str of
-    StrNil       => Just acc
-    StrCons c cs => fromHex' (16 * acc + !(fromHexit c)) (assert_smaller str cs)
-
-  export %inline
-  fromHex : String -> Maybe Int
-  fromHex str = do guard $ str /= ""; fromHex' 0 str
-
-namespace Nat
-  export
-  fromHexit : Char -> Maybe Nat
-  fromHexit = map cast . Int.fromHexit
-
-  export %inline
-  fromHex : String -> Maybe Nat
-  fromHex = map cast . Int.fromHex
+export
+showHex : Nat -> String
+showHex = showAtBase $ fromList $ unpack "0123456789ABCDEF"
diff --git a/lib/Quox/No.idr b/lib/Quox/No.idr
index 4134485..56f9a07 100644
--- a/lib/Quox/No.idr
+++ b/lib/Quox/No.idr
@@ -43,7 +43,7 @@ parameters {0 a, b : Bool}
   noOr2 = snd . noOr
 
 
-export infixr 1 `orNo`
+infixr 1 `orNo`
 export %inline
 orNo : No a -> No b -> No (a || b)
 orNo Ah Ah = Ah
@@ -53,7 +53,17 @@ nchoose : (b : Bool) -> Either (So b) (No b)
 nchoose True  = Left  Oh
 nchoose False = Right Ah
 
-export
-0 notYesNo : {f : Dec p} -> Not p -> No (isYes f)
-notYesNo {f = Yes y} g = absurd $ g y
-notYesNo {f = No  n} g = Ah
+
+private
+0 notFalseTrue : (a : Bool) -> not a = True -> a = False
+notFalseTrue False Refl = Refl
+
+export %inline
+soNot : So (not a) -> No a
+soNot x with 0 (not a) proof eq
+  soNot Oh | True =
+    rewrite notFalseTrue a eq in Ah
+
+export %inline
+soNot' : So a -> No (not a)
+soNot' Oh = Ah
diff --git a/lib/Quox/OPE.idr b/lib/Quox/OPE.idr
new file mode 100644
index 0000000..31203eb
--- /dev/null
+++ b/lib/Quox/OPE.idr
@@ -0,0 +1,76 @@
+||| "order preserving embeddings", for recording a correspondence between
+||| a smaller scope and part of a larger one.
+module Quox.OPE
+
+import Quox.NatExtra
+import Data.Nat
+
+%default total
+
+
+public export
+data OPE : Nat -> Nat -> Type where
+  Id   : OPE n n
+  Drop : OPE m n -> OPE m     (S n)
+  Keep : OPE m n -> OPE (S m) (S n)
+%name OPE p, q
+
+public export %inline Injective Drop where injective Refl = Refl
+public export %inline Injective Keep where injective Refl = Refl
+
+public export
+opeZero : {n : Nat} -> OPE 0 n
+opeZero {n = 0}   = Id
+opeZero {n = S n} = Drop opeZero
+
+public export
+(.) : OPE m n -> OPE n p -> OPE m p
+p      . Id     = p
+Id     . q      = q
+p      . Drop q = Drop $ p . q
+Drop p . Keep q = Drop $ p . q
+Keep p . Keep q = Keep $ p . q
+
+public export
+toLTE : {m : Nat} -> OPE m n -> m `LTE` n
+toLTE Id       = reflexive
+toLTE (Drop p) = lteSuccRight $ toLTE p
+toLTE (Keep p) = LTESucc      $ toLTE p
+
+
+public export
+keepN : (n : Nat) -> OPE a b -> OPE (n + a) (n + b)
+keepN 0     p = p
+keepN (S n) p = Keep $ keepN n p
+
+public export
+dropInner' : LTE' m n -> OPE m n
+dropInner' LTERefl      = Id
+dropInner' (LTESuccR p) = Drop $ dropInner' $ force p
+
+public export
+dropInner : {n : Nat} -> LTE m n -> OPE m n
+dropInner = dropInner' . fromLte
+
+public export
+dropInnerN : (m : Nat) -> OPE n (m + n)
+dropInnerN 0     = Id
+dropInnerN (S m) = Drop $ dropInnerN m
+
+
+public export
+interface Tighten t where
+  tighten : OPE m n -> t n -> Maybe (t m)
+
+parameters {auto _ : Tighten t}
+  export %inline
+  tightenInner : {n : Nat} -> m `LTE` n -> t n -> Maybe (t m)
+  tightenInner = tighten . dropInner
+
+  export %inline
+  tightenN : (m : Nat) -> t (m + n) -> Maybe (t n)
+  tightenN m = tighten $ dropInnerN m
+
+  export %inline
+  tighten1 : t (S n) -> Maybe (t n)
+  tighten1 = tightenN 1
diff --git a/lib/Quox/Parser/FromParser.idr b/lib/Quox/Parser/FromParser.idr
index 2ae4f37..4514245 100644
--- a/lib/Quox/Parser/FromParser.idr
+++ b/lib/Quox/Parser/FromParser.idr
@@ -1,31 +1,39 @@
 ||| take freshly-parsed input, scope check, type check, add to env
 module Quox.Parser.FromParser
 
-import public Quox.Parser.FromParser.Error as Quox.Parser.FromParser
-
-import Quox.Pretty
 import Quox.Parser.Syntax
 import Quox.Parser.Parser
-import public Quox.Parser.LoadFile
 import Quox.Typechecker
-import Quox.CheckBuiltin
 
 import Data.List
 import Data.Maybe
 import Data.SnocVect
 import Quox.EffExtra
-import Control.Monad.ST.Extra
 
 import System.File
 import System.Path
 import Data.IORef
 
+import public Quox.Parser.FromParser.Error as Quox.Parser.FromParser
+
+%default total
 
 %hide Typing.Error
 %hide Lexer.Error
 %hide Parser.Error
 
-%default total
+
+public export
+NDefinition : Type
+NDefinition = (Name, Definition)
+
+public export
+IncludePath : Type
+IncludePath = List String
+
+public export
+SeenFiles : Type
+SeenFiles = SortedSet String
 
 
 public export
@@ -33,50 +41,27 @@ data StateTag = NS | SEEN
 
 public export
 FromParserPure : List (Type -> Type)
-FromParserPure = [Except Error, DefsState, StateL NS Mods, NameGen, Log]
+FromParserPure =
+  [Except Error, DefsState, StateL NS Mods, NameGen]
+
+public export
+LoadFile' : List (Type -> Type)
+LoadFile' = [IO, StateL SEEN SeenFiles, Reader IncludePath]
+
+public export
+LoadFile : List (Type -> Type)
+LoadFile = LoadFile' ++ [Except Error]
 
 public export
 FromParserIO : List (Type -> Type)
-FromParserIO = FromParserPure ++ [LoadFile]
-
-
-public export
-record PureParserResult a where
-  constructor MkPureParserResult
-  val       : a
-  suf       : NameSuf
-  defs      : Definitions
-  log       : SnocList LogDoc
-  logLevels : LevelStack
-
-export
-fromParserPure : Mods -> NameSuf -> Definitions -> LevelStack ->
-                 Eff FromParserPure a -> Either Error (PureParserResult a)
-fromParserPure ns suf defs lvls act = runSTErr $ do
-  suf  <- newSTRef' suf
-  defs <- newSTRef' defs
-  log  <- newSTRef' [<]
-  lvls <- newSTRef' lvls
-  res  <- runEff act $ with Union.(::)
-    [handleExcept $ \e => stLeft e,
-     handleStateSTRef defs,
-     handleStateSTRef !(newSTRef' ns),
-     handleStateSTRef suf,
-     handleLogST log lvls]
-  pure $ MkPureParserResult {
-    val       = res,
-    suf       = !(readSTRef' suf),
-    defs      = !(readSTRef' defs),
-    log       = !(readSTRef' log),
-    logLevels = !(readSTRef' lvls)
-  }
+FromParserIO = FromParserPure ++ LoadFile'
 
 
 parameters {auto _ : Functor m} (b : Var n -> m a) (f : PName -> m a)
            (xs : Context' PatVar n)
   private
   fromBaseName : PBaseName -> m a
-  fromBaseName x = maybe (f $ MkPName [<] x) b $
+  fromBaseName x = maybe (f $ MakePName [<] x) b $
                    Context.find (\y => y.name == Just x) xs
 
   private
@@ -128,10 +113,11 @@ fromV : Context' PatVar d -> Context' PatVar n ->
         PName -> Maybe Universe -> Loc -> Eff FromParserPure (Term d n)
 fromV ds ns x u loc = fromName bound free ns x where
   bound : Var n -> Eff FromParserPure (Term d n)
-  bound i = unless (isNothing u) (throw $ DisplacedBoundVar loc x) $> BT i loc
-
+  bound i = do whenJust u $ \u => throw $ DisplacedBoundVar loc x
+               pure $ E $ B i loc
   free : PName -> Eff FromParserPure (Term d n)
-  free x = resolveName !(getAt NS) loc !(avoidDim ds loc x) u
+  free x = do x <- avoidDim ds loc x
+              resolveName !(getAt NS) loc x u
 
 mutual
   export
@@ -141,9 +127,6 @@ mutual
     TYPE k loc =>
       pure $ TYPE k loc
 
-    IOState loc =>
-      pure $ IOState loc
-
     Pi pi x s t loc =>
       Pi (fromPQty pi)
         <$> fromPTermWith ds ns s
@@ -167,6 +150,23 @@ mutual
     Pair s t loc =>
       Pair <$> fromPTermWith ds ns s <*> fromPTermWith ds ns t <*> pure loc
 
+    W x s t loc =>
+      W <$> fromPTermWith ds ns s
+        <*> fromPTermTScope ds ns [< x] t
+        <*> pure loc
+
+    Sup s t loc =>
+      Sup <$> fromPTermWith ds ns s
+          <*> fromPTermWith ds ns t
+          <*> pure loc
+
+    Case pi tree (r, ret) (CaseW x y (rh, ih) body _) loc =>
+      map E $ CaseW (fromPQty pi) (fromPQty rh)
+        <$> fromPTermElim ds ns tree
+        <*> fromPTermTScope ds ns [< r] ret
+        <*> fromPTermTScope ds ns [< x, y, ih] body
+        <*> pure loc
+
     Case pi pair (r, ret) (CasePair (x, y) body _) loc =>
       map E $ CasePair (fromPQty pi)
         <$> fromPTermElim ds ns pair
@@ -174,26 +174,10 @@ mutual
         <*> fromPTermTScope ds ns [< x, y] body
         <*> pure loc
 
-    Fst pair loc =>
-      map E $ Fst <$> fromPTermElim ds ns pair <*> pure loc
-
-    Snd pair loc =>
-      map E $ Snd <$> fromPTermElim ds ns pair <*> pure loc
-
-    Case pi tag (r, ret) (CaseEnum arms _) loc =>
-      map E $ CaseEnum (fromPQty pi)
-        <$> fromPTermElim ds ns tag
-        <*> fromPTermTScope ds ns [< r] ret
-        <*> assert_total fromPTermEnumArms loc ds ns arms
-        <*> pure loc
-
-    NAT loc => pure $ NAT loc
-    Nat n loc => pure $ Nat n loc
+    Nat loc => pure $ Nat loc
+    Zero loc => pure $ Zero loc
     Succ n loc => [|Succ (fromPTermWith ds ns n) (pure loc)|]
 
-    STRING loc => pure $ STRING loc
-    Str str loc => pure $ Str str loc
-
     Case pi nat (r, ret) (CaseNat zer (s, pi', ih, suc) _) loc =>
       map E $ CaseNat (fromPQty pi) (fromPQty pi')
         <$> fromPTermElim ds ns nat
@@ -202,14 +186,22 @@ mutual
         <*> fromPTermTScope ds ns [< s, ih] suc
         <*> pure loc
 
-    Enum strs loc => do
-      let set = SortedSet.fromList strs
-      unless (length strs == length (SortedSet.toList set)) $
-        throw $ DuplicatesInEnumType loc strs
-      pure $ Enum set loc
+    Enum strs loc =>
+      let set = SortedSet.fromList strs in
+      if length strs == length (SortedSet.toList set) then
+        pure $ Enum set loc
+      else
+        throw $ DuplicatesInEnum loc strs
 
     Tag str loc => pure $ Tag str loc
 
+    Case pi tag (r, ret) (CaseEnum arms _) loc =>
+      map E $ CaseEnum (fromPQty pi)
+        <$> fromPTermElim ds ns tag
+        <*> fromPTermTScope ds ns [< r] ret
+        <*> assert_total fromPTermEnumArms ds ns arms
+        <*> pure loc
+
     Eq (i, ty) s t loc =>
       Eq <$> fromPTermDScope ds ns [< i] ty
          <*> fromPTermWith ds ns s
@@ -263,22 +255,13 @@ mutual
         <*> fromPTermDScope ds ns [< j1] val1
         <*> pure loc
 
-    Let (qty, x, rhs) body loc =>
-      Let (fromPQty qty)
-        <$> fromPTermElim ds ns rhs
-        <*> fromPTermTScope ds ns [< x] body
-        <*> pure loc
-
   private
-  fromPTermEnumArms : Loc -> Context' PatVar d -> Context' PatVar n ->
+  fromPTermEnumArms : Context' PatVar d -> Context' PatVar n ->
                       List (PTagVal, PTerm) ->
                       Eff FromParserPure (CaseEnumArms d n)
-  fromPTermEnumArms loc ds ns arms = do
-    res <- SortedMap.fromList <$>
-           traverse (bitraverse (pure . fromPTagVal) (fromPTermWith ds ns)) arms
-    unless (length (keys res) == length arms) $
-      throw $ DuplicatesInEnumCase loc (map (fromPTagVal . fst) arms)
-    pure res
+  fromPTermEnumArms ds ns =
+    map SortedMap.fromList .
+    traverse (bitraverse (pure . fromPTagVal) (fromPTermWith ds ns))
 
   private
   fromPTermElim : Context' PatVar d -> Context' PatVar n ->
@@ -297,7 +280,7 @@ mutual
     if all isUnused xs then
       SN <$> fromPTermWith ds ns t
     else
-      SY (fromSnocVect $ map fromPatVar xs) <$> fromPTermWith ds (ns ++ xs) t
+      ST (fromSnocVect $ map fromPatVar xs) <$> fromPTermWith ds (ns ++ xs) t
 
   private
   fromPTermDScope : {s : Nat} -> Context' PatVar d -> Context' PatVar n ->
@@ -305,9 +288,9 @@ mutual
                     Eff FromParserPure (DScopeTermN s d n)
   fromPTermDScope ds ns xs t =
     if all isUnused xs then
-      SN {f = \d => Term d n} <$> fromPTermWith ds ns t
+      SN <$> fromPTermWith ds ns t
     else
-      SY (fromSnocVect $ map fromPatVar xs) <$> fromPTermWith (ds ++ xs) ns t
+      DST (fromSnocVect $ map fromPatVar xs) <$> fromPTermWith (ds ++ xs) ns t
 
 
 export %inline
@@ -316,110 +299,72 @@ fromPTerm = fromPTermWith [<] [<]
 
 
 export
-globalPQty : Has (Except Error) fs => PQty -> Eff fs GQty
-globalPQty (PQ pi loc) = case toGlobal pi of
-  Just g  => pure g
-  Nothing => throw $ QtyNotGlobal loc pi
+globalPQty : Loc -> (q : Qty) -> Eff [Except Error] (So $ isGlobal q)
+globalPQty loc pi = case choose $ isGlobal pi of
+  Left  y => pure y
+  Right _ => throw $ QtyNotGlobal loc pi
+
 
 export
-fromPBaseNameNS : Has (StateL NS Mods) fs => PBaseName -> Eff fs Name
+fromPBaseNameNS : PBaseName -> Eff [StateL NS Mods] Name
 fromPBaseNameNS name = pure $ addMods !(getAt NS) $ fromPBaseName name
 
-
 private
-liftTC : Eff TC a -> Eff FromParserPure a
-liftTC tc = runEff tc $ with Union.(::)
-  [handleExcept $ \e => throw $ WrapTypeError e,
-   handleReaderConst !(getAt DEFS),
-   \g => send g,
-   \g => send g]
-
-private
-liftWhnf : Eff Whnf a -> Eff FromParserPure a
-liftWhnf tc = runEff tc $ with Union.(::)
-  [handleExcept $ \e => throw $ WrapTypeError e,
-   \g => send g,
-   \g => send g]
-
-private
-addDef : Has DefsState fs => Name -> Definition -> Eff fs NDefinition
-addDef name def = do
-  modifyAt DEFS $ insert name def
-  pure (name, def)
-
+liftTC : TC a -> Eff FromParserPure a
+liftTC act = do
+  res <- lift $ runExcept $ runReaderAt DEFS !(getAt DEFS) act
+  rethrow $ mapFst WrapTypeError res
 
 export covering
 fromPDef : PDefinition -> Eff FromParserPure NDefinition
-fromPDef def = do
-  name <- fromPBaseNameNS def.name
-  defs <- getAt DEFS
-  when (isJust $ lookup name defs) $ do
-    throw $ AlreadyExists def.loc name
-  gqty <- globalPQty def.qty
-  let sqty = globalToSubj gqty
-  case def.body of
-    PConcrete ptype pterm => do
-      type <- traverse fromPTerm ptype
-      term <- fromPTerm pterm
-      type <- case type of
-        Just type => do
-          ignore $ liftTC $ do
-            checkTypeC empty type Nothing
-            checkC empty sqty term type
-          pure type
-        Nothing => do
-          let E elim = term
-            | _ => throw $ AnnotationNeeded term.loc empty term
-          res <- liftTC $ inferC empty sqty elim
-          pure res.type
-      when def.main $ liftWhnf $ expectMainType defs type
-      addDef name $ mkDef gqty type term def.scheme def.main def.loc
-    PPostulate ptype => do
-      type <- fromPTerm ptype
-      addDef name $ mkPostulate gqty type def.scheme def.main def.loc
-
-
-public export
-data HasFail = NoFail | AnyFail | FailWith String
-
-export covering
-expectFail : Loc -> Eff FromParserPure a -> Eff FromParserPure Error
-expectFail loc act = do
-  gen <- getAt GEN; defs <- getAt DEFS; ns <- getAt NS; lvl <- curLevels
-  case fromParserPure ns gen defs (singleton lvl) act of
-    Left  err => pure err
-    Right _   => throw $ ExpectedFail loc
-
-export covering
-maybeFail : Monoid a =>
-            PFail -> Loc -> Eff FromParserPure a -> Eff FromParserPure a
-maybeFail PSucceed         _   act = act
-maybeFail PFailAny         loc act = expectFail loc act $> neutral
-maybeFail (PFailMatch str) loc act = do
-    err <- expectFail loc act
-    let msg = runPretty $ prettyError False err {opts = Opts 10_000} -- w/e
-    if str `isInfixOf` renderInfinite msg
-       then pure neutral
-       else throw $ WrongFail str err loc
+fromPDef (MkPDef qty pname ptype pterm defLoc) = do
+  name <- lift $ fromPBaseNameNS pname
+  qtyGlobal <- lift $ globalPQty qty.loc qty.val
+  let gqty = Element qty.val qtyGlobal
+      sqty = globalToSubj gqty
+  type <- lift $ traverse fromPTerm ptype
+  term <- lift $ fromPTerm pterm
+  case type of
+    Just type => do
+      liftTC $ checkTypeC empty type Nothing
+      liftTC $ ignore $ checkC empty sqty term type
+      let def = mkDef gqty type term defLoc
+      modifyAt DEFS $ insert name def
+      pure (name, def)
+    Nothing => do
+      let E elim = term | _ => throw $ AnnotationNeeded term.loc empty term
+      res <- liftTC $ inferC empty sqty elim
+      let def = mkDef gqty res.type term defLoc
+      modifyAt DEFS $ insert name def
+      pure (name, def)
 
 export covering
 fromPDecl : PDecl -> Eff FromParserPure (List NDefinition)
-fromPDecl (PDef def) =
-  maybeFail def.fail def.loc $ singleton <$> fromPDef def
+fromPDecl (PDef def) = singleton <$> fromPDef def
 fromPDecl (PNs  ns)  =
-  maybeFail ns.fail ns.loc $
   localAt NS (<+> ns.name) $ concat <$> traverse fromPDecl ns.decls
-fromPDecl (PPrag prag) =
-  case prag of
-    PLogPush p _ => Log.push p $> []
-    PLogPop    _ => Log.pop    $> []
+
+
+export covering
+loadFile : Loc -> String -> Eff LoadFile (Maybe String)
+loadFile loc file =
+  if contains file !(getAt SEEN) then
+    pure Nothing
+  else do
+    Just ifile <- firstExists (map (</> file) !ask)
+      | Nothing => throw $ LoadError loc file FileNotFound
+    case !(readFile ifile) of
+      Right res => modifyAt SEEN (insert file) $> Just res
+      Left  err => throw $ LoadError loc ifile err
 
 mutual
   export covering
   loadProcessFile : Loc -> String -> Eff FromParserIO (List NDefinition)
   loadProcessFile loc file =
-    case !(loadFile loc file) of
-      Just tl => concat <$> traverse fromPTopLevel tl
+    case !(lift $ loadFile loc file) of
+      Just inp => do
+        tl <- either (throw . WrapParseError file) pure $ lexParseInput file inp
+        concat <$> traverse fromPTopLevel tl
       Nothing => pure []
 
   ||| populates the `defs` field of the state
@@ -427,3 +372,28 @@ mutual
   fromPTopLevel : PTopLevel -> Eff FromParserIO (List NDefinition)
   fromPTopLevel (PD    decl)     = lift $ fromPDecl decl
   fromPTopLevel (PLoad file loc) = loadProcessFile loc file
+
+export
+fromParserPure : NameSuf -> Definitions ->
+                 Eff FromParserPure a ->
+                 (Either Error (a, Definitions), NameSuf)
+fromParserPure suf defs act =
+  extract $
+  runStateAt GEN suf $
+  runExcept $
+  evalStateAt NS [<] $
+  runStateAt DEFS defs act
+
+export
+fromParserIO : (MonadRec io, HasIO io) =>
+               IncludePath ->
+               IORef SeenFiles -> IORef NameSuf -> IORef Definitions ->
+               Eff FromParserIO a -> io (Either Error a)
+fromParserIO inc seen suf defs act =
+  runIO $
+  runStateIORefAt GEN suf $
+  runExcept $
+  evalStateAt NS [<] $
+  runStateIORefAt SEEN seen $
+  runStateIORefAt DEFS defs $
+  runReader inc act
diff --git a/lib/Quox/Parser/FromParser/Error.idr b/lib/Quox/Parser/FromParser/Error.idr
index 16a3592..6bc2b0b 100644
--- a/lib/Quox/Parser/FromParser/Error.idr
+++ b/lib/Quox/Parser/FromParser/Error.idr
@@ -1,14 +1,11 @@
 module Quox.Parser.FromParser.Error
 
 import Quox.Parser.Parser
-import Quox.Parser.LoadFile
 import Quox.Typing
 import System.File
 
 import Quox.Pretty
 
-%default total
-
 %hide Text.PrettyPrint.Prettyprinter.Doc.infixr.(<++>)
 
 
@@ -24,34 +21,26 @@ ParseError = Parser.Error
 public export
 data Error =
     AnnotationNeeded Loc (NameContexts d n) (Term d n)
-  | DuplicatesInEnumType Loc (List TagVal)
-  | DuplicatesInEnumCase Loc (List TagVal)
+  | DuplicatesInEnum Loc (List TagVal)
   | TermNotInScope Loc Name
   | DimNotInScope Loc PBaseName
   | QtyNotGlobal Loc Qty
   | DimNameInTerm Loc PBaseName
   | DisplacedBoundVar Loc PName
   | WrapTypeError TypeError
-  | AlreadyExists Loc Name
-  | LoadError Loc FilePath FileError
-  | ExpectedFail Loc
-  | SchemeOnNamespace Loc Mods
-  | MainOnNamespace Loc Mods
-  | WrongFail String Error Loc
+  | LoadError Loc String FileError
   | WrapParseError String ParseError
 
 
 export
 prettyLexError : {opts : _} -> String -> LexError -> Eff Pretty (Doc opts)
 prettyLexError file (Err reason line col char) = do
+  let loc = makeLoc file (MkBounds line col line col)
   reason <- case reason of
-    Other msg => pure $ text msg
-    NoRuleApply => case char of
-      Just char => pure $ text "unrecognised character: \{show char}"
-      Nothing   => pure $ text "unexpected end of input"
+    EndInput    => pure "unexpected end of input"
+    NoRuleApply => pure $ text "unrecognised character: \{show char}"
     ComposeNotClosing (sl, sc) (el, ec) => pure $
       hsep ["unterminated token at", !(prettyBounds (MkBounds sl sc el ec))]
-  let loc = makeLoc file (MkBounds line col line col)
   pure $ vappend !(prettyLoc loc) reason
 
 export
@@ -72,23 +61,19 @@ prettyParseError file (ParseError errs) =
     traverse (map ("-" <++>) . prettyParseError1 file) (toList errs)
 
 
-parameters {opts : LayoutOpts} (showContext : Bool)
+parameters (showContext : Bool)
   export
-  prettyError : Error -> Eff Pretty (Doc opts)
+  prettyError : {opts : _} -> Error -> Eff Pretty (Doc opts)
   prettyError (AnnotationNeeded loc ctx tm) =
     [|vappend (prettyLoc loc)
         (hangD "type annotation needed on"
                !(prettyTerm ctx.dnames ctx.tnames tm))|]
     -- [todo] print the original PTerm instead
 
-  prettyError (DuplicatesInEnumType loc tags) =
+  prettyError (DuplicatesInEnum loc tags) =
     [|vappend (prettyLoc loc)
         (hangD "duplicate tags in enum type" !(prettyEnum tags))|]
 
-  prettyError (DuplicatesInEnumCase loc tags) =
-    [|vappend (prettyLoc loc)
-        (hangD "duplicate arms in enum case" !(prettyEnum tags))|]
-
   prettyError (DimNotInScope loc i) =
     [|vappend (prettyLoc loc)
         (pure $ hsep ["dimension", !(hl DVar $ text i), "not in scope"])|]
@@ -115,32 +100,10 @@ parameters {opts : LayoutOpts} (showContext : Bool)
   prettyError (WrapTypeError err) =
     Typing.prettyError showContext $ trimContext 2 err
 
-  prettyError (AlreadyExists loc name) = pure $
+  prettyError (LoadError loc str err) = pure $
     vsep [!(prettyLoc loc),
-          sep [!(prettyFree name), "has already been defined"]]
-
-  prettyError (LoadError loc file err) = pure $
-    vsep [!(prettyLoc loc),
-          "couldn't load file" <++> text file,
+          "couldn't load file" <++> text str,
           text $ show err]
 
-  prettyError (ExpectedFail loc) = pure $
-    vsep [!(prettyLoc loc), "expected error"]
-
-  prettyError (SchemeOnNamespace loc ns) = pure $
-    vsep [!(prettyLoc loc),
-          hsep ["namespace", !(hl Free $ text $ joinBy "." $ toList ns),
-                "cannot have #[compile-scheme] attached"]]
-
-  prettyError (MainOnNamespace loc ns) = pure $
-    vsep [!(prettyLoc loc),
-          hsep ["namespace", !(hl Free $ text $ joinBy "." $ toList ns),
-                "cannot have #[main] attached"]]
-
-  prettyError (WrongFail str err loc) = pure $
-    vsep [!(prettyLoc loc),
-          "wrong error, expected to match", !(hl Constant $ text "\"\{str}\""),
-          "but got", !(prettyError err)]
-
   prettyError (WrapParseError file err) =
     prettyParseError file err
diff --git a/lib/Quox/Parser/Lexer.idr b/lib/Quox/Parser/Lexer.idr
index f4a4ee0..d0bbbdd 100644
--- a/lib/Quox/Parser/Lexer.idr
+++ b/lib/Quox/Parser/Lexer.idr
@@ -1,7 +1,6 @@
 module Quox.Parser.Lexer
 
 import Quox.CharExtra
-import Quox.NatExtra
 import Quox.Name
 import Data.String.Extra
 import Data.SortedMap
@@ -20,7 +19,7 @@ import Derive.Prelude
 ||| @ Reserved reserved token
 ||| @ Name name, possibly qualified
 ||| @ Nat nat literal
-||| @ Str string literal
+||| @ String string literal
 ||| @ Tag tag literal
 ||| @ TYPE "Type" or "★" with ascii nat directly after
 ||| @ Sup superscript or ^ number (displacement, or universe for ★)
@@ -35,27 +34,16 @@ data Token =
   | Sup Nat
 %runElab derive "Token" [Eq, Ord, Show]
 
-||| token or whitespace
-||| @ Skip whitespace, comments, etc
-||| @ Invalid a token which failed a post-lexer check
-|||           (e.g. a qualified name containing a keyword)
-||| @ T a well formed token
+-- token or whitespace
 public export
-data ExtToken = Skip | Invalid String String | T Token
-%runElab derive "ExtToken" [Eq, Ord, Show]
+0 TokenW : Type
+TokenW = Maybe Token
 
 
-public export
-data ErrorReason =
-    NoRuleApply
-  | ComposeNotClosing (Int, Int) (Int, Int)
-  | Other String
-%runElab derive "ErrorReason" [Eq, Ord, Show]
-
 public export
 record Error where
   constructor Err
-  reason    : ErrorReason
+  reason    : StopReason
   line, col : Int
   ||| `Nothing` if the error is at the end of the input
   char      : Maybe Char
@@ -64,118 +52,77 @@ record Error where
 
 
 private
-skip : Lexer -> Tokenizer ExtToken
-skip t = match t $ const Skip
+skip : Lexer -> Tokenizer TokenW
+skip t = match t $ const Nothing
 
 private
-tmatch : Lexer -> (String -> Token) -> Tokenizer ExtToken
-tmatch t f = match t (T . f)
+match : Lexer -> (String -> Token) -> Tokenizer TokenW
+match t f = Tokenizer.match t (Just . f)
+%hide Tokenizer.match
 
 
+private
+name : Tokenizer TokenW
+name = match name $ Name . fromListP . split (== '.') . normalizeNfc
+
+||| [todo] escapes other than `\"` and (accidentally) `\\`
 export
-fromStringLit : (String -> Token) -> String -> ExtToken
-fromStringLit f str =
-  case go $ unpack $ drop 1 $ dropLast 1 str of
-    Left  err => Invalid err str
-    Right ok  => T $ f $ pack ok
-where
-  Interpolation Char where interpolate = singleton
-
-  go, hexEscape : List Char -> Either String (List Char)
-
-  go []                   = Right []
-  go ['\\']               = Left "string ends with \\"
-  go ('\\' :: 'n'  :: cs) = ('\n' ::) <$> go cs
-  go ('\\' :: 't'  :: cs) = ('\t' ::) <$> go cs
-  go ('\\' :: 'x'  :: cs) = hexEscape cs
-  go ('\\' :: 'X'  :: cs) = hexEscape cs
-  go ('\\' :: '\\' :: cs) = ('\\' ::) <$> go cs
-  go ('\\' :: '"'  :: cs) = ('"'  ::) <$> go cs
-  -- [todo] others
-  go ('\\' :: c :: _)     = Left "unknown escape '\{c}'"
-  go (c :: cs)            = (c ::) <$> go cs
-
-  hexEscape cs =
-    case break (== ';') cs of
-      (hs, ';' :: rest) => do
-        let hs = pack hs
-        let Just c = Int.fromHex hs
-          | Nothing => Left #"invalid hex string "\#{hs}" in escape"#
-        if isCodepoint c
-           then (chr c ::) <$> go (assert_smaller cs rest)
-           else Left "codepoint \{hs} out of range"
-      _ => Left "unterminated hex escape"
+fromStringLit : String -> String
+fromStringLit = pack . go . unpack . drop 1 . dropLast 1 where
+  go : List Char -> List Char
+  go []                = []
+  go ['\\']            = ['\\'] -- i guess???
+  go ('\\' :: c :: cs) = c :: go cs
+  go (c :: cs)         = c :: go cs
 
 private
-string : Tokenizer ExtToken
-string = match stringLit $ fromStringLit Str
-
-
-%hide binLit
-%hide octLit
-%hide hexLit
+string : Tokenizer TokenW
+string = match stringLit (Str . fromStringLit)
 
 private
-nat : Tokenizer ExtToken
-nat = match  hexLit fromHexLit
-  <|> tmatch decLit fromDecLit
-where
-  withUnderscores : Lexer -> Lexer
-  withUnderscores l = l <+> many (opt (is '_') <+> l)
-
-  withoutUnderscores : String -> String
-  withoutUnderscores = pack . go . unpack where
-    go : List Char -> List Char
-    go []          = []
-    go ('_' :: cs) =      go cs
-    go (c   :: cs) = c :: go cs
-
-  decLit =
-    withUnderscores (range '0' '9') <+> reject idContEnd
-
-  hexLit =
-    approx "0x" <+>
-    withUnderscores (range '0' '9' <|> range 'a' 'f' <|> range 'A' 'F') <+>
-    reject idContEnd
-
-  fromDecLit : String -> Token
-  fromDecLit = Nat . cast . withoutUnderscores
-
-  fromHexLit : String -> ExtToken
-  fromHexLit str =
-    maybe (Invalid "invalid hex sequence" str) (T . Nat) $
-    fromHex $ withoutUnderscores $ drop 2 str
-
+nat : Tokenizer TokenW
+nat = match (some (range '0' '9')) (Nat . cast)
 
 private
-tag : Tokenizer ExtToken
-tag = tmatch (is '\'' <+> name)      (Tag . drop 1)
-  <|>  match (is '\'' <+> stringLit) (fromStringLit Tag . drop 1)
+tag : Tokenizer TokenW
+tag = match (is '\'' <+> name)      (Tag . drop 1)
+  <|> match (is '\'' <+> stringLit) (Tag . fromStringLit . drop 1)
 
 
+
+private %inline
+fromSub : Char -> Char
+fromSub c = case c of
+  '₀' => '0'; '₁' => '1'; '₂' => '2'; '₃' => '3'; '₄' => '4'
+  '₅' => '5'; '₆' => '6'; '₇' => '7'; '₈' => '8'; '₉' => '9'; _ => c
+
 private %inline
 fromSup : Char -> Char
 fromSup c = case c of
   '⁰' => '0'; '¹' => '1'; '²' => '2'; '³' => '3'; '⁴' => '4'
   '⁵' => '5'; '⁶' => '6'; '⁷' => '7'; '⁸' => '8'; '⁹' => '9'; _ => c
 
+private %inline
+subToNat : String -> Nat
+subToNat = cast . pack . map fromSub . unpack
+
 private %inline
 supToNat : String -> Nat
 supToNat = cast . pack . map fromSup . unpack
 
--- ★0, Type0. base ★/Type is a Reserved and ★¹/Type¹ are sequences of two tokens
+-- ★0, Type0. base ★/Type is a Reserved
 private
-universe : Tokenizer ExtToken
+universe : Tokenizer TokenW
 universe = universeWith "★" <|> universeWith "Type" where
-  universeWith : String -> Tokenizer ExtToken
+  universeWith : String -> Tokenizer TokenW
   universeWith pfx =
     let len = length pfx in
-    tmatch (exact pfx <+> digits) (TYPE . cast . drop len)
+    match (exact pfx <+> digits) (TYPE . cast . drop len)
 
 private
-sup : Tokenizer ExtToken
-sup = tmatch (some $ pred isSupDigit) (Sup . supToNat)
-  <|> tmatch (is '^' <+> digits)      (Sup . cast . drop 1)
+sup : Tokenizer TokenW
+sup = match (some $ pred isSupDigit) (Sup . supToNat)
+  <|> match (is '^' <+> digits)      (Sup . cast . drop 1)
 
 
 private %inline
@@ -187,11 +134,9 @@ namespace Reserved
   ||| description of a reserved symbol
   ||| @ Word a reserved word (must not be followed by letters, digits, etc)
   ||| @ Sym a reserved symbol (must not be followed by symbolic chars)
-  ||| @ Punc a character that doesn't show up in names (brackets, etc);
-  |||        also a sequence ending in one of those, like `#[`, since the
-  |||        difference relates to lookahead
+  ||| @ Punc a character that doesn't show up in names (brackets, etc)
   public export
-  data Reserved1 = Word String | Sym String | Punc String
+  data Reserved1 = Word String | Sym String | Punc Char
   %runElab derive "Reserved1" [Eq, Ord, Show]
 
   ||| description of a token that might have unicode & ascii-only aliases
@@ -200,14 +145,17 @@ namespace Reserved
   %runElab derive "Reserved" [Eq, Ord, Show]
 
   public export
-  Sym1, Word1, Punc1 : String -> Reserved
-  Sym1  = Only . Sym
+  Sym1, Word1 : String -> Reserved
+  Sym1 = Only . Sym
   Word1 = Only . Word
+
+  public export
+  Punc1 : Char -> Reserved
   Punc1 = Only . Punc
 
 public export
 resString1 : Reserved1 -> String
-resString1 (Punc x) = x
+resString1 (Punc x) = singleton x
 resString1 (Word w) = w
 resString1 (Sym  s) = s
 
@@ -218,23 +166,17 @@ resString : Reserved -> String
 resString (Only r)   = resString1 r
 resString (r `Or` _) = resString1 r
 
-||| return both representative strings for a token description
-public export
-resString2 : Reserved -> List String
-resString2 (Only r)   = [resString1 r]
-resString2 (r `Or` s) = [resString1 r, resString1 s]
-
 private
-resTokenizer1 : Reserved1 -> String -> Tokenizer ExtToken
+resTokenizer1 : Reserved1 -> String -> Tokenizer TokenW
 resTokenizer1 r str =
   let res : String -> Token := const $ Reserved str in
-  case r of Word w => tmatch (exact w <+> reject idContEnd) res
-            Sym  s => tmatch (exact s <+> reject symCont)   res
-            Punc x => tmatch (exact x)                      res
+  case r of Word w => match (exact w <+> reject idContEnd) res
+            Sym s  => match (exact s <+> reject symCont)   res
+            Punc x => match (is x)                         res
 
 ||| match a reserved token
 export
-resTokenizer : Reserved -> Tokenizer ExtToken
+resTokenizer : Reserved -> Tokenizer TokenW
 resTokenizer (Only r)   = resTokenizer1 r (resString1 r)
 resTokenizer (r `Or` s) =
   resTokenizer1 r (resString1 r) <|> resTokenizer1 s (resString1 r)
@@ -246,8 +188,8 @@ resTokenizer (r `Or` s) =
 public export
 reserved : List Reserved
 reserved =
-  [Punc1 "(", Punc1 ")", Punc1 "[", Punc1 "]", Punc1 "{", Punc1 "}",
-   Punc1 ",", Punc1 ";", Punc1 "#[", Punc1 "#![",
+  [Punc1 '(', Punc1 ')', Punc1 '[', Punc1 ']', Punc1 '{', Punc1 '}',
+   Punc1 ',', Punc1 ';',
    Sym1 "@",
    Sym1 ":",
    Sym "⇒" `Or` Sym "=>",
@@ -255,16 +197,14 @@ reserved =
    Sym "×" `Or` Sym "**",
    Sym "≡" `Or` Sym "==",
    Sym "∷" `Or` Sym "::",
-   Punc1 ".",
+   Sym "⊲" `Or` Sym "<|",
+   Sym "⋄" `Or` Sym "<>",
+   Punc1 '.',
    Word1 "case",
    Word1 "case0", Word1 "case1",
    Word "caseω" `Or` Word "case#",
    Word1 "return",
    Word1 "of",
-   Word1 "let", Word1 "in",
-   Word1 "let0", Word1 "let1",
-   Word "letω" `Or` Word "let#",
-   Word1 "fst", Word1 "snd",
    Word1 "_",
    Word1 "Eq",
    Word "λ" `Or` Word "fun",
@@ -272,71 +212,35 @@ reserved =
    Word "ω" `Or` Sym "#",
    Sym "★" `Or` Word "Type",
    Word "ℕ" `Or` Word "Nat",
-   Word1 "IOState",
-   Word1 "String",
    Word1 "zero", Word1 "succ",
    Word1 "coe", Word1 "comp",
    Word1 "def",
    Word1 "def0",
    Word "defω" `Or` Word "def#",
-   Word1 "postulate",
-   Word1 "postulate0",
-   Word "postulateω" `Or` Word "postulate#",
    Sym1 "=",
    Word1 "load",
    Word1 "namespace"]
 
-public export
-reservedStrings : List String
-reservedStrings = map resString reserved
-
-public export
-allReservedStrings : List String
-allReservedStrings = foldMap resString2 reserved
-
 ||| `IsReserved str` is true if `Reserved str` might actually show up in
 ||| the token stream
 public export
 IsReserved : String -> Type
-IsReserved str = So (str `elem` reservedStrings)
-
-private
-name : Tokenizer ExtToken
-name =
-  match name $ \str =>
-    let parts = split (== '.') $ normalizeNfc str in
-    case find (`elem` allReservedStrings) (toList parts) of
-      Nothing => T $ Name $ fromListP parts
-      Just w  => Invalid "reserved word '\{w}' inside name \{str}" str
+IsReserved str = str `Elem` map resString reserved
 
 export
-tokens : Tokenizer ExtToken
+tokens : Tokenizer TokenW
 tokens = choice $
   map skip [pred isWhitespace,
             lineComment (exact "--" <+> reject symCont),
             blockComment (exact "{-") (exact "-}")] <+>
-  [universe] <+>  -- Type<i> takes precedence over bare Type
+  [universe] <+>  -- ★ᵢ takes precedence over bare ★
   map resTokenizer reserved <+>
   [sup, nat, string, tag, name]
 
-export
-check : Alternative f =>
-        WithBounds ExtToken -> Either Error (f (WithBounds Token))
-check (MkBounded val irr bounds@(MkBounds line col _ _)) = case val of
-  Skip            => Right empty
-  T tok           => Right $ pure $ MkBounded tok irr bounds
-  Invalid msg tok => Left  $ Err (Other msg) line col (index 0 tok)
-
-export
-toErrorReason : StopReason -> Maybe ErrorReason
-toErrorReason EndInput                = Nothing
-toErrorReason NoRuleApply             = Just NoRuleApply
-toErrorReason (ComposeNotClosing s e) = Just $ ComposeNotClosing s e
-
 export
 lex : String -> Either Error (List (WithBounds Token))
 lex str =
   let (res, reason, line, col, str) = lex tokens str in
-  case toErrorReason reason of
-    Nothing => concatMap check res @{MonoidApplicative}
-    Just e  => Left $ Err {reason = e, line, col, char = index 0 str}
+  case reason of
+    EndInput => Right $ mapMaybe sequence res
+    _        => Left  $ Err {reason, line, col, char = index 0 str}
diff --git a/lib/Quox/Parser/LoadFile.idr b/lib/Quox/Parser/LoadFile.idr
deleted file mode 100644
index 720a480..0000000
--- a/lib/Quox/Parser/LoadFile.idr
+++ /dev/null
@@ -1,100 +0,0 @@
-module Quox.Parser.LoadFile
-
-import public Quox.Parser.Syntax
-import Quox.Parser.Parser
-import Quox.Loc
-import Quox.EffExtra
-import Data.IORef
-import Data.SortedSet
-import System.File
-import System.Path
-
-
-%default total
-
-public export
-FilePath : Type
-FilePath = String
-
-
-public export
-data LoadFileL : (lbl : k) -> Type -> Type where
-  [search lbl]
-  Seen    : FilePath -> LoadFileL lbl Bool
-  SetSeen : FilePath -> LoadFileL lbl ()
-  DoLoad  : Loc -> FilePath -> LoadFileL lbl PFile
-
-public export
-LoadFile : Type -> Type
-LoadFile = LoadFileL ()
-
-
-export
-seenAt : (0 lbl : k) -> Has (LoadFileL lbl) fs => FilePath -> Eff fs Bool
-seenAt lbl file = send $ Seen {lbl} file
-
-export %inline
-seen : Has LoadFile fs => FilePath -> Eff fs Bool
-seen = seenAt ()
-
-
-export
-setSeenAt : (0 lbl : k) -> Has (LoadFileL lbl) fs => FilePath -> Eff fs ()
-setSeenAt lbl file = send $ SetSeen {lbl} file
-
-export %inline
-setSeen : Has LoadFile fs => FilePath -> Eff fs ()
-setSeen = setSeenAt ()
-
-
-export
-doLoadAt : (0 lbl : k) -> Has (LoadFileL lbl) fs =>
-           Loc -> FilePath -> Eff fs PFile
-doLoadAt lbl loc file = send $ DoLoad {lbl} loc file
-
-export %inline
-doLoad : Has LoadFile fs => Loc -> FilePath -> Eff fs PFile
-doLoad = doLoadAt ()
-
-
-public export
-SeenSet : Type
-SeenSet = SortedSet FilePath
-
-public export
-IncludePath : Type
-IncludePath = List String
-
-export covering
-readFileFrom : HasIO io => IncludePath -> FilePath ->
-               io (Either FileError String)
-readFileFrom inc f =
-  case !(firstExists $ map (</> f) inc) of
-    Just path => readFile path
-    Nothing   => pure $ Left $ FileNotFound
-
-export covering
-handleLoadFileIOE : (Loc -> FilePath -> FileError -> e) ->
-                    (FilePath -> Parser.Error -> e) ->
-                    IORef SeenSet -> IncludePath ->
-                    LoadFileL lbl a -> IOErr e a
-handleLoadFileIOE injf injp seen inc = \case
-  Seen    f   => contains f <$> readIORef seen
-  SetSeen f   => modifyIORef seen $ insert f
-  DoLoad  l f =>
-    case !(readFileFrom inc f) of
-      Left  err => ioLeft $ injf l f err
-      Right str => either (ioLeft . injp f) pure $ lexParseInput f str
-
-
-export
-loadFileAt : (0 lbl : k) -> Has (LoadFileL lbl) fs =>
-             Loc -> FilePath -> Eff fs (Maybe PFile)
-loadFileAt lbl loc file =
-  if !(seenAt lbl file)
-     then pure Nothing
-     else Just <$> doLoadAt lbl loc file <* setSeenAt lbl file
-
-export
-loadFile : Has LoadFile fs => Loc -> FilePath -> Eff fs (Maybe PFile)
-loadFile = loadFileAt ()
diff --git a/lib/Quox/Parser/Parser.idr b/lib/Quox/Parser/Parser.idr
index 6035d57..88c7cfc 100644
--- a/lib/Quox/Parser/Parser.idr
+++ b/lib/Quox/Parser/Parser.idr
@@ -124,7 +124,7 @@ qname = terminalMatch "name" `(Name n) `(n)
 ||| unqualified name
 export
 baseName : Grammar True PBaseName
-baseName = terminalMatch "unqualified name" `(Name (MkPName [<] b)) `(b)
+baseName = terminalMatch "unqualified name" `(Name (MakePName [<] b)) `(b)
 
 ||| dimension constant (0 or 1)
 export
@@ -149,12 +149,6 @@ export
 qty : FileName -> Grammar True PQty
 qty fname = withLoc fname [|PQ qtyVal|]
 
-export
-exactName : String -> Grammar True ()
-exactName name = terminal "expected '\{name}'" $ \case
-  Name (MkPName [<] x) => guard $ x == name
-  _                    => Nothing
-
 
 ||| pattern var (unqualified name or _)
 export
@@ -218,7 +212,8 @@ export
 qtyPatVar : FileName -> Grammar True (PQty, PatVar)
 qtyPatVar fname =
       [|(,) (qty fname) (needRes "." *> patVar fname)|]
-  <|> [|(,) (defLoc fname $ PQ One) (patVar fname)|]
+  <|> do name <- patVar fname
+         pure (PQ (if isUnused name then Zero else One) name.loc, name)
 
 
 export
@@ -232,15 +227,17 @@ data PCasePat =
   | PZero Loc
   | PSucc PatVar PQty PatVar Loc
   | PBox  PatVar Loc
+  | PSup  PatVar PatVar PQty PatVar Loc
 %runElab derive "PCasePat" [Eq, Ord, Show]
 
 export
 Located PCasePat where
-  (PPair _ _   loc).loc = loc
-  (PTag  _     loc).loc = loc
-  (PZero       loc).loc = loc
-  (PSucc _ _ _ loc).loc = loc
-  (PBox  _     loc).loc = loc
+  (PPair _ _     loc).loc = loc
+  (PTag  _       loc).loc = loc
+  (PZero         loc).loc = loc
+  (PSucc _ _ _   loc).loc = loc
+  (PBox  _       loc).loc = loc
+  (PSup  _ _ _ _ loc).loc = loc
 
 ||| either `zero` or `0`
 export
@@ -257,6 +254,11 @@ casePat fname = withLoc fname $
          ih <- resC "," *> qtyPatVar fname
            <|> [|(,) (defLoc fname $ PQ Zero) (unused fname)|]
          pure $ PSucc p (fst ih) (snd ih)
+  <|> do x <- patVar fname
+         y <- resC "⋄" *> patVar fname
+         ih <- resC "," *> qtyPatVar fname
+           <|> [|(,) (defLoc fname $ PQ Zero) (unused fname)|]
+         pure $ PSup x y (fst ih) (snd ih)
   <|> delim "[" "]" [|PBox (patVar fname)|]
   <|> fatalError "invalid pattern"
 
@@ -286,81 +288,19 @@ export
 universe1 : Grammar True Universe
 universe1 = universeTok <|> res "★" *> option 0 super
 
-
-public export
-PCaseArm : Type
-PCaseArm = (PCasePat, PTerm)
-
-export
-caseArm : FileName -> Grammar True PCaseArm
-caseArm fname =
-  [|(,) (casePat fname) (needRes "⇒" *> assert_total term fname)|]
-
-export
-checkCaseArms : Loc -> List PCaseArm -> Grammar False PCaseBody
-checkCaseArms loc [] = pure $ CaseEnum [] loc
-checkCaseArms loc ((PPair x y _, rhs) :: rest) =
-  if null rest then pure $ CasePair (x, y) rhs loc
-  else fatalError "unexpected pattern after pair"
-checkCaseArms loc ((PTag tag _, rhs1) :: rest) = do
-  let rest = for rest $ \case
-        (PTag tag _, rhs) => Just (tag, rhs)
-        _                 => Nothing
-  maybe (fatalError "expected all patterns to be tags")
-        (\rest => pure $ CaseEnum ((tag, rhs1) :: rest) loc) rest
-checkCaseArms loc ((PZero _, rhs1) :: rest) = do
-  let [(PSucc p q ih _, rhs2)] = rest
-    | _ => fatalError "expected succ pattern after zero"
-  pure $ CaseNat rhs1 (p, q, ih, rhs2) loc
-checkCaseArms loc ((PSucc p q ih _, rhs1) :: rest) = do
-  let [(PZero _, rhs2)] = rest
-    | _ => fatalError "expected zero pattern after succ"
-  pure $ CaseNat rhs2 (p, q, ih, rhs1) loc
-checkCaseArms loc ((PBox x _, rhs) :: rest) =
-  if null rest then pure $ CaseBox x rhs loc
-  else fatalError "unexpected pattern after box"
-
-export
-caseBody : FileName -> Grammar True PCaseBody
-caseBody fname = do
-  body <- bounds $ delimSep "{" "}" ";" $ caseArm fname
-  let loc = makeLoc fname body.bounds
-  checkCaseArms loc body.val
-
-export
-caseReturn : FileName -> Grammar True (PatVar, PTerm)
-caseReturn fname = do
-  x   <- patVar fname <* resC "⇒" <|> unused fname
-  ret <- assert_total term fname
-  pure (x, ret)
-
-export
-caseTerm : FileName -> Grammar True PTerm
-caseTerm fname = withLoc fname $ do
-  qty <- caseIntro fname;                     commit
-  head <- mustWork $ assert_total term fname; needRes "return"
-  ret  <- mustWork $ caseReturn fname;        needRes "of"
-  body <- mustWork $ caseBody fname
-  pure $ Case qty head ret body
-
-
-||| argument/atomic term: single-token terms, or those with delimiters
-||| e.g. `[t]`. includes `case` because the end delimiter is the `}`.
+||| argument/atomic term: single-token terms, or those with delimiters e.g.
+||| `[t]`
 export
 termArg : FileName -> Grammar True PTerm
 termArg fname = withLoc fname $
       [|TYPE universe1|]
-  <|> IOState <$ res "IOState"
   <|> [|Enum enumType|]
   <|> [|Tag tag|]
   <|> const <$> boxTerm fname
-  <|> NAT    <$ res "ℕ"
-  <|> Nat 0  <$ res "zero"
-  <|> [|Nat nat|]
-  <|> STRING <$ res "String"
-  <|> [|Str strLit|]
+  <|> Nat  <$ res "ℕ"
+  <|> Zero <$ res "zero"
+  <|> [|fromNat nat|]
   <|> [|V qname displacement|]
-  <|> const <$> caseTerm fname
   <|> const <$> tupleTerm fname
 
 export
@@ -440,10 +380,10 @@ eqTerm : FileName -> Grammar True PTerm
 eqTerm fname = withLoc fname $
   resC "Eq" *> mustWork [|Eq (typeLine fname) (termArg fname) (termArg fname)|]
 
-private
-appArg : Loc -> PTerm -> Either PDim PTerm -> PTerm
-appArg loc f (Left  p) = DApp f p loc
-appArg loc f (Right s) = App  f s loc
+export
+succTerm : FileName -> Grammar True PTerm
+succTerm fname = withLoc fname $
+  resC "succ" *> mustWork [|Succ (termArg fname)|]
 
 ||| a dimension argument with an `@` prefix, or
 ||| a term argument with no prefix
@@ -451,32 +391,15 @@ export
 anyArg : FileName -> Grammar True (Either PDim PTerm)
 anyArg fname = dimArg fname <||> termArg fname
 
-export
-resAppTerm : FileName -> (word : String) -> (0 _ : IsReserved word) =>
-             (PTerm -> Loc -> PTerm) -> Grammar True PTerm
-resAppTerm fname word f = withLoc fname $ do
-  head <- withLoc fname $ resC word *> mustWork [|f (termArg fname)|]
-  args <- many $ anyArg fname
-  pure $ \loc => foldl (appArg loc) head args
-
-export
-succTerm : FileName -> Grammar True PTerm
-succTerm fname = resAppTerm fname "succ" Succ
-
-export
-fstTerm : FileName -> Grammar True PTerm
-fstTerm fname = resAppTerm fname "fst" Fst
-
-export
-sndTerm : FileName -> Grammar True PTerm
-sndTerm fname = resAppTerm fname "snd" Snd
-
 export
 normalAppTerm : FileName -> Grammar True PTerm
 normalAppTerm fname = withLoc fname $ do
   head <- termArg fname
   args <- many $ anyArg fname
-  pure $ \loc => foldl (appArg loc) head args
+  pure $ \loc => foldl (ap loc) head args
+where ap : Loc -> PTerm -> Either PDim PTerm -> PTerm
+      ap loc f (Left  p) = DApp f p loc
+      ap loc f (Right s) = App  f s loc
 
 ||| application term `f x @y z`, or other terms that look like application
 ||| like `succ` or `coe`.
@@ -488,16 +411,21 @@ appTerm fname =
   <|> splitUniverseTerm fname
   <|> eqTerm fname
   <|> succTerm fname
-  <|> fstTerm fname
-  <|> sndTerm fname
   <|> normalAppTerm fname
 
+export
+supTerm : FileName -> Grammar True PTerm
+supTerm fname = withLoc fname $ do
+  l <- appTerm fname; commit
+  r <- optional $ res "⋄" *> assert_total supTerm fname
+  pure $ \loc => maybe l (\r => Sup l r loc) r
+
 export
 infixEqTerm : FileName -> Grammar True PTerm
 infixEqTerm fname = withLoc fname $ do
-  l <- appTerm fname; commit
+  l <- supTerm fname; commit
   rest <- optional $ res "≡" *>
-    [|(,) (assert_total term fname) (needRes ":" *> appTerm fname)|]
+    [|(,) (assert_total term fname) (needRes ":" *> supTerm fname)|]
   let u = Unused $ onlyStart l.loc
   pure $ \loc => maybe l (\rest => Eq (u, snd rest) l (fst rest) loc) rest
 
@@ -517,8 +445,38 @@ lamTerm fname = withLoc fname $ do
     body <- assert_total term fname; commit
     pure $ \loc => foldr (\x, s => k x s loc) body xs
 
+
+private
+data BindType = BPi | BW | BSig
+%runElab derive "BindType" [Eq, Ord]
+
+private
+data BindSequence' b a = BLast a | BMore a b (BindSequence' b a)
+
+private
+data BindTypeL = BTL BindType Loc
+%runElab derive "BindTypeL" [Eq, Ord]
+
+private
+data BindPart = BT (Maybe PQty) (List1 PatVar) PTerm
+Located BindPart where
+  (BT q xs t).loc = maybe (head xs).loc (.loc) q `extendL` t.loc
+
+
+private
+BindSequence : Type
+BindSequence = BindSequence' BindTypeL BindPart
+
+private
+bindType : FileName -> Grammar True BindTypeL
+bindType fname = bt BPi "→" <|> bt BW "⊲" <|> bt BSig "×"
+where
+  bt : BindType -> (s : String) -> (0 _ : IsReserved s) =>
+       Grammar True BindTypeL
+  bt t str = withLoc fname $ resC str $> BTL t
+
 -- [todo] fix the backtracking in e.g. (F x y z × B)
-export
+private
 properBinders : FileName -> Grammar True (List1 PatVar, PTerm)
 properBinders fname = assert_total $ do
   -- putting assert_total directly on `term`, in this one function,
@@ -528,340 +486,187 @@ properBinders fname = assert_total $ do
   t  <- term fname;          needRes ")"
   pure (xs, t)
 
-export
-sigmaTerm : FileName -> Grammar True PTerm
-sigmaTerm fname =
-      (properBinders fname >>= continueDep)
-  <|> (annTerm fname       >>= continueNondep)
-where
-  continueDep : (List1 PatVar, PTerm) -> Grammar True PTerm
-  continueDep (names, fst) = withLoc fname $ do
-    snd <- needRes "×" *> sigmaTerm fname
-    pure $ \loc => foldr (\x, snd => Sig x fst snd loc) snd names
-
-  cross : PTerm -> PTerm -> PTerm
-  cross l r = let loc = extend' l.loc r.loc.bounds in
-              Sig (Unused $ onlyStart l.loc) l r loc
-
-  continueNondep : PTerm -> Grammar False PTerm
-  continueNondep fst = do
-    rest <- optional $ resC "×" *> sepBy1 (res "×") (annTerm fname)
-    pure $ foldr1 cross $ fst ::: maybe [] toList rest
-
-export
-piTerm : FileName -> Grammar True PTerm
-piTerm fname = withLoc fname $ do
-  q   <- [|GivenQ $ qty fname <* resC "."|] <|> defLoc fname DefaultQ
-  dom <- [|Dep $ properBinders fname|] <|> [|Nondep $ ndDom q fname|]
-  cod <- optional $ do resC "→"; assert_total term fname <* commit
-  when (needCod q dom && isNothing cod) $ fail "missing function type result"
-  pure $ maybe (const $ toTerm dom) (makePi q dom) cod
-where
-  data PiQty = GivenQ PQty | DefaultQ Loc
-  data PiDom = Dep (List1 PatVar, PTerm) | Nondep PTerm
-
-  ndDom : PiQty -> FileName -> Grammar True PTerm
-  ndDom (GivenQ   _) = termArg   -- ｢1.(List A)｣, not ｢1.List A｣
-  ndDom (DefaultQ _) = sigmaTerm
-
-  needCod : PiQty -> PiDom -> Bool
-  needCod (DefaultQ _) (Nondep _) = False
-  needCod _            _          = True
-
-  toTerm : PiDom -> PTerm
-  toTerm (Dep (_, s)) = s
-  toTerm (Nondep s)   = s
-
-  toQty : PiQty -> PQty
-  toQty (GivenQ   qty) = qty
-  toQty (DefaultQ loc) = PQ One loc
-
-  toDoms : PQty -> PiDom -> List1 (PQty, PatVar, PTerm)
-  toDoms qty (Dep (xs, s)) = [(qty, x, s) | x <- xs]
-  toDoms qty (Nondep s)    = singleton (qty, Unused s.loc, s)
-
-  makePi : PiQty -> PiDom -> PTerm -> Loc -> PTerm
-  makePi q doms cod loc =
-    foldr (\(q, x, s), t => Pi q x s t loc) cod $ toDoms (toQty q) doms
-
-
-export
-letIntro : FileName -> Grammar True (Maybe PQty)
-letIntro fname =
-      withLoc fname (Just . PQ Zero <$ res "let0")
-  <|> withLoc fname (Just . PQ One  <$ res "let1")
-  <|> withLoc fname (Just . PQ Any  <$ res "letω")
-  <|> Nothing <$ resC "let"
+private
+bindPart : FileName -> Grammar True BindPart
+bindPart fname = do
+  qty <- optional $ qty fname <* resC "."
+  bnd <- properBinders fname
+     <|> do n <- unused fname
+            t <- if isJust qty then termArg fname else annTerm fname
+            pure (singleton n, t)
+  pure $ uncurry (BT qty) bnd
 
 private
-letBinder : FileName -> Maybe PQty -> Grammar True (PQty, PatVar, PTerm)
-letBinder fname mq = do
-  qty  <- letQty fname mq
-  x    <- patVar fname
-  type <- optional $ resC ":" *> term fname
-  rhs  <- resC "=" *> term fname
-  pure (qty, x, makeLetRhs rhs type)
-where
-  letQty : FileName -> Maybe PQty -> Grammar False PQty
-  letQty fname Nothing  = qty fname <* mustWork (resC ".") <|> defLoc fname (PQ One)
-  letQty fname (Just q) = pure q
+bindSequence : FileName -> Grammar True BindSequence
+bindSequence fname = do
+  x  <- bindPart fname
+  by <- optional $ do
+    b <- bindType fname
+    y <- mustWork $ assert_total bindSequence fname
+    pure (b, y)
+  pure $ maybe (BLast x) (\by => BMore x (fst by) (snd by)) by
 
-  makeLetRhs : PTerm -> Maybe PTerm -> PTerm
-  makeLetRhs tm ty = maybe tm (\t => Ann tm t (extendL tm.loc t.loc)) ty
+private
+fromBindSequence : BindSequence -> Grammar False PTerm
+fromBindSequence as = go [<] as where
+  -- the ol’ shunty
+  data Elem = E BindPart BindTypeL
+
+  fatalLoc' : Located z => z -> String -> Grammar False a
+  fatalLoc' z = maybe fatalError fatalLoc z.loc.bounds
+
+  toTerm : BindPart -> Grammar False PTerm
+  toTerm (BT Nothing (Unused _ ::: []) s) = pure s
+  toTerm s = fatalLoc' s $
+    "binder with no following body\n" ++
+    "(maybe some missing parens)"
+
+  fromTerm : PTerm -> BindPart
+  fromTerm t = BT Nothing (singleton $ Unused t.loc) t
+
+  checkNoQty : String -> Maybe PQty -> Grammar False ()
+  checkNoQty s (Just q) = fatalLoc' q "no quantity allowed with \{s}"
+  checkNoQty _ _ = pure ()
+
+  apply : Elem -> PTerm -> Grammar False PTerm
+  apply (E s'@(BT mqty xs s) (BTL b _)) t = case b of
+    BPi => do
+      let q   = fromMaybe (PQ One s.loc) mqty
+          loc = s'.loc `extendL` t.loc
+      pure $ foldr (\x, t => Pi q x s t loc) t xs
+    BW => do
+      checkNoQty "⊲" mqty
+      when (length xs /= 1) $ do
+        let loc = foldr1 extendL $ map (.loc) xs
+        fatalLoc' loc "only one binding allowed with ⊲"
+      pure $ W (head xs) s t (s.loc `extendL` t.loc)
+    BSig => do
+      checkNoQty "×" mqty
+      let loc = s'.loc `extendL` t.loc
+      pure $ foldr (\x, t => Sig x s t loc) t xs
+
+  end : SnocList Elem -> PTerm -> Grammar False PTerm
+  end [<]       t = pure t
+  end (es :< e) t = end es !(apply e t)
+
+  go : SnocList Elem -> BindSequence -> Grammar False PTerm
+  go es (BLast a) = do
+    end es !(toTerm a)
+  go [<] (BMore a b as) =
+    go [< E a b] as
+  go (es :< e@(E a' b')) (BMore a b as) =
+    if b' > b then do
+      t <- apply e !(toTerm a)
+      go (es :< E (fromTerm t) b) as
+    else
+      go (es :< e :< E a b) as
 
 export
-letTerm : FileName -> Grammar True PTerm
-letTerm fname = withLoc fname $ do
-  qty   <- letIntro fname
-  binds <- sepEndBy1 (res ";") $ assert_total letBinder fname qty
-  mustWork $ resC "in"
-  body  <- assert_total term fname
-  pure $ \loc => foldr (\b, s => Let b s loc) body binds
+bindTerm : FileName -> Grammar True PTerm
+bindTerm fname = fromBindSequence !(bindSequence fname)
 
--- term : FileName -> Grammar True PTerm
-term fname = lamTerm fname
-         <|> piTerm fname
-         <|> sigmaTerm fname
-         <|> letTerm fname
-
-
-export
-attr' : FileName -> (o : String) -> (0 _ : IsReserved o) =>
-        Grammar True PAttr
-attr' fname o = withLoc fname $ do
-  resC o
-  name <- baseName
-  args <- many $ termArg fname
-  mustWork $ resC "]"
-  pure $ PA name args
-
-export %inline
-attr : FileName -> Grammar True PAttr
-attr fname = attr' fname "#["
-
-export
-findDups : List PAttr -> List String
-findDups attrs =
-  SortedSet.toList $ snd $ foldl check (empty, empty) attrs
-where
-  Seen = SortedSet String; Dups = SortedSet String
-  check : (Seen, Dups) -> PAttr -> (Seen, Dups)
-  check (seen, dups) (PA a _ _) =
-    (insert a seen, if contains a seen then insert a dups else dups)
-
-export
-noDups : List PAttr -> Grammar False ()
-noDups attrs = do
-  let dups = findDups attrs
-  when (not $ null dups) $
-    fatalError "duplicate attribute names: \{joinBy "," dups}"
-
-export
-attrList : FileName -> Grammar False (List PAttr)
-attrList fname = do
-  res <- many $ attr fname
-  noDups res $> res
 
 public export
-data AttrMatch a =
-    Matched a
-  | NoMatch String (List String)
-  | Malformed String String
+PCaseArm : Type
+PCaseArm = (PCasePat, PTerm)
 
 export
-Functor AttrMatch where
-  map f (Matched x)     = Matched $ f x
-  map f (NoMatch s w)   = NoMatch s w
-  map f (Malformed a e) = Malformed a e
+caseArm : FileName -> Grammar True PCaseArm
+caseArm fname =
+  [|(,) (casePat fname) (needRes "⇒" *> assert_total term fname)|]
 
 export
-(<|>) : AttrMatch a -> AttrMatch a -> AttrMatch a
-Matched x     <|> _ = Matched x
-NoMatch {}    <|> y = y
-Malformed a e <|> _ = Malformed a e
+checkCaseArms : Loc -> List PCaseArm -> Grammar False PCaseBody
+checkCaseArms loc [] = pure $ CaseEnum [] loc
+checkCaseArms loc ((PPair x y _, rhs) :: rest) =
+  if null rest then pure $ CasePair (x, y) rhs loc
+  else fatalError "unexpected pattern after pair"
+checkCaseArms loc ((PTag tag _, rhs1) :: rest) = do
+  let rest = for rest $ \case
+        (PTag tag _, rhs) => Just (tag, rhs)
+        _                 => Nothing
+  maybe (fatalError "expected all patterns to be tags")
+        (\rest => pure $ CaseEnum ((tag, rhs1) :: rest) loc) rest
+checkCaseArms loc ((PZero _, rhs1) :: rest) = do
+  let [(PSucc p q ih _, rhs2)] = rest
+    | _ => fatalError "expected succ pattern after zero"
+  pure $ CaseNat rhs1 (p, q, ih, rhs2) loc
+checkCaseArms loc ((PSucc p q ih _, rhs1) :: rest) = do
+  let [(PZero _, rhs2)] = rest
+    | _ => fatalError "expected zero pattern after succ"
+  pure $ CaseNat rhs2 (p, q, ih, rhs1) loc
+checkCaseArms loc ((PBox x _, rhs) :: rest) =
+  if null rest then pure $ CaseBox x rhs loc
+  else fatalError "unexpected pattern after box"
+checkCaseArms loc ((PSup x y rh ih _, rhs) :: rest) =
+  if null rest then pure $ CaseW x y (rh, ih) rhs loc
+  else fatalError "unexpected pattern after sup"
 
 export
-isFail : PAttr -> List String -> AttrMatch PFail
-isFail (PA "fail" []        _) _ = Matched PFailAny
-isFail (PA "fail" [Str s _] _) _ = Matched $ PFailMatch s
-isFail (PA "fail" _ _) _ = Malformed "fail" "be absent or a string literal"
-isFail a w = NoMatch a.name w
+caseBody : FileName -> Grammar True PCaseBody
+caseBody fname = do
+  body <- bounds $ delimSep "{" "}" ";" $ caseArm fname
+  let loc = makeLoc fname body.bounds
+  checkCaseArms loc body.val
 
 export
-isMain : PAttr -> List String -> AttrMatch ()
-isMain (PA "main" [] _) _ = Matched ()
-isMain (PA "main" _  _) _ = Malformed "main" "have no arguments"
-isMain a w = NoMatch a.name w
+caseReturn : FileName -> Grammar True (PatVar, PTerm)
+caseReturn fname = do
+  x   <- patVar fname <* resC "⇒" <|> unused fname
+  ret <- assert_total term fname
+  pure (x, ret)
 
 export
-isScheme : PAttr -> List String -> AttrMatch String
-isScheme (PA "compile-scheme" [Str s _] _) _ = Matched s
-isScheme (PA "compile-scheme" _ _) _ =
-  Malformed "compile-scheme" "be a string literal"
-isScheme a w = NoMatch a.name w
+caseTerm : FileName -> Grammar True PTerm
+caseTerm fname = withLoc fname $ do
+  qty <- caseIntro fname;                     commit
+  head <- mustWork $ assert_total term fname; needRes "return"
+  ret  <- mustWork $ caseReturn fname;        needRes "of"
+  body <- mustWork $ caseBody fname
+  pure $ Case qty head ret body
 
-export
-matchAttr : String -> AttrMatch a -> Either String a
-matchAttr _ (Matched x) = Right x
-matchAttr d (NoMatch a w) = Left $ unlines
-  ["unrecognised \{d} attribute \{a}", "expected one of: \{show w}"]
-matchAttr _ (Malformed a s) = Left $ unlines
-  ["invalid \{a} attribute", "(should \{s})"]
-
-export
-mkPDef : List PAttr -> PQty -> PBaseName -> PBody ->
-         Either String (Loc -> PDefinition)
-mkPDef attrs qty name body = do
-  let start = MkPDef qty name body PSucceed False Nothing noLoc
-  res <- foldlM addAttr start attrs
-  pure $ \l => {loc_ := l} (the PDefinition res)
-where
-  data PDefAttr = DefFail PFail | DefMain | DefScheme String
-
-  isDefAttr : PAttr -> Either String PDefAttr
-  isDefAttr attr =
-    let defAttrs = ["fail", "main", "compile-scheme"] in
-    matchAttr "definition" $
-        DefFail   <$> isFail attr defAttrs
-    <|> DefMain   <$  isMain attr defAttrs
-    <|> DefScheme <$> isScheme attr defAttrs
-
-  addAttr : PDefinition -> PAttr -> Either String PDefinition
-  addAttr def attr =
-    case !(isDefAttr attr) of
-      DefFail   f   => pure $ {fail := f} def
-      DefMain       => pure $ {main := True} def
-      DefScheme str => pure $ {scheme := Just str} def
-
-export
-mkPNamespace : List PAttr -> Mods -> List PDecl ->
-               Either String (Loc -> PNamespace)
-mkPNamespace attrs name decls = do
-  let start = MkPNamespace name decls PSucceed noLoc
-  res <- foldlM addAttr start attrs
-  pure $ \l => {loc_ := l} (the PNamespace res)
-where
-  isNsAttr a = matchAttr "namespace" $ isFail a ["fail"]
-
-  addAttr : PNamespace -> PAttr -> Either String PNamespace
-  addAttr ns attr = pure $ {fail := !(isNsAttr attr)} ns
-
-||| `def` alone means `defω`; same for `postulate`
-export
-defIntro' : (bare, zero, omega : String) ->
-            (0 _ : IsReserved bare) =>
-            (0 _ : IsReserved zero) =>
-            (0 _ : IsReserved omega) =>
-            FileName -> Grammar True PQty
-defIntro' bare zero omega fname =
-      withLoc fname (PQ Zero <$ resC zero)
-  <|> withLoc fname (PQ Any  <$ resC omega)
-  <|> do pos <- bounds $ resC bare
-         let any = PQ Any $ makeLoc fname pos.bounds
-         option any $ qty fname <* needRes "."
-
-export
-defIntro : FileName -> Grammar True PQty
-defIntro = defIntro' "def" "def0" "defω"
-
-export
-postulateIntro : FileName -> Grammar True PQty
-postulateIntro = defIntro' "postulate" "postulate0" "postulateω"
-
-export
-postulate : FileName -> List PAttr -> Grammar True PDefinition
-postulate fname attrs = withLoc fname $ do
-  qty  <- postulateIntro fname
-  name <- baseName
-  type <- resC ":" *> mustWork (term fname)
-  optRes ";"
-  either fatalError pure $ mkPDef attrs qty name $ PPostulate type
-
-export
-concrete : FileName -> List PAttr -> Grammar True PDefinition
-concrete fname attrs = withLoc fname $ do
-  qty  <- defIntro fname
-  name <- baseName
-  type <- optional $ resC ":" *> mustWork (term fname)
-  term <- needRes "=" *> mustWork (term fname)
-  optRes ";"
-  either fatalError pure $ mkPDef attrs qty name $ PConcrete type term
-
-export
-definition : FileName -> List PAttr -> Grammar True PDefinition
-definition fname attrs =
-  try (postulate fname attrs) <|> concrete fname attrs
-
-export
-nsname : Grammar True Mods
-nsname = do ns <- qname; pure $ ns.mods :< ns.base
-
-export
-pragma : FileName -> Grammar True PPragma
-pragma fname = do
-  a <- attr' fname "#!["
-  either fatalError pure $ case a.name of
-    "log" => logArgs a.args a.loc
-    _     => Left $
-      #"unrecognised pragma "\#{a.name}"\n"# ++
-      #"known pragmas: ["log"]"#
-where
-  levelOOB : Nat -> Either String a
-  levelOOB n = Left $
-    "log level \{show n} out of bounds\n" ++
-    "expected number in range 0–\{show maxLogLevel} inclusive"
-
-  toLevel : Nat -> Either String LogLevel
-  toLevel lvl = maybe (levelOOB lvl) Right $ toLogLevel lvl
-
-  unknownCat : String -> Either String a
-  unknownCat cat = Left $
-    "unknown log category \{show cat}\n" ++
-    "known categories: \{show $ ["all", "default"] ++ logCategories}"
-
-  toCat : String -> Either String LogCategory
-  toCat cat = maybe (unknownCat cat) Right $ toLogCategory cat
-
-  fromPair : PTerm -> Either String (String, Nat)
-  fromPair (Pair (V (MkPName [<] x) Nothing _) (Nat n _) _) = Right (x, n)
-  fromPair _ = Left "invalid argument to log pragma"
-
-  logCatArg : (String, Nat) -> Either String Log.PushArg
-  logCatArg ("default", lvl) = [|SetDefault $ toLevel lvl|]
-  logCatArg ("all",     lvl) = [|SetAll $ toLevel lvl|]
-  logCatArg (cat,       lvl) = [|SetCat (toCat cat) (toLevel lvl)|]
-
-  logArgs : List PTerm -> Loc -> Either String PPragma
-  logArgs [] _ = Left "missing arguments to log pragma"
-  logArgs [V "pop" Nothing _] loc = Right $ PLogPop loc
-  logArgs other loc = do
-    args <- traverse (logCatArg <=< fromPair) other
-    pure $ PLogPush args loc
+-- export
+-- term : FileName -> Grammar True PTerm
+term fname = lamTerm fname
+         <|> caseTerm fname
+         <|> bindTerm fname
 
 
 export
 decl : FileName -> Grammar True PDecl
 
+||| `def` alone means `defω`
 export
-namespace_ : FileName -> List PAttr -> Grammar True PNamespace
-namespace_ fname attrs = withLoc fname $ do
-  ns    <- resC "namespace" *> nsname; needRes "{"
-  decls <- nsInner
-  either fatalError pure $ mkPNamespace attrs ns decls
+defIntro : FileName -> Grammar True PQty
+defIntro fname =
+      withLoc fname (PQ Zero <$ resC "def0")
+  <|> withLoc fname (PQ Any  <$ resC "defω")
+  <|> do pos <- bounds $ resC "def"
+         let any = PQ Any $ makeLoc fname pos.bounds
+         option any $ qty fname <* needRes "."
+
+export
+definition : FileName -> Grammar True PDefinition
+definition fname = withLoc fname $ do
+  qty  <- defIntro fname
+  name <- baseName
+  type <- optional $ resC ":" *> mustWork (term fname)
+  term <- needRes "=" *> mustWork (term fname)
+  optRes ";"
+  pure $ MkPDef qty name type term
+
+export
+namespace_ : FileName -> Grammar True PNamespace
+namespace_ fname = withLoc fname $ do
+  ns    <- resC "namespace" *> qname; needRes "{"
+  decls <- nsInner; optRes ";"
+  pure $ MkPNamespace (ns.mods :< ns.base) decls
 where
   nsInner : Grammar True (List PDecl)
   nsInner = [] <$ resC "}"
         <|> [|(assert_total decl fname <* commit) :: assert_total nsInner|]
 
-export
-declBody : FileName -> List PAttr -> Grammar True PDecl
-declBody fname attrs =
-  [|PDef $ definition fname attrs|] <|> [|PNs $ namespace_ fname attrs|]
-
--- decl : FileName -> Grammar True PDecl
-decl fname =
-      (attrList fname >>= declBody fname)
-  <|> PPrag <$> pragma fname
+decl fname = [|PDef $ definition fname|] <|> [|PNs $ namespace_ fname|]
 
 export
 load : FileName -> Grammar True PTopLevel
@@ -873,7 +678,7 @@ topLevel : FileName -> Grammar True PTopLevel
 topLevel fname = load fname <|> [|PD $ decl fname|]
 
 export
-input : FileName -> Grammar False PFile
+input : FileName -> Grammar False (List PTopLevel)
 input fname = [] <$ eof
           <|> [|(topLevel fname <* commit) :: assert_total input fname|]
 
@@ -882,5 +687,5 @@ lexParseTerm : FileName -> String -> Either Error PTerm
 lexParseTerm = lexParseWith . term
 
 export
-lexParseInput : FileName -> String -> Either Error PFile
+lexParseInput : FileName -> String -> Either Error (List PTopLevel)
 lexParseInput = lexParseWith . input
diff --git a/lib/Quox/Parser/Syntax.idr b/lib/Quox/Parser/Syntax.idr
index 9197efe..d08ab65 100644
--- a/lib/Quox/Parser/Syntax.idr
+++ b/lib/Quox/Parser/Syntax.idr
@@ -3,8 +3,6 @@ module Quox.Parser.Syntax
 import public Quox.Loc
 import public Quox.Syntax
 import public Quox.Definition
-import Quox.PrettyValExtra
-import public Quox.Log
 
 import Derive.Prelude
 %hide TT.Name
@@ -16,9 +14,9 @@ import Derive.Prelude
 public export
 data PatVar = Unused Loc | PV PBaseName Loc
 %name PatVar v
-%runElab derive "PatVar" [Eq, Ord, Show, PrettyVal]
+%runElab derive "PatVar" [Eq, Ord, Show]
 
-export %inline
+export
 Located PatVar where
   (Unused loc).loc = loc
   (PV _   loc).loc = loc
@@ -40,17 +38,17 @@ record PQty where
   val  : Qty
   loc_ : Loc
 %name PQty qty
-%runElab derive "PQty" [Eq, Ord, Show, PrettyVal]
+%runElab derive "PQty" [Eq, Ord, Show]
 
-export %inline Located PQty where q.loc = q.loc_
+export Located PQty where q.loc = q.loc_
 
 namespace PDim
   public export
   data PDim = K DimConst Loc | V PBaseName Loc
   %name PDim p, q
-  %runElab derive "PDim" [Eq, Ord, Show, PrettyVal]
+  %runElab derive "PDim" [Eq, Ord, Show]
 
-export %inline
+export
 Located PDim where
   (K _ loc).loc = loc
   (V _ loc).loc = loc
@@ -58,7 +56,7 @@ Located PDim where
 public export
 data PTagVal = PT TagVal Loc
 %name PTagVal tag
-%runElab derive "PTagVal" [Eq, Ord, Show, PrettyVal]
+%runElab derive "PTagVal" [Eq, Ord, Show]
 
 
 namespace PTerm
@@ -68,8 +66,6 @@ namespace PTerm
     data PTerm =
         TYPE Universe Loc
 
-      | IOState Loc
-
       | Pi PQty PatVar PTerm PTerm Loc
       | Lam PatVar PTerm Loc
       | App PTerm PTerm Loc
@@ -77,7 +73,9 @@ namespace PTerm
       | Sig PatVar PTerm PTerm Loc
       | Pair PTerm PTerm Loc
       | Case PQty PTerm (PatVar, PTerm) PCaseBody Loc
-      | Fst PTerm Loc | Snd PTerm Loc
+
+      | W PatVar PTerm PTerm Loc
+      | Sup PTerm PTerm Loc
 
       | Enum (List TagVal) Loc
       | Tag TagVal Loc
@@ -86,11 +84,8 @@ namespace PTerm
       | DLam PatVar PTerm Loc
       | DApp PTerm PDim Loc
 
-      | NAT Loc
-      | Nat Nat Loc | Succ PTerm Loc
-
-      | STRING Loc  -- "String" is a reserved word in idris
-      | Str String Loc
+      | Nat Loc
+      | Zero Loc | Succ PTerm Loc
 
       | BOX PQty PTerm Loc
       | Box PTerm Loc
@@ -101,101 +96,66 @@ namespace PTerm
       | Coe (PatVar, PTerm) PDim PDim PTerm Loc
       | Comp (PatVar, PTerm) PDim PDim PTerm PDim
              (PatVar, PTerm) (PatVar, PTerm) Loc
-
-      | Let (PQty, PatVar, PTerm) PTerm Loc
     %name PTerm s, t
 
     public export
     data PCaseBody =
         CasePair (PatVar, PatVar) PTerm Loc
+      | CaseW PatVar PatVar (PQty, PatVar) PTerm Loc
       | CaseEnum (List (PTagVal, PTerm)) Loc
       | CaseNat PTerm (PatVar, PQty, PatVar, PTerm) Loc
       | CaseBox PatVar PTerm Loc
     %name PCaseBody body
 
-  public export %inline
-  Zero : Loc -> PTerm
-  Zero = Nat 0
+%runElab deriveMutual ["PTerm", "PCaseBody"] [Eq, Ord, Show]
 
-%runElab deriveMutual ["PTerm", "PCaseBody"] [Eq, Ord, Show, PrettyVal]
-
-export %inline
+export
 Located PTerm where
-  (TYPE    _             loc).loc = loc
-  (IOState               loc).loc = loc
-  (Pi      _ _ _ _       loc).loc = loc
-  (Lam     _ _           loc).loc = loc
-  (App     _ _           loc).loc = loc
-  (Sig     _ _ _         loc).loc = loc
-  (Pair    _ _           loc).loc = loc
-  (Fst     _             loc).loc = loc
-  (Snd     _             loc).loc = loc
-  (Case    _ _ _ _       loc).loc = loc
-  (Enum    _             loc).loc = loc
-  (Tag     _             loc).loc = loc
-  (Eq      _ _ _         loc).loc = loc
-  (DLam    _ _           loc).loc = loc
-  (DApp    _ _           loc).loc = loc
-  (NAT                   loc).loc = loc
-  (Nat     _             loc).loc = loc
-  (Succ    _             loc).loc = loc
-  (STRING                loc).loc = loc
-  (Str     _             loc).loc = loc
-  (BOX     _ _           loc).loc = loc
-  (Box     _             loc).loc = loc
-  (V       _ _           loc).loc = loc
-  (Ann     _ _           loc).loc = loc
-  (Coe     _ _ _ _       loc).loc = loc
-  (Comp    _ _ _ _ _ _ _ loc).loc = loc
-  (Let     _ _           loc).loc = loc
+  (TYPE _             loc).loc = loc
+  (Pi   _ _ _ _       loc).loc = loc
+  (Lam  _ _           loc).loc = loc
+  (App  _ _           loc).loc = loc
+  (Sig  _ _ _         loc).loc = loc
+  (Pair _ _           loc).loc = loc
+  (Case _ _ _ _       loc).loc = loc
+  (W    _ _ _         loc).loc = loc
+  (Sup  _ _           loc).loc = loc
+  (Enum _             loc).loc = loc
+  (Tag  _             loc).loc = loc
+  (Eq   _ _ _         loc).loc = loc
+  (DLam _ _           loc).loc = loc
+  (DApp _ _           loc).loc = loc
+  (Nat                loc).loc = loc
+  (Zero               loc).loc = loc
+  (Succ _             loc).loc = loc
+  (BOX  _ _           loc).loc = loc
+  (Box  _             loc).loc = loc
+  (V    _ _           loc).loc = loc
+  (Ann  _ _           loc).loc = loc
+  (Coe  _ _ _ _       loc).loc = loc
+  (Comp _ _ _ _ _ _ _ loc).loc = loc
 
-export %inline
+export
 Located PCaseBody where
-  (CasePair _ _ loc).loc = loc
-  (CaseEnum _   loc).loc = loc
-  (CaseNat  _ _ loc).loc = loc
-  (CaseBox  _ _ loc).loc = loc
+  (CasePair _ _     loc).loc = loc
+  (CaseW    _ _ _ _ loc).loc = loc
+  (CaseEnum _       loc).loc = loc
+  (CaseNat  _ _     loc).loc = loc
+  (CaseBox  _ _     loc).loc = loc
 
 
-public export
-data PBody = PConcrete (Maybe PTerm) PTerm | PPostulate PTerm
-%name PBody body
-%runElab derive "PBody" [Eq, Ord, Show, PrettyVal]
-
-
-public export
-data PFail =
-  PSucceed
-| PFailAny
-| PFailMatch String
-%runElab derive "PFail" [Eq, Ord, Show, PrettyVal]
-
 public export
 record PDefinition where
   constructor MkPDef
-  qty    : PQty
-  name   : PBaseName
-  body   : PBody
-  fail   : PFail
-  main   : Bool
-  scheme : Maybe String
-  loc_   : Loc
+  qty  : PQty
+  name : PBaseName
+  type : Maybe PTerm
+  term : PTerm
+  loc_ : Loc
 %name PDefinition def
-%runElab derive "PDefinition" [Eq, Ord, Show, PrettyVal]
+%runElab derive "PDefinition" [Eq, Ord, Show]
 
-export %inline Located PDefinition where def.loc = def.loc_
-
-public export
-data PPragma =
-    PLogPush (List Log.PushArg) Loc
-  | PLogPop  Loc
-%name PPragma prag
-%runElab derive "PPragma" [Eq, Ord, Show, PrettyVal]
-
-export %inline
-Located PPragma where
-  (PLogPush _ loc).loc = loc
-  (PLogPop    loc).loc = loc
+export Located PDefinition where def.loc = def.loc_
 
 mutual
   public export
@@ -203,49 +163,35 @@ mutual
     constructor MkPNamespace
     name  : Mods
     decls : List PDecl
-    fail  : PFail
     loc_  : Loc
   %name PNamespace ns
 
   public export
   data PDecl =
-      PDef  PDefinition
-    | PNs   PNamespace
-    | PPrag PPragma
+      PDef PDefinition
+    | PNs  PNamespace
   %name PDecl decl
-%runElab deriveMutual ["PNamespace", "PDecl"] [Eq, Ord, Show, PrettyVal]
+%runElab deriveMutual ["PNamespace", "PDecl"] [Eq, Ord, Show]
 
-export %inline Located PNamespace where ns.loc = ns.loc_
+export Located PNamespace where ns.loc = ns.loc_
 
-export %inline
+export
 Located PDecl where
-  (PDef  d).loc    = d.loc
-  (PNs   ns).loc   = ns.loc
-  (PPrag prag).loc = prag.loc
+  (PDef def).loc = def.loc
+  (PNs  ns).loc  = ns.loc
 
 public export
 data PTopLevel = PD PDecl | PLoad String Loc
 %name PTopLevel t
-%runElab derive "PTopLevel" [Eq, Ord, Show, PrettyVal]
+%runElab derive "PTopLevel" [Eq, Ord, Show]
 
-export %inline
+export
 Located PTopLevel where
   (PD    decl).loc  = decl.loc
   (PLoad _ loc).loc = loc
 
 
 public export
-record PAttr where
-  constructor PA
-  name : PBaseName
-  args : List PTerm
-  loc_ : Loc
-%name PAttr attr
-%runElab derive "PAttr" [Eq, Ord, Show, PrettyVal]
-
-export %inline Located PAttr where attr.loc = attr.loc_
-
-
-public export
-PFile : Type
-PFile = List PTopLevel
+fromNat : Nat -> Loc -> PTerm
+fromNat 0     loc = Zero loc
+fromNat (S k) loc = Succ (fromNat k loc) loc
diff --git a/lib/Quox/Pretty.idr b/lib/Quox/Pretty.idr
index 606ec78..b8873de 100644
--- a/lib/Quox/Pretty.idr
+++ b/lib/Quox/Pretty.idr
@@ -3,7 +3,6 @@ module Quox.Pretty
 import Quox.Loc
 import Quox.Name
 
-import Control.Monad.ST.Extra
 import public Text.PrettyPrint.Bernardy
 import public Text.PrettyPrint.Bernardy.Core.Decorate
 import public Quox.EffExtra
@@ -25,9 +24,13 @@ data PPrec
 = Outer
 | Times   -- "_ × _"
 | InTimes -- arguments of ×
+| W       -- "_ ⊲ _"
+| InW     -- arguments of ⊲
 | AnnL    -- left of "∷"
 | Eq      -- "_ ≡ _ : _"
 | InEq    -- arguments of ≡
+| Sup     -- "_ ⋄ _"
+| InSup   -- arguments of ⋄
   -- ...
 | App  -- term/dimension application
 | Arg  -- argument to nonfix function
@@ -41,7 +44,7 @@ data HL
 | Dim  | DVar | DVarErr
 | Qty  | Universe
 | Syntax
-| Constant
+| Tag
 %runElab derive "HL" [Eq, Ord, Show]
 
 
@@ -66,12 +69,11 @@ export %inline
 runPrettyWith : PPrec -> Flavor -> (HL -> Highlight) -> Nat ->
                 Eff Pretty a -> a
 runPrettyWith prec flavor highlight indent act =
-  runST $ do
-    runEff act $ with Union.(::)
-      [handleStateSTRef !(newSTRef prec),
-       handleReaderConst flavor,
-       handleReaderConst highlight,
-       handleReaderConst indent]
+  extract $
+  evalStateAt PREC prec $
+  runReaderAt FLAVOR flavor $
+  runReaderAt HIGHLIGHT highlight $
+  runReaderAt INDENT indent act
 
 
 export %inline
@@ -86,65 +88,43 @@ toSGR DVarErr  = [SetForeground BrightGreen, SetStyle SingleUnderline]
 toSGR Qty      = [SetForeground BrightMagenta]
 toSGR Universe = [SetForeground BrightRed]
 toSGR Syntax   = [SetForeground BrightCyan]
-toSGR Constant = [SetForeground BrightRed]
+toSGR Tag      = [SetForeground BrightRed]
 
 export %inline
 highlightSGR : HL -> Highlight
 highlightSGR h = MkHighlight (escapeSGR $ toSGR h) (escapeSGR [Reset])
 
-export %inline
-toClass : HL -> String
-toClass Delim    = "dl"
-toClass Free     = "fr"
-toClass TVar     = "tv"
-toClass TVarErr  = "tv err"
-toClass Dim      = "dc"
-toClass DVar     = "dv"
-toClass DVarErr  = "dv err"
-toClass Qty      = "qt"
-toClass Universe = "un"
-toClass Syntax   = "sy"
-toClass Constant = "co"
-
-export %inline
-highlightHtml : HL -> Highlight
-highlightHtml h = MkHighlight #"<span class="\#{toClass h}">"# "</span>"
-
-
-export %inline
-runPrettyHL : (HL -> Highlight) -> Eff Pretty a -> a
-runPrettyHL f = runPrettyWith Outer Unicode f 2
 
 export %inline
 runPretty : Eff Pretty a -> a
-runPretty = runPrettyHL noHighlight
+runPretty = runPrettyWith Outer Unicode noHighlight 2
+
+export %inline
+runPrettyColor : Eff Pretty a -> a
+runPrettyColor = runPrettyWith Outer Unicode highlightSGR 2
 
 
 export %inline
-hl : {opts : LayoutOpts} -> HL -> Doc opts -> Eff Pretty (Doc opts)
+hl : {opts : _} -> HL -> Doc opts -> Eff Pretty (Doc opts)
 hl h doc = asksAt HIGHLIGHT $ \f => decorate (f h) doc
 
 
 export %inline
-indentD : {opts : LayoutOpts} -> Doc opts -> Eff Pretty (Doc opts)
+indentD : {opts : _} -> Doc opts -> Eff Pretty (Doc opts)
 indentD doc = pure $ indent !(askAt INDENT) doc
 
 export %inline
-hangD : {opts : LayoutOpts} -> Doc opts -> Doc opts -> Eff Pretty (Doc opts)
+hangD : {opts : _} -> Doc opts -> Doc opts -> Eff Pretty (Doc opts)
 hangD d1 d2 = pure $ hangSep !(askAt INDENT) d1 d2
 
 export %inline
-hangSingle : {opts : LayoutOpts} -> Nat -> Doc opts -> Doc opts -> Doc opts
-hangSingle n d1 d2 = ifMultiline (d1 <++> d2) (vappend d1 (indent n d2))
-
-export %inline
-hangDSingle : {opts : LayoutOpts} -> Doc opts -> Doc opts ->
-              Eff Pretty (Doc opts)
-hangDSingle d1 d2 = pure $ hangSingle !(askAt INDENT) d1 d2
+hangDSingle : {opts : _} -> Doc opts -> Doc opts -> Eff Pretty (Doc opts)
+hangDSingle d1 d2 =
+  pure $ ifMultiline (d1 <++> d2) (vappend d1 !(indentD d2))
 
 
 export
-tightDelims : {opts : LayoutOpts} -> (l, r : String) -> (inner : Doc opts) ->
+tightDelims : {opts : _} -> (l, r : String) -> (inner : Doc opts) ->
               Eff Pretty (Doc opts)
 tightDelims l r inner = do
   l <- hl Delim $ text l
@@ -152,7 +132,7 @@ tightDelims l r inner = do
   pure $ hcat [l, inner, r]
 
 export
-looseDelims : {opts : LayoutOpts} -> (l, r : String) -> (inner : Doc opts) ->
+looseDelims : {opts : _} -> (l, r : String) -> (inner : Doc opts) ->
               Eff Pretty (Doc opts)
 looseDelims l r inner = do
   l <- hl Delim $ text l
@@ -162,39 +142,39 @@ looseDelims l r inner = do
   pure $ ifMultiline short long
 
 export %inline
-parens : {opts : LayoutOpts} -> Doc opts -> Eff Pretty (Doc opts)
+parens : {opts : _} -> Doc opts -> Eff Pretty (Doc opts)
 parens = tightDelims "(" ")"
 
 export %inline
-bracks : {opts : LayoutOpts} -> Doc opts -> Eff Pretty (Doc opts)
+bracks : {opts : _} -> Doc opts -> Eff Pretty (Doc opts)
 bracks = tightDelims "[" "]"
 
 export %inline
-braces : {opts : LayoutOpts} -> Doc opts -> Eff Pretty (Doc opts)
+braces : {opts : _} -> Doc opts -> Eff Pretty (Doc opts)
 braces = looseDelims "{" "}"
 
 export %inline
-tightBraces : {opts : LayoutOpts} -> Doc opts -> Eff Pretty (Doc opts)
+tightBraces : {opts : _} -> Doc opts -> Eff Pretty (Doc opts)
 tightBraces = tightDelims "{" "}"
 
 export %inline
-parensIf : {opts : LayoutOpts} -> Bool -> Doc opts -> Eff Pretty (Doc opts)
+parensIf : {opts : _} -> Bool -> Doc opts -> Eff Pretty (Doc opts)
 parensIf True  = parens
 parensIf False = pure
 
 
 ||| uses hsep only if the whole list fits on one line
 export
-sepSingle : {opts : LayoutOpts} -> List (Doc opts) -> Doc opts
+sepSingle : {opts : _} -> List (Doc opts) -> Doc opts
 sepSingle xs = ifMultiline (hsep xs) (vsep xs)
 
 export
-fillSep : {opts : LayoutOpts} -> List (Doc opts) -> Doc opts
+fillSep : {opts : _} -> List (Doc opts) -> Doc opts
 fillSep []        = empty
 fillSep (x :: xs) = foldl (\x, y => sep [x, y]) x xs
 
 export
-exceptLast : {opts : LayoutOpts} -> (Doc opts -> Doc opts) ->
+exceptLast : {opts : _} -> (Doc opts -> Doc opts) ->
              List (Doc opts) -> List (Doc opts)
 exceptLast f []        = []
 exceptLast f [x]       = [x]
@@ -209,24 +189,11 @@ parameters {opts : LayoutOpts} {auto _ : Foldable t}
   separateTight : Doc opts -> t (Doc opts) -> Doc opts
   separateTight d = sep . exceptLast (<+> d) . toList
 
-  export
-  hseparateTight : Doc opts -> t (Doc opts) -> Doc opts
-  hseparateTight d = hsep . exceptLast (<+> d) . toList
-
-  export
-  vseparateTight : Doc opts -> t (Doc opts) -> Doc opts
-  vseparateTight d = vsep . exceptLast (<+> d) . toList
-
   export
   fillSeparateTight : Doc opts -> t (Doc opts) -> Doc opts
   fillSeparateTight d = fillSep . exceptLast (<+> d) . toList
 
 
-export %inline
-pshow : {opts : LayoutOpts} -> Show a => a -> Doc opts
-pshow = text . show
-
-
 export %inline
 ifUnicode : (uni, asc : Lazy a) -> Eff Pretty a
 ifUnicode uni asc =
@@ -235,7 +202,7 @@ ifUnicode uni asc =
     Ascii   => asc
 
 export %inline
-parensIfM : {opts : LayoutOpts} -> PPrec -> Doc opts -> Eff Pretty (Doc opts)
+parensIfM : {opts : _} -> PPrec -> Doc opts -> Eff Pretty (Doc opts)
 parensIfM d doc = parensIf (!(getAt PREC) > d) doc
 
 export %inline
@@ -248,73 +215,66 @@ prettyName : Name -> Doc opts
 prettyName = text . toDots
 
 export
-prettyFree : {opts : LayoutOpts} -> Name -> Eff Pretty (Doc opts)
+prettyFree : {opts : _} -> Name -> Eff Pretty (Doc opts)
 prettyFree = hl Free . prettyName
 
 export
 prettyBind' : BindName -> Doc opts
-prettyBind' = text . baseStr . val
+prettyBind' = text . baseStr . name
 
 export
-prettyTBind : {opts : LayoutOpts} -> BindName -> Eff Pretty (Doc opts)
+prettyTBind : {opts : _} -> BindName -> Eff Pretty (Doc opts)
 prettyTBind = hl TVar . prettyBind'
 
 export
-prettyDBind : {opts : LayoutOpts} -> BindName -> Eff Pretty (Doc opts)
+prettyDBind : {opts : _} -> BindName -> Eff Pretty (Doc opts)
 prettyDBind = hl DVar . prettyBind'
 
 
 
 export %inline
-typeD, ioStateD, arrowD, darrowD, timesD, lamD, eqndD, dlamD, annD, natD,
-stringD, eqD, colonD, commaD, semiD, atD, caseD, typecaseD, returnD, ofD, dotD,
-zeroD, succD, coeD, compD, undD, cstD, pipeD, fstD, sndD, letD, inD :
+typeD, arrowD, darrowD, timesD, lamD, eqndD, dlamD, annD, natD, triD, diamondD,
+eqD, colonD, commaD, semiD, caseD, typecaseD, returnD, ofD, dotD, zeroD, succD,
+coeD, compD, undD, cstD, pipeD :
   {opts : LayoutOpts} -> Eff Pretty (Doc opts)
 typeD     = hl Syntax . text =<< ifUnicode "★" "Type"
-ioStateD  = hl Syntax $ text "IOState"
-arrowD    = hl Syntax . text =<< ifUnicode "→" "->"
-darrowD   = hl Syntax . text =<< ifUnicode "⇒" "=>"
-timesD    = hl Syntax . text =<< ifUnicode "×" "**"
+arrowD    = hl Delim  . text =<< ifUnicode "→" "->"
+darrowD   = hl Delim  . text =<< ifUnicode "⇒" "=>"
+timesD    = hl Delim  . text =<< ifUnicode "×" "**"
 lamD      = hl Syntax . text =<< ifUnicode "λ" "fun"
-eqndD     = hl Syntax . text =<< ifUnicode "≡" "=="
+eqndD     = hl Delim  . text =<< ifUnicode "≡" "=="
 dlamD     = hl Syntax . text =<< ifUnicode "δ" "dfun"
-annD      = hl Syntax . text =<< ifUnicode "∷" "::"
+annD      = hl Delim  . text =<< ifUnicode "∷" "::"
 natD      = hl Syntax . text =<< ifUnicode "ℕ" "Nat"
-stringD   = hl Syntax   $ text "String"
-eqD       = hl Syntax   $ text "Eq"
-colonD    = hl Syntax   $ text ":"
-commaD    = hl Syntax   $ text ","
-semiD     = hl Delim    $ text ";"
-atD       = hl Delim    $ text "@"
-caseD     = hl Syntax   $ text "case"
-typecaseD = hl Syntax   $ text "type-case"
-ofD       = hl Syntax   $ text "of"
-returnD   = hl Syntax   $ text "return"
-dotD      = hl Delim    $ text "."
-zeroD     = hl Constant $ text "zero"
-succD     = hl Constant $ text "succ"
-coeD      = hl Syntax   $ text "coe"
-compD     = hl Syntax   $ text "comp"
-undD      = hl Syntax   $ text "_"
-cstD      = hl Syntax   $ text "="
-pipeD     = hl Delim    $ text "|"
-fstD      = hl Syntax   $ text "fst"
-sndD      = hl Syntax   $ text "snd"
-letD      = hl Syntax   $ text "let"
-inD       = hl Syntax   $ text "in"
+triD      = hl Syntax . text =<< ifUnicode "⊲" "<|"
+diamondD  = hl Syntax . text =<< ifUnicode "⋄" "<>"
+eqD       = hl Syntax $ text "Eq"
+colonD    = hl Delim  $ text ":"
+commaD    = hl Delim  $ text ","
+semiD     = hl Delim  $ text ";"
+caseD     = hl Syntax $ text "case"
+typecaseD = hl Syntax $ text "type-case"
+ofD       = hl Syntax $ text "of"
+returnD   = hl Syntax $ text "return"
+dotD      = hl Delim  $ text "."
+zeroD     = hl Syntax $ text "zero"
+succD     = hl Syntax $ text "succ"
+coeD      = hl Syntax $ text "coe"
+compD     = hl Syntax $ text "comp"
+undD      = hl Syntax $ text "_"
+cstD      = hl Syntax $ text "="
+pipeD     = hl Syntax $ text "|"
 
 
 export
-prettyApp : {opts : LayoutOpts} -> Nat -> Doc opts ->
-            List (Doc opts) -> Doc opts
+prettyApp : {opts : _} -> Nat -> Doc opts -> List (Doc opts) -> Doc opts
 prettyApp ind f args =
-  ifMultiline
-    (hsep (f :: args))
-    (f <++> vsep args <|> vsep (f :: map (indent ind) args))
+      hsep (f :: args)
+  <|> hsep [f, vsep args]
+  <|> vsep (f :: map (indent ind) args)
 
 export
-prettyAppD : {opts : LayoutOpts} -> Doc opts -> List (Doc opts) ->
-             Eff Pretty (Doc opts)
+prettyAppD : {opts : _} -> Doc opts -> List (Doc opts) -> Eff Pretty (Doc opts)
 prettyAppD f args = pure $ prettyApp !(askAt INDENT) f args
 
 
@@ -334,7 +294,7 @@ quoteTag tag =
   "\"" ++ escapeString tag ++ "\""
 
 export
-prettyBounds : {opts : LayoutOpts} -> Bounds -> Eff Pretty (Doc opts)
+prettyBounds : {opts : _} -> Bounds -> Eff Pretty (Doc opts)
 prettyBounds (MkBounds l1 c1 l2 c2) =
   hcat <$> sequence
     [hl TVar $ text $ show l1, colonD,
@@ -343,22 +303,8 @@ prettyBounds (MkBounds l1 c1 l2 c2) =
      hl DVar $ text $ show c2, colonD]
 
 export
-prettyLoc : {opts : LayoutOpts} -> Loc -> Eff Pretty (Doc opts)
+prettyLoc : {opts : _} -> Loc -> Eff Pretty (Doc opts)
 prettyLoc (L NoLoc) =
   hcat <$> sequence [hl TVarErr "no location", colonD]
 prettyLoc (L (YesLoc file b)) =
   hcat <$> sequence [hl Free $ text file, colonD, prettyBounds b]
-
-export
-prettyTag : {opts : _} -> String -> Eff Pretty (Doc opts)
-prettyTag tag = hl Constant $ text $ "'" ++ quoteTag tag
-
-export
-prettyStrLit : {opts : _} -> String -> Eff Pretty (Doc opts)
-prettyStrLit s =
-  let s = concatMap esc1 $ unpack s in
-  hl Constant $ hcat ["\"", text s, "\""]
-where
-  esc1 : Char -> String
-  esc1 '"' = "\""; esc1 '\\' = "\\"
-  esc1 c   = singleton c
diff --git a/lib/Quox/PrettyValExtra.idr b/lib/Quox/PrettyValExtra.idr
deleted file mode 100644
index 8ef7366..0000000
--- a/lib/Quox/PrettyValExtra.idr
+++ /dev/null
@@ -1,20 +0,0 @@
-module Quox.PrettyValExtra
-
-import Data.DPair
-import Derive.Prelude
-import public Text.Show.Value
-import public Text.Show.PrettyVal
-import public Text.Show.PrettyVal.Derive
-
-%language ElabReflection
-
-%runElab derive "SnocList" [PrettyVal]
-
-
-export %inline
-PrettyVal a => PrettyVal (Subset a p) where
-  prettyVal (Element x _) = Con "Element" [prettyVal x, Con "_" []]
-
-export %inline
-(forall x. PrettyVal (p x)) => PrettyVal (Exists p) where
-  prettyVal (Evidence _ p) = Con "Evidence" [Con "_" [], prettyVal p]
diff --git a/lib/Quox/Reduce.idr b/lib/Quox/Reduce.idr
new file mode 100644
index 0000000..4257743
--- /dev/null
+++ b/lib/Quox/Reduce.idr
@@ -0,0 +1,950 @@
+module Quox.Reduce
+
+import Quox.No
+import Quox.Syntax
+import Quox.Definition
+import Quox.Displace
+import Quox.Typing.Context
+import Quox.Typing.Error
+import Data.SnocVect
+import Data.Maybe
+import Data.List
+import Control.Eff
+
+%default total
+
+
+public export
+Whnf : List (Type -> Type)
+Whnf = [NameGen, Except Error]
+
+export
+runWhnfWith : NameSuf -> Eff Whnf a -> (Either Error a, NameSuf)
+runWhnfWith suf act = extract $ runStateAt GEN suf $ runExcept act
+
+export
+runWhnf : Eff Whnf a -> Either Error a
+runWhnf = fst . runWhnfWith 0
+
+
+public export
+0 RedexTest : TermLike -> Type
+RedexTest tm = {d, n : Nat} -> Definitions -> tm d n -> Bool
+
+public export
+interface CanWhnf (0 tm : TermLike) (0 isRedex : RedexTest tm) | tm
+where
+  whnf : {d, n : Nat} -> (defs : Definitions) ->
+         (ctx : WhnfContext d n) ->
+         tm d n -> Eff Whnf (Subset (tm d n) (No . isRedex defs))
+
+public export %inline
+whnf0 : {d, n : Nat} -> {0 isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
+        (defs : Definitions) -> WhnfContext d n -> tm d n -> Eff Whnf (tm d n)
+whnf0 defs ctx t = fst <$> whnf defs ctx t
+
+public export
+0 IsRedex, NotRedex : {isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
+                      Definitions -> Pred (tm d n)
+IsRedex  defs = So . isRedex defs
+NotRedex defs = No . isRedex defs
+
+public export
+0 NonRedex : (tm : TermLike) -> {isRedex : RedexTest tm} ->
+             CanWhnf tm isRedex => (d, n : Nat) -> (defs : Definitions) -> Type
+NonRedex tm d n defs = Subset (tm d n) (NotRedex defs)
+
+public export %inline
+nred : {0 isRedex : RedexTest tm} -> (0 _ : CanWhnf tm isRedex) =>
+       (t : tm d n) -> (0 nr : NotRedex defs t) => NonRedex tm d n defs
+nred t = Element t nr
+
+
+public export %inline
+isLamHead : Elim {} -> Bool
+isLamHead (Ann (Lam {}) (Pi {}) _) = True
+isLamHead (Coe {})                 = True
+isLamHead _                        = False
+
+public export %inline
+isDLamHead : Elim {} -> Bool
+isDLamHead (Ann (DLam {}) (Eq {}) _) = True
+isDLamHead (Coe {})                  = True
+isDLamHead _                         = False
+
+public export %inline
+isPairHead : Elim {} -> Bool
+isPairHead (Ann (Pair {}) (Sig {}) _) = True
+isPairHead (Coe {})                   = True
+isPairHead _                          = False
+
+public export %inline
+isWHead : Elim {} -> Bool
+isWHead (Ann (Sup {}) (W {}) _) = True
+isWHead (Coe {})                = True
+isWHead _                       = False
+
+public export %inline
+isTagHead : Elim {} -> Bool
+isTagHead (Ann (Tag {}) (Enum {}) _) = True
+isTagHead (Coe {})                   = True
+isTagHead _                          = False
+
+public export %inline
+isNatHead : Elim {} -> Bool
+isNatHead (Ann (Zero {}) (Nat {}) _) = True
+isNatHead (Ann (Succ {}) (Nat {}) _) = True
+isNatHead (Coe {})                   = True
+isNatHead _                          = False
+
+public export %inline
+isBoxHead : Elim {} -> Bool
+isBoxHead (Ann (Box {}) (BOX {}) _) = True
+isBoxHead (Coe {})                  = True
+isBoxHead _                         = False
+
+public export %inline
+isE : Term {} -> Bool
+isE (E {}) = True
+isE _      = False
+
+public export %inline
+isAnn : Elim {} -> Bool
+isAnn (Ann {}) = True
+isAnn _        = False
+
+||| true if a term is syntactically a type.
+public export %inline
+isTyCon : Term {} -> Bool
+isTyCon (TYPE  {}) = True
+isTyCon (Pi    {}) = True
+isTyCon (Lam   {}) = False
+isTyCon (Sig   {}) = True
+isTyCon (Pair  {}) = False
+isTyCon (W     {}) = True
+isTyCon (Sup   {}) = False
+isTyCon (Enum  {}) = True
+isTyCon (Tag   {}) = False
+isTyCon (Eq    {}) = True
+isTyCon (DLam  {}) = False
+isTyCon (Nat   {}) = True
+isTyCon (Zero  {}) = False
+isTyCon (Succ  {}) = False
+isTyCon (BOX   {}) = True
+isTyCon (Box   {}) = False
+isTyCon (E     {}) = False
+isTyCon (CloT  {}) = False
+isTyCon (DCloT {}) = False
+
+||| canPushCoe A s is true if a coercion along (𝑖 ⇒ A) on s can be pushed.
+||| for a type with η like functions, or a ground type like ℕ,
+||| this is true for any s.
+||| otherwise, like for pairs, it is only true if s is a constructor form.
+||| if A isn't a type, or isn't in whnf, then the question is meaningless. but
+||| it returns False anyway.
+public export %inline
+canPushCoe : Term (S d) n -> Term d n -> Bool
+canPushCoe (TYPE  {}) _         = True
+canPushCoe (Pi    {}) _         = True
+canPushCoe (Lam   {}) _         = False
+canPushCoe (Sig   {}) (Pair {}) = True
+canPushCoe (Sig   {}) _         = False
+canPushCoe (Pair  {}) _         = False
+canPushCoe (W     {}) (Sup {})  = True
+canPushCoe (W     {}) _         = False
+canPushCoe (Sup   {}) _         = False
+canPushCoe (Enum  {}) _         = True
+canPushCoe (Tag   {}) _         = False
+canPushCoe (Eq    {}) _         = True
+canPushCoe (DLam  {}) _         = False
+canPushCoe (Nat   {}) _         = True
+canPushCoe (Zero  {}) _         = False
+canPushCoe (Succ  {}) _         = False
+canPushCoe (BOX   {}) _         = True
+canPushCoe (Box   {}) _         = False
+canPushCoe (E     {}) _         = False
+canPushCoe (CloT  {}) _         = False
+canPushCoe (DCloT {}) _         = False
+
+
+||| true if a term is syntactically a type, or a neutral.
+public export %inline
+isTyConE : Term {} -> Bool
+isTyConE s = isTyCon s || isE s
+
+||| true if a term is syntactically a type.
+public export %inline
+isAnnTyCon : Elim {} -> Bool
+isAnnTyCon (Ann ty (TYPE {}) _) = isTyCon ty
+isAnnTyCon _                    = False
+
+public export %inline
+isK : Dim d -> Bool
+isK (K {}) = True
+isK _      = False
+
+
+mutual
+  public export
+  isRedexE : RedexTest Elim
+  isRedexE defs (F {x, _}) {d, n} =
+    isJust $ lookupElim x defs {d, n}
+  isRedexE _ (B {}) = False
+  isRedexE defs (App {fun, _}) =
+    isRedexE defs fun || isLamHead fun
+  isRedexE defs (CasePair {pair, _}) =
+    isRedexE defs pair || isPairHead pair
+  isRedexE defs (CaseW {tree, _}) =
+    isRedexE defs tree || isWHead tree
+  isRedexE defs (CaseEnum {tag, _}) =
+    isRedexE defs tag || isTagHead tag
+  isRedexE defs (CaseNat {nat, _}) =
+    isRedexE defs nat || isNatHead nat
+  isRedexE defs (CaseBox {box, _}) =
+    isRedexE defs box || isBoxHead box
+  isRedexE defs (DApp {fun, arg, _}) =
+    isRedexE defs fun || isDLamHead fun || isK arg
+  isRedexE defs (Ann {tm, ty, _}) =
+    isE tm || isRedexT defs tm || isRedexT defs ty
+  isRedexE defs (Coe {ty, val, _}) =
+    let ty = assert_smaller ty ty.term in
+    isRedexT defs ty || canPushCoe ty val
+  isRedexE defs (Comp {ty, r, _}) =
+    isRedexT defs ty || isK r
+  isRedexE defs (TypeCase {ty, ret, _}) =
+    isRedexE defs ty || isRedexT defs ret || isAnnTyCon ty
+  isRedexE _ (CloE  {}) = True
+  isRedexE _ (DCloE {}) = True
+
+  public export
+  isRedexT : RedexTest Term
+  isRedexT _    (CloT  {}) = True
+  isRedexT _    (DCloT {}) = True
+  isRedexT defs (E {e, _}) = isAnn e || isRedexE defs e
+  isRedexT _    _          = False
+
+
+public export
+tycaseRhs : (k : TyConKind) -> TypeCaseArms d n ->
+            Maybe (ScopeTermN (arity k) d n)
+tycaseRhs k arms = lookupPrecise k arms
+
+public export
+tycaseRhsDef : Term d n -> (k : TyConKind) -> TypeCaseArms d n ->
+               ScopeTermN (arity k) d n
+tycaseRhsDef def k arms = fromMaybe (SN def) $ tycaseRhs k arms
+
+public export
+tycaseRhs0 : (k : TyConKind) -> TypeCaseArms d n ->
+             (0 eq : arity k = 0) => Maybe (Term d n)
+tycaseRhs0 k arms {eq} with (tycaseRhs k arms) | (arity k)
+  tycaseRhs0 k arms {eq = Refl} | res | 0 = map (.term) res
+
+public export
+tycaseRhsDef0 : Term d n -> (k : TyConKind) -> TypeCaseArms d n ->
+                (0 eq : arity k = 0) => Term d n
+tycaseRhsDef0 def k arms = fromMaybe def $ tycaseRhs0 k arms
+
+
+export
+weakAtT : (CanTSubst f, Located2 f) => (by, at : Nat) ->
+          f d (at + n) -> f d (at + (by + n))
+weakAtT by at t = t `CanTSubst.(//)` pushN at (shift by) t.loc
+
+export
+weakAtD : (CanDSubst f, Located2 f) => (by, at : Nat) ->
+          f (at + d) n -> f (at + (by + d)) n
+weakAtD by at t = t `CanDSubst.(//)` pushN at (shift by) t.loc
+
+parameters {s : Nat}
+  export
+  weakS : (by : Nat) -> ScopeTermN s d n -> ScopeTermN s d (by + n)
+  weakS by (S names (Y body)) = S names $ Y $ weakAtT by s body
+  weakS by (S names (N body)) = S names $ N $ weakT by body
+
+  export
+  weakDS : (by : Nat) -> DScopeTermN s d n -> DScopeTermN s d (by + n)
+  weakDS by (S names (Y body)) = S names $ Y $ weakT by body
+  weakDS by (S names (N body)) = S names $ N $ weakT by body
+
+  export
+  dweakS : (by : Nat) -> ScopeTermN s d n -> ScopeTermN s (by + d) n
+  dweakS by (S names (Y body)) = S names $ Y $ dweakT by body
+  dweakS by (S names (N body)) = S names $ N $ dweakT by body
+
+  export
+  dweakDS : (by : Nat) -> DScopeTermN s d n -> DScopeTermN s (by + d) n
+  dweakDS by (S names (Y body)) = S names $ Y $ weakAtD by s body
+  dweakDS by (S names (N body)) = S names $ N $ dweakT by body
+
+private
+coeScoped : {s : Nat} -> DScopeTerm d n -> Dim d -> Dim d -> Loc ->
+            ScopeTermN s d n -> ScopeTermN s d n
+coeScoped ty p q loc (S names (Y body)) =
+  ST names $ E $ Coe (weakDS s ty) p q body loc
+coeScoped ty p q loc (S names (N body)) =
+  S names $ N $ E $ Coe ty p q body loc
+
+
+export covering
+CanWhnf Term Reduce.isRedexT
+
+export covering
+CanWhnf Elim Reduce.isRedexE
+
+parameters {d, n : Nat} (defs : Definitions) (ctx : WhnfContext d n)
+  ||| performs the minimum work required to recompute the type of an elim.
+  |||
+  ||| ⚠ **assumes the elim is already typechecked.** ⚠
+  export covering
+  computeElimType : (e : Elim d n) -> (0 ne : No (isRedexE defs e)) =>
+                    Eff Whnf (Term d n)
+  computeElimType (F {x, u, loc}) = do
+    let Just def = lookup x defs | Nothing => throw $ NotInScope loc x
+    pure $ displace u def.type
+  computeElimType (B {i, _}) = pure $ ctx.tctx !! i
+  computeElimType (App {fun = f, arg = s, loc}) {ne} = do
+    Pi {arg, res, _} <- whnf0 defs ctx =<< computeElimType f {ne = noOr1 ne}
+      | t => throw $ ExpectedPi loc ctx.names t
+    pure $ sub1 res $ Ann s arg loc
+  computeElimType (CasePair {pair, ret, _}) = pure $ sub1 ret pair
+  computeElimType (CaseW {tree, ret, _}) = pure $ sub1 ret tree
+  computeElimType (CaseEnum {tag, ret, _}) = pure $ sub1 ret tag
+  computeElimType (CaseNat {nat, ret, _}) = pure $ sub1 ret nat
+  computeElimType (CaseBox {box, ret, _}) = pure $ sub1 ret box
+  computeElimType (DApp {fun = f, arg = p, loc}) {ne} = do
+    Eq {ty, _} <- whnf0 defs ctx =<< computeElimType f {ne = noOr1 ne}
+      | t => throw $ ExpectedEq loc ctx.names t
+    pure $ dsub1 ty p
+  computeElimType (Ann {ty, _}) = pure ty
+  computeElimType (Coe {ty, q, _}) = pure $ dsub1 ty q
+  computeElimType (Comp {ty, _}) = pure ty
+  computeElimType (TypeCase {ret, _}) = pure ret
+
+parameters {d, n : Nat} (defs : Definitions) (ctx : WhnfContext (S d) n)
+  ||| for π.(x : A) → B, returns (A, B);
+  ||| for an elim returns a pair of type-cases that will reduce to that;
+  ||| for other intro forms error
+  private covering
+  tycasePi : (t : Term (S d) n) -> (0 tnf : No (isRedexT defs t)) =>
+             Eff Whnf (Term (S d) n, ScopeTerm (S d) n)
+  tycasePi (Pi {arg, res, _}) = pure (arg, res)
+  tycasePi (E e) {tnf} = do
+    ty <- computeElimType defs ctx e @{noOr2 tnf}
+    let loc  = e.loc
+        narg = mnb "Arg" loc; nret = mnb "Ret" loc
+        arg  = E $ typeCase1Y e ty KPi [< !narg, !nret] (BVT 1 loc) loc
+        res' = typeCase1Y e (Arr Zero arg ty loc) KPi [< !narg, !nret]
+                 (BVT 0 loc) loc
+        res  = ST [< !narg] $ E $ App (weakE 1 res') (BVT 0 loc) loc
+    pure (arg, res)
+  tycasePi t = throw $ ExpectedPi t.loc ctx.names t
+
+  ||| for (x : A) × B, returns (A, B);
+  ||| for an elim returns a pair of type-cases that will reduce to that;
+  ||| for other intro forms error
+  private covering
+  tycaseSig : (t : Term (S d) n) -> (0 tnf : No (isRedexT defs t)) =>
+              Eff Whnf (Term (S d) n, ScopeTerm (S d) n)
+  tycaseSig (Sig {fst, snd, _}) = pure (fst, snd)
+  tycaseSig (E e) {tnf} = do
+    ty <- computeElimType defs ctx e @{noOr2 tnf}
+    let loc  = e.loc
+        nfst = mnb "Fst" loc; nsnd = mnb "Snd" loc
+        fst  = E $ typeCase1Y e ty KSig [< !nfst, !nsnd] (BVT 1 loc) loc
+        snd' = typeCase1Y e (Arr Zero fst ty loc) KSig [< !nfst, !nsnd]
+                 (BVT 0 loc) loc
+        snd  = ST [< !nfst] $ E $ App (weakE 1 snd') (BVT 0 loc) loc
+    pure (fst, snd)
+  tycaseSig t = throw $ ExpectedSig t.loc ctx.names t
+
+  ||| for (x : A) ⊲ B, returns (A, B);
+  ||| for an elim returns a pair of type-cases that will reduce to that;
+  ||| for other intro forms error
+  private covering
+  tycaseW : (t : Term (S d) n) -> (0 tnf : No (isRedexT defs t)) =>
+            Eff Whnf (Term (S d) n, ScopeTerm (S d) n)
+  tycaseW (W {shape, body, _}) = pure (shape, body)
+  tycaseW (E e) {tnf} = do
+    ty <- computeElimType defs ctx e @{noOr2 tnf}
+    let loc    = e.loc
+        nshape = mnb "Shape" loc; nbody = mnb "Body" loc
+        shape  = E $ typeCase1Y e ty KW [< !nshape, !nbody] (BVT 1 loc) loc
+        body'  = typeCase1Y e (Arr Zero shape ty loc) KW [< !nshape, !nbody]
+                   (BVT 0 loc) loc
+        body   = ST [< !nshape] $ E $ App (weakE 1 body') (BVT 0 loc) loc
+    pure (shape, body)
+  tycaseW t = throw $ ExpectedW t.loc ctx.names t
+
+  ||| for [π. A], returns A;
+  ||| for an elim returns a type-case that will reduce to that;
+  ||| for other intro forms error
+  private covering
+  tycaseBOX : (t : Term (S d) n) -> (0 tnf : No (isRedexT defs t)) =>
+              Eff Whnf (Term (S d) n)
+  tycaseBOX (BOX {ty, _}) = pure ty
+  tycaseBOX (E e) {tnf} = do
+    let loc = e.loc
+    ty <- computeElimType defs ctx e @{noOr2 tnf}
+    pure $ E $ typeCase1Y e ty KBOX [< !(mnb "Ty" loc)] (BVT 0 loc) loc
+  tycaseBOX t = throw $ ExpectedBOX t.loc ctx.names t
+
+  ||| for Eq [i ⇒ A] l r, returns (A‹0/i›, A‹1/i›, A, l, r);
+  ||| for an elim returns five type-cases that will reduce to that;
+  ||| for other intro forms error
+  private covering
+  tycaseEq : (t : Term (S d) n) -> (0 tnf : No (isRedexT defs t)) =>
+             Eff Whnf (Term (S d) n, Term (S d) n, DScopeTerm (S d) n,
+                       Term (S d) n, Term (S d) n)
+  tycaseEq (Eq {ty, l, r, _}) = pure (ty.zero, ty.one, ty, l, r)
+  tycaseEq (E e) {tnf} = do
+    ty <- computeElimType defs ctx e @{noOr2 tnf}
+    let loc   = e.loc
+        names = traverse' (\x => mnb x loc) [< "A0", "A1", "A", "l", "r"]
+        a0    = E $ typeCase1Y e ty KEq !names (BVT 4 loc) loc
+        a1    = E $ typeCase1Y e ty KEq !names (BVT 3 loc) loc
+        a'    = typeCase1Y e (Eq0 ty a0 a1 loc) KEq !names (BVT 2 loc) loc
+        a     = DST [< !(mnb "i" loc)] $ E $ DApp (dweakE 1 a') (B VZ loc) loc
+        l     = E $ typeCase1Y e a0 KEq !names (BVT 1 loc) loc
+        r     = E $ typeCase1Y e a1 KEq !names (BVT 0 loc) loc
+    pure (a0, a1, a, l, r)
+  tycaseEq t = throw $ ExpectedEq t.loc ctx.names t
+
+-- new block because the functions below might pass a different ctx
+-- into the ones above
+parameters {d, n : Nat} (defs : Definitions) (ctx : WhnfContext d n)
+  ||| reduce a function application `App (Coe ty p q val) s loc`
+  private covering
+  piCoe : (ty : DScopeTerm d n) -> (p, q : Dim d) ->
+          (val, s : Term d n) -> Loc ->
+          Eff Whnf (Subset (Elim d n) (No . isRedexE defs))
+  piCoe sty@(S [< i] ty) p q val s loc = do
+    --  𝒮‹𝑘› ≔ π.(x : A‹𝑘/𝑖›) → B‹𝑘/𝑖›
+    --  𝓈‹𝑘› ≔ coe [𝑖 ⇒ A] @q @𝑘 s
+    -- -------------------------------------------------------
+    --  (coe [𝑖 ⇒ 𝒮‹𝑖›] @p @q t) s
+    --    ⇝
+    --  coe [i ⇒ B[𝓈‹i›/x] @p @q ((t ∷ 𝒮‹p›) 𝓈‹p›)
+    --
+    -- type-case is used to expose A,B if the type is neutral
+    let ctx1 = extendDim i ctx
+    Element ty tynf <- whnf defs ctx1 ty.term
+    (arg, res) <- tycasePi defs ctx1 ty
+    let s0   = CoeT i arg q p s s.loc
+        body = E $ App (Ann val (ty // one p) val.loc) (E s0) loc
+        s1   = CoeT i (arg // (BV 0 i.loc ::: shift 2)) (weakD 1 q) (BV 0 i.loc)
+                    (s // shift 1) s.loc
+    whnf defs ctx $ CoeT i (sub1 res s1) p q body loc
+
+  ||| reduce a pair elimination `CasePair pi (Coe ty p q val) ret body loc`
+  private covering
+  sigCoe : (qty : Qty) ->
+           (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
+           (ret : ScopeTerm d n) -> (body : ScopeTermN 2 d n) -> Loc ->
+           Eff Whnf (Subset (Elim d n) (No . isRedexE defs))
+  sigCoe qty sty@(S [< i] ty) p q val ret body loc = do
+    -- caseπ (coe [i ⇒ (x : A) × B] @p @q s) return z ⇒ C of { (a, b) ⇒ u }
+    -- ⇝
+    -- caseπ s ∷ ((x : A) × B)‹p/i› return z ⇒ C
+    -- of { (a, b) ⇒
+    --   u[(coe [i ⇒ A] @p @q a)/a,
+    --     (coe [i ⇒ B[(coe [j ⇒ A‹j/i›] @p @i a)/x]] @p @q b)/b] }
+    --
+    -- type-case is used to expose A,B if the type is neutral
+    let ctx1 = extendDim i ctx
+    Element ty tynf <- whnf defs ctx1 ty.term
+    (tfst, tsnd) <- tycaseSig defs ctx1 ty
+    let [< x, y] = body.names
+        a' = CoeT i (weakT 2 tfst) p q (BVT 1 x.loc) x.loc
+        tsnd' = tsnd.term //
+          (CoeT !(fresh i) (weakT 2 $ tfst // (B VZ i.loc ::: shift 2))
+            (weakD 1 p) (B VZ i.loc) (BVT 1 x.loc) y.loc ::: shift 2)
+        b' = CoeT i tsnd' p q (BVT 0 y.loc) y.loc
+    whnf defs ctx $ CasePair qty (Ann val (dsub1 sty p) val.loc) ret
+      (ST body.names $ body.term // (a' ::: b' ::: shift 2)) loc
+
+  ||| reduce a w elimination `CaseW pi piIH (Coe ty p q val) ret body loc`
+  private covering
+  wCoe : (qty, qtyIH : Qty) ->
+         (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
+         (ret : ScopeTerm d n) -> (body : ScopeTermN 3 d n) -> Loc ->
+         Eff Whnf (Subset (Elim d n) (No . isRedexE defs))
+  wCoe qty qtyIH sty@(S [< i] ty) p q val ret body loc = do
+    --  𝒮‹𝑘› ≔ ((x : A) ⊲ B)‹𝑘/𝑖›
+    --  𝒶‹𝑘› ≔ coe [𝑖 ⇒ A] @p @𝑘 a
+    --       : A‹𝑘/𝑖›
+    --  𝒷‹𝑘› ≔ coe [𝑖 ⇒ ω.B[𝒶‹𝑖›/x] → 𝒮‹𝑖›] @p @𝑘 b
+    --       : ω.B‹𝑘/𝑖›[𝒶‹𝑘›/x] → 𝒮‹𝑘›
+    --  𝒾𝒽   ≔ coe [𝑖 ⇒ π.(z : B[𝒶‹𝑖›/x]) → C[𝒷‹𝑖› z/p]] @p @q ih
+    --       : π.(z : B‹q/𝑖›[𝒶‹q›/x]) → C[𝒷‹q› z/p]
+    -- --------------------------------------------------------------------
+    --  caseπ (coe [𝑖 ⇒ 𝒮‹𝑖›] @p @q s) return z ⇒ C of { a ⋄ b, ς.ih ⇒ u }
+    --    ⇝
+    --  caseπ s ∷ 𝒮‹p› return z ⇒ C
+    --  of { a ⋄ b, ς.ih ⇒ u[𝒶‹q›/a, 𝒷‹q›/b, 𝒾𝒽/ih] }
+    let ctx1 = extendDim i ctx
+    Element ty tynf <- whnf defs ctx1 ty.term
+    (shape, tbody) <- tycaseW defs ctx1 ty
+    let [< a, b, ih] = body.names
+    ai <- fresh i; bi <- fresh i; ihi <- fresh i; z <- mnb "z" ih.loc
+    let a', b' : forall d'. (by : Shift d d') => Dim d' -> Elim d' (3 + n)
+        a' k =
+          let shape' = shape // Shift (weak 1 by) // shift 3 in
+          CoeT ai shape' (p // by) k (BVT 2 a.loc) a.loc
+        b' k =
+          let tbody' = tbody.term // Shift (weak 1 by)
+                                  // (a' (BV 0 bi.loc) ::: shift 3)
+              ty' = ty // Shift (weak 1 by) // shift 3
+          in
+          CoeT bi (Arr Any tbody' ty' b.loc) (p // by) k (BVT 1 b.loc) b.loc
+        ih' : Elim d (3 + n) :=
+          let tbody' = tbody.term // (a' (BV 0 ihi.loc) ::: shift 3)
+              ret' = sub1 (weakS 4 $ dweakS 1 ret) $
+                     App (weakE 1 $ b' (BV 0 ihi.loc)) (BVT 0 z.loc) ih.loc
+              ty = PiY qty z tbody' ret' ih.loc
+          in
+          CoeT ihi ty p q (BVT 0 ih.loc) ih.loc
+    whnf defs ctx $ CaseW qty qtyIH (Ann val (dsub1 sty p) val.loc) ret
+      (ST body.names $ body.term // (a' q ::: b' q ::: ih' ::: shift 3)) loc
+
+  ||| reduce a dimension application `DApp (Coe ty p q val) r loc`
+  private covering
+  eqCoe : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
+          (r : Dim d) -> Loc ->
+          Eff Whnf (Subset (Elim d n) (No . isRedexE defs))
+  eqCoe sty@(S [< j] ty) p q val r loc = do
+    -- (coe [j ⇒ Eq [i ⇒ A] L R] @p @q eq) @r
+    -- ⇝
+    -- comp [j ⇒ A‹r/i›] @p @q (eq ∷ (Eq [i ⇒ A] L R)‹p/j›)
+    --   @r { 0 j ⇒ L; 1 j ⇒ R }
+    let ctx1 = extendDim j ctx
+    Element ty tynf <- whnf defs ctx1 ty.term
+    (a0, a1, a, s, t) <- tycaseEq defs ctx1 ty
+    let a'   = dsub1 a (weakD 1 r)
+        val' = E $ DApp (Ann val (dsub1 sty p) val.loc) r loc
+    whnf defs ctx $ CompH j a' p q val' r j s j t loc
+
+  ||| reduce a pair elimination `CaseBox pi (Coe ty p q val) ret body`
+  private covering
+  boxCoe : (qty : Qty) ->
+           (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
+           (ret : ScopeTerm d n) -> (body : ScopeTerm d n) -> Loc ->
+           Eff Whnf (Subset (Elim d n) (No . isRedexE defs))
+  boxCoe qty sty@(S [< i] ty) p q val ret body loc = do
+    -- caseπ (coe [i ⇒ [ρ. A]] @p @q s) return z ⇒ C of { [a] ⇒ e }
+    -- ⇝
+    -- caseπ s ∷ [ρ. A]‹p/i› return z ⇒ C
+    -- of { [a] ⇒ e[(coe [i ⇒ A] p q a)/a] }
+    let ctx1 = extendDim i ctx
+    Element ty tynf <- whnf defs ctx1 ty.term
+    ta <- tycaseBOX defs ctx1 ty
+    let a' = CoeT i (weakT 1 ta) p q (BVT 0 body.name.loc) body.name.loc
+    whnf defs ctx $ CaseBox qty (Ann val (dsub1 sty p) val.loc) ret
+      (ST body.names $ body.term // (a' ::: shift 1)) loc
+
+
+||| reduce a type-case applied to a type constructor
+private covering
+reduceTypeCase : {d, n : Nat} -> (defs : Definitions) -> WhnfContext d n ->
+                 (ty : Term d n) -> (u : Universe) -> (ret : Term d n) ->
+                 (arms : TypeCaseArms d n) -> (def : Term d n) ->
+                 (0 _ : So (isTyCon ty)) => Loc ->
+                 Eff Whnf (Subset (Elim d n) (No . isRedexE defs))
+reduceTypeCase defs ctx ty u ret arms def loc = case ty of
+  -- (type-case ★ᵢ ∷ _ return Q of { ★ ⇒ s; ⋯ }) ⇝ s ∷ Q
+  TYPE {} =>
+    whnf defs ctx $ Ann (tycaseRhsDef0 def KTYPE arms) ret loc
+
+  -- (type-case π.(x : A) → B ∷ ★ᵢ return Q of { (a → b) ⇒ s; ⋯ }) ⇝
+  -- s[(A ∷ ★ᵢ)/a, ((λ x ⇒ B) ∷ 0.A → ★ᵢ)/b] ∷ Q
+  Pi {arg, res, loc = piLoc, _} =>
+    let arg' = Ann arg (TYPE u arg.loc) arg.loc
+        res' = Ann (Lam res res.loc)
+                   (Arr Zero arg (TYPE u arg.loc) arg.loc) res.loc
+    in
+    whnf defs ctx $
+      Ann (subN (tycaseRhsDef def KPi arms) [< arg', res']) ret loc
+
+  -- (type-case (x : A) ⊲ π.B ∷ ★ᵢ return Q of { (a ⊲ b) ⇒ s; ⋯ }) ⇝
+  -- s[(A ∷ ★ᵢ)/a, ((λ x ⇒ B) ∷ 0.A → ★ᵢ)/b] ∷ Q
+  W {shape, body, loc = wLoc, _} =>
+    let shape' = Ann shape (TYPE u shape.loc) shape.loc
+        body'  = Ann (Lam body body.loc)
+                     (Arr Zero shape (TYPE u shape.loc) shape.loc) body.loc
+    in
+    whnf defs ctx $
+      Ann (subN (tycaseRhsDef def KW arms) [< shape', body']) ret loc
+
+  -- (type-case (x : A) × B ∷ ★ᵢ return Q of { (a × b) ⇒ s; ⋯ }) ⇝
+  -- s[(A ∷ ★ᵢ)/a, ((λ x ⇒ B) ∷ 0.A → ★ᵢ)/b] ∷ Q
+  Sig {fst, snd, loc = sigLoc, _} =>
+    let fst' = Ann fst (TYPE u fst.loc) fst.loc
+        snd' = Ann (Lam snd snd.loc)
+                   (Arr Zero fst (TYPE u fst.loc) fst.loc) snd.loc
+    in
+    whnf defs ctx $
+      Ann (subN (tycaseRhsDef def KSig arms) [< fst', snd']) ret loc
+
+  -- (type-case {⋯} ∷ _ return Q of { {} ⇒ s; ⋯ }) ⇝ s ∷ Q
+  Enum {} =>
+    whnf defs ctx $ Ann (tycaseRhsDef0 def KEnum arms) ret loc
+
+  -- (type-case Eq [i ⇒ A] L R ∷ ★ᵢ return Q
+  --  of { Eq a₀ a₁ a l r ⇒ s; ⋯ }) ⇝
+  -- s[(A‹0/i› ∷ ★ᵢ)/a₀, (A‹1/i› ∷ ★ᵢ)/a₁,
+  --   ((δ i ⇒ A) ∷ Eq [★ᵢ] A‹0/i› A‹1/i›)/a,
+  --   (L ∷ A‹0/i›)/l, (R ∷ A‹1/i›)/r] ∷ Q
+  Eq {ty = a, l, r, loc = eqLoc, _} =>
+    let a0 = a.zero; a1 = a.one in
+    whnf defs ctx $ Ann
+      (subN (tycaseRhsDef def KEq arms)
+         [< Ann a0 (TYPE u a.loc) a.loc, Ann a1 (TYPE u a.loc) a.loc,
+            Ann (DLam a a.loc) (Eq0 (TYPE u a.loc) a0 a1 a.loc) a.loc,
+            Ann l a0 l.loc, Ann r a1 r.loc])
+      ret loc
+
+  -- (type-case ℕ ∷ _ return Q of { ℕ ⇒ s; ⋯ }) ⇝ s ∷ Q
+  Nat {} =>
+    whnf defs ctx $ Ann (tycaseRhsDef0 def KNat arms) ret loc
+
+  -- (type-case [π.A] ∷ ★ᵢ return Q of { [a] ⇒ s; ⋯ }) ⇝ s[(A ∷ ★ᵢ)/a] ∷ Q
+  BOX {ty = a, loc = boxLoc, _} =>
+    whnf defs ctx $ Ann
+      (sub1 (tycaseRhsDef def KBOX arms) (Ann a (TYPE u a.loc) a.loc))
+      ret loc
+
+
+||| pushes a coercion inside a whnf-ed term
+private covering
+pushCoe : {d, n : Nat} -> (defs : Definitions) -> WhnfContext d n ->
+          BindName -> (ty : Term (S d) n) ->
+          Dim d -> Dim d ->
+          (s : Term d n) -> (0 snf : No (isRedexT defs s)) =>
+          (0 pc : So (canPushCoe ty s)) => Loc ->
+          Eff Whnf (NonRedex Elim d n defs)
+pushCoe defs ctx i ty p q s loc =
+  if p == q then whnf defs ctx $ Ann s (ty // one q) loc else
+  case ty of
+    -- (coe ★ᵢ @p @q s) ⇝ (s ∷ ★ᵢ)
+    --
+    -- no η (what would that even mean), but ground type
+    TYPE {l, loc = tyLoc} =>
+      whnf defs ctx $ Ann s (TYPE l tyLoc) loc
+
+    -- just η expand it. then whnf for App will handle it later
+    -- this is how @xtt does it
+    --
+    -- (coe (𝑖 ⇒ π.(x : A) → B) @p @q s) ⇝
+    -- (λ y ⇒ (coe (𝑖 ⇒ π.(x : A) → B) @p @q s) y)
+    --   ∷ (π.(x : A) → B)‹q/𝑖›
+    Pi {} => do
+      y <- mnb "y" loc
+      let s'   = Coe (SY [< i] ty) p q s loc
+          body = SY [< y] $ E $ App (weakE 1 s') (BVT 0 y.loc) s.loc
+          ret  = ty // one q
+      whnf defs ctx $ Ann (Lam body loc) ret loc
+
+    -- (coe [i ⇒ (x : A) × B] @p @q (s, t)) ⇝
+    -- (coe [i ⇒ A] @p @q s,
+    --  coe [i ⇒ B[(coe [j ⇒ A‹j/i›] @p @i s)/x]] @p @q t)
+    --   ∷ (x : A‹q/i›) × B‹q/i›
+    --
+    -- no η so only reduce on an actual pair 🍐
+    Sig {fst = tfst, snd = tsnd, loc = tyLoc} => do
+      let Pair fst snd sLoc = s
+          fst'  = E $ CoeT i tfst p q fst fst.loc
+          tfst' = tfst // (B VZ i.loc ::: shift 2)
+          tsnd' = sub1 tsnd $
+                  CoeT !(fresh i) tfst' (weakD 1 p) (B VZ snd.loc)
+                    (dweakT 1 fst) snd.loc
+          snd'  = E $ CoeT i tsnd' p q snd snd.loc
+      pure $ nred $
+        Ann (Pair fst' snd' sLoc)
+            (Sig (tfst // one q) (tsnd // one q) tyLoc) loc
+
+    -- (coe [i ⇒ (x : A) ⊲ π.B] @p @q (s ⋄ t) ⇝
+    -- (coe [i ⇒ A] @p @q s ⋄
+    --  coe [i ⇒ ω.B[coe [j ⇒ A‹j/i›] @p @i s/x] → (x : A) ⊲ B] t)
+    --   ∷ ((x : A) ⊲ B)‹q/i›
+    --
+    -- again, no η
+    W {shape, body, loc = tyLoc} => do
+      let Sup root sub sLoc = s
+          root' = E $ CoeT i shape p q root root.loc
+          shape' = shape // (B VZ i.loc ::: shift 2)
+          coeRoot =
+            CoeT (setLoc shape.loc !(fresh i)) shape'
+                 (weakD 1 p) (B VZ i.loc) (dweakT 1 root) root.loc
+          tsub' = Arr Any (sub1 body coeRoot) ty sub.loc
+          sub' = E $ CoeT i tsub' p q sub sub.loc
+      pure $ nred $
+        Ann (Sup root' sub' sLoc)
+            (W (shape // one q) (body // one q) tyLoc) loc
+
+    -- (coe {𝗮, …} @p @q s) ⇝ (s ∷ {𝗮, …})
+    --
+    -- no η, but ground type
+    Enum {cases, loc = tyLoc} =>
+      whnf defs ctx $ Ann s (Enum cases tyLoc) loc
+
+    -- η expand, like for Lam
+    --
+    -- (coe (𝑖 ⇒ Eq (𝑗 ⇒ A) l r) @p @q s) ⇝
+    -- (δ k ⇒ (coe (𝑖 ⇒ Eq (𝑗 ⇒ A) l r) @p @q s) @k)
+    --   ∷ (Eq (𝑗 ⇒ A) l r)‹q/𝑖›
+    Eq {} => do
+      k <- mnb "k" loc
+      let s'   = Coe (SY [< i] ty) p q s loc
+          term = DLam (SY [< k] $ E $ DApp (dweakE 1 s') (BV 0 k.loc) loc) loc
+          ret  = ty // one q
+      whnf defs ctx $ Ann term ret loc
+
+    -- (coe ℕ @p @q s) ⇝ (s ∷ ℕ)
+    --
+    -- no η, but ground type
+    Nat {loc = tyLoc} =>
+      whnf defs ctx $ Ann s (Nat tyLoc) loc
+
+    -- (coe (𝑖 ⇒ [π. A]) @p @q s) ⇝
+    -- [coe (𝑖 ⇒ A) @p @q (case1 s ∷ [π. A‹p/𝑖›] return A‹p/𝑖› of {[x] ⇒ x})]
+    --   ∷ [π. A‹q/𝑖›]
+    --
+    -- [todo] box should probably have an η rule
+    BOX {qty, ty = innerTy, loc = tyLoc} => do
+      let s'     = Ann s (BOX qty (innerTy // one p) tyLoc) s.loc
+          inner' = CaseBox One s' (SN $ innerTy // one p)
+                     (SY [< !(mnb "x" s.loc)] $ BVT 0 s.loc) s.loc
+          inner  = Box (E $ CoeT i innerTy p q (E inner') loc) loc
+          ret    = BOX qty (innerTy // one q) tyLoc
+      whnf defs ctx $ Ann inner ret loc
+
+
+export covering
+CanWhnf Elim Reduce.isRedexE where
+  whnf defs ctx (F x u loc) with (lookupElim x defs) proof eq
+    _ | Just y  = whnf defs ctx $ setLoc loc $ displace u y
+    _ | Nothing = pure $ Element (F x u loc) $ rewrite eq in Ah
+
+  whnf _ _ (B i loc) = pure $ nred $ B i loc
+
+  -- ((λ x ⇒ t) ∷ (π.x : A) → B) s ⇝ t[s∷A/x] ∷ B[s∷A/x]
+  whnf defs ctx (App f s appLoc) = do
+    Element f fnf <- whnf defs ctx f
+    case nchoose $ isLamHead f of
+      Left _ => case f of
+        Ann (Lam {body, _}) (Pi {arg, res, _}) floc =>
+          let s = Ann s arg s.loc in
+          whnf defs ctx $ Ann (sub1 body s) (sub1 res s) appLoc
+        Coe ty p q val _ => piCoe defs ctx ty p q val s appLoc
+      Right nlh => pure $ Element (App f s appLoc) $ fnf `orNo` nlh
+
+  --  s'  ≔ s ∷ A
+  --  t'  ≔ t ∷ B[s'/x]
+  --  st' ≔ (s, t) ∷ (x : A) × B
+  --  C'  ≔ C[st'/p]
+  -- ---------------------------------------------------------------
+  --  case st' return p ⇒ C of { (a, b) ⇒ u } ⇝ u[s'/a, t'/x]] ∷ C'
+  whnf defs ctx (CasePair pi pair ret body caseLoc) = do
+    Element pair pairnf <- whnf defs ctx pair
+    case nchoose $ isPairHead pair of
+      Left _ => case pair of
+        Ann (Pair {fst, snd, _}) (Sig {fst = tfst, snd = tsnd, _}) pairLoc =>
+          let fst = Ann fst tfst fst.loc
+              snd = Ann snd (sub1 tsnd fst) snd.loc
+          in
+          whnf defs ctx $ Ann (subN body [< fst, snd]) (sub1 ret pair) caseLoc
+        Coe ty p q val _ => do
+          sigCoe defs ctx pi ty p q val ret body caseLoc
+      Right np =>
+        pure $ Element (CasePair pi pair ret body caseLoc) $ pairnf `orNo` np
+
+  --  s'  ≔ s ∷ A
+  --  t'  ≔ t ∷ ω.B[s'/x] → (x : A) ⊲ B
+  --  ih' ≔ (λ x ⇒ caseπ t x return p ⇒ C of { (a ⋄ b), ς.ih ⇒ u }) ∷
+  --          π.(y : B[s'/x]) → C[t' y/p]
+  --  st' ≔ s ⋄ t ∷ (x : A) ⊲ B
+  --  C'  ≔ C[st'/p]
+  -- --------------------------------------------------------------------
+  --  caseπ st' return p ⇒ C of { a ⋄ b, ς.ih ⇒ u }
+  --   ⇝
+  --  u[s'/a, t'/b, ih'/ih] ∷ C'
+  whnf defs ctx (CaseW qty qtyIH tree ret body caseLoc) = do
+    Element tree treenf <- whnf defs ctx tree
+    case nchoose $ isWHead tree of
+      Left _ => case tree of
+        Ann (Sup {root, sub, _})
+            w@(W {shape, body = wbody, _}) treeLoc =>
+          let root = Ann root shape root.loc
+              wbody' = sub1 wbody root
+              tsub = Arr Any wbody' w sub.loc
+              sub = Ann sub tsub sub.loc
+              ih' = LamY !(mnb "y" caseLoc) -- [todo] better name
+                    (E $ CaseW qty qtyIH
+                           (App (weakE 1 sub) (BVT 0 sub.loc) sub.loc)
+                           (weakS 1 ret) (weakS 1 body) caseLoc) sub.loc
+              ihret = sub1 (weakS 1 ret)
+                           (App (weakE 1 sub) (BVT 0 sub.loc) caseLoc)
+              tih = PiY qty !(mnb "y" caseLoc)
+                      wbody' ihret caseLoc
+              ih = Ann ih' tih caseLoc
+          in
+          whnf defs ctx $
+          Ann (subN body [< root, sub, ih]) (sub1 ret tree) tree.loc
+        Coe ty p q val _ => do
+          wCoe defs ctx qty qtyIH ty p q val ret body caseLoc
+      Right nw => pure $
+        Element (CaseW qty qtyIH tree ret body caseLoc) $ treenf `orNo` nw
+
+  -- case 'a ∷ {a,…} return p ⇒ C of { 'a ⇒ u } ⇝
+  -- u ∷ C['a∷{a,…}/p]
+  whnf defs ctx (CaseEnum pi tag ret arms caseLoc) = do
+    Element tag tagnf <- whnf defs ctx tag
+    case nchoose $ isTagHead tag of
+      Left _ => case tag of
+        Ann (Tag t _) (Enum ts _) _ =>
+          let ty = sub1 ret tag in
+          case lookup t arms of
+            Just arm => whnf defs ctx $ Ann arm ty arm.loc
+            Nothing  => throw $ MissingEnumArm caseLoc t (keys arms)
+        Coe ty p q val _ =>
+          -- there is nowhere an equality can be hiding inside an enum type
+          whnf defs ctx $
+            CaseEnum pi (Ann val (dsub1 ty q) val.loc) ret arms caseLoc
+      Right nt =>
+        pure $ Element (CaseEnum pi tag ret arms caseLoc) $ tagnf `orNo` nt
+
+  -- case zero ∷ ℕ return p ⇒ C of { zero ⇒ u; … } ⇝
+  --   u ∷ C[zero∷ℕ/p]
+  --
+  -- case succ n ∷ ℕ return p ⇒ C of { succ n', π.ih ⇒ u; … } ⇝
+  --   u[n∷ℕ/n', (case n ∷ ℕ ⋯)/ih] ∷ C[succ n ∷ ℕ/p]
+  whnf defs ctx (CaseNat pi piIH nat ret zer suc caseLoc) = do
+    Element nat natnf <- whnf defs ctx nat
+    case nchoose $ isNatHead nat of
+      Left _ =>
+        let ty = sub1 ret nat in
+        case nat of
+          Ann (Zero _) (Nat _) _ =>
+            whnf defs ctx $ Ann zer ty zer.loc
+          Ann (Succ n succLoc) (Nat natLoc) _ =>
+            let nn = Ann n (Nat natLoc) succLoc
+                tm = subN suc [< nn, CaseNat pi piIH nn ret zer suc caseLoc]
+            in
+            whnf defs ctx $ Ann tm ty caseLoc
+          Coe ty p q val _ =>
+            -- same deal as Enum
+            whnf defs ctx $
+              CaseNat pi piIH (Ann val (dsub1 ty q) val.loc) ret zer suc caseLoc
+      Right nn => pure $
+        Element (CaseNat pi piIH nat ret zer suc caseLoc) $ natnf `orNo` nn
+
+  -- case [t] ∷ [π.A] return p ⇒ C of { [x] ⇒ u } ⇝
+  --   u[t∷A/x] ∷ C[[t] ∷ [π.A]/p]
+  whnf defs ctx (CaseBox pi box ret body caseLoc) = do
+    Element box boxnf <- whnf defs ctx box
+    case nchoose $ isBoxHead box of
+      Left _ => case box of
+        Ann (Box val boxLoc) (BOX q bty tyLoc) _ =>
+          let ty = sub1 ret box in
+          whnf defs ctx $ Ann (sub1 body (Ann val bty val.loc)) ty caseLoc
+        Coe ty p q val _ =>
+          boxCoe defs ctx pi ty p q val ret body caseLoc
+      Right nb =>
+        pure $ Element (CaseBox pi box ret body caseLoc) $ boxnf `orNo` nb
+
+  -- e : Eq (𝑗 ⇒ A) t u ⊢ e @0 ⇝ t ∷ A‹0/𝑗›
+  -- e : Eq (𝑗 ⇒ A) t u ⊢ e @1 ⇝ u ∷ A‹1/𝑗›
+  --
+  -- ((δ 𝑖 ⇒ s) ∷ Eq (𝑗 ⇒ A) t u) @𝑘 ⇝ s‹𝑘/𝑖› ∷ A‹𝑘/𝑗›
+  whnf defs ctx (DApp f p appLoc) = do
+    Element f fnf <- whnf defs ctx f
+    case nchoose $ isDLamHead f of
+      Left _ => case f of
+        Ann (DLam {body, _}) (Eq {ty, l, r, _}) _ =>
+          whnf defs ctx $
+            Ann (endsOr (setLoc appLoc l) (setLoc appLoc r) (dsub1 body p) p)
+                (dsub1 ty p) appLoc
+        Coe ty p' q' val _ =>
+          eqCoe defs ctx ty p' q' val p appLoc
+      Right ndlh => case p of
+        K e _ => do
+          Eq {l, r, ty, _} <- whnf0 defs ctx =<< computeElimType defs ctx f
+            | ty => throw $ ExpectedEq ty.loc ctx.names ty
+          whnf defs ctx $
+            ends (Ann (setLoc appLoc l) ty.zero appLoc)
+                 (Ann (setLoc appLoc r) ty.one  appLoc) e
+        B {} => pure $ Element (DApp f p appLoc) $ fnf `orNo` ndlh `orNo` Ah
+
+  -- e ∷ A ⇝ e
+  whnf defs ctx (Ann s a annLoc) = do
+    Element s snf <- whnf defs ctx s
+    case nchoose $ isE s of
+      Left  _  => let E e = s in pure $ Element e $ noOr2 snf
+      Right ne => do
+        Element a anf <- whnf defs ctx a
+        pure $ Element (Ann s a annLoc) $ ne `orNo` snf `orNo` anf
+
+  whnf defs ctx (Coe (S _ (N ty)) _ _ val coeLoc) =
+    whnf defs ctx $ Ann val ty coeLoc
+  whnf defs ctx (Coe (S [< i] (Y ty)) p q val coeLoc) = do
+    Element ty  tynf  <- whnf defs (extendDim i ctx) ty
+    Element val valnf <- whnf defs ctx val
+    case nchoose $ canPushCoe ty val of
+      Right n => pure $ Element (Coe (SY [< i] ty) p q val coeLoc) $
+                        tynf `orNo` n
+      Left  y => pushCoe defs ctx i ty p q val coeLoc
+
+  whnf defs ctx (Comp ty p q val r zero one compLoc) =
+    -- comp [A] @p @p s { ⋯ } ⇝ s ∷ A
+    if p == q then whnf defs ctx $ Ann val ty compLoc else
+    case nchoose (isK r) of
+      -- comp [A] @p @q s @0 { 0 j ⇒ t; ⋯ } ⇝ t‹q/j› ∷ A
+      -- comp [A] @p @q s @1 { 1 j ⇒ t; ⋯ } ⇝ t‹q/j› ∷ A
+      Left y => case r of
+        K Zero _ => whnf defs ctx $ Ann (dsub1 zero q) ty compLoc
+        K One  _ => whnf defs ctx $ Ann (dsub1 one  q) ty compLoc
+      Right nk => do
+        Element ty tynf <- whnf defs ctx ty
+        pure $ Element (Comp ty p q val r zero one compLoc) $ tynf `orNo` nk
+
+  whnf defs ctx (TypeCase ty ret arms def tcLoc) = do
+    Element ty  tynf  <- whnf defs ctx ty
+    Element ret retnf <- whnf defs ctx ret
+    case nchoose $ isAnnTyCon ty of
+      Left  y  =>
+        let Ann ty (TYPE u _) _ = ty in
+        reduceTypeCase defs ctx ty u ret arms def tcLoc
+      Right nt => pure $
+        Element (TypeCase ty ret arms def tcLoc) (tynf `orNo` retnf `orNo` nt)
+
+  whnf defs ctx (CloE  (Sub el th)) = whnf defs ctx $ pushSubstsWith' id th el
+  whnf defs ctx (DCloE (Sub el th)) = whnf defs ctx $ pushSubstsWith' th id el
+
+export covering
+CanWhnf Term Reduce.isRedexT where
+  whnf _ _ t@(TYPE {}) = pure $ nred t
+  whnf _ _ t@(Pi   {}) = pure $ nred t
+  whnf _ _ t@(Lam  {}) = pure $ nred t
+  whnf _ _ t@(Sig  {}) = pure $ nred t
+  whnf _ _ t@(Pair {}) = pure $ nred t
+  whnf _ _ t@(W    {}) = pure $ nred t
+  whnf _ _ t@(Sup  {}) = pure $ nred t
+  whnf _ _ t@(Enum {}) = pure $ nred t
+  whnf _ _ t@(Tag  {}) = pure $ nred t
+  whnf _ _ t@(Eq   {}) = pure $ nred t
+  whnf _ _ t@(DLam {}) = pure $ nred t
+  whnf _ _ t@(Nat  {}) = pure $ nred t
+  whnf _ _ t@(Zero {}) = pure $ nred t
+  whnf _ _ t@(Succ {}) = pure $ nred t
+  whnf _ _ t@(BOX  {}) = pure $ nred t
+  whnf _ _ t@(Box  {}) = pure $ nred t
+
+  -- s ∷ A ⇝ s   (in term context)
+  whnf defs ctx (E e) = do
+    Element e enf <- whnf defs ctx e
+    case nchoose $ isAnn e of
+      Left  _  => let Ann {tm, _} = e in pure $ Element tm $ noOr1 $ noOr2 enf
+      Right na => pure $ Element (E e) $ na `orNo` enf
+
+  whnf defs ctx (CloT  (Sub tm th)) = whnf defs ctx $ pushSubstsWith' id th tm
+  whnf defs ctx (DCloT (Sub tm th)) = whnf defs ctx $ pushSubstsWith' th id tm
diff --git a/lib/Quox/Scoped.idr b/lib/Quox/Scoped.idr
deleted file mode 100644
index ea575cf..0000000
--- a/lib/Quox/Scoped.idr
+++ /dev/null
@@ -1,59 +0,0 @@
-module Quox.Scoped
-
-import public Quox.Var
-import public Quox.Context
-
-import Derive.Prelude
-
-%language ElabReflection
-%default total
-
-
-public export
-data ScopedBody : Nat -> (Nat -> Type) -> Nat -> Type where
-  Y : (body : f (s + n)) -> ScopedBody s f n
-  N : (body : f n)       -> ScopedBody s f n
-%name ScopedBody body
-
-export %inline %hint
-EqScopedBody : (forall n. Eq (f n)) => Eq (ScopedBody s f n)
-EqScopedBody = deriveEq
-
-export %inline %hint
-ShowScopedBody : (forall n. Show (f n)) => Show (ScopedBody s f n)
-ShowScopedBody = deriveShow
-
-||| a scoped term with names
-public export
-record Scoped (s : Nat) (f : Nat -> Type) (n : Nat) where
-  constructor S
-  names : BContext s
-  body  : ScopedBody s f n
-%name Scoped body
-
-export %inline
-(forall n. Eq (f n)) => Eq (Scoped s f n) where
-  s == t = s.body == t.body
-
-export %inline %hint
-ShowScoped : (forall n. Show (f n)) => Show (Scoped s f n)
-ShowScoped = deriveShow
-
-
-||| scope which ignores all its binders
-public export %inline
-SN : Located1 f => {s : Nat} -> f n -> Scoped s f n
-SN body = S (replicate s $ BN Unused body.loc) $ N body
-
-||| scope which uses its binders
-public export %inline
-SY : BContext s -> f (s + n) -> Scoped s f n
-SY ns = S ns . Y
-
-public export %inline
-name : Scoped 1 f n -> BindName
-name (S [< x] _) = x
-
-public export %inline
-(.name) : Scoped 1 f n -> BindName
-s.name = name s
diff --git a/lib/Quox/Syntax.idr b/lib/Quox/Syntax.idr
index 7ee6b44..969661c 100644
--- a/lib/Quox/Syntax.idr
+++ b/lib/Quox/Syntax.idr
@@ -6,5 +6,4 @@ import public Quox.Syntax.Qty
 import public Quox.Syntax.Shift
 import public Quox.Syntax.Subst
 import public Quox.Syntax.Term
-import public Quox.Syntax.Builtin
-import public Quox.Var
+import public Quox.Syntax.Var
diff --git a/lib/Quox/Syntax/Builtin.idr b/lib/Quox/Syntax/Builtin.idr
deleted file mode 100644
index 09ac392..0000000
--- a/lib/Quox/Syntax/Builtin.idr
+++ /dev/null
@@ -1,27 +0,0 @@
-module Quox.Syntax.Builtin
-
-import Derive.Prelude
-import Quox.PrettyValExtra
-import Quox.Pretty
-import Quox.Syntax.Term
-
-
-%default total
-%language ElabReflection
-
-public export
-data Builtin
-= Main
-%runElab derive "Builtin" [Eq, Ord, Show, PrettyVal]
-
-public export
-builtinDesc : Builtin -> String
-builtinDesc Main = "a function declared as #[main]"
-
-public export
-builtinTypeDoc : {opts : LayoutOpts} -> Builtin -> Eff Pretty (Doc opts)
-builtinTypeDoc Main =
-  prettyTerm [<] [<] $
-    Pi One (IOState noLoc)
-      (SN $ Sig (Enum (fromList [!(ifUnicode "𝑎" "a")]) noLoc)
-                (SN (IOState noLoc)) noLoc) noLoc
diff --git a/lib/Quox/Syntax/Dim.idr b/lib/Quox/Syntax/Dim.idr
index 5f60a17..2b2b7c1 100644
--- a/lib/Quox/Syntax/Dim.idr
+++ b/lib/Quox/Syntax/Dim.idr
@@ -2,11 +2,10 @@ module Quox.Syntax.Dim
 
 import Quox.Loc
 import Quox.Name
-import Quox.Var
+import Quox.Syntax.Var
 import Quox.Syntax.Subst
 import Quox.Pretty
 import Quox.Context
-import Quox.PrettyValExtra
 
 import Decidable.Equality
 import Control.Function
@@ -19,7 +18,7 @@ import Derive.Prelude
 public export
 data DimConst = Zero | One
 %name DimConst e
-%runElab derive "DimConst" [Eq, Ord, Show, PrettyVal]
+%runElab derive "DimConst" [Eq, Ord, Show]
 
 ||| `ends l r e` returns `l` if `e` is `Zero`, or `r` if it is `One`.
 public export
@@ -84,7 +83,7 @@ DSubst : Nat -> Nat -> Type
 DSubst = Subst Dim
 
 
-public export FromVar Dim where fromVarLoc = B
+public export FromVar Dim where fromVar = B
 
 
 export
diff --git a/lib/Quox/Syntax/DimEq.idr b/lib/Quox/Syntax/DimEq.idr
index 885eebd..0f47bd0 100644
--- a/lib/Quox/Syntax/DimEq.idr
+++ b/lib/Quox/Syntax/DimEq.idr
@@ -1,12 +1,11 @@
 module Quox.Syntax.DimEq
 
-import public Quox.Var
+import public Quox.Syntax.Var
 import public Quox.Syntax.Dim
 import public Quox.Syntax.Subst
 import public Quox.Context
 import Quox.Pretty
 import Quox.Name
-import Quox.FreeVars
 
 import Data.Maybe
 import Data.Nat
@@ -59,15 +58,10 @@ Traversable (IfConsistent eqs) where
   traverse f Nothing  = pure Nothing
   traverse f (Just x) = Just <$> f x
 
-public export
-ifConsistentElse : Applicative f => (eqs : DimEq d) ->
-                   f a -> f () -> f (IfConsistent eqs a)
-ifConsistentElse ZeroIsOne yes no = Nothing <$  no
-ifConsistentElse (C _)     yes no = Just    <$> yes
-
 public export
 ifConsistent : Applicative f => (eqs : DimEq d) -> f a -> f (IfConsistent eqs a)
-ifConsistent eqs act = ifConsistentElse eqs act (pure ())
+ifConsistent ZeroIsOne act = pure Nothing
+ifConsistent (C _)     act = Just <$> act
 
 public export
 toMaybe : IfConsistent eqs a -> Maybe a
@@ -123,7 +117,7 @@ equal ZeroIsOne p q = True
 equal (C eqs)   p q = get eqs p == get eqs q
 
 
-export infixl 7 :<?
+infixl 7 :<?
 export %inline
 (:<?) : DimEq d -> Maybe (Dim d) -> DimEq (S d)
 ZeroIsOne :<? d = ZeroIsOne
@@ -191,28 +185,20 @@ split1 e loc eqs = case setConst VZ e loc eqs of
   C (eqs :< _) => Just (eqs, K e loc ::: id)
 
 export %inline
-split1' : DimConst -> Loc -> DimEq' (S d) -> List (Split d)
-split1' e loc eqs = toList $ split1 e loc eqs
-
-export %inline
-split : Loc -> DimEq' (S d) -> Bool -> List (Split d)
-split loc eqs False = split1' Zero loc eqs
-split loc eqs True  = split1' Zero loc eqs <+> split1' One loc eqs
+split : Loc -> DimEq' (S d) -> List (Split d)
+split loc eqs = toList (split1 Zero loc eqs) <+> toList (split1 One loc eqs)
 
 export
-splits' : Loc -> DimEq' d -> FreeVars d -> List (DSubst d 0)
-splits' _   [<]          _  = [id]
-splits' loc eqs@(_ :< _) us = do
-  let (us, u) = uncons us
-  (eqs', th) <- split loc eqs u
-  ph         <- splits' loc eqs' us
-  pure $ th . ph
+splits' : Loc -> DimEq' d -> List (DSubst d 0)
+splits' _   [<]          = [id]
+splits' loc eqs@(_ :< _) =
+  [th . ph | (eqs', th) <- split loc eqs, ph <- splits' loc eqs']
 
 ||| the Loc is put into each of the DimConsts
 export %inline
-splits : Loc -> DimEq d -> FreeVars d -> List (DSubst d 0)
-splits _   ZeroIsOne _   = []
-splits loc (C eqs)   fvs = splits' loc eqs fvs
+splits : Loc -> DimEq d -> List (DSubst d 0)
+splits _   ZeroIsOne = []
+splits loc (C eqs)   = splits' loc eqs
 
 
 private
@@ -242,20 +228,9 @@ setSelf (B i _)    (C eqs) with (compareP i i) | (compare i.nat i.nat)
   _ | IsGT gt | GT = absurd gt
 
 
-private %inline
-dimEqPrec : BContext d -> Maybe (DimEq' d) -> PPrec
-dimEqPrec vars eqs =
-  if length vars <= 1 && maybe True null eqs then Arg else Outer
-
 private
-prettyDVars' : {opts : _} -> BContext d -> Eff Pretty (SnocList (Doc opts))
-prettyDVars' = traverse prettyDBind . toSnocList'
-
-export
-prettyDVars : {opts : _} -> BContext d -> Eff Pretty (Doc opts)
-prettyDVars vars =
-  parensIfM (dimEqPrec vars Nothing) $
-  fillSeparateTight !commaD $ !(prettyDVars' vars)
+prettyDVars : {opts : _} -> BContext d -> Eff Pretty (SnocList (Doc opts))
+prettyDVars = traverse prettyDBind . toSnocList'
 
 private
 prettyCst : {opts : _} -> BContext d -> Dim d -> Dim d -> Eff Pretty (Doc opts)
@@ -268,20 +243,20 @@ prettyCsts : {opts : _} -> BContext d -> DimEq' d ->
 prettyCsts [<] [<] = pure [<]
 prettyCsts dnames (eqs :< Nothing) = prettyCsts (tail dnames) eqs
 prettyCsts dnames (eqs :< Just q)  =
-  [|prettyCsts (tail dnames) eqs :< prettyCst dnames (BV 0 noLoc) (weakD 1 q)|]
+  [|prettyCsts (tail dnames) eqs :< prettyCst dnames (BV 0 q.loc) (weakD 1 q)|]
 
 export
 prettyDimEq' : {opts : _} -> BContext d -> DimEq' d -> Eff Pretty (Doc opts)
-prettyDimEq' vars eqs = do
-  vars' <- prettyDVars' vars
-  eqs'  <- prettyCsts vars eqs
-  parensIfM (dimEqPrec vars (Just eqs)) $
-    fillSeparateTight !commaD $ vars' ++ eqs'
+prettyDimEq' dnames eqs = do
+  vars <- prettyDVars dnames
+  eqs  <- prettyCsts dnames eqs
+  let prec = if length vars <= 1 && null eqs then Arg else Outer
+  parensIfM prec $ fillSeparateTight !commaD $ toList vars ++ toList eqs
 
 export
 prettyDimEq : {opts : _} -> BContext d -> DimEq d -> Eff Pretty (Doc opts)
 prettyDimEq dnames ZeroIsOne = do
-  vars <- prettyDVars' dnames
+  vars <- prettyDVars dnames
   cst  <- prettyCst [<] (K Zero noLoc) (K One noLoc)
   pure $ separateTight !commaD $ vars :< cst
 prettyDimEq dnames (C eqs) = prettyDimEq' dnames eqs
diff --git a/lib/Quox/Syntax/Qty.idr b/lib/Quox/Syntax/Qty.idr
index d0d3d79..1aa0ba0 100644
--- a/lib/Quox/Syntax/Qty.idr
+++ b/lib/Quox/Syntax/Qty.idr
@@ -6,7 +6,6 @@ module Quox.Syntax.Qty
 
 import Quox.Pretty
 import Quox.Decidable
-import Quox.PrettyValExtra
 import Data.DPair
 import Derive.Prelude
 
@@ -21,7 +20,7 @@ import Derive.Prelude
 ||| - ω (or #): don't care. an ω variable *can* also be used 0/1 time
 public export
 data Qty = Zero | One | Any
-%runElab derive "Qty" [Eq, Ord, Show, PrettyVal]
+%runElab derive "Qty" [Eq, Ord, Show]
 %name Qty.Qty pi, rh
 
 
@@ -79,16 +78,26 @@ lub p q = if p == q then p else Any
 ||| to maintain subject reduction, only 0 or 1 can occur
 ||| for the subject of a typing judgment. see @qtt, §2.3 for more detail
 public export
-data SQty = SZero | SOne
-%runElab derive "SQty" [Eq, Ord, Show, PrettyVal]
-%name Qty.SQty sg
+isSubj : Qty -> Bool
+isSubj Zero = True
+isSubj One  = True
+isSubj Any  = False
+
+public export
+SQty : Type
+SQty = Subset Qty $ So . isSubj
+
+public export %inline
+szero, sone : SQty
+szero = Element Zero Oh
+sone  = Element One  Oh
 
 ||| "σ ⨴ π"
 |||
-||| σ ⨴ π is 0 if either of σ or π are, otherwise it is σ.
+||| σ ⨭ π is 0 if either of σ or π are, otherwise it is σ.
 public export
 subjMult : SQty -> Qty -> SQty
-subjMult _  Zero = SZero
+subjMult _  Zero = szero
 subjMult sg _    = sg
 
 
@@ -96,59 +105,23 @@ subjMult sg _    = sg
 ||| quantity of 1, so the only distinction is whether it is present
 ||| at runtime at all or not
 public export
-data GQty = GZero | GAny
-%runElab derive "GQty" [Eq, Ord, Show, PrettyVal]
-%name GQty rh
+isGlobal : Qty -> Bool
+isGlobal Zero = True
+isGlobal One  = False
+isGlobal Any  = True
 
 public export
-toGlobal : Qty -> Maybe GQty
-toGlobal Zero = Just GZero
-toGlobal Any  = Just GAny
-toGlobal One  = Nothing
+GQty : Type
+GQty = Subset Qty $ So . isGlobal
+
+public export
+gzero, gany : GQty
+gzero = Element Zero Oh
+gany  = Element Any  Oh
 
 ||| when checking a definition, a 0 definition is checked at 0,
 ||| but an ω definition is checked at 1 since ω isn't a subject quantity
 public export %inline
 globalToSubj : GQty -> SQty
-globalToSubj GZero = SZero
-globalToSubj GAny  = SOne
-
-
-public export
-DecEq Qty where
-  decEq Zero Zero = Yes Refl
-  decEq Zero One  = No $ \case _ impossible
-  decEq Zero Any  = No $ \case _ impossible
-  decEq One  Zero = No $ \case _ impossible
-  decEq One  One  = Yes Refl
-  decEq One  Any  = No $ \case _ impossible
-  decEq Any  Zero = No $ \case _ impossible
-  decEq Any  One  = No $ \case _ impossible
-  decEq Any  Any  = Yes Refl
-
-public export
-DecEq SQty where
-  decEq SZero SZero = Yes Refl
-  decEq SZero SOne  = No $ \case _ impossible
-  decEq SOne  SZero = No $ \case _ impossible
-  decEq SOne  SOne  = Yes Refl
-
-public export
-DecEq GQty where
-  decEq GZero GZero = Yes Refl
-  decEq GZero GAny  = No $ \case _ impossible
-  decEq GAny  GZero = No $ \case _ impossible
-  decEq GAny  GAny  = Yes Refl
-
-
-namespace SQty
-  public export %inline
-  (.qty) : SQty -> Qty
-  (SZero).qty = Zero
-  (SOne).qty  = One
-
-namespace GQty
-  public export %inline
-  (.qty) : GQty -> Qty
-  (GZero).qty = Zero
-  (GAny).qty  = Any
+globalToSubj (Element Zero _) = szero
+globalToSubj (Element Any  _) = sone
diff --git a/lib/Quox/Syntax/Shift.idr b/lib/Quox/Syntax/Shift.idr
index ddc5a15..ecfe476 100644
--- a/lib/Quox/Syntax/Shift.idr
+++ b/lib/Quox/Syntax/Shift.idr
@@ -1,11 +1,9 @@
 module Quox.Syntax.Shift
 
-import public Quox.Var
+import public Quox.Syntax.Var
 
 import Data.Nat
 import Data.So
-import Data.Singleton
-import Syntax.PreorderReasoning
 
 %default total
 
@@ -148,25 +146,6 @@ weakViaNat s by =
 %transform "Shift.weak" Shift.weak = weakViaNat
 
 
-export
-getFrom : {to : Nat} -> Shift from to -> Singleton from
-getFrom SZ      = Val to
-getFrom (SS by) = getFrom by
-
-private
-0 getFromViaNatProof : (by : Shift from to) -> from = to `minus` by.nat
-getFromViaNatProof by = Calc $
-  |~ from
-  ~~ minus (by.nat + from) by.nat ..<(minusPlus {})
-  ~~ minus to by.nat              ..<(cong (flip minus by.nat) (shiftDiff by))
-
-private
-getFromViaNat : {to : Nat} -> Shift from to -> Singleton from
-getFromViaNat by = rewrite getFromViaNatProof by in Val _
-
-%transform "Shift.getFrom" Shift.getFrom = getFromViaNat
-
-
 public export
 shift : Shift from to -> Var from -> Var to
 shift SZ      i = i
@@ -199,12 +178,11 @@ by . SS bz = SS $ by . bz
 private
 0 compNatProof : (by : Shift from mid) -> (bz : Shift mid to) ->
                  to = by.nat + bz.nat + from
-compNatProof by bz = Calc $
-  |~ to
-  ~~ bz.nat + mid             ...(shiftDiff {})
-  ~~ bz.nat + (by.nat + from) ...(cong (bz.nat +) (shiftDiff {}))
-  ~~ bz.nat + by.nat + from   ...(plusAssociative {})
-  ~~ by.nat + bz.nat + from   ...(cong (+ from) (plusCommutative {}))
+compNatProof by bz =
+  trans (shiftDiff bz) $
+  trans (cong (bz.nat +) (shiftDiff by)) $
+  trans (plusAssociative bz.nat by.nat from) $
+  cong (+ from) (plusCommutative bz.nat by.nat)
 
 private %inline
 compViaNat' : (by : Shift from mid) -> (bz : Shift mid to) ->
@@ -227,7 +205,7 @@ compViaNatCorrect by (SS bz) =
 %transform "Shift.(.)" Shift.(.) = compViaNat
 
 
-export infixl 8 //
+infixl 8 //
 public export
 interface CanShift f where
   (//) : f from -> Shift from to -> f to
diff --git a/lib/Quox/Syntax/Subst.idr b/lib/Quox/Syntax/Subst.idr
index 1e14d4d..0615879 100644
--- a/lib/Quox/Syntax/Subst.idr
+++ b/lib/Quox/Syntax/Subst.idr
@@ -1,13 +1,12 @@
 module Quox.Syntax.Subst
 
 import public Quox.Syntax.Shift
-import Quox.Var
+import Quox.Syntax.Var
 import Quox.Name
 
 import Data.Nat
 import Data.List
 import Data.SnocVect
-import Data.Singleton
 import Derive.Prelude
 
 %default total
@@ -20,7 +19,7 @@ data Subst : (Nat -> Type) -> Nat -> Nat -> Type where
   (:::) : (t : Lazy (env to)) -> Subst env from to -> Subst env (S from) to
 %name Subst th, ph, ps
 
-export infixr 7 !:::
+infixr 7 !:::
 ||| in case the automatic laziness insertion gets confused
 public export
 (!:::) : env to -> Subst env from to -> Subst env (S from) to
@@ -42,7 +41,7 @@ export Ord  (f to) => Ord  (Subst f from to) where compare = compare `on` repr
 export Show (f to) => Show (Subst f from to) where show = show . repr
 
 
-export infixl 8 //
+infixl 8 //
 public export
 interface FromVar term => CanSubstSelf term where
   (//) : term from -> Lazy (Subst term from to) -> term to
@@ -50,7 +49,7 @@ interface FromVar term => CanSubstSelf term where
 
 public export
 getLoc : FromVar term => Subst term from to -> Var from -> Loc -> term to
-getLoc (Shift by) i      loc = fromVarLoc (shift by i) loc
+getLoc (Shift by) i      loc = fromVar (shift by i) loc
 getLoc (t ::: th) VZ     _   = t
 getLoc (t ::: th) (VS i) loc = getLoc th i loc
 
@@ -96,18 +95,18 @@ map f (t ::: th) = f t ::: map f th
 
 
 public export %inline
-push : CanSubstSelf f => Loc -> Subst f from to -> Subst f (S from) (S to)
-push loc th = fromVarLoc VZ loc ::: (th . shift 1)
+push : CanSubstSelf f => Subst f from to -> Loc -> Subst f (S from) (S to)
+push th loc = fromVar VZ loc ::: (th . shift 1)
 
 -- [fixme] a better way to do this?
 public export
-pushN : CanSubstSelf f => (s : Nat) -> Loc ->
-        Subst f from to -> Subst f (s + from) (s + to)
-pushN 0     _   th = th
-pushN (S s) loc th =
+pushN : CanSubstSelf f => (s : Nat) ->
+        Subst f from to -> Loc -> Subst f (s + from) (s + to)
+pushN 0     th _   = th
+pushN (S s) th loc =
   rewrite plusSuccRightSucc s from in
   rewrite plusSuccRightSucc s to in
-  pushN s loc $ fromVarLoc VZ loc ::: (th . shift 1)
+  pushN s (fromVar VZ loc ::: (th . shift 1)) loc
 
 public export
 drop1 : Subst f (S from) to -> Subst f from to
@@ -125,12 +124,6 @@ one : f n -> Subst f (S n) n
 one x = fromSnocVect [< x]
 
 
-export
-getFrom : {to : Nat} -> Subst _ from to -> Singleton from
-getFrom (Shift by) = getFrom by
-getFrom (t ::: th) = [|S $ getFrom th|]
-
-
 ||| whether two substitutions with the same codomain have the same shape
 ||| (the same number of terms and the same shift at the end). if so, they
 ||| also have the same domain
diff --git a/lib/Quox/Syntax/Term.idr b/lib/Quox/Syntax/Term.idr
index b7e4054..2ac69a4 100644
--- a/lib/Quox/Syntax/Term.idr
+++ b/lib/Quox/Syntax/Term.idr
@@ -3,3 +3,4 @@ module Quox.Syntax.Term
 import public Quox.Syntax.Term.Base
 import public Quox.Syntax.Term.Subst
 import public Quox.Syntax.Term.Pretty
+import public Quox.Syntax.Term.Tighten
diff --git a/lib/Quox/Syntax/Term/Base.idr b/lib/Quox/Syntax/Term/Base.idr
index 5457b83..23342d7 100644
--- a/lib/Quox/Syntax/Term/Base.idr
+++ b/lib/Quox/Syntax/Term/Base.idr
@@ -1,7 +1,6 @@
 module Quox.Syntax.Term.Base
 
-import public Quox.Var
-import public Quox.Scoped
+import public Quox.Syntax.Var
 import public Quox.Syntax.Shift
 import public Quox.Syntax.Subst
 import public Quox.Syntax.Qty
@@ -47,6 +46,39 @@ TagVal : Type
 TagVal = String
 
 
+public export
+data ScopedBody : Nat -> (Nat -> Type) -> Nat -> Type where
+  Y : (body : f (s + n)) -> ScopedBody s f n
+  N : (body : f n)       -> ScopedBody s f n
+%name ScopedBody body
+
+export %inline %hint
+EqScopedBody : (forall n. Eq (f n)) => Eq (ScopedBody s f n)
+EqScopedBody = deriveEq
+
+export %inline %hint
+ShowScopedBody : (forall n. Show (f n)) => Show (ScopedBody s f n)
+ShowScopedBody = deriveShow
+
+||| a scoped term with names
+public export
+record Scoped (s : Nat) (f : Nat -> Type) (n : Nat) where
+  constructor S
+  names : BContext s
+  body  : ScopedBody s f n
+%name Scoped body
+
+export %inline
+(forall n. Eq (f n)) => Eq (Scoped s f n) where
+  s == t = s.body == t.body
+
+export %inline %hint
+ShowScoped : (forall n. Show (f n)) => Show (Scoped s f n)
+ShowScoped = deriveShow
+
+
+infixl 8 :#
+infixl 9 :@, :%
 mutual
   public export
   TSubst : TSubstLike
@@ -59,10 +91,6 @@ mutual
     ||| type of types
     TYPE : (l : Universe) -> (loc : Loc) -> Term d n
 
-    ||| IO state token. this is a builtin because otherwise #[main] being a
-    ||| builtin makes no sense
-    IOState : (loc : Loc) -> Term d n
-
     ||| function type
     Pi  : (qty : Qty) -> (arg : Term d n) ->
           (res : ScopeTerm d n) -> (loc : Loc) -> Term d n
@@ -74,6 +102,16 @@ mutual
     ||| pair value
     Pair : (fst, snd : Term d n) -> (loc : Loc) -> Term d n
 
+    ||| inductive (w) type `(x : A) ⊲ B`
+    W : (shape : Term d n) ->
+        (body : ScopeTerm d n) -> (loc : Loc) -> Term d n
+    ||| subterms for `(x : A) ⊲ B` are:
+    |||   1. `x : A`
+    |||      (the "constructor" and non-recursive fields)
+    |||   2. `f : 1.(B x) → (x : A) ⊲ B`
+    |||      (the recursive fields, one for each element of B x)
+    Sup : (root, sub : Term d n) -> (loc : Loc) -> Term d n
+
     ||| enumeration type
     Enum : (cases : SortedSet TagVal) -> (loc : Loc) -> Term d n
     ||| enumeration value
@@ -85,21 +123,15 @@ mutual
     DLam : (body : DScopeTerm d n) -> (loc : Loc) -> Term d n
 
     ||| natural numbers (temporary until 𝐖 gets added)
-    NAT : (loc : Loc) -> Term d n
-    Nat : (val : Nat) -> (loc : Loc) -> Term d n
+    Nat  : (loc : Loc) -> Term d n
+    -- [todo] can these be elims?
+    Zero : (loc : Loc) -> Term d n
     Succ : (p : Term d n) -> (loc : Loc) -> Term d n
 
-    ||| strings
-    STRING : (loc : Loc) -> Term d n
-    Str    : (str : String) -> (loc : Loc) -> Term d n
-
     ||| "box" (package a value up with a certain quantity)
     BOX : (qty : Qty) -> (ty : Term d n) -> (loc : Loc) -> Term d n
     Box : (val : Term d n) -> (loc : Loc) -> Term d n
 
-    Let : (qty : Qty) -> (rhs : Elim d n) ->
-          (body : ScopeTerm d n) -> (loc : Loc) -> Term d n
-
     ||| elimination
     E : (e : Elim d n) -> Term d n
 
@@ -133,11 +165,12 @@ mutual
                (loc : Loc) ->
                Elim d n
 
-    ||| first element of a pair. only works in non-linear contexts.
-    Fst : (pair : Elim d n) -> (loc : Loc) -> Elim d n
-
-    ||| second element of a pair. only works in non-linear contexts.
-    Snd : (pair : Elim d n) -> (loc : Loc) -> Elim d n
+    ||| recursion
+    CaseW : (qty, qtyIH : Qty) -> (tree : Elim d n) ->
+            (ret : ScopeTerm d n) ->
+            (body : ScopeTermN 3 d n) ->
+            (loc : Loc) ->
+            Elim d n
 
     ||| enum matching
     CaseEnum : (qty : Qty) -> (tag : Elim d n) ->
@@ -234,123 +267,23 @@ mutual
   ShowElim : Show (Elim d n)
   ShowElim = assert_total {a = Show (Elim d n)} deriveShow
 
+||| scope which ignores all its binders
+public export %inline
+SN : {s : Nat} -> f n -> Scoped s f n
+SN = S (replicate s $ BN Unused noLoc) . N
 
-export
-Located (Elim d n) where
-  (F _ _ loc).loc               = loc
-  (B _ loc).loc                 = loc
-  (App _ _ loc).loc             = loc
-  (CasePair _ _ _ _ loc).loc    = loc
-  (Fst _ loc).loc               = loc
-  (Snd _ loc).loc               = loc
-  (CaseEnum _ _ _ _ loc).loc    = loc
-  (CaseNat _ _ _ _ _ _ loc).loc = loc
-  (CaseBox _ _ _ _ loc).loc     = loc
-  (DApp _ _ loc).loc            = loc
-  (Ann _ _ loc).loc             = loc
-  (Coe _ _ _ _ loc).loc         = loc
-  (Comp _ _ _ _ _ _ _ loc).loc  = loc
-  (TypeCase _ _ _ _ loc).loc    = loc
-  (CloE (Sub e _)).loc          = e.loc
-  (DCloE (Sub e _)).loc         = e.loc
+||| scope which uses its binders
+public export %inline
+SY : BContext s -> f (s + n) -> Scoped s f n
+SY ns = S ns . Y
 
-export
-Located (Term d n) where
-  (TYPE _ loc).loc      = loc
-  (IOState loc).loc     = loc
-  (Pi _ _ _ loc).loc    = loc
-  (Lam _ loc).loc       = loc
-  (Sig _ _ loc).loc     = loc
-  (Pair _ _ loc).loc    = loc
-  (Enum _ loc).loc      = loc
-  (Tag _ loc).loc       = loc
-  (Eq _ _ _ loc).loc    = loc
-  (DLam _ loc).loc      = loc
-  (NAT loc).loc         = loc
-  (Nat _ loc).loc       = loc
-  (STRING loc).loc      = loc
-  (Str _ loc).loc       = loc
-  (Succ _ loc).loc      = loc
-  (BOX _ _ loc).loc     = loc
-  (Box _ loc).loc       = loc
-  (Let _ _ _ loc).loc   = loc
-  (E e).loc             = e.loc
-  (CloT (Sub t _)).loc  = t.loc
-  (DCloT (Sub t _)).loc = t.loc
-
-export
-Located1 f => Located (ScopedBody s f n) where
-  (Y t).loc = t.loc
-  (N t).loc = t.loc
-
-export
-Located1 f => Located (Scoped s f n) where
-  t.loc = t.body.loc
-
-
-export
-Relocatable (Elim d n) where
-  setLoc loc (F x u _) = F x u loc
-  setLoc loc (B i _) = B i loc
-  setLoc loc (App fun arg _) = App fun arg loc
-  setLoc loc (CasePair qty pair ret body _) =
-    CasePair qty pair ret body loc
-  setLoc loc (Fst pair _) = Fst pair loc
-  setLoc loc (Snd pair _) = Fst pair loc
-  setLoc loc (CaseEnum qty tag ret arms _) =
-    CaseEnum qty tag ret arms loc
-  setLoc loc (CaseNat qty qtyIH nat ret zero succ _) =
-    CaseNat qty qtyIH nat ret zero succ loc
-  setLoc loc (CaseBox qty box ret body _) =
-    CaseBox qty box ret body loc
-  setLoc loc (DApp fun arg _) =
-    DApp fun arg loc
-  setLoc loc (Ann tm ty _) =
-    Ann tm ty loc
-  setLoc loc (Coe ty p q val _) =
-    Coe ty p q val loc
-  setLoc loc (Comp ty p q val r zero one _) =
-    Comp ty p q val r zero one loc
-  setLoc loc (TypeCase ty ret arms def _) =
-    TypeCase ty ret arms def loc
-  setLoc loc (CloE (Sub term subst)) =
-    CloE $ Sub (setLoc loc term) subst
-  setLoc loc (DCloE (Sub term subst)) =
-    DCloE $ Sub (setLoc loc term) subst
-
-export
-Relocatable (Term d n) where
-  setLoc loc (TYPE l _) = TYPE l loc
-  setLoc loc (IOState _) = IOState loc
-  setLoc loc (Pi qty arg res _) = Pi qty arg res loc
-  setLoc loc (Lam body _) = Lam body loc
-  setLoc loc (Sig fst snd _) = Sig fst snd loc
-  setLoc loc (Pair fst snd _) = Pair fst snd loc
-  setLoc loc (Enum cases _) = Enum cases loc
-  setLoc loc (Tag tag _) = Tag tag loc
-  setLoc loc (Eq ty l r _) = Eq ty l r loc
-  setLoc loc (DLam body _) = DLam body loc
-  setLoc loc (NAT _) = NAT loc
-  setLoc loc (Nat n _) = Nat n loc
-  setLoc loc (Succ p _) = Succ p loc
-  setLoc loc (STRING _) = STRING loc
-  setLoc loc (Str s _) = Str s loc
-  setLoc loc (BOX qty ty _) = BOX qty ty loc
-  setLoc loc (Box val _) = Box val loc
-  setLoc loc (Let qty rhs body _) = Let qty rhs body loc
-  setLoc loc (E e) = E $ setLoc loc e
-  setLoc loc (CloT (Sub term subst)) = CloT $ Sub (setLoc loc term) subst
-  setLoc loc (DCloT (Sub term subst)) = DCloT $ Sub (setLoc loc term) subst
-
-export
-Relocatable1 f => Relocatable (ScopedBody s f n) where
-  setLoc loc (Y body) = Y $ setLoc loc body
-  setLoc loc (N body) = N $ setLoc loc body
-
-export
-Relocatable1 f => Relocatable (Scoped s f n) where
-  setLoc loc (S names body) = S (setLoc loc <$> names) (setLoc loc body)
+public export %inline
+name : Scoped 1 f n -> BindName
+name (S [< x] _) = x
 
+public export %inline
+(.name) : Scoped 1 f n -> BindName
+s.name = name s
 
 ||| more convenient Pi
 public export %inline
@@ -398,12 +331,6 @@ public export %inline
 DLamN : (body : Term d n) -> (loc : Loc) -> Term d n
 DLamN {body, loc} = DLam {body = SN body, loc}
 
-||| more convenient Coe
-public export %inline
-CoeY : (i : BindName) -> (ty : Term (S d) n) ->
-       (p, q : Dim d) -> (val : Term d n) -> (loc : Loc) -> Elim d n
-CoeY {i, ty, p, q, val, loc} = Coe {ty = SY [< i] ty, p, q, val, loc}
-
 ||| non dependent equality type
 public export %inline
 Eq0 : (ty, l, r : Term d n) -> (loc : Loc) -> Term d n
@@ -414,11 +341,6 @@ public export %inline
 FT : Name -> Universe -> Loc -> Term d n
 FT x u loc = E $ F x u loc
 
-||| same as `B` but as a term
-public export %inline
-BT : Var n -> (loc : Loc) -> Term d n
-BT i loc = E $ B i loc
-
 ||| abbreviation for a bound variable like `BV 4` instead of
 ||| `B (VS (VS (VS (VS VZ))))`
 public export %inline
@@ -430,14 +352,20 @@ public export %inline
 BVT : (i : Nat) -> (0 _ : LT i n) => (loc : Loc) -> Term d n
 BVT i loc = E $ BV i loc
 
-public export %inline
-Zero : Loc -> Term d n
-Zero = Nat 0
+public export
+makeNat : Nat -> Loc -> Term d n
+makeNat 0 loc = Zero loc
+makeNat (S k) loc = Succ (makeNat k loc) loc
 
 public export %inline
 enum : List TagVal -> Loc -> Term d n
 enum ts loc = Enum (SortedSet.fromList ts) loc
 
+public export %inline
+caseEnum : Qty -> Elim d n -> ScopeTerm d n -> List (TagVal, Term d n) -> Loc ->
+           Elim d n
+caseEnum q e ret arms loc = CaseEnum q e ret (SortedMap.fromList arms) loc
+
 public export %inline
 typeCase : Elim d n -> Term d n ->
            List (TypeCaseArm d n) -> Term d n -> Loc -> Elim d n
@@ -447,6 +375,118 @@ public export %inline
 typeCase1Y : Elim d n -> Term d n ->
              (k : TyConKind) -> BContext (arity k) -> Term d (arity k + n) ->
              (loc : Loc) ->
-             {default (NAT loc) def : Term d n} ->
+             {default (Nat loc) def : Term d n} ->
              Elim d n
 typeCase1Y ty ret k ns body loc = typeCase ty ret [(k ** SY ns body)] def loc
+
+
+export
+Located (Elim d n) where
+  (F _ _ loc).loc               = loc
+  (B _ loc).loc                 = loc
+  (App _ _ loc).loc             = loc
+  (CasePair _ _ _ _ loc).loc    = loc
+  (CaseW _ _ _ _ _ loc).loc     = loc
+  (CaseEnum _ _ _ _ loc).loc    = loc
+  (CaseNat _ _ _ _ _ _ loc).loc = loc
+  (CaseBox _ _ _ _ loc).loc     = loc
+  (DApp _ _ loc).loc            = loc
+  (Ann _ _ loc).loc             = loc
+  (Coe _ _ _ _ loc).loc         = loc
+  (Comp _ _ _ _ _ _ _ loc).loc  = loc
+  (TypeCase _ _ _ _ loc).loc    = loc
+  (CloE (Sub e _)).loc          = e.loc
+  (DCloE (Sub e _)).loc         = e.loc
+
+export
+Located (Term d n) where
+  (TYPE _ loc).loc      = loc
+  (Pi _ _ _ loc).loc    = loc
+  (Lam _ loc).loc       = loc
+  (Sig _ _ loc).loc     = loc
+  (Pair _ _ loc).loc    = loc
+  (W _ _ loc).loc       = loc
+  (Sup _ _ loc).loc     = loc
+  (Enum _ loc).loc      = loc
+  (Tag _ loc).loc       = loc
+  (Eq _ _ _ loc).loc    = loc
+  (DLam _ loc).loc      = loc
+  (Nat loc).loc         = loc
+  (Zero loc).loc        = loc
+  (Succ _ loc).loc      = loc
+  (BOX _ _ loc).loc     = loc
+  (Box _ loc).loc       = loc
+  (E e).loc             = e.loc
+  (CloT (Sub t _)).loc  = t.loc
+  (DCloT (Sub t _)).loc = t.loc
+
+export
+Located1 f => Located (ScopedBody s f n) where
+  (Y t).loc = t.loc
+  (N t).loc = t.loc
+
+export
+Located1 f => Located (Scoped s f n) where
+  t.loc = t.body.loc
+
+
+export
+Relocatable (Elim d n) where
+  setLoc loc (F x u _) = F x u loc
+  setLoc loc (B i _) = B i loc
+  setLoc loc (App fun arg _) = App fun arg loc
+  setLoc loc (CasePair qty pair ret body _) =
+    CasePair qty pair ret body loc
+  setLoc loc (CaseW qty qtyIH tree ret body _) =
+    CaseW qty qtyIH tree ret body loc
+  setLoc loc (CaseEnum qty tag ret arms _) =
+    CaseEnum qty tag ret arms loc
+  setLoc loc (CaseNat qty qtyIH nat ret zero succ _) =
+    CaseNat qty qtyIH nat ret zero succ loc
+  setLoc loc (CaseBox qty box ret body _) =
+    CaseBox qty box ret body loc
+  setLoc loc (DApp fun arg _) =
+    DApp fun arg loc
+  setLoc loc (Ann tm ty _) =
+    Ann tm ty loc
+  setLoc loc (Coe ty p q val _) =
+    Coe ty p q val loc
+  setLoc loc (Comp ty p q val r zero one _) =
+    Comp ty p q val r zero one loc
+  setLoc loc (TypeCase ty ret arms def _) =
+    TypeCase ty ret arms def loc
+  setLoc loc (CloE (Sub term subst)) =
+    CloE $ Sub (setLoc loc term) subst
+  setLoc loc (DCloE (Sub term subst)) =
+    DCloE $ Sub (setLoc loc term) subst
+
+export
+Relocatable (Term d n) where
+  setLoc loc (TYPE l _) = TYPE l loc
+  setLoc loc (Pi qty arg res _) = Pi qty arg res loc
+  setLoc loc (Lam body _) = Lam body loc
+  setLoc loc (Sig fst snd _) = Sig fst snd loc
+  setLoc loc (Pair fst snd _) = Pair fst snd loc
+  setLoc loc (W shape body _) = W shape body loc
+  setLoc loc (Sup root sub _) = Sup root sub loc
+  setLoc loc (Enum cases _) = Enum cases loc
+  setLoc loc (Tag tag _) = Tag tag loc
+  setLoc loc (Eq ty l r _) = Eq ty l r loc
+  setLoc loc (DLam body _) = DLam body loc
+  setLoc loc (Nat _) = Nat loc
+  setLoc loc (Zero _) = Zero loc
+  setLoc loc (Succ p _) = Succ p loc
+  setLoc loc (BOX qty ty _) = BOX qty ty loc
+  setLoc loc (Box val _) = Box val loc
+  setLoc loc (E e) = E $ setLoc loc e
+  setLoc loc (CloT (Sub term subst)) = CloT $ Sub (setLoc loc term) subst
+  setLoc loc (DCloT (Sub term subst)) = DCloT $ Sub (setLoc loc term) subst
+
+export
+Relocatable1 f => Relocatable (ScopedBody s f n) where
+  setLoc loc (Y body) = Y $ setLoc loc body
+  setLoc loc (N body) = N $ setLoc loc body
+
+export
+Relocatable1 f => Relocatable (Scoped s f n) where
+  setLoc loc (S names body) = S (setLoc loc <$> names) (setLoc loc body)
diff --git a/lib/Quox/Syntax/Term/Pretty.idr b/lib/Quox/Syntax/Term/Pretty.idr
index 36d9320..18644ce 100644
--- a/lib/Quox/Syntax/Term/Pretty.idr
+++ b/lib/Quox/Syntax/Term/Pretty.idr
@@ -30,6 +30,14 @@ BTelescope : Nat -> Nat -> Type
 BTelescope = Telescope' BindName
 
 
+private
+subscript : String -> String
+subscript = pack . map sub . unpack where
+  sub : Char -> Char
+  sub c = case c of
+    '0' => '₀'; '1' => '₁'; '2' => '₂'; '3' => '₃'; '4' => '₄'
+    '5' => '₅'; '6' => '₆'; '7' => '₇'; '8' => '₈'; '9' => '₉'; _ => c
+
 private
 superscript : String -> String
 superscript = pack . map sup . unpack where
@@ -201,7 +209,8 @@ prettyTArg dnames tnames s =
 
 private
 prettyDArg : {opts : _} -> BContext d -> Dim d -> Eff Pretty (Doc opts)
-prettyDArg dnames p = [|atD <+> withPrec Arg (prettyDim dnames p)|]
+prettyDArg dnames p =
+  map (text "@" <+>) $ withPrec Arg $ prettyDim dnames p
 
 private
 splitApps : Elim d n -> (Elim d n, List (Either (Dim d) (Term d n)))
@@ -229,6 +238,7 @@ prettyDTApps dnames tnames f xs = do
 private
 record CaseArm opts d n where
   constructor MkCaseArm
+  {0 dinner, ninner : Nat}
   pat    : Doc opts
   dbinds : BTelescope d dinner -- 🍴
   tbinds : BTelescope n ninner
@@ -241,11 +251,12 @@ parameters {opts : LayoutOpts} (dnames : BContext d) (tnames : BContext n)
     body <- withPrec Outer $ assert_total
             prettyTerm (dnames . dbinds) (tnames . tbinds) body
     header <- (pat <++>) <$> darrowD
-    pure $ ifMultiline (header <++> body) (vsep [header, !(indentD body)])
+    pure $ hsep [header, body] <|> vsep [header, !(indentD body)]
 
   private
-  prettyCaseBody : List (CaseArm opts d n) -> Eff Pretty (List (Doc opts))
-  prettyCaseBody xs = traverse prettyCaseArm xs
+  prettyCaseBody : List (CaseArm opts d n) -> Eff Pretty (Doc opts)
+  prettyCaseBody xs =
+    braces . separateTight !semiD =<< traverse prettyCaseArm xs
 
 private
 prettyCompPat : {opts : _} -> DimConst -> BindName -> Eff Pretty (Doc opts)
@@ -272,12 +283,16 @@ layoutComp typq val r arms = do
       [typq, [val, r <++> lb], map (indent ind) arms, [rb]])
 
 
+export
+prettyTag : {opts : _} -> String -> Eff Pretty (Doc opts)
+prettyTag tag = hl Tag $ text $ "'" ++ quoteTag tag
+
 export
 prettyEnum : {opts : _} -> List String -> Eff Pretty (Doc opts)
 prettyEnum cases =
   tightBraces =<<
   fillSeparateTight !commaD <$>
-  traverse (hl Constant . Doc.text . quoteTag) cases
+  traverse (hl Tag . Doc.text . quoteTag) cases
 
 private
 prettyCaseRet : {opts : _} ->
@@ -288,7 +303,7 @@ prettyCaseRet dnames tnames body = withPrec Outer $ case body of
   S [< x] (Y tm) => do
     header <- [|prettyTBind x <++> darrowD|]
     body   <- assert_total prettyTerm dnames (tnames :< x) tm
-    hangDSingle header body
+    pure $ hsep [header, body] <|> vsep [header, !(indentD body)]
 
 private
 prettyCase_ : {opts : _} ->
@@ -296,16 +311,10 @@ prettyCase_ : {opts : _} ->
               Doc opts -> Elim d n -> ScopeTerm d n -> List (CaseArm opts d n) ->
               Eff Pretty (Doc opts)
 prettyCase_ dnames tnames intro head ret body = do
-  head   <- withPrec Outer $ assert_total prettyElim dnames tnames head
-  ret    <- prettyCaseRet dnames tnames ret
-  bodys  <- prettyCaseBody dnames tnames body
-  return <- returnD; of_ <- ofD
-  lb     <- hl Delim "{"; rb <- hl Delim "}"; semi <- semiD
-  ind    <- askAt INDENT
-  parensIfM Outer $ ifMultiline
-    (hsep [intro, head, return, ret, of_, lb, hseparateTight semi bodys, rb])
-    (vsep [intro <++> head, return <++> ret, of_ <++> lb,
-           indent ind $ vseparateTight semi bodys, rb])
+  head <- assert_total prettyElim dnames tnames head
+  ret  <- prettyCaseRet dnames tnames ret
+  body <- prettyCaseBody dnames tnames body
+  parensIfM Outer $ sep [intro <++> head, !returnD <++> ret, !ofD <++> body]
 
 private
 prettyCase : {opts : _} ->
@@ -316,62 +325,6 @@ prettyCase dnames tnames qty head ret body =
   prettyCase_ dnames tnames ![|caseD <+> prettyQty qty|] head ret body
 
 
-private
-LetBinder : Nat -> Nat -> Type
-LetBinder d n = (Qty, BindName, Elim d n)
-
-private
-LetExpr : Nat -> Nat -> Nat -> Type
-LetExpr d n n' = (Telescope (LetBinder d) n n', Term d n')
-
--- [todo] factor out this and the untyped version somehow
-export
-splitLet : Telescope (LetBinder d) n n' -> Term d n' -> Exists (LetExpr d n)
-splitLet ys t@(Let qty rhs body _) =
-  splitLet (ys :< (qty, body.name, rhs)) (assert_smaller t body.term)
-splitLet ys t =
-  Evidence _ (ys, t)
-
-private covering
-prettyLets : {opts : LayoutOpts} ->
-             BContext d -> BContext a -> Telescope (LetBinder d) a b ->
-             Eff Pretty (SnocList (Doc opts))
-prettyLets dnames xs lets = snd <$> go lets where
-  peelAnn : forall d, n. Elim d n -> Maybe (Term d n, Term d n)
-  peelAnn (Ann tm ty _) = Just (tm, ty)
-  peelAnn e             = Nothing
-
-  letHeader : Qty -> BindName -> Eff Pretty (Doc opts)
-  letHeader qty x = do
-    lett <- [|letD <+> prettyQty qty|]
-    x    <- prettyTBind x
-    pure $ lett <++> x
-
-  letBody : forall n. BContext n ->
-            Doc opts -> Elim d n -> Eff Pretty (Doc opts)
-  letBody tnames hdr e = case peelAnn e of
-    Just (tm, ty) => do
-      ty <- withPrec Outer $ assert_total prettyTerm dnames tnames ty
-      tm <- withPrec Outer $ assert_total prettyTerm dnames tnames tm
-      colon <- colonD; eq <- cstD; d <- askAt INDENT
-      pure $ hangSingle d (hangSingle d hdr (colon <++> ty)) (eq <++> tm)
-    Nothing => do
-      e <- withPrec Outer $ assert_total prettyElim dnames tnames e
-      eq <- cstD; d <- askAt INDENT
-      inn <- inD
-      pure $ ifMultiline
-        (hsep [hdr, eq, e, inn])
-        (vsep [hdr, indent d $ hsep [eq, e, inn]])
-
-  go : forall b. Telescope (LetBinder d) a b ->
-       Eff Pretty (BContext b, SnocList (Doc opts))
-  go [<] = pure (xs, [<])
-  go (lets :< (qty, x, rhs)) = do
-    (ys, docs) <- go lets
-    doc        <- letBody ys !(letHeader qty x) rhs
-    pure (ys :< x, docs :< doc)
-
-
 private
 isDefaultDir : Dim d -> Dim d -> Bool
 isDefaultDir (K Zero _) (K One _) = True
@@ -389,16 +342,16 @@ prettyTyCasePat : {opts : _} ->
                   (k : TyConKind) -> BContext (arity k) ->
                   Eff Pretty (Doc opts)
 prettyTyCasePat KTYPE [<] = typeD
-prettyTyCasePat KIOState [<] = ioStateD
 prettyTyCasePat KPi [< a, b] =
   parens . hsep =<< sequence [prettyTBind a, arrowD, prettyTBind b]
 prettyTyCasePat KSig [< a, b] =
   parens . hsep =<< sequence [prettyTBind a, timesD, prettyTBind b]
+prettyTyCasePat KW [< a, b] =
+  parens . hsep =<< sequence [prettyTBind a, triD, prettyTBind b]
 prettyTyCasePat KEnum [<] = hl Syntax $ text "{}"
 prettyTyCasePat KEq [< a0, a1, a, l, r] =
   hsep <$> sequence (eqD :: map prettyTBind [a0, a1, a, l, r])
 prettyTyCasePat KNat [<] = natD
-prettyTyCasePat KString [<] = stringD
 prettyTyCasePat KBOX [< a] = bracks =<< prettyTBind a
 
 
@@ -432,13 +385,13 @@ prettyDisp u = map Just $ hl Universe =<<
   ifUnicode (text $ superscript $ show u) (text $ "^" ++ show u)
 
 
-prettyTerm dnames tnames (TYPE l _) = do
-  type  <- hl Syntax . text =<< ifUnicode "★" "Type"
-  level <- prettyDisp l
-  pure $ maybe type (type <+>) level
-
-prettyTerm dnames tnames (IOState _) =
-  ioStateD
+prettyTerm dnames tnames (TYPE l _) =
+  case !(askAt FLAVOR) of
+    Unicode => do
+      star  <- hl Syntax "★"
+      level <- hl Universe $ text $ superscript $ show l
+      pure $ hcat [star, level]
+    Ascii   => [|hl Syntax "Type" <++> hl Universe (text $ show l)|]
 
 prettyTerm dnames tnames (Pi qty arg res _) =
   parensIfM Outer =<< do
@@ -469,6 +422,21 @@ prettyTerm dnames tnames p@(Pair fst snd _) =
       withPrec Outer $ prettyTerm dnames tnames $ assert_smaller p t
     pure $ separateTight !commaD lines
 
+prettyTerm dnames tnames (W a b _) = do
+  parensIfM W =<< do
+    left <- prettySigBind1 b.name dnames tnames a
+    right <- withPrec InW $
+             prettyTerm dnames (tnames :< b.name) (assert_smaller b b.term)
+    pure $ sep [hsep [left, !triD], right]
+
+prettyTerm dnames tnames (Sup root sub _) = do
+  parensIfM Sup =<< do
+    left  <- withPrec InSup $ prettyTerm dnames tnames root
+    right <- withPrec InSup $ prettyTerm dnames tnames sub
+    pure $
+      hsep [left, !diamondD, right] <|>
+      vsep [hsep [left, !diamondD], !(indentD right)]
+
 prettyTerm dnames tnames (Enum cases _) =
   prettyEnum $ SortedSet.toList cases
 
@@ -483,7 +451,7 @@ prettyTerm dnames tnames (Eq (S _ (N ty)) l r _) =
     pure $ sep [l <++> !eqndD, r <++> !colonD, ty]
 
 prettyTerm dnames tnames (Eq ty l r _) =
-  parensIfM App =<< do
+  parensIfM Arg =<< do
     ty <- prettyTypeLine dnames tnames ty
     l  <- withPrec Arg $ prettyTerm dnames tnames l
     r  <- withPrec Arg $ prettyTerm dnames tnames r
@@ -492,14 +460,25 @@ prettyTerm dnames tnames (Eq ty l r _) =
 prettyTerm dnames tnames s@(DLam {}) =
   prettyLambda dnames tnames s
 
-prettyTerm dnames tnames (NAT _) = natD
-prettyTerm dnames tnames (Nat n _) = hl Syntax $ pshow n
-prettyTerm dnames tnames (Succ p _) =
-  parensIfM App =<<
-  prettyAppD !succD [!(withPrec Arg $ prettyTerm dnames tnames p)]
+prettyTerm dnames tnames (Nat _) = natD
+prettyTerm dnames tnames (Zero _) = hl Syntax "0"
+prettyTerm dnames tnames (Succ p _) = do
+  s <- succD
+  either (succ s) prettyNat =<< tryToNat s p
+where
+  succ : Doc opts -> Doc opts -> Eff Pretty (Doc opts)
+  succ s t = prettyAppD s [t]
 
-prettyTerm dnames tnames (STRING _) = stringD
-prettyTerm dnames tnames (Str s _) = prettyStrLit s
+  tryToNat : Doc opts -> Term d n -> Eff Pretty (Either (Doc opts) Nat)
+  tryToNat s t with (pushSubsts' t)
+    _ | Zero _   = pure $ Right 0
+    _ | Succ d _ = bitraverse (succ s) (pure . S) =<<
+                   tryToNat s (assert_smaller t d)
+    _ | t'       = map Left . withPrec Arg $
+                   prettyTerm dnames tnames $ assert_smaller t t'
+
+  prettyNat : Nat -> Eff Pretty (Doc opts)
+  prettyNat = hl Syntax . text . show . S
 
 prettyTerm dnames tnames (BOX qty ty _) =
   bracks . hcat =<<
@@ -509,18 +488,7 @@ prettyTerm dnames tnames (BOX qty ty _) =
 prettyTerm dnames tnames (Box val _) =
   bracks =<< withPrec Outer (prettyTerm dnames tnames val)
 
-prettyTerm dnames tnames (Let qty rhs body _) = do
-  let Evidence _ (lets, body) = splitLet [< (qty, body.name, rhs)] body.term
-  heads <- prettyLets dnames tnames lets
-  let tnames = tnames . map (\(_, x, _) => x) lets
-  body <- withPrec Outer $ assert_total prettyTerm dnames tnames body
-  let lines = toList $ heads :< body
-  pure $ ifMultiline (hsep lines) (vsep lines)
-
-prettyTerm dnames tnames (E e) =
-  case the (Elim d n) (pushSubsts' e) of
-    Ann tm _ _ => assert_total prettyTerm dnames tnames tm
-    _          => assert_total prettyElim dnames tnames e
+prettyTerm dnames tnames (E e) = prettyElim dnames tnames e
 
 prettyTerm dnames tnames t0@(CloT (Sub t ph)) =
   prettyTerm dnames tnames $ assert_smaller t0 $ pushSubstsWith' id ph t
@@ -547,15 +515,15 @@ prettyElim dnames tnames (CasePair qty pair ret body _) = do
   prettyCase dnames tnames qty pair ret
     [MkCaseArm pat [<] [< x, y] body.term]
 
-prettyElim dnames tnames (Fst pair _) =
-  parensIfM App =<< do
-    pair <- prettyTArg dnames tnames (E pair)
-    prettyAppD !fstD [pair]
-
-prettyElim dnames tnames (Snd pair _) =
-  parensIfM App =<< do
-    pair <- prettyTArg dnames tnames (E pair)
-    prettyAppD !sndD [pair]
+prettyElim dnames tnames (CaseW qty qtyIH tree ret body _) = do
+  let [< t, r, ih] = body.names
+  pat0 <- hsep <$> sequence [prettyTBind t, diamondD, prettyTBind r]
+  ihpat <- map hcat $ sequence [prettyQty qtyIH, dotD, prettyTBind ih]
+  pat <- if ih.name == Unused
+         then pure pat0
+         else pure $ hsep [pat0 <+> !commaD, ihpat]
+  let arm = MkCaseArm pat [<] [< t, r, ih] body.term
+  prettyCase dnames tnames qty tree ret [arm]
 
 prettyElim dnames tnames (CaseEnum qty tag ret arms _) = do
   arms <- for (SortedMap.toList arms) $ \(tag, body) =>
@@ -567,7 +535,7 @@ prettyElim dnames tnames (CaseNat qty qtyIH nat ret zero succ _) = do
       [< p, ih] = succ.names
   spat0 <- [|succD <++> prettyTBind p|]
   ihpat0 <- map hcat $ sequence [prettyQty qtyIH, dotD, prettyTBind ih]
-  spat <- if ih.val == Unused
+  spat <- if ih.name == Unused
           then pure spat0
           else pure $ hsep [spat0 <+> !commaD, ihpat0]
   let sarm = MkCaseArm spat [<] [< p, ih] succ.term
@@ -583,31 +551,35 @@ prettyElim dnames tnames e@(DApp {}) =
   prettyDTApps dnames tnames f xs
 
 prettyElim dnames tnames (Ann tm ty _) =
-  case the (Term d n) (pushSubsts' tm) of
-    E e => assert_total prettyElim dnames tnames e
-    _   => do
-      tm <- withPrec AnnL  $ assert_total prettyTerm dnames tnames tm
-      ty <- withPrec Outer $ assert_total prettyTerm dnames tnames ty
-      parensIfM Outer =<< hangDSingle (tm <++> !annD) ty
+  parensIfM Outer =<<
+    hangDSingle !(withPrec AnnL  [|prettyTerm dnames tnames tm <++> annD|])
+                !(withPrec Outer (prettyTerm dnames tnames ty))
 
 prettyElim dnames tnames (Coe ty p q val _) =
-  parensIfM App =<< do
-    ty  <- prettyTypeLine dnames tnames ty
-    p   <- prettyDArg dnames p
-    q   <- prettyDArg dnames q
-    val <- prettyTArg dnames tnames val
-    prettyAppD !coeD [ty, sep [p, q], val]
+  parensIfM App =<<
+    if isDefaultDir p q then do
+      ty  <- prettyTypeLine dnames tnames ty
+      val <- prettyTArg dnames tnames val
+      prettyAppD !coeD [ty, val]
+    else do
+      ty  <- prettyTypeLine dnames tnames ty
+      p   <- prettyDArg dnames p
+      q   <- prettyDArg dnames q
+      val <- prettyTArg dnames tnames val
+      prettyAppD !coeD [ty, sep [p, q], val]
 
 prettyElim dnames tnames e@(Comp ty p q val r zero one _) =
   parensIfM App =<< do
-    ty   <- assert_total $ prettyTypeLine dnames tnames $ SN ty
+    ty   <- prettyTypeLine dnames tnames $ assert_smaller e $ SN ty
     pq   <- sep <$> sequence [prettyDArg dnames p, prettyDArg dnames q]
     val  <- prettyTArg dnames tnames val
     r    <- prettyDArg dnames r
     arm0 <- [|prettyCompArm dnames tnames Zero zero <+> semiD|]
     arm1 <- prettyCompArm dnames tnames One one
     ind  <- askAt INDENT
-    layoutComp [ty, pq] val r [arm0, arm1]
+    if isDefaultDir p q
+       then layoutComp [ty]     val r [arm0, arm1]
+       else layoutComp [ty, pq] val r [arm0, arm1]
 
 prettyElim dnames tnames (TypeCase ty ret arms def _) = do
   arms <- for (toList arms) $ \(k ** body) => do
diff --git a/lib/Quox/Syntax/Term/Subst.idr b/lib/Quox/Syntax/Term/Subst.idr
index 67927c3..eceffec 100644
--- a/lib/Quox/Syntax/Term/Subst.idr
+++ b/lib/Quox/Syntax/Term/Subst.idr
@@ -56,12 +56,12 @@ namespace DSubst.DScopeTermN
   (//) : {s : Nat} ->
          DScopeTermN s d1 n -> Lazy (DSubst d1 d2) ->
          DScopeTermN s d2 n
-  S ns (Y body) // th = S ns $ Y $ body // pushN s (locs $ toList' ns) th
+  S ns (Y body) // th = S ns $ Y $ body // pushN s th body.loc
   S ns (N body) // th = S ns $ N $ body // th
 
 
-export %inline FromVar (Elim d) where fromVarLoc = B
-export %inline FromVar (Term d) where fromVarLoc = E .: fromVarLoc
+export %inline FromVar (Elim d) where fromVar = B
+export %inline FromVar (Term d) where fromVar = E .: fromVar
 
 
 ||| does the minimal reasonable work:
@@ -104,7 +104,7 @@ namespace ScopeTermN
   (//) : {s : Nat} ->
          ScopeTermN s d n1 -> Lazy (TSubst d n1 n2) ->
          ScopeTermN s d n2
-  S ns (Y body) // th = S ns $ Y $ body // pushN s (locs $ toList' ns) th
+  S ns (Y body) // th = S ns $ Y $ body // pushN s th body.loc
   S ns (N body) // th = S ns $ N $ body // th
 
 namespace DScopeTermN
@@ -117,9 +117,6 @@ namespace DScopeTermN
 export %inline CanShift (Term d) where s // by = s // Shift by
 export %inline CanShift (Elim d) where e // by = e // Shift by
 
-export %inline CanShift (flip Term n) where s // by = s // Shift by
-export %inline CanShift (flip Elim n) where e // by = e // Shift by
-
 export %inline
 {s : Nat} -> CanShift (ScopeTermN s d) where
   b // by = b // Shift by
@@ -134,15 +131,6 @@ public export %inline
 dweakT : (by : Nat) -> Term d n -> Term (by + d) n
 dweakT by t = t // shift by
 
-public export %inline
-dweakS : (by : Nat) -> ScopeTermN s d n -> ScopeTermN s (by + d) n
-dweakS by t = t // shift by
-
-public export %inline
-dweakDS : {s : Nat} -> (by : Nat) ->
-          DScopeTermN s d n -> DScopeTermN s (by + d) n
-dweakDS by t = t // shift by
-
 public export %inline
 dweakE : (by : Nat) -> Elim d n -> Elim (by + d) n
 dweakE by t = t // shift by
@@ -152,40 +140,34 @@ public export %inline
 weakT : (by : Nat) -> Term d n -> Term d (by + n)
 weakT by t = t // shift by
 
-public export %inline
-weakS : {s : Nat} -> (by : Nat) -> ScopeTermN s d n -> ScopeTermN s d (by + n)
-weakS by t = t // shift by
-
-public export %inline
-weakDS : {s : Nat} -> (by : Nat) ->
-         DScopeTermN s d n -> DScopeTermN s d (by + n)
-weakDS by t = t // shift by
-
 public export %inline
 weakE : (by : Nat) -> Elim d n -> Elim d (by + n)
 weakE by t = t // shift by
 
 
-parameters {auto _ : CanShift f} {s : Nat}
-  export %inline
-  getTerm : ScopedBody s f n -> f (s + n)
-  getTerm (Y b) = b
-  getTerm (N b) = b // fromNat s
+parameters {s : Nat}
+  namespace ScopeTermBody
+    public export %inline
+    (.term) : ScopedBody s (Term d) n -> Term d (s + n)
+    (Y b).term = b
+    (N b).term = weakT s b
 
-  export %inline
-  (.term) : Scoped s f n -> f (s + n)
-  t.term = getTerm t.body
+  namespace ScopeTermN
+    public export %inline
+    (.term) : ScopeTermN s d n -> Term d (s + n)
+    t.term = t.body.term
 
-namespace ScopeTermBody
-  export %inline
-  getTerm0 : ScopedBody 0 f n -> f n
-  getTerm0 (Y b) = b
-  getTerm0 (N b) = b
+  namespace DScopeTermBody
+    public export %inline
+    (.term) : ScopedBody s (\d => Term d n) d -> Term (s + d) n
+    (Y b).term = b
+    (N b).term = dweakT s b
+
+  namespace DScopeTermN
+    public export %inline
+    (.term) : DScopeTermN s d n -> Term (s + d) n
+    t.term = t.body.term
 
-namespace ScopeTermN
-  export %inline
-  (.term0) : Scoped 0 f n -> f n
-  t.term0 = getTerm0 t.body
 
 export %inline
 subN : ScopeTermN s d n -> SnocVect s (Elim d n) -> Term d n
@@ -207,19 +189,18 @@ dsub1 t p = dsubN t [< p]
 
 
 public export %inline
-(.zero) : (body : DScopeTerm d n) -> {default body.loc loc : Loc} -> Term d n
-body.zero = dsub1 body $ K Zero loc
+(.zero) : DScopeTerm d n -> Term d n
+body.zero = dsub1 body $ K Zero body.loc
 
 public export %inline
-(.one) : (body : DScopeTerm d n) -> {default body.loc loc : Loc} -> Term d n
-body.one = dsub1 body $ K One loc
+(.one) : DScopeTerm d n -> Term d n
+body.one = dsub1 body $ K One body.loc
 
 
 public export
 0 CloTest : TermLike -> Type
 CloTest tm = forall d, n. tm d n -> Bool
 
-public export
 interface PushSubsts (0 tm : TermLike) (0 isClo : CloTest tm) | tm where
   pushSubstsWith : DSubst d1 d2 -> TSubst d2 n1 n2 ->
                    tm d1 n1 -> Subset (tm d2 n2) (No . isClo)
@@ -267,118 +248,85 @@ mutual
   isCloE (DCloE {}) = True
   isCloE _          = False
 
-export
-PushSubsts Elim Subst.isCloE where
-  pushSubstsWith th ph (F x u loc) =
-    nclo $ F x u loc
-  pushSubstsWith th ph (B i loc) =
-    let res = getLoc ph i loc in
-    case nchoose $ isCloE res of
-      Left  yes => assert_total pushSubsts res
-      Right no  => Element res no
-  pushSubstsWith th ph (App f s loc) =
-    nclo $ App (f // th // ph) (s // th // ph) loc
-  pushSubstsWith th ph (CasePair pi p r b loc) =
-    nclo $ CasePair pi (p // th // ph) (r // th // ph) (b // th // ph) loc
-  pushSubstsWith th ph (Fst pair loc) =
-    nclo $ Fst (pair // th // ph) loc
-  pushSubstsWith th ph (Snd pair loc) =
-    nclo $ Snd (pair // th // ph) loc
-  pushSubstsWith th ph (CaseEnum pi t r arms loc) =
-    nclo $ CaseEnum pi (t // th // ph) (r // th // ph)
-             (map (\b => b // th // ph) arms) loc
-  pushSubstsWith th ph (CaseNat pi pi' n r z s loc) =
-    nclo $ CaseNat pi pi' (n // th // ph) (r // th // ph)
-             (z // th // ph) (s // th // ph) loc
-  pushSubstsWith th ph (CaseBox pi x r b loc) =
-    nclo $ CaseBox pi (x // th // ph) (r // th // ph) (b // th // ph) loc
-  pushSubstsWith th ph (DApp f d loc) =
-    nclo $ DApp (f // th // ph) (d // th) loc
-  pushSubstsWith th ph (Ann s a loc) =
-    nclo $ Ann (s // th // ph) (a // th // ph) loc
-  pushSubstsWith th ph (Coe ty p q val loc) =
-    nclo $ Coe (ty // th // ph) (p // th) (q // th) (val // th // ph) loc
-  pushSubstsWith th ph (Comp ty p q val r zero one loc) =
-    nclo $ Comp (ty // th // ph) (p // th) (q // th)
-                (val // th // ph) (r // th)
-                (zero // th // ph) (one // th // ph) loc
-  pushSubstsWith th ph (TypeCase ty ret arms def loc) =
-    nclo $ TypeCase (ty // th // ph) (ret  // th // ph)
-      (map (\t => t // th // ph) arms) (def // th // ph) loc
-  pushSubstsWith th ph (CloE (Sub e ps)) =
-    pushSubstsWith th (comp th ps ph) e
-  pushSubstsWith th ph (DCloE (Sub e ps)) =
-    pushSubstsWith (ps . th) ph e
+mutual
+  export
+  PushSubsts Term Subst.isCloT where
+    pushSubstsWith th ph (TYPE l loc) =
+      nclo $ TYPE l loc
+    pushSubstsWith th ph (Pi qty a body loc) =
+      nclo $ Pi qty (a // th // ph) (body // th // ph) loc
+    pushSubstsWith th ph (Lam body loc) =
+      nclo $ Lam (body // th // ph) loc
+    pushSubstsWith th ph (Sig a b loc) =
+      nclo $ Sig (a // th // ph) (b // th // ph) loc
+    pushSubstsWith th ph (Pair s t loc) =
+      nclo $ Pair (s // th // ph) (t // th // ph) loc
+    pushSubstsWith th ph (W a b loc) =
+      nclo $ W (a // th // ph) (b // th // ph) loc
+    pushSubstsWith th ph (Sup s t loc) =
+      nclo $ Sup (s // th // ph) (t // th // ph) loc
+    pushSubstsWith th ph (Enum tags loc) =
+      nclo $ Enum tags loc
+    pushSubstsWith th ph (Tag tag loc) =
+      nclo $ Tag tag loc
+    pushSubstsWith th ph (Eq ty l r loc) =
+      nclo $ Eq (ty // th // ph) (l // th // ph) (r // th // ph) loc
+    pushSubstsWith th ph (DLam body loc) =
+      nclo $ DLam (body // th // ph) loc
+    pushSubstsWith _ _ (Nat loc) =
+      nclo $ Nat loc
+    pushSubstsWith _ _ (Zero loc) =
+      nclo $ Zero loc
+    pushSubstsWith th ph (Succ n loc) =
+      nclo $ Succ (n // th // ph) loc
+    pushSubstsWith th ph (BOX pi ty loc) =
+      nclo $ BOX pi (ty // th // ph) loc
+    pushSubstsWith th ph (Box val loc) =
+      nclo $ Box (val // th // ph) loc
+    pushSubstsWith th ph (E e) =
+      let Element e nc = pushSubstsWith th ph e in nclo $ E e
+    pushSubstsWith th ph (CloT (Sub s ps)) =
+      pushSubstsWith th (comp th ps ph) s
+    pushSubstsWith th ph (DCloT (Sub s ps)) =
+      pushSubstsWith (ps . th) ph s
 
-export
-PushSubsts Term Subst.isCloT where
-  pushSubstsWith th ph (TYPE l loc) =
-    nclo $ TYPE l loc
-  pushSubstsWith th ph (IOState loc) =
-    nclo $ IOState loc
-  pushSubstsWith th ph (Pi qty a body loc) =
-    nclo $ Pi qty (a // th // ph) (body // th // ph) loc
-  pushSubstsWith th ph (Lam body loc) =
-    nclo $ Lam (body // th // ph) loc
-  pushSubstsWith th ph (Sig a b loc) =
-    nclo $ Sig (a // th // ph) (b // th // ph) loc
-  pushSubstsWith th ph (Pair s t loc) =
-    nclo $ Pair (s // th // ph) (t // th // ph) loc
-  pushSubstsWith th ph (Enum tags loc) =
-    nclo $ Enum tags loc
-  pushSubstsWith th ph (Tag tag loc) =
-    nclo $ Tag tag loc
-  pushSubstsWith th ph (Eq ty l r loc) =
-    nclo $ Eq (ty // th // ph) (l // th // ph) (r // th // ph) loc
-  pushSubstsWith th ph (DLam body loc) =
-    nclo $ DLam (body // th // ph) loc
-  pushSubstsWith _ _ (NAT loc) =
-    nclo $ NAT loc
-  pushSubstsWith _ _ (Nat n loc) =
-    nclo $ Nat n loc
-  pushSubstsWith th ph (Succ n loc) =
-    nclo $ Succ (n // th // ph) loc
-  pushSubstsWith _ _ (STRING loc) =
-    nclo $ STRING loc
-  pushSubstsWith _ _ (Str s loc) =
-    nclo $ Str s loc
-  pushSubstsWith th ph (BOX pi ty loc) =
-    nclo $ BOX pi (ty // th // ph) loc
-  pushSubstsWith th ph (Box val loc) =
-    nclo $ Box (val // th // ph) loc
-  pushSubstsWith th ph (E e) =
-    let Element e nc = pushSubstsWith th ph e in nclo $ E e
-  pushSubstsWith th ph (Let qty rhs body loc) =
-    nclo $ Let qty (rhs // th // ph) (body // th // ph) loc
-  pushSubstsWith th ph (CloT (Sub s ps)) =
-    pushSubstsWith th (comp th ps ph) s
-  pushSubstsWith th ph (DCloT (Sub s ps)) =
-    pushSubstsWith (ps . th) ph s
-
-
-||| heterogeneous comp, in terms of Comp and Coe
-public export %inline
-CompH' : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
-         (r : Dim d) -> (zero, one : DScopeTerm d n) -> (loc : Loc) -> Elim d n
-CompH' {ty, p, q, val, r, zero, one, loc} =
-  let ty' = SY ty.names $ ty.term // (B VZ ty.name.loc ::: shift 2) in
-  Comp {
-    ty = dsub1 ty q, p, q,
-    val = E $ Coe ty p q val val.loc, r,
-    zero = SY zero.names $ E $
-      Coe ty' (B VZ zero.loc) (weakD 1 q) zero.term zero.loc,
-    one = SY one.names $ E $
-      Coe ty' (B VZ one.loc) (weakD 1 q) one.term one.loc,
-    loc
-  }
-
-||| heterogeneous comp, in terms of Comp and Coe
-public export %inline
-CompH : (i : BindName) -> (ty : Term (S d) n) ->
-        (p, q : Dim d) -> (val : Term d n) -> (r : Dim d) ->
-        (j0 : BindName) -> (zero : Term (S d) n) ->
-        (j1 : BindName) -> (one : Term (S d) n) ->
-        (loc : Loc) -> Elim d n
-CompH {i, ty, p, q, val, r, j0, zero, j1, one, loc} =
-  CompH' {ty = SY [< i] ty, p, q, val, r,
-          zero = SY [< j0] zero, one = SY [< j1] one, loc}
+  export
+  PushSubsts Elim Subst.isCloE where
+    pushSubstsWith th ph (F x u loc) =
+      nclo $ F x u loc
+    pushSubstsWith th ph (B i loc) =
+      let res = getLoc ph i loc in
+      case nchoose $ isCloE res of
+        Left  yes => assert_total pushSubsts res
+        Right no  => Element res no
+    pushSubstsWith th ph (App f s loc) =
+      nclo $ App (f // th // ph) (s // th // ph) loc
+    pushSubstsWith th ph (CasePair pi p r b loc) =
+      nclo $ CasePair pi (p // th // ph) (r // th // ph) (b // th // ph) loc
+    pushSubstsWith th ph (CaseW pi pi' e r b loc) =
+      nclo $ CaseW pi pi' (e // th // ph) (r // th // ph) (b // th // ph) loc
+    pushSubstsWith th ph (CaseEnum pi t r arms loc) =
+      nclo $ CaseEnum pi (t // th // ph) (r // th // ph)
+               (map (\b => b // th // ph) arms) loc
+    pushSubstsWith th ph (CaseNat pi pi' n r z s loc) =
+      nclo $ CaseNat pi pi' (n // th // ph) (r // th // ph)
+               (z // th // ph) (s // th // ph) loc
+    pushSubstsWith th ph (CaseBox pi x r b loc) =
+      nclo $ CaseBox pi (x // th // ph) (r // th // ph) (b // th // ph) loc
+    pushSubstsWith th ph (DApp f d loc) =
+      nclo $ DApp (f // th // ph) (d // th) loc
+    pushSubstsWith th ph (Ann s a loc) =
+      nclo $ Ann (s // th // ph) (a // th // ph) loc
+    pushSubstsWith th ph (Coe ty p q val loc) =
+      nclo $ Coe (ty // th // ph) (p // th) (q // th) (val // th // ph) loc
+    pushSubstsWith th ph (Comp ty p q val r zero one loc) =
+      nclo $ Comp (ty // th // ph) (p // th) (q // th)
+                  (val // th // ph) (r // th)
+                  (zero // th // ph) (one // th // ph) loc
+    pushSubstsWith th ph (TypeCase ty ret arms def loc) =
+      nclo $ TypeCase (ty // th // ph) (ret  // th // ph)
+        (map (\t => t // th // ph) arms) (def // th // ph) loc
+    pushSubstsWith th ph (CloE (Sub e ps)) =
+      pushSubstsWith th (comp th ps ph) e
+    pushSubstsWith th ph (DCloE (Sub e ps)) =
+      pushSubstsWith (ps . th) ph e
diff --git a/lib/Quox/Syntax/Term/Tighten.idr b/lib/Quox/Syntax/Term/Tighten.idr
new file mode 100644
index 0000000..8aaaa1a
--- /dev/null
+++ b/lib/Quox/Syntax/Term/Tighten.idr
@@ -0,0 +1,372 @@
+module Quox.Syntax.Term.Tighten
+
+import Quox.Syntax.Term.Base
+import Quox.Syntax.Term.Subst
+import public Quox.OPE
+import Quox.No
+
+%default total
+
+
+export
+Tighten Dim where
+  tighten p (K e loc) = pure $ K e loc
+  tighten p (B i loc) = B <$> tighten p i <*> pure loc
+
+export
+tightenScope : (forall m, n. OPE m n -> f n -> Maybe (f m)) ->
+               {s : Nat} -> OPE m n -> Scoped s f n -> Maybe (Scoped s f m)
+tightenScope f p (S names (Y body)) = SY names <$> f (keepN s p) body
+tightenScope f p (S names (N body)) = S names . N <$> f p body
+
+export
+tightenDScope : {0 f : Nat -> Nat -> Type} ->
+                (forall m, n, k. OPE m n -> f n k -> Maybe (f m k)) ->
+                OPE m n -> Scoped s (f n) k -> Maybe (Scoped s (f m) k)
+tightenDScope f p (S names (Y body)) = SY names <$> f p body
+tightenDScope f p (S names (N body)) = S names . N <$> f p body
+
+
+mutual
+  private
+  tightenT : OPE n1 n2 -> Term d n2 -> Maybe (Term d n1)
+  tightenT p s =
+    let Element s' _ = pushSubsts s in
+    tightenT' p $ assert_smaller s s'
+
+  private
+  tightenE : OPE n1 n2 -> Elim d n2 -> Maybe (Elim d n1)
+  tightenE p e =
+    let Element e' _ = pushSubsts e in
+    tightenE' p $ assert_smaller e e'
+
+  private
+  tightenT' : OPE n1 n2 -> (t : Term d n2) -> (0 nt : NotClo t) =>
+              Maybe (Term d n1)
+  tightenT' p (TYPE l loc) = pure $ TYPE l loc
+  tightenT' p (Pi qty arg res loc) =
+    Pi qty <$> tightenT p arg <*> tightenS p res <*> pure loc
+  tightenT' p (Lam body loc) =
+    Lam <$> tightenS p body <*> pure loc
+  tightenT' p (Sig fst snd loc) =
+    Sig <$> tightenT p fst <*> tightenS p snd <*> pure loc
+  tightenT' p (Pair fst snd loc) =
+    Pair <$> tightenT p fst <*> tightenT p snd <*> pure loc
+  tightenT' p (W shape body loc) =
+    W <$> tightenT p shape <*> tightenS p body <*> pure loc
+  tightenT' p (Sup root sub loc) =
+    Sup <$> tightenT p root <*> tightenT p sub <*> pure loc
+  tightenT' p (Enum cases loc) =
+    pure $ Enum cases loc
+  tightenT' p (Tag tag loc) =
+    pure $ Tag tag loc
+  tightenT' p (Eq ty l r loc) =
+    Eq <$> tightenDS p ty <*> tightenT p l <*> tightenT p r <*> pure loc
+  tightenT' p (DLam body loc) =
+    DLam <$> tightenDS p body <*> pure loc
+  tightenT' p (Nat loc) =
+    pure $ Nat loc
+  tightenT' p (Zero loc) =
+    pure $ Zero loc
+  tightenT' p (Succ s loc) =
+    Succ <$> tightenT p s <*> pure loc
+  tightenT' p (BOX qty ty loc) =
+    BOX qty <$> tightenT p ty <*> pure loc
+  tightenT' p (Box val loc) =
+    Box <$> tightenT p val <*> pure loc
+  tightenT' p (E e) =
+    assert_total $ E <$> tightenE p e
+
+  private
+  tightenE' : OPE n1 n2 -> (e : Elim d n2) -> (0 ne : NotClo e) =>
+              Maybe (Elim d n1)
+  tightenE' p (F x u loc) =
+    pure $ F x u loc
+  tightenE' p (B i loc) =
+    B <$> tighten p i <*> pure loc
+  tightenE' p (App fun arg loc) =
+    App <$> tightenE p fun <*> tightenT p arg <*> pure loc
+  tightenE' p (CasePair qty pair ret body loc) =
+    CasePair qty <$> tightenE p pair
+                 <*> tightenS p ret
+                 <*> tightenS p body
+                 <*> pure loc
+  tightenE' p (CaseW qty qtyIH tree ret body loc) =
+    CaseW qty qtyIH
+      <$> tightenE p tree
+      <*> tightenS p ret
+      <*> tightenS p body
+      <*> pure loc
+  tightenE' p (CaseEnum qty tag ret arms loc) =
+    CaseEnum qty <$> tightenE p tag
+                 <*> tightenS p ret
+                 <*> traverse (tightenT p) arms
+                 <*> pure loc
+  tightenE' p (CaseNat qty qtyIH nat ret zero succ loc) =
+    CaseNat qty qtyIH
+      <$> tightenE p nat
+      <*> tightenS p ret
+      <*> tightenT p zero
+      <*> tightenS p succ
+      <*> pure loc
+  tightenE' p (CaseBox qty box ret body loc) =
+    CaseBox qty <$> tightenE p box
+                <*> tightenS p ret
+                <*> tightenS p body
+                <*> pure loc
+  tightenE' p (DApp fun arg loc) =
+    DApp <$> tightenE p fun <*> pure arg <*> pure loc
+  tightenE' p (Ann tm ty loc) =
+    Ann <$> tightenT p tm <*> tightenT p ty <*> pure loc
+  tightenE' p (Coe ty q0 q1 val loc) =
+    Coe <$> tightenDS p ty
+        <*> pure q0 <*> pure q1
+        <*> tightenT p val
+        <*> pure loc
+  tightenE' p (Comp ty q0 q1 val r zero one loc) =
+    Comp <$> tightenT p ty
+         <*> pure q0 <*> pure q1
+         <*> tightenT p val
+         <*> pure r
+         <*> tightenDS p zero
+         <*> tightenDS p one
+         <*> pure loc
+  tightenE' p (TypeCase ty ret arms def loc) =
+    TypeCase <$> tightenE p ty
+             <*> tightenT p ret
+             <*> traverse (tightenS p) arms
+             <*> tightenT p def
+             <*> pure loc
+
+  export
+  tightenS : {s : Nat} -> OPE m n ->
+             ScopeTermN s f n -> Maybe (ScopeTermN s f m)
+  tightenS = assert_total $ tightenScope tightenT
+
+  export
+  tightenDS : OPE m n -> DScopeTermN s f n -> Maybe (DScopeTermN s f m)
+  tightenDS = assert_total $ tightenDScope tightenT {f = \n, d => Term d n}
+
+export Tighten (Elim d) where tighten p e = tightenE p e
+export Tighten (Term d) where tighten p t = tightenT p t
+
+
+mutual
+  export
+  dtightenT : OPE d1 d2 -> Term d2 n -> Maybe (Term d1 n)
+  dtightenT p s =
+    let Element s' _ = pushSubsts s in
+    dtightenT' p $ assert_smaller s s'
+
+  export
+  dtightenE : OPE d1 d2 -> Elim d2 n -> Maybe (Elim d1 n)
+  dtightenE p e =
+    let Element e' _ = pushSubsts e in
+    dtightenE' p $ assert_smaller e e'
+
+  private
+  dtightenT' : OPE d1 d2 -> (t : Term d2 n) -> (0 nt : NotClo t) =>
+               Maybe (Term d1 n)
+  dtightenT' p (TYPE l loc) =
+    pure $ TYPE l loc
+  dtightenT' p (Pi qty arg res loc) =
+    Pi qty <$> dtightenT p arg <*> dtightenS p res <*> pure loc
+  dtightenT' p (Lam body loc) =
+    Lam <$> dtightenS p body <*> pure loc
+  dtightenT' p (Sig fst snd loc) =
+    Sig <$> dtightenT p fst <*> dtightenS p snd <*> pure loc
+  dtightenT' p (Pair fst snd loc) =
+    Pair <$> dtightenT p fst <*> dtightenT p snd <*> pure loc
+  dtightenT' p (W shape body loc) =
+    W <$> dtightenT p shape <*> dtightenS p body <*> pure loc
+  dtightenT' p (Sup root sub loc) =
+    Sup <$> dtightenT p root <*> dtightenT p sub <*> pure loc
+  dtightenT' p (Enum cases loc) =
+    pure $ Enum cases loc
+  dtightenT' p (Tag tag loc) =
+    pure $ Tag tag loc
+  dtightenT' p (Eq ty l r loc) =
+    Eq <$> dtightenDS p ty <*> dtightenT p l <*> dtightenT p r <*> pure loc
+  dtightenT' p (DLam body loc) =
+    DLam <$> dtightenDS p body <*> pure loc
+  dtightenT' p (Nat loc) =
+    pure $ Nat loc
+  dtightenT' p (Zero loc) =
+    pure $ Zero loc
+  dtightenT' p (Succ s loc) =
+    Succ <$> dtightenT p s <*> pure loc
+  dtightenT' p (BOX qty ty loc) =
+    BOX qty <$> dtightenT p ty <*> pure loc
+  dtightenT' p (Box val loc) =
+    Box <$> dtightenT p val <*> pure loc
+  dtightenT' p (E e) =
+    assert_total $ E <$> dtightenE p e
+
+  export
+  dtightenE' : OPE d1 d2 -> (e : Elim d2 n) -> (0 ne : NotClo e) =>
+               Maybe (Elim d1 n)
+  dtightenE' p (F x u loc) =
+    pure $ F x u loc
+  dtightenE' p (B i loc) =
+    pure $ B i loc
+  dtightenE' p (App fun arg loc) =
+    App <$> dtightenE p fun <*> dtightenT p arg <*> pure loc
+  dtightenE' p (CasePair qty pair ret body loc) =
+    CasePair qty <$> dtightenE p pair
+                 <*> dtightenS p ret
+                 <*> dtightenS p body
+                 <*> pure loc
+  dtightenE' p (CaseW qty qtyIH tree ret body loc) =
+    CaseW qty qtyIH
+      <$> dtightenE p tree
+      <*> dtightenS p ret
+      <*> dtightenS p body
+      <*> pure loc
+  dtightenE' p (CaseEnum qty tag ret arms loc) =
+    CaseEnum qty <$> dtightenE p tag
+                 <*> dtightenS p ret
+                 <*> traverse (dtightenT p) arms
+                 <*> pure loc
+  dtightenE' p (CaseNat qty qtyIH nat ret zero succ loc) =
+    CaseNat qty qtyIH
+      <$> dtightenE p nat
+      <*> dtightenS p ret
+      <*> dtightenT p zero
+      <*> dtightenS p succ
+      <*> pure loc
+  dtightenE' p (CaseBox qty box ret body loc) =
+    CaseBox qty <$> dtightenE p box
+                <*> dtightenS p ret
+                <*> dtightenS p body
+                <*> pure loc
+  dtightenE' p (DApp fun arg loc) =
+    DApp <$> dtightenE p fun <*> tighten p arg <*> pure loc
+  dtightenE' p (Ann tm ty loc) =
+    Ann <$> dtightenT p tm <*> dtightenT p ty <*> pure loc
+  dtightenE' p (Coe ty q0 q1 val loc) =
+    [|Coe (dtightenDS p ty) (tighten p q0) (tighten p q1) (dtightenT p val)
+          (pure loc)|]
+  dtightenE' p (Comp ty q0 q1 val r zero one loc) =
+    [|Comp (dtightenT p ty) (tighten p q0) (tighten p q1)
+           (dtightenT p val) (tighten p r)
+           (dtightenDS p zero) (dtightenDS p one) (pure loc)|]
+  dtightenE' p (TypeCase ty ret arms def loc) =
+    [|TypeCase (dtightenE p ty) (dtightenT p ret)
+               (traverse (dtightenS p) arms) (dtightenT p def) (pure loc)|]
+
+  export
+  dtightenS : OPE d1 d2 -> ScopeTermN s d2 n -> Maybe (ScopeTermN s d1 n)
+  dtightenS = assert_total $ tightenDScope dtightenT {f = Term}
+
+  export
+  dtightenDS : {s : Nat} -> OPE d1 d2 ->
+               DScopeTermN s d2 n -> Maybe (DScopeTermN s d1 n)
+  dtightenDS = assert_total $ tightenScope dtightenT
+
+
+export [TermD] Tighten (\d => Term d n) where tighten p t = dtightenT p t
+export [ElimD] Tighten (\d => Elim d n) where tighten p e = dtightenE p e
+
+
+-- versions of SY, etc, that try to tighten and use SN automatically
+
+public export
+ST : Tighten f => {s : Nat} -> BContext s -> f (s + n) -> Scoped s f n
+ST names body =
+  case tightenN s body of
+    Just body => S names $ N body
+    Nothing   => S names $ Y body
+
+public export
+DST : {s : Nat} -> BContext s -> Term (s + d) n -> DScopeTermN s d n
+DST names body =
+  case tightenN @{TermD} s body of
+    Just body => S names $ N body
+    Nothing   => S names $ Y body
+
+public export %inline
+PiT : (qty : Qty) -> (x : BindName) ->
+      (arg : Term d n) -> (res : Term d (S n)) -> (loc : Loc) -> Term d n
+PiT {qty, x, arg, res, loc} = Pi {qty, arg, res = ST [< x] res, loc}
+
+public export %inline
+LamT : (x : BindName) -> (body : Term d (S n)) -> (loc : Loc) -> Term d n
+LamT {x, body, loc} = Lam {body = ST [< x] body, loc}
+
+public export %inline
+SigT : (x : BindName) -> (fst : Term d n) ->
+       (snd : Term d (S n)) -> (loc : Loc) -> Term d n
+SigT {x, fst, snd, loc} = Sig {fst, snd = ST [< x] snd, loc}
+
+public export %inline
+EqT : (i : BindName) -> (ty : Term (S d) n) ->
+      (l, r : Term d n) -> (loc : Loc) -> Term d n
+EqT {i, ty, l, r, loc} = Eq {ty = DST [< i] ty, l, r, loc}
+
+public export %inline
+DLamT : (i : BindName) -> (body : Term (S d) n) -> (loc : Loc) -> Term d n
+DLamT {i, body, loc} = DLam {body = DST [< i] body, loc}
+
+public export %inline
+CoeT : (i : BindName) -> (ty : Term (S d) n) ->
+       (p, q : Dim d) -> (val : Term d n) -> (loc : Loc) -> Elim d n
+CoeT {i, ty, p, q, val, loc} = Coe {ty = DST [< i] ty, p, q, val, loc}
+
+public export %inline
+typeCase1T : Elim d n -> Term d n ->
+             (k : TyConKind) -> BContext (arity k) -> Term d (arity k + n) ->
+             (loc : Loc) ->
+             {default (Nat loc) def : Term d n} ->
+             Elim d n
+typeCase1T ty ret k ns body loc {def} =
+  typeCase ty ret [(k ** ST ns body)] def loc
+
+
+export
+squeeze : {s : Nat} -> ScopeTermN s d n -> ScopeTermN s d n
+squeeze (S names (Y body)) = S names $ maybe (Y body) N $ tightenN s body
+squeeze (S names (N body)) = S names $ N body
+
+export
+dsqueeze : {s : Nat} -> DScopeTermN s d n -> DScopeTermN s d n
+dsqueeze (S names (Y body)) =
+  S names $ maybe (Y body) N $ tightenN s body @{TermD}
+dsqueeze (S names (N body)) = S names $ N body
+
+
+
+public export %inline
+CompH' : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
+         (r : Dim d) -> (zero, one : DScopeTerm d n) -> (loc : Loc) -> Elim d n
+CompH' {ty, p, q, val, r, zero, one, loc} =
+  -- [fixme] maintain location of existing B VZ
+  let ty' = DST ty.names $ ty.term // (B VZ ty.loc ::: shift 2) in
+  Comp {
+    ty = dsub1 ty q, p, q,
+    val = E $ Coe ty p q val val.loc, r,
+    -- [fixme] better locations for these vars?
+    zero = DST zero.names $ E $
+      Coe ty' (B VZ zero.loc) (weakD 1 q) zero.term zero.loc,
+    one = DST one.names $ E $
+      Coe ty' (B VZ one.loc) (weakD 1 q) one.term one.loc,
+    loc
+  }
+
+||| heterogeneous composition, using Comp and Coe (and subst)
+|||
+||| comp [i ⇒ A] @p @q s @r { 0 j ⇒ t₀; 1 j ⇒ t₁ }
+||| ≔
+||| comp [A‹q/i›] @p @q (coe [i ⇒ A] @p @q s) @r {
+|||   0 j ⇒ coe [i ⇒ A] @j @q t₀;
+|||   1 j ⇒ coe [i ⇒ A] @j @q t₁
+||| }
+public export %inline
+CompH : (i : BindName) -> (ty : Term (S d) n) ->
+        (p, q : Dim d) -> (val : Term d n) -> (r : Dim d) ->
+        (j0 : BindName) -> (zero : Term (S d) n) ->
+        (j1 : BindName) -> (one : Term (S d) n) ->
+        (loc : Loc) ->
+        Elim d n
+CompH {i, ty, p, q, val, r, j0, zero, j1, one, loc} =
+  CompH' {ty = DST [< i] ty, p, q, val, r,
+          zero = DST [< j0] zero, one = DST [< j1] one, loc}
diff --git a/lib/Quox/Syntax/Term/TyConKind.idr b/lib/Quox/Syntax/Term/TyConKind.idr
index 298173e..58ed05e 100644
--- a/lib/Quox/Syntax/Term/TyConKind.idr
+++ b/lib/Quox/Syntax/Term/TyConKind.idr
@@ -9,8 +9,7 @@ import Generics.Derive
 
 
 public export
-data TyConKind =
-  KTYPE | KIOState | KPi | KSig | KEnum | KEq | KNat | KString | KBOX
+data TyConKind = KTYPE | KPi | KSig | KW | KEnum | KEq | KNat | KBOX
 %name TyConKind k
 %runElab derive "TyConKind" [Eq.Eq, Ord.Ord, Show.Show, Generic, Meta, DecEq]
 
@@ -26,12 +25,11 @@ allKinds = %runElab do
 ||| in `type-case`, how many variables are bound in this branch
 public export %inline
 arity : TyConKind -> Nat
-arity KTYPE    = 0
-arity KIOState = 0
-arity KPi      = 2
-arity KSig     = 2
-arity KEnum    = 0
-arity KEq      = 5
-arity KNat     = 0
-arity KString  = 0
-arity KBOX     = 1
+arity KTYPE = 0
+arity KPi   = 2
+arity KSig  = 2
+arity KW    = 2
+arity KEnum = 0
+arity KEq   = 5
+arity KNat  = 0
+arity KBOX  = 1
diff --git a/lib/Quox/Var.idr b/lib/Quox/Syntax/Var.idr
similarity index 95%
rename from lib/Quox/Var.idr
rename to lib/Quox/Syntax/Var.idr
index 5466542..28cac7a 100644
--- a/lib/Quox/Var.idr
+++ b/lib/Quox/Syntax/Var.idr
@@ -1,7 +1,8 @@
-module Quox.Var
+module Quox.Syntax.Var
 
 import public Quox.Loc
 import public Quox.Name
+import Quox.OPE
 
 import Data.Nat
 import Data.List
@@ -138,10 +139,9 @@ weakIsSpec p i = toNatInj $ trans (weakCorrect p i) (sym $ weakSpecCorrect p i)
 
 
 public export
-interface FromVar f where %inline fromVarLoc : Var n -> Loc -> f n
+interface FromVar f where %inline fromVar : Var n -> Loc -> f n
 
-
-public export FromVar Var where fromVarLoc x _ = x
+public export FromVar Var where fromVar x _ = x
 
 export
 tabulateV : {0 tm : Nat -> Type} -> (forall n. Var n -> tm n) ->
@@ -289,3 +289,12 @@ decEqFromBool i j =
 %transform "Var.decEq" varDecEq = decEqFromBool
 
 public export %inline DecEq (Var n) where decEq = varDecEq
+
+
+export
+Tighten Var where
+  tighten Id       i      = Just i
+  tighten (Drop p) VZ     = Nothing
+  tighten (Drop p) (VS i) = tighten p i
+  tighten (Keep p) VZ     = Just VZ
+  tighten (Keep p) (VS i) = VS <$> tighten p i
diff --git a/lib/Quox/Typechecker.idr b/lib/Quox/Typechecker.idr
index 3892b27..cc463ed 100644
--- a/lib/Quox/Typechecker.idr
+++ b/lib/Quox/Typechecker.idr
@@ -3,7 +3,6 @@ module Quox.Typechecker
 import public Quox.Typing
 import public Quox.Equal
 import Quox.Displace
-import Quox.Pretty
 
 import Data.List
 import Data.SnocVect
@@ -14,14 +13,25 @@ import Quox.EffExtra
 
 
 public export
-0 TC : List (Type -> Type)
-TC = [ErrorEff, DefsReader, NameGen, Log]
+0 TCEff : List (Type -> Type)
+TCEff = [ErrorEff, DefsReader, NameGen]
+
+public export
+0 TC : Type -> Type
+TC = Eff TCEff
+
+export
+runTCWith : NameSuf -> Definitions -> TC a -> (Either Error a, NameSuf)
+runTCWith = runEqualWith
+
+export
+runTC : Definitions -> TC a -> Either Error a
+runTC = runEqual
 
 
 parameters (loc : Loc)
   export
-  popQs : Has ErrorEff fs => QContext s -> QOutput (s + n) ->
-          Eff fs (QOutput n)
+  popQs : Has ErrorEff fs => QContext s -> QOutput (s + n) -> Eff fs (QOutput n)
   popQs [<]         qout         = pure qout
   popQs (pis :< pi) (qout :< rh) = do expectCompatQ loc rh pi; popQs pis qout
 
@@ -42,23 +52,46 @@ lubs ctx []        = zeroFor ctx
 lubs ctx (x :: xs) = lubs1 $ x ::: xs
 
 
-private
-prettyTermTC : {opts : LayoutOpts} ->
-               TyContext d n -> Term d n -> Eff Pretty (Doc opts)
-prettyTermTC ctx s = prettyTerm ctx.dnames ctx.tnames s
+export
+typecaseTel : (k : TyConKind) -> BContext (arity k) -> Universe ->
+              CtxExtension d n (arity k + n)
+typecaseTel k xs u = case k of
+  KTYPE => [<]
+  KPi   => binaryTyCon xs
+  KSig  => binaryTyCon xs
+  KW    => binaryTyCon xs
+  KEnum => [<]
+  KEq   => eqCon xs
+  KNat  => [<]
+  KBOX  => unaryTyCon xs
+where
+  -- 0.A : ★ᵤ
+  unaryTyCon : BContext 1 -> CtxExtension d n (S n)
+  unaryTyCon [< a] = [< (Zero, a, TYPE u a.loc)]
 
+  -- 0.A : ★ᵤ, 0.B : 0.A → ★ᵤ
+  binaryTyCon : BContext 2 -> CtxExtension d n (2 + n)
+  binaryTyCon [< a, b] =
+    [< (Zero, a, TYPE u a.loc),
+       (Zero, b, Arr Zero (BVT 0 b.loc) (TYPE u b.loc) b.loc)]
+
+  -- 0.A₀ : ★ᵤ, 0.A₁ : ★ᵤ, 0.A : (A₀ ≡ A₁ : ★ᵤ), 0.L : A₀, 0.R : A₁
+  eqCon : BContext 5 -> CtxExtension d n (5 + n)
+  eqCon [< a0, a1, a, l, r] =
+    [< (Zero, a0, TYPE u a0.loc),
+       (Zero, a1, TYPE u a1.loc),
+       (Zero, a,  Eq0 (TYPE u a.loc) (BVT 1 a.loc) (BVT 0 a.loc) a.loc),
+       (Zero, l,  BVT 2 l.loc),
+       (Zero, r,  BVT 2 r.loc)]
+
+||| if a ⋄ b : (x : A) ⊲ B, then b : `supSubTy a A B _`
+||| i.e. ω.B[a∷A/x] → ((x : A) ⊲ B)
+export
+supSubTy : (root, rootTy : Term d n) ->
+           (body : ScopeTerm d n) -> Loc -> Term d n
+supSubTy root rootTy body loc =
+  Arr Any (sub1 body (Ann root rootTy root.loc)) (W rootTy body loc) loc
 
-private
-checkLogs : String -> TyContext d n -> SQty ->
-            Term d n -> Maybe (Term d n) -> Eff TC ()
-checkLogs fun ctx sg subj ty = do
-  let tyDoc = delay $ maybe (text "none") (runPretty . prettyTermTC ctx) ty
-  sayMany "check" subj.loc
-    [10 :> text fun,
-     95 :> hsep ["ctx =",  runPretty $ prettyTyContext ctx],
-     95 :> hsep ["sg =",   runPretty $ prettyQty sg.qty],
-     10 :> hsep ["subj =", runPretty $ prettyTermTC ctx subj],
-     10 :> hsep ["ty =",   tyDoc]]
 
 mutual
   ||| "Ψ | Γ ⊢ σ · s ⇐ A ⊳ Σ"
@@ -71,32 +104,28 @@ mutual
   ||| doing any further work.
   export covering %inline
   check : (ctx : TyContext d n) -> SQty -> Term d n -> Term d n ->
-          Eff TC (CheckResult ctx.dctx n)
-  check ctx sg subj ty =
-    ifConsistentElse ctx.dctx
-      (do checkLogs "check" ctx sg subj (Just ty)
-          checkC ctx sg subj ty)
-      (say "check" 20 subj.loc "check: 0=1")
+          TC (CheckResult ctx.dctx n)
+  check ctx sg subj ty = ifConsistent ctx.dctx $ checkC ctx sg subj ty
 
   ||| "Ψ | Γ ⊢₀ s ⇐ A"
   |||
   ||| `check0 ctx subj ty` checks a term (as `check`) in a zero context.
   export covering %inline
-  check0 : TyContext d n -> Term d n -> Term d n -> Eff TC ()
-  check0 ctx tm ty = ignore $ check ctx SZero tm ty
+  check0 : TyContext d n -> Term d n -> Term d n -> TC ()
+  check0 ctx tm ty = ignore $ check ctx szero tm ty
     -- the output will always be 𝟎 because the subject quantity is 0
 
   ||| `check`, assuming the dimension context is consistent
   export covering %inline
   checkC : (ctx : TyContext d n) -> SQty -> Term d n -> Term d n ->
-           Eff TC (CheckResult' n)
+           TC (CheckResult' n)
   checkC ctx sg subj ty =
-    wrapErr (WhileChecking ctx sg subj ty) $
+    wrapErr (WhileChecking ctx sg.fst subj ty) $
     checkCNoWrap ctx sg subj ty
 
   export covering %inline
   checkCNoWrap : (ctx : TyContext d n) -> SQty -> Term d n -> Term d n ->
-                 Eff TC (CheckResult' n)
+                 TC (CheckResult' n)
   checkCNoWrap ctx sg subj ty =
     let Element subj nc = pushSubsts subj in
     check' ctx sg subj ty
@@ -106,21 +135,16 @@ mutual
   ||| `checkType ctx subj ty` checks a type (in a zero context). sometimes the
   ||| universe doesn't matter, only that a term is _a_ type, so it is optional.
   export covering %inline
-  checkType : TyContext d n -> Term d n -> Maybe Universe -> Eff TC ()
-  checkType ctx subj l = do
-    let univ = TYPE <$> l <*> pure noLoc
-    ignore $ ifConsistentElse ctx.dctx
-      (do checkLogs "checkType" ctx SZero subj univ
-          checkTypeC ctx subj l)
-      (say "check" 20 subj.loc "checkType: 0=1")
+  checkType : TyContext d n -> Term d n -> Maybe Universe -> TC ()
+  checkType ctx subj l = ignore $ ifConsistent ctx.dctx $ checkTypeC ctx subj l
 
   export covering %inline
-  checkTypeC : TyContext d n -> Term d n -> Maybe Universe -> Eff TC ()
+  checkTypeC : TyContext d n -> Term d n -> Maybe Universe -> TC ()
   checkTypeC ctx subj l =
     wrapErr (WhileCheckingTy ctx subj l) $ checkTypeNoWrap ctx subj l
 
   export covering %inline
-  checkTypeNoWrap : TyContext d n -> Term d n -> Maybe Universe -> Eff TC ()
+  checkTypeNoWrap : TyContext d n -> Term d n -> Maybe Universe -> TC ()
   checkTypeNoWrap ctx subj l =
     let Element subj nc = pushSubsts subj in
     checkType' ctx subj l
@@ -134,19 +158,15 @@ mutual
   ||| doing any further work.
   export covering %inline
   infer : (ctx : TyContext d n) -> SQty -> Elim d n ->
-          Eff TC (InferResult ctx.dctx d n)
-  infer ctx sg subj = do
-    ifConsistentElse ctx.dctx
-      (do checkLogs "infer" ctx sg (E subj) Nothing
-          inferC ctx sg subj)
-      (say "check" 20 subj.loc "infer: 0=1")
+          TC (InferResult ctx.dctx d n)
+  infer ctx sg subj = ifConsistent ctx.dctx $ inferC ctx sg subj
 
   ||| `infer`, assuming the dimension context is consistent
   export covering %inline
   inferC : (ctx : TyContext d n) -> SQty -> Elim d n ->
-           Eff TC (InferResult' d n)
+           TC (InferResult' d n)
   inferC ctx sg subj =
-    wrapErr (WhileInferring ctx sg subj) $
+    wrapErr (WhileInferring ctx sg.fst subj) $
       let Element subj nc = pushSubsts subj in
       infer' ctx sg subj
 
@@ -154,37 +174,46 @@ mutual
   private covering
   toCheckType : TyContext d n -> SQty ->
                 (subj : Term d n) -> (0 nc : NotClo subj) => Term d n ->
-                Eff TC (CheckResult' n)
+                TC (CheckResult' n)
   toCheckType ctx sg t ty = do
-    u <- expectTYPE !(askAt DEFS) ctx sg ty.loc ty
-    expectEqualQ t.loc Zero sg.qty
+    u <- expectTYPE !(askAt DEFS) ctx ty.loc ty
+    expectEqualQ t.loc Zero sg.fst
     checkTypeNoWrap ctx t (Just u)
     pure $ zeroFor ctx
 
   private covering
   check' : TyContext d n -> SQty ->
            (subj : Term d n) -> (0 nc : NotClo subj) => Term d n ->
-           Eff TC (CheckResult' n)
+           TC (CheckResult' n)
 
   check' ctx sg t@(TYPE {}) ty = toCheckType ctx sg t ty
 
-  check' ctx sg t@(IOState {}) ty = toCheckType ctx sg t ty
-
   check' ctx sg t@(Pi {}) ty = toCheckType ctx sg t ty
 
   check' ctx sg (Lam body loc) ty = do
-    (qty, arg, res) <- expectPi !(askAt DEFS) ctx SZero ty.loc ty
+    (qty, arg, res) <- expectPi !(askAt DEFS) ctx ty.loc ty
     -- if Ψ | Γ, x : A ⊢ σ · t ⇐ B ⊳ Σ, ρ·x
     -- with ρ ≤ σπ
-    let qty' = sg.qty * qty
+    let qty' = sg.fst * qty
     qout <- checkC (extendTy qty' body.name arg ctx) sg body.term res.term
     -- then Ψ | Γ ⊢ σ · (λx ⇒ t) ⇐ (π·x : A) → B ⊳ Σ
     popQ loc qty' qout
 
   check' ctx sg t@(Sig {}) ty = toCheckType ctx sg t ty
 
+  check' ctx sg t@(W {}) ty = toCheckType ctx sg t ty
+
+  check' ctx sg (Sup root sub loc) ty = do
+    (shape, body) <- expectW !(askAt DEFS) ctx ty.loc ty
+    -- if Ψ | Γ ⊢ σ · a ⇐ A ⊳ Σ₁
+    qroot <- checkC ctx sg root shape
+    -- if Ψ | Γ ⊢ σ · b ⇐ ω.B[a∷A/x] → ((x : A) ⊲ B) ⊳ Σ₂
+    qsub <- checkC ctx sg sub (supSubTy root shape body sub.loc)
+    -- then Ψ | Γ ⊢ σ · (a ⋄ b) ⇐ ((x : A) ⊲ B) ⊳ Σ₁+ωΣ₂
+    pure $ qroot + Any * qsub
+
   check' ctx sg (Pair fst snd loc) ty = do
-    (tfst, tsnd) <- expectSig !(askAt DEFS) ctx SZero ty.loc ty
+    (tfst, tsnd) <- expectSig !(askAt DEFS) ctx ty.loc ty
     -- if Ψ | Γ ⊢ σ · s ⇐ A ⊳ Σ₁
     qfst <- checkC ctx sg fst tfst
     let tsnd = sub1 tsnd (Ann fst tfst fst.loc)
@@ -196,7 +225,7 @@ mutual
   check' ctx sg t@(Enum {}) ty = toCheckType ctx sg t ty
 
   check' ctx sg (Tag t loc) ty = do
-    tags <- expectEnum !(askAt DEFS) ctx SZero ty.loc ty
+    tags <- expectEnum !(askAt DEFS) ctx ty.loc ty
     -- if t ∈ ts
     unless (t `elem` tags) $ throw $ TagNotIn loc t tags
     -- then Ψ | Γ ⊢ σ · t ⇐ {ts} ⊳ 𝟎
@@ -205,54 +234,38 @@ mutual
   check' ctx sg t@(Eq {}) ty = toCheckType ctx sg t ty
 
   check' ctx sg (DLam body loc) ty = do
-    (ty, l, r) <- expectEq !(askAt DEFS) ctx SZero ty.loc ty
+    (ty, l, r) <- expectEq !(askAt DEFS) ctx ty.loc ty
     let ctx' = extendDim body.name ctx
         ty   = ty.term
         body = body.term
     -- if Ψ, i | Γ ⊢ σ · t ⇐ A ⊳ Σ
     qout <- checkC ctx' sg body ty
     -- if Ψ, i, i = 0 | Γ ⊢ t = l : A
-    let ctx0 = eqDim (B VZ loc) (K Zero loc) ctx'
-    lift $ equal loc ctx0 sg ty body $ dweakT 1 l
+    lift $ equal loc (eqDim (B VZ loc) (K Zero loc) ctx') ty body (dweakT 1 l)
     -- if Ψ, i, i = 1 | Γ ⊢ t = r : A
-    let ctx1 = eqDim (B VZ loc) (K One loc) ctx'
-    lift $ equal loc ctx1 sg ty body $ dweakT 1 r
+    lift $ equal loc (eqDim (B VZ loc) (K One loc)  ctx') ty body (dweakT 1 r)
     -- then Ψ | Γ ⊢ σ · (δ i ⇒ t) ⇐ Eq [i ⇒ A] l r ⊳ Σ
     pure qout
 
-  check' ctx sg t@(NAT {}) ty = toCheckType ctx sg t ty
+  check' ctx sg t@(Nat {}) ty = toCheckType ctx sg t ty
 
-  check' ctx sg (Nat {}) ty = do
-    expectNAT !(askAt DEFS) ctx SZero ty.loc ty
+  check' ctx sg (Zero {}) ty = do
+    expectNat !(askAt DEFS) ctx ty.loc ty
     pure $ zeroFor ctx
 
   check' ctx sg (Succ n {}) ty = do
-    expectNAT !(askAt DEFS) ctx SZero ty.loc ty
+    expectNat !(askAt DEFS) ctx ty.loc ty
     checkC ctx sg n ty
 
-  check' ctx sg t@(STRING {}) ty = toCheckType ctx sg t ty
-
-  check' ctx sg t@(Str s {}) ty = do
-    expectSTRING !(askAt DEFS) ctx SZero ty.loc ty
-    pure $ zeroFor ctx
-
   check' ctx sg t@(BOX {}) ty = toCheckType ctx sg t ty
 
   check' ctx sg (Box val loc) ty = do
-    (q, ty) <- expectBOX !(askAt DEFS) ctx SZero ty.loc ty
-    -- if Ψ | Γ ⊢ σ ⨴ π · s ⇐ A ⊳ Σ
-    valout <- checkC ctx (subjMult sg q) val ty
+    (q, ty) <- expectBOX !(askAt DEFS) ctx ty.loc ty
+    -- if Ψ | Γ ⊢ σ · s ⇐ A ⊳ Σ
+    valout <- checkC ctx sg val ty
     -- then Ψ | Γ ⊢ σ · [s] ⇐ [π.A] ⊳ πΣ
     pure $ q * valout
 
-  check' ctx sg (Let qty rhs body loc) ty = do
-    eres <- inferC ctx (subjMult sg qty) rhs
-    let sqty = sg.qty * qty
-    qout <- checkC (extendTyLet sqty body.name eres.type (E rhs) ctx)
-              sg body.term (weakT 1 ty)
-        >>= popQ loc sqty
-    pure $ qty * eres.qout + qout
-
   check' ctx sg (E e) ty = do
     -- if Ψ | Γ ⊢ σ · e ⇒ A' ⊳ Σ
     infres <- inferC ctx sg e
@@ -264,7 +277,7 @@ mutual
   private covering
   checkType' : TyContext d n ->
                (subj : Term d n) -> (0 nc : NotClo subj) =>
-               Maybe Universe -> Eff TC ()
+               Maybe Universe -> TC ()
 
   checkType' ctx (TYPE k loc) u = do
     -- if 𝓀 < ℓ then Ψ | Γ ⊢₀ Type 𝓀 ⇐ Type ℓ
@@ -272,9 +285,6 @@ mutual
       Just l  => unless (k < l) $ throw $ BadUniverse loc k l
       Nothing => pure ()
 
-  checkType' ctx (IOState loc) u = pure ()
-    -- Ψ | Γ ⊢₀ IOState ⇒ Type ℓ
-
   checkType' ctx (Pi qty arg res _) u = do
     -- if Ψ | Γ ⊢₀ A ⇐ Type ℓ
     checkTypeC ctx arg u
@@ -295,6 +305,16 @@ mutual
   checkType' ctx t@(Pair {}) u =
     throw $ NotType t.loc ctx t
 
+  checkType' ctx (W shape body _) u = do
+    -- if Ψ | Γ ⊢₀ A ⇐ Type ℓ
+    checkTypeC ctx shape u
+    -- if Ψ | Γ, x : A ⊢₀ B ⇐ Type ℓ
+    checkTypeScope ctx shape body u
+    -- then Ψ | Γ ⊢₀ (x : A) ⊲ π.B ⇐ Type ℓ
+
+  checkType' ctx t@(Sup {}) u =
+    throw $ NotType t.loc ctx t
+
   checkType' ctx (Enum {}) u = pure ()
     -- Ψ | Γ ⊢₀ {ts} ⇐ Type ℓ
 
@@ -315,35 +335,26 @@ mutual
   checkType' ctx t@(DLam {}) u =
     throw $ NotType t.loc ctx t
 
-  checkType' ctx (NAT {}) u = pure ()
-  checkType' ctx t@(Nat {}) u = throw $ NotType t.loc ctx t
+  checkType' ctx (Nat {}) u = pure ()
+  checkType' ctx t@(Zero {}) u = throw $ NotType t.loc ctx t
   checkType' ctx t@(Succ {}) u = throw $ NotType t.loc ctx t
 
-  checkType' ctx (STRING loc) u = pure ()
-    -- Ψ | Γ ⊢₀ STRING ⇒ Type ℓ
-  checkType' ctx t@(Str {}) u = throw $ NotType t.loc ctx t
-
   checkType' ctx (BOX q ty _) u = checkType ctx ty u
   checkType' ctx t@(Box {}) u = throw $ NotType t.loc ctx t
 
-  checkType' ctx (Let qty rhs body loc) u = do
-    expectEqualQ loc qty Zero
-    ety <- inferC ctx SZero rhs
-    checkType (extendTy Zero body.name ety.type ctx) body.term u
-
   checkType' ctx (E e) u = do
     -- if Ψ | Γ ⊢₀ E ⇒ Type ℓ
-    infres <- inferC ctx SZero e
+    infres <- inferC ctx szero e
     -- if Ψ | Γ ⊢ Type ℓ <: Type 𝓀
     case u of
       Just u  => lift $ subtype e.loc ctx infres.type (TYPE u e.loc)
-      Nothing => ignore $ expectTYPE !(askAt DEFS) ctx SZero e.loc infres.type
+      Nothing => ignore $ expectTYPE !(askAt DEFS) ctx e.loc infres.type
     -- then Ψ | Γ ⊢₀ E ⇐ Type 𝓀
 
 
   private covering
   checkTypeScope : TyContext d n -> Term d n ->
-                   ScopeTerm d n -> Maybe Universe -> Eff TC ()
+                   ScopeTerm d n -> Maybe Universe -> TC ()
   checkTypeScope ctx s (S _     (N body)) u = checkType ctx body u
   checkTypeScope ctx s (S [< x] (Y body)) u =
     checkType (extendTy Zero x s ctx) body u
@@ -352,27 +363,25 @@ mutual
   private covering
   infer' : TyContext d n -> SQty ->
            (subj : Elim d n) -> (0 nc : NotClo subj) =>
-           Eff TC (InferResult' d n)
+           TC (InferResult' d n)
 
   infer' ctx sg (F x u loc) = do
     -- if π·x : A {≔ s} in global context
     g <- lookupFree x loc !(askAt DEFS)
     -- if σ ≤ π
-    expectCompatQ loc sg.qty g.qty.qty
+    expectCompatQ loc sg.fst g.qty.fst
     -- then Ψ | Γ ⊢ σ · x ⇒ A ⊳ 𝟎
-    pure $ InfRes {
-      type = g.typeWithAt ctx.dimLen ctx.termLen u,
-      qout = zeroFor ctx
-    }
+    let Val d = ctx.dimLen; Val n = ctx.termLen
+    pure $ InfRes {type = displace u g.type, qout = zeroFor ctx}
 
   infer' ctx sg (B i _) =
     -- if x : A ∈ Γ
     -- then Ψ | Γ ⊢ σ · x ⇒ A ⊳ (𝟎, σ·x, 𝟎)
-    pure $ lookupBound sg.qty i ctx.tctx
+    pure $ lookupBound sg.fst i ctx.tctx
   where
     lookupBound : forall n. Qty -> Var n -> TContext d n -> InferResult' d n
-    lookupBound pi VZ (ctx :< var) =
-      InfRes {type = weakT 1 var.type, qout = zeroFor ctx :< pi}
+    lookupBound pi VZ (ctx :< type) =
+      InfRes {type = weakT 1 type, qout = zeroFor ctx :< pi}
     lookupBound pi (VS i) (ctx :< _) =
       let InfRes {type, qout} = lookupBound pi i ctx in
       InfRes {type = weakT 1 type, qout = qout :< Zero}
@@ -380,7 +389,7 @@ mutual
   infer' ctx sg (App fun arg loc) = do
     -- if Ψ | Γ ⊢ σ · f ⇒ (π·x : A) → B ⊳ Σ₁
     funres <- inferC ctx sg fun
-    (qty, argty, res) <- expectPi !(askAt DEFS) ctx SZero fun.loc funres.type
+    (qty, argty, res) <- expectPi !(askAt DEFS) ctx fun.loc funres.type
     -- if Ψ | Γ ⊢ σ ⨴ π · s ⇐ A ⊳ Σ₂
     argout <- checkC ctx (subjMult sg qty) arg argty
     -- then Ψ | Γ ⊢ σ · f s ⇒ B[s] ⊳ Σ₁ + πΣ₂
@@ -397,12 +406,12 @@ mutual
     pairres <- inferC ctx sg pair
     -- if Ψ | Γ, p : (x : A) × B ⊢₀ ret ⇐ Type
     checkTypeC (extendTy Zero ret.name pairres.type ctx) ret.term Nothing
-    (tfst, tsnd) <- expectSig !(askAt DEFS) ctx SZero pair.loc pairres.type
+    (tfst, tsnd) <- expectSig !(askAt DEFS) ctx pair.loc pairres.type
     -- if Ψ | Γ, x : A, y : B ⊢ σ · body ⇐
     --    ret[(x, y) ∷ (x : A) × B/p] ⊳ Σ₂, ρ₁·x, ρ₂·y
     -- with ρ₁, ρ₂ ≤ πσ
     let [< x, y]  = body.names
-        pisg    = pi * sg.qty
+        pisg    = pi * sg.fst
         bodyctx = extendTyN [< (pisg, x, tfst), (pisg, y, tsnd.term)] ctx
         bodyty  = substCasePairRet body.names pairres.type ret
     bodyout <- checkC bodyctx sg body.term bodyty >>=
@@ -413,30 +422,46 @@ mutual
       qout = pi * pairres.qout + bodyout
     }
 
-  infer' ctx sg (Fst pair loc) = do
-    -- if Ψ | Γ ⊢ σ · e ⇒ (x : A) × B ⊳ Σ
-    pairres <- inferC ctx sg pair
-    (tfst, _) <- expectSig !(askAt DEFS) ctx SZero pair.loc pairres.type
-    -- then Ψ | Γ ⊢ σ · fst e ⇒ A ⊳ ωΣ
+  infer' ctx sg (CaseW pi si tree ret body loc) = do
+    -- if 1 ≤ π
+    expectCompatQ loc One pi
+    -- if Ψ | Γ ⊢ σ · e ⇒ ((x : A) ⊲ B) ⊳ Σ₁
+    InfRes {type = w, qout = qtree} <- inferC ctx sg tree
+    -- if Ψ | Γ, p : (x : A) ⊲ B ⊢₀ C ⇐ Type
+    checkTypeC (extendTy Zero ret.name w ctx) ret.term Nothing
+    (shape, tbody) <- expectW !(askAt DEFS) ctx tree.loc w
+    -- if Ψ | Γ, x : A, y : ω.B → (x : A) ⊲ B,
+    --           ih : π.(z : B) → C[y z/p]
+    --  ⊢ σ · u ⇐ C[((x ⋄ y) ∷ (x : A) ⊲ B)/p]
+    --  ⊳ Σ₂, π'.x, ς₁.y, ς₂.ih
+    -- with π' ≤ σπ,  ς₂ ≤ σς,  ς₁+ς₂ ≤ σπ
+    let [< x, y, ih] = body.names
+        -- ω.B → (x : A) ⊲ B
+        tsub = Arr Any tbody.term (weakT 1 w) y.loc
+        -- y z
+        ihret = App (BV 1 y.loc) (BVT 0 ih.loc) y.loc
+        -- π.(z : B) → C[y z/p]
+        tih  = PiY pi !(mnb "z" ih.loc)
+                   (tbody.term // (BV 1 x.loc ::: shift 2))
+                   (ret.term // (ihret ::: shift 3)) ih.loc
+        sp = sg.fst * pi; ss = sg.fst * si
+        ctx' = extendTyN [< (sp, x, shape), (sp, y, tsub), (ss, ih, tih)] ctx
+    qbody' <- checkC ctx' sg body.term $ substCaseWRet body.names w ret
+    let qbody :< qx :< qy :< qih = qbody'
+    expectCompatQ x.loc qx sp
+    expectCompatQ (ih.loc `or` loc) qih ss
+    expectCompatQ y.loc (qy + qih) sp -- [todo] better error message
+    -- then Ψ | Γ ⊢ σ · caseπ e return p ⇒ C of { x ⋄ y, ς.ih ⇒ u }
+    --            ⇒ C[e/p] ⊳ Σ₁+Σ₂
     pure $ InfRes {
-      type = tfst,
-      qout = Any * pairres.qout
-    }
-
-  infer' ctx sg (Snd pair loc) = do
-    -- if Ψ | Γ ⊢ σ · e ⇒ (x : A) × B ⊳ Σ
-    pairres <- inferC ctx sg pair
-    (_, tsnd) <- expectSig !(askAt DEFS) ctx SZero pair.loc pairres.type
-    -- then Ψ | Γ ⊢ σ · snd e ⇒ B[fst e/x] ⊳ ωΣ
-    pure $ InfRes {
-      type = sub1 tsnd (Fst pair loc),
-      qout = Any * pairres.qout
+      type = sub1 ret tree,
+      qout = qtree + qbody
     }
 
   infer' ctx sg (CaseEnum pi t ret arms loc) {d, n} = do
     -- if Ψ | Γ ⊢ σ · t ⇒ {ts} ⊳ Σ₁
     tres <- inferC ctx sg t
-    ttags <- expectEnum !(askAt DEFS) ctx SZero t.loc tres.type
+    ttags <- expectEnum !(askAt DEFS) ctx t.loc tres.type
     -- if 1 ≤ π, OR there is only zero or one option
     unless (length (SortedSet.toList ttags) <= 1) $ expectCompatQ loc One pi
     -- if Ψ | Γ, x : {ts} ⊢₀ A ⇐ Type
@@ -460,43 +485,39 @@ mutual
     -- if Ψ | Γ ⊢ σ · n ⇒ ℕ ⊳ Σn
     nres <- inferC ctx sg n
     let nat = nres.type
-    expectNAT !(askAt DEFS) ctx SZero n.loc nat
+    expectNat !(askAt DEFS) ctx n.loc nat
     -- if Ψ | Γ, n : ℕ ⊢₀ A ⇐ Type
     checkTypeC (extendTy Zero ret.name nat ctx) ret.term Nothing
     -- if Ψ | Γ ⊢ σ · zer ⇐ A[0 ∷ ℕ/n] ⊳ Σz
     zerout <- checkC ctx sg zer $ sub1 ret $ Ann (Zero zer.loc) nat zer.loc
-    -- if Ψ | Γ, n : ℕ, ih : A ⊢ σ · suc ⇐ A[succ p ∷ ℕ/n] ⊳ Σs, ρ.p, ς.ih
-    -- with ς ≤ π'σ, (ρ + ς) ≤ πσ
+    -- if Ψ | Γ, n : ℕ, ih : A ⊢ σ · suc ⇐ A[succ p ∷ ℕ/n] ⊳ Σs, ρ₁.p, ρ₂.ih
+    -- with ρ₂ ≤ π'σ, (ρ₁ + ρ₂) ≤ πσ
     let [< p, ih] = suc.names
-        pisg      = pi * sg.qty
-        sucCtx    = extendTyN [< (pisg, p, NAT p.loc), (pi', ih, ret.term)] ctx
+        pisg      = pi * sg.fst
+        sucCtx    = extendTyN [< (pisg, p, Nat p.loc), (pi', ih, ret.term)] ctx
         sucType   = substCaseSuccRet suc.names ret
     sucout :< qp :< qih <- checkC sucCtx sg suc.term sucType
-    expectCompatQ loc qih (pi' * sg.qty)
+    expectCompatQ loc qih (pi' * sg.fst)
     -- [fixme] better error here
     expectCompatQ loc (qp + qih) pisg
-    -- if ς = 0, then Σb = lubs(Σz, Σs), otherwise Σb = Σz + ωςΣs
-    let bodyout = case qih of
-          Zero => lubs ctx [zerout, sucout]
-          _    => zerout + Any * sucout
-    -- then Ψ | Γ ⊢ caseπ ⋯ ⇒ A[n] ⊳ πΣn + Σb
+    -- then Ψ | Γ ⊢ caseπ ⋯ ⇒ A[n] ⊳ πΣn + Σz + ωΣs
     pure $ InfRes {
       type = sub1 ret n,
-      qout = pi * nres.qout + bodyout
+      qout = pi * nres.qout + zerout + Any * sucout
     }
 
   infer' ctx sg (CaseBox pi box ret body loc) = do
     -- if Ψ | Γ ⊢ σ · b ⇒ [ρ.A] ⊳ Σ₁
     boxres <- inferC ctx sg box
-    (rh, ty) <- expectBOX !(askAt DEFS) ctx SZero box.loc boxres.type
+    (q, ty) <- expectBOX !(askAt DEFS) ctx box.loc boxres.type
     -- if Ψ | Γ, x : [ρ.A] ⊢₀ R ⇐ Type
     checkTypeC (extendTy Zero ret.name boxres.type ctx) ret.term Nothing
-    -- if Ψ | Γ, x : A ⊢ σ · t ⇐ R[[x] ∷ [ρ.A/x]] ⊳ Σ₂, ς·x
+    -- if Ψ | Γ, x : A ⊢ t ⇐ R[[x] ∷ [ρ.A/x]] ⊳ Σ₂, ς·x
     --   with ς ≤ ρπσ
-    let rhpisg   = rh * pi * sg.qty
-        bodyCtx  = extendTy rhpisg body.name ty ctx
+    let qpisg    = q * pi * sg.fst
+        bodyCtx  = extendTy qpisg body.name ty ctx
         bodyType = substCaseBoxRet body.name ty ret
-    bodyout <- checkC bodyCtx sg body.term bodyType >>= popQ loc rhpisg
+    bodyout <- checkC bodyCtx sg body.term bodyType >>= popQ loc qpisg
     -- then Ψ | Γ ⊢ caseπ ⋯ ⇒ R[b/x] ⊳ Σ₁ + Σ₂
     pure $ InfRes {
       type = sub1 ret box,
@@ -506,54 +527,42 @@ mutual
   infer' ctx sg (DApp fun dim loc) = do
     -- if Ψ | Γ ⊢ σ · f ⇒ Eq [𝑖 ⇒ A] l r ⊳ Σ
     InfRes {type, qout} <- inferC ctx sg fun
-    ty <- fst <$> expectEq !(askAt DEFS) ctx SZero fun.loc type
+    ty <- fst <$> expectEq !(askAt DEFS) ctx fun.loc type
     -- then Ψ | Γ ⊢ σ · f p ⇒ A‹p/𝑖› ⊳ Σ
     pure $ InfRes {type = dsub1 ty dim, qout}
 
   infer' ctx sg (Coe ty p q val loc) = do
-    -- if Ψ, 𝑖 | Γ ⊢₀ A ⇐ Type _
     checkType (extendDim ty.name ctx) ty.term Nothing
-    -- if Ψ | Γ ⊢ σ · s ⇐ A‹p/𝑖› ⊳ Σ
     qout <- checkC ctx sg val $ dsub1 ty p
-    -- then Ψ | Γ ⊢ σ · coe (𝑖 ⇒ A) @p @q s ⇒ A‹q/𝑖› ⊳ Σ
     pure $ InfRes {type = dsub1 ty q, qout}
 
   infer' ctx sg (Comp ty p q val r (S [< j0] val0) (S [< j1] val1) loc) = do
-    -- if Ψ | Γ ⊢₀ A ⇐ Type _
     checkType ctx ty Nothing
-    -- if Ψ | Γ ⊢ σ · s ⇐ A ⊳ Σ
     qout <- checkC ctx sg val ty
-    -- if Ψ, 𝑗, 𝑖=0      | Γ ⊢ σ · t₀ ⇐ A ⊳ Σ₀
-    --    Ψ, 𝑗, 𝑖=0, 𝑗=p | Γ ⊢ t₀ = s ⇐ A
     let ty'  = dweakT 1 ty; val' = dweakT 1 val; p' = weakD 1 p
         ctx0 = extendDim j0 $ eqDim r (K Zero j0.loc) ctx
-        val0 = getTerm val0
+        val0 = val0.term
     qout0 <- check ctx0 sg val0 ty'
-    lift $ equal loc (eqDim (B VZ p.loc) p' ctx0) sg ty' val0 val'
-    -- if Ψ, 𝑗, 𝑖=1      | Γ ⊢ σ · t₁ ⇐ A ⊳ Σ₁
-    --    Ψ, 𝑗, 𝑖=1, 𝑗=p | Γ ⊢ t₁ = s ⇐ A
+    lift $ equal loc (eqDim (B VZ p.loc) p' ctx0) ty' val0 val'
     let ctx1 = extendDim j1 $ eqDim r (K One j1.loc) ctx
-        val1  = getTerm val1
+        val1  = val1.term
     qout1 <- check ctx1 sg val1 ty'
-    -- if Σ = Σ₀ = Σ₁
-    lift $ equal loc (eqDim (B VZ p.loc) p' ctx1) sg ty' val1 val'
+    lift $ equal loc (eqDim (B VZ p.loc) p' ctx1) ty' val1 val'
     let qouts  = qout :: catMaybes [toMaybe qout0, toMaybe qout1]
-    -- then Ψ | Γ ⊢ comp A @p @q s @r {0 𝑗 ⇒ t₀; 1 𝑗 ⇒ t₁} ⇒ A ⊳ Σ
     pure $ InfRes {type = ty, qout = lubs ctx qouts}
 
   infer' ctx sg (TypeCase ty ret arms def loc) = do
     -- if σ = 0
-    expectEqualQ loc Zero sg.qty
+    expectEqualQ loc Zero sg.fst
     -- if Ψ, Γ ⊢₀ e ⇒ Type u
-    u <- inferC ctx SZero ty >>=
-         expectTYPE !(askAt DEFS) ctx SZero ty.loc . type
+    u <- expectTYPE !(askAt DEFS) ctx ty.loc . type =<< inferC ctx szero ty
     -- if Ψ, Γ ⊢₀ C ⇐ Type (non-dependent return type)
     checkTypeC ctx ret Nothing
     -- if Ψ, Γ' ⊢₀ A ⇐ C for each rhs A
     for_ allKinds $ \k =>
       for_ (lookupPrecise k arms) $ \(S names t) =>
         check0 (extendTyN (typecaseTel k names u) ctx)
-               (getTerm t) (weakT (arity k) ret)
+               t.term (weakT (arity k) ret)
     -- then Ψ, Γ ⊢₀ type-case ⋯ ⇒ C
     pure $ InfRes {type = ret, qout = zeroFor ctx}
 
diff --git a/lib/Quox/Typing.idr b/lib/Quox/Typing.idr
index 2ebed73..20aa27d 100644
--- a/lib/Quox/Typing.idr
+++ b/lib/Quox/Typing.idr
@@ -6,8 +6,7 @@ import public Quox.Typing.Error as Typing
 
 import public Quox.Syntax
 import public Quox.Definition
-import public Quox.Whnf
-import public Quox.Pretty
+import public Quox.Reduce
 
 import Language.Reflection
 import Control.Eff
@@ -47,15 +46,24 @@ lookupFree x loc defs = maybe (throw $ NotInScope loc x) pure $ lookup x defs
 public export
 substCasePairRet : BContext 2 -> Term d n -> ScopeTerm d n -> Term d (2 + n)
 substCasePairRet [< x, y] dty retty =
-  let tm  = Pair (BVT 1 x.loc) (BVT 0 y.loc) $ x.loc `extendL` y.loc
-      arg = Ann tm (dty // fromNat 2) tm.loc in
+  let tm = Pair (BVT 1 x.loc) (BVT 0 y.loc) $ x.loc `extendL` y.loc
+      arg = Ann tm (dty // shift 2) tm.loc
+  in
   retty.term // (arg ::: shift 2)
 
+public export
+substCaseWRet : BContext 3 -> Term d n -> ScopeTerm d n -> Term d (3 + n)
+substCaseWRet [< x, y, ih] dty retty =
+  let tm = Sup (BVT 2 x.loc) (BVT 1 y.loc) $ x.loc `extendL` y.loc
+      arg = Ann tm (dty // shift 3) tm.loc
+  in
+  sub1 (weakS 3 retty) arg
+
 public export
 substCaseSuccRet : BContext 2 -> ScopeTerm d n -> Term d (2 + n)
 substCaseSuccRet [< p, ih] retty =
-  let loc = p.loc `extendL` ih.loc
-      arg = Ann (Succ (BVT 1 p.loc) p.loc) (NAT p.loc) loc in
+  let arg = Ann (Succ (BVT 1 p.loc) p.loc) (Nat p.loc) $ p.loc `extendL` ih.loc
+  in
   retty.term // (arg ::: shift 2)
 
 public export
@@ -65,31 +73,23 @@ substCaseBoxRet x dty retty =
   retty.term // (arg ::: shift 1)
 
 
-private
-0 ExpectErrorConstructor : Type
-ExpectErrorConstructor =
-  forall d, n. Loc -> NameContexts d n -> Term d n -> Error
-
-parameters (defs : Definitions)
-           {auto _ : (Has ErrorEff fs, Has NameGen fs, Has Log fs)}
+parameters (defs : Definitions) {auto _ : (Has ErrorEff fs, Has NameGen fs)}
   namespace TyContext
-   parameters (ctx : TyContext d n) (sg : SQty) (loc : Loc)
+   parameters (ctx : TyContext d n) (loc : Loc)
     export covering
     whnf : {0 isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
-           tm d n -> Eff fs (NonRedex tm d n defs (toWhnfContext ctx) sg)
+           tm d n -> Eff fs (NonRedex tm d n defs)
     whnf tm = do
       let Val n = ctx.termLen; Val d = ctx.dimLen
-      res <- lift $ runExcept $ whnf defs (toWhnfContext ctx) sg tm
+      res <- lift $ runExcept $ whnf defs (toWhnfContext ctx) tm
       rethrow res
 
     private covering %macro
-    expect : ExpectErrorConstructor -> TTImp -> TTImp ->
-             Elab (Term d n -> Eff fs a)
-    expect err pat rhs = Prelude.do
-      match <- check `(\case ~(pat) => Just ~(rhs); _ => Nothing)
-      pure $ \term => do
-        res <- whnf term
-        maybe (throw $ err loc ctx.names term) pure $ match $ fst res
+    expect : (forall d, n. Loc -> NameContexts d n -> Term d n -> Error) ->
+             TTImp -> TTImp -> Elab (Term d n -> Eff fs a)
+    expect k l r = do
+      f <- check `(\case ~(l) => Just ~(r); _ => Nothing)
+      pure $ \t => maybe (throw $ k loc ctx.names t) pure . f . fst =<< whnf t
 
     export covering %inline
     expectTYPE : Term d n -> Eff fs Universe
@@ -103,6 +103,10 @@ parameters (defs : Definitions)
     expectSig : Term d n -> Eff fs (Term d n, ScopeTerm d n)
     expectSig = expect ExpectedSig `(Sig {fst, snd, _}) `((fst, snd))
 
+    export covering %inline
+    expectW : Term d n -> Eff fs (Term d n, ScopeTerm d n)
+    expectW = expect ExpectedW `(W {shape, body, _}) `((shape, body))
+
     export covering %inline
     expectEnum : Term d n -> Eff fs (SortedSet TagVal)
     expectEnum = expect ExpectedEnum `(Enum {cases, _}) `(cases)
@@ -112,40 +116,32 @@ parameters (defs : Definitions)
     expectEq = expect ExpectedEq `(Eq {ty, l, r, _}) `((ty, l, r))
 
     export covering %inline
-    expectNAT : Term d n -> Eff fs ()
-    expectNAT = expect ExpectedNAT `(NAT {}) `(())
-
-    export covering %inline
-    expectSTRING : Term d n -> Eff fs ()
-    expectSTRING = expect ExpectedSTRING `(STRING {}) `(())
+    expectNat : Term d n -> Eff fs ()
+    expectNat = expect ExpectedNat `(Nat {}) `(())
 
     export covering %inline
     expectBOX : Term d n -> Eff fs (Qty, Term d n)
     expectBOX = expect ExpectedBOX `(BOX {qty, ty, _}) `((qty, ty))
 
-    export covering %inline
-    expectIOState : Term d n -> Eff fs ()
-    expectIOState = expect ExpectedIOState `(IOState {}) `(())
-
 
   namespace EqContext
-   parameters (ctx : EqContext n) (sg : SQty) (loc : Loc)
+   parameters (ctx : EqContext n) (loc : Loc)
     export covering
     whnf : {0 isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
-           tm 0 n -> Eff fs (NonRedex tm 0 n defs (toWhnfContext ctx) sg)
+           tm 0 n -> Eff fs (NonRedex tm 0 n defs)
     whnf tm = do
-      res <- lift $ runExcept $ whnf defs (toWhnfContext ctx) sg tm
+      let Val n = ctx.termLen
+      res <- lift $ runExcept $ whnf defs (toWhnfContext ctx) tm
       rethrow res
 
     private covering %macro
-    expect : ExpectErrorConstructor -> TTImp -> TTImp ->
-             Elab (Term 0 n -> Eff fs a)
-    expect err pat rhs = do
-      match <- check `(\case ~(pat) => Just ~(rhs); _ => Nothing)
-      pure $ \term => do
-        res <- whnf term
-        let t0 = delay $ term // shift0 ctx.dimLen
-        maybe (throw $ err loc ctx.names t0) pure $ match $ fst res
+    expect : (forall d, n. Loc -> NameContexts d n -> Term d n -> Error) ->
+             TTImp -> TTImp -> Elab (Term 0 n -> Eff fs a)
+    expect k l r = do
+      f <- check `(\case ~(l) => Just ~(r); _ => Nothing)
+      pure $ \t =>
+        let err = throw $ k loc ctx.names (t // shift0 ctx.dimLen) in
+        maybe err pure . f . fst =<< whnf t
 
     export covering %inline
     expectTYPE : Term 0 n -> Eff fs Universe
@@ -159,6 +155,10 @@ parameters (defs : Definitions)
     expectSig : Term 0 n -> Eff fs (Term 0 n, ScopeTerm 0 n)
     expectSig = expect ExpectedSig `(Sig {fst, snd, _}) `((fst, snd))
 
+    export covering %inline
+    expectW : Term 0 n -> Eff fs (Term 0 n, ScopeTerm 0 n)
+    expectW = expect ExpectedW `(W {shape, body, _}) `((shape, body))
+
     export covering %inline
     expectEnum : Term 0 n -> Eff fs (SortedSet TagVal)
     expectEnum = expect ExpectedEnum `(Enum {cases, _}) `(cases)
@@ -168,17 +168,9 @@ parameters (defs : Definitions)
     expectEq = expect ExpectedEq `(Eq {ty, l, r, _}) `((ty, l, r))
 
     export covering %inline
-    expectNAT : Term 0 n -> Eff fs ()
-    expectNAT = expect ExpectedNAT `(NAT {}) `(())
-
-    export covering %inline
-    expectSTRING : Term 0 n -> Eff fs ()
-    expectSTRING = expect ExpectedSTRING `(STRING {}) `(())
+    expectNat : Term 0 n -> Eff fs ()
+    expectNat = expect ExpectedNat `(Nat {}) `(())
 
     export covering %inline
     expectBOX : Term 0 n -> Eff fs (Qty, Term 0 n)
     expectBOX = expect ExpectedBOX `(BOX {qty, ty, _}) `((qty, ty))
-
-    export covering %inline
-    expectIOState : Term 0 n -> Eff fs ()
-    expectIOState = expect ExpectedIOState `(IOState {}) `(())
diff --git a/lib/Quox/Typing/Context.idr b/lib/Quox/Typing/Context.idr
index d231694..8447a9a 100644
--- a/lib/Quox/Typing/Context.idr
+++ b/lib/Quox/Typing/Context.idr
@@ -4,51 +4,17 @@ import Quox.Syntax
 import Quox.Context
 import Quox.Pretty
 import public Data.Singleton
-import Derive.Prelude
 
 %default total
-%language ElabReflection
 
 
 public export
 QContext : Nat -> Type
 QContext = Context' Qty
 
-public export
-record LocalVar d n where
-  constructor MkLocal
-  type : Term d n
-  term : Maybe (Term d n) -- if from a `let`
-%runElab deriveIndexed "LocalVar" [Show]
-
-namespace LocalVar
-  export %inline
-  letVar : (type, term : Term d n) -> LocalVar d n
-  letVar type term = MkLocal {type, term = Just term}
-
-  export %inline
-  lamVar : (type : Term d n) -> LocalVar d n
-  lamVar type = MkLocal {type, term = Nothing}
-
-  export %inline
-  mapVar : (Term d n -> Term d' n') -> LocalVar d n -> LocalVar d' n'
-  mapVar f = {type $= f, term $= map f}
-
-  export %inline
-  subD : DSubst d1 d2 -> LocalVar d1 n -> LocalVar d2 n
-  subD th = mapVar (// th)
-
-  export %inline
-  weakD : LocalVar d n -> LocalVar (S d) n
-  weakD = subD $ shift 1
-
-export %inline CanShift  (LocalVar d) where l // by = mapVar (// by) l
-export %inline CanDSubst LocalVar     where l // by = mapVar (// by) l
-export %inline CanTSubst LocalVar     where l // by = mapVar (// by) l
-
 public export
 TContext : TermLike
-TContext d = Context (LocalVar d)
+TContext d = Context (Term d)
 
 public export
 QOutput : Nat -> Type
@@ -65,12 +31,11 @@ record TyContext d n where
   {auto dimLen  : Singleton d}
   {auto termLen : Singleton n}
   dctx   : DimEq d
-  dnames : BContext d -- only used for printing
+  dnames : BContext d
   tctx   : TContext d n
-  tnames : BContext n -- only used for printing
+  tnames : BContext n
   qtys   : QContext n -- only used for printing
 %name TyContext ctx
-%runElab deriveIndexed "TyContext" [Show]
 
 
 public export
@@ -81,29 +46,29 @@ record EqContext n where
   dassign : DimAssign dimLen -- only used for printing
   dnames  : BContext dimLen -- only used for printing
   tctx    : TContext 0 n
-  tnames  : BContext n -- only used for printing
+  tnames  : BContext n
   qtys    : QContext n -- only used for printing
 %name EqContext ctx
-%runElab deriveIndexed "EqContext" [Show]
 
 
 public export
 record WhnfContext d n where
   constructor MkWhnfContext
-  {auto dimLen  : Singleton d}
-  {auto termLen : Singleton n}
   dnames : BContext d
   tnames : BContext n
   tctx   : TContext d n
 %name WhnfContext ctx
-%runElab deriveIndexed "WhnfContext" [Show]
 
 namespace TContext
+  export %inline
+  pushD : TContext d n -> TContext (S d) n
+  pushD tel = map (// shift 1) tel
+
   export %inline
   zeroFor : Context tm n -> QOutput n
   zeroFor ctx = Zero <$ ctx
 
-public export
+private
 extendLen : Telescope a n1 n2 -> Singleton n1 -> Singleton n2
 extendLen [<]        x = x
 extendLen (tel :< _) x = [|S $ extendLen tel x|]
@@ -113,66 +78,32 @@ public export
 CtxExtension : Nat -> Nat -> Nat -> Type
 CtxExtension d = Telescope ((Qty, BindName,) . Term d)
 
-public export
-CtxExtension0 : Nat -> Nat -> Nat -> Type
-CtxExtension0 d = Telescope ((BindName,) . Term d)
-
-public export
-CtxExtensionLet : Nat -> Nat -> Nat -> Type
-CtxExtensionLet d = Telescope ((Qty, BindName,) . LocalVar d)
-
-public export
-CtxExtensionLet0 : Nat -> Nat -> Nat -> Type
-CtxExtensionLet0 d = Telescope ((BindName,) . LocalVar d)
-
 namespace TyContext
   public export %inline
   empty : TyContext 0 0
-  empty = MkTyContext {
-    dctx = new, dnames = [<], tctx = [<], tnames = [<], qtys = [<]
-  }
+  empty =
+    MkTyContext {dctx = new, dnames = [<], tctx = [<], tnames = [<], qtys = [<]}
 
   public export %inline
   null : TyContext d n -> Bool
   null ctx = null ctx.dnames && null ctx.tnames
 
   export %inline
-  extendTyLetN : CtxExtensionLet d n1 n2 -> TyContext d n1 -> TyContext d n2
-  extendTyLetN xss (MkTyContext {termLen, dctx, dnames, tctx, tnames, qtys}) =
-    let (qs, xs, ls) = unzip3 xss in
+  extendTyN : CtxExtension d n1 n2 -> TyContext d n1 -> TyContext d n2
+  extendTyN xss (MkTyContext {termLen, dctx, dnames, tctx, tnames, qtys}) =
+    let (qs, xs, ss) = unzip3 xss in
     MkTyContext {
       dctx, dnames,
       termLen = extendLen xss termLen,
-      tctx    = tctx . ls,
+      tctx    = tctx . ss,
       tnames  = tnames . xs,
       qtys    = qtys . qs
     }
 
-  export %inline
-  extendTyN : CtxExtension d n1 n2 -> TyContext d n1 -> TyContext d n2
-  extendTyN = extendTyLetN . map (\(q, x, s) => (q, x, lamVar s))
-
-  export %inline
-  extendTyLetN0 : CtxExtensionLet0 d n1 n2 -> TyContext d n1 -> TyContext d n2
-  extendTyLetN0 xss = extendTyLetN (map (Zero,) xss)
-
-  export %inline
-  extendTyN0 : CtxExtension0 d n1 n2 -> TyContext d n1 -> TyContext d n2
-  extendTyN0 xss = extendTyN (map (Zero,) xss)
-
-  export %inline
-  extendTyLet : Qty -> BindName -> Term d n -> Term d n ->
-                TyContext d n -> TyContext d (S n)
-  extendTyLet q x s e = extendTyLetN [< (q, x, letVar s e)]
-
   export %inline
   extendTy : Qty -> BindName -> Term d n -> TyContext d n -> TyContext d (S n)
   extendTy q x s = extendTyN [< (q, x, s)]
 
-  export %inline
-  extendTy0 : BindName -> Term d n -> TyContext d n -> TyContext d (S n)
-  extendTy0 = extendTy Zero
-
   export %inline
   extendDim : BindName -> TyContext d n -> TyContext (S d) n
   extendDim x (MkTyContext {dimLen, dctx, dnames, tctx, tnames, qtys}) =
@@ -180,7 +111,7 @@ namespace TyContext
       dctx   = dctx :<? Nothing,
       dnames = dnames :< x,
       dimLen = [|S dimLen|],
-      tctx   = map weakD tctx,
+      tctx   = pushD tctx,
       tnames, qtys
     }
 
@@ -219,7 +150,7 @@ makeEqContext' ctx th = MkEqContext {
   termLen = ctx.termLen,
   dassign = makeDAssign th,
   dnames  = ctx.dnames,
-  tctx    = map (subD th) ctx.tctx,
+  tctx    = map (// th) ctx.tctx,
   tnames  = ctx.tnames,
   qtys    = ctx.qtys
 }
@@ -227,7 +158,7 @@ makeEqContext' ctx th = MkEqContext {
 export
 makeEqContext : TyContext d n -> DSubst d 0 -> EqContext n
 makeEqContext ctx@(MkTyContext {dnames, _}) th =
-  let Val d = lengthPrf0 dnames in makeEqContext' ctx th
+  let (d' ** Refl) = lengthPrf0 dnames in makeEqContext' ctx th
 
 namespace EqContext
   public export %inline
@@ -241,42 +172,21 @@ namespace EqContext
   null ctx = null ctx.dnames && null ctx.tnames
 
   export %inline
-  extendTyLetN : CtxExtensionLet 0 n1 n2 -> EqContext n1 -> EqContext n2
-  extendTyLetN xss (MkEqContext {termLen, dassign, dnames, tctx, tnames, qtys}) =
-    let (qs, xs, ls) = unzip3 xss in
+  extendTyN : CtxExtension 0 n1 n2 -> EqContext n1 -> EqContext n2
+  extendTyN xss (MkEqContext {termLen, dassign, dnames, tctx, tnames, qtys}) =
+    let (qs, xs, ss) = unzip3 xss in
     MkEqContext {
       termLen = extendLen xss termLen,
-      tctx    = tctx . ls,
+      tctx    = tctx . ss,
       tnames  = tnames . xs,
       qtys    = qtys . qs,
       dassign, dnames
     }
 
-  export %inline
-  extendTyN : CtxExtension 0 n1 n2 -> EqContext n1 -> EqContext n2
-  extendTyN = extendTyLetN . map (\(q, x, s) => (q, x, lamVar s))
-
-  export %inline
-  extendTyLetN0 : CtxExtensionLet0 0 n1 n2 -> EqContext n1 -> EqContext n2
-  extendTyLetN0 xss = extendTyLetN (map (Zero,) xss)
-
-  export %inline
-  extendTyN0 : CtxExtension0 0 n1 n2 -> EqContext n1 -> EqContext n2
-  extendTyN0 xss = extendTyN (map (Zero,) xss)
-
-  export %inline
-  extendTyLet : Qty -> BindName -> Term 0 n -> Term 0 n ->
-                EqContext n -> EqContext (S n)
-  extendTyLet q x s e = extendTyLetN [< (q, x, letVar s e)]
-
   export %inline
   extendTy : Qty -> BindName -> Term 0 n -> EqContext n -> EqContext (S n)
   extendTy q x s = extendTyN [< (q, x, s)]
 
-  export %inline
-  extendTy0 : BindName -> Term 0 n -> EqContext n -> EqContext (S n)
-  extendTy0 = extendTy Zero
-
   export %inline
   extendDim : BindName -> DimConst -> EqContext n -> EqContext n
   extendDim x e (MkEqContext {dassign, dnames, tctx, tnames, qtys}) =
@@ -288,7 +198,7 @@ namespace EqContext
   toTyContext (MkEqContext {dimLen, dassign, dnames, tctx, tnames, qtys}) =
     MkTyContext {
       dctx = fromGround dnames dassign,
-      tctx = map (subD $ shift0 dimLen) tctx,
+      tctx = map (// shift0 dimLen) tctx,
       dnames, tnames, qtys
     }
 
@@ -297,44 +207,18 @@ namespace EqContext
   toWhnfContext (MkEqContext {tnames, tctx, _}) =
     MkWhnfContext {dnames = [<], tnames, tctx}
 
-  export
-  injElim : WhnfContext d n -> Elim 0 0 -> Elim d n
-  injElim ctx e =
-    let Val d = ctx.dimLen; Val n = ctx.termLen in
-    e // shift0 d // shift0 n
-
 namespace WhnfContext
   public export %inline
   empty : WhnfContext 0 0
   empty = MkWhnfContext [<] [<] [<]
 
-  export
-  extendTy' : BindName -> LocalVar d n -> WhnfContext d n -> WhnfContext d (S n)
-  extendTy' x var (MkWhnfContext {termLen, dnames, tnames, tctx}) =
-    MkWhnfContext {
-      dnames,
-      termLen = [|S termLen|],
-      tnames  = tnames :< x,
-      tctx    = tctx   :< var
-    }
-
-  export %inline
-  extendTy : BindName -> Term d n -> WhnfContext d n -> WhnfContext d (S n)
-  extendTy x ty ctx = extendTy' x (lamVar ty) ctx
-
-  export %inline
-  extendTyLet : BindName -> (type, term : Term d n) ->
-                WhnfContext d n -> WhnfContext d (S n)
-  extendTyLet x type term ctx = extendTy' x (letVar {type, term}) ctx
-
   export
   extendDimN : {s : Nat} -> BContext s -> WhnfContext d n ->
                WhnfContext (s + d) n
-  extendDimN ns (MkWhnfContext {dnames, tnames, tctx, dimLen}) =
+  extendDimN ns (MkWhnfContext {dnames, tnames, tctx}) =
     MkWhnfContext {
-      dimLen = [|Val s + dimLen|],
       dnames = dnames ++ toSnocVect' ns,
-      tctx   = map (subD $ shift s) tctx,
+      tctx   = dweakT s <$> tctx,
       tnames
     }
 
@@ -346,25 +230,14 @@ namespace WhnfContext
 private
 prettyTContextElt : {opts : _} ->
                     BContext d -> BContext n ->
-                    Doc opts -> BindName -> LocalVar d n ->
-                    Eff Pretty (Doc opts)
-prettyTContextElt dnames tnames q x s = do
-  dot <- dotD
-  x  <- prettyTBind x; colon <- colonD
-  ty <- withPrec Outer $ prettyTerm dnames tnames s.type; eq <- cstD
-  tm <- traverse (withPrec Outer . prettyTerm dnames tnames) s.term
-  d  <- askAt INDENT
-  let qx = hcat [q, dot, x]
-  pure $ case tm of
-    Nothing =>
-      ifMultiline (hsep [qx, colon, ty]) (vsep [qx, indent d $ colon <++> ty])
-    Just tm =>
-      ifMultiline (hsep [qx, colon, ty, eq, tm])
-                  (vsep [qx, indent d $ colon <++> ty, indent d $ eq <++> tm])
+                    Qty -> BindName -> Term d n -> Eff Pretty (Doc opts)
+prettyTContextElt dnames tnames q x s =
+  pure $ hsep [hcat [!(prettyQty q), !dotD, !(prettyTBind x)], !colonD,
+               !(withPrec Outer $ prettyTerm dnames tnames s)]
 
 private
 prettyTContext' : {opts : _} ->
-                  BContext d -> Context' (Doc opts) n -> BContext n ->
+                  BContext d -> QContext n -> BContext n ->
                   TContext d n -> Eff Pretty (SnocList (Doc opts))
 prettyTContext' _ [<] [<] [<] = pure [<]
 prettyTContext' dnames (qtys :< q) (tnames :< x) (tys :< t) =
@@ -375,11 +248,8 @@ export
 prettyTContext : {opts : _} ->
                  BContext d -> QContext n -> BContext n ->
                  TContext d n -> Eff Pretty (Doc opts)
-prettyTContext dnames qtys tnames tys = do
-  comma <- commaD
-  qtys <- traverse prettyQty qtys
-  sepSingle . exceptLast (<+> comma) . toList <$>
-    prettyTContext' dnames qtys tnames tys
+prettyTContext dnames qtys tnames tys =
+  separateTight !commaD <$> prettyTContext' dnames qtys tnames tys
 
 export
 prettyTyContext : {opts : _} -> TyContext d n -> Eff Pretty (Doc opts)
@@ -387,16 +257,9 @@ prettyTyContext (MkTyContext dctx dnames tctx tnames qtys) =
   case dctx of
     C [<] => prettyTContext dnames qtys tnames tctx
     _     => pure $
-      sepSingle [!(prettyDimEq dnames dctx) <++> !pipeD,
-                 !(prettyTContext dnames qtys tnames tctx)]
+      sep [!(prettyDimEq dnames dctx) <++> !pipeD,
+           !(prettyTContext dnames qtys tnames tctx)]
 
 export
 prettyEqContext : {opts : _} -> EqContext n -> Eff Pretty (Doc opts)
 prettyEqContext ctx = prettyTyContext $ toTyContext ctx
-
-export
-prettyWhnfContext : {opts : _} -> WhnfContext d n -> Eff Pretty (Doc opts)
-prettyWhnfContext ctx =
-  let Val n = ctx.termLen in
-  sepSingle . exceptLast (<+> comma) . toList <$>
-    prettyTContext' ctx.dnames (replicate n "_") ctx.tnames ctx.tctx
diff --git a/lib/Quox/Typing/Error.idr b/lib/Quox/Typing/Error.idr
index 502757c..e618b5a 100644
--- a/lib/Quox/Typing/Error.idr
+++ b/lib/Quox/Typing/Error.idr
@@ -2,19 +2,12 @@ module Quox.Typing.Error
 
 import Quox.Loc
 import Quox.Syntax
-import Quox.Syntax.Builtin
 import Quox.Typing.Context
 import Quox.Typing.EqMode
 import Quox.Pretty
 
 import Data.List
 import Control.Eff
-import Derive.Prelude
-
-%language ElabReflection
-%hide TT.Name
-
-%default total
 
 
 public export
@@ -22,7 +15,6 @@ record NameContexts d n where
   constructor MkNameContexts
   dnames : BContext d
   tnames : BContext n
-%runElab deriveIndexed "NameContexts" [Show]
 
 namespace NameContexts
   export
@@ -63,19 +55,18 @@ namespace WhnfContext
 
 public export
 data Error
-= ExpectedTYPE    Loc (NameContexts d n) (Term d n)
-| ExpectedPi      Loc (NameContexts d n) (Term d n)
-| ExpectedSig     Loc (NameContexts d n) (Term d n)
-| ExpectedEnum    Loc (NameContexts d n) (Term d n)
-| ExpectedEq      Loc (NameContexts d n) (Term d n)
-| ExpectedNAT     Loc (NameContexts d n) (Term d n)
-| ExpectedSTRING  Loc (NameContexts d n) (Term d n)
-| ExpectedBOX     Loc (NameContexts d n) (Term d n)
-| ExpectedIOState Loc (NameContexts d n) (Term d n)
-| BadUniverse     Loc Universe Universe
-| TagNotIn        Loc TagVal (SortedSet TagVal)
-| BadCaseEnum     Loc (SortedSet TagVal) (SortedSet TagVal)
-| BadQtys         Loc String (TyContext d n) (List (QOutput n, Term d n))
+= ExpectedTYPE Loc (NameContexts d n) (Term d n)
+| ExpectedPi   Loc (NameContexts d n) (Term d n)
+| ExpectedSig  Loc (NameContexts d n) (Term d n)
+| ExpectedW    Loc (NameContexts d n) (Term d n)
+| ExpectedEnum Loc (NameContexts d n) (Term d n)
+| ExpectedEq   Loc (NameContexts d n) (Term d n)
+| ExpectedNat  Loc (NameContexts d n) (Term d n)
+| ExpectedBOX  Loc (NameContexts d n) (Term d n)
+| BadUniverse  Loc Universe Universe
+| TagNotIn     Loc TagVal (SortedSet TagVal)
+| BadCaseEnum  Loc (SortedSet TagVal) (SortedSet TagVal)
+| BadQtys      Loc String (TyContext d n) (List (QOutput n, Term d n))
 
 -- first term arg of ClashT is the type
 | ClashT  Loc (EqContext n) EqMode (Term 0 n) (Term 0 n) (Term 0 n)
@@ -88,14 +79,11 @@ data Error
 | NotType Loc (TyContext d n) (Term d n)
 | WrongType Loc (EqContext n) (Term 0 n) (Term 0 n)
 
-| WrongBuiltinType Builtin Error
-| ExpectedSingleEnum Loc (NameContexts d n) (Term d n)
-
 | MissingEnumArm Loc TagVal (List TagVal)
 
 -- extra context
 | WhileChecking
-    (TyContext d n) SQty
+    (TyContext d n) Qty
     (Term d n) -- term
     (Term d n) -- type
     Error
@@ -105,20 +93,19 @@ data Error
     (Maybe Universe)
     Error
 | WhileInferring
-    (TyContext d n) SQty
+    (TyContext d n) Qty
     (Elim d n)
     Error
 | WhileComparingT
-    (EqContext n) EqMode SQty
+    (EqContext n) EqMode
     (Term 0 n) -- type
     (Term 0 n) (Term 0 n) -- lhs/rhs
     Error
 | WhileComparingE
-    (EqContext n) EqMode SQty
+    (EqContext n) EqMode
     (Elim 0 n) (Elim 0 n)
     Error
 %name Error err
-%runElab derive "Error" [Show]
 
 public export
 ErrorEff : Type -> Type
@@ -127,35 +114,32 @@ ErrorEff = Except Error
 
 export
 Located Error where
-  (ExpectedTYPE     loc _ _).loc        = loc
-  (ExpectedPi       loc _ _).loc        = loc
-  (ExpectedSig      loc _ _).loc        = loc
-  (ExpectedEnum     loc _ _).loc        = loc
-  (ExpectedEq       loc _ _).loc        = loc
-  (ExpectedNAT      loc _ _).loc        = loc
-  (ExpectedSTRING   loc _ _).loc        = loc
-  (ExpectedBOX      loc _ _).loc        = loc
-  (ExpectedIOState  loc _ _).loc        = loc
-  (BadUniverse      loc _ _).loc        = loc
-  (TagNotIn         loc _ _).loc        = loc
-  (BadCaseEnum      loc _ _).loc        = loc
-  (BadQtys          loc _ _ _).loc      = loc
-  (ClashT           loc _ _ _ _ _).loc  = loc
-  (ClashTy          loc _ _ _ _).loc    = loc
-  (ClashE           loc _ _ _ _).loc    = loc
-  (ClashU           loc _ _ _).loc      = loc
-  (ClashQ           loc _ _).loc        = loc
-  (NotInScope       loc _).loc          = loc
-  (NotType          loc _ _).loc        = loc
-  (WrongType        loc _ _ _).loc      = loc
-  (WrongBuiltinType _ err).loc          = err.loc
-  (ExpectedSingleEnum loc _ _).loc      = loc
-  (MissingEnumArm   loc _ _).loc        = loc
-  (WhileChecking   _ _ _ _ err).loc     = err.loc
-  (WhileCheckingTy _ _ _ err).loc       = err.loc
-  (WhileInferring  _ _ _ err).loc       = err.loc
-  (WhileComparingT _ _ _ _ _ _ err).loc = err.loc
-  (WhileComparingE _ _ _ _ _ err).loc   = err.loc
+  (ExpectedTYPE    loc _ _).loc       = loc
+  (ExpectedPi      loc _ _).loc       = loc
+  (ExpectedSig     loc _ _).loc       = loc
+  (ExpectedW       loc _ _).loc       = loc
+  (ExpectedEnum    loc _ _).loc       = loc
+  (ExpectedEq      loc _ _).loc       = loc
+  (ExpectedNat     loc _ _).loc       = loc
+  (ExpectedBOX     loc _ _).loc       = loc
+  (BadUniverse     loc _ _).loc       = loc
+  (TagNotIn        loc _ _).loc       = loc
+  (BadCaseEnum     loc _ _).loc       = loc
+  (BadQtys         loc _ _ _).loc     = loc
+  (ClashT          loc _ _ _ _ _).loc = loc
+  (ClashTy         loc _ _ _ _).loc   = loc
+  (ClashE          loc _ _ _ _).loc   = loc
+  (ClashU          loc _ _ _).loc     = loc
+  (ClashQ          loc _ _).loc       = loc
+  (NotInScope      loc _).loc         = loc
+  (NotType         loc _ _).loc       = loc
+  (WrongType       loc _ _ _).loc     = loc
+  (MissingEnumArm  loc _ _).loc       = loc
+  (WhileChecking   _ _ _ _ err).loc   = err.loc
+  (WhileCheckingTy _ _ _ err).loc     = err.loc
+  (WhileInferring  _ _ _ err).loc     = err.loc
+  (WhileComparingT _ _ _ _ _ err).loc = err.loc
+  (WhileComparingE _ _ _ _ err).loc   = err.loc
 
 
 ||| separates out all the error context layers
@@ -168,10 +152,10 @@ explodeContext (WhileCheckingTy ctx s k err) =
   mapFst (WhileCheckingTy ctx s k ::) $ explodeContext err
 explodeContext (WhileInferring ctx x e err) =
   mapFst (WhileInferring ctx x e ::) $ explodeContext err
-explodeContext (WhileComparingT ctx x sg s t r err) =
-  mapFst (WhileComparingT ctx x sg s t r ::) $ explodeContext err
-explodeContext (WhileComparingE ctx x sg e f err) =
-  mapFst (WhileComparingE ctx x sg e f ::) $ explodeContext err
+explodeContext (WhileComparingT ctx x s t r err) =
+  mapFst (WhileComparingT ctx x s t r ::) $ explodeContext err
+explodeContext (WhileComparingE ctx x e f err) =
+  mapFst (WhileComparingE ctx x e f ::) $ explodeContext err
 explodeContext err = ([], err)
 
 ||| leaves the outermost context layer, and the innermost (up to) n, and removes
@@ -258,186 +242,164 @@ where
      hangDSingle "with quantities" $
       separateTight !commaD $ toSnocList' !(traverse prettyQty qs)]
 
-parameters {opts : LayoutOpts} (showContext : Bool)
-  export
-  inContext' : Bool -> a -> (a -> Eff Pretty (Doc opts)) ->
-               Doc opts -> Eff Pretty (Doc opts)
-  inContext' null ctx f doc =
-    if showContext && not null then
-      vappend doc <$> hangDSingle "in context" !(f ctx)
+export
+prettyErrorNoLoc : {opts : _} -> (showContext : Bool) -> Error ->
+                   Eff Pretty (Doc opts)
+prettyErrorNoLoc showContext = \case
+  ExpectedTYPE _ ctx s =>
+    hangDSingle "expected a type universe, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedPi _ ctx s =>
+    hangDSingle "expected a function type, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedSig _ ctx s =>
+    hangDSingle "expected a pair type, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedW _ ctx s =>
+    hangDSingle "expected an inductive (W) type, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedEnum _ ctx s =>
+    hangDSingle "expected an enumeration type, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedEq _ ctx s =>
+    hangDSingle "expected an equality type, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedNat _ ctx s =>
+    hangDSingle
+      ("expected the type" <++>
+        !(prettyTerm [<] [<] $ Nat noLoc) <+> ", but got")
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  ExpectedBOX _ ctx s =>
+    hangDSingle "expected a box type, but got"
+      !(prettyTerm ctx.dnames ctx.tnames s)
+
+  BadUniverse _ k l => pure $
+    sep ["the universe level" <++> !(prettyUniverse k),
+         "is not strictly less than" <++> !(prettyUniverse l)]
+
+  TagNotIn _ tag set =>
+    hangDSingle (hsep ["the tag", !(prettyTag tag), "is not contained in"])
+      !(prettyTerm [<] [<] $ Enum set noLoc)
+
+  BadCaseEnum _ head body => sep <$> sequence
+    [hangDSingle "case expression has head of type"
+       !(prettyTerm [<] [<] $ Enum head noLoc),
+     hangDSingle "but cases for"
+       !(prettyTerm [<] [<] $ Enum body noLoc)]
+
+  BadQtys _ what ctx arms =>
+    hangDSingle (text "inconsistent variable usage in \{what}") $
+      sep !(printCaseQtys ctx ctx.tnames arms)
+
+  ClashT _ ctx mode ty s t =>
+    inEContext ctx . sep =<< sequence
+    [hangDSingle "the term" !(prettyTerm [<] ctx.tnames s),
+     hangDSingle (text "is not \{prettyMode mode}")
+        !(prettyTerm [<] ctx.tnames t),
+     hangDSingle "at type" !(prettyTerm [<] ctx.tnames ty)]
+
+  ClashTy _ ctx mode a b =>
+    inEContext ctx . sep =<< sequence
+    [hangDSingle "the type" !(prettyTerm [<] ctx.tnames a),
+     hangDSingle (text "is not \{prettyMode mode}")
+        !(prettyTerm [<] ctx.tnames b)]
+
+  ClashE _ ctx mode e f =>
+    inEContext ctx . sep =<< sequence
+    [hangDSingle "the term" !(prettyElim [<] ctx.tnames e),
+     hangDSingle (text "is not \{prettyMode mode}")
+        !(prettyElim [<] ctx.tnames f)]
+
+  ClashU _ mode k l => pure $
+    sep ["the universe level" <++> !(prettyUniverse k),
+         text "is not \{prettyModeU mode}" <++> !(prettyUniverse l)]
+
+  ClashQ _ pi rh => pure $
+    sep ["the quantity" <++> !(prettyQty pi),
+         "is not equal to" <++> !(prettyQty rh)]
+
+  NotInScope _ x => pure $
+    hsep [!(prettyFree x), "is not in scope"]
+
+  NotType _ ctx s =>
+    inTContext ctx . sep =<< sequence
+    [hangDSingle "the term" !(prettyTerm ctx.dnames ctx.tnames s),
+     pure "is not a type"]
+
+  WrongType _ ctx ty s =>
+    inEContext ctx . sep =<< sequence
+    [hangDSingle "the term" !(prettyTerm [<] ctx.tnames s),
+     hangDSingle "cannot have type" !(prettyTerm [<] ctx.tnames ty)]
+
+  MissingEnumArm _ tag tags => pure $
+    sep [hsep ["the tag", !(prettyTag tag), "is not contained in"],
+         !(prettyTerm [<] [<] $ Enum (fromList tags) noLoc)]
+
+  WhileChecking ctx pi s a err =>
+    [|vappendBlank
+        (inTContext ctx . sep =<< sequence
+          [hangDSingle "while checking" !(prettyTerm ctx.dnames ctx.tnames s),
+           hangDSingle "has type"       !(prettyTerm ctx.dnames ctx.tnames a),
+           hangDSingle "with quantity"  !(prettyQty pi)])
+        (prettyErrorNoLoc showContext err)|]
+
+  WhileCheckingTy ctx a k err =>
+    [|vappendBlank
+        (inTContext ctx . sep =<< sequence
+          [hangDSingle "while checking" !(prettyTerm ctx.dnames ctx.tnames a),
+           pure $ text $ isTypeInUniverse k])
+        (prettyErrorNoLoc showContext err)|]
+
+  WhileInferring ctx pi e err =>
+    [|vappendBlank
+        (inTContext ctx . sep =<< sequence
+          [hangDSingle "while inferring the type of"
+              !(prettyElim ctx.dnames ctx.tnames e),
+           hangDSingle "with quantity"  !(prettyQty pi)])
+        (prettyErrorNoLoc showContext err)|]
+
+  WhileComparingT ctx mode a s t err =>
+    [|vappendBlank
+        (inEContext ctx . sep =<< sequence
+          [hangDSingle "while checking that" !(prettyTerm [<] ctx.tnames s),
+           hangDSingle (text "is \{prettyMode mode}")
+              !(prettyTerm [<] ctx.tnames t),
+           hangDSingle "at type" !(prettyTerm [<] ctx.tnames a)])
+        (prettyErrorNoLoc showContext err)|]
+
+  WhileComparingE ctx mode e f err =>
+    [|vappendBlank
+        (inEContext ctx . sep =<< sequence
+          [hangDSingle "while checking that" !(prettyElim [<] ctx.tnames e),
+           hangDSingle (text "is \{prettyMode mode}")
+              !(prettyElim [<] ctx.tnames f)])
+        (prettyErrorNoLoc showContext err)|]
+
+where
+  vappendBlank : Doc opts -> Doc opts -> Doc opts
+  vappendBlank a b = flush a `vappend` b
+
+  inTContext : TyContext d n -> Doc opts -> Eff Pretty (Doc opts)
+  inTContext ctx doc =
+    if showContext && not (null ctx) then
+      pure $ vappend doc (sep ["in context", !(prettyTyContext ctx)])
     else pure doc
 
-  export %inline
-  inTContext : TyContext d n -> Doc opts -> Eff Pretty (Doc opts)
-  inTContext ctx = inContext' (null ctx) ctx prettyTyContext
-
-  export %inline
   inEContext : EqContext n -> Doc opts -> Eff Pretty (Doc opts)
-  inEContext ctx = inContext' (null ctx) ctx prettyEqContext
+  inEContext ctx doc =
+    if showContext && not (null ctx) then
+      pure $ vappend doc (sep ["in context", !(prettyEqContext ctx)])
+    else pure doc
 
-  export
-  prettyErrorNoLoc : Error -> Eff Pretty (Doc opts)
-  prettyErrorNoLoc err0 = case err0 of
-    ExpectedTYPE _ ctx s =>
-      hangDSingle "expected a type universe, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedPi _ ctx s =>
-      hangDSingle "expected a function type, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedSig _ ctx s =>
-      hangDSingle "expected a pair type, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedEnum _ ctx s =>
-      hangDSingle "expected an enumeration type, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedEq _ ctx s =>
-      hangDSingle "expected an equality type, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedNAT _ ctx s =>
-      hangDSingle
-        ("expected the type" <++>
-          !(prettyTerm [<] [<] $ NAT noLoc) <+> ", but got")
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedSTRING _ ctx s =>
-      hangDSingle
-        ("expected the type" <++>
-          !(prettyTerm [<] [<] $ STRING noLoc) <+> ", but got")
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedBOX _ ctx s =>
-      hangDSingle "expected a box type, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    ExpectedIOState _ ctx s =>
-      hangDSingle "expected IOState, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    BadUniverse _ k l => pure $
-      sep ["the universe level" <++> !(prettyUniverse k),
-           "is not strictly less than" <++> !(prettyUniverse l)]
-
-    TagNotIn _ tag set =>
-      hangDSingle (hsep ["the tag", !(prettyTag tag), "is not contained in"])
-        !(prettyTerm [<] [<] $ Enum set noLoc)
-
-    BadCaseEnum _ head body => sep <$> sequence
-      [hangDSingle "case expression has head of type"
-         !(prettyTerm [<] [<] $ Enum head noLoc),
-       hangDSingle "but cases for"
-         !(prettyTerm [<] [<] $ Enum body noLoc)]
-
-    BadQtys _ what ctx arms =>
-      hangDSingle (text "inconsistent variable usage in \{what}") $
-        sep !(printCaseQtys ctx ctx.tnames arms)
-
-    ClashT _ ctx mode ty s t =>
-      inEContext ctx . sep =<< sequence
-      [hangDSingle "the term" !(prettyTerm [<] ctx.tnames s),
-       hangDSingle (text "is not \{prettyMode mode}")
-          !(prettyTerm [<] ctx.tnames t),
-       hangDSingle "at type" !(prettyTerm [<] ctx.tnames ty)]
-
-    ClashTy _ ctx mode a b =>
-      inEContext ctx . sep =<< sequence
-      [hangDSingle "the type" !(prettyTerm [<] ctx.tnames a),
-       hangDSingle (text "is not \{prettyMode mode}")
-          !(prettyTerm [<] ctx.tnames b)]
-
-    ClashE _ ctx mode e f =>
-      inEContext ctx . sep =<< sequence
-      [hangDSingle "the term" !(prettyElim [<] ctx.tnames e),
-       hangDSingle (text "is not \{prettyMode mode}")
-          !(prettyElim [<] ctx.tnames f)]
-
-    ClashU _ mode k l => pure $
-      sep ["the universe level" <++> !(prettyUniverse k),
-           text "is not \{prettyModeU mode}" <++> !(prettyUniverse l)]
-
-    ClashQ _ pi rh => pure $
-      sep ["the quantity" <++> !(prettyQty pi),
-           "is not equal to" <++> !(prettyQty rh)]
-
-    NotInScope _ x => pure $
-      hsep [!(prettyFree x), "is not in scope"]
-
-    NotType _ ctx s =>
-      inTContext ctx . sep =<< sequence
-      [hangDSingle "the term" !(prettyTerm ctx.dnames ctx.tnames s),
-       pure "is not a type"]
-
-    WrongType _ ctx ty s =>
-      inEContext ctx . sep =<< sequence
-      [hangDSingle "the term" !(prettyTerm [<] ctx.tnames s),
-       hangDSingle "cannot have type" !(prettyTerm [<] ctx.tnames ty)]
-
-    WrongBuiltinType b err => pure $
-      vappend
-        (sep [sep ["when checking", text $ builtinDesc b],
-              sep ["has type", !(builtinTypeDoc b)]])
-        !(prettyErrorNoLoc err)
-
-    ExpectedSingleEnum _ ctx s =>
-      hangDSingle "expected an enumeration type with one case, but got"
-        !(prettyTerm ctx.dnames ctx.tnames s)
-
-    MissingEnumArm _ tag tags => pure $
-      sep [hsep ["the tag", !(prettyTag tag), "is not contained in"],
-           !(prettyTerm [<] [<] $ Enum (fromList tags) noLoc)]
-
-    WhileChecking ctx sg s a err =>
-      [|vappendBlank
-          (inTContext ctx . sep =<< sequence
-            [hangDSingle "while checking" !(prettyTerm ctx.dnames ctx.tnames s),
-             hangDSingle "has type"       !(prettyTerm ctx.dnames ctx.tnames a),
-             hangDSingle "with quantity"  !(prettyQty sg.qty)])
-          (prettyErrorNoLoc err)|]
-
-    WhileCheckingTy ctx a k err =>
-      [|vappendBlank
-          (inTContext ctx . sep =<< sequence
-            [hangDSingle "while checking" !(prettyTerm ctx.dnames ctx.tnames a),
-             pure $ text $ isTypeInUniverse k])
-          (prettyErrorNoLoc err)|]
-
-    WhileInferring ctx sg e err =>
-      [|vappendBlank
-          (inTContext ctx . sep =<< sequence
-            [hangDSingle "while inferring the type of"
-                !(prettyElim ctx.dnames ctx.tnames e),
-             hangDSingle "with quantity" !(prettyQty sg.qty)])
-          (prettyErrorNoLoc err)|]
-
-    WhileComparingT ctx mode sg a s t err =>
-      [|vappendBlank
-          (inEContext ctx . sep =<< sequence
-            [hangDSingle "while checking that" !(prettyTerm [<] ctx.tnames s),
-             hangDSingle (text "is \{prettyMode mode}")
-                !(prettyTerm [<] ctx.tnames t),
-             hangDSingle "at type" !(prettyTerm [<] ctx.tnames a),
-             hangDSingle "with quantity" !(prettyQty sg.qty)])
-          (prettyErrorNoLoc err)|]
-
-    WhileComparingE ctx mode sg e f err =>
-      [|vappendBlank
-          (inEContext ctx . sep =<< sequence
-            [hangDSingle "while checking that" !(prettyElim [<] ctx.tnames e),
-             hangDSingle (text "is \{prettyMode mode}")
-                !(prettyElim [<] ctx.tnames f),
-             hangDSingle "with quantity" !(prettyQty sg.qty)])
-          (prettyErrorNoLoc err)|]
-
-  where
-    vappendBlank : Doc opts -> Doc opts -> Doc opts
-    vappendBlank a b = flush a `vappend` b
-
-  export
-  prettyError : Error -> Eff Pretty (Doc opts)
-  prettyError err = hangDSingle
-    !(prettyLoc err.loc)
-    !(indentD =<< prettyErrorNoLoc err)
+export
+prettyError : {opts : _} -> (showContext : Bool) ->
+              Error -> Eff Pretty (Doc opts)
+prettyError showContext err = sep <$> sequence
+  [prettyLoc err.loc, indentD =<< prettyErrorNoLoc showContext err]
diff --git a/lib/Quox/Untyped/Erase.idr b/lib/Quox/Untyped/Erase.idr
deleted file mode 100644
index 54062b4..0000000
--- a/lib/Quox/Untyped/Erase.idr
+++ /dev/null
@@ -1,568 +0,0 @@
-module Quox.Untyped.Erase
-
-import Quox.Definition as Q
-import Quox.Pretty
-import Quox.Syntax.Term.Base as Q
-import Quox.Syntax.Term.Subst
-import Quox.Typing
-import Quox.Untyped.Syntax as U
-import Quox.Whnf
-
-import Quox.EffExtra
-import Data.List1
-import Data.Singleton
-import Data.SnocVect
-import Language.Reflection
-
-%default total
-%language ElabReflection
-
-%hide TT.Name
-%hide AppView.(.head)
-
-
-public export
-data IsErased = Erased | Kept
-
-public export
-isErased : Qty -> IsErased
-isErased Zero = Erased
-isErased One  = Kept
-isErased Any  = Kept
-
-
-public export
-ErasureContext : Nat -> Nat -> Type
-ErasureContext = TyContext
-
-
-public export
-TypeError : Type
-TypeError = Typing.Error.Error
-%hide Typing.Error.Error
-
-public export
-data Error =
-  CompileTimeOnly (ErasureContext d n) (Q.Term d n)
-| WrapTypeError   TypeError
-| Postulate       Loc Name
-| WhileErasing    Name Q.Definition Error
-| MainIsErased    Loc Name
-%name Error err
-
-private %inline
-notInScope : Loc -> Name -> Error
-notInScope = WrapTypeError .: NotInScope
-
-export
-Located Error where
-  (CompileTimeOnly _ s).loc  = s.loc
-  (WrapTypeError err).loc    = err.loc
-  (Postulate loc _).loc      = loc
-  (WhileErasing _ def e).loc = e.loc `or` def.loc
-  (MainIsErased loc _).loc   = loc
-
-
-parameters {opts : LayoutOpts} (showContext : Bool)
-  export
-  prettyErrorNoLoc : Error -> Eff Pretty (Doc opts)
-  prettyErrorNoLoc (CompileTimeOnly ctx s) =
-    inTContext showContext ctx $
-    sep ["the term", !(prettyTerm ctx.dnames ctx.tnames s),
-         "only exists at compile time"]
-  prettyErrorNoLoc (WrapTypeError err) =
-    prettyErrorNoLoc showContext err
-  prettyErrorNoLoc (Postulate _ x) =
-    pure $ sep [!(prettyFree x), "is a postulate with no definition"]
-  prettyErrorNoLoc (WhileErasing x def err) = pure $
-    vsep [hsep ["while erasing the definition", !(prettyFree x)],
-          !(prettyErrorNoLoc err)]
-  prettyErrorNoLoc (MainIsErased _ x) =
-    pure $ hsep [!(prettyFree x), "is marked #[main] but is erased"]
-
-  export
-  prettyError : Error -> Eff Pretty (Doc opts)
-  prettyError err = sep <$> sequence
-    [prettyLoc err.loc, indentD =<< prettyErrorNoLoc err]
-
-
-public export
-Erase : List (Type -> Type)
-Erase = [Except Error, NameGen, Log]
-
-export
-liftWhnf : Eff Whnf a -> Eff Erase a
-liftWhnf act = lift $ wrapErr WrapTypeError act
-
-export covering
-computeElimType : Q.Definitions -> ErasureContext d n -> SQty ->
-                  Elim d n -> Eff Erase (Term d n)
-computeElimType defs ctx sg e = do
-  let ctx = toWhnfContext ctx
-  liftWhnf $ do
-    Element e _ <- whnf defs ctx sg e
-    computeElimType defs ctx sg e
-
-
-private %macro
-wrapExpect : TTImp ->
-             Elab (Q.Definitions -> TyContext d n -> Loc ->
-                   Term d n -> Eff Erase a)
-wrapExpect f_ = do
-  f <- check `(\x => ~(f_) x)
-  pure $ \defs, ctx, loc, s => liftWhnf $ f defs ctx SZero loc s
-
-
-public export
-record EraseElimResult d n where
-  constructor EraRes
-  type : Lazy (Q.Term d n)
-  term : U.Term n
-
-
-export covering
-eraseTerm' : (defs : Q.Definitions) -> (ctx : ErasureContext d n) ->
-             (ty, tm : Q.Term d n) ->
-             (0 _ : NotRedex defs (toWhnfContext ctx) SZero ty) =>
-             Eff Erase (U.Term n)
-
--- "Ψ | Γ | Σ ⊢ s ⤋ s' ⇐ A" for `s' <- eraseTerm (Ψ,Γ,Σ) A s`
---
--- in the below comments, Ψ, Γ, Σ are implicit and
--- only their extensions are written
-export covering
-eraseTerm : Q.Definitions -> ErasureContext d n ->
-            (ty, tm : Q.Term d n) -> Eff Erase (U.Term n)
-eraseTerm defs ctx ty tm = do
-  Element ty _ <- liftWhnf $ Interface.whnf defs (toWhnfContext ctx) SZero ty
-  eraseTerm' defs ctx ty tm
-
-
--- "Ψ | Γ | Σ ⊢ e ⤋ e' ⇒ A" for `EraRes A e' <- eraseElim (Ψ,Γ,Σ) e`
-export covering
-eraseElim : Q.Definitions -> ErasureContext d n -> (tm : Q.Elim d n) ->
-            Eff Erase (EraseElimResult d n)
-
-eraseTerm' defs ctx _ s@(TYPE {}) =
-  throw $ CompileTimeOnly ctx s
-
-eraseTerm' defs ctx _ s@(IOState {}) =
-  throw $ CompileTimeOnly ctx s
-
-eraseTerm' defs ctx _ s@(Pi {}) =
-  throw $ CompileTimeOnly ctx s
-
---      x : A | 0.x ⊢ s ⤋ s' ⇐ B
--- -------------------------------------
---  (λ x ⇒ s) ⤋ s'[⌷/x] ⇐ 0.(x : A) → B
---
---    x : A | π.x ⊢ s ⤋ s' ⇐ B   π ≠ 0
--- ----------------------------------------
---  (λ x ⇒ s) ⤋ (λ x ⇒ s') ⇐ π.(x : A) → B
-eraseTerm' defs ctx ty (Lam body loc) = do
-  let x = body.name
-  (qty, arg, res) <- wrapExpect `(expectPi) defs ctx loc ty
-  body            <- eraseTerm defs (extendTy qty x arg ctx) res.term body.term
-  pure $ case isErased qty of
-    Kept   => U.Lam x body loc
-    Erased => sub1 (Erased loc) body
-
-eraseTerm' defs ctx _ s@(Sig {}) =
-  throw $ CompileTimeOnly ctx s
-
---   s ⤋ s' ⇐ A    t ⤋ t' ⇐ B[s/x]
--- ---------------------------------
---  (s, t) ⤋ (s', t') ⇐ (x : A) × B
-eraseTerm' defs ctx ty (Pair fst snd loc) = do
-  (a, b) <- wrapExpect `(expectSig) defs ctx loc ty
-  let b = sub1 b (Ann fst a a.loc)
-  fst <- eraseTerm defs ctx a fst
-  snd <- eraseTerm defs ctx b snd
-  pure $ Pair fst snd loc
-
-eraseTerm' defs ctx _ s@(Enum {}) =
-  throw $ CompileTimeOnly ctx s
-
--- '𝐚 ⤋ '𝐚 ⇐ {⋯}
-eraseTerm' defs ctx _ (Tag tag loc) =
-  pure $ Tag tag loc
-
-eraseTerm' defs ctx ty s@(Eq {}) =
-  throw $ CompileTimeOnly ctx s
-
---        𝑖 ⊢ s ⤋ s' ⇐ A
--- ---------------------------------
---  (δ 𝑖 ⇒ s) ⤋ s' ⇐ Eq (𝑖 ⇒ A) l r
-eraseTerm' defs ctx ty (DLam body loc) = do
-  a <- fst <$> wrapExpect `(expectEq) defs ctx loc ty
-  eraseTerm defs (extendDim body.name ctx) a.term body.term
-
-eraseTerm' defs ctx _ s@(NAT {}) =
-  throw $ CompileTimeOnly ctx s
-
--- n ⤋ n ⇐ ℕ
-eraseTerm' _ _ _ (Nat n loc) =
-  pure $ Nat n loc
-
---       s ⤋ s' ⇐ ℕ
--- -----------------------
---  succ s ⤋ succ s' ⇐ ℕ
-eraseTerm' defs ctx ty (Succ p loc) = do
-  p <- eraseTerm defs ctx ty p
-  pure $ Succ p loc
-
-eraseTerm' defs ctx ty s@(STRING {}) =
-  throw $ CompileTimeOnly ctx s
-
--- s ⤋ s ⇐ String
-eraseTerm' _ _ _ (Str s loc) =
-  pure $ Str s loc
-
-eraseTerm' defs ctx ty s@(BOX {}) =
-  throw $ CompileTimeOnly ctx s
-
--- [s] ⤋ ⌷ ⇐ [0.A]
---
---  π ≠ 0   s ⤋ s' ⇐ A
--- --------------------
---   [s] ⤋ s' ⇐ [π.A]
-eraseTerm' defs ctx ty (Box val loc) = do
-  (qty, a) <- wrapExpect `(expectBOX) defs ctx loc ty
-  case isErased qty of
-    Erased => pure $ Erased loc
-    Kept   => eraseTerm defs ctx a val
-
---            s ⤋ s' ⇐ A
--- ---------------------------------
---   let0 x = e in s ⤋ s'[⌷/x] ⇐ A
---
---        e ⤋ e' ⇒ E   π ≠ 0
---      x : E ≔ e ⊢ s ⤋ s' ⇐ A
--- -------------------------------------
---  letπ x = e in s ⤋ let x = e' in s'
-eraseTerm' defs ctx ty (Let pi e s loc) = do
-  let x = s.name
-  case isErased pi of
-    Erased => do
-      ety <- computeElimType defs ctx SZero e
-      s'  <- eraseTerm defs (extendTyLet pi x ety (E e) ctx) (weakT 1 ty) s.term
-      pure $ sub1 (Erased e.loc) s'
-    Kept => do
-      EraRes ety e' <- eraseElim defs ctx e
-      s' <- eraseTerm defs (extendTyLet pi x ety (E e) ctx) (weakT 1 ty) s.term
-      pure $ Let True x e' s' loc
-
---  e ⤋ e' ⇒ B
--- ------------
---  e ⤋ e' ⇐ A
-eraseTerm' defs ctx ty (E e) =
-  term <$> eraseElim defs ctx e
-
-eraseTerm' defs ctx ty (CloT (Sub term th)) =
-  eraseTerm defs ctx ty $ pushSubstsWith' id th term
-
-eraseTerm' defs ctx ty (DCloT (Sub term th)) =
-  eraseTerm defs ctx ty $ pushSubstsWith' th id term
-
---  defω x : A = s
--- ----------------
---    x ⤋ x ⇒ A
-eraseElim defs ctx e@(F x u loc) = do
-  let Just def = lookup x defs
-    | Nothing => throw $ notInScope loc x
-  case isErased def.qty.qty of
-    Erased => throw $ CompileTimeOnly ctx $ E e
-    Kept   => pure $ EraRes (def.typeWith ctx.dimLen ctx.termLen) $ F x loc
-
---  π.x ∈ Σ   π ≠ 0
--- -----------------
---     x ⤋ x ⇒ A
-eraseElim defs ctx e@(B i loc) = do
-  case isErased $ ctx.qtys !!! i of
-    Erased => throw $ CompileTimeOnly ctx $ E e
-    Kept   => pure $ EraRes (ctx.tctx !! i).type $ B i loc
-
---  f ⤋ f' ⇒ π.(x : A) → B   s ⤋ s' ⇒ A   π ≠ 0
--- ---------------------------------------------
---             f s ⤋ f' s' ⇒ B[s/x]
---
---  f ⤋ f' ⇒ 0.(x : A) → B
--- -------------------------
---    f s ⤋ f' ⇒ B[s/x]
-eraseElim defs ctx (App fun arg loc) = do
-  efun              <- eraseElim defs ctx fun
-  (qty, targ, tres) <- wrapExpect `(expectPi) defs ctx loc efun.type
-  let ty = sub1 tres (Ann arg targ arg.loc)
-  case isErased qty of
-    Erased => pure $ EraRes ty efun.term
-    Kept   => do arg <- eraseTerm defs ctx targ arg
-                 pure $ EraRes ty $ App efun.term arg loc
-
---                        e ⇒ (x : A) × B
---    x : A, y : B | ρ.x, ρ.y ⊢ s ⤋ s' ⇐ R[((x,y) ∷ (x : A) × B)/z]
--- -------------------------------------------------------------------
---   (case0 e return z ⇒ R of {(x, y) ⇒ s}) ⤋ s'[⌷/x, ⌷/y] ⇒ R[e/z]
---
---                     e ⤋ e' ⇒ (x : A) × B   ρ ≠ 0
---    x : A, y : B | ρ.x, ρ.y ⊢ s ⤋ s' ⇐ R[((x,y) ∷ (x : A) × B)/z]
--- ----------------------------------------------------------------------------
---   (caseρ e return z ⇒ R of {(x, y) ⇒ s}) ⤋
---     ⤋
---   let xy = e' in let x = fst xy in let y = snd xy in s' ⇒ R[e/z]
-eraseElim defs ctx (CasePair qty pair ret body loc) = do
-  let [< x, y] = body.names
-  case isErased qty of
-    Kept => do
-      EraRes ety eterm <- eraseElim defs ctx pair
-      let ty = sub1 (ret // shift 2) $
-               Ann (Pair (BVT 0 loc) (BVT 1 loc) loc) (weakT 2 ety) loc
-      (tfst, tsnd) <- wrapExpect `(expectSig) defs ctx loc ety
-      let ctx' = extendTyN [< (qty, x, tfst), (qty, y, tsnd.term)] ctx
-      body' <- eraseTerm defs ctx' ty body.term
-      p <- mnb "p" loc
-      pure $ EraRes (sub1 ret pair) $
-        Let False p eterm
-          (Let False x (Fst (B VZ loc) loc)
-            (Let False y (Snd (B (VS VZ) loc) loc)
-              (body' // (B VZ loc ::: B (VS VZ) loc ::: shift 3))
-              loc) loc) loc
-    Erased => do
-      ety <- computeElimType defs ctx SOne pair
-      let ty = sub1 (ret // shift 2) $
-               Ann (Pair (BVT 0 loc) (BVT 1 loc) loc) (weakT 2 ety) loc
-      (tfst, tsnd) <- wrapExpect `(expectSig) defs ctx loc ety
-      let ctx' = extendTyN0 [< (x, tfst), (y, tsnd.term)] ctx
-      body' <- eraseTerm defs ctx' ty body.term
-      pure $ EraRes (sub1 ret pair) $ subN [< Erased loc, Erased loc] body'
-
---  e ⤋ e' ⇒ (x : A) × B
--- ----------------------
---   fst e ⤋ fst e' ⇒ A
-eraseElim defs ctx (Fst pair loc) = do
-  epair      <- eraseElim defs ctx pair
-  a          <- fst <$> wrapExpect `(expectSig) defs ctx loc epair.type
-  pure $ EraRes a $ Fst epair.term loc
-
---     e ⤋ e' ⇒ (x : A) × B
--- -----------------------------
---  snd e ⤋ snd e' ⇒ B[fst e/x]
-eraseElim defs ctx (Snd pair loc) = do
-  epair      <- eraseElim defs ctx pair
-  b          <- snd <$> wrapExpect `(expectSig) defs ctx loc epair.type
-  pure $ EraRes (sub1 b (Fst pair loc)) $ Snd epair.term loc
-
--- caseρ e return z ⇒ R of {} ⤋ absurd ⇒ R[e/z]
---
---               s ⤋ s' ⇐ R[𝐚∷{𝐚}/z]
--- -----------------------------------------------
---  case0 e return z ⇒ R of {𝐚 ⇒ s} ⤋ s' ⇒ R[e/z]
---
---         e ⤋ e' ⇒ A   sᵢ ⤋ s'ᵢ ⇐ R[𝐚ᵢ/z]   ρ ≠ 0   i ≠ 0
--- -------------------------------------------------------------------
---  caseρ e return z ⇒ R of {𝐚ᵢ ⇒ sᵢ} ⤋ case e of {𝐚ᵢ ⇒ s'ᵢ} ⇒ R[e/z]
-eraseElim defs ctx e@(CaseEnum qty tag ret arms loc) = do
-  let ty = sub1 ret tag
-  case isErased qty of
-    Erased => case SortedMap.toList arms of
-      []         => pure $ EraRes ty $ Absurd loc
-      [(t, rhs)] => do
-        let ty' = sub1 ret (Ann (Tag t loc) (enum [t] loc) loc)
-        rhs' <- eraseTerm defs ctx ty' rhs
-        pure $ EraRes ty rhs'
-      _ => throw $ CompileTimeOnly ctx $ E e
-    Kept => case List1.fromList $ SortedMap.toList arms of
-      Nothing   => pure $ EraRes ty $ Absurd loc
-      Just arms => do
-        etag <- eraseElim defs ctx tag
-        arms <- for arms $ \(t, rhs) => do
-          let ty' = sub1 ret (Ann (Tag t loc) etag.type loc)
-          rhs' <- eraseTerm defs ctx ty' rhs
-          pure (t, rhs')
-        pure $ EraRes ty $ CaseEnum etag.term arms loc
-
---        n ⤋ n' ⇒ ℕ   z ⤋ z' ⇐ R[zero∷ℕ/z]   ς ≠ 0
---  m : ℕ, ih : R[m/z] | ρ.m, ς.ih ⊢ s ⤋ s' ⇐ R[(succ m)∷ℕ/z]
--- -----------------------------------------------------------
---      caseρ n return z ⇒ R of {0 ⇒ z; succ m, ς.ih ⇒ s}
---        ⤋
---      case n' of {0 ⇒ z'; succ m, ih ⇒ s'} ⇒ R[n/z]
---
---             n ⤋ n' ⇒ ℕ   z ⤋ z' ⇐ R[zero∷ℕ/z]
---  m : ℕ, ih : R[m/z] | ρ.m, 0.ih ⊢ s ⤋ s' ⇐ R[(succ m)∷ℕ/z]
--- -----------------------------------------------------------
---      caseρ n return z ⇒ R of {0 ⇒ z; succ m, 0.ih ⇒ s}
---        ⤋
---      case n' of {0 ⇒ z'; succ m ⇒ s'[⌷/ih]} ⇒ R[n/z]
-eraseElim defs ctx (CaseNat qty qtyIH nat ret zero succ loc) = do
-  let ty = sub1 ret nat
-  enat <- eraseElim defs ctx nat
-  zero <- eraseTerm defs ctx (sub1 ret (Ann (Zero loc) (NAT loc) loc)) zero
-  let [< p, ih] = succ.names
-  succ' <- eraseTerm defs
-    (extendTyN [< (qty, p, NAT loc),
-                  (qtyIH, ih, sub1 (ret // shift 1) (BV 0 loc))] ctx)
-    (sub1 (ret // shift 2) (Ann (Succ (BVT 1 loc) loc) (NAT loc) loc))
-    succ.term
-  let succ = case isErased qtyIH of
-               Kept   => NSRec    p ih succ'
-               Erased => NSNonrec p    (sub1 (Erased loc) succ')
-  pure $ EraRes ty $ CaseNat enat.term zero succ loc
-
---  b ⤋ b' ⇒ [π.A]   πρ ≠ 0   x : A | πρ.x ⊢ s ⤋ s' ⇐ R[[x]∷[π.A]/z]
--- ------------------------------------------------------------------
---   caseρ b return z ⇒ R of {[x] ⇒ s} ⤋ let x = b' in s' ⇒ R[b/z]
---
---   b ⇒ [π.A]   x : A | 0.x ⊢ s ⤋ s' ⇐ R[[x]∷[0.A]/z]   πρ = 0
--- -------------------------------------------------------------
---  caseρ b return z ⇒ R of {[x] ⇒ s} ⤋ s'[⌷/x] ⇒ R[b/z]
-eraseElim defs ctx (CaseBox qty box ret body loc) = do
-  tbox <- computeElimType defs ctx SOne box
-  (pi, tinner) <- wrapExpect `(expectBOX) defs ctx loc tbox
-  let ctx' = extendTy (pi * qty) body.name tinner ctx
-      bty  = sub1 (ret // shift 1) $
-             Ann (Box (BVT 0 loc) loc) (weakT 1 tbox) loc
-  case isErased $ qty * pi of
-    Kept => do
-      ebox  <- eraseElim defs ctx box
-      ebody <- eraseTerm defs ctx' bty body.term
-      pure $ EraRes (sub1 ret box) $ Let False body.name ebox.term ebody loc
-    Erased => do
-      body' <- eraseTerm defs ctx' bty body.term
-      pure $ EraRes (sub1 ret box) $ body' // one (Erased loc)
-
---    f ⤋ f' ⇒ Eq (𝑖 ⇒ A) l r
--- ------------------------------
---      f @r ⤋ f' ⇒ A‹r/𝑖›
-eraseElim defs ctx (DApp fun arg loc) = do
-  efun <- eraseElim defs ctx fun
-  a    <- fst <$> wrapExpect `(expectEq) defs ctx loc efun.type
-  pure $ EraRes (dsub1 a arg) efun.term
-
---    s ⤋ s' ⇐ A
--- ----------------
---  s ∷ A ⤋ s' ⇒ A
-eraseElim defs ctx (Ann tm ty loc) =
-  EraRes ty <$> eraseTerm defs ctx ty tm
-
---        s ⤋ s' ⇐ A‹p/𝑖›
--- -----------------------------------
---  coe (𝑖 ⇒ A) @p @q s ⤋ s' ⇒ A‹q/𝑖›
-eraseElim defs ctx (Coe ty p q val loc) = do
-  val <- eraseTerm defs ctx (dsub1 ty p) val
-  pure $ EraRes (dsub1 ty q) val
-
---          s ⤋ s' ⇐ A
--- --------------------------------
---  comp A @p @q s @r {⋯} ⤋ s' ⇒ A
-eraseElim defs ctx (Comp ty p q val r zero one loc) =
-  EraRes ty <$> eraseTerm defs ctx ty val
-
-eraseElim defs ctx t@(TypeCase ty ret arms def loc) =
-  throw $ CompileTimeOnly ctx $ E t
-
-eraseElim defs ctx (CloE (Sub term th)) =
-  eraseElim defs ctx $ pushSubstsWith' id th term
-
-eraseElim defs ctx (DCloE (Sub term th)) =
-  eraseElim defs ctx $ pushSubstsWith' th id term
-
-
-export
-uses : Var n -> Term n -> Nat
-uses i (F {}) = 0
-uses i (B j _) = if i == j then 1 else 0
-uses i (Lam x body _) = uses (VS i) body
-uses i (App fun arg _) = uses i fun + uses i arg
-uses i (Pair fst snd _) = uses i fst + uses i snd
-uses i (Fst pair _) = uses i pair
-uses i (Snd pair _) = uses i pair
-uses i (Tag tag _) = 0
-uses i (CaseEnum tag cases _) =
-  uses i tag + foldl max 0 (map (assert_total uses i . snd) cases)
-uses i (Absurd {}) = 0
-uses i (Nat {}) = 0
-uses i (Succ nat _) = uses i nat
-uses i (CaseNat nat zer suc _) = uses i nat + max (uses i zer) (uses' suc)
-  where uses' : CaseNatSuc n -> Nat
-        uses' (NSRec  _ _ s) = uses (VS (VS i)) s
-        uses' (NSNonrec _ s) = uses (VS i) s
-uses i (Str {}) = 0
-uses i (Let _ x rhs body _) = uses i rhs + uses (VS i) body
-uses i (Erased {}) = 0
-
-export
-inlineable : U.Term n -> Bool
-inlineable (F {})      = True
-inlineable (B {})      = True
-inlineable (Tag {})    = True
-inlineable (Nat {})    = True
-inlineable (Str {})    = True
-inlineable (Absurd {}) = True
-inlineable (Erased {}) = True
-inlineable _           = False
-
-export
-droppable : U.Term n -> Bool
-droppable (F {})      = True
-droppable (B {})      = True
-droppable (Fst e _)   = droppable e
-droppable (Snd e _)   = droppable e
-droppable (Tag {})    = True
-droppable (Nat {})    = True
-droppable (Str {})    = True
-droppable (Absurd {}) = True
-droppable (Erased {}) = True
-droppable _           = False
-
-export
-trimLets : U.Term n -> U.Term n
-trimLets (F x loc) = F x loc
-trimLets (B i loc) = B i loc
-trimLets (Lam x body loc) = Lam x (trimLets body) loc
-trimLets (App fun arg loc) = App (trimLets fun) (trimLets arg) loc
-trimLets (Pair fst snd loc) = Pair (trimLets fst) (trimLets snd) loc
-trimLets (Fst pair loc) = Fst (trimLets pair) loc
-trimLets (Snd pair loc) = Snd (trimLets pair) loc
-trimLets (Tag tag loc) = Tag tag loc
-trimLets (CaseEnum tag cases loc) =
-  let tag   = trimLets tag
-      cases = map (map $ \c => trimLets $ assert_smaller cases c) cases in
-  if droppable tag && length cases == 1
-     then snd cases.head
-     else CaseEnum tag cases loc
-trimLets (Absurd loc) = Absurd loc
-trimLets (Nat n loc) = Nat n loc
-trimLets (Succ nat loc) = Succ (trimLets nat) loc
-trimLets (CaseNat nat zer suc loc) =
-  CaseNat (trimLets nat) (trimLets zer) (trimLets' suc) loc
-  where trimLets' : CaseNatSuc n -> CaseNatSuc n
-        trimLets' (NSRec x ih s) = NSRec    x ih $ trimLets s
-        trimLets' (NSNonrec x s) = NSNonrec x    $ trimLets s
-trimLets (Str s loc) = Str s loc
-trimLets (Let True x rhs body loc) =
-  Let True x (trimLets rhs) (trimLets body) loc
-trimLets (Let False x rhs body loc) =
-  let rhs'  = trimLets rhs
-      body' = trimLets body
-      uses  = uses VZ body in
-  if inlineable rhs' || uses == 1 || (droppable rhs' && uses == 0)
-     then sub1 rhs' body'
-     else Let False x rhs' body' loc
-trimLets (Erased loc) = Erased loc
-
-
-export covering
-eraseDef : Q.Definitions -> Name -> Q.Definition -> Eff Erase U.Definition
-eraseDef defs name def@(MkDef qty type body scheme isMain loc) =
-  wrapErr (WhileErasing name def) $
-  case isErased qty.qty of
-    Erased => do
-      when isMain $ throw $ MainIsErased loc name
-      pure ErasedDef
-    Kept   =>
-      case scheme of
-        Just str => pure $ SchemeDef isMain str
-        Nothing  => case body of
-          Postulate     => throw $ Postulate loc name
-          Concrete body => KeptDef isMain . trimLets <$>
-                           eraseTerm defs empty type body
diff --git a/lib/Quox/Untyped/Scheme.idr b/lib/Quox/Untyped/Scheme.idr
deleted file mode 100644
index b193598..0000000
--- a/lib/Quox/Untyped/Scheme.idr
+++ /dev/null
@@ -1,378 +0,0 @@
-module Quox.Untyped.Scheme
-
-import Quox.Name
-import Quox.Context
-import Quox.Untyped.Syntax
-import Quox.Pretty
-
-import Quox.EffExtra
-import Quox.CharExtra
-import Quox.NatExtra
-import Data.DPair
-import Data.List1
-import Data.String
-import Data.SortedSet
-import Data.Vect
-import Derive.Prelude
-
-%default total
-%language ElabReflection
-
-%hide TT.Name
-
-
-
-export
-isSchemeInitial : Char -> Bool
-isSchemeInitial c =
-  let gc = genCat c in
-  isLetter gc || isSymbol gc && c /= '|' ||
-  gc == Number Letter ||
-  gc == Number Other ||
-  gc == Mark NonSpacing ||
-  gc == Punctuation Dash ||
-  gc == Punctuation Connector ||
-  gc == Punctuation Other && c /= '\'' && c /= '\\' ||
-  gc == Other PrivateUse ||
-  (c `elem` unpack "!$%&*/:<=>?~_^")
-
-export
-isSchemeSubsequent : Char -> Bool
-isSchemeSubsequent c =
-  let gc = genCat c in
-  isSchemeInitial c ||
-  isNumber gc ||
-  isMark gc ||
-  (c `elem` unpack ".+-@")
-
-export
-isSchemeId : String -> Bool
-isSchemeId str =
-  str == "1+" || str == "1-" ||
-  case unpack str of
-    []      => False
-    c :: cs => isSchemeInitial c && all isSchemeSubsequent cs
-
-export
-escId : String -> String
-escId str =
-  let str' = concatMap doEsc $ unpack str in
-  if isSchemeId str' then str' else "|\{str}|"
-where
-  doEsc : Char -> String
-  doEsc '\\' = "\\\\"
-  doEsc '|'  = "\\|"
-  doEsc '\'' = "^"
-  doEsc c    = singleton c
-
-
-public export
-data Id = I String Nat
-%runElab derive "Id" [Eq, Ord]
-
-export
-prettyId' : {opts : LayoutOpts} -> Id -> Doc opts
-prettyId' (I str 0) = text $ escId str
-prettyId' (I str k) = text $ escId "\{str}:\{show k}"
-
-export
-prettyId : {opts : LayoutOpts} -> Id -> Eff Pretty (Doc opts)
-prettyId x = hl TVar $ prettyId' x
-
-
-public export
-data StateTag = AVOID | MAIN
-
-public export
-Scheme : List (Type -> Type)
-Scheme = [StateL AVOID (SortedSet Id), StateL MAIN (List Id)]
-  -- names to avoid, and functions with #[main] (should only be one)
-
-
-public export
-data Sexp =
-  V Id
-| L (List Sexp)
-| Q Sexp
-| N Nat
-| S String
-| Lambda (List Id) Sexp
-| LambdaC (List Id) Sexp -- curried lambda
-| Let Id Sexp Sexp
-| Case Sexp (List1 (List Sexp, Sexp))
-| Define Id Sexp
-| Literal String
-
-export
-FromString Sexp where fromString s = V $ I s 0
-
-
-private
-makeIdBase : Mods -> String -> String
-makeIdBase mods str = joinBy "." $ toList $ mods :< str
-
-export
-makeId : Name -> Id
-makeId (MkName mods (UN str))   = I (makeIdBase mods str) 0
-makeId (MkName mods (MN str k)) = I (makeIdBase mods str) 0
-makeId (MkName mods Unused)     = I (makeIdBase mods "_") 0
-
-export
-makeIdB : BindName -> Id
-makeIdB (BN name _) = makeId $ MkName [<] name
-
-private
-bump : Id -> Id
-bump (I x i) = I x (S i)
-
-export covering
-getFresh : SortedSet Id -> Id -> Id
-getFresh used x =
-  if contains x used then getFresh used (bump x) else x
-
-export covering
-freshIn : Id -> (Id -> Eff Scheme a) -> Eff Scheme a
-freshIn x k =
-  let x = getFresh !(getAt AVOID) x in
-  localAt AVOID (insert x) $ k x
-
-export covering
-freshInB : BindName -> (Id -> Eff Scheme a) -> Eff Scheme a
-freshInB x = freshIn (makeIdB x)
-
-export covering
-freshInBT : Telescope' BindName m n ->
-            (Telescope' Id m n -> Eff Scheme a) ->
-            Eff Scheme a
-freshInBT xs act = do
-  let (xs', used') = go (map makeIdB xs) !(getAt AVOID)
-  localAt_ AVOID used' $ act xs'
-where
-  go : forall n. Telescope' Id m n ->
-       SortedSet Id -> (Telescope' Id m n, SortedSet Id)
-  go [<]       used = ([<], used)
-  go (xs :< x) used =
-    let x          = getFresh used x
-        (xs, used) = go xs (insert x used)
-    in
-    (xs :< x, used)
-
-export covering
-freshInBC : Context' BindName n -> (Context' Id n -> Eff Scheme a) ->
-            Eff Scheme a
-freshInBC = freshInBT
-
-export covering
-toScheme : Context' Id n -> Term n -> Eff Scheme Sexp
-toScheme xs (F x _) = pure $ V $ makeId x
-
-toScheme xs (B i _) = pure $ V $ xs !!! i
-
-toScheme xs (Lam x body _) =
-  let Evidence n' (ys, body) = splitLam [< x] body in
-  freshInBT ys $ \ys => do
-    pure $ LambdaC (toList' ys) !(toScheme (xs . ys) body)
-
-toScheme xs (App fun arg _) = do
-  let (fun, args) = splitApp fun
-  fun  <- toScheme xs fun
-  args <- traverse (toScheme xs) args
-  arg  <- toScheme xs arg
-  pure $ if null args
-            then L [fun, arg]
-            else L $ "%" :: fun :: toList (args :< arg)
-
-toScheme xs (Pair fst snd _) =
-  pure $ L ["cons", !(toScheme xs fst), !(toScheme xs snd)]
-
-toScheme xs (Fst pair _) =
-  pure $ L ["car", !(toScheme xs pair)]
-
-toScheme xs (Snd pair _) =
-  pure $ L ["cdr", !(toScheme xs pair)]
-
-toScheme xs (Tag tag _) =
-  pure $ Q $ fromString tag
-
-toScheme xs (CaseEnum tag cases _) =
-  Case <$> toScheme xs tag
-       <*> for cases (\(t, rhs) => ([fromString t],) <$> toScheme xs rhs)
-
-toScheme xs (Absurd _) =
-  pure $ Q "absurd"
-
-toScheme xs (Nat n _) =
-  pure $ N n
-
-toScheme xs (Succ nat _) =
-  pure $ L ["+", !(toScheme xs nat), N 1]
-
-toScheme xs (CaseNat nat zer (NSRec p ih suc) _) =
-  freshInBC [< p, ih] $ \[< p, ih] =>
-  pure $
-    L ["case-nat-rec",
-       Lambda []      !(toScheme xs zer),
-       Lambda [p, ih] !(toScheme (xs :< p :< ih) suc),
-       !(toScheme xs nat)]
-
-toScheme xs (Str s _) = pure $ S s
-
-toScheme xs (CaseNat nat zer (NSNonrec p suc) _) =
-  freshInB p $ \p =>
-  pure $
-    L ["case-nat-nonrec",
-       Lambda []  !(toScheme xs zer),
-       Lambda [p] !(toScheme (xs :< p) suc),
-       !(toScheme xs nat)]
-
-toScheme xs (Let _ x rhs body _) =
-  freshInB x $ \x =>
-  pure $ Let x !(toScheme xs rhs) !(toScheme (xs :< x) body)
-
-toScheme xs (Erased _) =
-  pure $ Q "erased"
-
-
-export
-prelude : String
-prelude = """
-#!r6rs
-(import (rnrs))
-
-; curried lambda
-(define-syntax lambda%
-  (syntax-rules ()
-    [(_ (x . xs) . body) (lambda (x) (lambda% xs . body))]
-    [(_ ()       . body) (begin . body)]))
-
-; curried application
-(define-syntax %
-  (syntax-rules ()
-    [(_ e0 e1 . es) (% (e0 e1) . es)]
-    [(_ e) e]))
-
-; curried function definition
-(define-syntax define%
-  (syntax-rules ()
-    [(_ (f . xs) . body) (define f (lambda% xs . body))]
-    [(_ f        . body) (define f . body)]))
-
-(define-syntax builtin-io
-  (syntax-rules ()
-    [(_ . body) (lambda (s) (cons (begin . body) s))]))
-
-(define (case-nat-rec z s n)
-  (do [(i 0 (+ i 1)) (acc (z) (s i acc))]
-      [(= i n) acc]))
-
-(define (case-nat-nonrec z s n)
-  (if (= n 0) (z) (s (- n 1))))
-
-(define (run-main f) (f 'io-state))
-"""
-
-export
-escape : String -> String
-escape = foldMap esc1 . unpack where
-  esc1 : Char -> String
-  esc1 c =
-    if c == '\\' || c == '"' then
-      "\\" ++ singleton c
-    else if c < ' ' || c > '~' then
-      "\\x" ++ showHex (ord c) ++ ";"
-    else singleton c
-
-export covering
-defToScheme : Name -> Definition -> Eff Scheme (Maybe Sexp)
-defToScheme x ErasedDef = pure Nothing
-defToScheme x (KeptDef isMain def) = do
-  let x = makeId x
-  when isMain $ modifyAt MAIN (x ::)
-  modifyAt AVOID $ insert x
-  pure $ Just $ Define x !(toScheme [<] def)
-defToScheme x (SchemeDef isMain str) = do
-  let x = makeId x
-  when isMain $ modifyAt MAIN (x ::)
-  modifyAt AVOID $ insert x
-  pure $ Just $ Define x $ Literal str
-
-orIndent : {opts : LayoutOpts} -> Doc opts -> Doc opts -> Eff Pretty (Doc opts)
-orIndent a b = do
-  one <- parens $ a <++> b
-  two <- parens $ a `vappend` indent 2 b
-  pure $ ifMultiline one two
-
-export covering
-prettySexp : {opts : LayoutOpts} -> Sexp -> Eff Pretty (Doc opts)
-
-private covering
-prettyLambda : {opts : LayoutOpts} ->
-               String -> List Id -> Sexp -> Eff Pretty (Doc opts)
-prettyLambda lam xs e =
-  orIndent
-    (hsep [!(hl Syntax $ text lam), !(prettySexp $ L $ map V xs)])
-    !(prettySexp e)
-
-private covering
-prettyBind : {opts : LayoutOpts} -> (Id, Sexp) -> Eff Pretty (Doc opts)
-prettyBind (x, e) = parens $ sep [!(prettyId x), !(prettySexp e)]
-
-private covering
-prettyLet : {opts : LayoutOpts} ->
-            SnocList (Id, Sexp) -> Sexp -> Eff Pretty (Doc opts)
-prettyLet ps (Let x rhs body) = prettyLet (ps :< (x, rhs)) body
-prettyLet ps e =
-  orIndent
-    (hsep [!(hl Syntax "let*"),
-           !(bracks . vsep . toList =<< traverse prettyBind ps)])
-    !(prettySexp e)
-
-private covering
-prettyDefine : {opts : LayoutOpts} ->
-               String -> Either Id (List Id) -> Sexp -> Eff Pretty (Doc opts)
-prettyDefine def xs body =
-  parens $ vappend
-    (hsep [!(hl Syntax $ text def),
-           !(either prettyId (prettySexp . L . map V) xs)])
-    (indent 2 !(prettySexp body))
-
-prettySexp (V x) = prettyId x
-prettySexp (L []) = hl Delim "()"
-prettySexp (L (x :: xs)) = do
-  d  <- prettySexp x
-  ds <- traverse prettySexp xs
-  parens $ ifMultiline
-    (hsep $ d :: ds)
-    (hsep [d, vsep ds] <|> vsep (d :: map (indent 2) ds))
-prettySexp (Q (V x)) = hl Constant $ "'" <+> prettyId' x
-prettySexp (Q x) = pure $ hcat [!(hl Constant "'"), !(prettySexp x)]
-prettySexp (N n) = hl Constant $ pshow n
-prettySexp (S s) = prettyStrLit $ escape s
-prettySexp (Lambda xs e) = prettyLambda "lambda" xs e
-prettySexp (LambdaC xs e) = prettyLambda "lambda%" xs e
-prettySexp (Let x rhs e) = prettyLet [< (x, rhs)] e
-prettySexp (Case h as) = do
-  header' <- prettySexp h
-  case_   <- caseD
-  let header = ifMultiline (case_ <++> header')
-                           (case_ `vappend` indent 2 header')
-  arms <- traverse prettyCase $ toList as
-  pure $ ifMultiline
-    (parens $ header <++> hsep arms)
-    (parens $ vsep $ header :: map (indent 2) arms)
-where
-  prettyCase : (List Sexp, Sexp) -> Eff Pretty (Doc opts)
-  prettyCase (ps, e) = bracks $
-    ifMultiline
-      (hsep [!(parens . hsep =<< traverse prettySexp ps), !(prettySexp e)])
-      (vsep [!(parens .  sep =<< traverse prettySexp ps), !(prettySexp e)])
-prettySexp (Define x e) = case e of
-  LambdaC xs e => prettyDefine "define%" (Right $ x :: xs) e
-  Lambda  xs e => prettyDefine "define"  (Right $ x :: xs) e
-  _            => prettyDefine "define"  (Left x)          e
-prettySexp (Literal sexp) =
-  pure $ text sexp
-
-export covering
-makeRunMain : {opts : LayoutOpts} -> Id -> Eff Pretty (Doc opts)
-makeRunMain x = prettySexp $ L ["run-main", V x]
diff --git a/lib/Quox/Untyped/Syntax.idr b/lib/Quox/Untyped/Syntax.idr
deleted file mode 100644
index 06f02f0..0000000
--- a/lib/Quox/Untyped/Syntax.idr
+++ /dev/null
@@ -1,308 +0,0 @@
-module Quox.Untyped.Syntax
-
-import Quox.Var
-import Quox.Context
-import Quox.Name
-import Quox.Pretty
-import Quox.Syntax.Subst
-
-import Data.Vect
-import Data.DPair
-import Data.SortedMap
-import Data.SnocVect
-import Derive.Prelude
-%hide TT.Name
-
-%default total
-%language ElabReflection
-
-
-public export
-data Term : Nat -> Type
-
-public export
-data CaseNatSuc : Nat -> Type
-
-data Term where
-  F : (x : Name) -> Loc -> Term n
-  B : (i : Var n) -> Loc -> Term n
-
-  Lam : (x : BindName) -> (body : Term (S n)) -> Loc -> Term n
-  App : (fun, arg : Term n) -> Loc -> Term n
-
-  Pair : (fst, snd : Term n) -> Loc -> Term n
-  Fst : (pair : Term n) -> Loc -> Term n
-  Snd : (pair : Term n) -> Loc -> Term n
-
-  Tag : (tag : String) -> Loc -> Term n
-  CaseEnum : (tag : Term n) -> (cases : List1 (String, Term n)) -> Loc -> Term n
-  ||| empty match
-  Absurd : Loc -> Term n
-
-  Nat : (val : Nat) -> Loc -> Term n
-  Succ : (nat : Term n) -> Loc -> Term n
-  CaseNat : (nat : Term n) -> (zer : Term n) -> (suc : CaseNatSuc n) ->
-            Loc -> Term n
-
-  Str : (str : String) -> Loc -> Term n
-
-  ||| bool is true if the let comes from the original source code
-  Let : (real : Bool) -> (x : BindName) -> (rhs : Term n) ->
-        (body : Term (S n)) -> Loc -> Term n
-
-  Erased : Loc -> Term n
-%name Term s, t, u
-
-data CaseNatSuc where
-  NSRec    : (x, ih : BindName) -> Term (2 + n) -> CaseNatSuc n
-  NSNonrec : (x     : BindName) -> Term (S n)   -> CaseNatSuc n
-%name CaseNatSuc suc
-
-%runElab deriveParam $
-  map (\ty => PI ty allIndices [Eq, Ord, Show]) ["Term", "CaseNatSuc"]
-
-
-export
-Located (Term n) where
-  (F _ loc).loc           = loc
-  (B _ loc).loc           = loc
-  (Lam _ _ loc).loc       = loc
-  (App _ _ loc).loc       = loc
-  (Pair _ _ loc).loc      = loc
-  (Fst _ loc).loc         = loc
-  (Snd _ loc).loc         = loc
-  (Tag _ loc).loc         = loc
-  (CaseEnum _ _ loc).loc  = loc
-  (Absurd loc).loc        = loc
-  (Nat _ loc).loc         = loc
-  (Succ _ loc).loc        = loc
-  (CaseNat _ _ _ loc).loc = loc
-  (Str _ loc).loc         = loc
-  (Let _ _ _ _ loc).loc   = loc
-  (Erased loc).loc        = loc
-
-
-public export
-data Definition =
-  ErasedDef
-| KeptDef   Bool (Term 0)
-| SchemeDef Bool String
-  -- bools are presence of #[main] flag
-
-public export
-0 Definitions : Type
-Definitions = SortedMap Name Definition
-
-public export
-0 NDefinition : Type
-NDefinition = (Name, Definition)
-
-
-export covering
-prettyTerm : {opts : LayoutOpts} -> BContext n ->
-             Term n -> Eff Pretty (Doc opts)
-
-export covering
-prettyArg : {opts : LayoutOpts} -> BContext n -> Term n -> Eff Pretty (Doc opts)
-prettyArg xs arg = withPrec Arg $ prettyTerm xs arg
-
-export covering
-prettyApp_ : {opts : LayoutOpts} -> BContext n ->
-             Doc opts -> SnocList (Term n) -> Eff Pretty (Doc opts)
-prettyApp_ xs fun args =
-  parensIfM App =<<
-    prettyAppD fun (toList !(traverse (prettyArg xs) args))
-
-export covering %inline
-prettyApp : {opts : LayoutOpts} -> BContext n ->
-            Term n -> SnocList (Term n) -> Eff Pretty (Doc opts)
-prettyApp xs fun args =
-  prettyApp_ xs !(prettyArg xs fun) args
-
-public export
-record PrettyCaseArm a n where
-  constructor MkPrettyCaseArm
-  lhs : a
-  {len : Nat}
-  vars : Vect len BindName
-  rhs : Term (len + n)
-
-export covering
-prettyCase : {opts : LayoutOpts} -> BContext n ->
-             (a -> Eff Pretty (Doc opts)) ->
-             Term n -> List (PrettyCaseArm a n) ->
-             Eff Pretty (Doc opts)
-prettyCase xs f head arms =
-  parensIfM Outer =<< do
-    header <- hsep <$> sequence [caseD, prettyTerm xs head, ofD]
-    cases  <- for arms $ \(MkPrettyCaseArm lhs ys rhs) => do
-      lhs <- hsep <$> sequence [f lhs, darrowD]
-      rhs <- withPrec Outer $ prettyTerm (xs <>< ys) rhs
-      hangDSingle lhs rhs
-    lb <- hl Delim "{"; sc <- semiD; rb <- hl Delim "}"; d <- askAt INDENT
-    pure $ ifMultiline
-      (hsep [header, lb, separateTight sc cases, rb])
-      (vsep [hsep [header, lb], indent d $ vsep (map (<+> sc) cases), rb])
-
-private
-sucPat : {opts : LayoutOpts} -> BindName -> Eff Pretty (Doc opts)
-sucPat x = pure $ !succD <++> !(prettyTBind x)
-
-export
-splitApp : Term n -> (Term n, SnocList (Term n))
-splitApp (App f x _) = mapSnd (:< x) $ splitApp f
-splitApp f           = (f, [<])
-
-export
-splitPair : Term n -> List (Term n)
-splitPair (Pair s t _) = s :: splitPair t
-splitPair t            = [t]
-
-export
-splitLam : Telescope' BindName a b -> Term b ->
-           Exists $ \c => (Telescope' BindName a c, Term c)
-splitLam ys (Lam x body _) = splitLam (ys :< x) body
-splitLam ys t              = Evidence _ (ys, t)
-
-export
-splitLet : Telescope (\i => (BindName, Term i)) a b -> Term b ->
-           Exists $ \c => (Telescope (\i => (BindName, Term i)) a c, Term c)
-splitLet ys (Let _ x rhs body _) = splitLet (ys :< (x, rhs)) body
-splitLet ys t                    = Evidence _ (ys, t)
-
-private covering
-prettyLets : {opts : LayoutOpts} ->
-             BContext a -> Telescope (\i => (BindName, Term i)) a b ->
-             Eff Pretty (SnocList (Doc opts))
-prettyLets xs lets = sequence $ snd $ go lets where
-  go : forall b. Telescope (\i => (BindName, Term i)) a b ->
-       (BContext b, SnocList (Eff Pretty (Doc opts)))
-  go [<]                = (xs, [<])
-  go (lets :< (x, rhs)) =
-    let (ys, docs) = go lets
-        doc = do
-          x   <- prettyTBind x
-          rhs <- withPrec Outer $ prettyTerm ys rhs
-          hangDSingle (hsep [!letD, x, !cstD]) (hsep [rhs, !inD]) in
-    (ys :< x, docs :< doc)
-
-private
-sucCaseArm : {opts : LayoutOpts} ->
-             CaseNatSuc n -> Eff Pretty (PrettyCaseArm (Doc opts) n)
-sucCaseArm (NSRec x ih s) = pure $
-  MkPrettyCaseArm (!(sucPat x) <+> !commaD <++> !(prettyTBind ih)) [x, ih] s
-sucCaseArm (NSNonrec x s) = pure $
-  MkPrettyCaseArm !(sucPat x) [x] s
-
-prettyTerm _  (F x _) = prettyFree x
-prettyTerm xs (B i _) = prettyTBind $ xs !!! i
-prettyTerm xs (Lam x body _) =
-  parensIfM Outer =<< do
-    let Evidence n' (ys, body) = splitLam [< x] body
-    vars <- hsep . toList' <$> traverse prettyTBind ys
-    body <- withPrec Outer $ prettyTerm (xs . ys) body
-    hangDSingle (hsep [!lamD, vars, !darrowD]) body
-prettyTerm xs (App fun arg _) = do
-  let (fun, args) = splitApp fun
-  prettyApp xs fun (args :< arg)
-prettyTerm xs (Pair fst snd _) =
-  parens . separateTight !commaD =<<
-    traverse (withPrec Outer . prettyTerm xs) (fst :: splitPair snd)
-prettyTerm xs (Fst pair _) = prettyApp_ xs !fstD [< pair]
-prettyTerm xs (Snd pair _) = prettyApp_ xs !sndD [< pair]
-prettyTerm xs (Tag tag _) = prettyTag tag
-prettyTerm xs (CaseEnum tag cases _) =
-  prettyCase xs prettyTag tag $
-    map (\(t, rhs) => MkPrettyCaseArm t [] rhs) $ toList cases
-prettyTerm xs (Absurd _) = hl Syntax "absurd"
-prettyTerm xs (Nat n _) = hl Constant $ pshow n
-prettyTerm xs (Succ nat _) = prettyApp_ xs !succD [< nat]
-prettyTerm xs (CaseNat nat zer suc _) =
-  prettyCase xs pure nat [MkPrettyCaseArm !zeroD [] zer, !(sucCaseArm suc)]
-prettyTerm xs (Str s _) =
-  prettyStrLit s
-prettyTerm xs (Let _ x rhs body _) =
-  parensIfM Outer =<< do
-    let Evidence n' (lets, body) = splitLet [< (x, rhs)] body
-    heads <- prettyLets xs lets
-    body  <- withPrec Outer $ prettyTerm (xs . map fst lets) body
-    let lines = toList $ heads :< body
-    pure $ ifMultiline (hsep lines) (vsep lines)
-prettyTerm _ (Erased _) =
-  hl Syntax =<< ifUnicode "□" "[]"
-
-export covering
-prettyDef : {opts : LayoutOpts} -> Name ->
-            Definition -> Eff Pretty (Doc opts)
-prettyDef name ErasedDef =
-  pure $ hsep [!(prettyFree name), !cstD, !(prettyTerm [<] $ Erased noLoc)]
-prettyDef name (KeptDef isMain rhs) = do
-  name <- prettyFree name {opts}
-  eq   <- cstD
-  rhs  <- withPrec Outer $ prettyTerm [<] rhs
-  let header = if isMain then text "#[main]" <++> name else name
-  hangDSingle (header <++> eq) rhs
-prettyDef name (SchemeDef isMain str) = do
-  name <- prettyFree name {opts}
-  eq   <- cstD
-  let rhs = text $ "scheme:" ++ str
-  let header = if isMain then text "#[main]" <++> name else name
-  hangDSingle (header <++> eq) rhs
-
-
-public export
-USubst : Nat -> Nat -> Type
-USubst = Subst Term
-
-
-public export FromVar Term where fromVarLoc = B
-
-
-public export
-CanSubstSelf Term where
-  s // th = case s of
-    F x loc =>
-      F x loc
-    B i loc =>
-      getLoc th i loc
-    Lam x body loc =>
-      Lam x (assert_total $ body // push x.loc th) loc
-    App fun arg loc =>
-      App (fun // th) (arg // th) loc
-    Pair fst snd loc =>
-      Pair (fst // th) (snd // th) loc
-    Fst pair loc =>
-      Fst (pair // th) loc
-    Snd pair loc =>
-      Snd (pair // th) loc
-    Tag tag loc =>
-      Tag tag loc
-    CaseEnum tag cases loc =>
-      CaseEnum (tag // th) (map (assert_total mapSnd (// th)) cases) loc
-    Absurd loc =>
-      Absurd loc
-    Nat n loc =>
-      Nat n loc
-    Succ nat loc =>
-      Succ (nat // th) loc
-    CaseNat nat zer suc loc =>
-      CaseNat (nat // th) (zer // th) (assert_total substSuc suc th) loc
-    Str s loc =>
-      Str s loc
-    Let u x rhs body loc =>
-      Let u x (rhs // th) (assert_total $ body // push x.loc th) loc
-    Erased loc =>
-      Erased loc
-  where
-    substSuc : forall from, to.
-               CaseNatSuc from -> USubst from to -> CaseNatSuc to
-    substSuc (NSRec    x ih t) th = NSRec    x ih $ t // pushN 2 x.loc th
-    substSuc (NSNonrec x    t) th = NSNonrec x    $ t // push    x.loc th
-
-public export
-subN : SnocVect s (Term n) -> Term (s + n) -> Term n
-subN th t = t // fromSnocVect th
-
-public export
-sub1 : Term n -> Term (S n) -> Term n
-sub1 e = subN [< e]
diff --git a/lib/Quox/Whnf.idr b/lib/Quox/Whnf.idr
deleted file mode 100644
index fb25a58..0000000
--- a/lib/Quox/Whnf.idr
+++ /dev/null
@@ -1,5 +0,0 @@
-module Quox.Whnf
-
-import public Quox.Whnf.Interface       as Quox.Whnf
-import public Quox.Whnf.ComputeElimType as Quox.Whnf
-import public Quox.Whnf.Main            as Quox.Whnf
diff --git a/lib/Quox/Whnf/Coercion.idr b/lib/Quox/Whnf/Coercion.idr
deleted file mode 100644
index b086fc3..0000000
--- a/lib/Quox/Whnf/Coercion.idr
+++ /dev/null
@@ -1,252 +0,0 @@
-module Quox.Whnf.Coercion
-
-import Quox.Whnf.Interface
-import Quox.Whnf.ComputeElimType
-import Quox.Whnf.TypeCase
-
-%default total
-
-
-
-private
-coeScoped : {s : Nat} -> DScopeTerm d n -> Dim d -> Dim d -> Loc ->
-            ScopeTermN s d n -> ScopeTermN s d n
-coeScoped ty p q loc (S names (N body)) =
-  S names $ N $ E $ Coe ty p q body loc
-coeScoped ty p q loc (S names (Y body)) =
-  SY names $ E $ Coe (weakDS s ty) p q body loc
-where
-  weakDS : (by : Nat) -> DScopeTerm d n -> DScopeTerm d (by + n)
-  weakDS by (S names (Y body)) = S names $ Y $ weakT by body
-  weakDS by (S names (N body)) = S names $ N $ weakT by body
-
-
-parameters {auto _ : CanWhnf Term Interface.isRedexT}
-           {auto _ : CanWhnf Elim Interface.isRedexE}
-           (defs : Definitions) (ctx : WhnfContext d n) (sg : SQty)
-  ||| reduce a function application `App (Coe ty p q val) s loc`
-  export covering
-  piCoe : (ty : DScopeTerm d n) -> (p, q : Dim d) ->
-          (val, s : Term d n) -> Loc ->
-          Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx sg))
-  piCoe sty@(S [< i] ty) p q val s loc = do
-    -- (coe [i ⇒ π.(x : A) → B] @p @q t) s ⇝
-    -- coe [i ⇒ B[𝒔‹i›/x] @p @q ((t ∷ (π.(x : A) → B)‹p/i›) 𝒔‹p›)
-    --   where 𝒔‹j› ≔ coe [i ⇒ A] @q @j s
-    --
-    -- type-case is used to expose A,B if the type is neutral
-    let ctx1 = extendDim i ctx
-    Element ty tynf <- whnf defs ctx1 SZero $ getTerm ty
-    (arg, res) <- tycasePi defs ctx1 ty
-    let s0   = CoeY i arg q p s s.loc
-        body = E $ App (Ann val (ty // one p) val.loc) (E s0) loc
-        s1   = CoeY i (arg // (BV 0 i.loc ::: shift 2)) (weakD 1 q) (BV 0 i.loc)
-                    (s // shift 1) s.loc
-    whnf defs ctx sg $ CoeY i (sub1 res s1) p q body loc
-
-  ||| reduce a pair elimination `CasePair pi (Coe ty p q val) ret body loc`
-  export covering
-  sigCoe : (qty : Qty) ->
-           (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
-           (ret : ScopeTerm d n) -> (body : ScopeTermN 2 d n) -> Loc ->
-           Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx sg))
-  sigCoe qty sty@(S [< i] ty) p q val ret body loc = do
-    -- caseπ (coe [i ⇒ (x : A) × B] @p @q s) return z ⇒ C of { (a, b) ⇒ e }
-    --   ⇝
-    -- caseπ s ∷ ((x : A) × B)‹p/i› return z ⇒ C
-    -- of { (a, b) ⇒
-    --   e[(coe [i ⇒ A] @p @q a)/a,
-    --     (coe [i ⇒ B[(coe [j ⇒ A‹j/i›] @p @i a)/x]] @p @q b)/b] }
-    --
-    -- type-case is used to expose A,B if the type is neutral
-    let ctx1 = extendDim i ctx
-    Element ty tynf <- whnf defs ctx1 SZero $ getTerm ty
-    (tfst, tsnd) <- tycaseSig defs ctx1 ty
-    let [< x, y] = body.names
-        a' = CoeY i (weakT 2 tfst) p q (BVT 1 x.loc) x.loc
-        tsnd' = tsnd.term //
-          (CoeY i (weakT 2 $ tfst // (B VZ tsnd.loc ::: shift 2))
-            (weakD 1 p) (B VZ i.loc) (BVT 1 tsnd.loc) y.loc ::: shift 2)
-        b' = CoeY i tsnd' p q (BVT 0 y.loc) y.loc
-    whnf defs ctx sg $ CasePair qty (Ann val (ty // one p) val.loc) ret
-      (SY body.names $ body.term // (a' ::: b' ::: shift 2)) loc
-
-  ||| reduce a pair projection `Fst (Coe ty p q val) loc`
-  export covering
-  fstCoe : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
-           Loc -> Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx sg))
-  fstCoe sty@(S [< i] ty) p q val loc = do
-    -- fst (coe (𝑖 ⇒ (x : A) × B) @p @q s)
-    --   ⇝
-    -- coe (𝑖 ⇒ A) @p @q (fst (s ∷ (x : A‹p/𝑖›) × B‹p/𝑖›))
-    --
-    -- type-case is used to expose A,B if the type is neutral
-    let ctx1 = extendDim i ctx
-    Element ty tynf <- whnf defs ctx1 SZero $ getTerm ty
-    (tfst, _) <- tycaseSig defs ctx1 ty
-    whnf defs ctx sg $
-      Coe (SY [< i] tfst) p q
-          (E (Fst (Ann val (ty // one p) val.loc) val.loc)) loc
-
-  ||| reduce a pair projection `Snd (Coe ty p q val) loc`
-  export covering
-  sndCoe : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
-           Loc -> Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx sg))
-  sndCoe sty@(S [< i] ty) p q val loc = do
-    -- snd (coe (𝑖 ⇒ (x : A) × B) @p @q s)
-    --   ⇝
-    -- coe (𝑖 ⇒ B[coe (𝑗 ⇒ A‹𝑗/𝑖›) @p @𝑖 (fst (s ∷ (x : A) × B))/x]) @p @q
-    --     (snd (s ∷ (x : A‹p/𝑖›) × B‹p/𝑖›))
-    --
-    -- type-case is used to expose A,B if the type is neutral
-    let ctx1 = extendDim i ctx
-    Element ty tynf <- whnf defs ctx1 SZero $ getTerm ty
-    (tfst, tsnd) <- tycaseSig defs ctx1 ty
-    whnf defs ctx sg $
-      Coe (SY [< i] $ sub1 tsnd $
-            Coe (SY [< !(fresh i)] $ tfst // (BV 0 i.loc ::: shift 2))
-                (weakD 1 p) (BV 0 loc)
-                (E (Fst (Ann (dweakT 1 val) ty val.loc) val.loc)) loc)
-          p q
-          (E (Snd (Ann val (ty // one p) val.loc) val.loc))
-          loc
-
-  ||| reduce a dimension application `DApp (Coe ty p q val) r loc`
-  export covering
-  eqCoe : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
-          (r : Dim d) -> Loc ->
-          Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx sg))
-  eqCoe sty@(S [< j] ty) p q val r loc = do
-    -- (coe [j ⇒ Eq [i ⇒ A] L R] @p @q eq) @r
-    --   ⇝
-    -- comp [j ⇒ A‹r/i›] @p @q ((eq ∷ (Eq [i ⇒ A] L R)‹p/j›) @r)
-    --   @r { 0 j ⇒ L; 1 j ⇒ R }
-    let ctx1 = extendDim j ctx
-    Element ty tynf <- whnf defs ctx1 SZero $ getTerm ty
-    (a0, a1, a, s, t) <- tycaseEq defs ctx1 ty
-    let a'   = dsub1 a (weakD 1 r)
-        val' = E $ DApp (Ann val (ty // one p) val.loc) r loc
-    whnf defs ctx sg $ CompH j a' p q val' r j s j t loc
-
-  ||| reduce a pair elimination `CaseBox pi (Coe ty p q val) ret body`
-  export covering
-  boxCoe : (qty : Qty) ->
-           (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
-           (ret : ScopeTerm d n) -> (body : ScopeTerm d n) -> Loc ->
-           Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx sg))
-  boxCoe qty sty@(S [< i] ty) p q val ret body loc = do
-    -- caseπ (coe [i ⇒ [ρ. A]] @p @q s) return z ⇒ C of { [a] ⇒ e }
-    --   ⇝
-    -- caseπ s ∷ [ρ. A]‹p/i› return z ⇒ C of { [a] ⇒ e[(coe [i ⇒ A] p q a)/a] }
-    let ctx1 = extendDim i ctx
-    Element ty tynf <- whnf defs ctx1 SZero $ getTerm ty
-    ta <- tycaseBOX defs ctx1 ty
-    let xloc = body.name.loc
-    let a' = CoeY i (weakT 1 ta) p q (BVT 0 xloc) xloc
-    whnf defs ctx sg $ CaseBox qty (Ann val (ty // one p) val.loc) ret
-      (SY body.names $ body.term // (a' ::: shift 1)) loc
-
-
--- new params block to call the above functions at different `n`
-parameters {auto _ : CanWhnf Term Interface.isRedexT}
-           {auto _ : CanWhnf Elim Interface.isRedexE}
-           (defs : Definitions) (ctx : WhnfContext d n) (sg : SQty)
-  ||| pushes a coercion inside a whnf-ed term
-  export covering
-  pushCoe : BindName ->
-            (ty : Term (S d) n) -> (p, q : Dim d) -> (s : Term d n) -> Loc ->
-            (0 pc : So (canPushCoe sg ty s)) =>
-            Eff Whnf (NonRedex Elim d n defs ctx sg)
-  pushCoe i ty p q s loc =
-    case ty of
-      -- (coe ★ᵢ @_ @_ s) ⇝ (s ∷ ★ᵢ)
-      TYPE l tyLoc =>
-        whnf defs ctx sg $ Ann s (TYPE l tyLoc) loc
-
-      -- (coe IOState @_ @_ s) ⇝ (s ∷ IOState)
-      IOState tyLoc =>
-        whnf defs ctx sg $ Ann s (IOState tyLoc) loc
-
-      -- η expand, then simplify the Coe/App in the body
-      --
-      -- (coe (𝑖 ⇒ π.(x : A) → B) @p @q s)
-      --   ⇝
-      -- (λ y ⇒ (coe (𝑖 ⇒ π.(x : A) → B) @p @q s) y) ∷ (π.(x : A) → B)‹q/𝑖›
-      --   ⇝     ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-      -- (λ y ⇒ ⋯) ∷ (π.(x : A) → B)‹q/𝑖›   -- see `piCoe`
-      --
-      -- do the piCoe step here because otherwise equality checking keeps
-      -- doing the η forever
-      Pi {arg, res = S [< x] _, _} => do
-        let ctx' = extendTy x (arg // one p) ctx
-        body <- piCoe defs ctx' sg
-          (weakDS 1 $ SY [< i] ty) p q (weakT 1 s) (BVT 0 loc) loc
-        whnf defs ctx sg $
-          Ann (LamY x (E body.fst) loc) (ty // one q) loc
-
-      -- no η!!!
-      -- push into a pair constructor, otherwise still stuck
-      --
-      --   s̃‹𝑘› ≔ coe (𝑗 ⇒ A‹𝑗/𝑖›) @p @𝑘 s
-      -- -----------------------------------------------
-      --   (coe (𝑖 ⇒ (x : A) × B) @p @q (s, t))
-      --     ⇝
-      --   (s̃‹q›, coe (𝑖 ⇒ B[s̃‹𝑖›/x]) @p @q t)
-      --     ∷ ((x : A) × B)‹q/𝑖›
-      Sig tfst tsnd tyLoc => do
-        let Pair fst snd sLoc = s
-            fst' = CoeY i tfst p q fst fst.loc
-            fstInSnd =
-              CoeY !(fresh i)
-                   (tfst // (BV 0 loc ::: shift 2))
-                   (weakD 1 p) (BV 0 loc) (dweakT 1 fst) fst.loc
-            snd' = CoeY i (sub1 tsnd fstInSnd) p q snd snd.loc
-        whnf defs ctx sg $
-          Ann (Pair (E fst') (E snd') sLoc) (ty // one q) loc
-
-      -- (coe {𝐚̄} @_ @_ s) ⇝ (s ∷ {𝐚̄})
-      Enum cases tyLoc =>
-        whnf defs ctx sg $ Ann s (Enum cases tyLoc) loc
-
-      -- η expand/simplify, same as for Π
-      --
-      -- (coe (𝑖 ⇒ Eq (𝑗 ⇒ A) l r) @p @q s)
-      --   ⇝
-      -- (δ 𝑘 ⇒ (coe (𝑖 ⇒ Eq (𝑗 ⇒ A) l r) @p @q s) @𝑘) ∷ (Eq (𝑗 ⇒ A) l r)‹q/𝑖›
-      --   ⇝     ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-      -- (δ 𝑘 ⇒ ⋯) ∷ (Eq (𝑗 ⇒ A) l r)‹q/𝑖›   -- see `eqCoe`
-      --
-      -- do the eqCoe step here because otherwise equality checking keeps
-      -- doing the η forever
-      Eq {ty = S [< j] _, _} => do
-        let ctx' = extendDim j ctx
-        body <- eqCoe defs ctx' sg
-          (dweakDS 1 $ S [< i] $ Y ty) (weakD 1 p) (weakD 1 q)
-          (dweakT 1 s) (BV 0 loc) loc
-        whnf defs ctx sg $
-          Ann (DLamY i (E body.fst) loc) (ty // one q) loc
-
-      -- (coe ℕ @_ @_ s) ⇝ (s ∷ ℕ)
-      NAT tyLoc =>
-        whnf defs ctx sg $ Ann s (NAT tyLoc) loc
-
-      -- (coe String @_ @_ s) ⇝ (s ∷ String)
-      STRING tyLoc =>
-        whnf defs ctx sg $ Ann s (STRING tyLoc) loc
-
-      -- η expand/simplify
-      --
-      -- (coe (𝑖 ⇒ [π.A]) @p @q s)
-      --   ⇝
-      -- [case coe (𝑖 ⇒ [π.A]) @p @q s return A‹q/𝑖› of {[x] ⇒ x}]
-      --   ⇝
-      -- [case1 s ∷ [π.A]‹p/𝑖› ⋯] ∷ [π.A]‹q/𝑖›   -- see `boxCoe`
-      --
-      -- do the eqCoe step here because otherwise equality checking keeps
-      -- doing the η forever
-      BOX qty inner tyLoc => do
-        body <- boxCoe defs ctx sg qty
-          (SY [< i] ty) p q s
-          (SN $ inner // one q)
-          (SY [< !(mnb "inner" loc)] (BVT 0 loc)) loc
-        whnf defs ctx sg $ Ann (Box (E body.fst) loc) (ty // one q) loc
diff --git a/lib/Quox/Whnf/ComputeElimType.idr b/lib/Quox/Whnf/ComputeElimType.idr
deleted file mode 100644
index 3661c12..0000000
--- a/lib/Quox/Whnf/ComputeElimType.idr
+++ /dev/null
@@ -1,110 +0,0 @@
-module Quox.Whnf.ComputeElimType
-
-import Quox.Whnf.Interface
-import Quox.Displace
-import Quox.Pretty
-
-%default total
-
-
-||| performs the minimum work required to recompute the type of an elim.
-|||
-||| - assumes the elim is already typechecked
-||| - the return value is not reduced
-export covering
-computeElimType :
-  CanWhnf Term Interface.isRedexT =>
-  CanWhnf Elim Interface.isRedexE =>
-  (defs : Definitions) -> (ctx : WhnfContext d n) -> (0 sg : SQty) ->
-  (e : Elim d n) -> (0 ne : No (isRedexE defs ctx sg e)) =>
-  Eff Whnf (Term d n)
-
-||| computes a type and then reduces it to whnf
-export covering
-computeWhnfElimType0 :
-  CanWhnf Term Interface.isRedexT =>
-  CanWhnf Elim Interface.isRedexE =>
-  (defs : Definitions) -> (ctx : WhnfContext d n) -> (0 sg : SQty) ->
-  (e : Elim d n) -> (0 ne : No (isRedexE defs ctx sg e)) =>
-  Eff Whnf (Term d n)
-
-
-private covering
-computeElimTypeNoLog, computeWhnfElimType0NoLog :
-  CanWhnf Term Interface.isRedexT =>
-  CanWhnf Elim Interface.isRedexE =>
-  (defs : Definitions) -> WhnfContext d n -> (0 sg : SQty) ->
-  (e : Elim d n) -> (0 ne : No (isRedexE defs ctx sg e)) =>
-  Eff Whnf (Term d n)
-
-computeElimTypeNoLog defs ctx sg e =
-  case e of
-    F x u loc => do
-      let Just def = lookup x defs
-        | Nothing => throw $ NotInScope loc x
-      pure $ def.typeWithAt ctx.dimLen ctx.termLen u
-
-    B i _ =>
-      pure (ctx.tctx !! i).type
-
-    App f s loc =>
-      case !(computeWhnfElimType0NoLog defs ctx sg f {ne = noOr1 ne}) of
-        Pi {arg, res, _} => pure $ sub1 res $ Ann s arg loc
-        ty               => throw $ ExpectedPi loc ctx.names ty
-
-    CasePair {pair, ret, _} =>
-      pure $ sub1 ret pair
-
-    Fst pair loc =>
-      case !(computeWhnfElimType0NoLog defs ctx sg pair {ne = noOr1 ne}) of
-        Sig {fst, _} => pure fst
-        ty           => throw $ ExpectedSig loc ctx.names ty
-
-    Snd pair loc =>
-      case !(computeWhnfElimType0NoLog defs ctx sg pair {ne = noOr1 ne}) of
-        Sig {snd, _} => pure $ sub1 snd $ Fst pair loc
-        ty           => throw $ ExpectedSig loc ctx.names ty
-
-    CaseEnum {tag, ret, _} =>
-      pure $ sub1 ret tag
-
-    CaseNat {nat, ret, _} =>
-      pure $ sub1 ret nat
-
-    CaseBox {box, ret, _} =>
-      pure $ sub1 ret box
-
-    DApp {fun = f, arg = p, loc} =>
-      case !(computeWhnfElimType0NoLog defs ctx sg f {ne = noOr1 ne}) of
-        Eq {ty, _} => pure $ dsub1 ty p
-        t          => throw $ ExpectedEq loc ctx.names t
-
-    Ann {ty, _} =>
-      pure ty
-
-    Coe {ty, q, _} =>
-      pure $ dsub1 ty q
-
-    Comp {ty, _} =>
-      pure ty
-
-    TypeCase {ret, _} =>
-      pure ret
-
-computeElimType defs ctx sg e {ne} = do
-  let Val n = ctx.termLen
-  sayMany "whnf" e.loc
-    [90 :> "computeElimType",
-     95 :> hsep ["ctx =", runPretty $ prettyWhnfContext ctx],
-     90 :> hsep ["e =", runPretty $ prettyElim ctx.dnames ctx.tnames e]]
-  res <- computeElimTypeNoLog defs ctx sg e {ne}
-  say "whnf" 91 e.loc $
-    hsep ["computeElimType ⇝",
-          runPretty $ prettyTerm ctx.dnames ctx.tnames res]
-  pure res
-
-computeWhnfElimType0 defs ctx sg e =
-  computeElimType defs ctx sg e >>= whnf0 defs ctx SZero
-
-computeWhnfElimType0NoLog defs ctx sg e {ne} =
-  computeElimTypeNoLog defs ctx sg e {ne} >>= whnf0 defs ctx SZero
diff --git a/lib/Quox/Whnf/Interface.idr b/lib/Quox/Whnf/Interface.idr
deleted file mode 100644
index e516f62..0000000
--- a/lib/Quox/Whnf/Interface.idr
+++ /dev/null
@@ -1,266 +0,0 @@
-module Quox.Whnf.Interface
-
-import public Quox.No
-import public Quox.Log
-import public Quox.Syntax
-import public Quox.Definition
-import public Quox.Typing.Context
-import public Quox.Typing.Error
-import public Data.Maybe
-import public Control.Eff
-
-%default total
-
-
-public export
-Whnf : List (Type -> Type)
-Whnf = [Except Error, NameGen, Log]
-
-
-public export
-0 RedexTest : TermLike -> Type
-RedexTest tm =
-  {0 d, n : Nat} -> Definitions -> WhnfContext d n -> SQty -> tm d n -> Bool
-
-public export
-interface CanWhnf (0 tm : TermLike) (0 isRedex : RedexTest tm) | tm
-where
-  whnf, whnfNoLog :
-    (defs : Definitions) -> (ctx : WhnfContext d n) -> (q : SQty) ->
-    tm d n -> Eff Whnf (Subset (tm d n) (No . isRedex defs ctx q))
-  -- having isRedex be part of the class header, and needing to be explicitly
-  -- quantified on every use since idris can't infer its type, is a little ugly.
-  -- but none of the alternatives i've thought of so far work. e.g. in some
-  -- cases idris can't tell that `isRedex` and `isRedexT` are the same thing
-
-public export %inline
-whnf0, whnfNoLog0 :
-  {0 isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
-  Definitions -> WhnfContext d n -> SQty -> tm d n -> Eff Whnf (tm d n)
-whnf0      defs ctx q t = fst <$> whnf defs ctx q t
-whnfNoLog0 defs ctx q t = fst <$> whnfNoLog defs ctx q t
-
-public export
-0 IsRedex, NotRedex : {isRedex : RedexTest tm} -> CanWhnf tm isRedex =>
-                      Definitions -> WhnfContext d n -> SQty -> Pred (tm d n)
-IsRedex  defs ctx q = So . isRedex defs ctx q
-NotRedex defs ctx q = No . isRedex defs ctx q
-
-public export
-0 NonRedex : (tm : TermLike) -> {isRedex : RedexTest tm} ->
-             CanWhnf tm isRedex => (d, n : Nat) ->
-             Definitions -> WhnfContext d n -> SQty -> Type
-NonRedex tm d n defs ctx q = Subset (tm d n) (NotRedex defs ctx q)
-
-public export %inline
-nred : {0 isRedex : RedexTest tm} -> (0 _ : CanWhnf tm isRedex) =>
-       (t : tm d n) -> (0 nr : NotRedex defs ctx q t) =>
-       NonRedex tm d n defs ctx q
-nred t = Element t nr
-
-
-||| an expression like `(λ x ⇒ s) ∷ π.(x : A) → B`
-public export %inline
-isLamHead : Elim {} -> Bool
-isLamHead (Ann (Lam {}) (Pi {}) _) = True
-isLamHead (Coe {})                 = True
-isLamHead _                        = False
-
-||| an expression like `(δ 𝑖 ⇒ s) ∷ Eq (𝑖 ⇒ A) s t`
-public export %inline
-isDLamHead : Elim {} -> Bool
-isDLamHead (Ann (DLam {}) (Eq {}) _) = True
-isDLamHead (Coe {})                  = True
-isDLamHead _                         = False
-
-||| an expression like `(s, t) ∷ (x : A) × B`
-public export %inline
-isPairHead : Elim {} -> Bool
-isPairHead (Ann (Pair {}) (Sig {}) _) = True
-isPairHead (Coe {})                   = True
-isPairHead _                          = False
-
-||| an expression like `'a ∷ {a, b, c}`
-public export %inline
-isTagHead : Elim {} -> Bool
-isTagHead (Ann (Tag {}) (Enum {}) _) = True
-isTagHead (Coe {})                   = True
-isTagHead _                          = False
-
-||| an expression like `𝑘 ∷ ℕ` for a natural constant 𝑘, or `suc n ∷ ℕ`
-public export %inline
-isNatHead : Elim {} -> Bool
-isNatHead (Ann (Nat  {}) (NAT {}) _) = True
-isNatHead (Ann (Succ {}) (NAT {}) _) = True
-isNatHead (Coe {})                   = True
-isNatHead _                          = False
-
-||| a natural constant, with or without an annotation
-public export %inline
-isNatConst : Term d n -> Bool
-isNatConst (Nat {})               = True
-isNatConst (E (Ann (Nat {}) _ _)) = True
-isNatConst _                      = False
-
-||| an expression like `[s] ∷ [π. A]`
-public export %inline
-isBoxHead : Elim {} -> Bool
-isBoxHead (Ann (Box {}) (BOX {}) _) = True
-isBoxHead (Coe {})                  = True
-isBoxHead _                         = False
-
-||| an elimination in a term context
-public export %inline
-isE : Term {} -> Bool
-isE (E {}) = True
-isE _      = False
-
-||| an expression like `s ∷ A`
-public export %inline
-isAnn : Elim {} -> Bool
-isAnn (Ann {}) = True
-isAnn _        = False
-
-||| a syntactic type
-public export %inline
-isTyCon : Term {} -> Bool
-isTyCon (TYPE    {}) = True
-isTyCon (IOState {}) = True
-isTyCon (Pi      {}) = True
-isTyCon (Lam     {}) = False
-isTyCon (Sig     {}) = True
-isTyCon (Pair    {}) = False
-isTyCon (Enum    {}) = True
-isTyCon (Tag     {}) = False
-isTyCon (Eq      {}) = True
-isTyCon (DLam    {}) = False
-isTyCon (NAT     {}) = True
-isTyCon (Nat     {}) = False
-isTyCon (Succ    {}) = False
-isTyCon (STRING  {}) = True
-isTyCon (Str     {}) = False
-isTyCon (BOX     {}) = True
-isTyCon (Box     {}) = False
-isTyCon (Let     {}) = False
-isTyCon (E       {}) = False
-isTyCon (CloT    {}) = False
-isTyCon (DCloT   {}) = False
-
-||| a syntactic type, or a neutral
-public export %inline
-isTyConE : Term {} -> Bool
-isTyConE s = isTyCon s || isE s
-
-||| a syntactic type with an annotation `★ᵢ`
-public export %inline
-isAnnTyCon : Elim {} -> Bool
-isAnnTyCon (Ann ty (TYPE {}) _) = isTyCon ty
-isAnnTyCon _                    = False
-
-||| 0 or 1
-public export %inline
-isK : Dim d -> Bool
-isK (K {}) = True
-isK _      = False
-
-
-||| true if `ty` is a type constructor, and `val` is a value of that type where
-||| a coercion can be reduced
-|||
-||| 1. `ty` is an atomic type
-||| 2. `ty` has an η law that is usable in this context
-|||    (e.g. η for pairs only exists when σ=0, not when σ=1)
-||| 3. `val` is a constructor form
-public export %inline
-canPushCoe : SQty -> (ty, val : Term {}) -> Bool
-canPushCoe sg (TYPE    {}) _         = True
-canPushCoe sg (IOState {}) _         = True
-canPushCoe sg (Pi      {}) _         = True
-canPushCoe sg (Lam     {}) _         = False
-canPushCoe sg (Sig     {}) (Pair {}) = True
-canPushCoe sg (Sig     {}) _         = False
-canPushCoe sg (Pair    {}) _         = False
-canPushCoe sg (Enum    {}) _         = True
-canPushCoe sg (Tag     {}) _         = False
-canPushCoe sg (Eq      {}) _         = True
-canPushCoe sg (DLam    {}) _         = False
-canPushCoe sg (NAT     {}) _         = True
-canPushCoe sg (Nat     {}) _         = False
-canPushCoe sg (Succ    {}) _         = False
-canPushCoe sg (STRING  {}) _         = True
-canPushCoe sg (Str     {}) _         = False
-canPushCoe sg (BOX     {}) _         = True
-canPushCoe sg (Box     {}) _         = False
-canPushCoe sg (Let     {}) _         = False
-canPushCoe sg (E       {}) _         = False
-canPushCoe sg (CloT    {}) _         = False
-canPushCoe sg (DCloT   {}) _         = False
-
-
-mutual
-  ||| a reducible elimination
-  |||
-  ||| 1. a free variable, if its definition is known
-  ||| 2. a bound variable pointing to a `let`
-  ||| 3. an elimination whose head is reducible
-  ||| 4. an "active" elimination:
-  |||    an application whose head is an annotated lambda,
-  |||    a case expression whose head is an annotated constructor form, etc
-  ||| 5. a redundant annotation, or one whose term or type is reducible
-  ||| 6. a coercion `coe (𝑖 ⇒ A) @p @q s` where:
-  |||      a. `A` is reducible or a type constructor, or
-  |||      b. `𝑖` is not mentioned in `A`
-  |||         ([fixme] should be A‹0/𝑖› = A‹1/𝑖›), or
-  |||      c. `p = q`
-  ||| 7. a composition `comp A @p @q s @r {⋯}`
-  |||    where `p = q`, `r = 0`, or `r = 1`
-  ||| 8. a closure
-  public export
-  isRedexE : RedexTest Elim
-  isRedexE defs ctx sg (F {x, u, _}) = isJust $ lookupElim0 x u defs
-  isRedexE _    ctx sg (B {i, _}) = isJust (ctx.tctx !! i).term
-  isRedexE defs ctx sg (App {fun, _}) =
-    isRedexE defs ctx sg fun || isLamHead fun
-  isRedexE defs ctx sg (CasePair {pair, _}) =
-    isRedexE defs ctx sg pair || isPairHead pair || isYes (sg `decEq` SZero)
-  isRedexE defs ctx sg (Fst pair _) =
-    isRedexE defs ctx sg pair || isPairHead pair
-  isRedexE defs ctx sg (Snd pair _) =
-    isRedexE defs ctx sg pair || isPairHead pair
-  isRedexE defs ctx sg (CaseEnum {tag, _}) =
-    isRedexE defs ctx sg tag || isTagHead tag
-  isRedexE defs ctx sg (CaseNat {nat, _}) =
-    isRedexE defs ctx sg nat || isNatHead nat
-  isRedexE defs ctx sg (CaseBox {box, _}) =
-    isRedexE defs ctx sg box || isBoxHead box
-  isRedexE defs ctx sg (DApp {fun, arg, _}) =
-    isRedexE defs ctx sg fun || isDLamHead fun || isK arg
-  isRedexE defs ctx sg (Ann {tm, ty, _}) =
-    isE tm || isRedexT defs ctx sg tm || isRedexT defs ctx SZero ty
-  isRedexE defs ctx sg (Coe {ty = S _ (N _), _}) = True
-  isRedexE defs ctx sg (Coe {ty = S [< i] (Y ty), p, q, val, _}) =
-    isRedexT defs (extendDim i ctx) SZero ty ||
-    canPushCoe sg ty val || isYes (p `decEqv` q)
-  isRedexE defs ctx sg (Comp {ty, p, q, r, _}) =
-    isYes (p `decEqv` q) || isK r
-  isRedexE defs ctx sg (TypeCase {ty, ret, _}) =
-    isRedexE defs ctx sg ty || isRedexT defs ctx sg ret || isAnnTyCon ty
-  isRedexE _ _ _ (CloE  {}) = True
-  isRedexE _ _ _ (DCloE {}) = True
-
-  ||| a reducible term
-  |||
-  ||| 1. a reducible elimination, as `isRedexE`
-  ||| 2. an annotated elimination
-  |||    (the annotation is redundant in a checkable context)
-  ||| 3. a closure
-  ||| 4. `succ` applied to a natural constant
-  ||| 5. a `let` expression
-  public export
-  isRedexT : RedexTest Term
-  isRedexT _    _   _  (CloT  {})  = True
-  isRedexT _    _   _  (DCloT {})  = True
-  isRedexT _    _   _  (Let   {})  = True
-  isRedexT defs ctx sg (E {e, _})  = isAnn e || isRedexE defs ctx sg e
-  isRedexT _    _   _  (Succ p {}) = isNatConst p
-  isRedexT _    _   _  _           = False
diff --git a/lib/Quox/Whnf/Main.idr b/lib/Quox/Whnf/Main.idr
deleted file mode 100644
index cd340ca..0000000
--- a/lib/Quox/Whnf/Main.idr
+++ /dev/null
@@ -1,293 +0,0 @@
-module Quox.Whnf.Main
-
-import Quox.Whnf.Interface
-import Quox.Whnf.ComputeElimType
-import Quox.Whnf.TypeCase
-import Quox.Whnf.Coercion
-import Quox.Pretty
-import Quox.Displace
-import Data.SnocVect
-
-%default total
-
-
-export covering CanWhnf Term Interface.isRedexT
-export covering CanWhnf Elim Interface.isRedexE
-
-
--- the String is what to call the "s" argument in logs (maybe "s", or "e")
-private %inline
-whnfDefault :
-  {0 isRedex : RedexTest tm} ->
-  (CanWhnf tm isRedex, Located2 tm) =>
-  String ->
-  (forall d, n. WhnfContext d n -> tm d n -> Eff Pretty LogDoc) ->
-  (defs : Definitions) ->
-  (ctx : WhnfContext d n) ->
-  (sg : SQty) ->
-  (s : tm d n) ->
-  Eff Whnf (Subset (tm d n) (No . isRedex defs ctx sg))
-whnfDefault name ppr defs ctx sg s = do
-  sayMany "whnf" s.loc
-    [10 :> "whnf",
-     95 :> hsep ["ctx =", runPretty $ prettyWhnfContext ctx],
-     95 :> hsep ["sg =", runPretty $ prettyQty sg.qty],
-     10 :> hsep [text name, "=", runPretty $ ppr ctx s]]
-  res <- whnfNoLog defs ctx sg s
-  say "whnf" 11 s.loc $ hsep ["whnf ⇝", runPretty $ ppr ctx res.fst]
-  pure res
-
-covering
-CanWhnf Elim Interface.isRedexE where
-  whnf = whnfDefault "e" $ \ctx, e => prettyElim ctx.dnames ctx.tnames e
-
-  whnfNoLog defs ctx sg (F x u loc) with (lookupElim0 x u defs) proof eq
-    _ | Just y  = whnf defs ctx sg $ setLoc loc $ injElim ctx y
-    _ | Nothing = pure $ Element (F x u loc) $ rewrite eq in Ah
-
-  whnfNoLog defs ctx sg (B i loc) with (ctx.tctx !! i) proof eq1
-    _ | l with (l.term) proof eq2
-      _ | Just y  = whnf defs ctx sg $ Ann y l.type loc
-      _ | Nothing = pure $ Element (B i loc) $ rewrite eq1 in rewrite eq2 in Ah
-
-  -- ((λ x ⇒ t) ∷ (π.x : A) → B) s ⇝ t[s∷A/x] ∷ B[s∷A/x]
-  whnfNoLog defs ctx sg (App f s appLoc) = do
-    Element f fnf <- whnf defs ctx sg f
-    case nchoose $ isLamHead f of
-      Left _ => case f of
-        Ann (Lam {body, _}) (Pi {arg, res, _}) floc =>
-          let s = Ann s arg s.loc in
-          whnf defs ctx sg $ Ann (sub1 body s) (sub1 res s) appLoc
-        Coe ty p q val _ => piCoe defs ctx sg ty p q val s appLoc
-      Right nlh => pure $ Element (App f s appLoc) $ fnf `orNo` nlh
-
-  -- case (s, t) ∷ (x : A) × B return p ⇒ C of { (a, b) ⇒ u } ⇝
-  -- u[s∷A/a, t∷B[s∷A/x]] ∷ C[(s, t)∷((x : A) × B)/p]
-  --
-  -- 0 · case e return p ⇒ C of { (a, b) ⇒ u } ⇝
-  -- u[fst e/a, snd e/b] ∷ C[e/p]
-  whnfNoLog defs ctx sg (CasePair pi pair ret body caseLoc) = do
-    Element pair pairnf <- whnf defs ctx sg pair
-    case nchoose $ isPairHead pair of
-      Left _ => case pair of
-        Ann (Pair {fst, snd, _}) (Sig {fst = tfst, snd = tsnd, _}) pairLoc =>
-          let fst = Ann fst tfst fst.loc
-              snd = Ann snd (sub1 tsnd fst) snd.loc
-          in
-          whnf defs ctx sg $ Ann (subN body [< fst, snd]) (sub1 ret pair) caseLoc
-        Coe ty p q val _ => do
-          sigCoe defs ctx sg pi ty p q val ret body caseLoc
-      Right np =>
-        case sg `decEq` SZero of
-          Yes Refl =>
-            whnf defs ctx SZero $
-              Ann (subN body [< Fst pair caseLoc, Snd pair caseLoc])
-                  (sub1 ret pair)
-                  caseLoc
-          No n0 =>
-            pure $ Element (CasePair pi pair ret body caseLoc)
-                           (pairnf `orNo` np `orNo` notYesNo n0)
-
-  -- fst ((s, t) ∷ (x : A) × B) ⇝ s ∷ A
-  whnfNoLog defs ctx sg (Fst pair fstLoc) = do
-    Element pair pairnf <- whnf defs ctx sg pair
-    case nchoose $ isPairHead pair of
-      Left _ => case pair of
-        Ann (Pair {fst, snd, _}) (Sig {fst = tfst, snd = tsnd, _}) pairLoc =>
-          whnf defs ctx sg $ Ann fst tfst pairLoc
-        Coe ty p q val _ => do
-          fstCoe defs ctx sg ty p q val fstLoc
-      Right np =>
-        pure $ Element (Fst pair fstLoc) (pairnf `orNo` np)
-
-  -- snd ((s, t) ∷ (x : A) × B) ⇝ t ∷ B[(s ∷ A)/x]
-  whnfNoLog defs ctx sg (Snd pair sndLoc) = do
-    Element pair pairnf <- whnf defs ctx sg pair
-    case nchoose $ isPairHead pair of
-      Left _ => case pair of
-        Ann (Pair {fst, snd, _}) (Sig {fst = tfst, snd = tsnd, _}) pairLoc =>
-          whnf defs ctx sg $ Ann snd (sub1 tsnd (Ann fst tfst fst.loc)) sndLoc
-        Coe ty p q val _ => do
-          sndCoe defs ctx sg ty p q val sndLoc
-      Right np =>
-        pure $ Element (Snd pair sndLoc) (pairnf `orNo` np)
-
-  -- case 'a ∷ {a,…} return p ⇒ C of { 'a ⇒ u } ⇝
-  -- u ∷ C['a∷{a,…}/p]
-  whnfNoLog defs ctx sg (CaseEnum pi tag ret arms caseLoc) = do
-    Element tag tagnf <- whnf defs ctx sg tag
-    case nchoose $ isTagHead tag of
-      Left _ => case tag of
-        Ann (Tag t _) (Enum ts _) _ =>
-          let ty = sub1 ret tag in
-          case lookup t arms of
-            Just arm => whnf defs ctx sg $ Ann arm ty arm.loc
-            Nothing  => throw $ MissingEnumArm caseLoc t (keys arms)
-        Coe ty p q val _ =>
-          -- there is nowhere an equality can be hiding inside an enum type
-          whnf defs ctx sg $
-            CaseEnum pi (Ann val (dsub1 ty q) val.loc) ret arms caseLoc
-      Right nt =>
-        pure $ Element (CaseEnum pi tag ret arms caseLoc) $ tagnf `orNo` nt
-
-  -- case zero ∷ ℕ return p ⇒ C of { zero ⇒ u; … } ⇝
-  --   u ∷ C[zero∷ℕ/p]
-  --
-  -- case succ n ∷ ℕ return p ⇒ C of { succ n', π.ih ⇒ u; … } ⇝
-  --   u[n∷ℕ/n', (case n ∷ ℕ ⋯)/ih] ∷ C[succ n ∷ ℕ/p]
-  whnfNoLog defs ctx sg (CaseNat pi piIH nat ret zer suc caseLoc) = do
-    Element nat natnf <- whnf defs ctx sg nat
-    case nchoose $ isNatHead nat of
-      Left _ =>
-        let ty = sub1 ret nat in
-        case nat of
-          Ann (Nat 0 _) (NAT _) _ =>
-            whnf defs ctx sg $ Ann zer ty zer.loc
-          Ann (Nat (S n) succLoc) (NAT natLoc) _ =>
-            let nn = Ann (Nat n succLoc) (NAT natLoc) succLoc
-                tm = subN suc [< nn, CaseNat pi piIH nn ret zer suc caseLoc]
-            in
-            whnf defs ctx sg $ Ann tm ty caseLoc
-          Ann (Succ n succLoc) (NAT natLoc) _ =>
-            let nn = Ann n (NAT natLoc) succLoc
-                tm = subN suc [< nn, CaseNat pi piIH nn ret zer suc caseLoc]
-            in
-            whnf defs ctx sg $ Ann tm ty caseLoc
-          Coe ty p q val _ =>
-            -- same deal as Enum
-            whnf defs ctx sg $
-              CaseNat pi piIH (Ann val (dsub1 ty q) val.loc) ret zer suc caseLoc
-      Right nn => pure $
-        Element (CaseNat pi piIH nat ret zer suc caseLoc) (natnf `orNo` nn)
-
-  -- case [t] ∷ [π.A] return p ⇒ C of { [x] ⇒ u } ⇝
-  --   u[t∷A/x] ∷ C[[t] ∷ [π.A]/p]
-  whnfNoLog defs ctx sg (CaseBox pi box ret body caseLoc) = do
-    Element box boxnf <- whnf defs ctx sg box
-    case nchoose $ isBoxHead box of
-      Left _ => case box of
-        Ann (Box val boxLoc) (BOX q bty tyLoc) _ =>
-          let ty = sub1 ret box in
-          whnf defs ctx sg $ Ann (sub1 body (Ann val bty val.loc)) ty caseLoc
-        Coe ty p q val _ =>
-          boxCoe defs ctx sg pi ty p q val ret body caseLoc
-      Right nb =>
-        pure $ Element (CaseBox pi box ret body caseLoc) (boxnf `orNo` nb)
-
-  -- e : Eq (𝑗 ⇒ A) t u ⊢ e @0 ⇝ t ∷ A‹0/𝑗›
-  -- e : Eq (𝑗 ⇒ A) t u ⊢ e @1 ⇝ u ∷ A‹1/𝑗›
-  --
-  -- ((δ 𝑖 ⇒ s) ∷ Eq (𝑗 ⇒ A) t u) @𝑘 ⇝ s‹𝑘/𝑖› ∷ A‹𝑘/𝑗›
-  whnfNoLog defs ctx sg (DApp f p appLoc) = do
-    Element f fnf <- whnf defs ctx sg f
-    case nchoose $ isDLamHead f of
-      Left _ => case f of
-        Ann (DLam {body, _}) (Eq {ty, l, r, _}) _ =>
-          whnf defs ctx sg $
-            Ann (endsOr (setLoc appLoc l) (setLoc appLoc r) (dsub1 body p) p)
-                (dsub1 ty p) appLoc
-        Coe ty p' q' val _ =>
-          eqCoe defs ctx sg ty p' q' val p appLoc
-      Right ndlh => case p of
-        K e _ => do
-          Eq {l, r, ty, _} <- computeWhnfElimType0 defs ctx sg f
-            | ty => throw $ ExpectedEq ty.loc ctx.names ty
-          whnf defs ctx sg $
-            ends (Ann (setLoc appLoc l) ty.zero appLoc)
-                 (Ann (setLoc appLoc r) ty.one  appLoc) e
-        B {} => pure $ Element (DApp f p appLoc) (fnf `orNo` ndlh `orNo` Ah)
-
-  -- e ∷ A ⇝ e
-  whnfNoLog defs ctx sg (Ann s a annLoc) = do
-    Element s snf <- whnf defs ctx sg s
-    case nchoose $ isE s of
-      Left  _  => let E e = s in pure $ Element e $ noOr2 snf
-      Right ne => do
-        Element a anf <- whnf defs ctx SZero a
-        pure $ Element (Ann s a annLoc) (ne `orNo` snf `orNo` anf)
-
-  whnfNoLog defs ctx sg (Coe sty@(S [< i] ty) p q val coeLoc) =
-    -- reduction if A‹0/𝑖› = A‹1/𝑖› lives in Equal
-    case p `decEqv` q of
-      -- coe (𝑖 ⇒ A) @p @p s ⇝ (s ∷ A‹p/𝑖›)
-      Yes _   => whnf defs ctx sg $ Ann val (dsub1 sty p) coeLoc
-      No  npq => do
-        let ty = getTerm ty
-        Element ty tynf <- whnf defs (extendDim i ctx) SZero ty
-        case nchoose $ canPushCoe sg ty val of
-          Left  pc  => pushCoe defs ctx sg i ty p q val coeLoc
-          Right npc => pure $ Element (Coe (SY [< i] ty) p q val coeLoc)
-                                      (tynf `orNo` npc `orNo` notYesNo npq)
-
-  whnfNoLog defs ctx sg (Comp ty p q val r zero one compLoc) =
-    case p `decEqv` q of
-      -- comp [A] @p @p s @r { ⋯ } ⇝ s ∷ A
-      Yes y   => whnf defs ctx sg $ Ann val ty compLoc
-      No  npq => case r of
-        -- comp [A] @p @q s @0 { 0 𝑗 ⇒ t₀; ⋯ } ⇝ t₀‹q/𝑗› ∷ A
-        K Zero _ => whnf defs ctx sg $ Ann (dsub1 zero q) ty compLoc
-        -- comp [A] @p @q s @1 { 1 𝑗 ⇒ t₁; ⋯ } ⇝ t₁‹q/𝑗› ∷ A
-        K One  _ => whnf defs ctx sg $ Ann (dsub1 one  q) ty compLoc
-        B {}     => pure $ Element (Comp ty p q val r zero one compLoc)
-                                   (notYesNo npq `orNo` Ah)
-
-  whnfNoLog defs ctx sg (TypeCase ty ret arms def tcLoc) =
-    case sg `decEq` SZero of
-      Yes Refl => do
-        Element ty  tynf  <- whnf defs ctx SZero ty
-        Element ret retnf <- whnf defs ctx SZero ret
-        case nchoose $ isAnnTyCon ty of
-          Left  y  => let Ann ty (TYPE u _) _ = ty in
-                      reduceTypeCase defs ctx ty u ret arms def tcLoc
-          Right nt => pure $ Element (TypeCase ty ret arms def tcLoc)
-                                     (tynf `orNo` retnf `orNo` nt)
-      No _ =>
-        throw $ ClashQ tcLoc sg.qty Zero
-
-  whnfNoLog defs ctx sg (CloE (Sub el th)) =
-    whnfNoLog defs ctx sg $ pushSubstsWith' id th el
-  whnfNoLog defs ctx sg (DCloE (Sub el th)) =
-    whnfNoLog defs ctx sg $ pushSubstsWith' th id el
-
-covering
-CanWhnf Term Interface.isRedexT where
-  whnf = whnfDefault "e" $ \ctx, s => prettyTerm ctx.dnames ctx.tnames s
-
-  whnfNoLog _ _ _ t@(TYPE    {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(IOState {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Pi      {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Lam     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Sig     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Pair    {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Enum    {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Tag     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Eq      {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(DLam    {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(NAT     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Nat     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(STRING  {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Str     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(BOX     {}) = pure $ nred t
-  whnfNoLog _ _ _ t@(Box     {}) = pure $ nred t
-
-  whnfNoLog _ _ _ (Succ p loc) =
-    case nchoose $ isNatConst p of
-      Left _ => case p of
-        Nat p _               => pure $ nred $ Nat (S p) loc
-        E (Ann (Nat p _) _ _) => pure $ nred $ Nat (S p) loc
-      Right nc => pure $ nred $ Succ p loc
-
-  whnfNoLog defs ctx sg (Let _ rhs body _) =
-    whnf defs ctx sg $ sub1 body rhs
-
-  -- s ∷ A ⇝ s   (in term context)
-  whnfNoLog defs ctx sg (E e) = do
-    Element e enf <- whnf defs ctx sg e
-    case nchoose $ isAnn e of
-      Left  _  => let Ann {tm, _} = e in pure $ Element tm $ noOr1 $ noOr2 enf
-      Right na => pure $ Element (E e) $ na `orNo` enf
-
-  whnfNoLog defs ctx sg (CloT (Sub tm th)) =
-    whnfNoLog defs ctx sg $ pushSubstsWith' id th tm
-  whnfNoLog defs ctx sg (DCloT (Sub tm th)) =
-    whnfNoLog defs ctx sg $ pushSubstsWith' th id tm
diff --git a/lib/Quox/Whnf/TypeCase.idr b/lib/Quox/Whnf/TypeCase.idr
deleted file mode 100644
index c9ffde2..0000000
--- a/lib/Quox/Whnf/TypeCase.idr
+++ /dev/null
@@ -1,170 +0,0 @@
-module Quox.Whnf.TypeCase
-
-import Quox.Whnf.Interface
-import Quox.Whnf.ComputeElimType
-import Data.SnocVect
-
-%default total
-
-
-private
-tycaseRhs : (k : TyConKind) -> TypeCaseArms d n ->
-            Maybe (ScopeTermN (arity k) d n)
-tycaseRhs k arms = lookupPrecise k arms
-
-private
-tycaseRhsDef : Term d n -> (k : TyConKind) -> TypeCaseArms d n ->
-               ScopeTermN (arity k) d n
-tycaseRhsDef def k arms = fromMaybe (SN def) $ tycaseRhs k arms
-
-private
-tycaseRhs0 : (k : TyConKind) -> TypeCaseArms d n ->
-             (0 eq : arity k = 0) => Maybe (Term d n)
-tycaseRhs0 k arms = map (.term0) $ rewrite sym eq in tycaseRhs k arms
-
-private
-tycaseRhsDef0 : Term d n -> (k : TyConKind) -> TypeCaseArms d n ->
-                (0 eq : arity k = 0) => Term d n
-tycaseRhsDef0 def k arms = fromMaybe def $ tycaseRhs0 k arms
-
-
-parameters {auto _ : CanWhnf Term Interface.isRedexT}
-           {auto _ : CanWhnf Elim Interface.isRedexE}
-           (defs : Definitions) (ctx : WhnfContext d n)
-  ||| for π.(x : A) → B, returns (A, B);
-  ||| for an elim returns a pair of type-cases that will reduce to that;
-  ||| for other intro forms error
-  export covering
-  tycasePi : (t : Term d n) -> (0 tnf : No (isRedexT defs ctx SZero t)) =>
-             Eff Whnf (Term d n, ScopeTerm d n)
-  tycasePi (Pi {arg, res, _}) = pure (arg, res)
-  tycasePi (E e) {tnf} = do
-    ty <- computeElimType defs ctx SZero e {ne = noOr2 tnf}
-    let loc  = e.loc
-        narg = mnb "Arg" loc; nret = mnb "Ret" loc
-        arg  = E $ typeCase1Y e ty KPi [< !narg, !nret] (BVT 1 loc) loc
-        res' = typeCase1Y e (Arr Zero arg ty loc) KPi [< !narg, !nret]
-                 (BVT 0 loc) loc
-        res  = SY [< !narg] $ E $ App (weakE 1 res') (BVT 0 loc) loc
-    pure (arg, res)
-  tycasePi t = throw $ ExpectedPi t.loc ctx.names t
-
-  ||| for (x : A) × B, returns (A, B);
-  ||| for an elim returns a pair of type-cases that will reduce to that;
-  ||| for other intro forms error
-  export covering
-  tycaseSig : (t : Term d n) -> (0 tnf : No (isRedexT defs ctx SZero t)) =>
-              Eff Whnf (Term d n, ScopeTerm d n)
-  tycaseSig (Sig {fst, snd, _}) = pure (fst, snd)
-  tycaseSig (E e) {tnf} = do
-    ty <- computeElimType defs ctx SZero e {ne = noOr2 tnf}
-    let loc  = e.loc
-        nfst = mnb "Fst" loc; nsnd = mnb "Snd" loc
-        fst  = E $ typeCase1Y e ty KSig [< !nfst, !nsnd] (BVT 1 loc) loc
-        snd' = typeCase1Y e (Arr Zero fst ty loc) KSig [< !nfst, !nsnd]
-                 (BVT 0 loc) loc
-        snd  = SY [< !nfst] $ E $ App (weakE 1 snd') (BVT 0 loc) loc
-    pure (fst, snd)
-  tycaseSig t = throw $ ExpectedSig t.loc ctx.names t
-
-  ||| for [π. A], returns A;
-  ||| for an elim returns a type-case that will reduce to that;
-  ||| for other intro forms error
-  export covering
-  tycaseBOX : (t : Term d n) -> (0 tnf : No (isRedexT defs ctx SZero t)) =>
-              Eff Whnf (Term d n)
-  tycaseBOX (BOX {ty, _}) = pure ty
-  tycaseBOX (E e) {tnf} = do
-    ty <- computeElimType defs ctx SZero e {ne = noOr2 tnf}
-    pure $ E $ typeCase1Y e ty KBOX [< !(mnb "Ty" e.loc)] (BVT 0 e.loc) e.loc
-  tycaseBOX t = throw $ ExpectedBOX t.loc ctx.names t
-
-  ||| for Eq [i ⇒ A] l r, returns (A‹0/i›, A‹1/i›, A, l, r);
-  ||| for an elim returns five type-cases that will reduce to that;
-  ||| for other intro forms error
-  export covering
-  tycaseEq : (t : Term d n) -> (0 tnf : No (isRedexT defs ctx SZero t)) =>
-             Eff Whnf (Term d n, Term d n, DScopeTerm d n, Term d n, Term d n)
-  tycaseEq (Eq {ty, l, r, _}) = pure (ty.zero, ty.one, ty, l, r)
-  tycaseEq (E e) {tnf} = do
-    ty <- computeElimType defs ctx SZero e {ne = noOr2 tnf}
-    let loc   = e.loc
-        names = traverse' (\x => mnb x loc) [< "A0", "A1", "A", "L", "R"]
-        a0    = E $ typeCase1Y e ty KEq !names (BVT 4 loc) loc
-        a1    = E $ typeCase1Y e ty KEq !names (BVT 3 loc) loc
-        a'    = typeCase1Y e (Eq0 ty a0 a1 loc) KEq !names (BVT 2 loc) loc
-        a     = SY [< !(mnb "i" loc)] $ E $ DApp (dweakE 1 a') (B VZ loc) loc
-        l     = E $ typeCase1Y e a0 KEq !names (BVT 1 loc) loc
-        r     = E $ typeCase1Y e a1 KEq !names (BVT 0 loc) loc
-    pure (a0, a1, a, l, r)
-  tycaseEq t = throw $ ExpectedEq t.loc ctx.names t
-
-  ||| reduce a type-case applied to a type constructor
-  |||
-  ||| `reduceTypeCase A i Q arms def _` reduces an expression
-  ||| `type-case A ∷ ★ᵢ return Q of { arms; _ ⇒ def }`
-  export covering
-  reduceTypeCase : (ty : Term d n) -> (u : Universe) -> (ret : Term d n) ->
-                   (arms : TypeCaseArms d n) -> (def : Term d n) ->
-                   (0 _ : So (isTyCon ty)) => Loc ->
-                   Eff Whnf (Subset (Elim d n) (No . isRedexE defs ctx SZero))
-  reduceTypeCase ty u ret arms def loc = case ty of
-    -- (type-case ★ᵢ ∷ _ return Q of { ★ ⇒ s; ⋯ }) ⇝ s ∷ Q
-    TYPE {} =>
-      whnf defs ctx SZero $ Ann (tycaseRhsDef0 def KTYPE arms) ret loc
-
-    -- (type-case IOState ∷ _ return Q of { IOState ⇒ s; ⋯ }) ⇝ s ∷ Q
-    IOState {} =>
-      whnf defs ctx SZero $ Ann (tycaseRhsDef0 def KIOState arms) ret loc
-
-    -- (type-case π.(x : A) → B ∷ ★ᵢ return Q of { (a → b) ⇒ s; ⋯ }) ⇝
-    -- s[(A ∷ ★ᵢ)/a, ((λ x ⇒ B) ∷ 0.A → ★ᵢ)/b] ∷ Q
-    Pi {arg, res, loc = piLoc, _} =>
-      let arg' = Ann arg (TYPE u arg.loc) arg.loc
-          res' = Ann (Lam res res.loc)
-                     (Arr Zero arg (TYPE u arg.loc) arg.loc) res.loc
-      in
-      whnf defs ctx SZero $
-        Ann (subN (tycaseRhsDef def KPi arms) [< arg', res']) ret loc
-
-    -- (type-case (x : A) × B ∷ ★ᵢ return Q of { (a × b) ⇒ s; ⋯ }) ⇝
-    -- s[(A ∷ ★ᵢ)/a, ((λ x ⇒ B) ∷ 0.A → ★ᵢ)/b] ∷ Q
-    Sig {fst, snd, loc = sigLoc, _} =>
-      let fst' = Ann fst (TYPE u fst.loc) fst.loc
-          snd' = Ann (Lam snd snd.loc)
-                     (Arr Zero fst (TYPE u fst.loc) fst.loc) snd.loc
-      in
-      whnf defs ctx SZero $
-        Ann (subN (tycaseRhsDef def KSig arms) [< fst', snd']) ret loc
-
-    -- (type-case {⋯} ∷ _ return Q of { {} ⇒ s; ⋯ }) ⇝ s ∷ Q
-    Enum {} =>
-      whnf defs ctx SZero $ Ann (tycaseRhsDef0 def KEnum arms) ret loc
-
-    -- (type-case Eq [i ⇒ A] L R ∷ ★ᵢ return Q
-    --  of { Eq a₀ a₁ a l r ⇒ s; ⋯ }) ⇝
-    -- s[(A‹0/i› ∷ ★ᵢ)/a₀, (A‹1/i› ∷ ★ᵢ)/a₁,
-    --   ((δ i ⇒ A) ∷ Eq [★ᵢ] A‹0/i› A‹1/i›)/a,
-    --   (L ∷ A‹0/i›)/l, (R ∷ A‹1/i›)/r] ∷ Q
-    Eq {ty = a, l, r, loc = eqLoc, _} =>
-      let a0 = a.zero; a1 = a.one in
-      whnf defs ctx SZero $ Ann
-        (subN (tycaseRhsDef def KEq arms)
-           [< Ann a0 (TYPE u a.loc) a.loc, Ann a1 (TYPE u a.loc) a.loc,
-              Ann (DLam a a.loc) (Eq0 (TYPE u a.loc) a0 a1 a.loc) a.loc,
-              Ann l a0 l.loc, Ann r a1 r.loc])
-        ret loc
-
-    -- (type-case ℕ ∷ _ return Q of { ℕ ⇒ s; ⋯ }) ⇝ s ∷ Q
-    NAT {} =>
-      whnf defs ctx SZero $ Ann (tycaseRhsDef0 def KNat arms) ret loc
-
-    -- (type-case String ∷ _ return Q of { String ⇒ s; ⋯ }) ⇝ s ∷ Q
-    STRING {} =>
-      whnf defs ctx SZero $ Ann (tycaseRhsDef0 def KString arms) ret loc
-
-    -- (type-case [π.A] ∷ ★ᵢ return Q of { [a] ⇒ s; ⋯ }) ⇝ s[(A ∷ ★ᵢ)/a] ∷ Q
-    BOX {ty = a, loc = boxLoc, _} =>
-      whnf defs ctx SZero $ Ann
-        (sub1 (tycaseRhsDef def KBOX arms) (Ann a (TYPE u a.loc) a.loc))
-        ret loc
diff --git a/lib/Text/PrettyPrint/Bernardy/Core/Decorate.idr b/lib/Text/PrettyPrint/Bernardy/Core/Decorate.idr
index 6e73cc6..9e276d6 100644
--- a/lib/Text/PrettyPrint/Bernardy/Core/Decorate.idr
+++ b/lib/Text/PrettyPrint/Bernardy/Core/Decorate.idr
@@ -1,37 +1,28 @@
 -- this module has to be called this because a module A.B's private elements are
 -- still visible to A.B.C, even if they're in different packages. which i don't
 -- think is a good idea but i also don't want to fork prettier over it
---
--- also i adapted this code from stefan höck's prettier-ansi package
--- (https://github.com/idris-community/idris2-ansi)
 module Text.PrettyPrint.Bernardy.Core.Decorate
 
 import public Text.PrettyPrint.Bernardy.Core
 import Data.DPair
-import Data.String
-import Derive.Prelude
-
-%language ElabReflection
 
 
 public export
 record Highlight where
   constructor MkHighlight
   before, after : String
-%name Highlight h
-%runElab derive "Highlight" [Eq]
 
 export
-emptyHL : Highlight
-emptyHL = MkHighlight "" ""
+emptyHL : Highlight -> Bool
+emptyHL (MkHighlight before after) = before == "" && after == ""
 
 
--- lifted from prettier-ansi
+-- taken from prettier-ansi
 private
 decorateImpl : Highlight ->
                (ss : SnocList String) -> (0 _ : NonEmptySnoc ss) =>
                Subset (SnocList String) NonEmptySnoc
-decorateImpl h [< x]     = Element [< h.before ++ x ++ h.after] %search
+decorateImpl h [<x]      = Element [< h.before ++ x ++ h.after] %search
 decorateImpl h (sx :< x) = Element (go [] sx :< (x ++ h.after)) %search
   where
     go : List String -> SnocList String -> SnocList String
@@ -43,23 +34,12 @@ decorateImpl h (sx :< x) = Element (go [] sx :< (x ++ h.after)) %search
 ||| changing its stats like width or height.
 export
 decorateLayout : Highlight -> Layout -> Layout
-decorateLayout h (MkLayout content stats) =
+decorateLayout h l@(MkLayout content stats) =
+  if emptyHL h then l else
   layout (decorateImpl h content) stats
 
 ||| Decorate a `Doc` with the given highlighting *without*
 ||| changing its stats like width or height.
 export
-decorate : {opts : LayoutOpts} -> Highlight -> Doc opts -> Doc opts
-decorate h doc =
-  if h == emptyHL then doc else doc >>= pure . decorateLayout h
-
-
--- this function has nothing to do with highlighting but it's here because it
--- _also_ needs access to the private stuff
-||| render a doc with no line breaks at all
-export
-renderInfinite : Doc opts -> String
-renderInfinite (MkDoc (MkLayout content _) _) = unwords content where
-  unwords : SnocList String -> String
-  unwords [<]       = ""
-  unwords (xs :< x) = foldMap (++ " ") xs ++ x
+decorate : {opts : _} -> Highlight -> Doc opts -> Doc opts
+decorate h doc = doc >>= \l => pure (decorateLayout h l)
diff --git a/lib/on-hold/Quox/Lexer.idr b/lib/on-hold/Quox/Lexer.idr
new file mode 100644
index 0000000..3a299dd
--- /dev/null
+++ b/lib/on-hold/Quox/Lexer.idr
@@ -0,0 +1,102 @@
+module Quox.Lexer
+
+import public Quox.Token
+
+import Data.String
+import Data.String.Extra
+import public Text.Lexer
+import public Text.Lexer.Tokenizer
+import Control.Monad.Either
+import Generics.Derive
+
+%default total
+%language ElabReflection
+
+
+public export
+record Error where
+  constructor Err
+  reason    : StopReason
+  line, col : Int
+  char      : Char
+
+
+
+nameStart = pred $ \c => isAlpha c || c == '_'
+nameCont  = pred $ \c => isAlphaNum c || c == '_' || c == '\''
+
+name = nameStart <+> many nameCont <+> reject nameCont
+
+wild = is '_' <+> reject nameCont
+
+%hide Text.Lexer.symbol
+symbol = is '\'' <+> name
+
+decimal = some digit <+> reject nameCont
+
+
+natToNumber : Nat -> Number
+natToNumber 0 = Zero
+natToNumber 1 = One
+natToNumber k = Other k
+
+
+skip : Lexer -> Tokenizer (Maybe a)
+skip lex = match lex $ const Nothing
+
+simple : Char -> a -> Tokenizer (Maybe a)
+simple ch = match (is ch) . const . Just
+
+keyword : String -> Keyword -> Tokenizer (Maybe Token)
+keyword str = match (exact str <+> reject nameCont) . const . Just . K
+
+choice : (xs : List (Tokenizer a)) -> {auto 0 _ : NonEmpty xs} -> Tokenizer a
+choice (t :: ts) = foldl (\a, b => a <|> b) t ts
+
+match : Lexer -> (String -> a) -> Tokenizer (Maybe a)
+match lex f = Tokenizer.match lex (Just . f)
+%hide Tokenizer.match
+
+
+tokens : Tokenizer (Maybe Token)
+tokens = choice [
+  skip $ lineComment $ exact "--",
+  skip $ blockComment (exact "{-") (exact "-}"),
+  skip spaces,
+
+  simple '(' $ P LParen,  simple ')' $ P RParen,
+  simple '[' $ P LSquare, simple ']' $ P RSquare,
+  simple '{' $ P LBrace,  simple '}' $ P RBrace,
+  simple ',' $ P Comma,
+  simple '∷' $ P DblColon,
+  simple ':' $ P Colon, -- needs to be after '::'
+  simple '.' $ P Dot,
+
+  simple '→' $ P Arrow,
+  simple '⇒' $ P DblArrow,
+  simple '×' $ P Times,
+  simple '⊲' $ P Triangle,
+  match wild $ const $ P Wild,
+
+  keyword "λ"    Lam,
+  keyword "let"  Let,  keyword "in" In,
+  keyword "case" Case, keyword "of" Of,
+  keyword "ω"    Omega,
+  keyword "Π"    Pi,   keyword "Σ"  Sigma, keyword "W" W,
+
+  match name   $ Name,
+  match symbol $ Symbol . assert_total strTail,
+
+  match decimal $ N . natToNumber . cast,
+  match (is '★' <+> decimal) $ TYPE . cast . assert_total strTail
+]
+
+
+export
+lex : String -> Either Error (List BToken)
+lex str =
+  let (res, (reason, line, col, str)) = lex tokens str in
+  case reason of
+       EndInput => Right $ mapMaybe sequence res
+       _        => let char = assert_total strIndex str 0 in
+                   Left $ Err {reason, line, col, char}
diff --git a/lib/on-hold/Quox/Parser.idr b/lib/on-hold/Quox/Parser.idr
new file mode 100644
index 0000000..f9f4b09
--- /dev/null
+++ b/lib/on-hold/Quox/Parser.idr
@@ -0,0 +1,159 @@
+module Quox.Parser
+
+import Quox.Syntax
+import Quox.Token
+import Quox.Lexer
+
+import Data.Maybe
+import Data.SnocVect
+import Data.SnocList
+import Text.Parser
+
+%default total
+
+
+public export
+Vars : Nat -> Type
+Vars n = SnocVect n String
+
+public export
+Grammar : Bool -> Type -> Type
+Grammar = Core.Grammar () Token
+%hide Core.Grammar
+
+public export
+data Error
+= Lex (Lexer.Error)
+| Parse (List1 (ParsingError Token))
+| Leftover (List BToken)
+%hide Lexer.Error
+
+
+public export
+parseAll : {c : Bool} -> Grammar c a -> List BToken -> Either Error a
+parseAll grm input =
+  case parse grm input of
+       Right (x, [])   => Right x
+       Right (x, rest) => Left $ Leftover rest
+       Left  errs      => Left $ Parse errs
+
+public export
+lexParseAll : {c : Bool} -> Grammar c a -> String -> Either Error a
+lexParseAll grm = lex' >=> parseAll grm
+  where lex' : String -> Either Error (List BToken)
+        lex' = bimap Lex id . lex
+
+
+
+export
+punc : Punc -> Grammar True ()
+punc p = terminal (show p) $ \case
+  P p' => if p == p' then Just () else Nothing
+  _    => Nothing
+
+export
+keyword : Keyword -> Grammar True ()
+keyword k = terminal (show k) $ \case
+  K k' => if k == k' then Just () else Nothing
+  _    => Nothing
+
+export
+between : Punc -> Punc -> Grammar True a -> Grammar True a
+between opener closer inner = punc opener *> inner <* punc closer
+
+export
+parens, squares, braces : Grammar True a -> Grammar True a
+parens  = between LParen  RParen
+squares = between LSquare RSquare
+braces  = between LBrace  RBrace
+
+
+export
+number : Grammar True Nat
+number = terminal "number" $ \case
+  N Zero      => Just 0
+  N One       => Just 1
+  N (Other k) => Just k
+  _           => Nothing
+
+export
+universe : Grammar True Nat
+universe = terminal "universe" $ \case TYPE k => Just k; _ => Nothing
+
+export
+zero, one, omega : Grammar True ()
+zero  = terminal "0" $ \case N Zero  => Just (); _ => Nothing
+one   = terminal "1" $ \case N One   => Just (); _ => Nothing
+omega = terminal "ω" $ \case K Omega => Just (); _ => Nothing
+
+export
+quantity : Grammar True Qty
+quantity = Zero <$ zero <|> One <$ one <|> Any <$ omega
+
+
+find1 : Eq a => SnocVect k a -> a -> Maybe (Var k)
+find1 [<]       y = Nothing
+find1 (sx :< x) y = if x == y then Just VZ else VS <$> find1 sx y
+
+find : Vars k -> Name -> Maybe (Var k)
+find vs (MakeName [<] (UN y)) = find1 vs y
+find _  _                     = Nothing
+
+
+export
+checkAvoid1 : Vars n -> String -> Grammar False ()
+checkAvoid1 avoid y =
+  when (isJust $ find1 avoid y) $
+    fail "wrong type of bound variable: \{show y}"
+
+export
+checkAvoid : Vars n -> Name -> Grammar False ()
+checkAvoid avoid (MakeName [<] (UN y)) = checkAvoid1 avoid y
+checkAvoid _     _                     = pure ()
+
+export
+bound : (what : String) -> (bound : Vars k) -> (avoid : Vars n) ->
+        Grammar True (Var k)
+bound what vs avoid = do
+  x <- terminal "bound \{what} variable" $ \case Name x => Just x; _ => Nothing
+  checkAvoid1 avoid x
+  maybe (fail "not in scope: \{x}") pure $ find1 vs x
+
+export
+sname : Grammar True String
+sname = terminal "simple name" $ \case Name x => pure x; _ => Nothing
+
+export
+qname : Grammar True Name
+qname = do
+  parts <- sepBy1 (punc Dot) sname
+  pure $ MakeName {mods = cast $ init parts, base = UN $ last parts}
+
+export
+nameWith : (bound : Vars k) -> (avoid : Vars n) ->
+           Grammar True (Either (Var k) Name)
+nameWith bound avoid = do
+  y <- qname
+  checkAvoid avoid y
+  pure $ maybe (Right y) Left $ find bound y
+
+
+export
+dimension : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Dim d)
+dimension dvars tvars =
+      K Zero <$  zero
+  <|> K One  <$  one
+  <|> B      <$> bound "dimension" {bound = dvars, avoid = tvars}
+
+
+mutual
+  export
+  term : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Term d n)
+  term dvars tvars =
+        E <$> squares (elim {dvars, tvars})
+    <|> TYPE . U <$> universe
+
+  export
+  elim : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Elim d n)
+  elim dvars tvars =
+        either B F <$> nameWith {bound = tvars, avoid = dvars}
diff --git a/lib/on-hold/Quox/Syntax/DimEq.idr b/lib/on-hold/Quox/Syntax/DimEq.idr
new file mode 100644
index 0000000..4730b35
--- /dev/null
+++ b/lib/on-hold/Quox/Syntax/DimEq.idr
@@ -0,0 +1,363 @@
+module Quox.Syntax.DimEq
+
+import public Quox.Syntax.Var
+import public Quox.Syntax.Dim
+import public Quox.Syntax.Subst
+import public Quox.Context
+
+import Data.Maybe
+import Data.DPair
+
+%default total
+
+mutual
+  ||| consistent (0≠1) set of constraints between dimension variables
+  public export
+  data DimEq' : Nat -> Type where
+    ||| empty context
+    Nil : DimEq' 0
+    ||| Ψ, 𝑖, 𝑖=ε
+    Const : (eqs : DimEq' d) -> (e : DimConst) -> DimEq' (S d)
+    ||| Ψ, 𝑖, 𝑖=𝑗  (Ψ ⊢ 𝑗 and 𝑗 is unassigned)
+    Var : (eqs : DimEq' d) -> (i : Var d) -> (0 un : Unassigned eqs i) ->
+          DimEq' (S d)
+    ||| Ψ, 𝑖  (𝑖 unassigned)
+    None : (eqs : DimEq' d) -> DimEq' (S d)
+  %name DimEq' eqs
+
+  public export
+  data Unassigned : DimEq' d -> Var d -> Type where
+    UZ  : Unassigned (None eqs) VZ
+    USK : Unassigned eqs i -> Unassigned (Const eqs e)    (VS i)
+    USV : Unassigned eqs i -> Unassigned (Var   eqs j un) (VS i)
+    USN : Unassigned eqs i -> Unassigned (None  eqs )     (VS i)
+  %name Unassigned un
+
+
+||| set of constraints that might be inconsistent
+public export
+data DimEq : Nat -> Type where
+  ||| 0=1
+  ZeroIsOne : DimEq d
+  ||| 0≠1, plus other constraints
+  C : (eqs : DimEq' d) -> DimEq d
+%name DimEq eqs
+
+
+||| contains a value iff the dim ctx is consistent
+public export
+data IfConsistent : DimEq d -> Type -> Type where
+  Nothing :      IfConsistent ZeroIsOne a
+  Just    : a -> IfConsistent (C eqs)   a
+
+export
+Functor (IfConsistent eqs) where
+  map f Nothing  = Nothing
+  map f (Just x) = Just (f x)
+
+export
+Foldable (IfConsistent eqs) where
+  foldr f z Nothing  = z
+  foldr f z (Just x) = f x z
+
+export
+Traversable (IfConsistent eqs) where
+  traverse f Nothing  = pure Nothing
+  traverse f (Just x) = Just <$> f x
+
+||| performs an action if the dim ctx is consistent
+public export
+ifConsistent : Applicative f => (eqs : DimEq d) -> f a -> f (IfConsistent eqs a)
+ifConsistent ZeroIsOne act = pure Nothing
+ifConsistent (C _)     act = Just <$> act
+
+
+public export %inline
+weakD : Dim d -> Dim (S d)
+weakD p = p // SS SZ
+
+
+public export
+tail' : DimEq' (S d) -> DimEq' d
+tail' (Const eqs e)    = eqs
+tail' (Var   eqs i un) = eqs
+tail' (None  eqs )     = eqs
+
+public export
+tail : DimEq (S d) -> DimEq d
+tail ZeroIsOne = ZeroIsOne
+tail (C eqs)   = C $ tail' eqs
+
+public export
+head' : DimEq' (S d) -> Maybe (Dim d)
+head' (Const _ e)   = Just $ K e
+head' (Var   _ i _) = Just $ B i
+head' (None  _)     = Nothing
+
+export
+tailU : Unassigned eqs (VS i) -> Unassigned (tail' eqs) i
+tailU (USK un) = un
+tailU (USV un) = un
+tailU (USN un) = un
+
+
+||| make a dim ctx where each variable has a constant assignment
+public export
+fromGround' : Context' DimConst d -> DimEq' d
+fromGround' [<]        = Nil
+fromGround' (ctx :< e) = Const (fromGround' ctx) e
+
+||| make a dim ctx where each variable has a constant assignment
+public export
+fromGround : Context' DimConst d -> DimEq d
+fromGround = C . fromGround'
+
+
+||| make a dim ctx where each variable is unassigned
+public export
+new' : (d : Nat) -> DimEq' d
+new' 0     = Nil
+new' (S d) = None (new' d)
+
+||| make a dim ctx where each variable is unassigned
+public export
+new : (d : Nat) -> DimEq d
+new d = C $ new' d
+
+
+||| if the dim is a variable, then it is unassigned
+public export
+data UnassignedDim : DimEq' d -> Dim d -> Type where
+  UDK : UnassignedDim eqs (K e)
+  UDB : Unassigned eqs i -> UnassignedDim eqs (B i)
+
+export
+weakUD : {eqs : DimEq' (S d)} -> {p : Dim d} ->
+         UnassignedDim (tail' eqs) p -> UnassignedDim eqs (weakD p)
+weakUD UDK = UDK
+weakUD (UDB un) {eqs = Const eqs e}   = UDB $ USK un
+weakUD (UDB un) {eqs = Var   eqs _ _} = UDB $ USV un
+weakUD (UDB un) {eqs = None  eqs}     = UDB $ USN un
+
+
+||| get the constraint on a variable 𝑖. if it is equal to another var 𝑗,
+||| then 𝑗 is not further constrained
+public export
+getVarPrf : (eqs : DimEq' d) -> Var d -> Subset (Dim d) (UnassignedDim eqs)
+getVarPrf (Const eqs e)    VZ     = Element (K e)      UDK
+getVarPrf (Var   eqs i un) VZ     = Element (B $ VS i) (UDB $ USV un)
+getVarPrf (None  eqs)      VZ     = Element (B VZ)     (UDB UZ)
+getVarPrf (Const eqs _)    (VS i) = let p = getVarPrf eqs i in
+                                    Element (weakD p.fst) (weakUD p.snd)
+getVarPrf (Var   eqs _ _)  (VS i) = let p = getVarPrf eqs i in
+                                    Element (weakD p.fst) (weakUD p.snd)
+getVarPrf (None  eqs)      (VS i) = let p = getVarPrf eqs i in
+                                    Element (weakD p.fst) (weakUD p.snd)
+
+public export
+getVar : (eqs : DimEq' d) -> Var d -> Dim d
+getVar eqs i = fst $ getVarPrf eqs i
+
+public export
+getPrf : (eqs : DimEq' d) -> Dim d -> Subset (Dim d) (UnassignedDim eqs)
+getPrf eqs (K e) = Element (K e) UDK
+getPrf eqs (B i) = getVarPrf eqs i
+
+public export
+get : DimEq' d -> Dim d -> Dim d
+get eqs p = fst $ getPrf eqs p
+
+
+-- version of `get` that only shifts once but is even more annoying to prove
+-- anything about
+private
+getShift' : Shift d out -> DimEq' d -> Var d -> Maybe (Dim out)
+getShift' by (Const eqs e)    VZ     = Just $ K e
+getShift' by (Var   eqs i un) VZ     = Just $ B $ i // ssDown by
+getShift' by (None  eqs)      VZ     = Nothing
+getShift' by eqs              (VS i) = getShift' (ssDown by) (tail' eqs) i
+
+private
+getShift0' : DimEq' d -> Var d -> Maybe (Dim d)
+getShift0' = getShift' SZ
+
+private
+get' : DimEq' d -> Dim d -> Dim d
+get' eqs (K e) = K e
+get' eqs (B i) = fromMaybe (B i) $ getShift0' eqs i
+
+%transform "DimEq.get" get = get'
+
+
+public export
+Equal' : DimEq' d -> Rel (Dim d)
+Equal' eqs p q = get eqs p = get eqs q
+
+||| whether two dimensions are equal under the current constraints
+public export
+data Equal : DimEq d -> Rel (Dim d) where
+  Eq01 : Equal ZeroIsOne p q
+  EqC  : Equal' eqs p q -> Equal (C eqs) p q
+%name DimEq.Equal prf
+
+export
+decEqual : (eqs : DimEq d) -> Dec2 (Equal eqs)
+decEqual ZeroIsOne _ _ = Yes Eq01
+decEqual (C eqs)   p q = case get eqs p `decEq` get eqs q of
+  Yes y => Yes $ EqC y
+  No  n => No  $ \case EqC p => n p
+
+export
+equal : (eqs : DimEq d) -> Dim d -> Dim d -> Bool
+equal eqs p q = isYes $ decEqual eqs p q
+
+export
+{eqs : DimEq d} -> Reflexive _ (Equal eqs) where
+  reflexive = case eqs of
+    ZeroIsOne => Eq01
+    C eqs     => EqC Refl
+
+export
+Symmetric _ (Equal eqs) where
+  symmetric Eq01     = Eq01
+  symmetric (EqC eq) = EqC $ sym eq
+
+export
+Transitive _ (Equal eqs) where
+  transitive Eq01    Eq01    = Eq01
+  transitive (EqC p) (EqC q) = EqC $ p `trans` q
+
+export {eqs : DimEq d} -> Equivalence _ (Equal eqs) where
+
+
+||| extend the context with a new variable, possibly constrained
+public export
+(:<) : DimEq' d -> Maybe (Dim d) -> DimEq' (S d)
+eqs :< Nothing    = None  eqs
+eqs :< Just (K e) = Const eqs e
+eqs :< Just (B i) with (getVarPrf eqs i)
+  _ | Element (K e) _  = Const eqs e
+  _ | Element (B j) un = Var eqs j $ let UDB un = un in un
+
+infixl 7 :<?
+||| extend the context with a new variable, possibly constrained
+public export
+(:<?) : DimEq d -> Maybe (Dim d) -> DimEq (S d)
+ZeroIsOne :<? p = ZeroIsOne
+C eqs     :<? p = C $ eqs :< p
+
+
+public export
+checkConst : DimConst -> DimConst -> DimEq' d -> DimEq d
+checkConst e f eqs = case decEq e f of Yes _ => C eqs; No _ => ZeroIsOne
+
+public export
+setConst : Var d -> DimConst -> DimEq' d -> DimEq d
+setConst VZ     e (Const eqs f)    = checkConst e f $ eqs :< Just (K e)
+setConst VZ     e (Var   eqs i un) = setConst i e eqs :<? Just (K e)
+setConst VZ     e (None  eqs)      = C $ Const eqs e
+setConst (VS i) e (Const eqs f)    = setConst i e eqs :<? Just (K f)
+setConst (VS i) e (Var   eqs j un) = setConst i e eqs :<? Just (B j)
+setConst (VS i) e (None  eqs)      = setConst i e eqs :<? Nothing
+
+public export
+setVar : Var d -> Var d -> DimEq' d -> DimEq d
+setVar VZ VZ eqs = C eqs
+setVar VZ     (VS j) (Const eqs e)    = setConst j e eqs :<? Just (K e)
+setVar VZ     (VS j) (Var   eqs k un) = setVar j k eqs :<? Just (B k)
+setVar VZ     (VS j) (None  eqs)      = C eqs :<? Just (B j)
+setVar (VS i) VZ     (Const eqs e)    = setConst i e eqs :<? Just (K e)
+setVar (VS i) VZ     (Var   eqs k un) = setVar i k eqs :<? Just (B k)
+setVar (VS i) VZ     (None  eqs)      = C eqs :<? Just (B i)
+setVar (VS i) (VS j) (Const eqs e)    = setVar i j eqs :<? Just (K e)
+setVar (VS i) (VS j) (Var   eqs k un) = setVar i j eqs :<? Just (B k)
+setVar (VS i) (VS j) (None  eqs)      = setVar i j eqs :<? Nothing
+
+public export
+set : Dim d -> Dim d -> DimEq d -> DimEq d
+set p     q     ZeroIsOne = ZeroIsOne
+set (K e) (K f) (C eqs) = checkConst e f eqs
+set (K e) (B j) (C eqs) = setConst j e eqs
+set (B i) (K f) (C eqs) = setConst i f eqs
+set (B i) (B j) (C eqs) = setVar   i j eqs
+
+
+private
+splitV0 : (p : Dim (S d)) -> Either (p = B VZ) (q : Dim d ** p = weakD q)
+splitV0 (K e)      = Right (K e ** Refl)
+splitV0 (B VZ)     = Left Refl
+splitV0 (B (VS i)) = Right (B i ** Refl)
+
+
+export
+0 getSnoc : (eqs : DimEq' d) -> (u : Maybe (Dim d)) -> (i : Var d) ->
+            getVar (eqs :< u) (VS i) = weakD (getVar eqs i)
+getSnoc eqs Nothing      i = Refl
+getSnoc eqs (Just (K e)) i = Refl
+getSnoc eqs (Just (B j)) i with (getVarPrf eqs j)
+  _ | Element (K _) _ = Refl
+  _ | Element (B _) _ = Refl
+
+export
+0 snocStrengthen : (p, q : Dim d) ->
+                   Equal' (eqs :< u) (weakD p) (weakD q) -> Equal' eqs p q
+snocStrengthen (K e) (K e) Refl = Refl
+snocStrengthen (K e) (B i) prf =
+  shiftInj (SS SZ) _ _ $
+  rewrite sym $ getSnoc eqs u i in prf
+snocStrengthen (B i) (K e) prf =
+  shiftInj (SS SZ) _ _ $
+  rewrite sym $ getSnoc eqs u i in prf
+snocStrengthen (B i) (B j) prf =
+  shiftInj (SS SZ) _ _ $
+  rewrite sym $ getSnoc eqs u i in
+  rewrite sym $ getSnoc eqs u j in prf
+
+export
+0 snocStable : (eqs : DimEq d) -> (u : Maybe (Dim d)) -> (p, q : Dim d) ->
+               Equal eqs p q -> Equal (eqs :<? u) (weakD p) (weakD q)
+snocStable ZeroIsOne u p q Eq01 = Eq01
+snocStable (C eqs) u (K e) (K e) (EqC Refl) = reflexive
+snocStable (C eqs) u (K e) (B i) (EqC prf) = EqC $
+  rewrite getSnoc eqs u i in rewrite sym prf in Refl
+snocStable (C eqs) u (B i) (K e) (EqC prf) = EqC $
+  rewrite getSnoc eqs u i in rewrite prf in Refl
+snocStable (C eqs) u (B i) (B j) (EqC prf) = EqC $
+  rewrite getSnoc eqs u i in
+  rewrite getSnoc eqs u j in
+  rewrite prf in Refl
+
+export
+0 checkConstStable : (eqs : DimEq' d) -> (e, f : DimConst) ->
+                     (p, q : Dim d) -> Equal' eqs p q ->
+                     Equal (checkConst e f eqs) p q
+checkConstStable eqs e f p q prf with (decEq e f)
+  _ | Yes _ = EqC prf
+  _ | No  _ = Eq01
+
+export
+0 setConstStable : (eqs : DimEq' d) -> (i : Var d) -> (e : DimConst) ->
+                   (p, q : Dim d) -> Equal' eqs p q ->
+                   Equal (setConst i e eqs) p q
+setConstStable (Const eqs f) VZ e p q prf with (decEq e f)
+  _ | Yes _ = EqC prf
+  _ | No  _ = Eq01
+setConstStable (Const eqs f) (VS i) e p q prf = ?setConstStable_rhs_5
+setConstStable (Var eqs j un) VZ e p q prf = ?setConstStable_rhs_6
+setConstStable (Var eqs j un) (VS i) e p q prf = ?setConstStable_rhs_7
+setConstStable (None eqs) VZ e p q prf = ?setConstStable_rhs_8
+setConstStable (None eqs) (VS i) e p q prf = ?setConstStable_rhs_9
+
+export
+0 setVarStable : (eqs : DimEq' d) -> (i, j : Var d) ->
+                 (p, q : Dim d) -> Equal' eqs p q ->
+                 Equal (setVar i j eqs) p q
+
+export
+0 setStable : (eqs : DimEq d) -> (u, v, p, q : Dim d) ->
+              Equal eqs p q -> Equal (set u v eqs) p q
+setStable ZeroIsOne p q u v Eq01 = Eq01
+setStable (C eqs) (K e) (K f) p q (EqC prf) = checkConstStable eqs e f p q prf
+setStable (C eqs) (K e) (B i) p q (EqC prf) = setConstStable eqs i e p q prf
+setStable (C eqs) (B i) (K e) p q (EqC prf) = setConstStable eqs i e p q prf
+setStable (C eqs) (B i) (B j) p q (EqC prf) = setVarStable eqs i j p q prf
diff --git a/lib/on-hold/Quox/Token.idr b/lib/on-hold/Quox/Token.idr
new file mode 100644
index 0000000..432dd22
--- /dev/null
+++ b/lib/on-hold/Quox/Token.idr
@@ -0,0 +1,49 @@
+module Quox.Token
+
+import Generics.Derive
+import Text.Lexer
+
+%default total
+%language ElabReflection
+
+
+public export
+data Punc
+= LParen  | RParen
+| LSquare | RSquare
+| LBrace  | RBrace
+| Comma
+| Colon | DblColon
+| Dot
+| Arrow | DblArrow
+| Times | Triangle
+| Wild
+%runElab derive "Punc" [Generic, Meta, Eq, Ord, DecEq, Show]
+
+
+public export
+data Keyword
+= Lam | Let | In | Case | Of | Omega
+| Pi | Sigma | W
+%runElab derive "Keyword" [Generic, Meta, Eq, Ord, DecEq, Show]
+
+
+||| zero and one are separate because they are
+||| quantity & dimension constants
+public export
+data Number = Zero | One | Other Nat
+%runElab derive "Number" [Generic, Meta, Eq, Ord, DecEq, Show]
+
+
+public export
+data Token
+= P Punc
+| K Keyword
+| Name String | Symbol String
+| N Number | TYPE Nat
+%runElab derive "Token" [Generic, Meta, Eq, Ord, DecEq, Show]
+
+
+public export
+BToken : Type
+BToken = WithBounds Token
diff --git a/lib/quox-lib.ipkg b/lib/quox-lib.ipkg
index 85817f0..77285c5 100644
--- a/lib/quox-lib.ipkg
+++ b/lib/quox-lib.ipkg
@@ -5,27 +5,20 @@ authors   = "rhiannon morris"
 sourceloc = "https://git.rhiannon.website/rhi/quox"
 license   = "acsl"
 
-depends =
-  base, contrib, elab-util, sop, snocvect, eff, prettier,
-  pretty-show, parser-show
+depends = base, contrib, elab-util, sop, snocvect, eff, prettier
 
 modules =
   Text.PrettyPrint.Bernardy.Core.Decorate,
-  Control.Monad.ST.Extra,
   Quox.BoolExtra,
   Quox.CharExtra,
   Quox.NatExtra,
   Quox.EffExtra,
-  Quox.PrettyValExtra,
   Quox.Decidable,
   Quox.No,
-  Quox.Log,
   Quox.Loc,
-  Quox.Var,
-  Quox.Scoped,
+  Quox.OPE,
   Quox.Pretty,
   Quox.Syntax,
-  Quox.Syntax.Builtin,
   Quox.Syntax.Dim,
   Quox.Syntax.DimEq,
   Quox.Syntax.Qty,
@@ -34,17 +27,13 @@ modules =
   Quox.Syntax.Term,
   Quox.Syntax.Term.TyConKind,
   Quox.Syntax.Term.Base,
+  Quox.Syntax.Term.Tighten,
   Quox.Syntax.Term.Pretty,
   Quox.Syntax.Term.Subst,
-  Quox.FreeVars,
+  Quox.Syntax.Var,
   Quox.Displace,
   Quox.Definition,
-  Quox.Whnf.Interface,
-  Quox.Whnf.ComputeElimType,
-  Quox.Whnf.TypeCase,
-  Quox.Whnf.Coercion,
-  Quox.Whnf.Main,
-  Quox.Whnf,
+  Quox.Reduce,
   Quox.Context,
   Quox.Equal,
   Quox.Name,
@@ -53,14 +42,9 @@ modules =
   Quox.Typing.Error,
   Quox.Typing,
   Quox.Typechecker,
-  Quox.CheckBuiltin,
   Quox.Parser.Lexer,
   Quox.Parser.Syntax,
   Quox.Parser.Parser,
-  Quox.Parser.LoadFile,
   Quox.Parser.FromParser,
   Quox.Parser.FromParser.Error,
-  Quox.Parser,
-  Quox.Untyped.Syntax,
-  Quox.Untyped.Erase,
-  Quox.Untyped.Scheme
+  Quox.Parser
diff --git a/pack.toml b/pack.toml
index 2673417..ae96ef9 100644
--- a/pack.toml
+++ b/pack.toml
@@ -1,4 +1,4 @@
-collection = "nightly-240413"
+collection = "nightly-230711"
 
 [custom.all.tap]
 type = "git"
@@ -20,8 +20,3 @@ ipkg = "quox.ipkg"
 type = "local"
 path = "./tests"
 ipkg = "quox-tests.ipkg"
-
-[custom.all.quox-golden-tests]
-type = "local"
-path = "./golden-tests"
-ipkg = "quox-golden-tests.ipkg"
diff --git a/quox.bib b/quox.bib
index 5c2ca0a..6951370 100644
--- a/quox.bib
+++ b/quox.bib
@@ -1,4 +1,4 @@
-% quantitative/modal stuff {{{1
+% quantitative stuff
 
 @inproceedings{grtt,
   author    = {Moon, Benjamin and
@@ -17,18 +17,6 @@
   doi       = {10.1007/978-3-030-72019-3\_17}
 }
 
-@article{granule,
-  author  = {Dominic Orchard and Vilem{-}Benjamin Liepelt and Harley Eades III},
-  title   = {Quantitative program reasoning with graded modal types},
-  journal = {Proceedings of the {ACM} on Programming Languages},
-  volume  = {3},
-  number  = {{ICFP}},
-  pages   = {110:1--110:30},
-  year    = {2019},
-  url     = {https://doi.org/10.1145/3341714},
-  doi     = {10.1145/3341714},
-}
-
 @inproceedings{nuttin,
   author    = {Conor McBride},
   editor    = {Sam Lindley and
@@ -63,118 +51,8 @@
   doi       = {10.1145/3209108.3209189}
 }
 
-@article{frac-uniq,
-  author    = {Marshall, Daniel and Orchard, Dominic},
-  title     = {Functional Ownership through Fractional Uniqueness},
-  year      = {2024},
-  publisher = {Association for Computing Machinery},
-  address   = {New York, NY, USA},
-  volume    = {8},
-  number    = {OOPSLA1},
-  url       = {https://doi.org/10.1145/3649848},
-  doi       = {10.1145/3649848},
-  journal   = {Proc. ACM Program. Lang.},
-}
 
-@article{rustbelt,
-  author    = {Jung, Ralf and
-               Jourdan, Jacques-Henri and
-               Krebbers, Robbert and
-               Dreyer, Derek},
-  title     = {{RustBelt}:
-               securing the foundations of the {R}ust programming language},
-  year      = {2017},
-  publisher = {Association for Computing Machinery},
-  address   = {New York, NY, USA},
-  volume    = {2},
-  number    = {POPL},
-  url       = {https://doi.org/10.1145/3158154},
-  doi       = {10.1145/3158154},
-  journal   = {Proc. ACM Program. Lang.},
-}
-
-@article{lightweight-rust,
-  author    = {Pearce, David J.},
-  title     = {A Lightweight Formalism for Reference Lifetimes
-               and Borrowing in Rust},
-  year      = {2021},
-  publisher = {Association for Computing Machinery},
-  volume    = {43},
-  number    = {1},
-  url       = {https://doi.org/10.1145/3443420},
-  doi       = {10.1145/3443420},
-  journal   = {ACM Trans. Program. Lang. Syst.},
-}
-
-@misc{oxide,
-  title         = {Oxide: The Essence of Rust},
-  author        = {Aaron Weiss and
-                   Olek Gierczak and
-                   Daniel Patterson and
-                   Amal Ahmed},
-  year          = {2021},
-  eprint        = {1903.00982},
-  archivePrefix = {arXiv},
-  primaryClass  = {cs.PL}
-}
-
-@inproceedings{frac-perms,
-  author       = {John Boyland},
-  editor       = {Radhia Cousot},
-  title        = {Checking Interference with Fractional Permissions},
-  booktitle    = {Static Analysis, 10th International Symposium, {SAS} 2003,
-                  San Diego, CA, USA, June 11-13, 2003, Proceedings},
-  series       = {Lecture Notes in Computer Science},
-  volume       = {2694},
-  pages        = {55--72},
-  publisher    = {Springer},
-  year         = {2003},
-  url          = {https://doi.org/10.1007/3-540-44898-5\_4},
-  doi          = {10.1007/3-540-44898-5\_4},
-}
-
-@inproceedings{linexp-graded,
-  title = {Linear Exponentials as Graded Modal Types},
-  author = {Hughes, Jack and
-            Marshall, Daniel and
-            Wood, James and
-            Orchard, Dominic},
-  url = {https://hal-lirmm.ccsd.cnrs.fr/lirmm-03271465},
-  booktitle = {5th International Workshop on
-               Trends in Linear Logic and Applications ({TLLA} 2021)},
-  year = {2021},
-  month = Jun,
-}
-
-@inproceedings{alms,
-  author    = {Tov, Jesse A. and Pucella, Riccardo},
-  title     = {Practical affine types},
-  year      = {2011},
-  publisher = {Association for Computing Machinery},
-  url       = {https://users.cs.northwestern.edu/~jesse/pubs/alms/tovpucella-alms.pdf},
-  doi       = {10.1145/1926385.1926436},
-  booktitle = {Proceedings of the 38th Annual ACM SIGPLAN-SIGACT
-               Symposium on Principles of Programming Languages},
-}
-
-@inproceedings{rrr,
-  author    = {Daniel Marshall and Dominic Orchard},
-  editor    = {Marco Carbone and Rumyana Neykova},
-  title     = {Replicate, Reuse, Repeat: Capturing Non-Linear Communication
-               via Session Types and Graded Modal Types},
-  booktitle = {Proceedings of the 13th International Workshop on Programming
-               Language Approaches to Concurrency and Communication-cEntric
-               Software, PLACES@ETAPS 2022, Munich, Germany, 3rd April 2022},
-  series    = {{EPTCS}},
-  volume    = {356},
-  pages     = {1--11},
-  year      = {2022},
-  url       = {https://arxiv.org/abs/2203.12875},
-  doi       = {10.4204/EPTCS.356.1},
-}
-
-
-% observational stuff {{{1
+% observational stuff
 
 @inproceedings{ott-now,
   author    = {Thorsten Altenkirch and
@@ -221,26 +99,8 @@
   doi       = {10.4230/LIPIcs.FSCD.2019.31}
 }
 
-@article{xtt2,
-  author  = {Jonathan Sterling and Carlo Angiuli and Daniel Gratzer},
-  title   = {A Cubical Language for Bishop Sets},
-  journal = {Log. Methods Comput. Sci.},
-  volume  = {18},
-  number  = {1},
-  year    = {2022},
-  url     = {https://doi.org/10.46298/lmcs-18(1:43)2022},
-  doi     = {10.46298/LMCS-18(1:43)2022},
-}
 
-@unpublished{cubical-ott,
-  author = {James Chapman and Fredrik Nordvall Forsberg and Conor {McBride}},
-  title  = {The Box of Delights (Cubical Observational Type Theory)},
-  year   = {2018},
-  url    = {https://github.com/msp-strath/platypus/blob/138daf7/January18/doc/CubicalOTT/CubicalOTT.pdf},
-}
-
-
-% NbE {{{1
+% NbE
 
 @article{nbe-mltt,
   title    = {Normalization by Evaluation for Martin-Löf Type Theory with
@@ -312,7 +172,7 @@
   doi       = {10.4204/EPTCS.153.4}
 }
 
-% Misc type stuff {{{1
+% Misc type stuff
 
 @article{calf,
   author = {Niu, Yue and
@@ -326,7 +186,7 @@
   number = {POPL},
   url = {https://doi.org/10.1145/3498670},
   doi = {10.1145/3498670},
-  journal = {Proc. {ACM} Program. Lang.},
+  journal = {Proc. ACM Program. Lang.},
   month = {jan},
   articleno = {9},
   numpages = {31},
@@ -367,7 +227,7 @@
     for universe levels based on displacement algebras, for use in proof
     assistant implementations.
   },
-  journal = {Proc. {ACM} Program. Lang.},
+  journal = {Proc. ACM Program. Lang.},
   month = {jan},
   articleno = {57},
   numpages = {27},
@@ -457,71 +317,8 @@
   doi          = {10.1109/LICS.2000.855774},
 }
 
-@misc{ornaments,
-  author = {Conor {McBride}},
-  title  = {Ornamental Algebras, Algebraic Ornaments},
-  year   = {2011},
-  url    = {https://personal.cis.strath.ac.uk/conor.mcbride/pub/OAAO/LitOrn.pdf},
-}
 
-
-% Misc type stuff {{{1
-
-% not open access. i cry
-@inproceedings{simple-quotient,
-  author       = {Martin Hofmann},
-  editor       = {Mariangiola Dezani{-}Ciancaglini and Gordon D. Plotkin},
-  title        = {A Simple Model for Quotient Types},
-  booktitle    = {Typed Lambda Calculi and Applications,
-                  Second International Conference on Typed Lambda Calculi and
-                  Applications, {TLCA} '95, Edinburgh, UK, April 10-12, 1995,
-                  Proceedings},
-  series       = {Lecture Notes in Computer Science},
-  volume       = {902},
-  pages        = {216--234},
-  publisher    = {Springer},
-  year         = {1995},
-  url          = {https://doi.org/10.1007/BFb0014055},
-  doi          = {10.1007/BFB0014055},
-}
-
-@inproceedings{local,
-  author    = {Michael Vollmer and
-               Chaitanya Koparkar and
-               Mike Rainey and
-               Laith Sakka and
-               Milind Kulkarni and
-               Ryan R. Newton},
-  editor    = {Kathryn S. McKinley and
-               Kathleen Fisher},
-  title     = {{LoCal}: a language for programs operating on serialized data},
-  booktitle = {Proceedings of the 40th {ACM} {SIGPLAN} Conference on Programming
-               Language Design and Implementation, {PLDI} 2019, Phoenix, AZ,
-               USA, June 22-26, 2019},
-  pages     = {48--62},
-  publisher = {{ACM}},
-  year      = {2019},
-  url       = {http://recurial.com/pldi19main.pdf},
-  doi       = {10.1145/3314221.3314631},
-}
-
-@article{mlsub-pearl,
-  author    = {Parreaux, Lionel},
-  title     = {The simple essence of algebraic subtyping: principal type
-               inference with subtyping made easy (functional pearl)},
-  year      = {2020},
-  publisher = {Association for Computing Machinery},
-  address   = {New York, NY, USA},
-  volume    = {4},
-  number    = {ICFP},
-  url       = {https://doi.org/10.1145/3409006},
-  doi       = {10.1145/3409006},
-  journal   = {Proc. ACM Program. Lang.},
-  month     = {aug},
-}
-
-
-% Misc implementation {{{1
+% Misc implementation
 
 @article{expl-sub,
   author    = {Martín Abadi and
@@ -546,9 +343,9 @@
   date         = {2019-07},
   doi          = {10.1145/3341711},
   issn         = {2475-1421},
-  journaltitle = {Proceedings of the {ACM} on Programming Languages},
+  journaltitle = {Proceedings of the ACM on Programming Languages},
   keywords     = {Modal types,dependent types,normalization by evaluation,type-checking},
-  number       = {{ICFP}},
+  number       = {ICFP},
   pages        = {107:1--107:29},
   title        = {Implementing a Modal Dependent Type Theory},
   volume       = {3},
@@ -569,32 +366,3 @@
   url       = {https://www.cs.bham.ac.uk/~pbl/papers/hosc05.pdf},
   doi       = {10.1007/s10990-006-0480-6},
 }
-
-@article{defunc,
-  author  = {Yulong Huang and Jeremy Yallop},
-  title   = {Defunctionalization with Dependent Types},
-  journal = {Proceedings of the {ACM} on Programming Languages},
-  volume  = {7},
-  number  = {{PLDI}},
-  pages   = {516--538},
-  year    = {2023},
-  url     = {https://doi.org/10.1145/3591241},
-  doi     = {10.1145/3591241},
-}
-
-@inproceedings{delcont-callcc,
-  author       = {Martin Gasbichler and Michael Sperber},
-  editor       = {Mitchell Wand and Simon L. Peyton Jones},
-  title        = {Final shift for \texttt{call/cc}:
-                  direct implementation of shift and reset},
-  journaltitle = {Proceedings of the {ACM} on Programming Languages},
-  number       = {{ICFP}},
-  pages        = {271--282},
-  publisher    = {{ACM}},
-  year         = {2002},
-  % url          = {https://doi.org/10.1145/581478.581504},
-  url          = {https://www.cs.tufts.edu/~nr/cs257/archive/mike-sperber/shift-reset-direct.pdf},
-  doi          = {10.1145/581478.581504},
-}
-
-% vim: set fdm=marker :
diff --git a/stdlib/bool.quox b/stdlib/bool.quox
deleted file mode 100644
index 855f064..0000000
--- a/stdlib/bool.quox
+++ /dev/null
@@ -1,49 +0,0 @@
-load "misc.quox"
-
-namespace bool {
-
-def0 Bool : ★ = {true, false}
-
-def if-dep : 0.(P : Bool → ★) → (b : Bool) → ω.(P 'true) → ω.(P 'false) → P b =
-  λ P b t f ⇒ case b return b' ⇒ P b' of { 'true ⇒ t; 'false ⇒ f }
-
-def if : 0.(A : ★) → (b : Bool) → ω.A → ω.A → A =
-  λ A ⇒ if-dep (λ _ ⇒ A)
-
-def0 if-same : (A : ★) → (b : Bool) → (x : A) → if A b x x ≡ x : A =
-  λ A b x ⇒ if-dep (λ b' ⇒ if A b' x x ≡ x : A) b (δ _ ⇒ x) (δ _ ⇒ x)
-
-def if2 : 0.(A B : ★) → (b : Bool) → ω.A → ω.B → if¹ ★ b A B =
-  λ A B ⇒ if-dep (λ b ⇒ if¹ ★ b A B)
-
-def0 T : Bool → ★ = λ b ⇒ if¹ ★ b True False
-
-def dup! : (b : Bool) → Dup Bool b =
-  λ b ⇒
-  case b return b' ⇒ Dup Bool b' of {
-    'true  ⇒ (['true],  [δ _ ⇒ ['true]]);
-    'false ⇒ (['false], [δ _ ⇒ ['false]])
-  }
-
-def dup : Bool → [ω.Bool] =
-  λ b ⇒
-    case dup! b return [ω.Bool] of {
-      (b!, p0) ⇒ drop0 (b! ≡ [b] : [ω.Bool]) [ω.Bool] p0 b!
-    }
-
-def true-not-false : Not ('true ≡ 'false : Bool) =
-  λ eq ⇒ coe (𝑖 ⇒ T (eq @𝑖)) 'true
-
-
--- [todo] infix
-def and : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false
-def or  : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a 'true b
-def not : Bool → Bool = λ b ⇒ if Bool b 'false 'true
-
-
-def0 not-not : (b : Bool) → not (not b) ≡ b : Bool =
-  λ b ⇒ if-dep (λ b ⇒ not (not b) ≡ b : Bool) b (δ _ ⇒ 'true) (δ _ ⇒ 'false)
-
-}
-
-def0 Bool = bool.Bool
diff --git a/stdlib/either.quox b/stdlib/either.quox
deleted file mode 100644
index fa67ea2..0000000
--- a/stdlib/either.quox
+++ /dev/null
@@ -1,116 +0,0 @@
-load "misc.quox"
-load "bool.quox"
-
-namespace either {
-
-def0 Tag : ★ = {left, right}
-
-def0 Payload : ★ → ★ → Tag → ★ =
-  λ A B tag ⇒ case tag return ★ of { 'left ⇒ A; 'right ⇒ B }
-
-def0 Either : ★ → ★ → ★ =
-  λ A B ⇒ (tag : Tag) × Payload A B tag
-
-def Left : 0.(A B : ★) → A → Either A B =
-  λ A B x ⇒ ('left, x)
-
-def Right : 0.(A B : ★) → B → Either A B =
-  λ A B x ⇒ ('right, x)
-
-def elim :
-    0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
-    ω.((x : A) → P (Left  A B x)) →
-    ω.((x : B) → P (Right A B x)) →
-    (x : Either A B) → P x =
-  λ A B P f g e ⇒
-    case e return e' ⇒ P e' of { (t, a) ⇒
-      case t return t' ⇒ (a : Payload A B t') → P (t', a)
-      of { 'left ⇒ f; 'right ⇒ g } a
-    }
-
-def elimω :
-    0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
-    ω.(ω.(x : A) → P (Left  A B x)) →
-    ω.(ω.(x : B) → P (Right A B x)) →
-    ω.(x : Either A B) → P x =
-  λ A B P f g e ⇒
-    case fst e return t' ⇒ ω.(a : Payload A B t') → P (t', a)
-    of { 'left ⇒ f; 'right ⇒ g } (snd e)
-
-def fold :
-    0.(A B C : ★) → ω.(A → C) → ω.(B → C) → Either A B → C =
-  λ A B C ⇒ elim A B (λ _ ⇒ C)
-
-def foldω :
-    0.(A B C : ★) → ω.(ω.A → C) → ω.(ω.B → C) → ω.(Either A B) → C =
-  λ A B C ⇒ elimω A B (λ _ ⇒ C)
-
-
-}
-
-def0 Either = either.Either
-def  Left   = either.Left
-def  Right  = either.Right
-
-
-namespace dec {
-
-def0 Dec : ★ → ★ = λ A ⇒ Either [0.A] [0.Not A]
-
-def Yes : 0.(A : ★) → 0.A       → Dec A = λ A y ⇒ Left  [0.A] [0.Not A] [y]
-def No  : 0.(A : ★) → 0.(Not A) → Dec A = λ A n ⇒ Right [0.A] [0.Not A] [n]
-
-def yes-refl : 0.(A : ★) → 0.(x : A) → Dec (x ≡ x : A) =
-  λ A x ⇒ Yes (x ≡ x : A) (δ 𝑖 ⇒ x)
-
-def0 DecEq : ★ → ★ =
-  λ A ⇒ ω.(x y : A) → Dec (x ≡ y : A)
-
-def elim :
-    0.(A : ★) → 0.(P : 0.(Dec A) → ★) →
-    ω.(0.(y : A)     → P (Yes A y)) →
-    ω.(0.(n : Not A) → P (No  A n)) →
-    (x : Dec A) → P x =
-  λ A P f g ⇒
-    either.elim [0.A] [0.Not A] P
-      (λ y ⇒ case y return y' ⇒ P (Left  [0.A] [0.Not A] y') of {[y'] ⇒ f y'})
-      (λ n ⇒ case n return n' ⇒ P (Right [0.A] [0.Not A] n') of {[n'] ⇒ g n'})
-
-def bool : 0.(A : ★) → Dec A → Bool =
-  λ A ⇒ elim A (λ _ ⇒ Bool) (λ _ ⇒ 'true) (λ _ ⇒ 'false)
-
-def drop' : 0.(A : ★) → Dec A → True =
-  λ A ⇒ elim A (λ _ ⇒ True) (λ _ ⇒ 'true) (λ _ ⇒ 'true)
-
-def drop : 0.(A B : ★) → Dec A → B → B =
-  λ A B x y ⇒ true.drop B (drop' A x) y
-
-}
-
-def0 Dec   = dec.Dec
-def0 DecEq = dec.DecEq
-def  Yes   = dec.Yes
-def  No    = dec.No
-
-
-namespace dect {
-
-def0 DecT : ★ → ★ = λ A ⇒ Either A [0.Not A]
-
-def YesT : 0.(A : ★) → 1.A       → DecT A = λ A y ⇒ Left  A [0.Not A] y
-def NoT  : 0.(A : ★) → 0.(Not A) → DecT A = λ A n ⇒ Right A [0.Not A] [n]
-
-def elim :
-    0.(A : ★) → 0.(P : 0.(DecT A) → ★) →
-    ω.(1.(y : A)     → P (YesT A y)) →
-    ω.(0.(n : Not A) → P (NoT  A n)) →
-    (x : DecT A) → P x =
-  λ A P f g ⇒
-    either.elim A [0.Not A] P
-      f
-      (λ n ⇒ case n return n' ⇒ P (Right A [0.Not A] n') of {[n'] ⇒ g n'})
-}
-
-def0 DecT = dect.DecT
-def  YesT = dect.YesT
-def  NoT  = dect.NoT
diff --git a/stdlib/fin.quox b/stdlib/fin.quox
deleted file mode 100644
index 2491c90..0000000
--- a/stdlib/fin.quox
+++ /dev/null
@@ -1,259 +0,0 @@
-load "nat.quox"
-load "either.quox"
-load "maybe.quox"
-load "sub.quox"
-
-
-namespace nat.lt {
-
-def0 LT : ℕ → ℕ → ★ =
-  elim-pair¹ (λ _ _ ⇒ ★)
-    False             -- 0      ≮ 0
-    (λ   n p ⇒ True)  -- 0      < succ n
-    (λ m   p ⇒ False) -- succ m ≮ 0
-    (λ m n p ⇒ p)     -- succ m < succ n ⇔ m < n
-
-
-def0 irr : sub.Irr2 ℕ ℕ LT =
-  elim-pair (λ m n ⇒ (p q : LT m n) → p ≡ q : LT m n)
-    false.irr (λ _ _ ⇒ true.irr) (λ _ _ ⇒ false.irr) (λ _ _ p ⇒ p)
-
-
--- [todo] quantities (which will need to inline and adapt elim-pair)
-def elimω : 0.(P : (m n : ℕ) → LT m n → ★) →
-            ω.(0.(n : ℕ) → P 0 (succ n) 'true) →
-            ω.(0.(m n : ℕ) → 0.(lt : LT m n) →
-               ω.(P m n lt) → P (succ m) (succ n) lt) →
-            ω.(m n : ℕ) → 0.(lt : LT m n) → P m n lt =
-  λ P p0s pss ⇒
-    elim-pairω (λ m n ⇒ 0.(lt : LT m n) → P m n lt)
-      (λ       ff ⇒ void (P 0 0 ff) ff)
-      (λ   n p tt ⇒ p0s n)
-      (λ m   p ff ⇒ void (P (succ m) 0 ff) ff)
-      (λ m n p tt ⇒ pss m n tt (p tt))
-
-def0 true-ty : (m n : ℕ) → LT m n → LT m n ≡ True : ★ =
-  elim-pair¹ (λ m n ⇒ LT m n → LT m n ≡ True : ★)
-    (λ       ff ⇒ void¹ (False ≡ True : ★) ff)
-    (λ   n p tt ⇒ δ _ ⇒ True)
-    (λ m   p ff ⇒ void¹ (False ≡ True : ★) ff)
-    (λ n m p tf ⇒ p tf)
-
-def0 true-val :
-    (m n : ℕ) → (lt : LT m n) → Eq (𝑖 ⇒ true-ty m n lt @𝑖) lt 'true =
-  let IsTrue : (m n : ℕ) → LT m n → ★ =
-    λ m n lt ⇒ Eq (𝑖 ⇒ true-ty m n lt @𝑖) lt 'true in
-  elim-pair (λ m n ⇒ (lt : LT m n) → IsTrue m n lt)
-    (λ       ff ⇒ void (IsTrue 0 0 ff) ff)
-    (λ   n p tt ⇒ δ _ ⇒ 'true)
-    (λ m   p ff ⇒ void (IsTrue (succ m) 0 ff) ff)
-    (λ n m p tf ⇒ p tf)
-
-def revive : 0.(m n : ℕ) → 0.(LT m n) → LT m n =
-  λ m n lt ⇒ coe (𝑘 ⇒ true-ty m n lt @𝑘) @1 @0 'true
-
-
-def drop : 0.(A : ★) → 0.(m n : ℕ) → LT m n → A → A =
-  λ A m n lt x ⇒ true.drop A (coe (𝑖 ⇒ true-ty m n lt @𝑖) lt) x
-
-def0 succ-both : (m n : ℕ) → LT m n → LT (succ m) (succ n) =
-  λ m n p ⇒ p
-
-def0 succ-right : (m n : ℕ) → LT m n → LT m (succ n) =
-  λ m n lt ⇒
-    elimω (λ m n _ ⇒ LT m (succ n))
-      (λ _        ⇒ 'true)
-      (λ _ _ _ ih ⇒ ih)
-      m n lt
-
-def0 right-is-succ : (m n : ℕ) → LT m n → IsSucc n =
-  λ m n lt ⇒
-    elimω (λ _ n _ ⇒ IsSucc n) (λ _ ⇒ 'true) (λ _ _ _ _ ⇒ 'true) m n lt
-
-def right-has-succ : 0.(m : ℕ) → (n : ℕ) → 0.(LT m n) → HasSucc n =
-  λ m n lt ⇒
-    case n return n' ⇒ 0.(LT m n') → HasSucc n' of {
-      0      ⇒ λ lt ⇒ void (HasSucc 0) (right-is-succ m 0 lt);
-      succ n ⇒ λ _  ⇒ (n, [δ _ ⇒ succ n])
-    } lt
-
-def0 right-not-zero : (m : ℕ) → Not (LT m 0) =
-  λ m ⇒ case m return m' ⇒ Not (LT m' 0) of { 0 ⇒ λ v ⇒ v; succ _ ⇒ λ v ⇒ v }
-
-def0 plus-right : (m n₀ n₁ : ℕ) → LT m n₀ → LT m (plus n₀ n₁) =
-  λ m n₀ n₁ lt ⇒
-    elimω (λ m n _ ⇒ LT m (plus n n₁)) (λ _ ⇒ 'true) (λ _ _ _ ih ⇒ ih) m n₀ lt
-
-#[compile-scheme "(lambda% (m n) (if (< m n) dec.Yes dec.No))"]
-def lt? : ω.(m n : ℕ) → Dec (LT m n) =
-  elim-pairω (λ m n ⇒ Dec (LT m n))
-    (No (LT 0 0) (λ v ⇒ v))
-    (λ n p ⇒ Yes (LT 0 (succ n)) 'true)
-    (λ m p ⇒ No  (LT (succ m) 0) (λ v ⇒ v))
-    (λ m n p ⇒
-      dec.elim (LT m n) (λ _ ⇒ Dec (LT (succ m) (succ n)))
-        (λ yes ⇒ Yes (LT (succ m) (succ n)) yes)
-        (λ no  ⇒ No  (LT (succ m) (succ n)) no) p)
-
-
-def0 irrefl : (m n : ℕ) → LT m n → Not (m ≡ n : ℕ) =
-  λ m n lt ⇒
-    elimω (λ m n _ ⇒ Not (m ≡ n : ℕ))
-      (λ n eq ⇒ zero-not-succ n eq)
-      (λ m n _ ih eq ⇒ ih (succ-inj m n eq))
-      m n lt
-
-def0 asym : (m n : ℕ) → LT m n → Not (LT n m) =
-  λ m n lt ⇒
-    elimω (λ m n _ ⇒ Not (LT n m)) (λ _ ff ⇒ ff) (λ _ _ _ ih ff ⇒ ih ff) m n lt
-
-def0 trans : (n₀ n₁ n₂ : ℕ) → LT n₀ n₁ → LT n₁ n₂ → LT n₀ n₂ =
-  λ n₀ n₁ n₂ lt₀₁ lt₁₂ ⇒
-  elimω (λ n₀ n₁ lt₀₁ ⇒ (n₂ : ℕ) → (lt₁₂ : LT n₁ n₂) → LT n₀ n₂)
-    (λ n₁ n₂ ⇒
-      case n₂ return n₂' ⇒ LT (succ n₁) n₂' → LT 0 n₂' of {
-        0      ⇒ λ v ⇒ v;
-        succ _ ⇒ λ _ ⇒ 'true
-      })
-    (λ n₀ n₁ lt₀₁ ih n₂ ⇒
-      case n₂ return n₂' ⇒ LT (succ n₁) n₂' → LT (succ n₀) n₂' of {
-        0       ⇒ λ v    ⇒ v;
-        succ n₂ ⇒ λ lt₁₂ ⇒ ih n₂ lt₁₂
-      })
-    n₀ n₁ lt₀₁ n₂ lt₁₂
-
-}
-
-namespace nat {
-def0 LT  = lt.LT
-def  lt? = lt.lt?
-}
-
-
-namespace fin {
-
-def0 Bounded : ℕ → ℕ → ★ = λ n i ⇒ nat.LT i n
-
-def0 Fin : ℕ → ★ = λ n ⇒ Sub ℕ (Bounded n)
-
-def fin : 0.(n : ℕ) → (i : ℕ) → 0.(Bounded n i) → Fin n =
-  λ n ⇒ sub.sub ℕ (Bounded n)
-
-def val : 0.(n : ℕ) → Fin n → ℕ =
-  λ n ⇒ sub.val ℕ (Bounded n)
-
-def0 val-eq : (n : ℕ) → (i j : Fin n) → val n i ≡ val n j : ℕ → i ≡ j : Fin n =
-  λ n ⇒ sub.sub-eq ℕ (Bounded n) (λ i ⇒ nat.lt.irr i n)
-
-def0 proof : (n : ℕ) → (i : Fin n) → nat.LT (val n i) n =
-  λ n ⇒ sub.proof ℕ (Bounded n)
-
-
-def0 no-fin0 : Not (Fin 0) =
-  λ f0 ⇒ case f0 return False of { (i, lt) ⇒
-    nat.lt.right-not-zero i (get0 (nat.LT i 0) lt)
-  }
-
-
-def fin? : ω.(n i : ℕ) → Maybe (Fin n) =
-  λ n ⇒ sub.sub? ℕ (Bounded n) (λ i ⇒ nat.lt? i n)
-
-def F0 : 0.(n : ℕ) → Fin (succ n) =
-  λ n ⇒ fin (succ n) 0 'true
-def FS : 0.(n : ℕ) → Fin n → Fin (succ n) =
-  λ n i ⇒ fin (succ n) (succ (val n i)) (proof n i)
-
-def weak : 0.(m n : ℕ) → 0.(nat.LT m n) → Fin m → Fin n =
-  λ m n mn i' ⇒
-    let i = val m i'; 0.im = proof m i' in
-    fin n i (nat.lt.trans i m n im mn)
-
-
-def bound-has-succ : (n : ℕ) → 0.(Fin n) → nat.HasSucc n =
-  λ n i ⇒ nat.lt.right-has-succ (fst i) n (get0 (nat.LT (fst i) n) (snd i))
-
-def elim' :
-    0.(P : (n i : ℕ) → nat.LT i n → ★) →
-    1.(pz : 0.(n : ℕ) → P (succ n) 0 'true) →
-    ω.(ps : 0.(n i : ℕ) → 0.(lt : nat.LT i n) →
-            P n i lt → P (succ n) (succ i) lt) →
-    0.(n : ℕ) → (i : ℕ) → 0.(lt : nat.LT i n) → P n i lt =
-  λ P pz ps n i lt ⇒
-    case i return i' ⇒ 0.(n : ℕ) → 0.(lt : nat.LT i' n) → P n i' lt of {
-      0 ⇒ λ n lt ⇒
-        let0 npp = nat.lt.right-has-succ 0 n lt;
-             p   = nat.has-succ.val n npp;
-             np  = nat.has-succ.proof n npp in
-        coe (𝑘 ⇒ P (np @𝑘) 0 (coe (𝑙 ⇒ nat.LT 0 (np @𝑙)) @0 @𝑘 lt)) @1 @0
-            (pz p);
-      succ i, ih ⇒ λ n lt ⇒
-        let 0.npp = nat.lt.right-has-succ (succ i) n lt;
-            0.p   = nat.has-succ.val n npp;
-            0.np  = nat.has-succ.proof n npp;
-            0.lt' : nat.LT i p = coe (𝑘 ⇒ nat.LT (succ i) (np @𝑘)) lt;
-            0.lteq : Eq (𝑘 ⇒ nat.LT (succ i) (np @𝑘)) lt lt' =
-              δ 𝑘 ⇒ coe (𝑙 ⇒ nat.LT (succ i) (np @𝑙)) @0 @𝑘 lt;
-            1.almost : P (succ p) (succ i) lt' = ps p i lt' (ih p lt') in
-        coe (𝑘 ⇒ P (np @𝑘) (succ i) (lteq @𝑘)) @1 @0 almost;
-    } n lt
-
-def elim : 0.(P : (n : ℕ) → Fin n → ★) →
-           (pz : 0.(n : ℕ) → P (succ n) (F0 n)) →
-           (ps : 0.(n : ℕ) → 0.(i : Fin n) →
-                 P n i → P (succ n) (FS n i)) →
-           0.(n : ℕ) → (i : Fin n) → P n i =
-  λ P pz ps n ilt ⇒
-    case ilt return ilt' ⇒ P n ilt' of { (i, lt) ⇒
-      let0 lt = get0 (nat.LT i n) lt in
-      drop0 (nat.LT i n) (P n (i, [lt])) lt
-      (elim' (λ n i lt ⇒ P n (i, [lt])) pz (λ n i lt ⇒ ps n (i, [lt])) n i lt)
-    }
-
-{-
-def elim : 0.(P : (n : ℕ) → Fin n → ★) →
-           (pz : 0.(n : ℕ) → P (succ n) (F0 n)) →
-           (ps : 0.(n : ℕ) → 0.(i : Fin n) →
-                 P n i → P (succ n) (FS n i)) →
-           0.(n : ℕ) → (i : Fin n) → P n i =
-  λ P pz ps n ilt ⇒
-    let i = val n ilt; 0.lt : nat.LT i n = proof n ilt;
-        0.pp = nat.lt.right-has-succ i n lt;
-        0.p  = nat.has-succ.val n pp; 0.np = nat.has-succ.proof n pp;
-        0.RES : ℕ → ℕ → ★ =
-          λ i n ⇒ (lt : nat.LT i n) × P n (i, [lt]);
-        res : RES i (succ p) =
-          case i
-          return i' ⇒ 0.(p : ℕ) → 0.(nat.LT i' (succ p)) → RES i' (succ p)
-          of {
-            0 ⇒ λ p _ ⇒ ('true, pz p);
-            succ i, IH ⇒ λ p lt ⇒
-              let 0.qq = nat.lt.right-has-succ i p lt;
-                  0.q  = nat.has-succ.val p qq; 0.pq = nat.has-succ.proof p qq;
-                  0.lt : nat.LT i (succ q) = coe (𝑘 ⇒ nat.LT i (pq @𝑘)) lt;
-              in
-              case IH q lt return RES (succ i) (succ p) of { (lt', ih') ⇒
-                let lt : nat.LT (succ i) (succ p) =
-                      coe (𝑘 ⇒ nat.LT i (pq @𝑘)) @1 @0 lt';
-                    ih : P p (i, [lt]) =
-                      coe (𝑘 ⇒ P (pq @𝑘) (i, [coe (𝑙 ⇒ nat.LT i (pq @𝑙)) @1 @𝑘 lt']))
-                          @1 @0 ih';
-                    res : P (succ p) (succ i, [lt]) =
-                      ps p (i, [lt]) ih;
-                in
-                (lt, res)
-              }
-          } p (coe (𝑘 ⇒ nat.LT i (np @𝑘)) lt);
-    in
-    case coe (𝑘 ⇒ RES i (np @𝑘)) @1 @0 res
-    return P n ilt
-    of { (lt', res) ⇒
-      nat.lt.drop (P n ilt) i n lt' res
-    }
--}
-
-}
-
-
-def0 Fin = fin.Fin
-def  F0  = fin.F0
-def  FS  = fin.FS
diff --git a/stdlib/int.quox b/stdlib/int.quox
deleted file mode 100644
index 3ca1478..0000000
--- a/stdlib/int.quox
+++ /dev/null
@@ -1,149 +0,0 @@
-load "nat.quox"
-
-namespace int {
-
-def0 Sign : ★ = {pos, neg-succ}
-def0 ℤ : ★ = Sign × ℕ
-
-def from-ℕ : ℕ → ℤ = λ n ⇒ ('pos, n)
-
-def neg-ℕ : ℕ → ℤ =
-  λ n ⇒ case n return ℤ of { 0 ⇒ ('pos, 0); succ n ⇒ ('neg-succ, n) }
-
-def zeroℤ : ℤ = ('pos, 0)
-
-
-def match : 0.(A : ★) → ω.(pos neg : ℕ → A) → ℤ → A =
-  λ A pos neg x ⇒
-    case x return A of { (s, x) ⇒
-      case s return A of { 'pos ⇒ pos x; 'neg-succ ⇒ neg x }
-    }
-
-def negate : ℤ → ℤ =
-  match ℤ neg-ℕ (λ x ⇒ from-ℕ (succ x))
-
-def minus-ℕ-ℕ : ℕ → ℕ → ℤ =
-  λ m n ⇒
-    letω f : ω.ℕ → ω.ℕ → ℤ = λ m n ⇒
-      bool.if ℤ (nat.ge m n) (from-ℕ (nat.minus m n))
-                             (neg-ℕ (nat.minus n m)) in
-    getω ℤ (app2ω ℕ ℕ ℤ f (nat.dup m) (nat.dup n))
-
-def plus-ℕ : ℤ → ℕ → ℤ =
-  match (ℕ → ℤ) (λ x n ⇒ from-ℕ (nat.plus x n))
-                (λ x n ⇒ minus-ℕ-ℕ n (succ x))
-
-def minus-ℕ : ℤ → ℕ → ℤ =
-  match (ℕ → ℤ) minus-ℕ-ℕ (λ x n ⇒ ('neg-succ, nat.plus x n))
-
-
-def plus : ℤ → ℤ → ℤ =
-  match (ℤ → ℤ) (λ x y ⇒ plus-ℕ y x) (λ x y ⇒ minus-ℕ y (succ x))
-
-def minus : ℤ → ℤ → ℤ = λ x y ⇒ plus x (negate y)
-
-
-def dup-sign : Sign → [ω. Sign] =
-  λ s ⇒ case s return [ω. Sign] of {
-    'pos      ⇒ ['pos];
-    'neg-succ ⇒ ['neg-succ]
-  }
-
-def0 dup-sign-ok : (s : Sign) → dup-sign s ≡ [s] : [ω. Sign] =
-  λ s ⇒ case s return s' ⇒ dup-sign s' ≡ [s'] : [ω. Sign] of {
-    'pos      ⇒ δ 𝑖 ⇒ ['pos];
-    'neg-succ ⇒ δ 𝑖 ⇒ ['neg-succ]
-  }
-
-def dup : ℤ → [ω.ℤ] =
-  λ x ⇒ case x return [ω.ℤ] of { (s, n) ⇒
-    app2ω Sign ℕ ℤ (λ s n ⇒ (s, n)) (dup-sign s) (nat.dup n)
-  }
-
-def0 dup-ok : (x : ℤ) → dup x ≡ [x] : [ω.ℤ] =
-  λ x ⇒
-  case x return x' ⇒ dup x' ≡ [x'] : [ω.ℤ] of { (s, n) ⇒ δ 𝑖 ⇒
-    app2ω Sign ℕ ℤ (λ s n ⇒ (s, n)) (dup-sign-ok s @𝑖) (nat.dup-ok n @𝑖)
-  }
-
-
-def times-ℕ : ℤ → ℕ → ℤ =
-  match (ℕ → ℤ)
-    (λ m  n ⇒ from-ℕ (nat.times m n))
-    (λ m' n ⇒ neg-ℕ (nat.times (succ m') n))
-
-def times : ℤ → ℤ → ℤ =
-  match (ℤ → ℤ) (λ p x ⇒ times-ℕ x p) (λ n x ⇒ negate (times-ℕ x (succ n)))
-
-
-def abs : ℤ → ℕ = match ℕ (λ p ⇒ p) (λ n ⇒ succ n)
-
-
-def pair-eq? : 0.(A B : ★) → ω.(DecEq A) → ω.(DecEq B) → DecEq (A × B) =
-  λ A B eqA? eqB? x y ⇒
-    let0 Ret : ★ = x ≡ y : (A × B) in
-    letω a0 = fst x; a1 = fst y;
-         b0 = snd x; b1 = snd y in
-    dec.elim (a0 ≡ a1 : A) (λ _ ⇒ Dec Ret)
-      (λ ya ⇒
-        dec.elim (b0 ≡ b1 : B) (λ _ ⇒ Dec Ret)
-          (λ yb ⇒ Yes Ret (δ 𝑖 ⇒ (ya @𝑖, yb @𝑖)))
-          (λ nb ⇒ No  Ret (λ eq ⇒ nb (δ 𝑖 ⇒ snd (eq @𝑖))))
-          (eqB? b0 b1))
-      (λ na ⇒ No Ret (λ eq ⇒ na (δ 𝑖 ⇒ fst (eq @𝑖))))
-      (eqA? a0 a1)
-
-
-def sign-eq? : DecEq Sign =
-  λ x y ⇒
-    let0 disc : Sign → ★ =
-      λ s ⇒ case s return ★ of { 'pos ⇒ True; 'neg-succ ⇒ False } in
-  case x return x' ⇒ Dec (x' ≡ y : Sign) of {
-    'pos ⇒
-      case y return y' ⇒ Dec ('pos ≡ y' : Sign) of {
-        'pos ⇒ dec.yes-refl Sign 'pos;
-        'neg-succ ⇒
-          No ('pos ≡ 'neg-succ : Sign)
-             (λ eq ⇒ coe (𝑖 ⇒ disc (eq @𝑖)) 'true)
-      };
-    'neg-succ ⇒
-      case y return y' ⇒ Dec ('neg-succ ≡ y' : Sign) of {
-        'neg-succ ⇒ dec.yes-refl Sign 'neg-succ;
-        'pos ⇒
-          No ('neg-succ ≡ 'pos : Sign)
-             (λ eq ⇒ coe (𝑖 ⇒ disc (eq @𝑖)) @1 @0 'true)
-      }
-  }
-
-#[compile-scheme "(lambda% (x y) (if (equal? x y) Yes No))"]
-def eq? : DecEq ℤ = pair-eq? Sign ℕ sign-eq? nat.eq?
-
-def eq : ω.ℤ → ω.ℤ → Bool =
-  λ x y ⇒ dec.bool (x ≡ y : ℤ) (eq? x y)
-
-}
-
-def0 ℤ = int.ℤ
-
-
-namespace scheme-int {
-  postulate0 Int : ★
-
-  #[compile-scheme "(lambda (x) x)"]
-  postulate from-ℕ : ℕ → Int
-
-  #[compile-scheme "(lambda% (x y) (+ x y))"]
-  postulate plus : Int → Int → Int
-
-  #[compile-scheme "(lambda% (x y) (- x y))"]
-  postulate minus : Int → Int → Int
-
-  #[compile-scheme "(lambda% (x y) (* x y))"]
-  postulate times : Int → Int → Int
-
-  #[compile-scheme "(lambda% (x y) (if (= x y) 'true 'false))"]
-  postulate eq : Int → Int → Bool
-
-  #[compile-scheme "abs"]
-  postulate abs : Int → ℕ
-}
diff --git a/stdlib/io.quox b/stdlib/io.quox
deleted file mode 100644
index 36ebe69..0000000
--- a/stdlib/io.quox
+++ /dev/null
@@ -1,100 +0,0 @@
-load "misc.quox"
-load "maybe.quox"
-load "list.quox"
-
-namespace io {
-
-def0 IORes : ★ → ★ = λ A ⇒ A × IOState
-
-def0 IO : ★ → ★ = λ A ⇒ IOState → IORes A
-
-def pure : 0.(A : ★) → A → IO A = λ A x s ⇒ (x, s)
-
-def bind : 0.(A B : ★) → IO A → (A → IO B) → IO B =
-  λ A B m k s0 ⇒
-  case m s0 return IORes B of { (x, s1) ⇒ k x s1 }
-
-def bindω : 0.(A B : ★) → IO [ω.A] → (ω.A → IO B) → IO B =
-  λ A B m k s0 ⇒
-  case m s0 return IORes B of { (x, s1) ⇒
-    case x return IORes B of { [x] ⇒ k x s1 }
-  }
-
-def map : 0.(A B : ★) → (A → B) → IO A → IO B =
-  λ A B f m ⇒ bind A B m (λ x ⇒ pure B (f x))
-
-def mapω : 0.(A B : ★) → (ω.A → B) → IO [ω.A] → IO B =
-  λ A B f m ⇒ bindω A B m (λ x ⇒ pure B (f x))
-
-def seq : 0.(B : ★) → IO True → IO B → IO B =
-  λ B x y ⇒ bind True B x (λ u ⇒ case u return IO B of { 'true ⇒ y })
-
-def seq' : IO True → IO True → IO True = seq True
-
-def pass : IO True = pure True 'true
-
-#[compile-scheme "(lambda (str) (builtin-io (display str) 'true))"]
-postulate print : String → IO True
-
-#[compile-scheme "(lambda (str) (builtin-io (write str) (newline) 'true))"]
-postulate dump : 0.(A : ★) → A → IO True
-
-def newline = print "\n"
-
-def println : String → IO True =
-  λ str ⇒ seq' (print str) newline
-
-#[compile-scheme "(builtin-io (get-line (current-input-port)))"]
-postulate readln : IO String
-
-
--- [todo] errors lmao
-
-{-
-postulate0 File : ★
-
-#[compile-scheme "(lambda (path) (builtin-io (open-input-file path)))"]
-postulate open-read : String → IO File
-
-#[compile-scheme "(lambda (file) (builtin-io (close-port file) 'true))"]
-postulate close : File → IO True
-
-#[compile-scheme
- "(lambda% (file if-eof if-line)
-    (builtin-io
-      (let ([result (get-line file)])
-        (if (eof-object? result)
-            (cons if-eof file)
-            (cons (if-line result) file)))))"]
-postulate prim-read-line :
-  File →
-  ω.(if-eof  : Maybe [ω.String]) →
-  ω.(if-line : ω.String → Maybe [ω.String]) →
-  IO (Maybe [ω.String] × File)
-
-def read-line : File → IO (Maybe [ω.String] × File) =
-  λ f ⇒ prim-read-line f (Nothing [ω.String]) (λ x ⇒ Just [ω.String] [x])
--}
-
-
-#[compile-scheme
- "(lambda (path) (builtin-io (call-with-input-file path get-string-all)))"]
-postulate read-fileω : ω.(path : String) → IO [ω.String]
-
-def read-file : ω.(path : String) → IO String =
-  λ path ⇒
-    map [ω.String] String (getω String) (read-fileω path)
-
-
-#[compile-scheme
-  "(lambda (path) (builtin-io
-    (call-with-input-file path
-      (lambda (file)
-        (do [(line (get-line file) (get-line file))
-             (acc  '()             (cons line acc))]
-          [(eof-object? line) (reverse acc)])))))"]
-postulate read-file-lines : ω.(path : String) → IO (List String)
-
-}
-
-def0 IO = io.IO
diff --git a/stdlib/irrel.quox b/stdlib/irrel.quox
deleted file mode 100644
index 87537a4..0000000
--- a/stdlib/irrel.quox
+++ /dev/null
@@ -1,43 +0,0 @@
-load "misc.quox"
-
-def0 Irr1 : (A : ★) → (A → ★) → ★ =
-  λ A P ⇒ (x : A) → (p q : P x) → p ≡ q : P x
-
-def0 Sub : (A : ★) → (P : A → ★) → ★ =
-  λ A P ⇒ (x : A) × [0. P x]
-
-def0 SubDup : (A : ★) → (P : A → ★) → Sub A P → ★ =
-  λ A P s ⇒ Dup A (fst s)
-    -- (x! : [ω.A]) × [0. x! ≡ [fst s] : [ω.A]]
-
-def subdup-to-dup :
-    0.(A : ★) → 0.(P : A → ★) → 0.(Irr1 A P) →
-    0.(s : Sub A P) → SubDup A P s → Dup (Sub A P) s =
-  λ A P pirr s sd ⇒
-    case sd return Dup (Sub A P) s of { (sω, ss0) ⇒
-    case ss0 return Dup (Sub A P) s of { [ss0] ⇒
-      case sω
-      return sω' ⇒ 0.(sω' ≡ [fst s] : [ω.A]) → Dup (Sub A P) s
-      of { [s!] ⇒ λ ss' ⇒
-        let ω.p  : [0.P (fst s)] = revive0 (P (fst s)) (snd s);
-            0.ss : s! ≡ fst s : A = boxω-inj A s! (fst s) ss' in
-        ([(s!, coe (𝑖 ⇒ [0.P (ss @𝑖)]) @1 @0 p)],
-         [δ 𝑗 ⇒ [(ss @𝑗, coe (𝑖 ⇒ [0.P (ss @𝑖)]) @1 @𝑗 p)]])
-      } ss0
-    }}
-
-def subdup : 0.(A : ★) → 0.(P : A → ★) → 0.(Irr1 A P) →
-             ((x : A) → Dup A x) →
-             (s : Sub A P) → SubDup A P s =
-  λ A P pirr dup s ⇒
-    case s return s' ⇒ SubDup A P s' of { (x, p) ⇒
-      drop0 (P x) (Dup A x) p (dup x)
-    }
-
-def dup : 0.(A : ★) → 0.(P : A → ★) → 0.(Irr1 A P) →
-          ((x : A) → Dup A x) →
-          (s : Sub A P) → Dup (Sub A P) s =
-  λ A P pirr dup s ⇒ subdup-to-dup A P pirr s (subdup A P pirr dup s)
-
-def forget : 0.(A : ★) → 0.(P : A → ★) → Sub A P → A =
-  λ A P s ⇒ case s return A of { (x, p) ⇒ drop0 (P x) A p x }
diff --git a/stdlib/list.quox b/stdlib/list.quox
deleted file mode 100644
index feaa0a7..0000000
--- a/stdlib/list.quox
+++ /dev/null
@@ -1,595 +0,0 @@
-load "misc.quox"
-load "nat.quox"
-load "maybe.quox"
-load "bool.quox"
-load "qty.quox"
-
-namespace vec {
-
-def0 Vec : ℕ → ★ → ★ =
-  λ n A ⇒
-  caseω n return ★ of {
-    zero           ⇒ {nil};
-    succ _, 0.Tail ⇒ A × Tail
-  }
-
-def drop-nil-dep : 0.(A : ★) → 0.(P : Vec 0 A → ★) →
-                   (xs : Vec 0 A) → P 'nil → P xs =
-  λ A P xs p ⇒ case xs return xs' ⇒ P xs' of { 'nil ⇒ p }
-
-def drop-nil : 0.(A B : ★) → Vec 0 A → B → B =
-  λ A B ⇒ drop-nil-dep A (λ _ ⇒ B)
-
-def match-dep :
-    0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
-    ω.(P 0 'nil) →
-    ω.((n : ℕ) → (x : A) → (xs : Vec n A) → P (succ n) (x, xs)) →
-    (n : ℕ) → (xs : Vec n A) → P n xs =
-  λ A P pn pc n ⇒
-    case n return n' ⇒ (xs : Vec n' A) → P n' xs of {
-      0 ⇒ λ nil ⇒ drop-nil-dep A (P 0) nil pn;
-      succ len ⇒ λ cons ⇒
-        case cons return cons' ⇒ P (succ len) cons' of {
-          (first, rest) ⇒ pc len first rest
-        }
-    }
-
-def match-depω :
-    0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
-    ω.(P 0 'nil) →
-    ω.(ω.(n : ℕ) → ω.(x : A) → ω.(xs : Vec n A) → P (succ n) (x, xs)) →
-    ω.(n : ℕ) → ω.(xs : Vec n A) → P n xs =
-  λ A P pn pc n ⇒
-    caseω n return n' ⇒ ω.(xs : Vec n' A) → P n' xs of {
-      0 ⇒ λ nil ⇒ drop-nil-dep A (P 0) nil pn;
-      succ len ⇒ λ cons ⇒
-        caseω cons return cons' ⇒ P (succ len) cons' of {
-          (first, rest) ⇒ pc len first rest
-        }
-    }
-def match-dep# = match-depω
-
-def elim : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
-           P 0 'nil →
-           ω.((x : A) → 0.(n : ℕ) → 0.(xs : Vec n A) →
-              P n xs → P (succ n) (x, xs)) →
-           (n : ℕ) → (xs : Vec n A) → P n xs =
-  λ A P pn pc n ⇒
-    case n return n' ⇒ (xs' : Vec n' A) → P n' xs' of {
-      zero ⇒ λ nil ⇒
-        case nil return nil' ⇒ P 0 nil' of { 'nil ⇒ pn };
-      succ n, IH ⇒ λ cons ⇒
-        case cons return cons' ⇒ P (succ n) cons' of {
-          (first, rest) ⇒ pc first n rest (IH rest)
-        }
-    }
-
-def elim2 : 0.(A B : ★) → 0.(P : (n : ℕ) → Vec n A → Vec n B → ★) →
-            P 0 'nil 'nil →
-            ω.((x : A) → (y : B) → 0.(n : ℕ) →
-               0.(xs : Vec n A) → 0.(ys : Vec n B) →
-               P n xs ys → P (succ n) (x, xs) (y, ys)) →
-            (n : ℕ) → (xs : Vec n A) → (ys : Vec n B) → P n xs ys =
-  λ A B P pn pc n ⇒
-    case n return n' ⇒ (xs : Vec n' A) → (ys : Vec n' B) → P n' xs ys of {
-      zero ⇒ λ nila nilb ⇒
-        drop-nil-dep A (λ n ⇒ P 0 n nilb) nila
-          (drop-nil-dep B (λ n ⇒ P 0 'nil n) nilb pn);
-      succ n, IH ⇒ λ consa consb ⇒
-        case consa return consa' ⇒ P (succ n) consa' consb of { (a, as) ⇒
-          case consb return consb' ⇒ P (succ n) (a, as) consb' of { (b, bs) ⇒
-            pc a b n as bs (IH as bs)
-          }
-        }
-    }
-
-def elim2-uneven :
-    0.(A B : ★) → 0.(P : (m n : ℕ) → Vec m A → Vec n B → ★) →
-    -- both nil
-    ω.(P 0 0 'nil 'nil) →
-    -- first nil
-    ω.((y : B) → 0.(n : ℕ) → 0.(ys : Vec n B) →
-       P 0 n 'nil ys → P 0 (succ n) 'nil (y, ys)) →
-    -- second nil
-    ω.((x : A) → 0.(m : ℕ) → 0.(xs : Vec m A) →
-       P m 0 xs 'nil → P (succ m) 0 (x, xs) 'nil) →
-    -- both cons
-    ω.((x : A) → (y : B) → 0.(m n : ℕ) →
-       0.(xs : Vec m A) → 0.(ys : Vec n B) →
-       P m n xs ys → P (succ m) (succ n) (x, xs) (y, ys)) →
-    (m n : ℕ) → (xs : Vec m A) → (ys : Vec n B) → P m n xs ys =
-  λ A B P pnn pnc pcn pcc ⇒
-    nat.elim-pair (λ m n ⇒ (xs : Vec m A) → (ys : Vec n B) → P m n xs ys)
-      (λ xnil ynil ⇒
-        let0 Ret = P 0 0 'nil 'nil in
-        drop-nil A Ret xnil (drop-nil B Ret ynil pnn))
-      (λ n IH xnil yys ⇒
-        case yys return yys' ⇒ P 0 (succ n) 'nil yys' of { (y, ys) ⇒
-          pnc y n ys (IH xnil ys)
-        })
-      (λ m IH xxs ynil ⇒
-        case xxs return xxs' ⇒ P (succ m) 0 xxs' 'nil of { (x, xs) ⇒
-          pcn x m xs (IH xs ynil)
-        })
-      (λ m n IH xxs yys ⇒
-        case xxs return xxs' ⇒ P (succ m) (succ n) xxs'    yys  of { (x, xs) ⇒
-        case yys return yys' ⇒ P (succ m) (succ n) (x, xs) yys' of { (y, ys) ⇒
-          pcc x y m n xs ys (IH xs ys)
-        }})
-
--- haha gross
-def elimω : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
-            ω.(P 0 'nil) →
-            ω.(ω.(x : A) → ω.(n : ℕ) → ω.(xs : Vec n A) →
-               ω.(P n xs) → P (succ n) (x, xs)) →
-            ω.(n : ℕ) → ω.(xs : Vec n A) → P n xs =
-  λ A P pn pc n ⇒
-    caseω n return n' ⇒ ω.(xs' : Vec n' A) → P n' xs' of {
-      zero         ⇒ λ _ ⇒ pn;
-      succ n, ω.IH ⇒ λ xxs ⇒
-        letω x = fst xxs; xs = snd xxs in pc x n xs (IH xs)
-    }
-
-def elimω2 : 0.(A B : ★) → 0.(P : (n : ℕ) → Vec n A → Vec n B → ★) →
-             ω.(P 0 'nil 'nil) →
-             ω.(ω.(x : A) → ω.(y : B) → ω.(n : ℕ) →
-                ω.(xs : Vec n A) → ω.(ys : Vec n B) →
-                ω.(P n xs ys) → P (succ n) (x, xs) (y, ys)) →
-             ω.(n : ℕ) → ω.(xs : Vec n A) → ω.(ys : Vec n B) → P n xs ys =
-  λ A B P pn pc n ⇒
-    caseω n return n' ⇒ ω.(xs : Vec n' A) → ω.(ys : Vec n' B) → P n' xs ys of {
-      zero         ⇒ λ _ _ ⇒ pn;
-      succ n, ω.IH ⇒ λ xxs yys ⇒
-        letω x = fst xxs; xs = snd xxs; y = fst yys; ys = snd yys in
-        pc x y n xs ys (IH xs ys)
-    }
-
-{-
-postulate elimP :
-    ω.(π : NzQty) → ω.(ρₙ ρₗ : Qty) →
-    0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
-    FunNz π (P 0 'nil)
-    (Fun 'any
-        (FUN-NZ π A (λ x ⇒ FUN ρₙ ℕ (λ n ⇒ FUN ρₗ (Vec n A) (λ xs ⇒
-            FunNz π (P n xs) (P (succ n) (x, xs))))))
-    (FUN-NZ π ℕ (λ n ⇒ FUN-NZ π (Vec n A) (λ xs ⇒ P n xs))))
-{-
-  =
-  λ π ρₙ ρₗ A P ⇒ uhhhhhhhhhhhhhhhhhhh
--}
--}
-
-def elimω2-uneven :
-    0.(A B : ★) → 0.(P : (m n : ℕ) → Vec m A → Vec n B → ★) →
-    -- both nil
-    ω.(P 0 0 'nil 'nil) →
-    -- first nil
-    ω.(ω.(y : B) → ω.(n : ℕ) → ω.(ys : Vec n B) →
-       ω.(P 0 n 'nil ys) → P 0 (succ n) 'nil (y, ys)) →
-    -- second nil
-    ω.(ω.(x : A) → ω.(m : ℕ) → ω.(xs : Vec m A) →
-       ω.(P m 0 xs 'nil) → P (succ m) 0 (x, xs) 'nil) →
-    -- both cons
-    ω.(ω.(x : A) → ω.(y : B) → ω.(m n : ℕ) →
-       ω.(xs : Vec m A) → ω.(ys : Vec n B) →
-       ω.(P m n xs ys) → P (succ m) (succ n) (x, xs) (y, ys)) →
-    ω.(m n : ℕ) → ω.(xs : Vec m A) → ω.(ys : Vec n B) → P m n xs ys =
-  λ A B P pnn pnc pcn pcc ⇒
-    nat.elim-pairω (λ m n ⇒ ω.(xs : Vec m A) → ω.(ys : Vec n B) → P m n xs ys)
-      (λ _ _ ⇒ pnn)
-      (λ n IH xnil yys ⇒
-        letω y = fst yys; ys = snd yys in pnc y n ys (IH xnil ys))
-      (λ m IH xxs ynil ⇒
-        letω x = fst xxs; xs = snd xxs in pcn x m xs (IH xs ynil))
-      (λ m n IH xxs yys ⇒
-        letω x = fst xxs; xs = snd xxs; y = fst yys; ys = snd yys in
-        pcc x y m n xs ys (IH xs ys))
-
-def zip-with : 0.(A B C : ★) → ω.(A → B → C) →
-               (n : ℕ) → Vec n A → Vec n B → Vec n C =
-  λ A B C f ⇒
-    elim2 A B (λ n _ _ ⇒ Vec n C) 'nil (λ a b _ _ _ abs ⇒ (f a b, abs))
-
-def zip-withω : 0.(A B C : ★) → ω.(ω.A → ω.B → C) →
-                ω.(n : ℕ) → ω.(Vec n A) → ω.(Vec n B) → Vec n C =
-  λ A B C f ⇒
-    elimω2 A B (λ n _ _ ⇒ Vec n C) 'nil (λ a b _ _ _ abs ⇒ (f a b, abs))
-
-
-namespace zip-with {
-  def0 Failure : (A B : ★) → (m n : ℕ) → Vec m A → Vec n B → ★ =
-    λ A B m n xs ys ⇒
-    Sing (Vec m A) xs × Sing (Vec n B) ys × [0. Not (m ≡ n : ℕ)]
-
-  def0 Success : (C : ★) → (m n : ℕ) → ★ =
-    λ C m n ⇒ Vec n C × [0. m ≡ n : ℕ]
-
-  def0 Result : (A B C : ★) → (m n : ℕ) → Vec m A → Vec n B → ★ =
-    λ A B C m n xs ys ⇒
-    Either (Failure A B m n xs ys) (Success C m n)
-
-  def zip-with-hetω : 0.(A B C : ★) → ω.(A → B → C) →
-                      ω.(m n : ℕ) → (xs : Vec m A) → (ys : Vec n B) →
-                      Result A B C m n xs ys =
-    λ A B C f m n xs ys ⇒
-      let0 TNo  : Vec m A → Vec n B → ★ = Failure A B m n;
-           TYes : ★ = Success C m n;
-           TRes : Vec m A → Vec n B → ★ = λ xs ys ⇒ Either (TNo xs ys) TYes in
-      dec.elim (m ≡ n : ℕ)
-        (λ _ ⇒ (xs : Vec m A) → (ys : Vec n B) → TRes xs ys)
-        (λ eq xs ys ⇒
-          let zs : Vec n C =
-            zip-with A B C f n (coe (𝑖 ⇒ Vec (eq @𝑖) A) xs) ys in
-          Right (TNo xs ys) TYes (zs, [eq]))
-        (λ neq xs ys ⇒ Left (TNo xs ys) TYes
-          (sing (Vec m A) xs, sing (Vec n B) ys, [neq]))
-        (nat.eq? m n) xs ys
-
-  def zip-with-het : 0.(A B C : ★) → ω.(A → B → C) →
-                     (m n : ℕ) → (xs : Vec m A) → (ys : Vec n B) →
-                     Result A B C m n xs ys =
-    λ A B C f m n ⇒
-      let0 Ret : ℕ → ℕ → ★ =
-             λ m n ⇒ (xs : Vec m A) → (ys : Vec n B) → Result A B C m n xs ys in
-      dup.elim ℕ m (λ m' ⇒ Ret m' n)
-        (λ m ⇒ dup.elim ℕ n (λ n' ⇒ Ret m n')
-          (λ n ⇒ zip-with-hetω A B C f m n) (nat.dup! n))
-        (nat.dup! m)
-}
-def0 ZipWith = zip-with.Result
-def zip-with-het = zip-with.zip-with-het
-def zip-with-hetω = zip-with.zip-with-hetω
-
-def map : 0.(A B : ★) → ω.(A → B) → (n : ℕ) → Vec n A → Vec n B =
-  λ A B f ⇒ elim A (λ n _ ⇒ Vec n B) 'nil (λ x _ _ ys ⇒ (f x, ys))
-
-#[compile-scheme "(lambda% (n xs) xs)"]
-def up : 0.(A : ★) → (n : ℕ) → Vec n A → Vec¹ n A =
-  λ A n ⇒
-    case n return n' ⇒ Vec n' A → Vec¹ n' A of {
-      zero ⇒ λ xs ⇒
-        case xs return Vec¹ 0 A of { 'nil ⇒ 'nil };
-      succ n', f' ⇒ λ xs ⇒
-        case xs return Vec¹ (succ n') A of {
-          (first, rest) ⇒ (first, f' rest)
-        }
-    }
-
-def append : 0.(A : ★) → (m : ℕ) → 0.(n : ℕ) →
-             Vec m A → Vec n A → Vec (nat.plus m n) A =
-  λ A m n xs ys ⇒
-    elim A (λ m _ ⇒ Vec (nat.plus m n) A) ys (λ x _ _ xsys ⇒ (x, xsys)) m xs
-
-}
-
-def0 Vec = vec.Vec
-
-
-namespace list {
-
-def0 List : ★ → ★ =
-  λ A ⇒ (len : ℕ) × Vec len A
-
-def Nil : 0.(A : ★) → List A =
-  λ A ⇒ (0, 'nil)
-
-def Cons : 0.(A : ★) → A → List A → List A =
-  λ A x xs ⇒ case xs return List A of { (len, elems) ⇒ (succ len, x, elems) }
-
-def single : 0.(A : ★) → A → List A =
-  λ A x ⇒ Cons A x (Nil A)
-
-def elim : 0.(A : ★) → 0.(P : List A → ★) →
-           P (Nil A) →
-           ω.((x : A) → 0.(xs : List A) → P xs → P (Cons A x xs)) →
-           (xs : List A) → P xs =
-  λ A P pn pc xs ⇒
-    case xs return xs' ⇒ P xs' of { (len, elems) ⇒
-      vec.elim A (λ n xs ⇒ P (n, xs))
-        pn (λ x n xs IH ⇒ pc x (n, xs) IH)
-        len elems
-    }
-
-def elimω : 0.(A : ★) → 0.(P : List A → ★) →
-            ω.(P (Nil A)) →
-            ω.(ω.(x : A) → ω.(xs : List A) → ω.(P xs) → P (Cons A x xs)) →
-            ω.(xs : List A) → P xs =
-  λ A P pn pc xs ⇒
-    caseω xs return xs' ⇒ P xs' of { (len, elems) ⇒
-      vec.elimω A (λ n xs ⇒ P (n, xs))
-        pn (λ x n xs IH ⇒ pc x (n, xs) IH)
-        len elems
-    }
-
-def elim2 : 0.(A B : ★) → 0.(P : List A → List B → ★) →
-            ω.(P (Nil A) (Nil B)) →
-            ω.((y : B) → 0.(ys : List B) →
-               P (Nil A) ys → P (Nil A) (Cons B y ys)) →
-            ω.((x : A) → 0.(xs : List A) →
-               P xs (Nil B) → P (Cons A x xs) (Nil B)) →
-            ω.((x : A) → 0.(xs : List A) → (y : B) → 0.(ys : List B) →
-               P xs ys → P (Cons A x xs) (Cons B y ys)) →
-            (xs : List A) → (ys : List B) → P xs ys =
-  λ A B P pnn pnc pcn pcc xs ys ⇒
-    case xs return xs' ⇒ P xs'     ys  of { (m, xs) ⇒
-    case ys return ys' ⇒ P (m, xs) ys' of { (n, ys) ⇒
-      vec.elim2-uneven A B (λ m n xs ys ⇒ P (m, xs) (n, ys))
-        pnn
-        (λ y n ys IH ⇒ pnc y (n, ys) IH)
-        (λ x m xs IH ⇒ pcn x (m, xs) IH)
-        (λ x y m n xs ys IH ⇒ pcc x (m, xs) y (n, ys) IH)
-        m n xs ys
-    }}
-
-def elimω2 : 0.(A B : ★) → 0.(P : List A → List B → ★) →
-             ω.(P (Nil A) (Nil B)) →
-             ω.(ω.(y : B) → ω.(ys : List B) →
-                ω.(P (Nil A) ys) → P (Nil A) (Cons B y ys)) →
-             ω.(ω.(x : A) → ω.(xs : List A) →
-                ω.(P xs (Nil B)) → P (Cons A x xs) (Nil B)) →
-             ω.(ω.(x : A) → ω.(xs : List A) → ω.(y : B) → ω.(ys : List B) →
-                ω.(P xs ys) → P (Cons A x xs) (Cons B y ys)) →
-             ω.(xs : List A) → ω.(ys : List B) → P xs ys =
-  λ A B P pnn pnc pcn pcc xs ys ⇒
-    caseω xs return xs' ⇒ P xs'     ys  of { (m, xs) ⇒
-    caseω ys return ys' ⇒ P (m, xs) ys' of { (n, ys) ⇒
-      vec.elimω2-uneven A B (λ m n xs ys ⇒ P (m, xs) (n, ys))
-        pnn
-        (λ y n ys IH ⇒ pnc y (n, ys) IH)
-        (λ x m xs IH ⇒ pcn x (m, xs) IH)
-        (λ x y m n xs ys IH ⇒ pcc x (m, xs) y (n, ys) IH)
-        m n xs ys
-    }}
-
-def as-vec : 0.(A : ★) → 0.(P : List A → ★) → (xs : List A) →
-             (ω.(n : ℕ) → (xs : Vec n A) → P (n, xs)) → P xs =
-  λ A P xs f ⇒
-    case xs return xs' ⇒ P xs' of { (n, xs) ⇒
-      dup.elim ℕ n (λ n' ⇒ (xs : Vec n' A) → P (n', xs)) f (nat.dup! n) xs
-    }
-
-def match-dep :
-    0.(A : ★) → 0.(P : List A → ★) →
-    ω.(P (Nil A)) → ω.((x : A) → (xs : List A) → P (Cons A x xs)) →
-    (xs : List A) → P xs =
-  λ A P pn pc xs ⇒
-    case xs return xs' ⇒ P xs' of {
-      (len, elems) ⇒
-        vec.match-dep A (λ n xs ⇒ P (n, xs)) pn (λ n x xs ⇒ pc x (n, xs))
-          len elems
-    }
-
-def match-depω :
-    0.(A : ★) → 0.(P : List A → ★) →
-    ω.(P (Nil A)) →
-    ω.(ω.(x : A) → ω.(xs : List A) → P (Cons A x xs)) →
-    ω.(xs : List A) → P xs =
-  λ A P pn pc xs ⇒
-    vec.match-depω A (λ n xs ⇒ P (n, xs)) pn (λ n x xs ⇒ pc x (n, xs))
-                   (fst xs) (snd xs)
-def match-dep# = match-depω
-
-def match : 0.(A B : ★) → ω.B → ω.(A → List A → B) → List A → B =
-  λ A B ⇒ match-dep A (λ _ ⇒ B)
-
-def matchω : 0.(A B : ★) → ω.B → ω.(ω.A → ω.(List A) → B) → ω.(List A) → B =
-  λ A B ⇒ match-depω A (λ _ ⇒ B)
-def match# = matchω
-
-
-def up : 0.(A : ★) → List A → List¹ A =
-  λ A xs ⇒
-  case xs return List¹ A of { (len, elems) ⇒
-    dup.elim'¹ ℕ len (λ _ ⇒ List¹ A)
-      (λ len eq ⇒ (len, vec.up A len (coe (𝑖 ⇒ Vec (eq @𝑖) A) @1 @0 elems)))
-      (nat.dup! len)
-  }
-
-def foldr : 0.(A B : ★) → B → ω.(A → B → B) → List A → B =
-  λ A B z f xs ⇒ elim A (λ _ ⇒ B) z (λ x _ y ⇒ f x y) xs
-
-def foldl : 0.(A B : ★) → B → ω.(B → A → B) → List A → B =
-  λ A B z f xs ⇒
-    foldr A (B → B) (λ b ⇒ b) (λ a g b ⇒ g (f b a)) xs z
-
-def map : 0.(A B : ★) → ω.(A → B) → List A → List B =
-  λ A B f ⇒ foldr A (List B) (Nil B) (λ x ys ⇒ Cons B (f x) ys)
-
-
--- ugh
-def foldrω : 0.(A B : ★) → ω.B → ω.(ω.A → ω.B → B) → ω.(List A) → B =
-  λ A B z f xs ⇒ elimω A (λ _ ⇒ B) z (λ x _ y ⇒ f x y) xs
-
-def foldlω : 0.(A B : ★) → ω.B → ω.(ω.B → ω.A → B) → ω.(List A) → B =
-  λ A B z f xs ⇒
-    foldrω A (ω.B → B) (λ b ⇒ b) (λ a g b ⇒ g (f b a)) xs z
-
-def mapω : 0.(A B : ★) → ω.(ω.A → B) → ω.(List A) → List B =
-  λ A B f ⇒ foldrω A (List B) (Nil B) (λ x ys ⇒ Cons B (f x) ys)
-
-
-def0 All : (A : ★) → (P : A → ★) → List A → ★ =
-  λ A P xs ⇒ foldr¹ A ★ True (λ x ps ⇒ P x × ps) (up A xs)
-
-def append : 0.(A : ★) → List A → List A → List A =
-  λ A xs ys ⇒ foldr A (List A) ys (Cons A) xs
-
-def reverse : 0.(A : ★) → List A → List A =
-  λ A ⇒ foldl A (List A) (Nil A) (λ xs x ⇒ Cons A x xs)
-
-
-def find : 0.(A : ★) → ω.(ω.A → Bool) → ω.(List A) → Maybe A =
-  λ A p ⇒
-    foldlω A (Maybe A) (Nothing A) (λ m x ⇒ maybe.or A m (maybe.check A p x))
-
-def cons-first : 0.(A : ★) → ω.A → List (List A) → List (List A) =
-  λ A x ⇒
-    match (List A) (List (List A))
-      (single (List A) (single A x))
-      (λ xs xss ⇒ Cons (List A) (Cons A x xs) xss)
-
-def split : 0.(A : ★) → ω.(ω.A → Bool) → ω.(List A) → List (List A) =
-  λ A p ⇒
-    foldrω A (List (List A))
-      (Nil (List A))
-      (λ x xss ⇒ bool.if (List (List A)) (p x)
-          (Cons (List A) (Nil A) xss)
-          (cons-first A x xss))
-
-def break : 0.(A : ★) → ω.(ω.A → Bool) → ω.(List A) → List A × List A =
-  λ A p xs ⇒
-  let0 Lst = List A; Lst2 = (Lst × Lst) ∷ ★; State = Either Lst Lst2 in
-  letω LeftS = Left Lst Lst2; RightS = Right Lst Lst2 in
-  letω res =
-    foldlω A State
-      (LeftS (Nil A))
-      (λ acc x ⇒
-        either.foldω Lst Lst2 State
-          (λ xs ⇒ bool.if State (p x)
-            (RightS (xs, list.single A x))
-            (LeftS  (Cons A x xs)))
-          (λ xsys ⇒
-            RightS (fst xsys, Cons A x (snd xsys))) acc)
-      xs ∷ State in
-  letω res =
-    either.fold Lst Lst2 Lst2 (λ xs ⇒ (Nil A, xs)) (λ xsys ⇒ xsys) res in
-  (reverse A (fst res), reverse A (snd res))
-
-def uncons : 0.(A : ★) → List A → Maybe (A × List A) =
-  λ A ⇒
-    match A (Maybe (A × List A))
-      (Nothing (A × List A))
-      (λ x xs ⇒ Just (A × List A) (x, xs))
-
-def head : 0.(A : ★) → ω.(List A) → Maybe A =
-  λ A ⇒ matchω A (Maybe A) (Nothing A) (λ x _ ⇒ Just A x)
-
-def tail : 0.(A : ★) → ω.(List A) → Maybe (List A) =
-  λ A ⇒ matchω A (Maybe (List A)) (Nothing (List A)) (λ _ xs ⇒ Just (List A) xs)
-
-def tail-or-nil : 0.(A : ★) → ω.(List A) → List A =
-  λ A ⇒ matchω A (List A) (Nil A) (λ _ xs ⇒ xs)
-
--- slip (xs, [])      = (xs, [])
--- slip (xs, y :: ys) = (y :: xs, ys)
-def slip : 0.(A : ★) → List A × List A → List A × List A =
-  λ A xsys ⇒
-    case xsys return List A × List A of { (xs, ys) ⇒
-      match A (List A → List A × List A)
-        (λ      xs ⇒ (xs, Nil A))
-        (λ y ys xs ⇒ (Cons A y xs, ys))
-        ys xs
-    }
-
-def split-at' : 0.(A : ★) → ℕ → List A → List A × List A =
-  λ A n xs ⇒
-    (case n return List A × List A → List A × List A of {
-      0         ⇒ λ xsys ⇒ xsys;
-      succ _, f ⇒ λ xsys ⇒ f (slip A xsys)
-    }) (Nil A, xs)
-
-def split-at : 0.(A : ★) → ℕ → List A → List A × List A =
-  λ A n xs ⇒
-    case split-at' A n xs return List A × List A of {
-      (xs', ys) ⇒ (reverse A xs', ys)
-    }
-
-def filter : 0.(A : ★) → ω.(ω.A → Bool) → ω.(List A) → List A =
-  λ A p ⇒
-    foldrω A (List A)
-      (Nil A)
-      (λ x xs ⇒ bool.if (List A) (p x) (Cons A x xs) xs)
-
-def length : 0.(A : ★) → ω.(List A) → ℕ =
-  λ A xs ⇒ fst xs
-
-
-namespace zip-with {
-  def0 VFailure = vec.zip-with.Failure
-  def0 VSuccess = vec.zip-with.Success
-
-  def0 Failure : (A B : ★) → List A → List B → ★ =
-    λ A B xs ys ⇒ VFailure A B (fst xs) (fst ys) (snd xs) (snd ys)
-
-  def0 Result : (A B C : ★) → List A → List B → ★ =
-    λ A B C xs ys ⇒ Either (Failure A B xs ys) (List C)
-
-  def zip-with : 0.(A B C : ★) → ω.(A → B → C) →
-                 (xs : List A) → (ys : List B) →
-                 Result A B C xs ys =
-    λ A B C f xs ys ⇒
-    let0 Ret = Result A B C in
-    as-vec A (λ xs' ⇒ Ret xs'     ys)  xs (λ m xs ⇒
-    as-vec B (λ ys' ⇒ Ret (m, xs) ys') ys (λ n ys ⇒
-    let0 Err = Failure A B (m, xs) (n, ys) in
-    either.fold Err (VSuccess C m n) (Ret (m, xs) (n, ys))
-      (λ no ⇒ Left Err (List C) no)
-      (λ yes ⇒ case yes return Ret (m, xs) (n, ys) of { (vec, prf) ⇒
-        Right Err (List C) (drop0 (m ≡ n : ℕ) (List C) prf (n, vec))
-      })
-      (vec.zip-with-hetω A B C f m n xs ys)))
-}
-def0 ZipWith = zip-with.Result
-def zip-with = zip-with.zip-with
-
-def zip-withω : 0.(A B C : ★) → ω.(ω.A → ω.B → C) →
-                ω.(xs : List A) → ω.(ys : List B) →
-                Either [0. Not (fst xs ≡ fst ys : ℕ)] (List C) =
-  λ A B C f xs ys ⇒
-    letω m = fst xs; xs = snd xs;
-         n = fst ys; ys = snd ys in
-    let0 Err : ★ = [0. Not (m ≡ n : ℕ)] in
-    dec.elim (m ≡ n : ℕ) (λ _ ⇒ Either Err (List C))
-      (λ mn ⇒
-        letω xs = coe (𝑖 ⇒ Vec (mn @𝑖) A) xs in
-        Right Err (List C) (n, vec.zip-withω A B C f n xs ys))
-      (λ nmn ⇒ Left Err (List C) [nmn])
-      (nat.eq? m n)
-def zip-with# = zip-withω
-
-
-def zip-with-uneven :
-    0.(A B C : ★) → ω.(ω.A → ω.B → C) → ω.(List A) → ω.(List B) → List C =
-  λ A B C f xs ys ⇒
-    caseω nat.min (fst xs) (fst ys)
-    return ω.(List A) → ω.(List B) → List C of {
-      0             ⇒ λ _ _ ⇒ Nil C;
-      succ _, ω.fih ⇒ λ xs ys ⇒
-        maybe.foldω (A × List A) (List C) (Nil C)
-          (λ xxs ⇒ maybe.foldω (B × List B) (List C) (Nil C)
-            (λ yys ⇒ Cons C (f (fst xxs) (fst yys)) (fih (snd xxs) (snd yys)))
-            (list.uncons B ys))
-          (list.uncons A xs)
-    } xs ys
-
-
-def sum     : List ℕ → ℕ = foldl ℕ ℕ 0 nat.plus
-def product : List ℕ → ℕ = foldl ℕ ℕ 1 nat.times
-
-
-namespace mergesort {
-  def deal : 0.(A : ★) → List A → List A × List A =
-    λ A ⇒
-    let0 One = List A; Pair : ★ = One × One in
-    foldl A Pair (Nil A, Nil A)
-      (pair.uncurry' One One (A → Pair) (λ ys zs x ⇒ (Cons A x zs, ys)))
-
-}
-
-
-postulate0 SchemeList : ★ → ★
-
-#[compile-scheme
-  "(lambda (list) (cons (length list) (fold-right cons 'nil list)))"]
-postulate from-scheme : 0.(A : ★) → SchemeList A → List A
-
-#[compile-scheme
- "(lambda (lst)
-    (do [(lst (cdr lst) (cdr lst))
-         (acc '()       (cons (car lst) acc))]
-      [(equal? lst 'nil) (reverse acc)]))"]
-postulate to-scheme : 0.(A : ★) → List A → SchemeList A
-
-}
-
-def0 List = list.List
diff --git a/stdlib/maybe.quox b/stdlib/maybe.quox
deleted file mode 100644
index 83e96c4..0000000
--- a/stdlib/maybe.quox
+++ /dev/null
@@ -1,146 +0,0 @@
-load "misc.quox"
-load "pair.quox"
-load "either.quox"
-
-namespace maybe {
-
-def0 Tag : ★ = {nothing, just}
-
-def0 Payload : Tag → ★ → ★ =
-  λ tag A ⇒ case tag return ★ of { 'nothing ⇒ True; 'just ⇒ A }
-
-def0 Maybe : ★ → ★ =
-  λ A ⇒ (t : Tag) × Payload t A
-
-def tag : 0.(A : ★) → ω.(Maybe A) → Tag =
-  λ _ x ⇒ caseω x return Tag of { (tag, _) ⇒ tag }
-
-def Nothing : 0.(A : ★) → Maybe A =
-  λ _ ⇒ ('nothing, 'true)
-
-def Just : 0.(A : ★) → A → Maybe A =
-  λ _ x ⇒ ('just, x)
-
-def0 IsJustTag : Tag → ★ =
-  λ t ⇒ case t return ★ of { 'just ⇒ True; 'nothing ⇒ False }
-
-def0 IsJust : (A : ★) → Maybe A → ★ =
-  λ A x ⇒ IsJustTag (tag A x)
-
-def is-just? : 0.(A : ★) → ω.(x : Maybe A) → Dec (IsJust A x) =
-  λ A x ⇒
-  caseω tag A x return t ⇒ Dec (IsJustTag t) of {
-    'just    ⇒ Yes True  'true;
-    'nothing ⇒ No  False (λ x ⇒ x)
-  }
-
-def0 nothing-unique :
-    (A : ★) → (x : True) → ('nothing, x) ≡ Nothing A : Maybe A =
-  λ A x ⇒
-  case x return x' ⇒ ('nothing, x') ≡ Nothing A : Maybe A of {
-    'true ⇒ δ _ ⇒ ('nothing, 'true)
-  }
-
-def elim' :
-    0.(A : ★) →
-    0.(P : (t : Tag) → Payload t A → ★) →
-    ω.(P 'nothing 'true) →
-    ω.((x : A) → P 'just x) →
-    (t : Tag) → (x : Payload t A) → P t x =
-  λ A P nothing just tag ⇒
-  case tag return t ⇒ (x : Payload t A) → P t x of {
-    'nothing ⇒ λ x ⇒ case x return x' ⇒ P 'nothing x' of { 'true ⇒ nothing };
-    'just    ⇒ just
-  }
-
-def elim :
-    0.(A : ★) →
-    0.(P : Maybe A → ★) →
-    ω.(P (Nothing A)) →
-    ω.((x : A) → P (Just A x)) →
-    (x : Maybe A) → P x =
-  λ A P n j x ⇒
-    case x return x' ⇒ P x' of {
-      (tag, payload) ⇒ elim' A (λ x t ⇒ P (x, t)) n j tag payload
-    }
-
-def elimω' :
-    0.(A : ★) →
-    0.(P : (t : Tag) → Payload t A → ★) →
-    ω.(P 'nothing 'true) →
-    ω.(ω.(x : A) → P 'just x) →
-    ω.(t : Tag) → ω.(x : Payload t A) → P t x =
-  λ A P nothing just tag ⇒
-  case tag return t ⇒ ω.(x : Payload t A) → P t x of {
-    'nothing ⇒ λ x ⇒ case x return x' ⇒ P 'nothing x' of { 'true ⇒ nothing };
-    'just    ⇒ just
-  }
-
-def elimω :
-    0.(A : ★) →
-    0.(P : Maybe A → ★) →
-    ω.(P (Nothing A)) →
-    ω.(ω.(x : A) → P (Just A x)) →
-    ω.(x : Maybe A) → P x =
-  λ A P n j x ⇒
-    caseω x return x' ⇒ P x' of {
-      (tag, payload) ⇒ elimω' A (λ x t ⇒ P (x, t)) n j tag payload
-    }
-
-{-
--- direct elim implementation
-def elim :
-    0.(A : ★) →
-    0.(P : Maybe A → ★) →
-    ω.(P (Nothing A)) →
-    ω.((x : A) → P (Just A x)) →
-    (x : Maybe A) → P x =
-  λ A P n j x ⇒
-  case x return x' ⇒ P x' of { (tag, payload) ⇒
-    (case tag
-     return t ⇒
-       0.(eq : tag ≡ t : Tag) → P (t, coe (𝑖 ⇒ Payload (eq @𝑖) A) payload)
-     of {
-       'nothing ⇒
-          λ eq ⇒
-          case coe (𝑖 ⇒ Payload (eq @𝑖) A) payload
-          return p ⇒ P ('nothing, p)
-          of { 'true ⇒ n };
-       'just ⇒ λ eq ⇒ j (coe (𝑖 ⇒ Payload (eq @𝑖) A) payload)
-     }) (δ 𝑖 ⇒ tag)
-  }
--}
-
-def fold : 0.(A B : ★) → ω.B → ω.(A → B) → Maybe A → B =
-  λ A B ⇒ elim A (λ _ ⇒ B)
-
-def foldω : 0.(A B : ★) → ω.B → ω.(ω.A → B) → ω.(Maybe A) → B =
-  λ A B ⇒ elimω A (λ _ ⇒ B)
-
-def join : 0.(A : ★) → (Maybe (Maybe A)) → Maybe A =
-  λ A ⇒ fold (Maybe A) (Maybe A) (Nothing A) (λ x ⇒ x)
-
-def pair : 0.(A B : ★) → ω.(Maybe A) → ω.(Maybe B) → Maybe (A × B) =
-  λ A B x y ⇒
-    foldω A (Maybe (A × B)) (Nothing (A × B))
-      (λ x' ⇒ fold B (Maybe (A × B)) (Nothing (A × B))
-        (λ y' ⇒ Just (A × B) (x', y')) y) x
-
-def map : 0.(A B : ★) → ω.(A → B) → Maybe A → Maybe B =
-  λ A B f ⇒ fold A (Maybe B) (Nothing B) (λ x ⇒ Just B (f x))
-
-def mapω : 0.(A B : ★) → ω.(ω.A → B) → ω.(Maybe A) → Maybe B =
-  λ A B f ⇒ foldω A (Maybe B) (Nothing B) (λ x ⇒ Just B (f x))
-
-
-def check : 0.(A : ★) → (ω.A → Bool) → ω.A → Maybe A =
-  λ A p x ⇒ bool.if (Maybe A) (p x) (Just A x) (Nothing A)
-
-def or : 0.(A : ★) → Maybe A → ω.(Maybe A) → Maybe A =
-  λ A l r ⇒ fold A (Maybe A) r (Just A) l
-
-}
-
-def0 Maybe   = maybe.Maybe
-def  Just    = maybe.Just
-def  Nothing = maybe.Nothing
diff --git a/stdlib/misc.quox b/stdlib/misc.quox
deleted file mode 100644
index 945c9af..0000000
--- a/stdlib/misc.quox
+++ /dev/null
@@ -1,261 +0,0 @@
-namespace true {
-  def0 True : ★ = {true}
-
-  def drop : 0.(A : ★) → True → A → A =
-    λ A t x ⇒ case t return A of { 'true ⇒ x }
-
-  def0 eta : (s : True) → s ≡ 'true : True =
-    λ s ⇒ case s return s' ⇒ s' ≡ 'true : True of { 'true ⇒ δ 𝑖 ⇒ 'true }
-
-  def0 irr : (s t : True) → s ≡ t : True =
-    λ s t ⇒
-      coe (𝑖 ⇒ eta s @𝑖 ≡ t : True) @1 @0
-        (coe (𝑖 ⇒ 'true ≡ eta t @𝑖 : True) @1 @0 (δ _ ⇒ 'true))
-
-  def revive : 0.True → True = λ _ ⇒ 'true
-}
-def0 True = true.True
-
-namespace false {
-  def0 False : ★ = {}
-
-  def void : 0.(A : ★) → 0.False → A =
-    λ A v ⇒ case0 v return A of { }
-
-  def0 irr : (u v : False) → u ≡ v : False =
-    λ u v ⇒ void (u ≡ v : False) u
-
-  def revive : 0.False → False = void False
-}
-def0 False = false.False
-def void = false.void
-
-
-def0 Not : ★ → ★ = λ A ⇒ ω.A → False
-
-def0 Iff : ★ → ★ → ★ = λ A B ⇒ (A → B) × (B → A)
-
-def0 All : (A : ★) → (A → ★) → ★ =
-  λ A P ⇒ (x : A) → P x
-
-def cong :
-    0.(A : ★) → 0.(P : A → ★) → 1.(p : All A P) →
-    0.(x y : A) → 1.(xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
-  λ A P p x y xy ⇒ δ 𝑖 ⇒ p (xy @𝑖)
-
-def cong' :
-    0.(A B : ★) → 1.(f : A → B) →
-    0.(x y : A) → 1.(xy : x ≡ y : A) → f x ≡ f y : B =
-  λ A B ⇒ cong A (λ _ ⇒ B)
-
-def coherence :
-    0.(A B : ★) → 0.(AB : A ≡ B : ★) → 1.(x : A) →
-    Eq (𝑖 ⇒ AB @𝑖) x (coe (𝑖 ⇒ AB @𝑖) x) =
-  λ A B AB x ⇒
-    δ 𝑗 ⇒ coe (𝑖 ⇒ AB @𝑖) @0 @𝑗 x
-
-
-def0 EqF : (A : ★) → (P : A → ★) → (p : All A P) → (q : All A P) → A → ★ =
-  λ A P p q x ⇒ p x ≡ q x : P x
-
-def funext :
-    0.(A : ★) → 0.(P : A → ★) → 0.(p q : All A P) →
-    1.(All A (EqF A P p q)) → p ≡ q : All A P =
-  λ A P p q eq ⇒ δ 𝑖 ⇒ λ x ⇒ eq x @𝑖
-
-def refl : 0.(A : ★) → 1.(x : A) → x ≡ x : A = λ A x ⇒ δ _ ⇒ x
-
-def sym : 0.(A : ★) → 0.(x y : A) → 1.(x ≡ y : A) → y ≡ x : A =
-  λ A x y eq ⇒ coe (𝑗 ⇒ eq @𝑗 ≡ x : A) (δ _ ⇒ eq @0)
-    -- btw this uses eq @0 instead of just x because of the quantities
-
-def sym-c : 0.(A : ★) → 0.(x y : A) → 1.(x ≡ y : A) → y ≡ x : A =
-  λ A x y eq ⇒ δ 𝑖 ⇒
-    comp A (eq @0) @𝑖 { 0 𝑗 ⇒ eq @𝑗; 1 _ ⇒ eq @0 }
-
-{-
-def sym-het : 0.(A B : ★) → 0.(AB : A ≡ B : ★) →
-              0.(x : A) → 0.(y : B) →
-              1.(Eq (𝑖 ⇒ AB @𝑖) x y) →
-              Eq (𝑖 ⇒ sym¹ ★ A B AB @𝑖) y x =
-  λ A B AB x y xy ⇒
-    let0 BA  = sym¹ ★ A B AB;
-         y'  : A = coe (𝑖 ⇒ BA @𝑖) y;
-         yy' : Eq (𝑖 ⇒ BA @𝑖) y y' =
-           δ 𝑗 ⇒ coe (𝑖 ⇒ BA @𝑖) @0 @𝑗 y;
-    in
-    0
--}
-
-{-
-  δ 𝑖 ⇒
-    comp (𝑗 ⇒ sym¹ ★ A B AB @𝑗) @0 @𝑖 y @𝑖 {
-      0 𝑗 ⇒ xy @𝑗;
-      1 𝑗 ⇒ xy @𝑗
-    }
--}
-
-def trans10 : 0.(A : ★) → 0.(x y z : A) →
-              1.(x ≡ y : A) → 0.(y ≡ z : A) → x ≡ z : A =
-  λ A x y z eq1 eq2 ⇒ coe (𝑗 ⇒ x ≡ eq2 @𝑗 : A) eq1
-
-def trans01 : 0.(A : ★) → 0.(x y z : A) →
-              0.(x ≡ y : A) → 1.(y ≡ z : A) → x ≡ z : A =
-  λ A x y z eq1 eq2 ⇒ coe (𝑗 ⇒ eq1 @𝑗 ≡ z : A) @1 @0 eq2
-
-def trans : 0.(A : ★) → 0.(x y z : A) →
-            ω.(x ≡ y : A) → ω.(y ≡ z : A) → x ≡ z : A =
-  λ A x y z eq1 eq2 ⇒ trans01 A x y z eq1 eq2
-
-{-
-def trans-het : 0.(A B C : ★) → 0.(AB : A ≡ B : ★) → 0.(BC : B ≡ C : ★) →
-                0.(x : A) → 0.(y : B) → 0.(z : C) →
-                ω.(Eq (𝑖 ⇒ AB @𝑖) x y) →
-                ω.(Eq (𝑖 ⇒ BC @𝑖) y z) →
-                Eq (𝑖 ⇒ trans¹ ★ A B C AB BC @𝑖) x z
-=
-  λ A B C AB BC x y z xy yz ⇒
-    let 0.AC = trans¹ ★ A B C AB BC;
-        0.y' : A = coe (𝑗 ⇒ AB @𝑗) @1 @0 y;
-    in
-    δ 𝑖 ⇒
-    trans (AC @𝑖) (coe (𝑗 ⇒ AC @𝑗) @0 @𝑖 x)
-                  (coe (𝑗 ⇒ AC @𝑗) @0 @𝑖 y')
-                  (coe (𝑗 ⇒ AC @𝑗) @1 @𝑖 z)
-                  0
-                  0
-                  @𝑖
-
-def0 trans-trans-het :
-    (A : ★) → (x y z : A) →
-    (xy : x ≡ y : A) → (yz : y ≡ z : A) →
-    Eq (_ ⇒ x ≡ z : A)
-       (trans A x y z xy yz)
-       (trans-het A A A (δ _ ⇒ A) (δ _ ⇒ A) x y z xy yz) =
-  λ A x y z xy yz ⇒ δ _ ⇒ trans A x y z xy yz
--}
-
-def appω : 0.(A B : ★) → ω.(f : ω.A → B) → [ω.A] → [ω.B] =
-  λ A B f x ⇒ case x return [ω.B] of { [x'] ⇒ [f x'] }
-def app# = appω
-
-def app2ω : 0.(A B C : ★) → ω.(f : ω.A → ω.B → C) → [ω.A] → [ω.B] → [ω.C] =
-  λ A B C f x y ⇒
-  case x return [ω.C] of { [x'] ⇒
-    case y return [ω.C] of { [y'] ⇒ [f x' y'] }
-  }
-def app2# = app2ω
-
-def getω : 0.(A : ★) → [ω.A] → A =
-  λ A x ⇒ case x return A of { [x] ⇒ x }
-def get# = getω
-
-def0 get0 : (A : ★) → [0.A] → A =
-  λ A x ⇒ case x return A of { [x] ⇒ x }
-
-def0 get0-box : (A : ★) → (b : [0.A]) →
-                [get0 A b] ≡ b : [0.A] =
-  λ A b ⇒ case b return b' ⇒ [get0 A b'] ≡ b' : [0.A] of { [x] ⇒ δ _ ⇒ [x] }
-
-def drop0 : 0.(A B : ★) → [0.A] → B → B =
-  λ A B x y ⇒ case x return B of { [_] ⇒ y }
-
-def0 drop0-eq : (A B : ★) → (x : [0.A]) → (y : B) → drop0 A B x y ≡ y : B =
-  λ A B x y ⇒
-  case x return x' ⇒ drop0 A B x' y ≡ y : B of { [_] ⇒ δ 𝑖 ⇒ y }
-
-def0 HEq : (A B : ★) → A → B → ★¹ =
-  λ A B x y ⇒ (AB : A ≡ B : ★) × Eq (𝑖 ⇒ AB @𝑖) x y
-
-def0 boxω-inj : (A : ★) → (x y : A) → [x] ≡ [y] : [ω.A] → x ≡ y : A =
-  λ A x y xy ⇒ δ 𝑖 ⇒ getω A (xy @𝑖)
--- [todo] change lexical syntax to allow "box#-inj"
-
-def revive0 : 0.(A : ★) → 0.[0.A] → [0.A] =
-  λ A s ⇒ [get0 A s]
-
-
-namespace sing {
-
-def0 Sing : (A : ★) → A → ★ =
-  λ A x ⇒ (val : A) × [0. val ≡ x : A]
-
-def sing : 0.(A : ★) → (x : A) → Sing A x =
-  λ A x ⇒ (x, [δ _ ⇒ x])
-
-def val : 0.(A : ★) → 0.(x : A) → Sing A x → A =
-  λ A x sg ⇒
-  case sg return A of { (x', eq) ⇒ drop0 (x' ≡ x : A) A eq x' }
-
-def0 val-fst : (A : ★) → (x : A) → (sg : Sing A x) → val A x sg ≡ fst sg : A =
-  λ A x sg ⇒ drop0-eq (fst sg ≡ x : A) A (snd sg) (fst sg)
-
-def0 proof : (A : ★) → (x : A) → (sg : Sing A x) → val A x sg ≡ x : A =
-  λ A x sg ⇒
-  trans A (val A x sg) (fst sg) x
-    (val-fst A x sg) (get0 (fst sg ≡ x : A) (snd sg))
-
-def app : 0.(A B : ★) → 0.(x : A) →
-          (f : A → B) → Sing A x → Sing B (f x) =
-  λ A B x f sg ⇒
-    let 1.x' = val A x sg;
-        0.xx = proof A x sg in
-    (f x', [δ 𝑖 ⇒ f (xx @𝑖)])
-
-}
-
-def0 Sing = sing.Sing
-def  sing = sing.sing
-
-
-namespace dup {
-
-def0 Dup : (A : ★) → A → ★ =
-  λ A x ⇒ Sing [ω.A] [x]
-
-def from-parts :
-    0.(A : ★) →
-    (dup : A → [ω.A]) →
-    0.(prf : (x : A) → dup x ≡ [x] : [ω.A]) →
-    (x : A) → Dup A x =
-  λ A dup prf x ⇒ (dup x, [prf x])
-
-def to-drop : 0.(A : ★) → (A → [ω.A]) → 0.(B : ★) → A → B → B =
-  λ A dup B x y ⇒ case dup x return B of { [_] ⇒ y }
-
-def erased : 0.(A : ★) → (x : [0.A]) → Dup [0.A] x =
-  λ A x ⇒ case x return x' ⇒ Dup [0.A] x' of { [x] ⇒ sing [ω.[0.A]] [[x]] }
-
-def valω : 0.(A : ★) → 0.(x : A) → Dup A x → [ω.A] =
-  λ A x ⇒ sing.val [ω.A] [x]
-def val# = valω
-
-def val : 0.(A : ★) → 0.(x : A) → Dup A x → A =
-  λ A x x! ⇒ getω A (valω A x x!)
-
-def0 proofω : (A : ★) → (x : A) → (x! : Dup A x) → valω A x x! ≡ [x] : [ω.A] =
-  λ A x x! ⇒ sing.proof [ω.A] [x] x!
-def0 proof# : (A : ★) → (x : A) → (x! : Dup A x) → val# A x x! ≡ [x] : [ω.A] =
-  proofω
-
-def0 proof : (A : ★) → (x : A) → (x! : Dup A x) → val A x x! ≡ x : A =
-  λ A x x! ⇒ δ 𝑖 ⇒ getω A (proofω A x x! @𝑖)
-
-def elim' : 0.(A : ★) → 0.(x : A) → 0.(P : A → ★) →
-            (ω.(x' : A) → 0.(x' ≡ x : A) → P x) → Dup A x → P x =
-  λ A x P f x! ⇒
-    let xω : [ω.A] = sing.val [ω.A] [x] x! in
-    case xω return xω' ⇒ 0.(xω' ≡ xω : [ω.A]) → P x of { [x'] ⇒ λ eq1 ⇒
-      let0 eq2 = sing.proof [ω.A] [x] x!;
-           eq  = boxω-inj A x' x (trans [ω.A] [x'] xω [x] eq1 eq2) in
-      f x' eq
-    } (δ _ ⇒ xω)
-
-def elim : 0.(A : ★) → 0.(x : A) → 0.(P : A → ★) →
-           (ω.(x' : A) → P x') → Dup A x → P x =
-  λ A x P f ⇒ elim' A x P (λ x' xx ⇒ coe (𝑖 ⇒ P (xx @𝑖)) (f x'))
-
-
-}
-
-def0 Dup = dup.Dup
diff --git a/stdlib/nat.quox b/stdlib/nat.quox
deleted file mode 100644
index d2e620f..0000000
--- a/stdlib/nat.quox
+++ /dev/null
@@ -1,297 +0,0 @@
-load "misc.quox"
-load "bool.quox"
-load "either.quox"
-load "sub.quox"
-
-namespace nat {
-
-def elim-0-1 :
-    0.(P : ℕ → ★) →
-    ω.(P 0) → ω.(P 1) →
-    ω.(0.(n : ℕ) → P n → P (succ n)) →
-    (n : ℕ) → P n =
-  λ P p0 p1 ps n ⇒
-  case n return n' ⇒ P n' of {
-    zero    ⇒ p0;
-    succ n' ⇒
-      case n' return n'' ⇒ P (succ n'') of {
-        zero         ⇒ p1;
-        succ n'', IH ⇒ ps (succ n'') IH
-      }
-  }
-
-def elim-pair :
-    0.(P : ℕ → ℕ → ★) →
-    ω.(P 0 0) →
-    ω.(0.(n : ℕ)   → P 0 n → P 0 (succ n)) →
-    ω.(0.(m : ℕ)   → P m 0 → P (succ m) 0) →
-    ω.(0.(m n : ℕ) → P m n → P (succ m) (succ n)) →
-    (m n : ℕ) → P m n =
-  λ P zz zs sz ss m ⇒
-    case m return m' ⇒ (n : ℕ) → P m' n of {
-      0 ⇒ λ n ⇒ case n return n' ⇒ P 0 n' of {
-        0            ⇒ zz;
-        succ n', ihn ⇒ zs n' ihn
-      };
-      succ m', ihm ⇒ λ n ⇒ case n return n' ⇒ P (succ m') n' of {
-        0       ⇒ sz m' (ihm 0);
-        succ n' ⇒ ss m' n' (ihm n')
-      }
-    }
-
-def elim-pairω :
-    0.(P : ℕ → ℕ → ★) →
-    ω.(P 0 0) →
-    ω.(ω.(n : ℕ)   → ω.(P 0 n) → P 0 (succ n)) →
-    ω.(ω.(m : ℕ)   → ω.(P m 0) → P (succ m) 0) →
-    ω.(ω.(m n : ℕ) → ω.(P m n) → P (succ m) (succ n)) →
-    ω.(m n : ℕ) → P m n =
-  λ P zz zs sz ss m ⇒
-    caseω m return m' ⇒ ω.(n : ℕ) → P m' n of {
-      0 ⇒ λ n ⇒ caseω n return n' ⇒ P 0 n' of {
-        0              ⇒ zz;
-        succ n', ω.ihn ⇒ zs n' ihn
-      };
-      succ m', ω.ihm ⇒ λ n ⇒ caseω n return n' ⇒ P (succ m') n' of {
-        0       ⇒ sz m' (ihm 0);
-        succ n' ⇒ ss m' n' (ihm n')
-      }
-    }
-
-
-def succ-boxω : [ω.ℕ] → [ω.ℕ] =
-  λ n ⇒ case n return [ω.ℕ] of { [n] ⇒ [succ n] }
-
-#[compile-scheme "(lambda (n) n)"]
-def dup : ℕ → [ω.ℕ] =
-  λ n ⇒ case n return [ω.ℕ] of {
-    0          ⇒ [0];
-    succ _, n! ⇒ succ-boxω n!
-  }
-
-def0 dup-ok : (n : ℕ) → dup n ≡ [n] : [ω.ℕ] =
-  λ n ⇒
-  case n return n' ⇒ dup n' ≡ [n'] : [ω.ℕ] of {
-    0          ⇒ δ 𝑖 ⇒ [0];
-    succ _, ih ⇒ δ 𝑖 ⇒ succ-boxω (ih @𝑖)
-  }
-
-def dup! : (n : ℕ) → Dup ℕ n =
-  dup.from-parts ℕ dup dup-ok
-
-
-def drop : 0.(A : ★) → ℕ → A → A =
-  dup.to-drop ℕ dup
-
-
-def natopω' : 0.(A : ★) → ω.(ω.ℕ → ω.ℕ → A) → ℕ → ℕ → A =
-  λ A f m n ⇒
-    getω A (app2ω ℕ ℕ A f (dup m) (dup n))
-
-def natopω = natopω' ℕ
-
-#[compile-scheme "(lambda% (m n) (+ m n))"]
-def plus : ℕ → ℕ → ℕ =
-  λ m n ⇒
-  case m return ℕ of {
-    zero      ⇒ n;
-    succ _, p ⇒ succ p
-  }
-
-#[compile-scheme "(lambda% (m n) (* m n))"]
-def timesω : ω.ℕ → ω.ℕ → ℕ =
-  λ m n ⇒
-  case m return ℕ of {
-    zero      ⇒ zero;
-    succ _, t ⇒ plus n t
-  }
-
-def times = natopω timesω
-
-def pred : ℕ → ℕ = λ n ⇒ case n return ℕ of { zero ⇒ zero; succ n ⇒ n }
-
-def pred-succ : ω.(n : ℕ) → pred (succ n) ≡ n : ℕ =
-  λ n ⇒ δ 𝑖 ⇒ n
-
-def succ-inj : 0.(m n : ℕ) → succ m ≡ succ n : ℕ → m ≡ n : ℕ =
-  λ m n eq ⇒ δ 𝑖 ⇒ pred (eq @𝑖)
-
-#[compile-scheme "(lambda% (m n) (max 0 (- m n)))"]
-def minus : ℕ → ℕ → ℕ =
-  λ m n ⇒
-  (case n return ℕ → ℕ of {
-    zero      ⇒ λ m ⇒ m;
-    succ _, f ⇒ λ m ⇒ f (pred m)
-  }) m
-
-
-def minω : ω.ℕ → ω.ℕ → ℕ =
-  elim-pairω (λ _ _ ⇒ ℕ) 0 (λ _ _ ⇒ 0) (λ _ _ ⇒ 0) (λ _ _ x ⇒ succ x)
-
-def min = natopω minω
-
-
-def0 IsSucc : ℕ → ★ =
-  λ n ⇒ case n return ★ of { zero ⇒ False; succ _ ⇒ True }
-
-def is-succ? : ω.(n : ℕ) → Dec (IsSucc n) =
-  λ n ⇒
-  caseω n return n' ⇒ Dec (IsSucc n') of {
-    zero   ⇒ No  (IsSucc zero)      (λ v ⇒ v);
-    succ n ⇒ Yes (IsSucc (succ n)) 'true
-  }
-
-def zero-not-succ : 0.(m : ℕ) → Not (zero ≡ succ m : ℕ) =
-  λ m eq ⇒ coe (𝑖 ⇒ IsSucc (eq @𝑖)) @1 @0 'true
-
-def succ-not-zero : 0.(m : ℕ) → Not (succ m ≡ zero : ℕ) =
-  λ m eq ⇒ coe (𝑖 ⇒ IsSucc (eq @𝑖)) 'true
-
-def0 not-succ-self : (m : ℕ) → Not (m ≡ succ m : ℕ) =
-  λ m ⇒
-  case m return m' ⇒ Not (m' ≡ succ m' : ℕ) of {
-    zero         ⇒ zero-not-succ 0;
-    succ n, ω.ih ⇒ λ eq ⇒ ih (succ-inj n (succ n) eq)
-  }
-
-
-def0 IsSuccOf : ℕ → ℕ → ★ =
-  λ n p ⇒ n ≡ succ p : ℕ
-
-def0 PredOf : ℕ → ★ =
-  λ n ⇒ Sub ℕ (IsSuccOf n)
-
-def0 no-pred0 : Not (PredOf 0) =
-  λ p ⇒
-  case p return False of { (p, lt) ⇒
-    zero-not-succ p (get0 (0 ≡ succ p : ℕ) lt)
-  }
-
-def pred? : (n : ℕ) → DecT (PredOf n) =
-  λ n ⇒
-  case n return n' ⇒ DecT (PredOf n') of {
-    zero   ⇒ NoT  (PredOf zero)     no-pred0;
-    succ n ⇒ YesT (PredOf (succ n)) (n, [δ _ ⇒ succ n])
-  }
-
-namespace pred-of {
-
-def revive : (n : ℕ) → 0.(PredOf n) → PredOf n =
-  λ n hs ⇒
-    let0 p = fst hs in
-    case n return n' ⇒ 0.(n' ≡ succ p : ℕ) → PredOf n' of {
-      zero    ⇒ λ eq ⇒ void (PredOf zero) (zero-not-succ p eq);
-      succ p' ⇒ λ _  ⇒ (p', [δ _ ⇒ succ p'])
-    } (get0 (n ≡ succ p : ℕ) (snd hs))
-
-def val : 0.(n : ℕ) → PredOf n → ℕ =
-  λ n ⇒ sub.val ℕ (IsSuccOf n)
-
-def0 proof : (n : ℕ) → (p : PredOf n) → n ≡ succ (fst p) : ℕ =
-  λ n ⇒ sub.proof ℕ (IsSuccOf n)
-
-}
-
-
-def divmodω : ω.ℕ → ω.ℕ → ℕ × ℕ =
-  -- https://coq.inria.fr/doc/V8.18.0/stdlib/Coq.Init.Nat.html#divmod
-  letω divmod' : ℕ → ω.ℕ → ℕ → ℕ → ℕ × ℕ =
-    λ x ⇒
-    case x return ω.ℕ → ℕ → ℕ → ℕ × ℕ of {
-      0          ⇒ λ y q u ⇒ (q, u);
-      succ _, f' ⇒ λ y q u ⇒
-        case u return ℕ × ℕ of {
-          0       ⇒ f' y (succ q) y;
-          succ u' ⇒ f' y q u'
-        }
-    } in
-  λ x y ⇒
-  caseω y return ℕ × ℕ of {
-    0       ⇒ (0, 0);
-    succ y' ⇒
-      case divmod' x y' 0 y' return ℕ × ℕ of { (d, m) ⇒ (d, minus y' m) }
-  }
-
-def divmod = natopω' (ℕ × ℕ) divmodω
-
-def divω : ω.ℕ → ω.ℕ → ℕ = λ x y ⇒ fst (divmodω x y)
-def div = natopω divω
-
-def modω : ω.ℕ → ω.ℕ → ℕ = λ x y ⇒ snd (divmodω x y)
-def mod = natopω modω
-
-
-#[compile-scheme "(lambda% (m n) (if (= m n) Yes No))"]
-def eq? : DecEq ℕ =
-  λ m n ⇒
-  elim-pair (λ m n ⇒ Dec (m ≡ n : ℕ))
-    (Yes (0 ≡ 0 : ℕ) (δ 𝑖 ⇒ 0))
-    (λ n p ⇒
-      dec.drop (0 ≡ n : ℕ) (Dec (0 ≡ succ n : ℕ)) p
-        (No (0 ≡ succ n : ℕ) (λ zs ⇒ zero-not-succ n zs)))
-    (λ m p ⇒
-      dec.drop (m ≡ 0 : ℕ) (Dec (succ m ≡ 0 : ℕ)) p
-        (No (succ m ≡ 0 : ℕ) (λ sz ⇒ succ-not-zero m sz)))
-    (λ m n ⇒
-      dec.elim (m ≡ n : ℕ) (λ _ ⇒ Dec (succ m ≡ succ n : ℕ))
-        (λ yy ⇒ Yes (succ m ≡ succ n : ℕ) (δ 𝑖  ⇒ succ (yy @𝑖)))
-        (λ nn ⇒ No  (succ m ≡ succ n : ℕ) (λ yy ⇒ nn (succ-inj m n yy))))
-    m n
-
-
-def0 Ordering : ★ = {lt, eq, gt}
-
-namespace ordering {
-  def from : 0.(A : ★) → ω.A → ω.A → ω.A → Ordering → A =
-    λ A lt eq gt o ⇒
-    case o return A of { 'lt ⇒ lt; 'eq ⇒ eq; 'gt ⇒ gt }
-
-  def drop : 0.(A : ★) → Ordering → A → A =
-    λ A o x ⇒ case o return A of { 'lt ⇒ x; 'eq ⇒ x; 'gt ⇒ x }
-
-  def eq : Ordering → Ordering → Bool =
-    λ x y ⇒
-    case x return Bool of {
-      'lt ⇒ case y return Bool of { 'lt ⇒ 'true;  'eq ⇒ 'false; 'gt ⇒ 'false };
-      'eq ⇒ case y return Bool of { 'lt ⇒ 'false; 'eq ⇒ 'true;  'gt ⇒ 'false };
-      'gt ⇒ case y return Bool of { 'lt ⇒ 'false; 'eq ⇒ 'false; 'gt ⇒ 'true  };
-    }
-}
-
-def compare : ℕ → ℕ → Ordering =
-  elim-pair (λ _ _ ⇒ Ordering)
-    'eq
-    (λ _ o   ⇒ ordering.drop Ordering o 'lt)
-    (λ _ o   ⇒ ordering.drop Ordering o 'gt)
-    (λ _ _ x ⇒ x)
-
-def lt : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ ordering.eq (compare m n) 'lt
-def eq : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ ordering.eq (compare m n) 'eq
-def gt : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ ordering.eq (compare m n) 'gt
-def ne : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ bool.not (eq m n)
-def le : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ bool.not (gt m n)
-def ge : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ bool.not (lt m n)
-
-
-def0 plus-zero : (m : ℕ) → m ≡ plus m 0 : ℕ =
-  λ m ⇒
-  case m return m' ⇒ m' ≡ plus m' 0 : ℕ of {
-    zero        ⇒ δ _ ⇒ 0;
-    succ m', ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
-  }
-
-def0 plus-succ : (m n : ℕ) → succ (plus m n) ≡ plus m (succ n) : ℕ =
-  λ m n ⇒
-  case m return m' ⇒ succ (plus m' n) ≡ plus m' (succ n) : ℕ of {
-    zero       ⇒ δ _ ⇒ succ n;
-    succ _, ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
-  }
-
-def0 times-zero : (m : ℕ) → 0 ≡ timesω m 0 : ℕ =
-  λ m ⇒
-  case m return m' ⇒ 0 ≡ timesω m' 0 : ℕ of {
-    zero        ⇒ δ _ ⇒ zero;
-    succ m', ih ⇒ ih
-  }
-
-}
diff --git a/stdlib/pair.quox b/stdlib/pair.quox
deleted file mode 100644
index 9f93009..0000000
--- a/stdlib/pair.quox
+++ /dev/null
@@ -1,67 +0,0 @@
-namespace pair {
-
-def0 Σ : (A : ★) → (A → ★) → ★ = λ A B ⇒ (x : A) × B x
-
-def uncurry :
-    0.(A : ★) → 0.(B : A → ★) → 0.(C : (x : A) → (B x) → ★) →
-    (f : (x : A) → (y : B x) → C x y) →
-    (p : Σ A B) → C (fst p) (snd p) =
-  λ A B C f p ⇒
-    case p return p' ⇒ C (fst p') (snd p') of { (x, y) ⇒ f x y }
-
-def uncurry' :
-    0.(A B C : ★) → (A → B → C) → (A × B) → C =
-  λ A B C ⇒ uncurry A (λ _ ⇒ B) (λ _ _ ⇒ C)
-
-def curry :
-    0.(A : ★) → 0.(B : A → ★) → 0.(C : (Σ A B) → ★) →
-    (f : (p : Σ A B) → C p) → (x : A) → (y : B x) → C (x, y) =
-  λ A B C f x y ⇒ f (x, y)
-
-def curry' :
-    0.(A B C : ★) → (A × B → C) → A → B → C =
-  λ A B C ⇒ curry A (λ _ ⇒ B) (λ _ ⇒ C)
-
-def0 fst-snd :
-    (A : ★) → (B : A → ★) →
-    (p : Σ A B) → p ≡ (fst p, snd p) : Σ A B =
-  λ A B p ⇒ δ 𝑖 ⇒ p -- η
-
-def0 fst-eq :
-    (A : ★) → (B : A → ★) →
-    (p q : Σ A B) → p ≡ q : Σ A B → fst p ≡ fst q : A =
-  λ A B p q eq ⇒ δ 𝑖 ⇒ fst (eq @𝑖)
-
-def0 snd-eq :
-    (A : ★) → (B : A → ★) →
-    (p q : Σ A B) → (eq : p ≡ q : Σ A B) →
-    Eq (𝑖 ⇒ B (fst-eq A B p q eq @𝑖)) (snd p) (snd q) =
-  λ A B p q eq ⇒ δ 𝑖 ⇒ snd (eq @𝑖)
-
-def0 pair-eq :
-    (A : ★) → (B : A → ★) →
-    (x0 x1 : A) → (y0 : B x0) → (y1 : B x1) →
-    (xx : x0 ≡ x1 : A) → (yy : Eq (𝑖 ⇒ B (xx @𝑖)) y0 y1) →
-    (x0, y0) ≡ (x1, y1) : ((x : A) × B x) =
-  λ A B x0 x1 y0 y1 xx yy ⇒ δ 𝑖 ⇒ (xx @𝑖, yy @𝑖)
-
-def map :
-    0.(A A' : ★) →
-    0.(B : A → ★) → 0.(B' : A' → ★) →
-    (f : A → A') → (g : 0.(x : A) → (B x) → B' (f x)) →
-    Σ A B → Σ A' B' =
-  λ A A' B B' f g p ⇒
-    case p return Σ A' B' of { (x, y) ⇒ (f x, g x y) }
-
-def map' : 0.(A A' B B' : ★) → (A → A') → (B → B') → (A × B) → A' × B' =
-  λ A A' B B' f g ⇒ map A A' (λ _ ⇒ B) (λ _ ⇒ B') f (λ _ ⇒ g)
-
-def map-fst : 0.(A A' B : ★) → (A → A') → A × B → A' × B =
-  λ A A' B f ⇒ map' A A' B B f (λ x ⇒ x)
-
-def map-snd : 0.(A B B' : ★) → (B → B') → A × B → A × B' =
-  λ A B B' f ⇒ map' A A B B' (λ x ⇒ x) f
-
-}
-
-def0 Σ   = pair.Σ
diff --git a/stdlib/qty.quox b/stdlib/qty.quox
deleted file mode 100644
index 673b4d4..0000000
--- a/stdlib/qty.quox
+++ /dev/null
@@ -1,156 +0,0 @@
-load "misc.quox"
-
-def0 Qty : ★ = {"zero", one, any}
-
-def0 NzQty : ★ = {one, any}
-
-def nz : NzQty → Qty =
-  λ π ⇒ case π return Qty of { 'one ⇒ 'one; 'any ⇒ 'any }
-
-def dup! : (π : Qty) → Dup Qty π =
-  λ π ⇒ case π return π' ⇒ Dup Qty π' of {
-    'zero ⇒ (['zero], [δ _ ⇒ ['zero]]);
-    'one  ⇒ (['one],  [δ _ ⇒ ['one]]);
-    'any  ⇒ (['any],  [δ _ ⇒ ['any]]);
-  }
-
-def dup : (π : Qty) → [ω.Qty] =
-  λ π ⇒ dup.valω Qty π (dup! π)
-
-def drop : 0.(A : ★) → Qty → A → A =
-  λ A π x ⇒ case π return A of {
-    'zero ⇒ x;
-    'one  ⇒ x;
-    'any  ⇒ x;
-  }
-
-def if-zero : 0.(A : ★) → Qty → ω.A → ω.A → A =
-  λ A π z nz ⇒
-  case π return A of { 'zero ⇒ z; 'one ⇒ nz; 'any ⇒ nz }
-
-def plus : Qty → ω.Qty → Qty =
-  λ π ρ ⇒
-  case π return Qty of {
-    'zero ⇒ ρ;
-    'one  ⇒ if-zero Qty ρ 'one 'any;
-    'any  ⇒ 'any;
-  }
-
-def times : Qty → ω.Qty → Qty =
-  λ π ρ ⇒
-  case π return Qty of {
-    'zero ⇒ 'zero;
-    'one  ⇒ ρ;
-    'any  ⇒ if-zero Qty ρ 'zero 'any;
-  }
-
-def0 FUN : Qty → (A : ★) → (A → ★) → ★ =
-  λ π A B ⇒
-  case π return ★ of {
-    'zero ⇒ 0.(x : A) → B x;
-    'one  ⇒ 1.(x : A) → B x;
-    'any  ⇒ ω.(x : A) → B x;
-  }
-
-def0 FUN-NZ : NzQty → (A : ★) → (A → ★) → ★ =
-  λ π A B ⇒
-  case π return ★ of {
-    'one  ⇒ 1.(x : A) → B x;
-    'any  ⇒ ω.(x : A) → B x;
-  }
-
-def0 Fun : Qty → ★ → ★ → ★ =
-  λ π A B ⇒ FUN π A (λ _ ⇒ B)
-
-def0 FunNz : NzQty → ★ → ★ → ★ =
-  λ π A B ⇒ FUN-NZ π A (λ _ ⇒ B)
-
-def0 Box : Qty → ★ → ★ =
-  λ π A ⇒
-  case π return ★ of {
-    'zero ⇒ [0.A];
-    'one  ⇒ [1.A];
-    'any  ⇒ [ω.A];
-  }
-
-def0 BoxNz : NzQty → ★ → ★ =
-  λ π A ⇒
-  case π return ★ of {
-    'one  ⇒ [1.A];
-    'any  ⇒ [ω.A];
-  }
-
-def0 unbox : (π : Qty) → (A : ★) → Box π A → A =
-  λ π A ⇒
-  case π return π' ⇒ Box π' A → A of {
-    'zero ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-    'one  ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-    'any  ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-  }
-
-def0 unbox0 = unbox 'zero
-def0 unbox1 = unbox 'one
-def0 unboxω = unbox 'any
-
-def0 unbox-nz : (π : NzQty) → (A : ★) → BoxNz π A → A =
-  λ π A ⇒
-  case π return π' ⇒ BoxNz π' A → A of {
-    'one  ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-    'any  ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
-  }
-
-def0 unbox-nz1 = unbox-nz 'one
-def0 unbox-nzω = unbox-nz 'any
-
-def apply : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
-            FUN π A B → (x : Box π A) → B (unbox π A x) =
-  λ π A B ⇒
-  case π
-  return π' ⇒ FUN π' A B → (x : Box π' A) → B (unbox π' A x)
-  of {
-    'zero ⇒ λ f x ⇒ case x return x' ⇒ B (unbox0 A x') of { [x] ⇒ f x };
-    'one  ⇒ λ f x ⇒ case x return x' ⇒ B (unbox1 A x') of { [x] ⇒ f x };
-    'any  ⇒ λ f x ⇒ case x return x' ⇒ B (unboxω A x') of { [x] ⇒ f x };
-  }
-
-def apply' : (π : Qty) → 0.(A B : ★) → Fun π A B → (x : Box π A) → B =
-  λ π A B ⇒ apply π A (λ _ ⇒ B)
-
-def apply-nz : (π : NzQty) → 0.(A : ★) → 0.(B : A → ★) →
-               FUN-NZ π A B → (x : BoxNz π A) → B (unbox-nz π A x) =
-  λ π A B ⇒
-  case π
-  return π' ⇒ FUN-NZ π' A B → (x : BoxNz π' A) → B (unbox-nz π' A x)
-  of {
-    'one  ⇒ λ f x ⇒ case x return x' ⇒ B (unbox-nz1 A x') of { [x] ⇒ f x };
-    'any  ⇒ λ f x ⇒ case x return x' ⇒ B (unbox-nzω A x') of { [x] ⇒ f x };
-  }
-
-def apply-nz' : (π : NzQty) → 0.(A B : ★) → FunNz π A B → (x : BoxNz π A) → B =
-  λ π A B ⇒ apply-nz π A (λ _ ⇒ B)
-
-def lam : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
-          ((x : Box π A) → B (unbox π A x)) → FUN π A B =
-  λ π A B ⇒
-    case π
-    return π' ⇒ ((x : Box π' A) → B (unbox π' A x)) → FUN π' A B of {
-      'zero ⇒ λ f x ⇒ f [x];
-      'one  ⇒ λ f x ⇒ f [x];
-      'any  ⇒ λ f x ⇒ f [x];
-    }
-
-def lam' : (π : Qty) → 0.(A B : ★) → (Box π A → B) → Fun π A B =
-  λ π A B ⇒ lam π A (λ _ ⇒ B)
-
-def lam-nz : (π : NzQty) → 0.(A : ★) → 0.(B : A → ★) →
-             ((x : BoxNz π A) → B (unbox-nz π A x)) → FUN-NZ π A B =
-  λ π A B ⇒
-    case π
-    return π' ⇒ ((x : BoxNz π' A) → B (unbox-nz π' A x)) → FUN-NZ π' A B of {
-      'one  ⇒ λ f x ⇒ f [x];
-      'any  ⇒ λ f x ⇒ f [x];
-    }
-
-def lam-nz' : (π : NzQty) → 0.(A B : ★) → (BoxNz π A → B) → FunNz π A B =
-  λ π A B ⇒ lam-nz π A (λ _ ⇒ B)
-
diff --git a/stdlib/string.quox b/stdlib/string.quox
deleted file mode 100644
index f59c799..0000000
--- a/stdlib/string.quox
+++ /dev/null
@@ -1,144 +0,0 @@
-load "bool.quox"
-load "list.quox"
-load "maybe.quox"
-load "either.quox"
-
-namespace char {
-
-postulate0 Char : ★
-
-#[compile-scheme "(lambda (c) c)"]
-postulate dup : Char → [ω.Char]
-
-#[compile-scheme "char->integer"]
-postulate to-ℕ : Char → ℕ
-
-#[compile-scheme "integer->char"]
-postulate from-ℕ : ℕ → Char
-
-def space   = from-ℕ 0x20
-def tab     = from-ℕ 0x09
-def newline = from-ℕ 0x0a
-
-def test-via-ℕ : (ω.ℕ → ω.ℕ → Bool) → (ω.Char → ω.Char → Bool) =
-  λ p c d ⇒ p (to-ℕ c) (to-ℕ d)
-def lt = test-via-ℕ nat.lt
-def eq = test-via-ℕ nat.eq
-def gt = test-via-ℕ nat.gt
-def le = test-via-ℕ nat.le
-def ne = test-via-ℕ nat.ne
-def ge = test-via-ℕ nat.ge
-
-postulate0 eq-iff-nat : (c d : Char) → Iff (c ≡ d : Char) (to-ℕ c ≡ to-ℕ d : ℕ)
-
-def eq? : DecEq Char =
-  λ c d ⇒
-  let0 Ty = (c ≡ d : Char) ∷ ★ in
-  dec.elim (to-ℕ c ≡ to-ℕ d : ℕ) (λ _ ⇒ Dec Ty)
-    (λ y ⇒ Yes Ty ((snd (eq-iff-nat c d)) y))
-    (λ n ⇒ No  Ty (λ y ⇒ n ((fst (eq-iff-nat c d)) y)))
-    (nat.eq? (to-ℕ c) (to-ℕ d))
-
-def ws? : ω.Char → Bool =
-  λ c ⇒ bool.or (bool.or (eq c space) (eq c tab)) (eq c newline)
-
-def digit? : ω.Char → Bool =
-  λ c ⇒ bool.and (ge c (from-ℕ 0x30)) (le c (from-ℕ 0x39))
-
-def digit-val : Char → Maybe ℕ =
-  λ c ⇒ case dup c return Maybe ℕ of { [c] ⇒
-    bool.if (Maybe ℕ) (digit? c)
-      (Just ℕ (nat.minus (to-ℕ c) 0x30))
-      (Nothing ℕ)
-  }
-
-}
-
-def0 Char = char.Char
-
-namespace string {
-
-#[compile-scheme "string->list"]
-postulate to-scheme-list : String → list.SchemeList Char
-
-def to-list : String → List Char =
-  λ str ⇒ list.from-scheme Char (to-scheme-list str)
-
-#[compile-scheme "list->string"]
-postulate from-scheme-list : list.SchemeList Char → String
-
-def from-list : List Char → String =
-  λ cs ⇒ from-scheme-list (list.to-scheme Char cs)
-
-def foldl : 0.(A : ★) → A → ω.(A → Char → A) → String → A =
-  λ A z f str ⇒ list.foldl Char A z f (to-list str)
-
-def foldlω : 0.(A : ★) → ω.A → ω.(ω.A → ω.Char → A) → ω.String → A =
-  λ A z f str ⇒ list.foldlω Char A z f (to-list str)
-
-def split : ω.(ω.Char → Bool) → ω.String → List String =
-  λ p str ⇒
-    list.map (List Char) String from-list
-      (list.split Char p (to-list str))
-
-def break : ω.(ω.Char → Bool) → ω.String → String × String =
-  λ p str ⇒
-  letω pair = list.break Char p (to-list str) in
-  (from-list (fst pair), from-list (snd pair))
-
-def reverse : String → String =
-  λ str ⇒ from-list (list.reverse Char (to-list str))
-
-#[compile-scheme "(lambda% (y n a b) (if (string=? a b) y n))"]
-postulate eq' : 0.(A : ★) → A → A → ω.String → ω.String → A
-def eq : ω.String → ω.String → Bool = eq' Bool 'true 'false
-
-def null : ω.String → Bool = eq ""
-def not-null : ω.String → Bool = λ s ⇒ bool.not (null s)
-
-#[compile-scheme "(lambda (str) str)"]
-postulate dup : String → [ω.String]
-
-postulate0 dup-ok : (str : String) → dup str ≡ [str] : [ω.String]
-
-def dup! : (str : String) → Dup String str =
-  dup-from-parts String dup dup-ok
-
-
-def to-ℕ : String → Maybe ℕ =
-  letω add-digit : Maybe ℕ → ℕ → Maybe ℕ =
-    maybe.fold ℕ (ℕ → Maybe ℕ) (λ d ⇒ Just ℕ d)
-      (λ n d ⇒ Just ℕ (nat.plus (nat.times 10 n) d)) in
-  letω drop : Maybe ℕ → Maybe ℕ =
-    maybe.fold ℕ (Maybe ℕ) (Nothing ℕ)
-      (λ n ⇒ nat.drop (Maybe ℕ) n (Nothing ℕ)) in
-  letω add-digit-c : Maybe ℕ → Char → Maybe ℕ =
-    λ acc c ⇒
-      maybe.fold ℕ (Maybe ℕ → Maybe ℕ) drop (λ n acc ⇒ add-digit acc n)
-        (char.digit-val c) acc in
-  λ str ⇒
-    case dup str return Maybe ℕ of { [str] ⇒
-      bool.if (Maybe ℕ) (not-null str)
-        (foldl (Maybe ℕ) (Just ℕ 0) add-digit-c str)
-        (Nothing ℕ)
-    }
-
-def to-ℕ-or-0 : String → ℕ =
-  λ str ⇒ maybe.fold ℕ ℕ 0 (λ x ⇒ x) (to-ℕ str)
-
-
-#[compile-scheme
- "(lambda% (yes no str)
-    (let [(len (string-length str))]
-      (if (= len 0)
-        no
-        (let [(first (string-ref str 0))
-              (rest  (substring str 1 len))]
-          (% yes first rest)))))"]
-postulate uncons' : 0.(A : ★) → ω.A → ω.(Char → String → A) → String → A
-
-def uncons : String → Maybe (Char × String) =
-  let0 Pair : ★ = Char × String in
-  uncons' (Maybe Pair) (Nothing Pair) (λ c s ⇒ Just Pair (c, s))
-
-}
diff --git a/stdlib/sub.quox b/stdlib/sub.quox
deleted file mode 100644
index 61128a4..0000000
--- a/stdlib/sub.quox
+++ /dev/null
@@ -1,159 +0,0 @@
-load "misc.quox"
-load "either.quox"
-load "maybe.quox"
-
-namespace sub {
-
-def0 Irr : (A : ★) → ★ =
-  λ A ⇒ (x y : A) → x ≡ y : A
-
-def0 Irr1 : (A : ★) → (A → ★) → ★ =
-  λ A P ⇒ (x : A) → Irr (P x)
-
-def0 Irr2 : (A B : ★) → (A → B → ★) → ★ =
-  λ A B P ⇒ (x : A) → (y : B) → Irr (P x y)
-
-def0 Sub : (A : ★) → (P : A → ★) → ★ =
-  λ A P ⇒ (x : A) × [0. P x]
-
-
-def sub : 0.(A : ★) → 0.(P : A → ★) → (x : A) → 0.(P x) → Sub A P =
-  λ A P x p ⇒ (x, [p])
-
-def sub? : 0.(A : ★) → 0.(P : A → ★) → (ω.(x : A) → Dec (P x)) →
-           ω.A → Maybe (Sub A P) =
-  λ A P p? x ⇒
-    dec.elim (P x) (λ _ ⇒ Maybe (Sub A P))
-      (λ y ⇒ Just (Sub A P) (x, [y]))
-      (λ n ⇒ Nothing (Sub A P))
-      (p? x)
-
-
-def val : 0.(A : ★) → 0.(P : A → ★) → Sub A P → A =
-  λ A P s ⇒ case s return A of { (x, p) ⇒ drop0 (P x) A p x }
-
-def0 proof : 0.(A : ★) → 0.(P : A → ★) → (s : Sub A P) → P (fst s) =
-  λ A P s ⇒ get0 (P (fst s)) (snd s)
-
-{-
-
-def0 proof' : 0.(A : ★) → 0.(P : A → ★) → (s : Sub A P) → P (fst s) =
-  λ A P s ⇒ get0 (P (fst s)) (snd s)
-
-def0 val-fst : (A : ★) → (P : A → ★) →
-               (s : Sub A P) → val A P s ≡ fst s : A =
-  λ A P s ⇒
-    case s return s' ⇒ val A P s' ≡ fst s' : A of {
-      (x, p) ⇒ drop0-eq (P x) A p x
-    }
-
-def0 proof : 0.(A : ★) → 0.(P : A → ★) → (s : Sub A P) → P (val A P s) =
-  λ A P s ⇒ coe (𝑖 ⇒ P (val-fst A P s @𝑖)) @1 @0 (proof' A P s)
-
-postulate0 proof-snd' : (A : ★) → (P : A → ★) → (s : Sub A P) →
-                  Eq (𝑖 ⇒ P (val-fst A P s @𝑖)) (proof A P s) (proof' A P s)
-
-postulate0 proof-snd : (A : ★) → (P : A → ★) → (s : Sub A P) →
-                 Eq (𝑖 ⇒ [0.P (val-fst A P s @𝑖)]) [proof A P s] (snd s)
-
-#![log (all, 10) (equal, 100)]
-def0 val-proof-eq : (A : ★) → (P : A → ★) → (s : Sub A P) →
-                    sub A P (val A P s) (proof A P s) ≡ s : Sub A P =
-  λ A P s ⇒
-    case s return s' ⇒ sub A P (val A P s') (proof A P s') ≡ s' : Sub A P
-    of { (xxxxx, p) ⇒
-      case p
-      return p' ⇒
-        sub A P (val A P (xxxxx, p')) (proof A P (xxxxx, p')) ≡ (xxxxx, p') : Sub A P
-      of { [p0] ⇒
-        δ 𝑖 ⇒ (val-fst A P (xxxxx, [p0]) @𝑖, proof-snd A P (xxxxx, [p0]) @𝑖)
-      }
-    }
-#![log pop]
-
-def elim' : 0.(A : ★) → 0.(P : A → ★) →
-            0.(R : (x : A) → P x → ★) →
-            (1.(x : A) → 0.(p : P x) → R x p) →
-            (s : Sub A P) → R (val A P s) (proof A P s) =
-  λ A P R p s ⇒ p (val A P s) (proof A P s)
-
-{-
-def elim : 0.(A : ★) → 0.(P : A → ★) →
-           0.(R : Sub A P → ★) →
-           (1.(x : A) → 0.(p : P x) → R (x, [p])) →
-           (s : Sub A P) → R s =
-  λ A P R p s ⇒ p (val A P s) (proof A P s)
--}
-
--}
-
-
-
-def0 SubDup : (A : ★) → (P : A → ★) → Sub A P → ★ =
-  λ A P s ⇒ Dup A (fst s)
-    -- (x! : [ω.A]) × [0. x! ≡ [fst s] : [ω.A]]
-
-def subdup-to-dup :
-    0.(A : ★) → 0.(P : A → ★) →
-    0.(s : Sub A P) → SubDup A P s → Dup (Sub A P) s =
-  λ A P s sd ⇒
-    case sd return Dup (Sub A P) s of { (sω, ss0) ⇒
-    case ss0 return Dup (Sub A P) s of { [ss0] ⇒
-      case sω
-      return sω' ⇒ 0.(sω' ≡ [fst s] : [ω.A]) → Dup (Sub A P) s
-      of { [s!] ⇒ λ ss' ⇒
-        let ω.p  : [0.P (fst s)] = revive0 (P (fst s)) (snd s);
-            0.ss : s! ≡ fst s : A = boxω-inj A s! (fst s) ss' in
-        ([(s!, coe (𝑖 ⇒ [0.P (ss @𝑖)]) @1 @0 p)],
-         [δ 𝑗 ⇒ [(ss @𝑗, coe (𝑖 ⇒ [0.P (ss @𝑖)]) @1 @𝑗 p)]])
-      } ss0
-    }}
-
-def subdup : 0.(A : ★) → 0.(P : A → ★) →
-             ((x : A) → Dup A x) →
-             (s : Sub A P) → SubDup A P s =
-  λ A P dup s ⇒
-    case s return s' ⇒ SubDup A P s' of { (x, p) ⇒
-      drop0 (P x) (Dup A x) p (dup x)
-    }
-
-def dup! : 0.(A : ★) → 0.(P : A → ★) → ((x : A) → Dup A x) →
-           (s : Sub A P) → Dup (Sub A P) s =
-  λ A P dupA s ⇒ subdup-to-dup A P s (subdup A P dupA s)
-
-
-def0 irr1-het : (A : ★) → (P : A → ★) → Irr1 A P →
-                (x y : A) → (p : P x) → (q : P y) →
-                (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) p q =
-  λ A P pirr x y p q xy ⇒ δ 𝑖 ⇒
-    pirr (xy @𝑖) (coe (𝑗 ⇒ P (xy @𝑗)) @0 @𝑖 p) (coe (𝑗 ⇒ P (xy @𝑗)) @1 @𝑖 q) @𝑖
-
-def0 irr2-het : (A B : ★) → (P : A → B → ★) → Irr2 A B P →
-                (x₀ x₁ : A) → (y₀ y₁ : B) → (p : P x₀ y₀) → (q : P x₁ y₁) →
-                (xx : x₀ ≡ x₁ : A) → (yy : y₀ ≡ y₁ : B) →
-                Eq (𝑖 ⇒ P (xx @𝑖) (yy @𝑖)) p q =
-  λ A B P pirr x₀ x₁ y₀ y₁ p q xx yy ⇒ δ 𝑖 ⇒
-    pirr (xx @𝑖) (yy @𝑖)
-         (coe (𝑗 ⇒ P (xx @𝑗) (yy @𝑗)) @0 @𝑖 p)
-         (coe (𝑗 ⇒ P (xx @𝑗) (yy @𝑗)) @1 @𝑖 q) @𝑖
-
-
-def0 sub-eq : (A : ★) → (P : A → ★) → Irr1 A P →
-              (x y : Sub A P) → fst x ≡ fst y : A → x ≡ y : Sub A P =
-  λ A P pirr x y xy0 ⇒ δ 𝑖 ⇒
-    let proof = proof A P in
-    (xy0 @𝑖, [irr1-het A P pirr (fst x) (fst y) (proof x) (proof y) xy0 @𝑖])
-
-
-def eq? : 0.(A : ★) → 0.(P : A → ★) → 0.(Irr1 A P) →
-          DecEq A → DecEq (Sub A P) =
-  λ A P pirr aeq? s t ⇒
-    let0 EQ : ★ = s ≡ t : Sub A P in
-    dec.elim (fst s ≡ fst t : A) (λ _ ⇒ Dec EQ)
-      (λ y ⇒ Yes EQ (sub-eq A P pirr s t y))
-      (λ n ⇒ No  EQ (λ eq ⇒ n (δ 𝑖 ⇒ fst (eq @𝑖))))
-      (aeq? (fst s) (fst t))
-
-}
-
-def0 Sub = sub.Sub
diff --git a/syntax.ebnf b/syntax.ebnf
index 1296129..7531d2a 100644
--- a/syntax.ebnf
+++ b/syntax.ebnf
@@ -24,7 +24,7 @@ dim arg = "@", dim.
 
 pat var = NAME | "_".
 
-term = lambda | pi | sigma | ann | let.
+term = lambda | case | pi | w | sigma | ann.
 
 lambda = ("λ" | "δ"), {pat var}+, "⇒", term.
 
@@ -39,28 +39,27 @@ pattern = "zero" | "0"
             (* default qty for IH is 1 *)
         | TAG
         | "[", pat var, "]"
-        | "(", pat var, ",", pat var, ")".
+        | "(", pat var, ",", pat var, ")"
+        | pat var, "⋄", pat var, [",", [qty, "."], pat var].
 
 (* default qty is 1 *)
 pi = [qty, "."], (binder | term arg), "→", term.
 binder = "(", {NAME}+, ":", term, ")".
 
+w = binder, "⊲", ann.
+
 sigma = (binder | ann), "×", (sigma | ann).
 
 ann = infix eq, ["∷", term].
 
-bare let binder = pat var, "=", term.
-qty let binder = [qty, "."], bare let binder.
+infix eq = sup term, ["≡", term, ":", sup term]. (* dependent is below *)
 
-let = ("let0" | "let1" | "letω"), {bare let binder / ";"}+, "in", term
-    | "let", {qty let binder / ";"}+, "in", term.
+sup term = app term, ["⋄", app term].
 
-infix eq = app term, ["≡", term, ":", app term]. (* dependent is below *)
-
-app term       = coe | comp | split universe | dep eq | special app | normal app.
+app term       = coe | comp | split universe | dep eq | succ | normal app.
 split universe = "★", NAT.
 dep eq         = "Eq", type line, term arg, term arg.
-special app    = ("fst" | "snd" | "succ"), {term arg}+.
+succ           = "succ", term arg.
 normal app     = term arg, {term arg | dim arg}.
 
 (* direction defaults to @0 @1 *)
@@ -82,5 +81,4 @@ term arg = UNIVERSE | "★", SUPER
          | "zero"
          | NAT
          | QNAME, displacement
-         | "(", {term / ","}+, [","], ")"
-         | case.
+         | "(", {term / ","}+, [","], ")".
diff --git a/tests/AstExtra.idr b/tests/AstExtra.idr
index 9dfb70a..2528d9a 100644
--- a/tests/AstExtra.idr
+++ b/tests/AstExtra.idr
@@ -4,7 +4,7 @@ import Quox.Syntax
 import Quox.Parser.Syntax
 import Quox.Typing.Context
 
-export prefix 9 ^
+prefix 9 ^
 public export
 (^) : (Loc -> a) -> a
 (^) a = a noLoc
@@ -24,24 +24,10 @@ anys : {n : Nat} -> QContext n
 anys {n = 0}   = [<]
 anys {n = S n} = anys :< Any
 
-public export
-locals : Context (Term d) n -> Context (LocalVar d) n
-locals = map $ \t => MkLocal t Nothing
-
 public export
 ctx, ctx01 : {n : Nat} -> Context (\n => (BindName, Term 0 n)) n ->
              TyContext 0 n
 ctx tel = let (ns, ts) = unzip tel in
-          MkTyContext new [<] (locals ts) ns anys
+          MkTyContext new [<] ts ns anys
 ctx01 tel = let (ns, ts) = unzip tel in
-            MkTyContext ZeroIsOne [<] (locals ts) ns anys
-
-export
-mkDef : GQty -> Term 0 0 -> Term 0 0 -> Definition
-mkDef q ty tm = Definition.mkDef q ty tm Nothing False noLoc
-%hide Definition.mkDef
-
-export
-mkPostulate : GQty -> Term 0 0 -> Definition
-mkPostulate q ty = Definition.mkPostulate q ty Nothing False noLoc
-%hide Definition.mkPostulate
+            MkTyContext ZeroIsOne [<] ts ns anys
diff --git a/tests/Tests.idr b/tests/Tests.idr
index 5159893..7d87a97 100644
--- a/tests/Tests.idr
+++ b/tests/Tests.idr
@@ -2,7 +2,6 @@ module Tests
 
 import TAP
 import Tests.DimEq
-import Tests.FreeVars
 import Tests.Reduce
 import Tests.Equal
 import Tests.Typechecker
@@ -16,7 +15,6 @@ import System
 allTests : List Test
 allTests = [
   DimEq.tests,
-  FreeVars.tests,
   Reduce.tests,
   Equal.tests,
   Typechecker.tests,
diff --git a/tests/Tests/DimEq.idr b/tests/Tests/DimEq.idr
index c48729e..b96f7c4 100644
--- a/tests/Tests/DimEq.idr
+++ b/tests/Tests/DimEq.idr
@@ -30,13 +30,13 @@ testPrettyD ds eqs str {label} =
 private
 testWf : BContext d -> DimEq d -> Test
 testWf ds eqs =
-  test (prettySquash (prettyDimEq_ ds) Unicode eqs ++ " ⊢ ✓") $
+  test (prettySquash (prettyDimEq_ ds) Unicode eqs ++ "⊢ ✓") $
     unless (wf eqs) $ Left ()
 
 private
 testNwf : BContext d -> DimEq d -> Test
 testNwf ds eqs =
-  test (prettySquash (prettyDimEq_ ds) Unicode eqs ++ " ⊢ ✗") $
+  test (prettySquash (prettyDimEq_ ds) Unicode eqs ++ "⊢ ✗") $
     when (wf eqs) $ Left ()
 
 
diff --git a/tests/Tests/Equal.idr b/tests/Tests/Equal.idr
index efd1b33..1965421 100644
--- a/tests/Tests/Equal.idr
+++ b/tests/Tests/Equal.idr
@@ -2,7 +2,6 @@ module Tests.Equal
 
 import Quox.Equal
 import Quox.Typechecker
-import Control.Monad.ST
 import public TypingImpls
 import TAP
 import Quox.EffExtra
@@ -11,37 +10,37 @@ import AstExtra
 
 defGlobals : Definitions
 defGlobals = fromList
-  [("A", mkPostulate GZero (^TYPE 0)),
-   ("B", mkPostulate GZero (^TYPE 0)),
-   ("a", mkPostulate GAny (^FT "A" 0)),
-   ("a'", mkPostulate GAny (^FT "A" 0)),
-   ("b", mkPostulate GAny (^FT "B" 0)),
-   ("f", mkPostulate GAny (^Arr One (^FT "A" 0) (^FT "A" 0))),
-   ("id", mkDef GAny (^Arr One (^FT "A" 0) (^FT "A" 0)) (^LamY "x" (^BVT 0))),
-   ("eq-AB", mkPostulate GZero (^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0))),
-   ("two", mkDef GAny (^NAT) (^Succ (^Succ (^Zero))))]
+  [("A", ^mkPostulate gzero (^TYPE 0)),
+   ("B", ^mkPostulate gzero (^TYPE 0)),
+   ("a", ^mkPostulate gany (^FT "A" 0)),
+   ("a'", ^mkPostulate gany (^FT "A" 0)),
+   ("b", ^mkPostulate gany (^FT "B" 0)),
+   ("f", ^mkPostulate gany (^Arr One (^FT "A" 0) (^FT "A" 0))),
+   ("absurd", ^mkDef gany (^Arr One (^enum []) (^FT "A" 0))
+      (^LamY "v" (E $ ^caseEnum One (^BV 0) (SN $ ^FT "A" 0) []))),
+   ("id", ^mkDef gany (^Arr One (^FT "A" 0) (^FT "A" 0)) (^LamY "x" (^BVT 0))),
+   ("eq-AB", ^mkPostulate gzero (^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0))),
+   ("two", ^mkDef gany (^Nat) (^Succ (^Succ (^Zero))))]
 
-parameters (label : String) (act : Eff Equal ())
+parameters (label : String) (act : Equal ())
            {default defGlobals globals : Definitions}
   testEq : Test
   testEq = test label $ runEqual globals act
 
   testNeq : Test
-  testNeq = testThrows label (const True) $ runTC globals act $> "ok"
+  testNeq = testThrows label (const True) $ runTC globals act $> "()"
 
 
 parameters (ctx : TyContext d n)
-  subT, equalT : {default SOne sg : SQty} ->
-                 Term d n -> Term d n -> Term d n -> Eff TC ()
-  subT ty s t {sg} = lift $ Term.sub noLoc ctx sg ty s t
-  equalT ty s t {sg} = lift $ Term.equal noLoc ctx sg ty s t
-  equalTy : Term d n -> Term d n -> Eff TC ()
+  subT, equalT : Term d n -> Term d n -> Term d n -> TC ()
+  subT ty s t = lift $ Term.sub noLoc ctx ty s t
+  equalT ty s t = lift $ Term.equal noLoc ctx ty s t
+  equalTy : Term d n -> Term d n -> TC ()
   equalTy s t = lift $ Term.equalType noLoc ctx s t
 
-  subE, equalE : {default SOne sg : SQty} ->
-                 Elim d n -> Elim d n -> Eff TC ()
-  subE e f {sg} = lift $ Elim.sub noLoc ctx sg e f
-  equalE e f {sg} = lift $ Elim.equal noLoc ctx sg e f
+  subE, equalE : Elim d n -> Elim d n -> TC ()
+  subE e f = lift $ Elim.sub noLoc ctx e f
+  equalE e f = lift $ Elim.equal noLoc ctx e f
 
 
 export
@@ -49,7 +48,6 @@ tests : Test
 tests = "equality & subtyping" :- [
   note #""s{t,…}" for term substs; "s‹p,…›" for dim substs"#,
   note #""0=1 ⊢ 𝒥" means that 𝒥 holds in an inconsistent dim context"#,
-  note "binds before ∥ are globals, after it are BVs",
 
   "universes" :- [
     testEq "★₀ = ★₀" $
@@ -155,7 +153,7 @@ tests = "equality & subtyping" :- [
       let tm = ^Eq0 (^TYPE 1) (^TYPE 0) (^TYPE 0) in
       equalT empty (^TYPE 2) tm tm,
     testEq "A ≔ ★₁ ⊢ (★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : A)"
-        {globals = fromList [("A", mkDef GZero (^TYPE 2) (^TYPE 1))]} $
+        {globals = fromList [("A", ^mkDef gzero (^TYPE 2) (^TYPE 1))]} $
       equalT empty (^TYPE 2)
         (^Eq0 (^TYPE 1) (^TYPE 0) (^TYPE 0))
         (^Eq0 (^FT "A" 0) (^TYPE 0) (^TYPE 0)),
@@ -167,6 +165,7 @@ tests = "equality & subtyping" :- [
       refl a x = ^Ann (^DLam (SN x)) (^Eq0 a x x)
   in
   [
+    note "binds before ∥ are globals, after it are BVs",
     note #"refl A x is an abbreviation for "(δ i ⇒ x) ∷ (x ≡ x : A)""#,
     testEq "refl A a = refl A a" $
       equalE empty
@@ -175,7 +174,7 @@ tests = "equality & subtyping" :- [
 
     testEq "p : (a ≡ a' : A), q : (a ≡ a' : A) ∥ ⊢ p = q  (free)"
            {globals =
-              let def = mkPostulate GZero
+              let def = ^mkPostulate gzero
                           (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))
               in defGlobals `mergeLeft` fromList [("p", def), ("q", def)]} $
       equalE empty (^F "p" 0) (^F "q" 0),
@@ -194,32 +193,32 @@ tests = "equality & subtyping" :- [
 
     testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : EE ⊢ x = y"
            {globals = defGlobals `mergeLeft` fromList
-              [("E", mkDef GZero (^TYPE 0)
+              [("E", ^mkDef gzero (^TYPE 0)
                         (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))),
-               ("EE", mkDef GZero (^TYPE 0) (^FT "E" 0))]} $
+               ("EE", ^mkDef gzero (^TYPE 0) (^FT "E" 0))]} $
       equalE
         (extendTyN [< (Any, "x", ^FT "EE" 0), (Any, "y", ^FT "EE" 0)] empty)
         (^BV 0) (^BV 1),
 
     testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : E ⊢ x = y"
            {globals = defGlobals `mergeLeft` fromList
-              [("E", mkDef GZero (^TYPE 0)
+              [("E", ^mkDef gzero (^TYPE 0)
                         (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))),
-               ("EE", mkDef GZero (^TYPE 0) (^FT "E" 0))]} $
+               ("EE", ^mkDef gzero (^TYPE 0) (^FT "E" 0))]} $
       equalE
         (extendTyN [< (Any, "x", ^FT "EE" 0), (Any, "y", ^FT "E" 0)] empty)
         (^BV 0) (^BV 1),
 
     testEq "E ≔ a ≡ a' : A ∥ x : E, y : E ⊢ x = y"
            {globals = defGlobals `mergeLeft` fromList
-              [("E", mkDef GZero (^TYPE 0)
+              [("E", ^mkDef gzero (^TYPE 0)
                         (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0)))]} $
       equalE (extendTyN [< (Any, "x", ^FT "E" 0), (Any, "y", ^FT "E" 0)] empty)
         (^BV 0) (^BV 1),
 
     testEq "E ≔ a ≡ a' : A ∥ x : (E×E), y : (E×E) ⊢ x = y"
            {globals = defGlobals `mergeLeft` fromList
-              [("E", mkDef GZero (^TYPE 0)
+              [("E", ^mkDef gzero (^TYPE 0)
                         (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0)))]} $
       let ty : forall n. Term 0 n := ^Sig (^FT "E" 0) (SN $ ^FT "E" 0) in
       equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
@@ -227,9 +226,9 @@ tests = "equality & subtyping" :- [
 
     testEq "E ≔ a ≡ a' : A, W ≔ E × E ∥ x : W, y : E×E ⊢ x = y"
            {globals = defGlobals `mergeLeft` fromList
-              [("E", mkDef GZero (^TYPE 0)
+              [("E", ^mkDef gzero (^TYPE 0)
                       (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))),
-               ("W", mkDef GZero (^TYPE 0) (^And (^FT "E" 0) (^FT "E" 0)))]} $
+               ("W", ^mkDef gzero (^TYPE 0) (^And (^FT "E" 0) (^FT "E" 0)))]} $
       equalE
         (extendTyN [< (Any, "x", ^FT "W" 0),
                       (Any, "y", ^And (^FT "E" 0) (^FT "E" 0))] empty)
@@ -279,11 +278,11 @@ tests = "equality & subtyping" :- [
 
   "free var" :-
   let au_bu = fromList
-        [("A", mkDef GAny (^TYPE 1) (^TYPE 0)),
-         ("B", mkDef GAny (^TYPE 1) (^TYPE 0))]
+        [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
+         ("B", ^mkDef gany (^TYPE 1) (^TYPE 0))]
       au_ba = fromList
-        [("A", mkDef GAny (^TYPE 1) (^TYPE 0)),
-         ("B", mkDef GAny (^TYPE 1) (^FT "A" 0))]
+        [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
+         ("B", ^mkDef gany (^TYPE 1) (^FT "A" 0))]
   in [
     testEq "A = A" $
       equalE empty (^F "A" 0) (^F "A" 0),
@@ -304,13 +303,13 @@ tests = "equality & subtyping" :- [
     testNeq "A ≮: B" $
       subE empty (^F "A" 0) (^F "B" 0),
     testEq "A : ★₃ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
-        {globals = fromList [("A", mkDef GAny (^TYPE 3) (^TYPE 0)),
-                             ("B", mkDef GAny (^TYPE 3) (^TYPE 2))]} $
+        {globals = fromList [("A", ^mkDef gany (^TYPE 3) (^TYPE 0)),
+                             ("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
       subE empty (^F "A" 0) (^F "B" 0),
     note "(A and B in different universes)",
     testEq "A : ★₁ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
-        {globals = fromList [("A", mkDef GAny (^TYPE 1) (^TYPE 0)),
-                             ("B", mkDef GAny (^TYPE 3) (^TYPE 2))]} $
+        {globals = fromList [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
+                             ("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
       subE empty (^F "A" 0) (^F "B" 0),
     testEq "0=1 ⊢ A <: B" $
       subE empty01 (^F "A" 0) (^F "B" 0)
@@ -447,30 +446,30 @@ tests = "equality & subtyping" :- [
   ],
 
   "natural type" :- [
-    testEq "ℕ = ℕ" $ equalTy empty (^NAT) (^NAT),
-    testEq "ℕ = ℕ : ★₀" $ equalT empty (^TYPE 0) (^NAT) (^NAT),
-    testEq "ℕ = ℕ : ★₆₉" $ equalT empty (^TYPE 69) (^NAT) (^NAT),
-    testNeq "ℕ ≠ {}" $ equalTy empty (^NAT) (^enum []),
-    testEq "0=1 ⊢ ℕ = {}" $ equalTy empty01 (^NAT) (^enum [])
+    testEq "ℕ = ℕ" $ equalTy empty (^Nat) (^Nat),
+    testEq "ℕ = ℕ : ★₀" $ equalT empty (^TYPE 0) (^Nat) (^Nat),
+    testEq "ℕ = ℕ : ★₆₉" $ equalT empty (^TYPE 69) (^Nat) (^Nat),
+    testNeq "ℕ ≠ {}" $ equalTy empty (^Nat) (^enum []),
+    testEq "0=1 ⊢ ℕ = {}" $ equalTy empty01 (^Nat) (^enum [])
   ],
 
   "natural numbers" :- [
-    testEq "0 = 0" $ equalT empty (^NAT) (^Zero) (^Zero),
+    testEq "0 = 0" $ equalT empty (^Nat) (^Zero) (^Zero),
     testEq "succ two = succ two" $
-      equalT empty (^NAT) (^Succ (^FT "two" 0)) (^Succ (^FT "two" 0)),
+      equalT empty (^Nat) (^Succ (^FT "two" 0)) (^Succ (^FT "two" 0)),
     testNeq "succ two ≠ two" $
-      equalT empty (^NAT) (^Succ (^FT "two" 0)) (^FT "two" 0),
+      equalT empty (^Nat) (^Succ (^FT "two" 0)) (^FT "two" 0),
     testNeq "0 ≠ 1" $
-      equalT empty (^NAT) (^Zero) (^Succ (^Zero)),
+      equalT empty (^Nat) (^Zero) (^Succ (^Zero)),
     testEq "0=1 ⊢ 0 = 1" $
-      equalT empty01 (^NAT) (^Zero) (^Succ (^Zero))
+      equalT empty01 (^Nat) (^Zero) (^Succ (^Zero))
   ],
 
   "natural elim" :- [
     testEq "caseω 0 return {a,b} of {zero ⇒ 'a; succ _ ⇒ 'b} = 'a" $
       equalT empty
         (^enum ["a", "b"])
-        (E $ ^CaseNat Any Zero (^Ann (^Zero) (^NAT))
+        (E $ ^CaseNat Any Zero (^Ann (^Zero) (^Nat))
           (SN $ ^enum ["a", "b"])
           (^Tag "a")
           (SN $ ^Tag "b"))
@@ -478,19 +477,19 @@ tests = "equality & subtyping" :- [
     testEq "caseω 1 return {a,b} of {zero ⇒ 'a; succ _ ⇒ 'b} = 'b" $
       equalT empty
         (^enum ["a", "b"])
-        (E $ ^CaseNat Any Zero (^Ann (^Succ (^Zero)) (^NAT))
+        (E $ ^CaseNat Any Zero (^Ann (^Succ (^Zero)) (^Nat))
           (SN $ ^enum ["a", "b"])
           (^Tag "a")
           (SN $ ^Tag "b"))
         (^Tag "b"),
     testEq "caseω 4 return ℕ of {0 ⇒ 0; succ n ⇒ n} = 3" $
       equalT empty
-        (^NAT)
-        (E $ ^CaseNat Any Zero (^Ann (^Nat 4) (^NAT))
-          (SN $ ^NAT)
+        (^Nat)
+        (E $ ^CaseNat Any Zero (^Ann (^makeNat 4) (^Nat))
+          (SN $ ^Nat)
           (^Zero)
           (SY [< "n", ^BN Unused] $ ^BVT 1))
-        (^Nat 3)
+        (^makeNat 3)
   ],
 
   todo "pair types",
@@ -513,62 +512,32 @@ tests = "equality & subtyping" :- [
         (^Pair (^Tag "b") (^Tag "a")),
     testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : ℕ" $
       equalT empty01
-        (^NAT)
+        (^Nat)
         (^Pair (^Tag "a") (^Tag "b"))
         (^Pair (^Tag "b") (^Tag "a"))
   ],
 
   todo "pair elim",
 
+  todo "w types",
+
+  "sup" :- [
+    testEq "a ⋄ absurd ≡ a ⋄ absurd : A ⊲ {}" $
+      equalT empty
+        (^W (^FT "A" 0) (SN $ ^enum []))
+        (^Sup (^FT "a" 0) (^FT "absurd" 0))
+        (^Sup (^FT "a" 0) (^FT "absurd" 0))
+  ],
+
+  todo "w elim",
+
   todo "enum types",
   todo "enum",
   todo "enum elim",
 
-  "box types" :- [
-    testEq "[1.A] = [1.A] : ★" $
-      equalT empty
-        (^TYPE 0)
-        (^BOX One (^FT "A" 0))
-        (^BOX One (^FT "A" 0)),
-    testNeq "[1.A] ≠ [ω.A] : ★" $
-      equalT empty
-        (^TYPE 0)
-        (^BOX One (^FT "A" 0))
-        (^BOX Any (^FT "A" 0)),
-    testNeq "[1.A] ≠ [1.B] : ★" $
-      equalT empty
-        (^TYPE 0)
-        (^BOX One (^FT "A" 0))
-        (^BOX One (^FT "B" 0)),
-    testNeq "[1.A] ≠ A : ★" $
-      equalT empty
-        (^TYPE 0)
-        (^BOX One (^FT "A" 0))
-        (^FT "A" 0),
-    testEq "0=1 ⊢ [1.A] = [1.B] : ★" $
-      equalT empty01
-        (^TYPE 0)
-        (^BOX One (^FT "A" 0))
-        (^BOX One (^FT "B" 0))
-  ],
-
-  "boxes" :- [
-    testEq "[a] = [a] : [ω.A]" $
-      equalT empty
-        (^BOX Any (^FT "A" 0))
-        (^Box (^FT "a" 0))
-        (^Box (^FT "a" 0)),
-    testNeq "[a] ≠ [a'] : [ω.A]" $
-      equalT empty
-        (^BOX Any (^FT "A" 0))
-        (^Box (^FT "a" 0))
-        (^Box (^FT "a'" 0)),
-    testEq "ω.x : [ω.A] ⊢ x = [case1 b return A of {[y] ⇒ y}] : [ω.A]" $
-      equalT (ctx [< ("x", ^BOX Any (^FT "A" 0))])
-        (^BOX Any (^FT "A" 0))
-        (^BVT 0)
-        (^Box (E $ ^CaseBox One (^BV 0) (SN $ ^FT "A" 0) (SY [< "y"] (^BVT 0))))
-  ],
+  todo "box types",
+  todo "boxes",
+  todo "box elim",
 
   "elim closure" :- [
     note "bold numbers for de bruijn indices",
diff --git a/tests/Tests/FreeVars.idr b/tests/Tests/FreeVars.idr
deleted file mode 100644
index a51ab9d..0000000
--- a/tests/Tests/FreeVars.idr
+++ /dev/null
@@ -1,105 +0,0 @@
-module Tests.FreeVars
-
-import Quox.Pretty
-import Quox.Syntax
-import Quox.FreeVars
-import AstExtra
-import TAP
-import Derive.Prelude
-
-%language ElabReflection
-
-
-private
-data FailureType = Dim | Term
-%runElab derive "FailureType" [Show]
-
-private
-record Failure where
-  constructor Fail
-  type : FailureType
-  expected, got : FreeVars n
-
-private
-ToInfo Failure where
-  toInfo f = [("type",     show f.type),
-              ("expected", show f.expected),
-              ("got",      show f.got)]
-
-private
-testFreeVars : {d, n : Nat} -> (HasFreeVars (f d), HasFreeDVars f) =>
-               (f d n -> String) -> f d n -> FreeVars' d -> FreeVars' n -> Test
-testFreeVars lbl tm dims terms =
-  test (lbl tm) $ do
-    let dims  = FV dims; terms  = FV terms
-        dims' = fdv tm;  terms' = fv tm
-    unless (dims  == dims')  $ Left $ Fail Dim  dims  dims'
-    unless (terms == terms') $ Left $ Fail Term terms terms'
-    Right ()
-
-private
-Doc80 : Type
-Doc80 = Doc $ Opts 80
-
-private
-prettyWith : (a -> Eff Pretty Doc80) -> a -> String
-prettyWith f = trim . render _ . runPretty . f
-
-parameters {d, n : Nat} (ds : BContext d) (ts : BContext n)
-  private
-  withContext : Doc80 -> Eff Pretty Doc80
-  withContext doc =
-    if null ds && null ts then pure $ hsep ["⊢", doc]
-    else pure $ sep [hsep [!(ctx1 ds), "|", !(ctx1 ts), "⊢"], doc]
-  where
-    ctx1 : forall k. BContext k -> Eff Pretty Doc80
-    ctx1 [<] = pure "·"
-    ctx1 ctx = fillSeparateTight !commaD . toList' <$>
-               traverse' (pure . prettyBind') ctx
-
-  private
-  testFreeVarsT : Term d n -> FreeVars' d -> FreeVars' n -> Test
-  testFreeVarsT = testFreeVars $ prettyWith $ withContext <=< prettyTerm ds ts
-
-  private
-  testFreeVarsE : Elim d n -> FreeVars' d -> FreeVars' n -> Test
-  testFreeVarsE = testFreeVars $ prettyWith $ withContext <=< prettyElim ds ts
-
-export
-tests : Test
-tests = "free variables" :- [
-  testFreeVarsT [<] [<] (^TYPE 0) [<] [<],
-  testFreeVarsT [<"i", "j"] [<] (^TYPE 0) [<False, False] [<],
-  testFreeVarsT [<] [<"x", "y"] (^TYPE 0) [<] [<False, False],
-  testFreeVarsT [<"i"] [<"x"] (^TYPE 0) [<False] [<False],
-
-  testFreeVarsE [<] [<] (^F "f" 0) [<] [<],
-  testFreeVarsE [<] [<] (^F "f" 6) [<] [<],
-  testFreeVarsE [<"i"] [<] (^F "f" 0) [<False] [<],
-  testFreeVarsE [<] [<"x"] (^F "f" 0) [<] [<False],
-
-  testFreeVarsE [<] [<"x"] (^BV 0) [<] [<True],
-  testFreeVarsE [<"i"] [<"x"] (^BV 0) [<False] [<True],
-  testFreeVarsE [<] [<"x","y"] (^BV 1) [<] [<True,False],
-  testFreeVarsE [<] [<"x","y"] (^BV 0) [<] [<False,True],
-  testFreeVarsE [<] [<"x","y","z"] (^BV 1) [<] [<False,True,False],
-
-  testFreeVarsE [<] [<"x","y"] (^App (^BV 1) (^BVT 0)) [<] [<True,True],
-  testFreeVarsE [<] [<"x","y","z"] (^App (^BV 1) (^BVT 0))
-                [<] [<False,True,True],
-  testFreeVarsE [<] [<"x","y"] (^App (^BV 1) (^TYPE 1)) [<] [<True,False],
-
-  testFreeVarsT [<"i"] [<"x"] (^LamY "y" (^BVT 0)) [<False] [<False],
-  testFreeVarsT [<"i"] [<"x"] (^LamN (^BVT 0)) [<False] [<True],
-
-  testFreeVarsE [<"i","j"] [<] (^DApp (^F "eq" 0) (^BV 0)) [<False,True] [<],
-  testFreeVarsE [<"i","j"] [<] (^DApp (^F "eq" 0) (^BV 1)) [<True,False] [<],
-  testFreeVarsE [<"i","j"] [<] (^DApp (^F "eq" 0) (^K Zero)) [<False,False] [<],
-
-  testFreeVarsT [<"i","j"] [<] (^DLamY "k" (E $ ^DApp (^F "eq" 0) (^BV 0)))
-                [<False,False] [<],
-  testFreeVarsT [<"i","j"] [<] (^DLamN (E $ ^DApp (^F "eq" 0) (^BV 0)))
-                [<False,True] [<],
-
-  todo "others"
-]
diff --git a/tests/Tests/FromPTerm.idr b/tests/Tests/FromPTerm.idr
index 2bbc059..c4202eb 100644
--- a/tests/Tests/FromPTerm.idr
+++ b/tests/Tests/FromPTerm.idr
@@ -16,14 +16,11 @@ import Derive.Prelude
 %hide TParser.Failure
 %hide TParser.ExpectedFail
 
-PError  = Parser.Error
-FPError = FromParser.Error
-
 public export
 data Failure =
-    ParseError   PError
-  | FromParser   FPError
-  | WrongResult  String
+    ParseError Parser.Error
+  | FromParser FromParser.Error
+  | WrongResult String
   | ExpectedFail String
 
 %runElab derive "FileError" [Show]
@@ -42,33 +39,42 @@ ToInfo Failure where
 
 parameters {c : Bool} {auto _ : Show b}
            (grm : FileName -> Grammar c a)
-           (fromP : a -> Either FPError b)
+           (fromP : a -> Either FromParser.Error b)
            (inp : String)
-  parsesWith : String -> (b -> Bool) -> Test
-  parsesWith label p = test label $ do
-    pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
-    res  <- mapFst FromParser $ fromP pres
-    unless (p res) $ Left $ WrongResult $ show res
+  parameters {default (ltrim inp) label : String}
+    parsesWith : (b -> Bool) -> Test
+    parsesWith p = test label $ do
+      pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
+      res  <- mapFst FromParser $ fromP pres
+      unless (p res) $ Left $ WrongResult $ show res
 
-  %macro
-  parseMatch : {default (ltrim inp) label : String} -> TTImp -> Elab Test
-  parseMatch {label} pat =
-    parsesWith label <$> check `(\case ~(pat) => True; _ => False)
+    parses : Test
+    parses = parsesWith $ const True
 
-  parseFails : {default "\{ltrim inp}  # fails" label : String} -> Test
-  parseFails {label} = test label $ do
-    pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
-    either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
+    %macro
+    parseMatch : TTImp -> Elab Test
+    parseMatch pat =
+      parsesWith <$> check `(\case ~(pat) => True; _ => False)
+
+    parsesAs : Eq b => b -> Test
+    parsesAs exp = parsesWith (== exp)
+
+  parameters {default "\{ltrim inp}  # fails" label : String}
+    parseFails : Test
+    parseFails = test label $ do
+      pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
+      either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
 
 
-runFromParser : Definitions -> Eff FromParserPure a -> Either FPError a
-runFromParser defs = map val . fromParserPure [<] 0 defs initStack
+runFromParser : {default empty defs : Definitions} ->
+                Eff FromParserPure a -> Either FromParser.Error a
+runFromParser = map fst . fst . fromParserPure 0 defs
 
 export
 tests : Test
 tests = "PTerm → Term" :- [
   "dimensions" :-
-  let fromPDim = runFromParser empty . fromPDimWith [< "𝑖", "𝑗"]
+  let fromPDim = runFromParser . fromPDimWith [< "𝑖", "𝑗"]
   in [
     note "dim ctx: [𝑖, 𝑗]",
     parseMatch dim fromPDim "𝑖" `(B (VS VZ) _),
@@ -79,9 +85,9 @@ tests = "PTerm → Term" :- [
   ],
 
   "terms" :-
-  let defs = fromList [("f", mkDef GAny (^NAT) (^Zero))]
+  let defs = fromList [("f", mkDef gany (Nat noLoc) (Zero noLoc) noLoc)]
         -- doesn't have to be well typed yet, just well scoped
-      fromPTerm = runFromParser defs .
+      fromPTerm = runFromParser {defs} .
                   fromPTermWith [< "𝑖", "𝑗"] [< "A", "x", "y", "z"]
   in [
     note "dim ctx: [𝑖, 𝑗]; term ctx: [A, x, y, z]",
@@ -91,7 +97,7 @@ tests = "PTerm → Term" :- [
     parseMatch term fromPTerm "λ w ⇒ w"
       `(Lam (S _ $ Y $ E $ B VZ _) _),
     parseMatch term fromPTerm "λ w ⇒ x"
-      `(Lam (S _ $ Y $ E $ B (VS $ VS $ VS VZ) _) _),
+      `(Lam (S _ $ N $ E $ B (VS $ VS VZ) _) _),
     parseMatch term fromPTerm "λ x ⇒ x"
       `(Lam (S _ $ Y $ E $ B VZ _) _),
     parseMatch term fromPTerm "λ a b ⇒ f a b"
diff --git a/tests/Tests/Lexer.idr b/tests/Tests/Lexer.idr
index 40fd9a8..7823d5d 100644
--- a/tests/Tests/Lexer.idr
+++ b/tests/Tests/Lexer.idr
@@ -47,12 +47,7 @@ tests = "lexer" :- [
     lexes "    " [],
     lexes "-- line comment" [],
     lexes "name -- line comment" [Name "name"],
-    lexes
-      """
-      -- line comment
-      nameBetween -- and another
-      """
-      [Name "nameBetween"],
+    lexes "-- line comment\nnameBetween -- and another" [Name "nameBetween"],
     lexes "{- block comment -}" [],
     lexes "{- {- nested -} block comment -}" []
   ],
@@ -71,18 +66,17 @@ tests = "lexer" :- [
     lexes "δελτα" [Name "δελτα"],
     lexes "★★" [Name "★★"],
     lexes "Types" [Name "Types"],
-    lexes "a.b.c.d.e" [Name $ MkPName [< "a","b","c","d"] "e"],
+    lexes "a.b.c.d.e" [Name $ MakePName [< "a","b","c","d"] "e"],
     lexes "normalïse" [Name "normalïse"],
       -- ↑ replace i + combining ¨ with precomposed ï
     lexes "map#" [Name "map#"],
-    lexes "map#[" [Name "map#", Reserved "["], -- don't actually do this
-    lexes "map #[" [Name "map", Reserved "#["],
     lexes "write!" [Name "write!"],
     lexes "uhh??!?!?!?" [Name "uhh??!?!?!?"],
 
-    lexFail "abc.fun.ghi",
-    lexFail "abc.λ.ghi",
-    lexFail "abc.ω.ghi",
+    todo "check for reserved words in a qname",
+    skip $
+    lexes "abc.fun.def"
+      [Name "abc", Reserved ".", Reserved "λ", Reserved ".", Name "def"],
 
     lexes "+" [Name "+"],
     lexes "*" [Name "*"],
@@ -90,16 +84,16 @@ tests = "lexer" :- [
     lexes "***" [Name "***"],
     lexes "+**" [Name "+**"],
     lexes "+#" [Name "+#"],
-    lexes "+.+.+" [Name $ MkPName [< "+", "+"] "+"],
-    lexes "a.+" [Name $ MkPName [< "a"] "+"],
-    lexes "+.a" [Name $ MkPName [< "+"] "a"],
+    lexes "+.+.+" [Name $ MakePName [< "+", "+"] "+"],
+    lexes "a.+" [Name $ MakePName [< "a"] "+"],
+    lexes "+.a" [Name $ MakePName [< "+"] "a"],
 
     lexes "+a" [Name "+", Name "a"],
 
     lexes "x." [Name "x", Reserved "."],
     lexes "&." [Name "&", Reserved "."],
     lexes ".x" [Reserved ".", Name "x"],
-    lexes "a.b.c." [Name $ MkPName [< "a", "b"] "c", Reserved "."],
+    lexes "a.b.c." [Name $ MakePName [< "a", "b"] "c", Reserved "."],
 
     lexes "case" [Reserved "case"],
     lexes "caseω" [Reserved "caseω"],
@@ -108,13 +102,6 @@ tests = "lexer" :- [
     lexes "case0" [Reserved "case0"],
     lexes "case##" [Name "case##"],
 
-    lexes "let" [Reserved "let"],
-    lexes "letω" [Reserved "letω"],
-    lexes "let#" [Reserved "letω"],
-    lexes "let1" [Reserved "let1"],
-    lexes "let0" [Reserved "let0"],
-    lexes "let##" [Name "let##"],
-
     lexes "_" [Reserved "_"],
     lexes "_a" [Name "_a"],
     lexes "a_" [Name "a_"],
@@ -155,31 +142,15 @@ tests = "lexer" :- [
   ],
 
   "strings" :- [
-    lexes   #" ""          "# [Str ""],
-    lexes   #" "abc"       "# [Str "abc"],
-    lexes   #" "\""        "# [Str "\""],
-    lexes   #" "\\"        "# [Str "\\"],
-    lexes   #" "\\\""      "# [Str "\\\""],
-    lexes   #" "\t"        "# [Str "\t"],
-    lexes   #" "\n"        "# [Str "\n"],
-    lexes   #" "🐉"        "# [Str "🐉"],
-    lexes   #" "\x1f409;"  "# [Str "🐉"],
-    lexFail #" "\q"        "#,
-    lexFail #" "\"         "#
+    lexes #" "" "# [Str ""],
+    lexes #" "abc" "# [Str "abc"],
+    lexes #" "\"" "# [Str "\""],
+    lexes #" "\\" "# [Str "\\"],
+    lexes #" "\\\"" "# [Str "\\\""],
+    todo "other escapes"
   ],
 
-  "naturals" :- [
-    lexes   "0"           [Nat 0],
-    lexes   "123"         [Nat 123],
-    lexes   "69_420"      [Nat 69420],
-    lexes   "0x123"       [Nat 0x123],
-    lexes   "0xbeef"      [Nat 0xbeef],
-    lexes   "0xBEEF"      [Nat 0xBEEF],
-    lexes   "0XBEEF"      [Nat 0xBEEF],
-    lexes   "0xbaba_baba" [Nat 0xbabababa],
-    lexFail "123abc",
-    lexFail "0x123abcghi"
-  ],
+  todo "naturals",
 
   "universes" :- [
     lexes "Type0" [TYPE 0],
diff --git a/tests/Tests/Parser.idr b/tests/Tests/Parser.idr
index 7bbca5d..97a11dc 100644
--- a/tests/Tests/Parser.idr
+++ b/tests/Tests/Parser.idr
@@ -63,9 +63,9 @@ tests = "parser" :- [
 
   "names" :- [
     parsesAs (const qname) "x"
-      (MkPName [<] "x"),
-    parsesAs (const qname) "Data.List.length"
-      (MkPName [< "Data", "List"] "length"),
+      (MakePName [<] "x"),
+    parsesAs (const qname) "Data.String.length"
+      (MakePName [< "Data", "String"] "length"),
     parseFails (const qname) "_"
   ],
 
@@ -124,7 +124,7 @@ tests = "parser" :- [
     parseMatch term "f"
       `(V "f" {}),
     parseMatch term "f.x.y"
-      `(V (MkPName [< "f", "x"] "y") {}),
+      `(V (MakePName [< "f", "x"] "y") {}),
     parseMatch term "f x"
       `(App (V "f" {}) (V "x" {}) _),
     parseMatch term "f x y"
@@ -138,15 +138,7 @@ tests = "parser" :- [
     parseMatch term "f @p"
       `(DApp (V "f" {}) (V "p" {}) _),
     parseMatch term "f x @p y"
-      `(App (DApp (App (V "f" {}) (V "x" {}) _) (V "p" {}) _) (V "y" {}) _),
-    parseMatch term "fst e"
-      `(Fst (V "e" {}) _),
-    parseMatch term "snd e"
-      `(Snd (V "e" {}) _),
-    parseMatch term "(fst e) x"
-      `(App (Fst (V "e" {}) _) (V "x" {}) _),
-    parseMatch term "fst e x"
-      `(App (Fst (V "e" {}) _) (V "x" {}) _)
+      `(App (DApp (App (V "f" {}) (V "x" {}) _) (V "p" {}) _) (V "y" {}) _)
   ],
 
   "annotations" :- [
@@ -176,6 +168,8 @@ tests = "parser" :- [
           (App (V "B" {}) (V "x" {}) _) _) _),
     parseMatch term "(x : A) → B x"
       `(Pi (PQ One _) (PV "x" _) (V "A" {}) (App (V "B" {}) (V "x" {}) _) _),
+    parseFails term "(x : A) → (y : B x)",
+    parseFails term "(x : A) → 1.(B x)",
     parseMatch term "1.A → B"
       `(Pi (PQ One _) (Unused _) (V "A" {}) (V "B" {}) _),
     parseMatch term "A → B"
@@ -257,6 +251,43 @@ tests = "parser" :- [
     parseFails term "(x,,y)"
   ],
 
+  "w" :- [
+    parseMatch term "(x : A) ⊲ B"
+      `(W (PV "x" _) (V "A" {}) (V "B" {}) _),
+    parseFails term "(x y : A) ⊲ B",
+    parseFails term "1.(x : A) ⊲ B",
+    parseMatch term "(x : A) ⊲ (y : B) ⊲ C"
+      `(W (PV "x" _) (V "A" {})
+        (W (PV "y" _) (V "B" {})  (V "C" {}) _) _),
+    parseMatch term "A ⊲ B"
+      `(W _ (V "A" {}) (V "B" {}) _),
+    parseMatch term "A <| B"
+      `(W _ (V "A" {}) (V "B" {}) _),
+    parseFails term "A ⊲ (y : B)",
+    parseMatch term "(x : A) ⊲ B x × C"
+      `(W (PV "x" _) (V "A" {})
+         (Sig _ (App (V "B" {}) (V "x" {}) _) (V "C" {}) _) _),
+    parseMatch term "A ⊲ B → C"
+      `(Pi _ _ (W _ (V "A" {}) (V "B" {}) _) (V "C" {}) _),
+    parseMatch term "A → B ⊲ C"
+      `(Pi _ _ (V "A" {}) (W _ (V "B" {}) (V "C" {}) _) _)
+  ],
+
+  "sup" :- [
+    parseMatch term "s ⋄ t"
+      `(Sup (V "s" {}) (V "t" {}) _),
+    parseMatch term "s ⋄ t ⋄ u"
+      `(Sup (V "s" {}) (Sup (V "t" {}) (V "u" {}) _) _),
+    parseMatch term "s <> t"
+      `(Sup (V "s" {}) (V "t" {}) _),
+    parseMatch term "a b ⋄ c d"
+      `(Sup (App (V "a" {}) (V "b" {}) _) (App (V "c" {}) (V "d" {}) _) _),
+    parseMatch term "a ⋄ b ≡ a' ⋄ b' : (A ⊲ B)"
+      `(Eq (_, W _ (V "A" {}) (V "B" {}) _)
+           (Sup (V "a"  {}) (V "b"  {}) _)
+           (Sup (V "a'" {}) (V "b'" {}) _) _)
+  ],
+
   "equality type" :- [
     parseMatch term "Eq (i ⇒ A) s t"
       `(Eq (PV "i" _, V "A" {}) (V "s" {}) (V "t" {}) _),
@@ -290,24 +321,29 @@ tests = "parser" :- [
   ],
 
   "naturals" :- [
-    parseMatch term "ℕ" `(NAT _),
-    parseMatch term "Nat" `(NAT _),
-    parseMatch term "zero" `(Nat 0 _),
+    parseMatch term "ℕ" `(Nat _),
+    parseMatch term "Nat" `(Nat _),
+    parseMatch term "zero" `(Zero _),
     parseMatch term "succ n" `(Succ (V "n" {}) _),
-    parseMatch term "3" `(Nat 3 _),
-    parseMatch term "succ (succ 1)" `(Succ (Succ (Nat 1 _) _) _),
+    parseMatch term "3"
+      `(Succ (Succ (Succ (Zero _) _) _) _),
+    parseMatch term "succ (succ 1)"
+      `(Succ (Succ (Succ (Zero _) _) _) _),
     parseFails term "succ succ 5",
     parseFails term "succ"
   ],
 
   "box" :- [
     parseMatch term "[1.ℕ]"
-      `(BOX (PQ One _) (NAT _) _),
+      `(BOX (PQ One _) (Nat _) _),
     parseMatch term "[ω. ℕ × ℕ]"
-      `(BOX (PQ Any _) (Sig (Unused _) (NAT _) (NAT _) _) _),
-    parseMatch term "[a]" `(Box (V "a" {}) _),
-    parseMatch term "[0]" `(Box (Nat 0 _) _),
-    parseMatch term "[1]" `(Box (Nat 1 _) _)
+      `(BOX (PQ Any _) (Sig (Unused _) (Nat _) (Nat _) _) _),
+    parseMatch term "[a]"
+      `(Box (V "a" {}) _),
+    parseMatch term "[0]"
+      `(Box (Zero _) _),
+    parseMatch term "[1]"
+      `(Box (Succ (Zero _) _) _)
   ],
 
   "coe" :- [
@@ -391,191 +427,84 @@ tests = "parser" :- [
       `(Case (PQ Any _) (V "n" {}) (Unused _, V "A" {})
         (CaseNat (V "a" {}) (PV "n'" _, PQ Zero _, Unused _, V "b" {}) _) _),
     parseMatch term "caseω n return ℕ of { succ _, 1.ih ⇒ ih; zero ⇒ 0; }"
-      `(Case (PQ Any _) (V "n" {}) (Unused _, NAT _)
-        (CaseNat (Nat 0 _) (Unused _, PQ One _, PV "ih" _, V "ih" {}) _) _),
+      `(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
+        (CaseNat (Zero _) (Unused _, PQ One _, PV "ih" _, V "ih" {}) _) _),
     parseMatch term "caseω n return ℕ of { succ _, ω.ih ⇒ ih; zero ⇒ 0; }"
-      `(Case (PQ Any _) (V "n" {}) (Unused _, NAT _)
-        (CaseNat (Nat 0 _) (Unused _, PQ Any _, PV "ih" _, V "ih" {}) _) _),
+      `(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
+        (CaseNat (Zero _) (Unused _, PQ Any _, PV "ih" _, V "ih" {}) _) _),
     parseMatch term "caseω n return ℕ of { succ _, ih ⇒ ih; zero ⇒ 0; }"
-      `(Case (PQ Any _) (V "n" {}) (Unused _, NAT _)
-        (CaseNat (Nat 0 _) (Unused _, PQ One _, PV "ih" _, V "ih" {}) _) _),
+      `(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
+        (CaseNat (Zero _) (Unused _, PQ One _, PV "ih" _, V "ih" {}) _) _),
+    parseMatch term "caseω n return ℕ of { succ _, _ ⇒ ih; zero ⇒ 0; }"
+      `(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
+        (CaseNat (Zero _) (Unused _, PQ Zero _, Unused _, V "ih" {}) _) _),
     parseFails term "caseω n return A of { zero ⇒ a }",
     parseFails term "caseω n return ℕ of { succ ⇒ 5 }",
-    parseMatch term
-      "case1 f s return x ⇒ A x of { (l, r) ⇒ r l } x"
-      `(App
-        (Case (PQ One _) (App (V "f" {}) (V "s" {}) _)
-          (PV "x" _, App (V "A" {}) (V "x" {}) _)
-          (CasePair (PV "l" _, PV "r" _)
-                    (App (V "r" {}) (V "l" {}) _) _) _)
-        (V "x" {}) _)
+    parseMatch term "case e return z ⇒ C of { a ⋄ b, ω.ih ⇒ u }"
+      `(Case (PQ One _) (V "e" {}) (PV "z" _, V "C" {})
+        (CaseW (PV "a" _) (PV "b" _) (PQ Any _, PV "ih" _) (V "u" {}) _) _),
+    parseMatch term "case e return z ⇒ C of { a ⋄ b, ih ⇒ u }"
+      `(Case (PQ One _) (V "e" {}) (PV "z" _, V "C" {})
+        (CaseW (PV "a" _) (PV "b" _) (PQ One _, PV "ih" _) (V "u" {}) _) _),
+    parseMatch term "case e return z ⇒ C of { a ⋄ b ⇒ u }"
+      `(Case (PQ One _) (V "e" {}) (PV "z" _, V "C" {})
+        (CaseW (PV "a" _) (PV "b" _) (PQ Zero _, Unused _) (V "u" {}) _) _),
+    parseMatch term "case e return z ⇒ C of { a ⋄ b, _ ⇒ u }"
+      `(Case (PQ One _) (V "e" {}) (PV "z" _, V "C" {})
+        (CaseW (PV "a" _) (PV "b" _) (PQ Zero _, Unused _) (V "u" {}) _) _)
   ],
 
-  "let" :- [
-    parseMatch term "let x = y in z"
-      `(Let (PQ One _, PV "x" {}, V "y" {}) (V "z" {}) _),
-    parseMatch term "let x = y; in z"
-      `(Let (PQ One _, PV "x" {}, V "y" {}) (V "z" {}) _),
-    parseMatch term "let0 x = y in z"
-      `(Let (PQ Zero _, PV "x" {}, V "y" {}) (V "z" {}) _),
-    parseMatch term "let1 x = y in z"
-      `(Let (PQ One _, PV "x" {}, V "y" {}) (V "z" {}) _),
-    parseMatch term "letω x = y in z"
-      `(Let (PQ Any _, PV "x" {}, V "y" {}) (V "z" {}) _),
-    parseMatch term "letω x : X = y in z"
-      `(Let (PQ Any _, PV "x" {}, Ann (V "y" {}) (V "X" {}) _) (V "z" {}) _),
-    parseMatch term "let ω.x = y in z"
-      `(Let (PQ Any _, PV "x" {}, V "y" {}) (V "z" {}) _),
-    parseMatch term "let x = y1 y2 in z1 z2"
-      `(Let (PQ One _, PV "x" {},
-             (App (V "y1" {}) (V "y2" {}) _))
-          (App (V "z1" {}) (V "z2" {}) _) _),
-    parseMatch term "let x = a in let y = b in z"
-      `(Let (PQ One _, PV "x" {}, V "a" {})
-        (Let (PQ One _, PV "y" {}, V "b" {}) (V "z" {}) _) _),
-    parseMatch term "let x = a; y = b in z"
-      `(Let (PQ One _, PV "x" {}, V "a" {})
-        (Let (PQ One _, PV "y" {}, V "b" {}) (V "z" {}) _) _),
-    parseMatch term "letω x = a; y = b in z"
-      `(Let (PQ Any _, PV "x" {}, V "a" {})
-        (Let (PQ Any _, PV "y" {}, V "b" {}) (V "z" {}) _) _),
-    parseMatch term "letω x = a; y = b; in z"
-      `(Let (PQ Any _, PV "x" {}, V "a" {})
-        (Let (PQ Any _, PV "y" {}, V "b" {}) (V "z" {}) _) _),
-    parseMatch term "let ω.x = a; 1.y = b in z"
-      `(Let (PQ Any _, PV "x" {}, V "a" {})
-        (Let (PQ One _, PV "y" {}, V "b" {}) (V "z" {}) _) _),
-    parseMatch term "let x = y in z ∷ Z"
-      `(Let (PQ One _, PV "x" {}, V "y" {})
-          (Ann (V "z" {}) (V "Z" {}) _) _),
-    parseMatch term "let x = y in z₁ ≡ z₂ : Z"
-      `(Let (PQ One _, PV "x" {}, V "y" {})
-          (Eq (Unused _, V "Z" {}) (V "z₁" {}) (V "z₂" {}) _) _),
-    parseFails term "let1 1.x = y in z",
-    parseFails term "let x = y",
-    parseFails term "let x in z"
-  ],
-
-  "definitions" :-
-  let definition = flip definition [] in [
+  "definitions" :- [
     parseMatch definition "defω x : {a} × {b} = ('a, 'b);"
       `(MkPDef (PQ Any _) "x"
-        (PConcrete
-          (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
-          (Pair (Tag "a" _) (Tag "b" _) _)) _ _ _ _),
+        (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
+        (Pair (Tag "a" _) (Tag "b" _) _) _),
     parseMatch definition "def# x : {a} ** {b} = ('a, 'b)"
       `(MkPDef (PQ Any _) "x"
-        (PConcrete
-          (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
-          (Pair (Tag "a" _) (Tag "b" _) _)) _ _ _ _),
+        (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
+        (Pair (Tag "a" _) (Tag "b" _) _) _),
     parseMatch definition "def ω.x : {a} × {b} = ('a, 'b)"
       `(MkPDef (PQ Any _) "x"
-        (PConcrete
-          (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
-          (Pair (Tag "a" _) (Tag "b" _) _)) _ _ _ _),
+        (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
+        (Pair (Tag "a" _) (Tag "b" _) _) _),
     parseMatch definition "def x : {a} × {b} = ('a, 'b)"
       `(MkPDef (PQ Any _) "x"
-        (PConcrete
-          (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
-          (Pair (Tag "a" _) (Tag "b" _) _)) _ _ _ _),
+        (Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
+        (Pair (Tag "a" _) (Tag "b" _) _) _),
     parseMatch definition "def0 A : ★⁰ = {a, b, c}"
-      `(MkPDef (PQ Zero _) "A"
-          (PConcrete (Just $ TYPE 0 _) (Enum ["a", "b", "c"] _)) _ _ _ _),
-    parseMatch definition "postulate yeah : ℕ"
-      `(MkPDef (PQ Any _) "yeah" (PPostulate (NAT _)) _ _ _ _),
-    parseMatch definition "postulateω yeah : ℕ"
-      `(MkPDef (PQ Any _) "yeah" (PPostulate (NAT _)) _ _ _ _),
-    parseMatch definition "postulate0 FileHandle : ★"
-      `(MkPDef (PQ Zero _) "FileHandle" (PPostulate (TYPE 0 _)) _ _ _ _),
-    parseFails definition "postulate not-a-postulate : ℕ = 69",
-    parseFails definition "postulate not-a-postulate = 69",
-    parseFails definition "def not-a-def : ℕ"
+      `(MkPDef (PQ Zero _) "A" (Just $ TYPE 0 _)
+          (Enum ["a", "b", "c"] _) _)
   ],
 
   "top level" :- [
     parseMatch input "def0 A : ★⁰ = {}; def0 B : ★¹ = A;"
-      `([PD $ PDef $ MkPDef (PQ Zero _) "A"
-            (PConcrete (Just $ TYPE 0 _) (Enum [] _)) PSucceed False Nothing _,
-         PD $ PDef $ MkPDef (PQ Zero _) "B"
-            (PConcrete (Just $ TYPE 1 _) (V "A" {})) PSucceed False Nothing _]),
+      `([PD $ PDef $ MkPDef (PQ Zero _) "A" (Just $ TYPE 0 _) (Enum [] _) _,
+         PD $ PDef $ MkPDef (PQ Zero _) "B" (Just $ TYPE 1 _) (V "A" {}) _]),
     parseMatch input "def0 A : ★⁰ = {} def0 B : ★¹ = A" $
-      `([PD $ PDef $ MkPDef (PQ Zero _) "A"
-            (PConcrete (Just $ TYPE 0 _) (Enum [] _)) PSucceed False Nothing _,
-         PD $ PDef $ MkPDef (PQ Zero _) "B"
-            (PConcrete (Just $ TYPE 1 _) (V "A" {})) PSucceed False Nothing _]),
+      `([PD $ PDef $ MkPDef (PQ Zero _) "A" (Just $ TYPE 0 _) (Enum [] _) _,
+         PD $ PDef $ MkPDef (PQ Zero _) "B" (Just $ TYPE 1 _) (V "A" {}) _]),
     note "empty input",
     parsesAs input "" [],
     parseFails input ";;;;;;;;;;;;;;;;;;;;;;;;;;",
     parseMatch input "namespace a {}"
-      `([PD $ PNs $ MkPNamespace [< "a"] [] PSucceed _]),
+      `([PD $ PNs $ MkPNamespace [< "a"] [] _]),
     parseMatch input "namespace a.b.c {}"
-      `([PD $ PNs $ MkPNamespace [< "a", "b", "c"] [] PSucceed _]),
+      `([PD $ PNs $ MkPNamespace [< "a", "b", "c"] [] _]),
     parseMatch input "namespace a {namespace b {}}"
-      `([PD (PNs $ MkPNamespace [< "a"]
-            [PNs $ MkPNamespace [< "b"] [] PSucceed _] PSucceed _)]),
+      `([PD $ PNs $ MkPNamespace [< "a"] [PNs $ MkPNamespace [< "b"] [] _] _]),
     parseMatch input "namespace a {def x = 't ∷ {t}}"
-      `([PD (PNs $ MkPNamespace [< "a"]
-            [PDef $ MkPDef (PQ Any _) "x"
-              (PConcrete Nothing (Ann (Tag "t" _) (Enum ["t"] _) _))
-              PSucceed False Nothing _]
-            PSucceed _)]),
-    parseMatch input "namespace a {def x : {t} = 't} def y = a.x"
-      `([PD (PNs $ MkPNamespace [< "a"]
-            [PDef $ MkPDef (PQ Any _) "x"
-              (PConcrete (Just (Enum ["t"] _)) (Tag "t" _))
-              PSucceed False Nothing _]
-            PSucceed _),
-         PD (PDef $ MkPDef (PQ Any _) "y"
-          (PConcrete Nothing (V (MkPName [< "a"] "x") Nothing _))
-          PSucceed False Nothing _)]),
+      `([PD $ PNs $ MkPNamespace [< "a"]
+          [PDef $ MkPDef (PQ Any _) "x" Nothing
+              (Ann (Tag "t" _) (Enum ["t"] _) _) _] _]),
+    parseMatch input "namespace a {def x = 't ∷ {t}} def y = a.x"
+      `([PD $ PNs $ MkPNamespace [< "a"]
+          [PDef $ MkPDef (PQ Any _) "x" Nothing
+              (Ann (Tag "t" _) (Enum ["t"] _) _) _] _,
+         PD $ PDef $ MkPDef (PQ Any _) "y" Nothing
+            (V (MakePName [< "a"] "x") {}) _]),
     parseMatch input #" load "a.quox"; def b = a.b "#
       `([PLoad "a.quox" _,
-         PD (PDef $ MkPDef (PQ Any _) "b"
-          (PConcrete Nothing (V (MkPName [< "a"] "b") Nothing _))
-          PSucceed False Nothing _)]),
-    parseMatch input #" #[main] postulate hi : String "#
-      `([PD (PDef $ MkPDef (PQ Any _) "hi"
-          (PPostulate (STRING _))
-          PSucceed True Nothing _)]),
-    parseMatch input #" #[compile-scheme "hi"] postulate hi : String "#
-      `([PD (PDef $ MkPDef (PQ Any _) "hi"
-          (PPostulate (STRING _))
-          PSucceed False (Just "hi") _)]),
-    parseMatch input #" #[main] #[compile-scheme "hi"] postulate hi : String "#
-      `([PD (PDef $ MkPDef (PQ Any _) "hi"
-          (PPostulate (STRING _))
-          PSucceed True (Just "hi") _)]),
-    parseMatch input #" #[fail] def hi = "hi!!!! uwu" "#
-      `([PD (PDef $ MkPDef (PQ Any _) "hi"
-          (PConcrete Nothing (Str "hi!!!! uwu" _))
-          PFailAny False Nothing _)]),
-    parseMatch input #" #[fail "type"] def hi = "hi!!!! uwu" "#
-      `([PD (PDef $ MkPDef (PQ Any _) "hi"
-          (PConcrete Nothing (Str "hi!!!! uwu" _))
-          (PFailMatch "type") False Nothing _)]),
-    parseMatch input #" #[fail] namespace ns { } "#
-      `([PD (PNs $ MkPNamespace [< "ns"] [] PFailAny _)]),
-    parseFails input #" #[fail 69] namespace ns { } "#,
-    parseFails input "#[main]",
-    parseFails input "#[main] namespace a { } ",
-    parseFails input #" #[not-an-attr] postulate hi : String "#,
-    parseFails input #" #[log pop] postulate hi : String "#,
-    parseMatch input #" #![log pop] "#
-      `([PD (PPrag (PLogPop _))]),
-    parseMatch input #" #![log (all, 5)] "#
-      `([PD (PPrag (PLogPush [SetAll (Element 5 _)] _))]),
-    parseMatch input #" #![log (default, 69)] "#
-      `([PD (PPrag (PLogPush [SetDefault (Element 69 _)] _))]),
-    parseMatch input #" #![log (whnf, 100)] "#
-      `([PD (PPrag (PLogPush [SetCat (Element "whnf" _) (Element 100 _)] _))]),
-    parseMatch input #" #![log (all, 5) (default, 69) (whnf, 100)] "#
-      `([PD (PPrag (PLogPush
-          [SetAll (Element 5 _), SetDefault (Element 69 _),
-           SetCat (Element "whnf" _) (Element 100 _)] _))]),
-    parseFails input #" #![log] "#,
-    parseFails input #" #![log (non-category, 5)] "#,
-    parseFails input #" #![log (whnf, 50000000)] "#,
-    parseFails input #" #![log [0.★⁵]] "#,
-    parseFails input #" #![main] "#
+         PD $ PDef $ MkPDef (PQ Any _) "b" Nothing
+            (V (MakePName [< "a"] "b") {}) _])
   ]
 ]
diff --git a/tests/Tests/PrettyTerm.idr b/tests/Tests/PrettyTerm.idr
index 30c84cd..71e183f 100644
--- a/tests/Tests/PrettyTerm.idr
+++ b/tests/Tests/PrettyTerm.idr
@@ -24,7 +24,7 @@ parameters (ds : BContext d) (ns : BContext n)
   testPrettyE1 e str {label} = testPrettyT1 (E e) str {label}
 
 
-export prefix 9 ^
+prefix 9 ^
 (^) : (Loc -> a) -> a
 (^) a = a noLoc
 
@@ -37,8 +37,8 @@ tests = "pretty printing terms" :- [
   "free vars" :- [
     testPrettyE1 [<] [<] (^F "x" 0) "x",
     testPrettyE  [<] [<] (^F "x" 1) "x¹" "x^1",
-    testPrettyE1 [<] [<] (^F (MkName [< "A", "B", "C"] "x") 0) "A.B.C.x",
-    testPrettyE  [<] [<] (^F (MkName [< "A", "B", "C"] "x") 2)
+    testPrettyE1 [<] [<] (^F (MakeName [< "A", "B", "C"] "x") 0) "A.B.C.x",
+    testPrettyE  [<] [<] (^F (MakeName [< "A", "B", "C"] "x") 2)
       "A.B.C.x²"
       "A.B.C.x^2"
   ],
@@ -105,8 +105,8 @@ tests = "pretty printing terms" :- [
   ],
 
   "type universes" :- [
-    testPrettyT [<] [<] (^TYPE 0) "★" "Type",
-    testPrettyT [<] [<] (^TYPE 100) "★¹⁰⁰" "Type^100"
+    testPrettyT [<] [<] (^TYPE 0) "★⁰" "Type 0",
+    testPrettyT [<] [<] (^TYPE 100) "★¹⁰⁰" "Type 100"
   ],
 
   "function types" :- [
@@ -120,8 +120,8 @@ tests = "pretty printing terms" :- [
       "1.(x : A) -> B x",
     testPrettyT [<] [<]
       (^PiY Zero "A" (^TYPE 0) (^Arr Any (^BVT 0) (^BVT 0)))
-      "0.(A : ★) → ω.A → A"
-      "0.(A : Type) -> #.A -> A",
+      "0.(A : ★⁰) → ω.A → A"
+      "0.(A : Type 0) -> #.A -> A",
     testPrettyT [<] [<]
       (^Arr Any (^Arr Any (^FT "A" 0) (^FT "A" 0)) (^FT "A" 0))
       "ω.(ω.A → A) → A"
@@ -133,8 +133,8 @@ tests = "pretty printing terms" :- [
     testPrettyT [<] [<]
       (^PiY Zero "P" (^Arr Zero (^FT "A" 0) (^TYPE 0))
         (E $ ^App (^BV 0) (^FT "a" 0)))
-      "0.(P : 0.A → ★) → P a"
-      "0.(P : 0.A -> Type) -> P a"
+      "0.(P : 0.A → ★⁰) → P a"
+      "0.(P : 0.A -> Type 0) -> P a"
   ],
 
   "pair types" :- [
@@ -193,8 +193,8 @@ tests = "pretty printing terms" :- [
   "case" :- [
     testPrettyE [<] [<]
       (^CasePair One (^F "a" 0) (SN $ ^TYPE 1) (SN $ ^TYPE 0))
-      "case1 a return ★¹ of { (_, _) ⇒ ★ }"
-      "case1 a return Type^1 of { (_, _) => Type }",
+      "case1 a return ★¹ of { (_, _) ⇒ ★⁰ }"
+      "case1 a return Type 1 of { (_, _) => Type 0 }",
     testPrettyT [<] [<]
       (^LamY "u" (E $
         ^CaseEnum One (^F "u" 0)
@@ -209,13 +209,12 @@ tests = "pretty printing terms" :- [
 
   "type-case" :- [
     testPrettyE [<] [<]
-      {label = "type-case ℕ ∷ ★ return ★ of { ⋯ }"}
-      (^TypeCase (^Ann (^NAT) (^TYPE 0)) (^TYPE 0) empty (^NAT))
-      "type-case ℕ ∷ ★ return ★ of { _ ⇒ ℕ }"
-      "type-case Nat :: Type return Type of { _ => Nat }"
+      {label = "type-case ℕ ∷ ★⁰ return ★⁰ of { ⋯ }"}
+      (^TypeCase (^Ann (^Nat) (^TYPE 0)) (^TYPE 0) empty (^Nat))
+      "type-case ℕ ∷ ★⁰ return ★⁰ of { _ ⇒ ℕ }"
+      "type-case Nat :: Type 0 return Type 0 of { _ => Nat }"
   ],
 
-  skipWith "(todo: print user-written redundant annotations)" $
   "annotations" :- [
     testPrettyE [<] [<]
       (^Ann (^FT "a" 0) (^FT "A" 0))
@@ -236,6 +235,6 @@ tests = "pretty printing terms" :- [
     testPrettyE [<] [<]
       (^Ann (^Arr One (^FT "A" 0) (^FT "A" 0)) (^TYPE 7))
       "(1.A → A) ∷ ★⁷"
-      "(1.A -> A) :: Type^7"
+      "(1.A -> A) :: Type 7"
   ]
 ]
diff --git a/tests/Tests/Reduce.idr b/tests/Tests/Reduce.idr
index 0635199..53404e4 100644
--- a/tests/Tests/Reduce.idr
+++ b/tests/Tests/Reduce.idr
@@ -2,7 +2,6 @@ module Tests.Reduce
 
 import Quox.Syntax as Lib
 import Quox.Equal
-import Control.Monad.ST.Extra
 import TypingImpls
 import AstExtra
 import TAP
@@ -12,21 +11,13 @@ import Control.Eff
 %hide Pretty.App
 
 
-runWhnf : Eff Whnf a -> Either Error a
-runWhnf act = runSTErr $ do
-  runEff act $ with Union.(::)
-    [handleExcept (\e => stLeft e),
-     handleStateSTRef !(newSTRef' 0),
-     handleLogDiscardST !(newSTRef' 0)]
-
 parameters {0 isRedex : RedexTest tm} {auto _ : CanWhnf tm isRedex} {d, n : Nat}
            {auto _ : (Eq (tm d n), Show (tm d n))}
            {default empty defs : Definitions}
-           {default SOne sg : SQty}
   private
   testWhnf : String -> WhnfContext d n -> tm d n -> tm d n -> Test
   testWhnf label ctx from to = test "\{label}  (whnf)" $ do
-    result <- mapFst toInfo $ runWhnf $ whnf0 defs ctx sg from
+    result <- mapFst toInfo $ runWhnf $ whnf0 defs ctx from
     unless (result == to) $ Left [("exp", show to), ("got", show result)]
 
   private
@@ -34,8 +25,8 @@ parameters {0 isRedex : RedexTest tm} {auto _ : CanWhnf tm isRedex} {d, n : Nat}
   testNoStep label ctx e = testWhnf label ctx e e
 
 private
-ctx : {n : Nat} -> Context (\n => (BindName, Term 0 n)) n -> WhnfContext 0 n
-ctx xs = let (ns, ts) = unzip xs in MkWhnfContext [<] ns (locals ts)
+ctx : Context (\n => (BindName, Term 0 n)) n -> WhnfContext 0 n
+ctx xs = let (ns, ts) = unzip xs in MkWhnfContext [<] ns ts
 
 
 export
@@ -54,7 +45,7 @@ tests = "whnf" :- [
   ],
 
   "neutrals" :- [
-    testNoStep "x" (ctx [< ("A", ^NAT)]) $ ^BV 0,
+    testNoStep "x" (ctx [< ("A", ^Nat)]) $ ^BV 0,
     testNoStep "a"       empty $ ^F "a" 0,
     testNoStep "f a"     empty $ ^App (^F "f" 0) (^FT "a" 0),
     testNoStep "★₀ ∷ ★₁" empty $ ^Ann (^TYPE 0) (^TYPE 1)
@@ -75,21 +66,21 @@ tests = "whnf" :- [
 
   "definitions" :- [
     testWhnf "a  (transparent)" empty
-      {defs = fromList [("a", ^mkDef GZero (^TYPE 1) (^TYPE 0) Nothing False)]}
+      {defs = fromList [("a", ^mkDef gzero (^TYPE 1) (^TYPE 0))]}
       (^F "a" 0) (^Ann (^TYPE 0) (^TYPE 1)),
     testNoStep "a  (opaque)" empty
-      {defs = fromList [("a", ^mkPostulate GZero (^TYPE 1) Nothing False)]}
+      {defs = fromList [("a", ^mkPostulate gzero (^TYPE 1))]}
       (^F "a" 0)
   ],
 
   "elim closure" :- [
-    testWhnf "x{}" (ctx [< ("x", ^NAT)])
+    testWhnf "x{}" (ctx [< ("x", ^Nat)])
       (CloE (Sub (^BV 0) id))
       (^BV 0),
     testWhnf "x{a/x}" empty
       (CloE (Sub (^BV 0) (^F "a" 0 ::: id)))
       (^F "a" 0),
-    testWhnf "x{a/y}" (ctx [< ("x", ^NAT)])
+    testWhnf "x{a/y}" (ctx [< ("x", ^Nat)])
       (CloE (Sub (^BV 0) (^BV 0 ::: ^F "a" 0 ::: id)))
       (^BV 0),
     testWhnf "x{(y{a/y})/x}" empty
@@ -98,7 +89,7 @@ tests = "whnf" :- [
     testWhnf "(x y){f/x,a/y}" empty
       (CloE (Sub (^App (^BV 0) (^BVT 1)) (^F "f" 0 ::: ^F "a" 0 ::: id)))
       (^App (^F "f" 0) (^FT "a" 0)),
-    testWhnf "(y ∷ x){A/x}" (ctx [< ("x", ^NAT)])
+    testWhnf "(y ∷ x){A/x}" (ctx [< ("x", ^Nat)])
       (CloE (Sub (^Ann (^BVT 1) (^BVT 0)) (^F "A" 0 ::: id)))
       (^BV 0),
     testWhnf "(y ∷ x){A/x,a/y}" empty
@@ -131,10 +122,10 @@ tests = "whnf" :- [
       ^App (^F "f" 0)
         (E $ ^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A" 0) (^FT "A" 0)))
               (^FT "a" 0)),
-    testNoStep "λx. (y x){x/x,a/y}" (ctx [< ("y", ^NAT)]) $
+    testNoStep "λx. (y x){x/x,a/y}" (ctx [< ("y", ^Nat)]) $
       ^LamY "x" (CloT $ Sub (E $ ^App (^BV 1) (^BVT 0))
                             (^BV 0 ::: ^F "a" 0 ::: id)),
-    testNoStep "f (y x){x/x,a/y}" (ctx [< ("y", ^NAT)]) $
+    testNoStep "f (y x){x/x,a/y}" (ctx [< ("y", ^Nat)]) $
       ^App (^F "f" 0)
         (CloT (Sub (E $ ^App (^BV 1) (^BVT 0))
                    (^BV 0 ::: ^F "a" 0 ::: id)))
diff --git a/tests/Tests/Typechecker.idr b/tests/Tests/Typechecker.idr
index 42af71e..248d415 100644
--- a/tests/Tests/Typechecker.idr
+++ b/tests/Tests/Typechecker.idr
@@ -2,7 +2,6 @@ module Tests.Typechecker
 
 import Quox.Syntax
 import Quox.Typechecker as Lib
-import Control.Monad.ST
 import public TypingImpls
 import TAP
 import Quox.EffExtra
@@ -31,10 +30,10 @@ ToInfo Error' where
      ("wanted", show good),
      ("wanted", show bad)]
 
-0 Test : List (Type -> Type)
-Test = [Except Error', DefsReader]
+0 M : Type -> Type
+M = Eff [Except Error', DefsReader]
 
-inj : Eff TC a -> Eff Test a
+inj : TC a -> M a
 inj act = rethrow $ mapFst TCError $ runTC !(askAt DEFS) act
 
 
@@ -79,7 +78,7 @@ sndDef =
       (SY [< "x", "y"] $ ^BVT 0))))
 
 nat : Term d n
-nat = ^NAT
+nat = ^Nat
 
 apps : Elim d n -> List (Term d n) -> Elim d n
 apps = foldl (\f, s => ^App f s)
@@ -87,56 +86,56 @@ apps = foldl (\f, s => ^App f s)
 
 defGlobals : Definitions
 defGlobals = fromList
-  [("A",  mkPostulate GZero (^TYPE 0)),
-   ("B",  mkPostulate GZero (^TYPE 0)),
-   ("C",  mkPostulate GZero (^TYPE 1)),
-   ("D",  mkPostulate GZero (^TYPE 1)),
-   ("P",  mkPostulate GZero (^Arr Any (^FT "A" 0) (^TYPE 0))),
-   ("a",  mkPostulate GAny  (^FT "A" 0)),
-   ("a'", mkPostulate GAny  (^FT "A" 0)),
-   ("b",  mkPostulate GAny  (^FT "B" 0)),
-   ("c",  mkPostulate GAny  (^FT "C" 0)),
-   ("d",  mkPostulate GAny  (^FT "D" 0)),
-   ("f",  mkPostulate GAny  (^Arr One (^FT "A" 0) (^FT "A" 0))),
-   ("fω", mkPostulate GAny  (^Arr Any (^FT "A" 0) (^FT "A" 0))),
-   ("g",  mkPostulate GAny  (^Arr One (^FT "A" 0) (^FT "B" 0))),
-   ("f2", mkPostulate GAny
+  [("A",  ^mkPostulate gzero (^TYPE 0)),
+   ("B",  ^mkPostulate gzero (^TYPE 0)),
+   ("C",  ^mkPostulate gzero (^TYPE 1)),
+   ("D",  ^mkPostulate gzero (^TYPE 1)),
+   ("P",  ^mkPostulate gzero (^Arr Any (^FT "A" 0) (^TYPE 0))),
+   ("a",  ^mkPostulate gany  (^FT "A" 0)),
+   ("a'", ^mkPostulate gany  (^FT "A" 0)),
+   ("b",  ^mkPostulate gany  (^FT "B" 0)),
+   ("c",  ^mkPostulate gany  (^FT "C" 0)),
+   ("d",  ^mkPostulate gany  (^FT "D" 0)),
+   ("f",  ^mkPostulate gany  (^Arr One (^FT "A" 0) (^FT "A" 0))),
+   ("fω", ^mkPostulate gany  (^Arr Any (^FT "A" 0) (^FT "A" 0))),
+   ("g",  ^mkPostulate gany  (^Arr One (^FT "A" 0) (^FT "B" 0))),
+   ("f2", ^mkPostulate gany
       (^Arr One (^FT "A" 0) (^Arr One (^FT "A" 0) (^FT "B" 0)))),
-   ("p",  mkPostulate GAny
+   ("p",  ^mkPostulate gany
       (^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))),
-   ("q",  mkPostulate GAny
+   ("q",  ^mkPostulate gany
       (^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))),
-   ("refl", mkDef GAny reflTy reflDef),
-   ("fst",  mkDef GAny fstTy fstDef),
-   ("snd",  mkDef GAny sndTy sndDef)]
+   ("refl", ^mkDef gany reflTy reflDef),
+   ("fst",  ^mkDef gany fstTy fstDef),
+   ("snd",  ^mkDef gany sndTy sndDef)]
 
-parameters (label : String) (act : Lazy (Eff Test ()))
+parameters (label : String) (act : Lazy (M ()))
            {default defGlobals globals : Definitions}
   testTC : Test
   testTC = test label {e = Error', a = ()} $
-    runEff act [handleExcept (\e => Left e), handleReaderConst globals]
+    extract $ runExcept $ runReaderAt DEFS globals act
 
   testTCFail : Test
   testTCFail = testThrows label (const True) $
-    runEff act [handleExcept (\e => Left e), handleReaderConst globals] $> "ok"
+    (extract $ runExcept $ runReaderAt DEFS globals act) $> "()"
 
 
-inferredTypeEq : TyContext d n -> (exp, got : Term d n) -> Eff Test ()
+inferredTypeEq : TyContext d n -> (exp, got : Term d n) -> M ()
 inferredTypeEq ctx exp got =
   wrapErr (const $ WrongInfer ctx.dnames ctx.tnames exp got) $ inj $ lift $
     equalType noLoc ctx exp got
 
-qoutEq : (exp, got : QOutput n) -> Eff Test ()
+qoutEq : (exp, got : QOutput n) -> M ()
 qoutEq qout res = unless (qout == res) $ throw $ WrongQOut qout res
 
-inferAs : TyContext d n -> (sg : SQty) -> Elim d n -> Term d n -> Eff Test ()
+inferAs : TyContext d n -> (sg : SQty) -> Elim d n -> Term d n -> M ()
 inferAs ctx@(MkTyContext {dctx, _}) sg e ty = do
   case !(inj $ infer ctx sg e) of
     Just res => inferredTypeEq ctx ty res.type
     Nothing  => pure ()
 
 inferAsQ : TyContext d n -> (sg : SQty) ->
-           Elim d n -> Term d n -> QOutput n -> Eff Test ()
+           Elim d n -> Term d n -> QOutput n -> M ()
 inferAsQ ctx@(MkTyContext {dctx, _}) sg e ty qout = do
   case !(inj $ infer ctx sg e) of
     Just res => do
@@ -144,20 +143,20 @@ inferAsQ ctx@(MkTyContext {dctx, _}) sg e ty qout = do
       qoutEq qout res.qout
     Nothing => pure ()
 
-infer_ : TyContext d n -> (sg : SQty) -> Elim d n -> Eff Test ()
+infer_ : TyContext d n -> (sg : SQty) -> Elim d n -> M ()
 infer_ ctx sg e = ignore $ inj $ infer ctx sg e
 
 checkQ : TyContext d n -> SQty ->
-         Term d n -> Term d n -> QOutput n -> Eff Test ()
+         Term d n -> Term d n -> QOutput n -> M ()
 checkQ ctx@(MkTyContext {dctx, _}) sg s ty qout = do
   case !(inj $ check ctx sg s ty) of
     Just res => qoutEq qout res
     Nothing  => pure ()
 
-check_ : TyContext d n -> SQty -> Term d n -> Term d n -> Eff Test ()
+check_ : TyContext d n -> SQty -> Term d n -> Term d n -> M ()
 check_ ctx sg s ty = ignore $ inj $ check ctx sg s ty
 
-checkType_ : TyContext d n -> Term d n -> Maybe Universe -> Eff Test ()
+checkType_ : TyContext d n -> Term d n -> Maybe Universe -> M ()
 checkType_ ctx s u = inj $ checkType ctx s u
 
 
@@ -168,7 +167,7 @@ tests = "typechecker" :- [
     testTC "0 · ★₀ ⇐ ★₁  # by checkType" $
       checkType_ empty (^TYPE 0) (Just 1),
     testTC "0 · ★₀ ⇐ ★₁  # by check" $
-      check_ empty SZero (^TYPE 0) (^TYPE 1),
+      check_ empty szero (^TYPE 0) (^TYPE 1),
     testTC "0 · ★₀ ⇐ ★₂" $
       checkType_ empty (^TYPE 0) (Just 2),
     testTC "0 · ★₀ ⇐ ★_" $
@@ -180,241 +179,241 @@ tests = "typechecker" :- [
     testTC "0=1 ⊢ 0 · ★₁ ⇐ ★₀" $
       checkType_ empty01 (^TYPE 1) (Just 0),
     testTCFail "1 · ★₀ ⇍ ★₁  # by check" $
-      check_ empty SOne (^TYPE 0) (^TYPE 1)
+      check_ empty sone (^TYPE 0) (^TYPE 1)
   ],
 
   "function types" :- [
     note "A, B : ★₀;  C, D : ★₁;  P : 0.A → ★₀",
     testTC "0 · 1.A → B ⇐ ★₀" $
-      check_ empty SZero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^TYPE 0),
+      check_ empty szero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^TYPE 0),
     note "subtyping",
     testTC "0 · 1.A → B ⇐ ★₁" $
-      check_ empty SZero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^TYPE 1),
+      check_ empty szero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^TYPE 1),
     testTC "0 · 1.C → D ⇐ ★₁" $
-      check_ empty SZero (^Arr One (^FT "C" 0) (^FT "D" 0)) (^TYPE 1),
+      check_ empty szero (^Arr One (^FT "C" 0) (^FT "D" 0)) (^TYPE 1),
     testTCFail "0 · 1.C → D ⇍ ★₀" $
-      check_ empty SZero (^Arr One (^FT "C" 0) (^FT "D" 0)) (^TYPE 0),
+      check_ empty szero (^Arr One (^FT "C" 0) (^FT "D" 0)) (^TYPE 0),
     testTC "0 · 1.(x : A) → P x ⇐ ★₀" $
-      check_ empty SZero
+      check_ empty szero
         (^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
         (^TYPE 0),
     testTCFail "0 · 1.A → P ⇍ ★₀" $
-      check_ empty SZero (^Arr One (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
+      check_ empty szero (^Arr One (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
     testTC "0=1 ⊢ 0 · 1.A → P ⇐ ★₀" $
-      check_ empty01 SZero (^Arr One (^FT "A" 0) (^FT "P" 0)) (^TYPE 0)
+      check_ empty01 szero (^Arr One (^FT "A" 0) (^FT "P" 0)) (^TYPE 0)
   ],
 
   "pair types" :- [
     testTC "0 · A × A ⇐ ★₀" $
-      check_ empty SZero (^And (^FT "A" 0) (^FT "A" 0)) (^TYPE 0),
+      check_ empty szero (^And (^FT "A" 0) (^FT "A" 0)) (^TYPE 0),
     testTCFail "0 · A × P ⇍ ★₀" $
-      check_ empty SZero (^And (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
+      check_ empty szero (^And (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
     testTC "0 · (x : A) × P x ⇐ ★₀" $
-      check_ empty SZero
+      check_ empty szero
         (^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
         (^TYPE 0),
     testTC "0 · (x : A) × P x ⇐ ★₁" $
-      check_ empty SZero
+      check_ empty szero
         (^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
         (^TYPE 1),
     testTC "0 · (A : ★₀) × A ⇐ ★₁" $
-      check_ empty SZero
+      check_ empty szero
         (^SigY "A" (^TYPE 0) (^BVT 0))
         (^TYPE 1),
     testTCFail "0 · (A : ★₀) × A ⇍ ★₀" $
-      check_ empty SZero
+      check_ empty szero
         (^SigY "A" (^TYPE 0) (^BVT 0))
         (^TYPE 0),
     testTCFail "1 · A × A ⇍ ★₀" $
-      check_ empty SOne
+      check_ empty sone
         (^And (^FT "A" 0) (^FT "A" 0))
         (^TYPE 0)
   ],
 
   "enum types" :- [
-    testTC "0 · {} ⇐ ★₀" $ check_ empty SZero (^enum []) (^TYPE 0),
-    testTC "0 · {} ⇐ ★₃" $ check_ empty SZero (^enum []) (^TYPE 3),
+    testTC "0 · {} ⇐ ★₀" $ check_ empty szero (^enum []) (^TYPE 0),
+    testTC "0 · {} ⇐ ★₃" $ check_ empty szero (^enum []) (^TYPE 3),
     testTC "0 · {a,b,c} ⇐ ★₀" $
-      check_ empty SZero (^enum ["a", "b", "c"]) (^TYPE 0),
+      check_ empty szero (^enum ["a", "b", "c"]) (^TYPE 0),
     testTC "0 · {a,b,c} ⇐ ★₃" $
-      check_ empty SZero (^enum ["a", "b", "c"]) (^TYPE 3),
-    testTCFail "1 · {} ⇍ ★₀" $ check_ empty SOne (^enum []) (^TYPE 0),
-    testTC "0=1 ⊢ 1 · {} ⇐ ★₀" $ check_ empty01 SOne (^enum []) (^TYPE 0)
+      check_ empty szero (^enum ["a", "b", "c"]) (^TYPE 3),
+    testTCFail "1 · {} ⇍ ★₀" $ check_ empty sone (^enum []) (^TYPE 0),
+    testTC "0=1 ⊢ 1 · {} ⇐ ★₀" $ check_ empty01 sone (^enum []) (^TYPE 0)
   ],
 
   "free vars" :- [
     note "A : ★₀",
     testTC "0 · A ⇒ ★₀" $
-      inferAs empty SZero (^F "A" 0) (^TYPE 0),
+      inferAs empty szero (^F "A" 0) (^TYPE 0),
     testTC "0 · [A] ⇐ ★₀" $
-      check_ empty SZero (^FT "A" 0) (^TYPE 0),
+      check_ empty szero (^FT "A" 0) (^TYPE 0),
     note "subtyping",
     testTC "0 · [A] ⇐ ★₁" $
-      check_ empty SZero (^FT "A" 0) (^TYPE 1),
+      check_ empty szero (^FT "A" 0) (^TYPE 1),
     note "(fail) runtime-relevant type",
     testTCFail "1 · A ⇏ ★₀" $
-      infer_ empty SOne (^F "A" 0),
+      infer_ empty sone (^F "A" 0),
     testTC "1 . f ⇒ 1.A → A" $
-      inferAs empty SOne (^F "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
+      inferAs empty sone (^F "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
     testTC "1 . f ⇐ 1.A → A" $
-      check_ empty SOne (^FT "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
+      check_ empty sone (^FT "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
     testTCFail "1 . f ⇍ 0.A → A" $
-      check_ empty SOne (^FT "f" 0) (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
+      check_ empty sone (^FT "f" 0) (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
     testTCFail "1 . f ⇍ ω.A → A" $
-      check_ empty SOne (^FT "f" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
+      check_ empty sone (^FT "f" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
     testTC "1 . (λ x ⇒ f x) ⇐ 1.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (E $ ^App (^F "f" 0) (^BVT 0)))
         (^Arr One (^FT "A" 0) (^FT "A" 0)),
     testTC "1 . (λ x ⇒ f x) ⇐ ω.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (E $ ^App (^F "f" 0) (^BVT 0)))
         (^Arr Any (^FT "A" 0) (^FT "A" 0)),
     testTCFail "1 . (λ x ⇒ f x) ⇍ 0.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (E $ ^App (^F "f" 0) (^BVT 0)))
         (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
     testTC "1 . fω ⇒ ω.A → A" $
-      inferAs empty SOne (^F "fω" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
+      inferAs empty sone (^F "fω" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
     testTC "1 . (λ x ⇒ fω x) ⇐ ω.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (E $ ^App (^F "fω" 0) (^BVT 0)))
         (^Arr Any (^FT "A" 0) (^FT "A" 0)),
     testTCFail "1 . (λ x ⇒ fω x) ⇍ 0.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (E $ ^App (^F "fω" 0) (^BVT 0)))
         (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
     testTCFail "1 . (λ x ⇒ fω x) ⇍ 1.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (E $ ^App (^F "fω" 0) (^BVT 0)))
         (^Arr One (^FT "A" 0) (^FT "A" 0)),
     note "refl : (0·A : ★₀) → (1·x : A) → (x ≡ x : A) ≔ (λ A x ⇒ δ _ ⇒ x)",
-    testTC "1 · refl ⇒ ⋯" $ inferAs empty SOne (^F "refl" 0) reflTy,
-    testTC "1 · [refl] ⇐ ⋯" $ check_ empty SOne (^FT "refl" 0) reflTy
+    testTC "1 · refl ⇒ ⋯" $ inferAs empty sone (^F "refl" 0) reflTy,
+    testTC "1 · [refl] ⇐ ⋯" $ check_ empty sone (^FT "refl" 0) reflTy
   ],
 
   "bound vars" :- [
     testTC "x : A ⊢ 1 · x ⇒ A ⊳ 1·x" $
-      inferAsQ (ctx [< ("x", ^FT "A" 0)]) SOne
+      inferAsQ (ctx [< ("x", ^FT "A" 0)]) sone
         (^BV 0) (^FT "A" 0) [< One],
     testTC "x : A ⊢ 1 · x ⇐ A ⊳ 1·x" $
-      checkQ (ctx [< ("x", ^FT "A" 0)]) SOne (^BVT 0) (^FT "A" 0) [< One],
+      checkQ (ctx [< ("x", ^FT "A" 0)]) sone (^BVT 0) (^FT "A" 0) [< One],
     note "f2 : 1.A → 1.A → B",
     testTC "x : A ⊢ 1 · f2 x x ⇒ B ⊳ ω·x" $
-      inferAsQ (ctx [< ("x", ^FT "A" 0)]) SOne
+      inferAsQ (ctx [< ("x", ^FT "A" 0)]) sone
         (^App (^App (^F "f2" 0) (^BVT 0)) (^BVT 0)) (^FT "B" 0) [< Any]
   ],
 
   "lambda" :- [
     note "linear & unrestricted identity",
     testTC "1 · (λ x ⇒ x) ⇐ A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (^BVT 0))
         (^Arr One (^FT "A" 0) (^FT "A" 0)),
     testTC "1 · (λ x ⇒ x) ⇐ ω.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (^BVT 0))
         (^Arr Any (^FT "A" 0) (^FT "A" 0)),
     note "(fail) zero binding used relevantly",
     testTCFail "1 · (λ x ⇒ x) ⇍ 0.A → A" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "x" (^BVT 0))
         (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
     note "(but ok in overall erased context)",
     testTC "0 · (λ x ⇒ x) ⇐ A ⇾ A" $
-      check_ empty SZero
+      check_ empty szero
         (^LamY "x" (^BVT 0))
         (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
     testTC "1 · (λ A x ⇒ refl A x) ⇐ ⋯  # (type of refl)" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "A" (^LamY "x"
           (E $ ^App (^App (^F "refl" 0) (^BVT 1)) (^BVT 0))))
         reflTy,
     testTC "1 · (λ A x ⇒ δ i ⇒ x) ⇐ ⋯  # (def. and type of refl)" $
-      check_ empty SOne reflDef reflTy
+      check_ empty sone reflDef reflTy
   ],
 
   "pairs" :- [
     testTC "1 · (a, a) ⇐ A × A" $
-      check_ empty SOne
+      check_ empty sone
         (^Pair (^FT "a" 0) (^FT "a" 0)) (^And (^FT "A" 0) (^FT "A" 0)),
     testTC "x : A ⊢ 1 · (x, x) ⇐ A × A ⊳ ω·x" $
-      checkQ (ctx [< ("x", ^FT "A" 0)]) SOne
+      checkQ (ctx [< ("x", ^FT "A" 0)]) sone
         (^Pair (^BVT 0) (^BVT 0)) (^And (^FT "A" 0) (^FT "A" 0)) [< Any],
     testTC "1 · (a, δ i ⇒ a) ⇐ (x : A) × (x ≡ a)" $
-      check_ empty SOne
+      check_ empty sone
         (^Pair (^FT "a" 0) (^DLamN (^FT "a" 0)))
         (^SigY "x" (^FT "A" 0) (^Eq0 (^FT "A" 0) (^BVT 0) (^FT "a" 0)))
   ],
 
   "unpairing" :- [
     testTC "x : A × A ⊢ 1 · (case1 x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 1·x" $
-      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) SOne
+      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) sone
         (^CasePair One (^BV 0) (SN $ ^FT "B" 0)
           (SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0)))
         (^FT "B" 0) [< One],
     testTC "x : A × A ⊢ 1 · (caseω x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ ω·x" $
-      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) SOne
+      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) sone
         (^CasePair Any (^BV 0) (SN $ ^FT "B" 0)
           (SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0)))
         (^FT "B" 0) [< Any],
     testTC "x : A × A ⊢ 0 · (caseω x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 0·x" $
-      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) SZero
+      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) szero
         (^CasePair Any (^BV 0) (SN $ ^FT "B" 0)
           (SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0)))
         (^FT "B" 0) [< Zero],
     testTCFail "x : A × A ⊢ 1 · (case0 x return B of (l,r) ⇒ f2 l r) ⇏" $
-      infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) SOne
+      infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) sone
         (^CasePair Zero (^BV 0) (SN $ ^FT "B" 0)
           (SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0))),
     testTC "x : A × B ⊢ 1 · (caseω x return A of (l,r) ⇒ l) ⇒ A ⊳ ω·x" $
-      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) SOne
+      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) sone
         (^CasePair Any (^BV 0) (SN $ ^FT "A" 0)
           (SY [< "l", "r"] $ ^BVT 1))
         (^FT "A" 0) [< Any],
     testTC "x : A × B ⊢ 0 · (case1 x return A of (l,r) ⇒ l) ⇒ A ⊳ 0·x" $
-      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) SZero
+      inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) szero
         (^CasePair One (^BV 0) (SN $ ^FT "A" 0)
           (SY [< "l", "r"] $ ^BVT 1))
         (^FT "A" 0) [< Zero],
     testTCFail "x : A × B ⊢ 1 · (case1 x return A of (l,r) ⇒ l) ⇏" $
-      infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) SOne
+      infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) sone
         (^CasePair One (^BV 0) (SN $ ^FT "A" 0)
           (SY [< "l", "r"] $ ^BVT 1)),
     note "fst : 0.(A : ★₀) → 0.(B : ω.A → ★₀) → ω.((x : A) × B x) → A",
     note "    ≔ (λ A B p ⇒ caseω p return A of (x, y) ⇒ x)",
     testTC "0 · ‹type of fst› ⇐ ★₁" $
-      check_ empty SZero fstTy (^TYPE 1),
+      check_ empty szero fstTy (^TYPE 1),
     testTC "1 · ‹def of fst› ⇐ ‹type of fst›" $
-      check_ empty SOne fstDef fstTy,
+      check_ empty sone fstDef fstTy,
     note "snd : 0.(A : ★₀) → 0.(B : A ↠ ★₀) → ω.(p : (x : A) × B x) → B (fst A B p)",
     note "    ≔ (λ A B p ⇒ caseω p return p ⇒ B (fst A B p) of (x, y) ⇒ y)",
     testTC "0 · ‹type of snd› ⇐ ★₁" $
-      check_ empty SZero sndTy (^TYPE 1),
+      check_ empty szero sndTy (^TYPE 1),
     testTC "1 · ‹def of snd› ⇐ ‹type of snd›" $
-      check_ empty SOne sndDef sndTy,
+      check_ empty sone sndDef sndTy,
     testTC "0 · snd A P ⇒ ω.(p : (x : A) × P x) → P (fst A P p)" $
-      inferAs empty SZero
+      inferAs empty szero
         (^App (^App (^F "snd" 0) (^FT "A" 0)) (^FT "P" 0))
         (^PiY Any "p" (^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
           (E $ ^App (^F "P" 0)
             (E $ apps (^F "fst" 0) [^FT "A" 0, ^FT "P" 0, ^BVT 0]))),
     testTC "1 · fst A (λ _ ⇒ B) (a, b) ⇒ A" $
-      inferAs empty SOne
+      inferAs empty sone
         (apps (^F "fst" 0)
               [^FT "A" 0, ^LamN (^FT "B" 0), ^Pair (^FT "a" 0) (^FT "b" 0)])
         (^FT "A" 0),
     testTC "1 · fst¹ A (λ _ ⇒ B) (a, b) ⇒ A" $
-      inferAs empty SOne
+      inferAs empty sone
         (apps (^F "fst" 1)
               [^FT "A" 0, ^LamN (^FT "B" 0), ^Pair (^FT "a" 0) (^FT "b" 0)])
         (^FT "A" 0),
     testTCFail "1 · fst ★⁰ (λ _ ⇒ ★⁰) (A, B) ⇏" $
-      infer_ empty SOne
+      infer_ empty sone
         (apps (^F "fst" 0)
               [^TYPE 0, ^LamN (^TYPE 0), ^Pair (^FT "A" 0) (^FT "B" 0)]),
     testTC "0 · fst¹ ★⁰ (λ _ ⇒ ★⁰) (A, B) ⇒ ★⁰" $
-      inferAs empty SZero
+      inferAs empty szero
         (apps (^F "fst" 1)
               [^TYPE 0, ^LamN (^TYPE 0), ^Pair (^FT "A" 0) (^FT "B" 0)])
         (^TYPE 0)
@@ -422,23 +421,23 @@ tests = "typechecker" :- [
 
   "enums" :- [
     testTC "1 · 'a ⇐ {a}" $
-      check_ empty SOne (^Tag "a") (^enum ["a"]),
+      check_ empty sone (^Tag "a") (^enum ["a"]),
     testTC "1 · 'a ⇐ {a, b, c}" $
-      check_ empty SOne (^Tag "a") (^enum ["a", "b", "c"]),
+      check_ empty sone (^Tag "a") (^enum ["a", "b", "c"]),
     testTCFail "1 · 'a ⇍ {b, c}" $
-      check_ empty SOne (^Tag "a") (^enum ["b", "c"]),
+      check_ empty sone (^Tag "a") (^enum ["b", "c"]),
     testTC "0=1 ⊢ 1 · 'a ⇐ {b, c}" $
-      check_ empty01 SOne (^Tag "a") (^enum ["b", "c"])
+      check_ empty01 sone (^Tag "a") (^enum ["b", "c"])
   ],
 
   "enum matching" :- [
     testTC "ω.x : {tt} ⊢ 1 · case1 x return {tt} of { 'tt ⇒ 'tt } ⇒ {tt}" $
-      inferAs (ctx [< ("x", ^enum ["tt"])]) SOne
+      inferAs (ctx [< ("x", ^enum ["tt"])]) sone
         (^CaseEnum One (^BV 0) (SN (^enum ["tt"]))
           (singleton "tt" (^Tag "tt")))
         (^enum ["tt"]),
     testTCFail "ω.x : {tt} ⊢ 1 · case1 x return {tt} of { 'ff ⇒ 'tt } ⇏" $
-      infer_ (ctx [< ("x", ^enum ["tt"])]) SOne
+      infer_ (ctx [< ("x", ^enum ["tt"])]) sone
         (^CaseEnum One (^BV 0) (SN (^enum ["tt"]))
           (singleton "ff" (^Tag "tt")))
   ],
@@ -447,44 +446,44 @@ tests = "typechecker" :- [
     testTC "0 · ℕ ≡ ℕ : ★₀ ⇐ Type" $
       checkType_ empty (^Eq0 (^TYPE 0) nat nat) Nothing,
     testTC "0 · ℕ ≡ ℕ : ★₀ ⇐ ★₁" $
-      check_ empty SZero (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
+      check_ empty szero (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
     testTCFail "1 · ℕ ≡ ℕ : ★₀ ⇍ ★₁" $
-      check_ empty SOne (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
+      check_ empty sone (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
     testTC "0 · ℕ ≡ ℕ : ★₀ ⇐ ★₂" $
-      check_ empty SZero (^Eq0 (^TYPE 0) nat nat) (^TYPE 2),
+      check_ empty szero (^Eq0 (^TYPE 0) nat nat) (^TYPE 2),
     testTC "0 · ℕ ≡ ℕ : ★₁ ⇐ ★₂" $
-      check_ empty SZero (^Eq0 (^TYPE 1) nat nat) (^TYPE 2),
+      check_ empty szero (^Eq0 (^TYPE 1) nat nat) (^TYPE 2),
     testTCFail "0 · ℕ ≡ ℕ : ★₁ ⇍ ★₁" $
-      check_ empty SZero (^Eq0 (^TYPE 1) nat nat) (^TYPE 1),
+      check_ empty szero (^Eq0 (^TYPE 1) nat nat) (^TYPE 1),
     testTCFail "0 ≡ 'beep : {beep} ⇍ Type" $
       checkType_ empty
         (^Eq0 (^enum ["beep"]) (^Zero) (^Tag "beep"))
         Nothing,
     testTC "ab : A ≡ B : ★₀, x : A, y : B ⊢ 0 · Eq [i ⇒ ab i] x y ⇐ ★₀" $
       check_ (ctx [< ("ab", ^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0)),
-                     ("x", ^FT "A" 0), ("y", ^FT "B" 0)]) SZero
+                     ("x", ^FT "A" 0), ("y", ^FT "B" 0)]) szero
         (^EqY "i" (E $ ^DApp (^BV 2) (^BV 0)) (^BVT 1) (^BVT 0))
         (^TYPE 0),
     testTCFail "ab : A ≡ B : ★₀, x : A, y : B ⊢ Eq [i ⇒ ab i] y x ⇍ Type" $
       check_ (ctx [< ("ab", ^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0)),
-                     ("x", ^FT "A" 0), ("y", ^FT "B" 0)]) SZero
+                     ("x", ^FT "A" 0), ("y", ^FT "B" 0)]) szero
         (^EqY "i" (E $ ^DApp (^BV 2) (^BV 0)) (^BVT 0) (^BVT 1))
         (^TYPE 0)
   ],
 
   "equalities" :- [
     testTC "1 · (δ i ⇒ a) ⇐ a ≡ a" $
-      check_ empty SOne (^DLamN (^FT "a" 0))
+      check_ empty sone (^DLamN (^FT "a" 0))
         (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0)),
     testTC "0 · (λ p q ⇒ δ i ⇒ p) ⇐ (ω·p q : a ≡ a') → p ≡ q  # uip" $
-      check_ empty SZero
+      check_ empty szero
         (^LamY "p" (^LamY "q" (^DLamN (^BVT 1))))
         (^PiY Any "p" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
           (^PiY Any "q" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
             (^Eq0 (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
               (^BVT 1) (^BVT 0)))),
     testTC "0 · (λ p q ⇒ δ i ⇒ q) ⇐ (ω·p q : a ≡ a') → p ≡ q  # uip(2)" $
-      check_ empty SZero
+      check_ empty szero
         (^LamY "p" (^LamY "q" (^DLamN (^BVT 0))))
         (^PiY Any "p" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
           (^PiY Any "q" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
@@ -493,15 +492,15 @@ tests = "typechecker" :- [
   ],
 
   "natural numbers" :- [
-    testTC "0 · ℕ ⇐ ★₀" $ check_ empty SZero nat (^TYPE 0),
-    testTC "0 · ℕ ⇐ ★₇" $ check_ empty SZero nat (^TYPE 7),
-    testTCFail "1 · ℕ ⇍ ★₀" $ check_ empty SOne nat (^TYPE 0),
-    testTC "1 · zero ⇐ ℕ" $ check_ empty SOne (^Zero) nat,
-    testTCFail "1 · zero ⇍ ℕ×ℕ" $ check_ empty SOne (^Zero) (^And nat nat),
+    testTC "0 · ℕ ⇐ ★₀" $ check_ empty szero nat (^TYPE 0),
+    testTC "0 · ℕ ⇐ ★₇" $ check_ empty szero nat (^TYPE 7),
+    testTCFail "1 · ℕ ⇍ ★₀" $ check_ empty sone nat (^TYPE 0),
+    testTC "1 · zero ⇐ ℕ" $ check_ empty sone (^Zero) nat,
+    testTCFail "1 · zero ⇍ ℕ×ℕ" $ check_ empty sone (^Zero) (^And nat nat),
     testTC "ω·n : ℕ ⊢ 1 · succ n ⇐ ℕ" $
-      check_ (ctx [< ("n", nat)]) SOne (^Succ (^BVT 0)) nat,
+      check_ (ctx [< ("n", nat)]) sone (^Succ (^BVT 0)) nat,
     testTC "1 · λ n ⇒ succ n ⇐ 1.ℕ → ℕ" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "n" (^Succ (^BVT 0)))
         (^Arr One nat nat)
   ],
@@ -510,7 +509,7 @@ tests = "typechecker" :- [
     note "1 · λ n ⇒ case1 n return ℕ of { zero ⇒ 0; succ n ⇒ n }",
     note "    ⇐ 1.ℕ → ℕ",
     testTC "pred" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "n" (E $
           ^CaseNat One Zero (^BV 0) (SN nat)
             (^Zero) (SY [< "n", ^BN Unused] $ ^BVT 1)))
@@ -518,7 +517,7 @@ tests = "typechecker" :- [
     note "1 · λ m n ⇒ case1 m return ℕ of { zero ⇒ n; succ _, 1.p ⇒ succ p }",
     note "    ⇐ 1.ℕ → 1.ℕ → 1.ℕ",
     testTC "plus" $
-      check_ empty SOne
+      check_ empty sone
         (^LamY "m" (^LamY "n" (E $
           ^CaseNat One One (^BV 1) (SN nat)
             (^BVT 0)
@@ -528,11 +527,11 @@ tests = "typechecker" :- [
 
   "box types" :- [
     testTC "0 · [0.ℕ] ⇐ ★₀" $
-      check_ empty SZero (^BOX Zero nat) (^TYPE 0),
+      check_ empty szero (^BOX Zero nat) (^TYPE 0),
     testTC "0 · [0.★₀] ⇐ ★₁" $
-      check_ empty SZero (^BOX Zero (^TYPE 0)) (^TYPE 1),
+      check_ empty szero (^BOX Zero (^TYPE 0)) (^TYPE 1),
     testTCFail "0 · [0.★₀] ⇍ ★₀" $
-      check_ empty SZero (^BOX Zero (^TYPE 0)) (^TYPE 0)
+      check_ empty szero (^BOX Zero (^TYPE 0)) (^TYPE 0)
   ],
 
   todo "box values",
@@ -540,7 +539,7 @@ tests = "typechecker" :- [
 
   "type-case" :- [
     testTC "0 · type-case ℕ ∷ ★₀ return ★₀ of { _ ⇒ ℕ } ⇒ ★₀" $
-      inferAs empty SZero
+      inferAs empty szero
         (^TypeCase (^Ann nat (^TYPE 0)) (^TYPE 0) empty nat)
         (^TYPE 0)
   ],
@@ -555,7 +554,7 @@ tests = "typechecker" :- [
     note "1 · λ x y xy ⇒ δ i ⇒ p (xy i)",
     note "  ⇐ (0·x y : A) → (1·xy : x ≡ y) → Eq [i ⇒ P (xy i)] (p x) (p y)",
     testTC "cong" $
-      check_ empty SOne
+      check_ empty sone
         ([< "x", "y", "xy"] :\\ [< "i"] :\\% E (F "p" :@ E (BV 0 :% BV 0)))
         (PiY Zero "x"  (FT "A") $
          PiY Zero "y"  (FT "A") $
@@ -568,7 +567,7 @@ tests = "typechecker" :- [
     note "1 · λ eq ⇒ δ i ⇒ λ x ⇒ eq x i",
     note "  ⇐ (1·eq : (1·x : A) → p x ≡ q x) → p ≡ q",
     testTC "funext" $
-      check_ empty SOne
+      check_ empty sone
         ([< "eq"] :\\ [< "i"] :\\% [< "x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
         (PiY One "eq"
           (PiY One "x" (FT "A")
diff --git a/tests/TypingImpls.idr b/tests/TypingImpls.idr
index c86ad66..e84ed32 100644
--- a/tests/TypingImpls.idr
+++ b/tests/TypingImpls.idr
@@ -3,31 +3,19 @@ module TypingImpls
 import TAP
 import public Quox.Typing
 import public Quox.Pretty
-import Quox.Equal
-import Quox.Typechecker
-import Control.Monad.ST.Extra
 import PrettyExtra
 
 import Derive.Prelude
 %language ElabReflection
 
 
+%runElab deriveIndexed "TyContext" [Show]
+%runElab deriveIndexed "EqContext" [Show]
+%runElab deriveIndexed "NameContexts" [Show]
+%runElab derive "Error" [Show]
+
 export
 ToInfo Error where
   toInfo err =
     let str = render (Opts 60) $ runPrettyDef $ prettyError True err in
     [("err", str)]
-
-
-export
-runEqual : Definitions -> Eff Equal a -> Either Error a
-runEqual defs act = runSTErr $ do
-  runEff act $ with Union.(::)
-    [handleExcept (\e => stLeft e),
-     handleReaderConst defs,
-     handleStateSTRef !(newSTRef' 0),
-     handleLogDiscardST !(newSTRef' 0)]
-
-export
-runTC : Definitions -> Eff TC a -> Either Error a
-runTC = runEqual
diff --git a/tests/on-hold/Tests/Lexer.idr b/tests/on-hold/Tests/Lexer.idr
new file mode 100644
index 0000000..c432360
--- /dev/null
+++ b/tests/on-hold/Tests/Lexer.idr
@@ -0,0 +1,144 @@
+module Tests.Lexer
+
+import Quox.Lexer
+import TAP
+
+
+RealError = Quox.Lexer.Error
+%hide Quox.Lexer.Error
+
+export
+ToInfo RealError where
+  toInfo (Err reason line col char) =
+    [("reason", show reason),
+     ("line",   show line),
+     ("col",    show col),
+     ("char",   show char)]
+
+data Error
+= LexerError RealError
+| WrongAnswer (List Token) (List Token)
+| TestFailed  (List Token)
+
+ToInfo Error where
+  toInfo (LexerError err) = toInfo err
+  toInfo (WrongAnswer exp got) =
+    [("expected", show exp), ("received", show got)]
+  toInfo (TestFailed got) =
+    [("failed", show got)]
+
+
+lex' : String -> Either Error (List Token)
+lex' = bimap LexerError (map val) . lex
+
+parameters (label : String) (input : String)
+  acceptsSuchThat' : (List Token -> Maybe Error) -> Test
+  acceptsSuchThat' p = test label $ delay $ do
+    res <- bimap LexerError (map val) $ lex input
+    case p res of
+         Just err => throwError err
+         Nothing  => pure ()
+
+  acceptsSuchThat : (List Token -> Bool) -> Test
+  acceptsSuchThat p = acceptsSuchThat' $ \res =>
+    if p res then Nothing else Just $ TestFailed res
+
+  acceptsWith : List Token -> Test
+  acceptsWith expect = acceptsSuchThat' $ \res =>
+    if res == expect then Nothing else Just $ WrongAnswer expect res
+
+  accepts : Test
+  accepts = acceptsSuchThat $ const True
+
+  rejects : Test
+  rejects = testThrows label (\case LexerError _ => True; _ => False) $ delay $
+            bimap LexerError (map val) $ lex input
+
+parameters (input : String) {default False esc : Bool}
+  show' : String -> String
+  show' s = if esc then show s else "\"\{s}\""
+
+  acceptsWith' : List Token -> Test
+  acceptsWith' = acceptsWith (show' input) input
+
+  accepts' : Test
+  accepts' = accepts (show' input) input
+
+  rejects' : Test
+  rejects' = rejects "\{show' input}  (reject)" input
+
+
+tests = "lexer" :- [
+  "comments" :- [
+    acceptsWith' ""            [],
+    acceptsWith' "  \n \t\t "  [] {esc = True},
+    acceptsWith' "-- a"        [],
+    acceptsWith' "{- -}"       [],
+    acceptsWith' "{--}"        [],
+    acceptsWith' "{------}"    [],
+    acceptsWith' "{- {- -} -}" [],
+    acceptsWith' "{- } -}"     [],
+    rejects' "{-}",
+    rejects' "{- {- -}",
+    acceptsWith' "( -- comment \n )" [P LParen, P RParen] {esc = True}
+  ],
+
+  "punctuation" :- [
+    acceptsWith' "({[:,]})"
+      [P LParen,  P LBrace, P LSquare,
+       P Colon,   P Comma,
+       P RSquare, P RBrace, P RParen],
+    acceptsWith' " ( { [ : , ] } ) "
+      [P LParen,  P LBrace, P LSquare,
+       P Colon,   P Comma,
+       P RSquare, P RBrace, P RParen],
+    acceptsWith' "→ ⇒ × ⊲ ∷"
+      [P Arrow, P DblArrow, P Times, P Triangle, P DblColon],
+    acceptsWith' "_" [P Wild]
+  ],
+
+  "names & symbols" :- [
+    acceptsWith' "a"        [Name "a"],
+    acceptsWith' "abc"      [Name "abc"],
+    acceptsWith' "_a"       [Name "_a"],
+    acceptsWith' "a_"       [Name "a_"],
+    acceptsWith' "a_b"      [Name "a_b"],
+    acceptsWith' "abc'"     [Name "abc'"],
+    acceptsWith' "a'b'c''"  [Name "a'b'c''"],
+    acceptsWith' "abc123"   [Name "abc123"],
+    acceptsWith' "_1"       [Name "_1"],
+    acceptsWith' "ab cd"    [Name "ab", Name "cd"],
+    acceptsWith' "ab{--}cd" [Name "ab", Name "cd"],
+    acceptsWith' "'a"       [Symbol "a"],
+    acceptsWith' "'ab"      [Symbol "ab"],
+    acceptsWith' "'_b"      [Symbol "_b"],
+    acceptsWith' "a.b.c"    [Name "a", P Dot, Name "b", P Dot, Name "c"],
+    rejects'     "'",
+    rejects'     "1abc"
+  ],
+
+  "keywords" :- [
+    acceptsWith' "λ"    [K Lam],
+    acceptsWith' "let"  [K Let],
+    acceptsWith' "in"   [K In],
+    acceptsWith' "case" [K Case],
+    acceptsWith' "of"   [K Of],
+    acceptsWith' "ω"    [K Omega],
+    acceptsWith' "Π"    [K Pi],
+    acceptsWith' "Σ"    [K Sigma],
+    acceptsWith' "W"    [K W],
+    acceptsWith' "WAAA" [Name "WAAA"]
+  ],
+
+  "universes" :- [
+    acceptsWith' "★10"    [TYPE 10],
+    rejects'     "★"
+  ],
+
+  "numbers" :- [
+    acceptsWith' "0"      [N Zero],
+    acceptsWith' "1"      [N One],
+    acceptsWith' "2"      [N $ Other 2],
+    acceptsWith' "69"     [N $ Other 69]
+  ]
+]
diff --git a/tests/on-hold/Tests/Parser.idr b/tests/on-hold/Tests/Parser.idr
new file mode 100644
index 0000000..d335a7a
--- /dev/null
+++ b/tests/on-hold/Tests/Parser.idr
@@ -0,0 +1,144 @@
+module Tests.Parser
+
+import Quox.Syntax
+import Quox.Parser
+import Quox.Lexer
+import Tests.Lexer
+import Quox.Pretty
+
+import TermImpls
+import Data.SnocVect
+import Text.Parser
+import TAP
+
+
+export
+Show tok => ToInfo (ParsingError tok) where
+  toInfo (Error msg Nothing)    = [("msg", msg)]
+  toInfo (Error msg (Just loc)) = [("loc", show loc), ("msg", msg)]
+
+
+numberErrs : List1 Info -> Info
+numberErrs (head ::: [])   = head
+numberErrs (head ::: tail) = go 0 (head :: tail) where
+  number1 : Nat -> Info -> Info
+  number1 n = map $ \(k, v) => (show n ++ k, v)
+
+  go : Nat -> List Info -> Info
+  go k []        = []
+  go k (x :: xs) = number1 k x ++ go (S k) xs
+
+export
+ToInfo Parser.Error where
+  toInfo (Lex      err)  = toInfo err
+  toInfo (Parse    errs) = numberErrs $ map toInfo errs
+  toInfo (Leftover toks) = toInfo [("leftover", toks)]
+
+
+RealError = Quox.Parser.Error
+%hide Lexer.RealError
+%hide Quox.Parser.Error
+
+data Error a
+= Parser RealError
+| Unexpected a a
+| ShouldFail a
+
+export
+Show a => ToInfo (Error a) where
+  toInfo (Parser err) = toInfo err
+  toInfo (Unexpected exp got) = toInfo $
+    [("expected", exp), ("received", got)]
+  toInfo (ShouldFail got) = toInfo [("success", got)]
+
+
+parameters {c : Bool} (grm : Grammar c a) (note : String) (input : String)
+  parsesNote : (Show a, Eq a) => a -> Test
+  parsesNote exp = test "\"\{input}\"\{note}" $ delay $
+    case lexParseAll grm input of
+         Right got => if got == exp then Right ()
+                                    else Left $ Unexpected exp got
+         Left  err => Left $ Parser err
+
+  rejectsNote : Show a => Test
+  rejectsNote = test "\"\{input}\"\{note} ‹reject›" $ do
+    case lexParseAll grm input of
+         Left  err => Right ()
+         Right val => Left $ ShouldFail val
+
+parameters {c : Bool} (grm : Grammar c a) (input : String)
+  parses : (Show a, Eq a) => a -> Test
+  parses = parsesNote grm "" input
+
+  rejects : Show a => Test
+  rejects = rejectsNote grm "" input
+
+tests = "parser" :- [
+  "numbers" :-
+  let parses = parses number
+  in [
+    parses "0"    0,
+    parses "1"    1,
+    parses "1000" 1000
+  ],
+
+  "bound vars (x, y, z | a ⊢)" :-
+  let grm = bound "test" {bound = [< "x", "y", "z"], avoid = [< "a"]}
+      parses = parses grm; rejects = rejects grm; rejectsNote = rejectsNote grm
+  in [
+    parses  "x" (V 2),
+    parses  "y" (V 1),
+    parses  "z" (V 0),
+    rejects "M.x",
+    rejects "x.a",
+    rejectsNote " (avoid)"        "a",
+    rejectsNote " (not in scope)" "c"
+  ],
+
+  "bound or free vars (x, y, z ⊢)" :-
+  let parses = parses $ nameWith {bound = [< "x", "y", "z"], avoid = [<]}
+  in [
+    parses "x"         (Left (V 2)),
+    parses "y"         (Left (V 1)),
+    parses "z"         (Left (V 0)),
+    parses "a"         (Right (MakeName [<]          (UN "a"))),
+    parses "a.b.c"     (Right (MakeName [< "a", "b"] (UN "c"))),
+    parses "a . b . c" (Right (MakeName [< "a", "b"] (UN "c"))),
+    parses "M.x"       (Right (MakeName [< "M"]      (UN "x"))),
+    parses "x.a"       (Right (MakeName [< "x"]      (UN "a")))
+  ],
+
+  "dimension (i, j | x, y, z ⊢)" :-
+  let grm = dimension {dvars = [< "i", "j"], tvars = [< "x", "y", "z"]}
+      parses = parses grm; rejects = rejects grm; rejectsNote = rejectsNote grm
+  in [
+    parses  "0" (K Zero),
+    parses  "1" (K One),
+    rejects "2",
+    parses  "i" (B (V 1)),
+    rejectsNote " (tvar)"         "x",
+    rejectsNote " (not in scope)" "a"
+  ],
+
+  "terms & elims (i, j | x, y, z ⊢)" :-
+  let dvars = [< "i", "j"]; tvars = [< "x", "y", "z"]
+      tgrm = term {dvars, tvars}; egrm = elim {dvars, tvars}
+      tparses  = parsesNote  tgrm " (term)"
+      eparses  = parsesNote  egrm " (elim)"
+      trejects = rejectsNote tgrm " (term)"
+      erejects = rejectsNote egrm " (elim)"
+  in [
+    "universes" :- [
+      tparses "★0"    (TYPE 0),
+      tparses "★1000" (TYPE 1000)
+    ],
+
+    "variables" :- [
+      eparses  "a"   (F "a"),
+      eparses  "x"   (BV 2),
+      trejects "a",
+      tparses  "[a]" (FT "a"),
+      tparses  "[x]" (BVT 2)
+    ]
+  ]
+]
diff --git a/tests/on-hold/Tests/Unicode.idr b/tests/on-hold/Tests/Unicode.idr
new file mode 100644
index 0000000..e3b0c1c
--- /dev/null
+++ b/tests/on-hold/Tests/Unicode.idr
@@ -0,0 +1,90 @@
+module Tests.Unicode
+
+import Quox.NatExtra
+import Quox.Unicode
+import Data.List
+import Data.String
+import Data.Maybe
+import TAP
+
+
+maxLatin1 = '\xFF'
+
+escape : Char -> Maybe String
+escape '\'' = Nothing
+escape c =
+  if c > maxLatin1 then Nothing else
+  case unpack $ show c of
+       '\'' :: '\\' :: cs => pack . ('\\' ::) <$> init' cs
+       _                  => Nothing
+
+codepoint : Char -> String
+codepoint = padLeft 4 '0' . showHex . cast
+
+display : Char -> String
+display c =
+  let c'  = fromMaybe (singleton c) $ escape c in
+  if '\x20' <= c && c <= maxLatin1
+     then "｢\{c'}｣"
+     else "｢\{c'}｣ (U+\{codepoint c})"
+
+displayS' : String -> String
+displayS' =
+  foldMap (\c => if c <= maxLatin1 then singleton c else "\\x\{codepoint c}") .
+  unpack
+
+displayS : String -> String
+displayS str =
+  if all (<= maxLatin1) (unpack str)
+     then "｢\{str}｣"
+     else "｢\{str}｣ (\"\{displayS' str}\")"
+
+testOneChar : (Char -> Bool) -> Char -> Test
+testOneChar pred c = test (display c) $ unless (pred c) $ Left ()
+
+testAllChars : String -> (Char -> Bool) -> List Char -> Test
+testAllChars label pred chars = label :- map (testOneChar pred) chars
+
+
+testNfc : String -> String -> Test
+testNfc input result =
+  test (displayS input) $
+  let norm = normalizeNfc input in
+  unless (norm == result) $
+  Left [("expected", displayS result), ("received", displayS norm)]
+
+testAlreadyNfc : String -> Test
+testAlreadyNfc input = testNfc input input
+
+
+
+tests = "unicode" :- [
+  "general categories" :- [
+    testAllChars "id starts" isIdStart
+      ['a', 'á', '𝕕', '개', 'ʨ', '𒁙', '𝟙'],
+    testAllChars "not id starts" (not . isIdStart)
+      ['0', '_', '-', '‿', ' ', '[', ',', '.', '\1'],
+    testAllChars "id continuations" isIdCont
+      ['a', 'á', '𝕕', '개', 'ʨ', '𒁙', '0', '\''],
+    testAllChars "not id continuations" (not . isIdCont)
+      ['_', '‿', ' ', '[', ',', '.', '\1'],
+    testAllChars "id connectors" isIdConnector
+      ['_', '‿'],
+    testAllChars "not id connectors" (not . isIdConnector)
+      ['a', ' ', ',', '-'],
+    testAllChars "white space" isWhitespace
+      [' ', '\t', '\r', '\n',
+       '\x2028', -- line separator
+       '\x2029'  -- paragraph separator
+      ],
+    testAllChars "not white space" (not . isWhitespace)
+      ['a', '-', '_', '\1']
+  ],
+
+  "normalisation" :- [
+    testNfc        "e\x301" "é",
+    testAlreadyNfc "é",
+    testAlreadyNfc ""
+    -- idk if this is wrong it's chez's fault. or unicode's
+  ]
+]
diff --git a/tests/quox-tests.ipkg b/tests/quox-tests.ipkg
index 3757f91..c98b60d 100644
--- a/tests/quox-tests.ipkg
+++ b/tests/quox-tests.ipkg
@@ -8,7 +8,6 @@ modules =
   AstExtra,
   TypingImpls,
   PrettyExtra,
-  Tests.FreeVars,
   Tests.DimEq,
   Tests.Reduce,
   Tests.Equal,