i gotta clean this up lol

day1.pdc

@@ -0,0 +1,124 @@
+---
+title: advent of code 2023, day 1
+...
+
+
+since this is a brand new language, we need to define… quite a lot.
+
+
+## booleans
+
+enumerations are one of the base kinds of type in quox. an enumeration type looks like `{a, b, c, …}` and the values look like `'a`.
+
+```quox
+namespace bool {
+
+def0 Bool : ★ = {true, false}
+```
+
+one of the things quox's type system does is keep track of how many times each variable is used. it's like a much simpler version of rust's Whole Situation. i think something nice can be built on top of it, but that's in the future. anyway, this extends a little bit to top-level definitions: if something is marked `0`, then it doesn't exist at all at run time. this is needed for types, which have no run time representation, but can also be used for anything else that shouldn't exist when the compiler is done, like correctness proofs, or whatever.
+
+`1` on the type of a function argument (or no marker, since it's the default) means it is used exactly once in all code paths. `ω` means it can be used however you like. the two branches of `if` below are `ω`, because whether they are used or not depends on the value of `b`, and saying that exactly is not possible (currently??). the default for top level definitions is `ω`, since it doesn't make much sense to have one that can be used once, ever, _somewhere_.
+
+you match against enums (and most other things) with a `case` expression. currently, the return type annotation is mandatory, because it can't _always_ be inferred, and the machinery to figure it out when it _is_ possible doesn't exist yet.
+
+```quox
+def if : 0.(A : ★) → (b : Bool) → ω.A → ω.A → A =
+  λ A b t f ⇒ case b return A of { 'true ⇒ t; 'false ⇒ f }
+
+def and : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false
+def or  : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a 'true b
+
+}  -- (end of namespace)
+```
+
+<aside>
+  `and` and `or` here are just normal functions that evaluate both their arguments. sorry.
+</aside>
+
+for the same reason as the `return` annotation, there's no inference for type arguments and stuff like that, so the type of `if`'s branches has to be specified as the first argument.yes this is annoying. it'll be gone one day.
+
+there's also no module importing yet, so if i want to use a name unqualified i just bind it again outside of a namespace for now. without getting Into It, a single name is one of the things whose types is obvious enough not to need an annotation (and type constructors aren't. if you know you know).
+
+```quox
+def0 Bool = bool.Bool
+```
+
+unit, or `()`, or whatever you want to call it, is an even simpler enumeration. since it has no useful information, it can be thrown away, but not automatically yet.
+
+```quox
+namespace unit {
+def0 Unit : ★ = {unit}
+
+def drop : 0.(A : ★) → A → Unit → A =
+  λ A x u ⇒ case u return A of { 'unit ⇒ x }
+}
+
+def0 Unit = unit.Unit
+```
+
+
+## maybe (aka option)
+
+booleans are all right, but what if you need data _inside_ your data.
+
+quox's enums are _just_ the symbols, so instead, you can use a pair. the first element is your enum, and the second element is everything else. what that is depends on the tag, so we write a function `Payload` that returns the type we need. `Nothing` needs no thing (well, a placeholder), and `Just` needs one thing.
+
+```quox
+namespace maybe {
+
+def0 Tag : ★ = {nothing, just}
+
+def0 Payload : Tag → ★ → ★ =
+  λ tag A ⇒ case tag return ★ of { 'nothing ⇒ Unit; 'just ⇒ A }
+
+def0 Maybe : ★ → ★ =
+  λ A ⇒ (t : Tag) × Payload t A
+
+def Nothing : 0.(A : ★) →     Maybe A = λ A   ⇒ ('nothing, 'unit)
+def Just    : 0.(A : ★) → A → Maybe A = λ A x ⇒ ('just,    x)
+```
+
+with the language in this early state it's easier to work types if we define folds for them. for today, non-dependent versions will do, like haskell's `maybe` or rust's `map_or`. and if i make it take the two components separately, i can put off talking about the `x` of quox until another day.
+
+```quox
+def fold' : 0.(A B : ★) → ω.B → ω.(ω.A → B) →
+            ω.(tag : Tag) → ω.(Payload tag A) → B =
+  λ A B nothing just tag ⇒
+  case tag return t ⇒ ω.(Payload t A) → B of {
+    'nothing ⇒ λ _ ⇒ nothing;
+    'just    ⇒ λ x ⇒ just x
+  }
+
+def fold : 0.(A B : ★) → ω.B → ω.(ω.A → B) → ω.(Maybe A) → B =
+  λ A B nothing just x ⇒
+  caseω x return B of { (tag, payload) ⇒ fold' A B nothing just tag payload }
+
+}
+
+def0 Maybe   = maybe.Maybe
+def  Just    = maybe.Just
+def  Nothing = maybe.Nothing
+```
+
+it is possible to make these types more precise about how they use their arguments, but let's worry about that some other time. this is good enough for now.
+
+`fold'` looks a bit weird here. first, its return annotation has an extra `t ⇒` at the beginning. and it also has a pattern match before it's taken all of its arguments, so the arms inside the case are both functions. sorry i lied there are dependent types afoot on the inside of this function
+
+first let's try to write it like this:
+
+```{.quox}
+def fold' : 0.(A B : ★) → ω.B → ω.(ω.A → B) →
+            ω.(tag : Tag) → ω.(Payload tag A) → B =
+  λ A B nothing just tag payload ⇒
+  case tag return B of {
+    'nothing ⇒ nothing;
+    'just    ⇒ just payload
+  }
+```
+
+in the second branch, the type of `just` is `ω.A → B`, and the type of `payload` is `Payload tag A`. right now, the type system can't see that these are the same, so you get an error. but in this branch, `tag` is `'just`, so `payload` _should_ have type `Payload 'just A`, which is `A`. to make this connection obvious, you can write a return clause as `return x ⇒ T`, which means that, in each branch, occurrences of `x` will be replaced with that branches pattern, and for the whole expression's type, they will be replaced with the head. this is also the reason for matching before taking the last argument: it is the occurrence in that argument's type that we care about.
+
+maybe you are thinking "the word `tag` is right there! of course i want to replace it!" and in future versions of the language simple examples like this will be more automatic. but for now cut me some slack ok
+
+

day2.ss

@@ -29,12 +29,11 @@
 (define (split-at ch str)
   (define len (string-length str))
   (let loop [(start 0) (end 0) (acc '())]
-    (cond
+    (cond [(>= end len)
-      [(>= end len)
+           (reverse (cons (substring str start len) acc))]
-       (reverse (cons (substring str start len) acc))]
+          [(char=? ch (string-ref str end))
-      [(char=? ch (string-ref str end))
+           (loop (+ end 1) (+ end 1) (cons (substring str start end) acc))]
-       (loop (+ end 1) (+ end 1) (cons (substring str start end) acc))]
+          [else (loop start (+ end 1) acc)])))
-      [else (loop start (+ end 1) acc)])))
 
 (define (split-at-nested chs0 str)
   (define chs (cond [(list? chs0) chs0] [(string? chs0) (string->list chs0)]))

day3.quox

@@ -0,0 +1,96 @@
+load "string.quox"
+
+
+def0 Symbol : ★ = Char × ℕ × ℕ -- value, x, y
+def0 Number : ★ = ℕ × ℕ × ℕ × ℕ -- value, start_x, end_x, y
+
+namespace symbol {
+  def value : ω.Symbol → Char = λ s ⇒ fst s
+  def x     : ω.Symbol → ℕ    = λ s ⇒ fst (snd s)
+  def y     : ω.Symbol → ℕ    = λ s ⇒ snd (snd s)
+}
+
+namespace number {
+  def value : ω.Number → ℕ = λ n ⇒ fst n
+  def sx    : ω.Number → ℕ = λ n ⇒ fst (snd n)
+  def ex    : ω.Number → ℕ = λ n ⇒ fst (snd (snd n))
+  def y     : ω.Number → ℕ = λ n ⇒ snd (snd (snd n))
+}
+
+namespace element {
+  def0 Tag : ★ = {symbol, number}
+
+  def0 Body : Tag → ★ =
+    λ t ⇒ case t return ★ of { 'symbol ⇒ Symbol; 'number ⇒ Number }
+}
+
+def0 Element : ★ = (t : element.Tag) × element.Body t
+
+def make-symbol : (value : Char) → (x y : ℕ) → Element =
+  λ c x y ⇒ ('symbol, c, x, y)
+
+def make-number : (value start_x end_x y : ℕ) → Element =
+  λ v sx ex y ⇒ ('number, v, sx, ex, y)
+
+def dot = char.from-ℕ 0x2e
+
+
+def adj-x : ω.(nx sx ex : ℕ) → Bool =
+  λ nx sx ex ⇒ bool.and (nat.ge (succ nx) sx) (nat.le nx (succ ex))
+
+def adj-y : ω.(ny sy : ℕ) → Bool =
+  λ ny sy ⇒ bool.and (nat.ge (succ ny) sy) (nat.le ny (succ sy))
+
+
+def adjacent : ω.Symbol → ω.Number → Bool =
+  λ s n ⇒
+  bool.and (adj-x (symbol.x s) (number.sx n) (number.ex n))
+           (adj-y (symbol.y s) (number.y n))
+
+def any : 0.(A : ★) → ω.(ω.A → Bool) → ω.(List A) → Bool =
+  λ A p ⇒ list.foldlω A Bool 'false (λ b x ⇒ bool.or b (p x))
+
+def is-label : ω.(List Symbol) → ω.Number → Bool =
+  λ ss n ⇒ any Symbol (λ s ⇒ adjacent s n) ss
+
+
+namespace read {
+  def0 Digits : ★ = Maybe (List ℕ)
+
+  def0 State : ★ =
+    -- current number, x, y
+    Digits × ℕ × ℕ ×
+    -- stuff seen so far
+    List Number × List Symbol
+
+  def Cons = list.Cons
+  def Nil  = list.Nil
+
+  def add-digit : ℕ → Digits → Digits =
+    λ d ds ⇒
+    maybe.fold (List ℕ) (ℕ → Digits)
+      (λ    d ⇒ Just (List ℕ) (Cons ℕ d (Nil ℕ)))
+      (λ ds d ⇒ Just (List ℕ) (Cons ℕ d ds))
+      ds d
+
+  def next-col : State → State =
+    λ s ⇒
+    case s return State of { (ds, rest) ⇒
+      case rest return State of { (x, rest) ⇒ (ds, succ x, rest) }
+    }
+
+  def next-row : State → State =
+    λ s ⇒
+    case s return State of { (ds, rest) ⇒
+      case rest return State of { (x, rest) ⇒
+        nat.drop State x
+          (case rest return State of { (y, rest) ⇒ (ds, 0, succ y, rest) })
+      }
+    }
+
+  def seen-digit : Char → State → State =
+    λ c s ⇒
+    case s return State of {
+      (ds, rest) ⇒ (add-digit (char.digit c) ds, rest)
+    }
+}

day4.quox

@@ -0,0 +1,54 @@
+-- introducing: let expressions!!!
+-- i implemented them yesterday because this was just too annoying otherwise
+
+load "list.quox"
+load "string.quox"
+load "io.quox"
+
+
+def0 Line : ★ = List ℕ × List ℕ
+
+
+-- i still don't have char literals. quox has no idea what "a char" is
+def colon = char.from-ℕ 0x3A
+def bar   = char.from-ℕ 0x7C
+
+def split-line : ω.String → Line =
+  λ line ⇒
+  letω line  = snd (string.break (char.eq colon) line);
+       pair  = string.break (char.eq bar) line;
+       got   = fst pair; want = snd pair;
+       got   = list.filter String string.not-null (string.split char.ws? got);
+       want  = list.filter String string.not-null (string.split char.ws? want);
+       got   = list.tail-or-nil String got;
+       want  = list.tail-or-nil String want;
+       to-ℕs = list.map String ℕ
+         (λ s ⇒ maybe.fold ℕ ℕ 0 (λ n ⇒ n) (string.to-ℕ s)) in
+  (to-ℕs got, to-ℕs want)
+
+def mem : ω.ℕ → ω.(List ℕ) → Bool =
+  λ n ⇒ list.foldlω ℕ Bool 'false (λ b n' ⇒ bool.or b (nat.eq n n'))
+
+def all-members : ω.(List ℕ) → ω.(List ℕ) → List ℕ =
+  λ g w ⇒ list.filter ℕ (λ n ⇒ mem n w) g
+
+def score-from-len : ω.(List ℕ) → ℕ =
+  λ xs ⇒
+    maybe.foldω (ℕ × List ℕ) ℕ 0
+      (λ xxs ⇒ list.foldlω ℕ ℕ 1 (λ c _ ⇒ nat.times 2 c) (snd xxs))
+      (list.uncons ℕ xs)
+
+def score : ω.Line → ℕ =
+  λ ln ⇒ score-from-len (all-members (fst ln) (snd ln))
+
+def total-score : ω.(List Line) → ℕ =
+  list.foldlω Line ℕ 0 (λ n l ⇒ nat.plus n (score l))
+
+#[main]
+def main =
+  io.bindω String True
+    (io.read-fileω "in/day4")
+    (λ s ⇒ io.dump ℕ
+      (letω lines = string.split (char.eq char.newline) s;
+            lines = list.mapω String Line split-line lines in
+       total-score lines))

day6.quox

@@ -0,0 +1,113 @@
+load "string.quox"
+load "io.quox"
+
+
+namespace real {
+  postulate0 ℝ : ★
+
+  #[compile-scheme "inexact"]
+  postulate to-ℝ : ℕ → ℝ
+
+  #[compile-scheme "sqrt"]
+  postulate sqrt : ℝ → ℝ
+
+  #[compile-scheme "(lambda (x) (exact (floor x)))"]
+  postulate floor : ℝ → ℕ
+
+  #[compile-scheme "(lambda (x) (exact (ceiling x)))"]
+  postulate ceiling : ℝ → ℕ
+
+  #[compile-scheme "(lambda% (x y) (+ x y))"]
+  postulate plus : ℝ → ℝ → ℝ
+
+  #[compile-scheme "(lambda% (x y) (- x y))"]
+  postulate minus : ℝ → ℝ → ℝ
+
+  #[compile-scheme "(lambda% (x y) (* x y))"]
+  postulate times : ℝ → ℝ → ℝ
+
+  #[compile-scheme "(lambda% (x y) (/ x y))"]
+  postulate divide : ℝ → ℝ → ℝ
+
+  #[compile-scheme "(lambda% (x y) (if (< x y) 'true 'false))"]
+  postulate lt : ω.ℝ → ω.ℝ → Bool
+
+  def negate : ℝ → ℝ = λ x ⇒ minus (to-ℝ 0) x
+
+  def quad : ω.ℝ → ω.ℝ → ω.ℝ → ℝ × ℝ =
+    λ a b c ⇒
+      letω res =
+        (λ op ⇒
+          let disc = minus (times b b) (times (to-ℝ 4) (times a c)) in
+          divide (op (negate b) (sqrt disc)) (times (to-ℝ 2) a))
+        ∷ (ℝ → ℝ → ℝ) → ℝ in
+      letω ordered =
+        (λ x y ⇒ bool.if (ℝ × ℝ) (lt x y) (x, y) (y, x)) ∷ ω.ℝ → ω.ℝ → ℝ × ℝ in
+      ordered (res plus) (res minus)
+}
+
+def0 ℝ = real.ℝ
+def to-ℝ = real.to-ℝ
+
+
+def range : ω.ℕ → ω.ℕ → ℕ × ℕ =
+  λ t d ⇒
+    letω d = to-ℝ d; t = to-ℝ t;
+         res = real.quad (real.negate (to-ℝ 1)) t (real.negate d);
+         lo = fst res; hi = snd res
+    in (real.ceiling lo, real.floor hi)
+
+def result : ω.(ℕ × ℕ) → ℕ =
+  λ td ⇒ letω r = range (fst td) (snd td) in succ (nat.minus (snd r) (fst r))
+
+
+def0 Game : ★ = ℕ × ℕ
+
+def to-ℕ' : String → ℕ =
+  λ s ⇒ maybe.fold ℕ ℕ 0 (λ n ⇒ n) (string.to-ℕ s)
+
+def split-line : ω.String → List ℕ =
+  λ l ⇒
+   letω strings = string.split char.ws? l;
+        strings = list.filter String string.not-null strings;
+        strings = list.tail-or-nil String strings in
+   list.map String ℕ to-ℕ' strings
+
+def split-file : ω.String → List Game =
+  λ str ⇒
+  letω both = string.break (λ c ⇒ char.eq c char.newline) str;
+       one = fst both; two = snd both;
+       times = split-line one; distances = split-line two in
+  list.zip-with-uneven ℕ ℕ Game (λ t d ⇒ (t, d)) times distances
+
+
+def space? : ω.Char → Bool = λ c ⇒ char.eq c char.space
+
+def squash : ω.String → String =
+  λ s ⇒
+    letω nonws? = (λ c ⇒ bool.not (char.ws? c)) ∷ ω.Char → Bool in
+    string.from-list (list.filter Char nonws? (string.to-list s))
+
+def from-line : ω.String → ℕ =
+  λ s ⇒ letω s = snd (string.break space? s) in to-ℕ' (squash s)
+
+def nonsplit-file : ω.String → Game =
+  λ str ⇒
+  letω both = string.break (λ c ⇒ char.eq c char.newline) str;
+       one = fst both; two = snd both in
+  (from-line one, from-line two)
+
+
+def product : List ℕ → ℕ = list.foldl ℕ ℕ 1 nat.times
+
+
+def part1 =
+  io.bindω String True
+    (io.read-fileω "in/day6")
+    (λ s ⇒ io.dump ℕ (product (list.mapω Game ℕ result (split-file s))))
+
+#[main]
+def part2 =
+  io.bindω String True
+    (io.read-fileω "in/day6")
+    (λ s ⇒ io.dump ℕ (result (nonsplit-file s)))

lib/bool.quox

@@ -1,39 +1,48 @@
-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);
+  λ 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-dep¹ (λ _ ⇒ ★) 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
+  λ b ⇒
-    [('true,  [δ _ ⇒ 'true])]
+  case b return b' ⇒ [ω. Sing Bool b'] of {
-    [('false, [δ _ ⇒ 'false])];
+    'true  ⇒ [('true,  [δ _ ⇒ 'true])];
+    'false ⇒ [('false, [δ _ ⇒ 'false])]
+  }
 
 def dup : Bool → [ω. Bool] =
-  λ b ⇒ appω (Sing Bool b) Bool (λ b' ⇒ sing.val Bool b b') (dup! b);
+  λ b ⇒ appω (Sing Bool b) Bool (λ b' ⇒ sing.val Bool b b') (dup! b)
 
 def true-not-false : Not ('true ≡ 'false : Bool) =
-  λ eq ⇒ coe (𝑖 ⇒ T (eq @𝑖)) 'true;
+  λ eq ⇒ coe (𝑖 ⇒ T (eq @𝑖)) 'true
 
 
 -- [todo] infix
-def and : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false;
+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 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 ⇒
+  case b return b' ⇒ not (not b') ≡ b' : Bool
+  of { 'true ⇒ δ _ ⇒ 'true; 'false ⇒ δ _ ⇒ 'false }
 
 }
 
-def0 Bool = bool.Bool;
+def0 Bool = bool.Bool

lib/either.quox

@@ -1,21 +1,21 @@
-load "misc.quox";
+load "misc.quox"
-load "bool.quox";
+load "bool.quox"
 
 namespace either {
 
-def0 Tag : ★ = {left, right};
+def0 Tag : ★ = {left, right}
 
 def0 Payload : ★ → ★ → Tag → ★ =
-  λ A B tag ⇒ case tag return ★ of { 'left ⇒ A; 'right ⇒ B };
+  λ A B tag ⇒ case tag return ★ of { 'left ⇒ A; 'right ⇒ B }
 
 def0 Either : ★ → ★ → ★ =
-  λ A B ⇒ (tag : Tag) × Payload A B tag;
+  λ A B ⇒ (tag : Tag) × Payload A B tag
 
 def Left : 0.(A B : ★) → A → Either A B =
-  λ A B x ⇒ ('left, x);
+  λ A B x ⇒ ('left, x)
 
 def Right : 0.(A B : ★) → B → Either A B =
-  λ A B x ⇒ ('right, x);
+  λ A B x ⇒ ('right, x)
 
 def elim' :
     0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
@@ -25,7 +25,7 @@ def elim' :
   λ A B P f g t ⇒
     case t
     return t' ⇒ (a : Payload A B t') → P (t', a)
-    of { 'left ⇒ f; 'right ⇒ g };
+    of { 'left ⇒ f; 'right ⇒ g }
 
 def elim :
     0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
@@ -33,25 +33,50 @@ def elim :
     ω.((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) ⇒ elim' A B P f g t a };
+    case e return e' ⇒ P e' of { (t, a) ⇒ elim' A B P f g t 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)) →
+    (t : Tag) → ω.(a : Payload A B t) → P (t, a) =
+  λ A B P f g t ⇒
+    case t
+    return t' ⇒ ω.(a : Payload A B t') → P (t', a)
+    of { 'left ⇒ f; 'right ⇒ g }
+
+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 ⇒ elimω' A B P f g (fst e) (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;
+def0 Either = either.Either
-def  Left   = either.Left;
+def  Left   = either.Left
-def  Right  = either.Right;
+def  Right  = either.Right
 
 
 namespace dec {
 
-def0 Dec : ★ → ★ = λ A ⇒ Either [0.A] [0.Not A];
+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 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 No  : 0.(A : ★) → 0.(Not A) → Dec A = λ A n ⇒ Right [0.A] [0.Not A] [n]
 
 def0 DecEq : ★ → ★ =
-  λ A ⇒ ω.(x : A) → ω.(y : A) → Dec (x ≡ y : A);
+  λ A ⇒ ω.(x : A) → ω.(y : A) → Dec (x ≡ y : A)
 
 def elim :
     0.(A : ★) → 0.(P : 0.(Dec A) → ★) →
@@ -61,14 +86,20 @@ def elim :
   λ A P f g ⇒
     either.elim [0.A] [0.Not A] P
       (λ y ⇒ case0 y return y' ⇒ P (Left  [0.A] [0.Not A] y') of {[y'] ⇒ f y'})
-      (λ n ⇒ case0 n return n' ⇒ P (Right [0.A] [0.Not A] n') of {[n'] ⇒ g n'});
+      (λ n ⇒ case0 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);
+  λ 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 Dec   = dec.Dec
-def0 DecEq = dec.DecEq;
+def0 DecEq = dec.DecEq
-def  Yes   = dec.Yes;
+def  Yes   = dec.Yes
-def  No    = dec.No;
+def  No    = dec.No

lib/io.quox

@@ -14,6 +14,15 @@ 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 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 })
 
@@ -24,6 +33,9 @@ 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 (display str) (newline) 'true))"]
+postulate dump : 0.(A : ★) → A → IO True
+
 def newline = print "\n"
 
 def println : String → IO True =
@@ -64,7 +76,12 @@ def read-line : File → IO (Maybe [ω.String] × File) =
 
 #[compile-scheme
  "(lambda (path) (builtin-io (call-with-input-file path get-string-all)))"]
-postulate read-file : ω.(path : String) → IO String
+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

lib/list.quox

@@ -1,6 +1,6 @@
-load "nat.quox";
+load "nat.quox"
-load "maybe.quox";
+load "maybe.quox"
-load "bool.quox";
+load "bool.quox"
 
 namespace vec {
 
@@ -9,7 +9,28 @@ def0 Vec : ℕ → ★ → ★ =
   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 elim : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
            P 0 'nil →
@@ -24,7 +45,26 @@ def elim : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
         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)
+          }
+        }
+    }
 
 -- haha gross
 def elimω : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
@@ -40,7 +80,36 @@ def elimω : 0.(A : ★) → 0.(P : (n : ℕ) → Vec n A → ★) →
         caseω cons return cons' ⇒ P (succ n) cons' of {
           (first, rest) ⇒ pc first n rest (ih rest)
         }
-    };
+    }
+
+def elimω2 : 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 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))
 
 #[compile-scheme "(lambda% (n xs) xs)"]
 def up : 0.(A : ★) → (n : ℕ) → Vec n A → Vec¹ n A =
@@ -56,19 +125,22 @@ def up : 0.(A : ★) → (n : ℕ) → Vec n A → Vec¹ n A =
 
 }
 
-def0 Vec = vec.Vec;
+def0 Vec = vec.Vec
 
 
 namespace list {
 
 def0 List : ★ → ★ =
-  λ A ⇒ (len : ℕ) × Vec len A;
+  λ A ⇒ (len : ℕ) × Vec len A
 
 def Nil : 0.(A : ★) → List A =
-  λ A ⇒ (0, 'nil);
+  λ 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) };
+  λ 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) →
@@ -79,7 +151,7 @@ def elim : 0.(A : ★) → 0.(P : List A → ★) →
       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)) →
@@ -90,7 +162,22 @@ def elimω : 0.(A : ★) → 0.(P : List A → ★) →
       vec.elimω A (λ n xs ⇒ P (n, xs))
         pn (λ x n xs ih ⇒ pc x (n, xs) ih)
         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 ⇒
+    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 : 0.(A B : ★) → ω.B → ω.(A → List A → B) → List A → B =
+  λ A B ⇒ match-dep A (λ _ ⇒ B)
+
 
 -- [fixme] List A <: List¹ A should be automatic, imo
 #[compile-scheme "(lambda (xs) xs)"]
@@ -104,44 +191,228 @@ def up : 0.(A : ★) → List A → List¹ A =
         }
       }
     }
-  };
+  }
 
 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;
+  λ 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;
+    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);
+  λ 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;
+  λ 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;
+    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);
+  λ 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);
+  λ 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;
+  λ 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);
+  λ 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));
+    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 xs ⇒ maybe.mapω (A × List A) A (λ xxs ⇒ fst xxs) (uncons A xs)
+
+def tail : 0.(A : ★) → ω.(List A) → Maybe (List A) =
+  λ A xs ⇒ maybe.mapω (A × List A) (List A) (λ xxs ⇒ snd xxs) (uncons A xs)
+
+def tail-or-nil : 0.(A : ★) → ω.(List A) → List A =
+  λ A xs ⇒ maybe.fold (List A) (List A) (Nil A) (λ xs ⇒ xs) (tail A xs)
+
+def slip : 0.(A : ★) → List A × List A → List A × List A =
+  λ A xsys ⇒
+    case xsys return List A × List A of { (xs, ys) ⇒
+      maybe.fold (A × List A) (List A → List A × List A)
+        (λ     xs ⇒ (xs, Nil A))
+        (λ yys xs ⇒
+          case yys return List A × List A of { (y, ys) ⇒ (Cons A y xs, ys) })
+        (uncons A 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
+
+
+def0 ZipWithFailureVec : (m n : ℕ) → (A B : ★) → Vec m A → Vec n B → ★ =
+  λ m n A B xs ys ⇒ Sing (Vec m A) xs × Sing (Vec n B) ys × [0. Not (m ≡ n : ℕ)]
+
+def0 ZipWithFailure : (A B : ★) → List A → List B → ★ =
+  λ A B xs ys ⇒ ZipWithFailureVec (fst xs) (fst ys) A B (snd xs) (snd ys)
+
+{-
+-- unfinished
+def zip-with : 0.(A B C : ★) → ω.(A → B → C) →
+               (xs : List A) → (ys : List B) →
+               Either (ZipWithFailure A B xs ys) (List C) =
+  λ A B C f xs' ys' ⇒
+  let0 Ret = Either (ZipWithFailure A B xs' ys') (List C) in
+  case xs' return Ret of { (m', xs) ⇒
+  case ys' return Ret of { (n', ys) ⇒
+  case nat.dup! m' return Ret of { [m!] ⇒
+  let ω.m = fst m!; 0.mm' = get0 (m ≡ m' : ℕ) (snd m!) in
+  case nat.dup! n' return Ret of { [n!] ⇒
+  let ω.n = fst n!; 0.nn' = get0 (n ≡ n' : ℕ) (snd n!) in
+  let1 xs = coe (𝑖 ⇒ Vec (mm' @𝑖) A) @1 @0 xs ∷ Vec m A in
+  let1 ys = coe (𝑖 ⇒ Vec (nn' @𝑖) B) @1 @0 ys ∷ Vec n B in
+    dec.elim (m ≡ n : ℕ) Ret
+      (λ mn ⇒
+        let xs = coe (𝑖 ⇒ Vec (mn @𝑖) A) xs ∷ Vec n A in
+        Right (ZipWithFailure A B xs' ys') (List C)
+          (n, vec.zip-with A B C n xs ys))
+      (λ nmn ⇒
+        Left (ZipWithFailure A B xs' ys') (List C)
+          (?, ?, [nmn]) -- <---------------------
+      (nat.eq? m n)
+  }}}}
+-}
+
+
+def zip-withω : 0.(A B C : ★) → ω.(ω.A → ω.B → C) →
+                ω.(xs : List A) → ω.(ys : List B) →
+                Either (ZipWithFailure A B xs ys) (List C) =
+  λ A B C f xs' ys' ⇒
+    let0 Err = ZipWithFailure A B xs' ys';
+         Ret = Either Err (List C) in
+    letω m = fst xs'; xs = snd xs';
+         n = fst ys'; ys = snd ys' in
+    dec.elim (m ≡ n : ℕ) (λ _ ⇒ Ret)
+      (λ 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) (sing (Vec m A) xs, sing (Vec n B) ys, [nmn]))
+      (nat.eq? m n)
+
+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
+
+
+{-
+-- unfinished
+def zip-with : 0.(A B C : ★) → ω.(A → B → C) →
+               (xs : List A) → (ys : List B) →
+               Either (Sing (List A) xs × Sing (List B) ys ×
+                       Not (length A xs ≡ length B ys : ℕ))
+                      (List C) =
+  λ A B C f xs' ys' ⇒
+    let0 Err = (Sing (List A) xs' × Sing (List B) ys' ×
+                Not (length A xs' ≡ length B ys' : ℕ)) ∷ ★;
+         Ret = Either Err (List C) in
+    case xs' return Ret of { (m', xs) ⇒
+      case ys' return Ret of { (n', ys) ⇒
+        case nat.dup! m' return Ret of { [msing] ⇒
+          case nat.dup! n' return Ret of { [nsing] ⇒
+            let1 m = fst msing; n = fst nsing in
+            let0 mm' = get0 (m ≡ m' : ℕ) (snd msing);
+                 nn' = get0 (n ≡ n' : ℕ) (snd nsing) in
+            dec.elim (m ≡ n : ℕ) (λ _ ⇒ Ret)
+              (λ mn ⇒
+                let0 m'n = trans ℕ m' m n (sym ℕ m m' mm') mn ∷ m' ≡ n : ℕ in
+                let1 xs = coe (𝑖 ⇒ Vec (m'n @𝑖) A) xs ∷ Vec n A;
+                     ys = coe (𝑖 ⇒ Vec (nn' @𝑖) B) @1 @0 ys ∷ Vec n B in
+                Right Err (List C) (n, vec.zip-with A B C f n xs ys))
+              (λ nmn ⇒
+                let xs =
+                  ((m, coe (𝑖 ⇒ Vec (mm' @𝑖) A) @1 @0 xs),
+                   [δ 𝑗 ⇒ (mm' @𝑗, coe (𝑖 ⇒ Vec (mm' @𝑖) A) @1 @𝑗 xs)])
+                  ∷ Sing (List A) xs' in
+                  -- sing (List A) (m, coe (𝑖 ⇒ Vec (mm' @𝑖) A) @1 @0 xs);
+                let ys = sing (List B) (n, coe (𝑖 ⇒ Vec (nn' @𝑖) B) @1 @0 ys) in
+                Left Err (List C) (xs, ys, nmn))
+          }
+        }
+      }
+    }
+-}
 
 
 postulate0 SchemeList : ★ → ★
@@ -160,4 +431,4 @@ postulate to-scheme : 0.(A : ★) → List A → SchemeList A
 
 }
 
-def0 List = list.List;
+def0 List = list.List

lib/maybe.quox

@@ -126,6 +126,12 @@ def pair : 0.(A B : ★) → ω.(Maybe A) → ω.(Maybe B) → Maybe (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)

lib/misc.quox

@@ -1,11 +1,18 @@
 def0 True : ★ = {true}
 
+namespace true {
+  def drop : 0.(A : ★) → True → A → A =
+    λ A t x ⇒ case t return A of { 'true ⇒ x }
+}
+
 def0 False : ★ = {}
 def0 Not : ★ → ★ = λ A ⇒ ω.A → False
 
 def void : 0.(A : ★) → 0.False → A =
   λ A v ⇒ case0 v return A of { }
 
+def0 Iff : ★ → ★ → ★ = λ A B ⇒ (A → B) × (B → A)
+
 def0 All : (A : ★) → (0.A → ★) → ★ =
   λ A P ⇒ (x : A) → P x
 
@@ -60,6 +67,16 @@ def app2ω : 0.(A B C : ★) → ω.(f : ω.A → ω.B → C) → [ω.A] → [ω
 def getω : 0.(A : ★) → [ω.A] → A =
   λ A x ⇒ case x return A of { [x] ⇒ x }
 
+def0 get0 : (A : ★) → [0.A] → A =
+  λ A x ⇒ case x return A of { [x] ⇒ x }
+
+def drop0 : 0.(A B : ★) → [0.B] → A → A =
+  λ A B x y ⇒ case x return A of { [_] ⇒ y }
+
+def0 drop0-eq : (A B : ★) → (x : [0.B]) → (y : A) → drop0 A B x y ≡ y : A =
+  λ A B x y ⇒
+  case x return x' ⇒ drop0 A B x' y ≡ y : A of { [_] ⇒ δ 𝑖 ⇒ y }
+
 def0 HEq : (A B : ★) → A → B → ★¹ =
   λ A B x y ⇒ (AB : A ≡ B : ★) × Eq (𝑖 ⇒ AB @𝑖) x y
 
@@ -73,14 +90,16 @@ def sing : 0.(A : ★) → (x : A) → Sing A x =
 namespace sing {
 
 def val : 0.(A : ★) → 0.(x : A) → Sing A x → A =
-  λ A _ sg ⇒
+  λ A x sg ⇒
-  case sg return A of { (x, eq) ⇒ case eq return A of { [_] ⇒ x } }
+  case sg return A of { (x', eq) ⇒ drop0 A (x' ≡ x : 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 A (fst sg ≡ x : A) (snd sg) (fst sg)
 
 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) ⇒
+  trans A (val A x sg) (fst sg) x
-    case eq return eq' ⇒ val A x (x', eq') ≡ x : A of { [eq'] ⇒ eq' }
+    (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) =
@@ -88,5 +107,4 @@ def app : 0.(A B : ★) → 0.(x : A) →
   case sg return Sing B (f x) of { (x_, eq) ⇒
     case eq return Sing B (f x) of { [eq] ⇒ (f x_, [δ 𝑖 ⇒ f (eq @𝑖)]) }
   }
-
 }

lib/nat.quox

@@ -19,7 +19,7 @@ def elim-0-1 :
       }
   }
 
-def elim-pair :
+def elim-pair' :
     0.(P : ℕ → ℕ → ★) →
     ω.(P 0 0) →
     ω.(0.(n : ℕ)   → P 0 n → P 0 (succ n)) →
@@ -38,6 +38,25 @@ def elim-pair :
       }
     }
 
+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')
+      }
+    }
+
 #[compile-scheme "(lambda (n) (cons n 'erased))"]
 def dup! : (n : ℕ) → [ω. Sing ℕ n] =
   λ n ⇒
@@ -51,6 +70,10 @@ def dup! : (n : ℕ) → [ω. Sing ℕ n] =
 def dup : ℕ → [ω.ℕ] =
   λ n ⇒ appω (Sing ℕ n) ℕ (λ n' ⇒ sing.val ℕ n n') (dup! n);
 
+#[compile-scheme "(lambda% (n x) x)"]
+def drop : 0.(A : ★) → ℕ → A → A =
+  λ A n x ⇒ case n return A of { 0 ⇒ x; succ _, ih ⇒ ih }
+
 #[compile-scheme "(lambda% (m n) (+ m n))"]
 def plus : ℕ → ℕ → ℕ =
   λ m n ⇒
@@ -87,6 +110,14 @@ def minus : ℕ → ℕ → ℕ =
   }) m;
 
 
+def minω : ω.ℕ → ω.ℕ → ℕ =
+  elim-pairω (λ _ _ ⇒ ℕ) 0 (λ _ _ ⇒ 0) (λ _ _ ⇒ 0) (λ _ _ x ⇒ succ x)
+
+def min : ℕ → ℕ → ℕ =
+  λ m n ⇒
+  case dup m return ℕ of { [m] ⇒ case dup n return ℕ of { [n] ⇒ minω m n } }
+
+
 def0 IsSucc : ℕ → ★ =
   λ n ⇒ case n return ★ of { zero ⇒ False; succ _ ⇒ True };
 
@@ -114,62 +145,57 @@ def0 not-succ-self : (m : ℕ) → Not (m ≡ succ m : ℕ) =
 
 #[compile-scheme "(lambda% (m n) (if (= m n) Yes No))"]
 def eq? : DecEq ℕ =
-  λ m ⇒
+  λ m n ⇒
-  caseω m
+  elim-pair' (λ m n ⇒ Dec (m ≡ n : ℕ))
-  return m' ⇒ ω.(n : ℕ) → Dec (m' ≡ n : ℕ)
+    (Yes (0 ≡ 0 : ℕ) (δ 𝑖 ⇒ 0))
-  of {
+    (λ n p ⇒
-    zero ⇒ λ n ⇒
+      dec.drop (0 ≡ n : ℕ) (Dec (0 ≡ succ n : ℕ)) p
-      caseω n return n' ⇒ Dec (zero ≡ n' : ℕ) of {
+        (No (0 ≡ succ n : ℕ) (λ zs ⇒ zero-not-succ n zs)))
-        zero    ⇒ Yes (zero ≡ zero    : ℕ) (δ _ ⇒ zero);
+    (λ m p ⇒
-        succ n' ⇒ No  (zero ≡ succ n' : ℕ) (λ eq ⇒ zero-not-succ n' eq)
+      dec.drop (m ≡ 0 : ℕ) (Dec (succ m ≡ 0 : ℕ)) p
-      };
+        (No (succ m ≡ 0 : ℕ) (λ sz ⇒ succ-not-zero m sz)))
-    succ m', ω.ih ⇒ λ n ⇒
+    (λ m n ⇒
-      caseω n return n' ⇒ Dec (succ m' ≡ n' : ℕ) of {
+      dec.elim (m ≡ n : ℕ) (λ _ ⇒ Dec (succ m ≡ succ n : ℕ))
-        zero    ⇒ No (succ m' ≡ zero : ℕ) (λ eq ⇒ succ-not-zero m' eq);
+        (λ yy ⇒ Yes (succ m ≡ succ n : ℕ) (δ 𝑖  ⇒ succ (yy @𝑖)))
-        succ n' ⇒
+        (λ nn ⇒ No  (succ m ≡ succ n : ℕ) (λ yy ⇒ nn (succ-inj m n yy))))
-          dec.elim (m' ≡ n' : ℕ) (λ _ ⇒ Dec (succ m' ≡ succ n' : ℕ))
+    m n
-            (λ y ⇒ Yes (succ m' ≡ succ n' : ℕ) (δ 𝑖 ⇒ succ (y @𝑖)))
-            (λ n ⇒ No  (succ m' ≡ succ n' : ℕ) (λ eq ⇒ n (succ-inj m' n' eq)))
-            (ih n')
-      }
-  };
 
 
 def0 Ordering : ★ = {lt, eq, gt}
 
-def from-ordering : 0.(A : ★) → ω.A → ω.A → ω.A → Ordering → A =
+namespace ordering {
-  λ A lt eq gt o ⇒
+  def from : 0.(A : ★) → ω.A → ω.A → ω.A → Ordering → A =
-  case o return A of { 'lt ⇒ lt; 'eq ⇒ eq; 'gt ⇒ gt }
+    λ A lt eq gt o ⇒
+    case o return A of { 'lt ⇒ lt; 'eq ⇒ eq; 'gt ⇒ gt }
 
-def drop-ordering : 0.(A : ★) → Ordering → A → A =
+  def drop : 0.(A : ★) → Ordering → A → A =
-  λ A o x ⇒ case o return A of { 'lt ⇒ x; 'eq ⇒ x; 'gt ⇒ x }
+    λ 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)
+  elim-pair' (λ _ _ ⇒ Ordering)
     'eq
-    (λ _ o   ⇒ drop-ordering Ordering o 'lt)
+    (λ _ o   ⇒ ordering.drop Ordering o 'lt)
-    (λ _ o   ⇒ drop-ordering Ordering o 'gt)
+    (λ _ o   ⇒ ordering.drop Ordering o 'gt)
     (λ _ _ x ⇒ x)
 
 def compare : ℕ → ℕ → Ordering =
-  λ m n ⇒
+  λ m n ⇒ case dup m return Ordering of { [m] ⇒ compareω m n }
-  case dup m return Ordering of { [m] ⇒
-  case dup n return Ordering of { [n] ⇒ compareω m n } }
 
-def lt : ω.ℕ → ω.ℕ → Bool =
+def lt : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ ordering.eq (compare m n) 'lt
-  λ m n ⇒ from-ordering Bool 'true 'false 'false (compare m n)
+def eq : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ ordering.eq (compare m n) 'eq
-
+def gt : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ ordering.eq (compare m n) 'gt
-def le : ω.ℕ → ω.ℕ → Bool =
+def ne : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ bool.not (eq m n)
-  λ m n ⇒ from-ordering Bool 'true 'true 'false (compare m n)
+def le : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ bool.not (gt m n)
-
+def ge : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ bool.not (lt m n)
-def eq : ω.ℕ → ω.ℕ → Bool =
-  λ m n ⇒ from-ordering Bool 'false 'true 'false (compare m n)
-
-def gt : ω.ℕ → ω.ℕ → Bool =
-  λ m n ⇒ from-ordering Bool 'false 'false 'true (compare m n)
-
-def ge : ω.ℕ → ω.ℕ → Bool =
-  λ m n ⇒ from-ordering Bool 'false 'true 'true (compare m n)
 
 
 def0 plus-zero : (m : ℕ) → m ≡ plus m 0 : ℕ =

lib/string.quox

@@ -0,0 +1,106 @@
+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 ⇒
+  case dup c return Bool of { [c] ⇒
+    bool.or (bool.or (eq c space) (eq c tab)) (eq c newline)
+  }
+
+def digit? : ω.Char → Bool =
+  λ c ⇒ case dup c return Bool of { [c] ⇒
+    bool.and (ge c (from-ℕ 0x30)) (le c (from-ℕ 0x39))
+  }
+
+def digit-val : Char → ℕ =
+  λ c ⇒
+  case dup c return ℕ of { [c] ⇒
+    bool.if ℕ (digit? c) (nat.minus (to-ℕ c) 0x30) 0
+  }
+
+}
+
+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)
+
+#[compile-scheme
+  "(lambda% (fail ok str) (cond [(string->number str) => ok] [else fail]))"]
+postulate to-ℕ' : 0.(B : ★) → ω.B → ω.(ℕ → B) → String → B
+
+def to-ℕ : String → Maybe ℕ =
+  to-ℕ' (Maybe ℕ) (Nothing ℕ) (Just ℕ)
+
+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% (a b) (if (string=? a b) 'true 'false))"]
+postulate eq : ω.String → ω.String → Bool
+
+def null : ω.String → Bool = eq ""
+def not-null : ω.String → Bool = λ s ⇒ bool.not (null s)
+
+}

pack.toml

@@ -1,13 +1,23 @@
 collection = "nightly-231020"
 
 [custom.all.quox-lib]
-type   = "git"
+type   = "local"
-url    = "https://git.rhiannon.website/rhi/quox.git"
+path   = "../quox/lib"
-commit = "latest:🐉"
+ipkg   = "quox-lib.ipkg"
-ipkg   = "lib/quox-lib.ipkg"
 
 [custom.all.quox]
-type   = "git"
+type   = "local"
-url    = "https://git.rhiannon.website/rhi/quox.git"
+path   = "../quox/exe"
-commit = "latest:🐉"
+ipkg   = "quox.ipkg"
-ipkg   = "exe/quox.ipkg"
+
+# [custom.all.quox-lib]
+# type   = "git"
+# url    = "https://git.rhiannon.website/rhi/quox.git"
+# commit = "latest:🐉"
+# ipkg   = "lib/quox-lib.ipkg"
+
+# [custom.all.quox]
+# type   = "git"
+# url    = "https://git.rhiannon.website/rhi/quox.git"
+# commit = "latest:🐉"
+# ipkg   = "exe/quox.ipkg"