i gotta clean this up lol

This commit is contained in:
rhiannon morris 2023-12-07 03:47:23 +01:00
parent 43743266a1
commit 6b8818376b
14 changed files with 1007 additions and 127 deletions

124
day1.pdc Normal file
View File

@ -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

11
day2.ss
View File

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

96
day3.quox Normal file
View File

@ -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)
}
}

54
day4.quox Normal file
View File

@ -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))

113
day6.quox Normal file
View File

@ -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)))

View File

@ -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
[('true, [δ _ ⇒ 'true])]
[('false, [δ _ ⇒ 'false])];
λ b ⇒
case b return b' ⇒ [ω. Sing Bool b'] of {
'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 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
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

View File

@ -1,21 +1,21 @@
load "misc.quox";
load "bool.quox";
load "misc.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;
def Left = either.Left;
def Right = either.Right;
def0 Either = either.Either
def Left = either.Left
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 No : 0.(A : ★) → 0.(Not A) → Dec A = λ A n ⇒ Right [0.A] [0.Not A] [n];
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]
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 DecEq = dec.DecEq;
def Yes = dec.Yes;
def No = dec.No;
def0 Dec = dec.Dec
def0 DecEq = dec.DecEq
def Yes = dec.Yes
def No = dec.No

View File

@ -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

View File

@ -1,6 +1,6 @@
load "nat.quox";
load "maybe.quox";
load "bool.quox";
load "nat.quox"
load "maybe.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

View File

@ -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)

View File

@ -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 ⇒
case sg return A of { (x, eq) ⇒ case eq return A of { [_] ⇒ x } }
λ A x sg ⇒
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) ⇒
case eq return eq' ⇒ val A x (x', eq') ≡ x : A of { [eq'] ⇒ eq' }
}
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) =
@ -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 @𝑖)]) }
}
}

View File

@ -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 ⇒
caseω m
return m' ⇒ ω.(n : ) → Dec (m' ≡ n : )
of {
zero ⇒ λ n ⇒
caseω n return n' ⇒ Dec (zero ≡ n' : ) of {
zero ⇒ Yes (zero ≡ zero : ) (δ _ ⇒ zero);
succ n' ⇒ No (zero ≡ succ n' : ) (λ eq ⇒ zero-not-succ n' eq)
};
succ m', ω.ih ⇒ λ n ⇒
caseω n return n' ⇒ Dec (succ m' ≡ n' : ) of {
zero ⇒ No (succ m' ≡ zero : ) (λ eq ⇒ succ-not-zero m' eq);
succ n' ⇒
dec.elim (m' ≡ n' : ) (λ _ ⇒ Dec (succ m' ≡ succ n' : ))
(λ y ⇒ Yes (succ m' ≡ succ n' : ) (δ 𝑖 ⇒ succ (y @𝑖)))
(λ n ⇒ No (succ m' ≡ succ n' : ) (λ eq ⇒ n (succ-inj m' n' eq)))
(ih n')
}
};
λ 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}
def from-ordering : 0.(A : ★) → ω.A → ω.A → ω.A → Ordering → A =
λ A lt eq gt o ⇒
case o return A of { 'lt ⇒ lt; 'eq ⇒ eq; 'gt ⇒ 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-ordering : 0.(A : ★) → Ordering → A → A =
λ A o x ⇒ case o return A of { 'lt ⇒ x; 'eq ⇒ x; 'gt ⇒ x }
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)
elim-pair' (λ _ _ ⇒ Ordering)
'eq
(λ _ o ⇒ drop-ordering Ordering o 'lt)
(λ _ o ⇒ drop-ordering Ordering o 'gt)
(λ _ o ⇒ ordering.drop Ordering o 'lt)
(λ _ o ⇒ ordering.drop Ordering o 'gt)
(λ _ _ x ⇒ x)
def compare : → Ordering =
λ m n ⇒
case dup m return Ordering of { [m] ⇒
case dup n return Ordering of { [n] ⇒ compareω m n } }
λ m n ⇒ case dup m return Ordering of { [m] ⇒ compareω m n }
def lt : ω. → ω. → Bool =
λ m n ⇒ from-ordering Bool 'true 'false 'false (compare m n)
def le : ω. → ω. → Bool =
λ m n ⇒ from-ordering Bool 'true 'true 'false (compare 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)
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 : =

106
lib/string.quox Normal file
View File

@ -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)
}

View File

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