aoc2023/day1-standalone.quox
2023-12-01 18:52:23 +01:00

371 lines
9.9 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

namespace bool {
def0 Bool : ★ = {true, false}
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;
}
def0 Bool = bool.Bool
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
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 =
λ _ ⇒ ('nothing, 'unit)
def Just : 0.(A : ★) → A → Maybe A =
λ _ x ⇒ ('just, x)
def fold' : 0.(A B : ★) → ω.B → ω.(ω.A → B) →
ω.(t : Tag) → ω.(Payload t A) → B =
λ A B nothing just tag ⇒
case tag return t ⇒ ω.(Payload t A) → B of {
'nothing ⇒ λ _ ⇒ nothing;
'just ⇒ just
}
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 }
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 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 (λ x ⇒ Just A x) l
}
def0 Maybe = maybe.Maybe
def Just = maybe.Just
def Nothing = maybe.Nothing
namespace vec {
def0 Vec : → ★ → ★ =
λ n A ⇒
case n return ★ of {
0 ⇒ Unit;
succ _, 0.Tail ⇒ A × Tail
}
def foldr : 0.(A B : ★) → B → ω.(A → B → B) → (n : ) → Vec n A → B =
λ A B nil cons len ⇒
case len return l ⇒ Vec l A → B of {
0 ⇒ λ u ⇒ unit.drop B nil u;
succ n, f ⇒ λ lst ⇒
case lst return B of { (first, rest) ⇒ cons first (f rest) }
}
-- uggh
def foldrω : 0.(A B : ★) → ω.B → ω.(ω.A → ω.B → B) →
ω.(n : ) → ω.(Vec n A) → B =
λ A B nil cons len ⇒
caseω len return l ⇒ ω.(Vec l A) → B of {
0 ⇒ λ _ ⇒ nil;
succ n, ω.f ⇒ λ lst ⇒ cons (fst lst) (f (snd lst))
}
}
namespace list {
def0 List : ★ → ★ =
λ A ⇒ (len : ) × vec.Vec len A
def Nil : 0.(A : ★) → List A =
λ A ⇒ (0, 'unit)
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 foldr : 0.(A B : ★) → B → ω.(A → B → B) → List A → B =
λ A B nil cons lst ⇒
case lst return B of { (len, elems) ⇒ vec.foldr A B nil cons len elems }
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 foldrω : 0.(A B : ★) → ω.B → ω.(ω.A → ω.B → B) → ω.(List A) → B =
λ A B nil cons lst ⇒
caseω lst return B of { (len, elems) ⇒ vec.foldrω A B nil cons len elems }
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)
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))
postulate0 SchemeList : ★ → ★
#[compile-scheme
"(lambda (list) (cons (length list) (fold-right cons 'unit list)))"]
postulate from-scheme : 0.(A : ★) → SchemeList A → List A
}
def0 List = list.List
def Nil = list.Nil
def Cons = list.Cons
namespace nat {
-- recurse over two numbers in lockstep until one reaches zero
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) n)"]
def dup : → [ω. ] =
λ n ⇒
case n return n' ⇒ [ω. ] of {
0 ⇒ [0];
succ n, d ⇒ case d return [ω.] of { [n'] ⇒ [succ n'] }
};
#[compile-scheme "(lambda% (m n) (+ m n))"]
def plus : =
λ m n ⇒
case m return of {
0 ⇒ n;
succ _, p ⇒ succ p
};
#[compile-scheme "(lambda% (m n) (* m n))"]
def timesω : → ω. =
λ m n ⇒
case m return of {
0 ⇒ 0;
succ _, t ⇒ plus n t
};
def times : =
λ m n ⇒ case dup n return of { [n] ⇒ timesω m n };
def pred : =
λ n ⇒ case n return of { 0 ⇒ 0; succ n ⇒ n };
#[compile-scheme "(lambda% (m n) (max 0 (- m n)))"]
def minus : =
λ m n ⇒
case dup m return of { [m] ⇒
elim-pair (λ _ _ ⇒ )
0
(λ _ p ⇒ succ p)
(λ _ p ⇒ p)
(λ _ _ p ⇒ p)
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 }
def drop-ordering : 0.(A : ★) → Ordering → A → A =
λ A o x ⇒ case o return A of { 'lt ⇒ x; 'eq ⇒ x; 'gt ⇒ x }
def compareω : ω. → Ordering =
elim-pair (λ _ _ ⇒ Ordering)
'eq
(λ _ o ⇒ drop-ordering Ordering o 'lt)
(λ _ o ⇒ drop-ordering Ordering o 'gt)
(λ _ _ x ⇒ x)
def compare : → Ordering =
λ m n ⇒ case dup m return Ordering of { [m] ⇒ compareω m n }
def le : ω. → ω. → Bool =
λ m n ⇒
case compare m n return Bool
of { 'lt ⇒ 'true; 'eq ⇒ 'true; 'gt ⇒ 'false }
}
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 map : 0.(A B : ★) → (A → B) → IO A → IO B =
λ A B f act ⇒ bind A B act (λ x ⇒ pure B (f x))
def seq : 0.(B : ★) → IO Unit → IO B → IO B =
λ B x y ⇒ bind Unit B x (λ u ⇒ case u return IO B of { 'unit ⇒ y })
def seq' : IO Unit → IO Unit → IO Unit = seq Unit
#[compile-scheme "(lambda (x) (builtin-io (display x) (newline)))"]
postulate dump : 0.(A : ★) → A → IO Unit
#[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 prim-read-file-lines :
ω.(path : String) → IO (list.SchemeList String)
def read-file-lines : ω.(path : String) → IO (List String) =
λ path ⇒
map (list.SchemeList String) (List String)
(list.from-scheme String)
(prim-read-file-lines path)
}
def0 IO = io.IO
namespace char {
postulate0 Char : ★
#[compile-scheme "char->integer"]
postulate ord : Char →
#[compile-scheme "integer->char"]
postulate chr : → Char
#[compile-scheme "(lambda (c) c)"]
postulate dup : Char → [ω.Char]
def le : ω.Char → ω.Char → Bool =
λ x y ⇒ nat.le (ord x) (ord y)
def between : ω.Char → ω.Char → ω.Char → Bool =
λ lo hi c ⇒
case dup c return Bool of { [c] ⇒ bool.and (le lo c) (le c hi) }
def is-digit : ω.Char → Bool =
between (chr 0x30) (chr 0x39)
def digit : Char → =
λ c ⇒ nat.minus (ord c) 0x30
#[compile-scheme "(lambda (c) (builtin-io (display c) (newline)))"]
postulate println : Char → IO Unit
}
def0 Char = char.Char
namespace string {
#[compile-scheme "string->list"]
postulate prim-to-list : String → list.SchemeList Char
def to-list : String → List Char =
λ str ⇒ list.from-scheme Char (prim-to-list str)
#[compile-scheme "(lambda (str) str)"]
postulate dup : String → [ω.String]
}
def find-first-last :
0.(A : ★) →
ω.(ω.A → Bool) →
ω.(List A) → Maybe (A × A) =
λ A p xs ⇒
maybe.pair A A
(list.find A p xs)
(list.find A p (list.reverse A xs))
def number' : Char → Char → =
λ tens units ⇒ nat.plus (nat.times 10 (char.digit tens)) (char.digit units)
def number : String → =
λ line ⇒
case string.dup line return of {
[line] ⇒
maybe.fold (Char × Char) 0
(λ cd ⇒ case cd return of { (c, d) ⇒ number' c d })
(find-first-last Char char.is-digit (string.to-list line))
}
def part1 : List String → =
list.foldr String 0 (λ str n ⇒ nat.plus (number str) n)
#[main]
def main : IO Unit =
io.bind (List String) Unit
(io.read-file-lines "in/day1")
(λ lines ⇒ io.dump (part1 lines))