├── .gitignore ├── README.md ├── bits.ya ├── bytes.ya ├── unit.ya ├── eq.ya ├── empty.ya ├── io_test.ya ├── applicative.ya ├── is.ya ├── either.ya ├── functor.ya ├── introit.ya ├── pair.ya ├── b_tree.ya ├── .github └── workflows │ └── nix.yml ├── boolean.ya ├── bool.ya ├── dict_test.ya ├── parsec ├── state.ya ├── reply.ya └── error.ya ├── io.ya ├── equal.ya ├── flake.nix ├── function.ya ├── bitstring.ya ├── LICENSE ├── ord.ya ├── nat.ya ├── matrix.ya ├── maybe.ya ├── alternative.ya ├── monad.ya ├── natural.ya ├── char.ya ├── vector.ya ├── parser.ya ├── u8.ya ├── list.ya ├── list_sort.ya ├── u16.ya ├── u32.ya ├── flake.lock ├── i8.ya ├── u64.ya ├── i16.ya ├── text.ya ├── i32.ya ├── i64.ya ├── show.ya ├── dict.ya ├── parsec.ya └── map.ya /.gitignore: -------------------------------------------------------------------------------- 1 | .yatima 2 | .history 3 | history.txt 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # introit 2 | The Yatima Standard Library 3 | -------------------------------------------------------------------------------- /bits.ya: -------------------------------------------------------------------------------- 1 | package bits where 2 | 3 | def Bits: Type = #Bits 4 | -------------------------------------------------------------------------------- /bytes.ya: -------------------------------------------------------------------------------- 1 | package bytes where 2 | 3 | def Bytes: Type = #Bytes 4 | -------------------------------------------------------------------------------- /unit.ya: -------------------------------------------------------------------------------- 1 | package unit where 2 | 3 | // The type with only one inhabitant: 4 | type Unit { 5 | New 6 | } 7 | 8 | -------------------------------------------------------------------------------- /eq.ya: -------------------------------------------------------------------------------- 1 | package eq 2 | import bool 3 | where 4 | 5 | type Eq (A: Type) { 6 | New (eq: ∀ (a b: A) -> Bool), 7 | } 8 | 9 | -------------------------------------------------------------------------------- /empty.ya: -------------------------------------------------------------------------------- 1 | package empty where 2 | 3 | type Empty { } 4 | 5 | def Empty.absurd (0 A: Type) (x: Empty): A = (case x) (λ _ => A) 6 | -------------------------------------------------------------------------------- /io_test.ya: -------------------------------------------------------------------------------- 1 | package io_test 2 | import io 3 | import unit 4 | import bytes 5 | where 6 | 7 | def main: IO Unit = IO.print (#Text.to_bytes "Hello, World!") 8 | -------------------------------------------------------------------------------- /applicative.ya: -------------------------------------------------------------------------------- 1 | package applicative where 2 | 3 | type Applicative (F: ∀ Type -> Type) { 4 | New 5 | (pure: ∀ (A: Type) A -> F A) 6 | (bind: ∀ (A B: Type) (F (∀ A -> B)) (F A) -> F B), 7 | } 8 | 9 | -------------------------------------------------------------------------------- /is.ya: -------------------------------------------------------------------------------- 1 | package is 2 | import equal 3 | import bool 4 | where 5 | 6 | def Is (a: Bool): Type = Equal Bool Bool.True a 7 | def is: Is(Bool.True) = Equal.Refl Bool Bool.True 8 | 9 | def Isnt (a: Bool): Type = Equal Bool Bool.False a 10 | def isnt: Isnt(Bool.False) = Equal.Refl Bool Bool.False 11 | -------------------------------------------------------------------------------- /either.ya: -------------------------------------------------------------------------------- 1 | package either where 2 | 3 | type Either (A B: Type) { 4 | Left A, 5 | Right B, 6 | } 7 | 8 | def Either.bind (0 A B C: Type) (e: Either A B) (f: ∀ B -> (Either A C)) 9 | : Either A C 10 | = (case e) (λ m => Either A C) (Either.Left A C) f 11 | 12 | def Either.bindL (0 A B C: Type) (e: Either A B) (f: ∀ A -> (Either C B)) 13 | : Either C B 14 | = (case e) (λ m => Either C B) f (Either.Right C B) 15 | 16 | -------------------------------------------------------------------------------- /functor.ya: -------------------------------------------------------------------------------- 1 | package functor where 2 | 3 | type Functor (F: ∀ Type -> Type) { 4 | New (map: ∀ (A B: Type) (f: ∀ A -> B) (f: F A) -> F B) 5 | } 6 | 7 | def Functor.map 8 | (0 F: ∀ Type -> Type) 9 | (impl: Functor F) 10 | (A: Type) 11 | (B: Type) 12 | (fun: ∀ A -> B) 13 | (f : F A) 14 | : F B 15 | = (case impl) (λ _ => F B) (λ m => m A B fun f) 16 | 17 | //def functor (A: Type) : Functor.Functor (Pair A) 18 | // = Functor.new (Pair A) (map A) 19 | -------------------------------------------------------------------------------- /introit.ya: -------------------------------------------------------------------------------- 1 | package introit 2 | import empty 3 | import function 4 | import unit 5 | import pair 6 | import either 7 | import functor 8 | import monad 9 | import maybe 10 | import list 11 | import eq 12 | import ord 13 | import equal 14 | import bool 15 | import boolean 16 | import nat 17 | import natural 18 | import u8 19 | import u16 20 | import u32 21 | import u64 22 | import i8 23 | import i16 24 | import i32 25 | import i64 26 | import char 27 | import text 28 | import bits 29 | import bytes 30 | import bitstring 31 | import parsec 32 | import io 33 | import dict 34 | where 35 | 36 | 37 | -------------------------------------------------------------------------------- /pair.ya: -------------------------------------------------------------------------------- 1 | package pair where 2 | 3 | type Pair (A B: Type) { 4 | New (fst: A) (snd: B) 5 | } 6 | 7 | def Pair.curry (0 A B C: Type) (f: ∀ (Pair A B) -> C) (x: A) (y: B): C 8 | = f (Pair.New A B x y) 9 | 10 | def Pair.uncurry (0 A B C: Type) (f: ∀ A B -> C) (ab: Pair A B): C 11 | = (case ab) (λ _ => C) (λ a b => f a b) 12 | 13 | def Pair.fst (0 A B : Type) (p : Pair A B): A 14 | = (case p) (λ _ => A) (λ a b => a) 15 | 16 | def Pair.snd (0 A B : Type) (p : Pair A B): B 17 | = (case p) (λ _ => B) (λ a b => b) 18 | 19 | def Pair.map (0 A B C : Type) (f : ∀ B -> C) (p : Pair A B): Pair A C 20 | = (case p) (λ _ => Pair A C) (λ x y => Pair.New A C x (f y)) 21 | 22 | -------------------------------------------------------------------------------- /b_tree.ya: -------------------------------------------------------------------------------- 1 | package b_tree where 2 | 3 | type BTree (A: Type) { 4 | Leaf, 5 | Node A (BTree A) (BTree A), 6 | } 7 | 8 | //def fromList (A : Type) (ordering : Ordered A) (list : List A): BinaryTree A 9 | // = (case list) (λ _ => BinaryTree A) 10 | // (empty A) 11 | // (λ head tail => 12 | // (case tail) (λ _ => BinaryTree A) 13 | // (leaf A head) 14 | // (λ next _ => if (BinaryTree A) (isLessThanOrEqual A ordering head next) 15 | // (node A head (fromList A ordering tail) (empty A)) 16 | // (node A head (empty A) (fromList A ordering tail)) 17 | // ) 18 | // ) 19 | -------------------------------------------------------------------------------- /.github/workflows/nix.yml: -------------------------------------------------------------------------------- 1 | name: "Nix CI" 2 | on: 3 | pull_request: 4 | push: 5 | branches: 6 | - main 7 | jobs: 8 | tests: 9 | runs-on: ubuntu-latest 10 | steps: 11 | - uses: actions/checkout@v2.3.4 12 | - uses: cachix/install-nix-action@v13 13 | with: 14 | install_url: https://github.com/numtide/nix-flakes-installer/releases/download/nix-2.4pre20210604_8e6ee1b/install 15 | extra_nix_config: | 16 | experimental-features = nix-command flakes 17 | - uses: cachix/cachix-action@v10 18 | with: 19 | name: yatima 20 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' 21 | - run: nix flake check --impure --show-trace 22 | -------------------------------------------------------------------------------- /boolean.ya: -------------------------------------------------------------------------------- 1 | package boolean where 2 | 3 | 4 | type Boolean { 5 | True, 6 | False, 7 | } 8 | 9 | def Boolean.and (a: Boolean) (b: Boolean): Boolean = 10 | (case a) (λ _ => Boolean) 11 | ((case b) (λ _ => Boolean) Boolean.True Boolean.False) 12 | Boolean.False 13 | 14 | def Boolean.or (a: Boolean) (b: Boolean): Boolean = 15 | (case a) (λ _ => Boolean) 16 | Boolean.True 17 | ((case b) (λ _ => Boolean) Boolean.True Boolean.False) 18 | 19 | def Boolean.not (a: Boolean): Boolean = 20 | (case a) (λ _ => Boolean) Boolean.False Boolean.True 21 | 22 | def Boolean.xor (a: Boolean) (b: Boolean): Boolean = 23 | (case a) (λ _ => Boolean) (Boolean.not b) b 24 | 25 | def Boolean.if (A : Type) (bool : Boolean) (a1: A) (a2: A) : A 26 | = (case bool) (λ _ => A) a1 a2 27 | 28 | -------------------------------------------------------------------------------- /bool.ya: -------------------------------------------------------------------------------- 1 | package bool where 2 | 3 | def Bool: Type = #Bool 4 | 5 | def Bool.True: Bool = #Bool.true 6 | def Bool.False: Bool = #Bool.false 7 | 8 | def Bool.eql: ∀ (x y: Bool) -> Bool = #Bool.eql 9 | def Bool.lte: ∀ (x y: Bool) -> Bool = #Bool.lte 10 | def Bool.lth: ∀ (x y: Bool) -> Bool = #Bool.lth 11 | def Bool.gte: ∀ (x y: Bool) -> Bool = #Bool.gte 12 | def Bool.gth: ∀ (x y: Bool) -> Bool = #Bool.gth 13 | 14 | 15 | def Bool.and: ∀ (x y: Bool) -> Bool = #Bool.and 16 | def Bool.or: ∀ (x y: Bool) -> Bool = #Bool.or 17 | def Bool.xor: ∀ (x y: Bool) -> Bool = #Bool.xor 18 | 19 | def Bool.not: ∀ (x: Bool) -> Bool = #Bool.not 20 | 21 | def Bool.neq (x y: Bool): Bool = Bool.not (Bool.eql x y) 22 | 23 | def Bool.if (A: Type) (bool : Bool) (t f: A): A = (case bool) (λ _ => A) t f 24 | 25 | -------------------------------------------------------------------------------- /dict_test.ya: -------------------------------------------------------------------------------- 1 | package dict_test 2 | import dict 3 | import text 4 | import nat 5 | import maybe 6 | import bool 7 | where 8 | 9 | def insert_keys (m: Dict Nat) : Dict Nat 10 | = Dict.insert Nat "foo" 1 (Dict.insert Nat "bar" 500 m) 11 | 12 | def delete_keys (m: Dict Nat) : Dict Nat 13 | = Dict.delete Nat "foo" (Dict.delete Nat "bar" m) 14 | 15 | def contains_test (key: Text) (value: Nat) (m: Dict Nat): Bool 16 | = Maybe.eq Nat (Nat.eql) (Dict.lookup Nat key m) (Maybe.Some Nat value) 17 | 18 | def should_be_true (m: Dict Nat): Bool 19 | = let newMap: Dict Nat = insert_keys m; 20 | (Bool.and) (contains_test "foo" 1 newMap) (contains_test "bar" 500 newMap) 21 | 22 | def should_be_false (m: Dict Nat): Bool 23 | = let newMap: Dict Nat = delete_keys m; 24 | (Bool.and) (contains_test "foo" 1 newMap) (contains_test "bar" 500 newMap) -------------------------------------------------------------------------------- /parsec/state.ya: -------------------------------------------------------------------------------- 1 | package state 2 | import text 3 | import nat 4 | import list 5 | import parsec.error 6 | where 7 | 8 | // A parser state contains: 9 | // + the remaining string input to parse 10 | // + the offset of the remaining input relative to the initial input 11 | // + a list of errors we've accumulated at the current offset 12 | // + a custom state value 13 | type State (S E: Type) { 14 | New (pos: Nat) (txt: Text) (errs: List (Error E)) (state: S), 15 | } 16 | 17 | // an initial state starts at offset 0 and with no errors 18 | def State.initial (S E: Type) (txt: Text) (state: S): State S E 19 | = State.New S E 0 txt (List.Nil (Error E)) state 20 | 21 | def State.longestMatch (S E: Type) (x y: State S E): State S E 22 | = (case x) (λ _ => State S E) (λ x_pos _ _ _ => 23 | (case y) (λ _ => State S E) (λ y_pos _ _ _ => 24 | (case (Nat.lte x_pos y_pos)) (λ _ => State S E) x y 25 | ) 26 | ) 27 | -------------------------------------------------------------------------------- /io.ya: -------------------------------------------------------------------------------- 1 | package io 2 | import functor 3 | import monad 4 | import bytes 5 | import unit 6 | where 7 | 8 | type IO (A: Type) { 9 | Return (x: A), 10 | Bind (B: Type) (io: IO B) (f: ∀ B -> IO A), 11 | Print (contents: Bytes): IO Unit, 12 | Read: IO Bytes, 13 | } 14 | 15 | def IO.read: IO Bytes 16 | = IO.Read Bytes 17 | 18 | def IO.print (contents: Bytes): IO Unit 19 | = IO.Print Unit contents 20 | 21 | def IO.map (A B: Type) (f: forall A -> B) (io: IO A): IO B 22 | = IO.Bind B A io (λ x => IO.Return B (f x)) 23 | 24 | def IO.pure (0 A: Type) (value: A): IO A 25 | = IO.Return A value 26 | 27 | def IO.bind (A B: Type) (io: IO A) (f: forall A -> IO B): IO B 28 | = IO.Bind B A io f 29 | 30 | def IO.functor: Functor IO 31 | = Functor.New (λ A => IO A) (λ A B f io => IO.map A B f io) 32 | 33 | def IO.monad: Monad IO 34 | = Monad.New (λ A => IO A) 35 | (λ A value => IO.pure A value) 36 | (λ A B io f => IO.bind A B io f) -------------------------------------------------------------------------------- /equal.ya: -------------------------------------------------------------------------------- 1 | package equal where 2 | 3 | type Equal (A: Type) (a: A): ∀ (ω b: A) -> Type { 4 | Refl: Equal A a a 5 | } 6 | 7 | // if a ~ b then b ~ a 8 | def Equal.sym (0 A: Type) (a b: A) (e: Equal A a b) : Equal A b a 9 | = (case e) (λ b e => Equal A b a) (Equal.Refl A a) 10 | 11 | // ∀ a, b, c if a ~ b and b ~ c then a ~ c 12 | def Equal.trans (0 A: Type) (a b c: A) (ab: Equal A a b) (bc: Equal A b c) 13 | : Equal A a c 14 | = (case bc) (λ b' _ => Equal A a b') ab 15 | 16 | // if a ~A b then f(a) ~B f(b) 17 | def Equal.cong (0 A B: Type) (a b: A) (f: ∀ A -> B) (e: Equal A a b) 18 | : Equal B (f a) (f b) 19 | = (case e) (λ b' _ => Equal B (f a) (f b')) (Equal.Refl B (f a)) 20 | 21 | def Equal.rewrite (A: Type) (a b: A) (e: Equal A a b) (P: ∀ A -> Type) (x: P a) 22 | : P b 23 | = (case e) (λ b e => P b) x 24 | 25 | //def Equal.cast 26 | // (0 A: Type) (0 a b: A) (0 P: ∀ A -> Type) (e: Equal A a b) (x: P a) 27 | // : P b 28 | // = (case e) (λ b' _ => P b') x 29 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Introit the standard lib of Yatima"; 3 | 4 | inputs.nixpkgs.url = "github:nixos/nixpkgs"; 5 | inputs.yatima.url = "github:yatima-inc/yatima"; 6 | inputs.utils.url = "github:numtide/flake-utils"; 7 | 8 | outputs = { self, nixpkgs, utils, yatima }: 9 | utils.lib.eachDefaultSystem (system: 10 | let 11 | pkgs = nixpkgs.legacyPackages.${system}; 12 | yatima-bin = yatima.apps.${system}.yatima.program; 13 | name = "introit"; 14 | src = ./.; 15 | yatima-check = file: pkgs.runCommand "yatima-check" { 16 | inherit src; 17 | buildInputs = [ yatima ]; 18 | } '' 19 | ${yatima-bin} --no-file-store --root ${src} check ${file} > $out 20 | ''; 21 | 22 | in 23 | { 24 | checks.${name} = yatima-check "introit.ya"; 25 | devShell = pkgs.mkShell { 26 | buildInputs = with pkgs; [ 27 | yatima 28 | ]; 29 | }; 30 | 31 | }); 32 | } 33 | -------------------------------------------------------------------------------- /function.ya: -------------------------------------------------------------------------------- 1 | package function where 2 | 3 | def Proposition (0 A: Type): Type = ∀ A -> Type 4 | 5 | def Function (0 A B: Type): Type = ∀ A -> B 6 | def DependentFunction (0 A: Type) (0 B: Proposition A): Type = ∀ (x: A) -> B x 7 | 8 | def Function.const (0 A B: Type) (x: A) (y: B): A = x 9 | def DependentFunction.const (0 A: Type) (B: Proposition A) (x: A) (y: B x): A 10 | = x 11 | 12 | def Function.id (0 A: Type) (x: A): A = x 13 | 14 | def Function.compose (0 A B C: Type) (g: Function B C) (f: Function A B) 15 | : Function A C 16 | = λ x => g (f x) 17 | 18 | def DependentFunction.compose 19 | (0 A: Type) 20 | (0 B: Proposition A) 21 | (0 C: ∀ (a: A) (B a) -> Type) 22 | (x: A) 23 | (f: DependentFunction A B) 24 | (g: ∀ (b: B x) -> C x (f x)) 25 | : C x (f x) 26 | = g (f x) 27 | 28 | def Function.call (0 A B: Type) (x: A) (f: Function A B): B = f x 29 | def DependentFunction.call 30 | (0 A: Type) (0 B: Proposition A) (x: A) (f: DependentFunction A B): B x = f x 31 | 32 | -------------------------------------------------------------------------------- /bitstring.ya: -------------------------------------------------------------------------------- 1 | package bitstring where 2 | 3 | type BitString { 4 | BE, 5 | B0 (pred: BitString), 6 | B1 (pred: BitString), 7 | } 8 | 9 | def BitString.concat (x: BitString) (y: BitString) : BitString = 10 | (case x) (λ _ => BitString) 11 | y 12 | (λ xs => BitString.B0 (BitString.concat xs y)) 13 | (λ xs => BitString.B1 (BitString.concat xs y)) 14 | 15 | def BitString.inc (a: BitString): BitString 16 | = (case a) (λ _ => BitString) 17 | (BitString.B1 BitString.BE) 18 | (λ xs => BitString.B1 xs) 19 | (λ xs => BitString.B0 (BitString.inc xs)) 20 | 21 | def BitString.add (x: BitString) (y: BitString): BitString = 22 | (case y) (λ _ => BitString) x 23 | (λ ys => (case x) (λ _ => BitString) y 24 | (λ xs => BitString.B0 (BitString.add xs ys)) 25 | (λ xs => BitString.B1 (BitString.add xs ys))) 26 | (λ ys => (case x) (λ _ => BitString) y 27 | (λ xs => BitString.B1 (BitString.add xs ys)) 28 | (λ xs => BitString.B0 (BitString.add (BitString.inc xs) ys))) 29 | -------------------------------------------------------------------------------- /parsec/reply.ya: -------------------------------------------------------------------------------- 1 | package reply 2 | import either 3 | import parsec.error 4 | import parsec.state 5 | where 6 | 7 | // A Reply over custom state S, custom error E and return value A can be: 8 | // + eok when the parser returns an A value and input was not consumed 9 | // + eer when the parser throws an E error and input was not consumed 10 | // + cok when the parser returns an A value and input was consumed 11 | // + cer when the parser throws an E error and input was consumed 12 | type Reply (S E A: Type) { 13 | EOK (state: State S E) (val: A) : Reply S E A, 14 | EER (state: State S E) (err: Error E), 15 | COK (state: State S E) (val: A), 16 | CER (state: State S E) (err: Error E), 17 | } 18 | 19 | def Reply.toEither (S E A: Type) (reply: Reply S E A): Either (Error E) A 20 | = (case reply) (λ _ => Either (Error E) A) 21 | (λ s a => Either.Right (Error E) A a) 22 | (λ s e => Either.Left (Error E) A e) 23 | (λ s a => Either.Right (Error E) A a) 24 | (λ s e => Either.Left (Error E) A e) 25 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Lurk Lab 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /ord.ya: -------------------------------------------------------------------------------- 1 | package ord 2 | import bool 3 | where 4 | 5 | type Ordering { 6 | LT, 7 | EQ, 8 | GT, 9 | } 10 | 11 | type Ord (A: Type) { 12 | New (cmp: ∀ (a b : A) -> Ordering) 13 | } 14 | 15 | def Ord.compare (0 A : Type) (ord: Ord A) (a b : A): Ordering 16 | = (case ord) (λ _ => Ordering) (λ cmp => cmp a b) 17 | 18 | def Ordering.eql (a b: Ordering): Bool 19 | = (case a) (λ _ => Bool) 20 | ((case b) (λ _ => Bool) Bool.True Bool.False Bool.False) 21 | ((case b) (λ _ => Bool) Bool.False Bool.True Bool.False) 22 | ((case b) (λ _ => Bool) Bool.False Bool.False Bool.True) 23 | 24 | def Ord.lth (0 A: Type) (ord: Ord A) (a b: A): Bool 25 | = Ordering.eql (Ord.compare A ord a b) Ordering.LT 26 | 27 | def Ord.eql (0 A: Type) (ord: Ord A) (a b: A): Bool 28 | = Ordering.eql (Ord.compare A ord a b) Ordering.EQ 29 | 30 | def Ord.gth (0 A: Type) (ord: Ord A) (a b: A): Bool 31 | = Ordering.eql (Ord.compare A ord a b) Ordering.GT 32 | 33 | def Ord.lte (0 A: Type) (ord: Ord A) (a b: A): Bool 34 | = Bool.or (Ord.eql A ord a b) (Ord.lth A ord a b) 35 | 36 | def Ord.gte (0 A: Type) (ord: Ord A) (a b: A): Bool 37 | = Bool.or (Ord.eql A ord a b) (Ord.gth A ord a b) 38 | 39 | -------------------------------------------------------------------------------- /nat.ya: -------------------------------------------------------------------------------- 1 | package nat 2 | import bool 3 | import maybe 4 | import is 5 | import ord 6 | where 7 | 8 | def Nat: Type = #Nat 9 | 10 | def Nat.Z: Nat = 0 11 | def Nat.S: ∀ Nat -> Nat = #Nat.suc 12 | 13 | def Nat.pred: ∀ Nat -> Nat = #Nat.pre 14 | def Nat.eql: ∀ (x y: Nat) -> Bool = #Nat.eql 15 | def Nat.lte: ∀ (x y: Nat) -> Bool = #Nat.lte 16 | def Nat.lth: ∀ (x y: Nat) -> Bool = #Nat.lth 17 | def Nat.gte: ∀ (x y: Nat) -> Bool = #Nat.gte 18 | def Nat.gth: ∀ (x y: Nat) -> Bool = #Nat.gth 19 | 20 | def Nat.add: ∀ (x y: Nat) -> Nat = #Nat.add 21 | def Nat.mul: ∀ (x y: Nat) -> Nat = #Nat.mul 22 | 23 | def Nat.neq (x y: Nat): Bool = Bool.not (Nat.eql x y) 24 | 25 | def Nat.div (x y: Nat) (0 e: Is (Nat.neq y 0)): Nat = #Nat.div x y 26 | 27 | def Nat.divChecked (x y: Nat): Maybe Nat = 28 | (case y) (λ _ => Maybe Nat) 29 | (Maybe.None Nat) 30 | (λ _ => Maybe.Some Nat (#Nat.div x y)) 31 | 32 | def Nat.mod (x y: Nat) (0 e: Is (Nat.neq y 0)): Nat = #Nat.mod x y 33 | 34 | def Nat.modChecked (x y: Nat): Maybe Nat = 35 | (case y) (λ _ => Maybe Nat) 36 | (Maybe.None Nat) 37 | (λ _ => Maybe.Some Nat (#Nat.mod x y)) 38 | 39 | def Nat.compare (x y: Nat): Ordering = 40 | (case (Nat.lth x y)) (λ _ => Ordering) 41 | Ordering.LT 42 | ((case (Nat.eql x y)) (λ _ => Ordering) Ordering.EQ Ordering.GT) 43 | -------------------------------------------------------------------------------- /matrix.ya: -------------------------------------------------------------------------------- 1 | // Basic Matrix functions 2 | package matrix 3 | import natural 4 | import vector 5 | where 6 | 7 | type Matrix (A: Type): ∀ (ω rows: Natural) (ω cols: Natural) -> Type { 8 | New 9 | (rows: Natural) (cols: Natural) (vec: (Vector (Vector A cols) rows)) 10 | : Matrix A rows cols 11 | } 12 | 13 | //def fill (0 A: Type) (rows: Nat) (cols : Nat) (a: A) : Matrix A rows cols = 14 | // new A rows cols (Vector.fill (Vector A cols) rows (Vector.fill A cols a)) 15 | // 16 | //def getRows (0 A: Type) (rows: Nat) (cols: Nat) (matrix: Matrix A rows cols): Vector (Vector A cols) rows 17 | // = (case matrix) (λ r c m => Vector (Vector A c) r) 18 | // (λ r c vec => vec) 19 | // 20 | //def vec_vec_addable (0 A: Type) (impl: Addable A) (rows: Nat) (cols : Nat): Addable (Vector (Vector A cols) rows) 21 | // = Vector.deriveAddable (Vector A cols) (Vector.deriveAddable A impl cols) rows 22 | // 23 | //def add (0 A: Type) (impl: Addable A) (rows: Nat) (cols : Nat) (x y : Matrix A rows cols): Matrix A rows cols 24 | // = new A rows cols (Vector.add (Vector A cols) (Vector.deriveAddable A impl cols) rows (getRows A rows cols x) (getRows A rows cols y)) 25 | // 26 | //def deriveAddable (0 A: Type) (impl: Addable A) (rows: Nat) (cols : Nat): Addable (Matrix A rows cols) 27 | // = Nat.newAddable (Matrix A rows cols) (add A impl rows cols) 28 | -------------------------------------------------------------------------------- /maybe.ya: -------------------------------------------------------------------------------- 1 | package maybe 2 | import functor 3 | import monad 4 | import bool 5 | where 6 | 7 | type Maybe (A: Type) { 8 | None, 9 | Some A, 10 | } 11 | 12 | def Maybe.isNothing (0 A: Type) (m: Maybe A): Bool 13 | = (case m) (λ _ => Bool) (Bool.True) (λ _ => Bool.False) 14 | 15 | def Maybe.eq (0 A: Type) (f: forall A A -> Bool) (a b: Maybe A): Bool 16 | = (case a) (λ _ => Bool) 17 | (Maybe.isNothing A b) 18 | (λ x => (case b) (λ _ => Bool) 19 | (Bool.False) 20 | (λ y => f x y) 21 | ) 22 | 23 | def Maybe.map (0 A B: Type) (f: ∀ A -> B) (m: Maybe A): Maybe B 24 | = (case m) (λ m => Maybe B) (Maybe.None B) (λ x => Maybe.Some B (f x)) 25 | 26 | def Maybe.bind (0 A B: Type) (m: Maybe A) (f: ∀ A -> (Maybe B)): Maybe B 27 | = (case m) (λ m => Maybe B) (Maybe.None B) f 28 | 29 | def Maybe.default (0 A: Type) (default: A) (m: Maybe A): A 30 | = (case m) (λ _ => A) (default) (λ x => x) 31 | 32 | def Maybe.join (0 A: Type) (m: Maybe (Maybe A)): Maybe A 33 | = (case m) (λ _ => Maybe A) (Maybe.None A) (λ x => x) 34 | 35 | def Maybe.or (0 A: Type) (a b: Maybe A): Maybe A 36 | = (case a) (λ _ => Maybe A) (b) (λ x => Maybe.Some A x) 37 | 38 | def Maybe.extract (0 A B: Type) (m: Maybe A) (a: B) (f: forall A -> B): B 39 | = (case m) (λ _ => B) (a) (f) 40 | 41 | def Maybe.functor: Functor Maybe 42 | = Functor.New (λ A => Maybe A) (λ A B f m => Maybe.map A B f m) 43 | 44 | def Maybe.monad: Monad Maybe 45 | = Monad.New (λ A => Maybe A) (λ A x => Maybe.Some A x) (λ A B m f => Maybe.bind A B m f) -------------------------------------------------------------------------------- /alternative.ya: -------------------------------------------------------------------------------- 1 | package alternative 2 | import applicative 3 | import list 4 | where 5 | 6 | type Alternative (F: ∀ Type -> Type) { 7 | New 8 | (empty: ∀ (A: Type) -> F A) 9 | (option: ∀ (A: Type) (p q: F A) -> F A), 10 | } 11 | 12 | // Empty alternative 13 | def Alternative.empty (0 F: ∀ Type -> Type) (impl: Alternative F) (A: Type): F A 14 | = (case impl) (λ _ => F A) (λ emptyF _ => emptyF A) 15 | 16 | def Alternative.option 17 | (0 F: ∀ Type -> Type) (impl: Alternative F) (A: Type) (p q: F A) 18 | : F A 19 | = (case impl) (λ _ => F A) (λ _ optionF => optionF A p q) 20 | 21 | //// One or more 22 | //def some 23 | // (F: ∀ Type -> Type) (impl: Alternative F) (A: Type) (f: F A) 24 | // : F (List A) 25 | // = 26 | // let many_f: F (List A) = 27 | // option F impl (List A) (some F impl A f) (pure F impl (List A) (List.nil A)); 28 | // (Applicative.applicate F (applicative F impl) (List A) (List A) 29 | // (Functor.map F (functor F impl) A (∀ (List A) -> List A) 30 | // (List.cons A) 31 | // f 32 | // ) 33 | // many_f 34 | // ) 35 | // 36 | //// Zero or more 37 | //def many (F: ∀ Type -> Type) (impl : Alternative F) (A : Type) (f : F A): F (List A) = 38 | // let some_f : F (List A) = 39 | // (Applicative.applicate F (applicative F impl) (List A) (List A) 40 | // (Functor.map F (functor F impl) A (∀ (List A) -> List A) 41 | // (List.cons A) 42 | // f 43 | // ) 44 | // (many F impl A f) 45 | // ); 46 | // option F impl (List A) some_f (pure F impl (List A) (List.nil A)) 47 | -------------------------------------------------------------------------------- /monad.ya: -------------------------------------------------------------------------------- 1 | package monad where 2 | 3 | type Monad (M: ∀ Type -> Type) { 4 | New 5 | (pure: ∀ (A: Type) A -> M A) 6 | (bind: ∀ (A B: Type) (M A) (∀ A -> (M B)) -> M B), 7 | } 8 | 9 | def bind 10 | (0 M: ∀ Type -> Type) 11 | (impl: Monad M) 12 | (A: Type) 13 | (B: Type) 14 | (m: M A) 15 | (f: ∀ A -> (M B)) 16 | : M B 17 | = (case impl) (λ _ => M B) (λ _ bind => bind A B m f) 18 | 19 | def pure (0 M: ∀ Type -> Type) (impl: Monad M) (A: Type) (a: A): M A = 20 | (case impl) (λ _ => M A) (λ pure _ => pure A a) 21 | 22 | 23 | //// A monoid monad with identity and a binary operation 24 | //def MonadPlus (M: ∀ Type -> Type) : Type = 25 | // @self ∀ 26 | // (0 P: ∀ (MonadPlus M) -> Type) 27 | // (& new: ∀ 28 | // (monad : Monad M) 29 | // (mzero : ∀ (A : Type) -> M A) 30 | // (mplus : ∀ (A : Type) (p q : M A) -> M A) 31 | // -> P (data λ P n => n monad mzero mplus) 32 | // ) -> P self 33 | // 34 | //def new (0 M: ∀ Type -> Type) 35 | // (monad : Monad M) 36 | // (mzero : ∀ (A : Type) -> M A) 37 | // (mplus : ∀ (A : Type) (p q : M A) -> M A) 38 | // : MonadPlus M 39 | // = data λ P n => n monad mzero mplus 40 | // 41 | //def monad (0 M: ∀ Type -> Type) (impl : MonadPlus M): Monad M 42 | // = (case impl) (λ _ => Monad M) 43 | // (λ monad _ _ => monad) 44 | // 45 | //def mzero (0 M: ∀ Type -> Type) (impl : MonadPlus M): ∀ (A : Type) -> M A 46 | // = (case impl) (λ _ => ∀ (A : Type) -> M A) 47 | // (λ _ mzero _ => mzero) 48 | // 49 | //def mplus (0 M: ∀ Type -> Type) (impl : MonadPlus M): ∀ (A : Type) (p q : M A) -> M A 50 | // = (case impl) (λ _ => ∀ (A : Type) (p q : M A) -> M A) 51 | // (λ _ _ mplus => mplus) 52 | -------------------------------------------------------------------------------- /natural.ya: -------------------------------------------------------------------------------- 1 | package natural 2 | import nat 3 | import empty 4 | import equal 5 | import unit 6 | where 7 | 8 | type Natural { 9 | Z, 10 | S Natural, 11 | } 12 | 13 | def Natural.Z_isnt_S (n: Natural) (e: Equal Natural (Natural.S n) Natural.Z) 14 | : Empty 15 | = Equal.rewrite Natural (Natural.S n) Natural.Z e 16 | (λ k => (case k) (λ _ => Type) Empty (λ _ => Unit)) 17 | Unit.New 18 | 19 | def Natural.pred (x: Natural): Natural 20 | = (case x) (λ _ => Natural) Natural.Z (λ p => p) 21 | 22 | def Natural.fromNat (n: Nat): Natural 23 | = (case n) (λ _ => Natural) 24 | Natural.Z 25 | (λ pre => Natural.S (Natural.fromNat pre)) 26 | 27 | def Natural.toNat (n: Natural): Nat 28 | = (case n) (λ x => Nat) 0 (λ pre => Nat.S (Natural.toNat pre)) 29 | 30 | def add (a b: Natural): Natural 31 | = (case a) (λ _ => Natural) b (λ pred => Natural.S (add pred b)) 32 | 33 | def mul (a b: Natural): Natural 34 | = (case a) (λ _ => Natural) Natural.Z (λ pred => add b (mul pred b)) 35 | 36 | 37 | def sub (n m: Natural): Natural 38 | = (case m) (λ _ => Natural) 39 | n (λ x => (case n) (λ _ => Natural) Natural.Z (λ y => sub x y)) 40 | 41 | //def divMod_go (n m d: Nat): Pair Nat Nat = 42 | // (case (sub n m)) (λ _ => Pair Nat Nat) 43 | // (Pair.new Nat Nat d n) 44 | // (λ p => (divMod_go (succ p) m (succ d))) 45 | // 46 | //def divMod (n m: Nat): Pair Nat Nat = divMod_go n m zero 47 | // 48 | //def div (n m : Nat): Nat = Pair.fst Nat Nat (divMod n m) 49 | //def mod (n m : Nat): Nat = Pair.snd Nat Nat (divMod n m) 50 | // 51 | //def compare (a b: Nat): Ordering 52 | // = (case a) (λ _ => Ordering) 53 | // ((case b) (λ _ => Ordering) Ord.eq (λ _ => Ord.lt)) 54 | // (λ ap => (case b) (λ _ => Ordering) Ord.gt (λ bp => compare ap bp)) 55 | -------------------------------------------------------------------------------- /char.ya: -------------------------------------------------------------------------------- 1 | package char 2 | import bool 3 | import is 4 | import u32 5 | where 6 | 7 | def Char: Type = #Char 8 | 9 | def Char.fromU32: ∀ U32 -> Char = #Char.from_U32 10 | def Char.toU32: ∀ Char -> U32 = #Char.to_U32 11 | 12 | def Char.eql: ∀ (x y: Char) -> Bool = #Char.eql 13 | def Char.lte: ∀ (x y: Char) -> Bool = #Char.lte 14 | def Char.lth: ∀ (x y: Char) -> Bool = #Char.lth 15 | def Char.gte: ∀ (x y: Char) -> Bool = #Char.gte 16 | def Char.gth: ∀ (x y: Char) -> Bool = #Char.gth 17 | 18 | def Char.isAlphabetic: ∀ Char -> Bool = #Char.is_alphabetic 19 | def Char.isAlphanumeric: ∀ Char -> Bool = #Char.is_alphanumeric 20 | 21 | def Char.isAscii: ∀ Char -> Bool = #Char.is_ascii_alphabetic 22 | def Char.isAsciiAlphabetic: ∀ Char -> Bool = #Char.is_ascii_alphanumeric 23 | def Char.isAsciiControl: ∀ Char -> Bool = #Char.is_ascii_control 24 | 25 | def Char.isAsciiDigit: ∀ #Char -> #Bool = #Char.is_ascii_digit 26 | def Char.isAsciiGraphic: ∀ #Char -> #Bool = #Char.is_ascii_graphic 27 | def Char.isAsciiHexDigit: ∀ #Char -> #Bool = #Char.is_ascii_hexdigit 28 | def Char.isAsciiLowerCase: ∀ #Char -> #Bool = #Char.is_ascii_lowercase 29 | def Char.isAsciiPunctuation: ∀ #Char -> #Bool = #Char.is_ascii_punctuation 30 | def Char.isAsciiUpperCase: ∀ #Char -> #Bool = #Char.is_ascii_uppercase 31 | def Char.isAsciiWhitespace: ∀ #Char -> #Bool = #Char.is_ascii_whitespace 32 | def Char.isControl: ∀ #Char -> #Bool = #Char.is_control 33 | def Char.isDigit: ∀ #Char -> #Bool = #Char.is_digit 34 | def Char.isLowercase: ∀ #Char -> #Bool = #Char.is_lowercase 35 | def Char.isNumeric: ∀ #Char -> #Bool = #Char.is_numeric 36 | def Char.isUppercase: ∀ #Char -> #Bool = #Char.is_uppercase 37 | def Char.isWhitespace: ∀ #Char -> #Bool = #Char.is_whitespace 38 | def Char.lenUTF8: ∀ #Char -> #Nat = #Char.len_utf8 39 | def Char.lenUTF16: ∀ #Char -> #Nat = #Char.len_utf16 40 | def Char.toAsciiLowercase: ∀ #Char -> #Bool = #Char.to_ascii_lowercase 41 | def Char.toAsciiUppercase: ∀ #Char -> #Bool = #Char.to_ascii_uppercase 42 | def Char.toLowercase: ∀ #Char -> #Bool = #Char.to_lowercase 43 | def Char.toUppercase: ∀ #Char -> #Bool = #Char.to_uppercase 44 | -------------------------------------------------------------------------------- /vector.ya: -------------------------------------------------------------------------------- 1 | package vector 2 | import natural 3 | import maybe 4 | import unit 5 | import pair 6 | import equal 7 | import empty 8 | where 9 | 10 | 11 | type Vector (A: Type): ∀ (ω k: Natural) -> Type { 12 | Nil: Vector A Natural.Z, 13 | Cons (0 k: Natural) (x: A) (xs: Vector A k): Vector A (Natural.S k), 14 | } 15 | 16 | def Vector.head (0 A: Type) (k: Natural) (a : Vector A (Natural.S k)): A 17 | = ((case a) (λ k' self => ∀ (Equal Natural (Natural.S k) k') -> A) 18 | (λ e => Empty.absurd A (Natural.Z_isnt_S k e)) 19 | (λ k x xs e => x)) 20 | (Equal.Refl Natural (Natural.S k)) 21 | 22 | def Vector.tail (0 A: Type) (0 k: Natural) (a : Vector A k) 23 | : Vector A (Natural.pred k) 24 | = (case a) (λ k _ => Vector A (Natural.pred k)) 25 | (Vector.Nil A) 26 | (λ _ x xs => xs) 27 | 28 | def Vector.fill (0 A: Type) (n: Natural) (a: A): Vector A n 29 | = (case n) (λ x => (Vector A x)) 30 | (Vector.Nil A) 31 | (λ p => Vector.Cons A p a (Vector.fill A p a)) 32 | 33 | def Vector.extract (0 A: Type) (0 k: Natural) (xs: Vector A (Natural.S k)) 34 | : Pair A (Vector A k) 35 | = (case xs) 36 | (λ k _ => (case k) (λ _ => Type) Unit (λ pred => Pair A (Vector A pred))) 37 | Unit.New 38 | (λ k y ys => Pair.New A (Vector A k) y ys) 39 | 40 | // 41 | //def concat (0 A : Type) (0 sizeA sizeB : Nat) (a : Vector A sizeA) (b : Vector A sizeB): Vector A (Nat.add sizeA sizeB) 42 | // = (case a) (λ sizeA _ => Vector A (Nat.add sizeA sizeB)) 43 | // b 44 | // (λ sizeA head tail => cons A (Nat.add sizeA sizeB) head (concat A sizeA sizeB tail b)) 45 | // 46 | //def at (A : Type) (0 size : Nat) (vec : Vector A size) (idx : Nat): Maybe A 47 | // = (case idx) (λ _ => Maybe A) 48 | // (head A size vec) 49 | // (λ pred => at A size vec pred) 50 | // 51 | //def map (0 A B: Type) (0 size: Nat) (f: ∀ A -> B) (vec: Vector A size): Vector B size 52 | // = (case vec) (λ k _ => Vector B k) 53 | // (nil B) 54 | // (λ size x xs => cons B size (f x) (map A B size f xs)) 55 | // 56 | //def foldr (0 A B : Type) (0 size : Nat) (f: forall A B -> B) (b : B) (vec : Vector A size): B 57 | // = (case vec) (λ _ _ => B) 58 | // b 59 | // (λ size head tail => f head (foldr A B size f b tail)) 60 | // 61 | //def foldl (0 A B : Type) (0 size : Nat) (f: forall A B -> B) (b : B) (vec : Vector A size): B 62 | // = (case vec) (λ _ _ => B) 63 | // b 64 | // (λ size head tail => (foldl A B size f (f head b) tail)) 65 | -------------------------------------------------------------------------------- /parser.ya: -------------------------------------------------------------------------------- 1 | // This package is an adaptation of the Haskell Megaparsec library found at 2 | // https://hackage.haskell.org/package/megaparsec 3 | package parser 4 | import unit 5 | import either 6 | import maybe 7 | import char 8 | import list 9 | import nat 10 | import text 11 | import parsec 12 | import parsec.state as Parsec 13 | import parsec.error as Parsec 14 | import parsec.reply as Parsec 15 | where 16 | 17 | def Parser (A: Type): Type = Parsec Unit Unit A 18 | 19 | def State: Type = Parsec.State Unit Unit 20 | def Error: Type = Parsec.Error Unit 21 | def Reply (A: Type): Type = Parsec.Reply Unit Unit A 22 | 23 | def State.new (pos: Nat) (txt: Text) (errs: List Error): State 24 | = Parsec.State.New Unit Unit pos txt errs Unit.New 25 | 26 | def State.init (txt: Text): State = Parsec.State.initial Unit Unit txt Unit.New 27 | 28 | def Parser.run (A: Type) (parser: Parser A) (state: State): Reply A 29 | = Parsec.run Unit Unit A parser state 30 | 31 | def Parser.parse (A: Type) (parser: Parser A) (txt: Text): Either Error A 32 | = Parsec.parse Unit Unit A parser (State.init txt) 33 | 34 | def Parsed (A: Type) (reply: Reply A): Type = 35 | (case reply) (λ _ => Type) 36 | (λ _ _ => A) 37 | (λ _ _ => Error) 38 | (λ _ _ => A) 39 | (λ _ _ => Error) 40 | 41 | def Parser.parsed (A: Type) (parser: Parser A) (txt: Text) 42 | : Parsed A (Parser.run A parser (State.init txt)) 43 | = (case (Parser.run A parser (State.init txt))) (λ reply => Parsed A reply) 44 | (λ _ x => x) 45 | (λ _ e => e) 46 | (λ _ x => x) 47 | (λ _ e => e) 48 | 49 | def Parser.pure (A: Type) (a: A): Parser A = Parsec.pure Unit Unit A a 50 | 51 | def Parser.bind (A B: Type) (p: Parser A) (f: ∀ A -> Parser B): Parser B = 52 | Parsec.bind Unit Unit A B p f 53 | 54 | def Parser.ap (A B: Type) (pf: Parser (∀ A -> B)) (pa: Parser A): Parser B = 55 | Parsec.ap Unit Unit A B pf pa 56 | 57 | def Parser.state: Parser State = Parsec.state Unit Unit 58 | 59 | def Parser.token (A: Type) (f: ∀ Char -> Maybe A) (exps: List Parsec.Item): Parser A 60 | = Parsec.token Unit Unit A f exps 61 | 62 | def Parser.anyChar: Parser Char = Parsec.anyChar Unit Unit 63 | 64 | def Parser.char (c: Char): Parser Char = Parsec.char Unit Unit c 65 | 66 | def Parser.optional (A: Type) (p: Parser A): Parser (Maybe A) 67 | = Parsec.optional Unit Unit A p 68 | 69 | def Parser.many (A: Type) (p: Parser A): Parser (List A) = Parsec.many Unit Unit A p 70 | 71 | def Parser.take (err: Text) (n: Nat): Parser Text = Parsec.take Unit Unit err n 72 | -------------------------------------------------------------------------------- /u8.ya: -------------------------------------------------------------------------------- 1 | package u8 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def U8: Type = #U8 10 | 11 | def U8.MAX: U8 = #U8.max 12 | def U8.MIN: U8 = #U8.min 13 | 14 | def U8.eql: ∀ (x y: U8) -> Bool = #U8.eql 15 | def U8.lte: ∀ (x y: U8) -> Bool = #U8.lte 16 | def U8.lth: ∀ (x y: U8) -> Bool = #U8.lth 17 | def U8.gte: ∀ (x y: U8) -> Bool = #U8.gte 18 | def U8.gth: ∀ (x y: U8) -> Bool = #U8.gth 19 | def U8.and: ∀ (x y: U8) -> Bool = #U8.and 20 | def U8.xor: ∀ (x y: U8) -> Bool = #U8.xor 21 | def U8.or: ∀ (x y: U8) -> Bool = #U8.or 22 | def U8.neq (x y: U8): Bool = Bool.not (U8.eql x y) 23 | 24 | def U8.add: ∀ (x y: U8) -> U8 = #U8.add 25 | def U8.addSafe (x y: U8) (0 e: Is (U8.gte (#U8.add x y) x)): U8 = #U8.add x y 26 | 27 | def U8.sub: ∀ (x y: U8) -> U8 = #U8.sub 28 | def U8.subSafe (x y: U8) (0 e: Is (U8.lte y x)): U8 = #U8.sub x y 29 | 30 | def U8.mul: ∀ (x y: U8) -> U8 = #U8.mul 31 | 32 | def U8.SafeMul (x y: U8): Bool = 33 | (case (U8.eql x 0u8)) (λ _ => Bool) 34 | Bool.True 35 | (U8.eql (#U8.div (#U8.mul x y) x) y) 36 | 37 | def U8.mulSafe (x y: U8) (0 e: Is (U8.SafeMul x y)): U8 = #U8.mul x y 38 | 39 | def U8.div (x y: U8): Maybe U8 = 40 | (case (U8.neq y 0u8)) (λ _ => Maybe U8) 41 | (Maybe.Some U8 (#U8.div x y)) 42 | (Maybe.None U8) 43 | 44 | def U8.divSafe (x y: U8) (0 e: Is (U8.neq y 0)): U8 = #U8.div x y 45 | 46 | def U8.mod (x y: U8): Maybe U8 = 47 | (case (U8.neq y 0u8)) (λ _ => Maybe U8) 48 | (Maybe.Some U8 (#U8.mod x y)) 49 | (Maybe.None U8) 50 | 51 | def U8.modSafe (x y: U8) (0 e: Is (U8.neq y 0)): U8 = #U8.mod x y 52 | 53 | def U8.pow: ∀ (x: U8) (y: U32) -> U8 = #U8.pow 54 | def U8.shl: ∀ (x: U32) (y: U8) -> U8 = #U8.shl 55 | def U8.shr: ∀ (x: U32) (y: U8) -> U8 = #U8.shr 56 | def U8.rol: ∀ (x: U32) (y: U8) -> U8 = #U8.rol 57 | def U8.ror: ∀ (x: U32) (y: U8) -> U8 = #U8.ror 58 | 59 | def U8.countZeros: ∀ (x: U8) -> U32 = #U8.count_zeros 60 | def U8.countOnes: ∀ (x: U8) -> U32 = #U8.count_ones 61 | 62 | def U8.toU16: ∀ (x: U8) -> #U16 = #U8.to_U16 63 | def U8.toU32: ∀ (x: U8) -> #U32 = #U8.to_U32 64 | def U8.toU64: ∀ (x: U8) -> #U64 = #U8.to_U64 65 | 66 | def U8.toI8 (x: U8): Maybe #I8 = 67 | (case (U8.lte x (#I8.to_U8 #I8.max))) (λ _ => Maybe #I8) 68 | (Maybe.Some #I8 (#U8.to_I8 x)) 69 | (Maybe.None #I8) 70 | 71 | def U8.toI8Safe (x: U8) (0 e: Is (U8.lte x (#I8.to_U8 #I8.max))): #I8 72 | = #U8.to_I8 x 73 | 74 | def U8.toI16: ∀ (x: U8) -> #I16 = #U8.to_I16 75 | def U8.toI32: ∀ (x: U8) -> #I32 = #U8.to_I32 76 | def U8.toI64: ∀ (x: U8) -> #I64 = #U8.to_I64 77 | 78 | def U8.toNat: ∀ (x: U8) -> #Nat = #U8.to_Nat 79 | def U8.toInt: ∀ (x: U8) -> #Int = #U8.to_Int 80 | -------------------------------------------------------------------------------- /parsec/error.ya: -------------------------------------------------------------------------------- 1 | package error 2 | import bool 3 | import either 4 | import list 5 | import maybe 6 | import text 7 | import char 8 | import nat 9 | where 10 | 11 | // #Parsec Errors 12 | 13 | // Items are possible things at a given offset in the input 14 | // a parser might expect to see, or alternatively might *not* expect to see: 15 | // + tokens or characters such as "a", "b", "&", "ϝ", "\ACK" 16 | // + labels or tags that can be attached to parsers, such as "an ascii char" 17 | // + the end of the input stream 18 | type Item { 19 | Tokens Text, 20 | Label Text, 21 | Eof, 22 | } 23 | 24 | // A Fancy error is where the parser author preempts the internal error system 25 | // and instead returns a custom failure message or a value of custom type E 26 | type Fancy (E: Type) { 27 | Fail Text, 28 | Custom E, 29 | } 30 | 31 | // A parser error can be either 32 | // + a trivial error containing 33 | // * the offset at which the error occured 34 | // * possibly an unexpected Item which triggered the error at that offset 35 | // * a list of expected Items at that offset 36 | // + a user specified custom error containing 37 | // * the offset at which the error occured 38 | // * a list of Fancy error messages at that offset 39 | type Error (E: Type) { 40 | Trivial (pos: Nat) (unexpected: Maybe Item) (expected: List Item), 41 | Fancy (pos: Nat) (messages: List (Fancy E)), 42 | } 43 | 44 | // When a parser branches and tries different possible options on its input 45 | // we need some way to combine the errors that each branch generates. 46 | // Because branches that consume more input are better than those that do less 47 | // the errors from farther along the input are more useful. 48 | // Thus to merge errors we compare positions and throw away the earlier error. 49 | // If both errors occur at the same place though, we prefer fancy errors. 50 | // If both errors are fancy at the same place, we merge the messages. 51 | // If both errors are trivial at the same place, we merge the expected items. 52 | // (We also try to prefer the presence of an unexpected token over its absence) 53 | def Error.merge (E: Type) (x y: Error E): Error E = 54 | (case x) (λ _ => Error E) 55 | (λ x_pos x_unx x_exp => (case y) (λ _ => Error E) 56 | (λ y_pos y_unx y_exp => 57 | (case (Nat.compare x_pos y_pos)) (λ _ => Error E) 58 | y 59 | (Error.Trivial E x_pos x_unx (List.concat Item x_exp y_exp)) 60 | x 61 | ) 62 | (λ y_pos y_msg => (case (Nat.compare x_pos y_pos)) (λ _ => Error E) y y x) 63 | ) 64 | (λ x_pos x_msg => (case y) (λ _ => Error E) 65 | (λ y_pos y_unx y_exp => 66 | (case (Nat.compare x_pos y_pos)) (λ _ => Error E) y x x) 67 | (λ y_pos y_msg => (case (Nat.compare x_pos y_pos)) (λ _ => Error E) 68 | y 69 | (Error.Fancy E x_pos (List.concat (Fancy E) x_msg y_msg)) 70 | x 71 | ) 72 | ) 73 | 74 | 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /list.ya: -------------------------------------------------------------------------------- 1 | package list 2 | import bool 3 | import functor 4 | import maybe 5 | import monad 6 | import natural 7 | where 8 | 9 | type List (A: Type) { 10 | Nil, 11 | Cons A (List A), 12 | } 13 | 14 | def List.single (0 A: Type) (x: A): List A = List.Cons A x (List.Nil A) 15 | 16 | def List.head (0 A: Type) (a: List A): Maybe A 17 | = (case a) (λ _ => Maybe A) (Maybe.None A) (λ x _ => Maybe.Some A x) 18 | 19 | def List.tail (0 A: Type) (a : List A): Maybe (List A) 20 | = (case a) (λ _ => Maybe (List A)) 21 | (Maybe.None (List A) ) 22 | (λ _ xs => Maybe.Some (List A) xs) 23 | 24 | def List.concat (0 A: Type) (a b: List A): List A 25 | = (case a) (λ _ => List A) b (λ x xs => List.Cons A x (List.concat A xs b)) 26 | 27 | def List.replicate (0 A: Type) (x: A): List A = List.Cons A x (List.replicate A x) 28 | 29 | def List.take (0 A: Type) (n: Natural) (list: List A): Maybe (List A) = 30 | (case n) (λ _ => Maybe (List A)) 31 | (Maybe.Some (List A) (List.Nil A)) 32 | (λ pre => (case list) (λ _ => Maybe (List A)) 33 | (Maybe.None (List A)) 34 | (λ x xs => Maybe.map (List A) (List A) (List.Cons A x) (List.take A pre xs)) 35 | ) 36 | 37 | def List.drop (0 A: Type) (n: Natural) (list: List A): Maybe (List A) = 38 | (case n) (λ _ => Maybe (List A)) 39 | (Maybe.Some (List A) list) 40 | (λ pre => (case list) (λ _ => Maybe (List A)) 41 | (Maybe.None (List A)) 42 | (λ _ xs => List.drop A pre xs) 43 | ) 44 | 45 | def List.at (0 A: Type) (list: List A) (idx: Natural): Maybe A 46 | = (case idx) (λ _ => Maybe A) 47 | (List.head A list) 48 | (λ pre => List.at A list pre) 49 | 50 | def List.flatten (0 A: Type) (list: List (List A)): List A 51 | = (case list) (λ _ => List A) 52 | (List.Nil A) 53 | (λ x xs => List.concat A x (List.flatten A xs)) 54 | 55 | def List.singleton (0 A : Type) (a : A): List A 56 | = List.Cons A a (List.Nil A) 57 | 58 | def List.map (0 A B: Type) (f: forall A -> B) (list : List A): List B 59 | = (case list) (λ _ => List B) 60 | (List.Nil B) 61 | (λ x xs => List.Cons B (f x) (List.map A B f xs)) 62 | 63 | def List.foldr (0 A: Type) (0 B: Type) (f: forall A B -> B) (b: B) (list: List A): B 64 | = (case list) (λ _ => B) 65 | b 66 | (λ x xs => f x (List.foldr A B f b xs)) 67 | 68 | 69 | def List.foldl (0 A: Type) (0 B: Type) (f: forall A B -> B) (b: B) (list: List A): B 70 | = (case list) (λ _ => B) 71 | b 72 | (λ x xs => (List.foldl A B f (f x b) xs)) 73 | 74 | 75 | def List.flatMap (0 A: Type) (B: Type) (l: List A) (fun: forall A -> (List B)): List B 76 | = List.flatten B (List.map A (List B) fun l) 77 | 78 | def List.elem (0 A: Type) (f: forall A A -> Bool) (value: A) (list: List A): Bool 79 | = (case list) (λ _ => Bool) 80 | Bool.False 81 | (λ x xs => 82 | Bool.if Bool (f value x) Bool.True (List.elem A f value xs)) 83 | 84 | def List.functor: Functor List 85 | = Functor.New (λ A => List A) (λ A B f xs => List.map A B f xs) 86 | 87 | def List.monad: Monad List 88 | = Monad.New (λ A => List A) (λ A x => List.single A x) (λ A B list f => List.flatMap A B list f) 89 | -------------------------------------------------------------------------------- /list_sort.ya: -------------------------------------------------------------------------------- 1 | //package ListSort where 2 | // 3 | //open List (List, cons, singleton, nil) 4 | //open Compared (Compared, Ordered, compareOrdered) 5 | // 6 | //def merge (0 A : Type) (ord : Ordered A) (as : List A) (bs : List A): List A = 7 | // let cmp : ∀ A A -> Compared = compareOrdered A ord; 8 | // (case as) (λ _ => List A) 9 | // (bs) 10 | // (λ a ass => (case bs) (λ _ => List A) 11 | // as 12 | // (λ b bss => (case (cmp a b)) (λ _ => List A) 13 | // (cons A a (merge A ord ass bs)) 14 | // (cons A a (merge A ord ass bs)) 15 | // (cons A b (merge A ord as bss)) 16 | // ) 17 | // ) 18 | // 19 | //def mergePairs (0 A : Type) (ord : Ordered A) (xs : List (List A)) : List (List A) = 20 | // (case xs) (λ _ => List (List A)) 21 | // (xs) 22 | // (λ a as => 23 | // (case as) (λ _ => List (List A)) 24 | // (xs) 25 | // (λ b _ => cons (List A) (merge A ord a b) (mergePairs A ord as)) 26 | // ) 27 | // 28 | //def mergeAll (0 A : Type) (ord : Ordered A) (xs : List (List A)): List A = 29 | // let mAllRec : List A = mergeAll A ord (mergePairs A ord xs); 30 | // (case xs) (λ _ => List A) 31 | // (mAllRec) 32 | // (λ x xs => 33 | // (case xs) (λ _ => List A) 34 | // x 35 | // (λ _ _ => mAllRec) 36 | // ) 37 | // 38 | //// Split the list into ascending or descending sequences 39 | //def sequences (0 A : Type) (ord : Ordered A) (l: List A): (List (List A)) = 40 | // letrec cmp : ∀ A A -> Compared = compareOrdered A ord; 41 | // letrec descending : ∀ (A) (List A) (List A) -> List (List A) = 42 | // (λ a as bs => 43 | // let seq : List (List A) = cons (List A) (cons A a as) (sequences A ord bs); 44 | // (case bs) (λ _ => List (List A)) 45 | // (seq) 46 | // (λ b bs => (case (cmp a b)) (λ _ => List (List A)) 47 | // (seq) 48 | // (seq) 49 | // (descending b (cons A a as) bs)) 50 | // ); 51 | // letrec ascending : ∀ (A) (∀ (List A) -> List A) (List A) -> List (List A) = 52 | // (λ a as bs => 53 | // let cmp : ∀ A A -> Compared = compareOrdered A ord; 54 | // let seq : List (List A) = cons (List A) (as (singleton A a)) (sequences A ord bs); 55 | // (case bs) (λ _ => List (List A)) 56 | // (seq) 57 | // (λ b bs => (case (cmp a b)) (λ _ => List (List A)) 58 | // (ascending b (λ ys => (as (cons A a ys))) bs) 59 | // (ascending b (λ ys => (as (cons A a ys))) bs) 60 | // (seq) 61 | // ) 62 | // ); 63 | // (case l) (λ _ => List (List A)) 64 | // (singleton (List A) l) 65 | // (λ a lTail => 66 | // (case lTail) (λ _ => List (List A)) 67 | // (singleton (List A) l) 68 | // (λ b xs => 69 | // (case (cmp a b)) (λ _ => List (List A)) 70 | // (ascending b (cons A a) xs) -- ltn 71 | // (ascending b (cons A a) xs) -- eql 72 | // (descending b (singleton A a) xs) -- gtn 73 | // ) 74 | // ) 75 | // 76 | //// Sort a list with merge sort 77 | //def mergeSort (0 A : Type) (ord : Ordered A) (list : List A): List A = 78 | // mergeAll A ord (sequences A ord list) 79 | -------------------------------------------------------------------------------- /u16.ya: -------------------------------------------------------------------------------- 1 | package u16 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def U16: Type = #U16 10 | 11 | def U16.MAX: U16 = #U16.max 12 | def U16.MIN: U16 = #U16.min 13 | 14 | def U16.eql: ∀ (x y: U16) -> Bool = #U16.eql 15 | def U16.lte: ∀ (x y: U16) -> Bool = #U16.lte 16 | def U16.lth: ∀ (x y: U16) -> Bool = #U16.lth 17 | def U16.gte: ∀ (x y: U16) -> Bool = #U16.gte 18 | def U16.gth: ∀ (x y: U16) -> Bool = #U16.gth 19 | def U16.and: ∀ (x y: U16) -> Bool = #U16.and 20 | def U16.xor: ∀ (x y: U16) -> Bool = #U16.xor 21 | def U16.or: ∀ (x y: U16) -> Bool = #U16.or 22 | def U16.neq (x y: U16): Bool = Bool.not (U16.eql x y) 23 | 24 | def U16.add: ∀ (x y: U16) -> U16 = #U16.add 25 | def U16.addSafe (x y: U16) (0 e: Is (U16.gte (#U16.add x y) x)): U16 26 | = #U16.add x y 27 | 28 | def U16.sub: ∀ (x y: U16) -> U16 = #U16.sub 29 | def U16.subSafe (x y: U16) (0 e: Is (U16.lte y x)): U16 = #U16.sub x y 30 | 31 | def U16.mul: ∀ (x y: U16) -> U16 = #U16.mul 32 | 33 | def U16.SafeMul (x y: U16): Bool = 34 | (case (U16.eql x 0u16)) (λ _ => Bool) 35 | Bool.True 36 | (U16.eql (#U16.div (#U16.mul x y) x) y) 37 | 38 | def U16.mulSafe (x y: U16) (0 e: Is (U16.SafeMul x y)): U16 = #U16.mul x y 39 | 40 | def U16.div (x y: U16): Maybe U16 = 41 | (case (U16.neq y 0u16)) (λ _ => Maybe U16) 42 | (Maybe.Some U16 (#U16.div x y)) 43 | (Maybe.None U16) 44 | 45 | def U16.divSafe (x y: U16) (0 e: Is (U16.neq y 0)): U16 = #U16.div x y 46 | 47 | def U16.mod (x y: U16): Maybe U16 = 48 | (case (U16.neq y 0u16)) (λ _ => Maybe U16) 49 | (Maybe.Some U16 (#U16.mod x y)) 50 | (Maybe.None U16) 51 | 52 | def U16.modSafe (x y: U16) (0 e: Is (U16.neq y 0)): U16 = #U16.mod x y 53 | 54 | def U16.pow: ∀ (x: U16) (y: U32) -> U16 = #U16.pow 55 | def U16.shl: ∀ (x: U32) (y: U16) -> U16 = #U16.shl 56 | def U16.shr: ∀ (x: U32) (y: U16) -> U16 = #U16.shr 57 | def U16.rol: ∀ (x: U32) (y: U16) -> U16 = #U16.rol 58 | def U16.ror: ∀ (x: U32) (y: U16) -> U16 = #U16.ror 59 | 60 | def U16.countZeros: ∀ (x: U16) -> U32 = #U16.count_zeros 61 | def U16.countOnes: ∀ (x: U16) -> U32 = #U16.count_ones 62 | 63 | def U16.toU8 (x: U16): Maybe #U8 = 64 | (case (U16.lte x (#U8.to_U16 #U8.max))) (λ _ => Maybe #U8) 65 | (Maybe.Some #U8 (#U16.to_U8 x)) 66 | (Maybe.None #U8) 67 | 68 | def U16.toU8Safe (x: U16) (0 e: Is (U16.lte x (#U8.to_U16 #U8.max))): #U8 69 | = #U16.to_U8 x 70 | 71 | def U16.toU32: ∀ (x: U16) -> #U32 = #U16.to_U32 72 | def U16.toU64: ∀ (x: U16) -> #U64 = #U16.to_U64 73 | 74 | def U16.toI8 (x: U16): Maybe #I8 = 75 | (case (U16.lte x (#I8.to_U16 #I8.max))) (λ _ => Maybe #I8) 76 | (Maybe.Some #I8 (#U16.to_I8 x)) 77 | (Maybe.None #I8) 78 | 79 | def U16.toI8Safe (x: U16) (0 e: Is (U16.lte x (#I8.to_U16 #I8.max))): #I8 80 | = #U16.to_I8 x 81 | 82 | def U16.toI16 (x: U16): Maybe #I16 = 83 | (case (U16.lte x (#I16.to_U16 #I16.max))) (λ _ => Maybe #I16) 84 | (Maybe.Some #I16 (#U16.to_I16 x)) 85 | (Maybe.None #I16) 86 | 87 | def U16.toI16Safe (x: U32) (0 e: Is (U16.lte x (#I16.to_U32 #I16.max))): #I16 88 | = #U32.to_I16 x 89 | 90 | def U16.toI32: ∀ (x: U16) -> #I32 = #U16.to_I32 91 | def U16.toI64: ∀ (x: U16) -> #I64 = #U16.to_I64 92 | 93 | def U16.toNat: ∀ (x: U16) -> #Nat = #U16.to_Nat 94 | def U16.toInt: ∀ (x: U16) -> #Int = #U16.to_Int 95 | -------------------------------------------------------------------------------- /u32.ya: -------------------------------------------------------------------------------- 1 | package u32 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | where 7 | 8 | def U32: Type = #U32 9 | 10 | def U32.MAX: U32 = #U32.max 11 | def U32.MIN: U32 = #U32.min 12 | 13 | def U32.eql: ∀ (x y: U32) -> Bool = #U32.eql 14 | def U32.lte: ∀ (x y: U32) -> Bool = #U32.lte 15 | def U32.lth: ∀ (x y: U32) -> Bool = #U32.lth 16 | def U32.gte: ∀ (x y: U32) -> Bool = #U32.gte 17 | def U32.gth: ∀ (x y: U32) -> Bool = #U32.gth 18 | def U32.and: ∀ (x y: U32) -> Bool = #U32.and 19 | def U32.xor: ∀ (x y: U32) -> Bool = #U32.xor 20 | def U32.or: ∀ (x y: U32) -> Bool = #U32.or 21 | def U32.neq (x y: U32): Bool = Bool.not (U32.eql x y) 22 | 23 | def U32.add: ∀ (x y: U32) -> U32 = #U32.add 24 | def U32.addSafe (x y: U32) (0 e: Is (U32.gte (#U32.add x y) x)): U32 25 | = #U32.add x y 26 | 27 | def U32.sub: ∀ (x y: U32) -> U32 = #U32.sub 28 | def U32.subSafe (x y: U32) (0 e: Is (U32.lte y x)): U32 = #U32.sub x y 29 | 30 | def U32.mul: ∀ (x y: U32) -> U32 = #U32.mul 31 | 32 | def U32.SafeMul (x y: U32): Bool = 33 | (case (U32.eql x 0u32)) (λ _ => Bool) 34 | Bool.True 35 | (U32.eql (#U32.div (#U32.mul x y) x) y) 36 | 37 | def U32.mulSafe (x y: U32) (0 e: Is (U32.SafeMul x y)): U32 = #U32.mul x y 38 | 39 | def U32.div (x y: U32): Maybe U32 = 40 | (case (U32.neq y 0u32)) (λ _ => Maybe U32) 41 | (Maybe.Some U32 (#U32.div x y)) 42 | (Maybe.None U32) 43 | 44 | def U32.divSafe (x y: U32) (0 e: Is (U32.neq y 0)): U32 = #U32.div x y 45 | 46 | def U32.mod (x y: U32): Maybe U32 = 47 | (case (U32.neq y 0u32)) (λ _ => Maybe U32) 48 | (Maybe.Some U32 (#U32.mod x y)) 49 | (Maybe.None U32) 50 | 51 | def U32.modSafe (x y: U32) (0 e: Is (U32.neq y 0)): U32 = #U32.mod x y 52 | 53 | def U32.pow: ∀ (x y: U32) -> U32 = #U32.pow 54 | def U32.shl: ∀ (x y: U32) -> U32 = #U32.shl 55 | def U32.shr: ∀ (x y: U32) -> U32 = #U32.shr 56 | def U32.rol: ∀ (x y: U32) -> U32 = #U32.rol 57 | def U32.ror: ∀ (x y: U32) -> U32 = #U32.ror 58 | 59 | def U32.countZeros: ∀ (x: U32) -> U32 = #U32.count_zeros 60 | def U32.countOnes: ∀ (x: U32) -> U32 = #U32.count_ones 61 | 62 | def U32.toU8 (x: U32): Maybe #U8 = 63 | (case (U32.lte x (#U8.to_U32 #U8.max))) (λ _ => Maybe #U8) 64 | (Maybe.Some #U8 (#U32.to_U8 x)) 65 | (Maybe.None #U8) 66 | 67 | def U32.toU8Safe (x: U32) (0 e: Is (U32.lte x (#U8.to_U32 #U8.max))): #U8 68 | = #U32.to_U8 x 69 | 70 | def U32.toU16 (x: U32): Maybe #U16 = 71 | (case (U32.lte x (#U16.to_U32 #U16.max))) (λ _ => Maybe #U16) 72 | (Maybe.Some #U16 (#U32.to_U16 x)) 73 | (Maybe.None #U16) 74 | 75 | def U32.toU16Safe (x: U32) (0 e: Is (U32.lte x (#U16.to_U32 #U16.max))): #U16 76 | = #U32.to_U16 x 77 | 78 | def U32.toU64: ∀ (x: U32) -> #U64 = #U32.to_U64 79 | 80 | def U32.toI8 (x: U32): Maybe #I8 = 81 | (case (U32.lte x (#I8.to_U32 #I8.max))) (λ _ => Maybe #I8) 82 | (Maybe.Some #I8 (#U32.to_I8 x)) 83 | (Maybe.None #I8) 84 | 85 | def U32.toI8Safe (x: U32) (0 e: Is (U32.lte x (#I8.to_U32 #I8.max))): #I8 86 | = #U32.to_I8 x 87 | 88 | def U32.toI16 (x: U32): Maybe #I16 = 89 | (case (U32.lte x (#I16.to_U32 #I16.max))) (λ _ => Maybe #I16) 90 | (Maybe.Some #I16 (#U32.to_I16 x)) 91 | (Maybe.None #I16) 92 | 93 | def U32.toI16Safe (x: U32) (0 e: Is (U32.lte x (#I16.to_U32 #I16.max))): #I16 94 | = #U32.to_I16 x 95 | 96 | def U32.toI32 (x: U32): Maybe #I32 = 97 | (case (U32.lte x (#I32.to_U32 #I32.max))) (λ _ => Maybe #I32) 98 | (Maybe.Some #I32 (#U32.to_I32 x)) 99 | (Maybe.None #I32) 100 | 101 | def U32.toI32Safe (x: U32) (0 e: Is (U32.lte x (#I32.to_U32 #I32.max))): #I32 102 | = #U32.to_I32 x 103 | 104 | def U32.toI64: ∀ (x: U32) -> #I64 = #U32.to_I64 105 | 106 | def U32.toNat: ∀ (x: U32) -> #Nat = #U32.to_Nat 107 | def U32.toInt: ∀ (x: U32) -> #Int = #U32.to_Int 108 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "naersk-lib": { 4 | "inputs": { 5 | "nixpkgs": "nixpkgs_2" 6 | }, 7 | "locked": { 8 | "lastModified": 1623927034, 9 | "narHash": "sha256-sGxlmfp5eXL5sAMNqHSb04Zq6gPl+JeltIZ226OYN0w=", 10 | "owner": "nmattia", 11 | "repo": "naersk", 12 | "rev": "e09c320446c5c2516d430803f7b19f5833781337", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "nmattia", 17 | "repo": "naersk", 18 | "type": "github" 19 | } 20 | }, 21 | "nixpkgs": { 22 | "locked": { 23 | "lastModified": 1625767768, 24 | "narHash": "sha256-X3kSjMSYuKV0k67hM9RD5h4EHVt+mmjYmMVxm1T4Bd0=", 25 | "owner": "nixos", 26 | "repo": "nixpkgs", 27 | "rev": "ad9a2ed50fd9184ac4db372c237ae7638372896a", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "nixos", 32 | "repo": "nixpkgs", 33 | "type": "github" 34 | } 35 | }, 36 | "nixpkgs_2": { 37 | "locked": { 38 | "lastModified": 1624958234, 39 | "narHash": "sha256-DWl7IW8NtTgD7Pa1FX/9+LI7BaIxWwQaUOaLHPG5ksQ=", 40 | "owner": "NixOS", 41 | "repo": "nixpkgs", 42 | "rev": "bcd6993fae602c1799466c05e4c9aaf570e1d6f3", 43 | "type": "github" 44 | }, 45 | "original": { 46 | "id": "nixpkgs", 47 | "type": "indirect" 48 | } 49 | }, 50 | "nixpkgs_3": { 51 | "locked": { 52 | "lastModified": 1622465836, 53 | "narHash": "sha256-9/6YC9hCO8hHODaN6p/AKjS1jVDf5NSD6iRA4hKnhRY=", 54 | "owner": "nixos", 55 | "repo": "nixpkgs", 56 | "rev": "829b074ee04083b06712862be9e5c63c1713d278", 57 | "type": "github" 58 | }, 59 | "original": { 60 | "owner": "nixos", 61 | "repo": "nixpkgs", 62 | "type": "github" 63 | } 64 | }, 65 | "root": { 66 | "inputs": { 67 | "nixpkgs": "nixpkgs", 68 | "utils": "utils", 69 | "yatima": "yatima" 70 | } 71 | }, 72 | "utils": { 73 | "locked": { 74 | "lastModified": 1623875721, 75 | "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", 76 | "owner": "numtide", 77 | "repo": "flake-utils", 78 | "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", 79 | "type": "github" 80 | }, 81 | "original": { 82 | "owner": "numtide", 83 | "repo": "flake-utils", 84 | "type": "github" 85 | } 86 | }, 87 | "utils_2": { 88 | "locked": { 89 | "lastModified": 1622445595, 90 | "narHash": "sha256-m+JRe6Wc5OZ/mKw2bB3+Tl0ZbtyxxxfnAWln8Q5qs+Y=", 91 | "owner": "numtide", 92 | "repo": "flake-utils", 93 | "rev": "7d706970d94bc5559077eb1a6600afddcd25a7c8", 94 | "type": "github" 95 | }, 96 | "original": { 97 | "owner": "numtide", 98 | "repo": "flake-utils", 99 | "type": "github" 100 | } 101 | }, 102 | "yatima": { 103 | "inputs": { 104 | "naersk-lib": "naersk-lib", 105 | "nixpkgs": "nixpkgs_3", 106 | "utils": "utils_2" 107 | }, 108 | "locked": { 109 | "lastModified": 1625611235, 110 | "narHash": "sha256-7IolAagsJU8cfDAbZBL4pJ19uibfeRO/2DOM5QQtXeg=", 111 | "owner": "yatima-inc", 112 | "repo": "yatima", 113 | "rev": "c977c02eef6f20147d2f4d00bfee5e2931638ebb", 114 | "type": "github" 115 | }, 116 | "original": { 117 | "owner": "yatima-inc", 118 | "repo": "yatima", 119 | "type": "github" 120 | } 121 | } 122 | }, 123 | "root": "root", 124 | "version": 7 125 | } 126 | -------------------------------------------------------------------------------- /i8.ya: -------------------------------------------------------------------------------- 1 | package i8 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def I8: Type = #I8 10 | 11 | def I8.MAX: I8 = #I8.max 12 | def I8.MIN: I8 = #I8.min 13 | 14 | def I8.abs: ∀ (x: I8) -> #U8 = #I8.abs 15 | def I8.sgn: ∀ (x: I8) -> Bool = #I8.sgn 16 | 17 | def I8.eql: ∀ (x y: I8) -> Bool = #I8.eql 18 | def I8.lte: ∀ (x y: I8) -> Bool = #I8.lte 19 | def I8.lth: ∀ (x y: I8) -> Bool = #I8.lth 20 | def I8.gte: ∀ (x y: I8) -> Bool = #I8.gte 21 | def I8.gth: ∀ (x y: I8) -> Bool = #I8.gth 22 | def I8.and: ∀ (x y: I8) -> Bool = #I8.and 23 | def I8.xor: ∀ (x y: I8) -> Bool = #I8.xor 24 | def I8.or: ∀ (x y: I8) -> Bool = #I8.or 25 | def I8.neq (x y: I8): Bool = Bool.not (I8.eql x y) 26 | 27 | def I8.add: ∀ (x y: I8) -> I8 = #I8.add 28 | 29 | def I8.SafeAdd (x y: I8): Bool = 30 | Bool.not 31 | (Bool.and 32 | (Bool.eql (I8.sgn x) (I8.sgn y)) 33 | (Bool.neq (I8.sgn x) (I8.sgn (#I8.add x y))) 34 | ) 35 | 36 | def I8.addSafe (x y: I8) (0 e: Is (I8.SafeAdd x y)): I8 = #I8.add x y 37 | 38 | def I8.sub: ∀ (x y: I8) -> I8 = #I8.sub 39 | 40 | def I8.SafeSub (x y: I8): Bool = 41 | Bool.not 42 | (Bool.and 43 | (Bool.eql (I8.sgn x) (Bool.not (I8.sgn y))) 44 | (Bool.neq (I8.sgn x) (I8.sgn (#I8.sub x y))) 45 | ) 46 | 47 | def I8.subSafe (x y: I8) (0 e: Is (I8.lte y x)): I8 = #I8.sub x y 48 | 49 | def I8.mul: ∀ (x y: I8) -> I8 = #I8.mul 50 | 51 | def I8.SafeMul (x y: I8): Bool = 52 | Bool.or (I8.eql x +0i8) 53 | ((case (I8.eql y +0i8)) (λ _ => Bool) 54 | Bool.True 55 | (I8.eql (#I8.div (#I8.mul x y) y) x) 56 | ) 57 | 58 | def I8.mulSafe (x y: I8) (0 e: Is (I8.SafeMul x y)): I8 = #I8.mul x y 59 | 60 | def I8.div (x y: I8): Maybe I8 = 61 | (case (I8.neq y +0i8)) (λ _ => Maybe I8) 62 | (Maybe.Some I8 (#I8.div x y)) 63 | (Maybe.None I8) 64 | 65 | def I8.divSafe (x y: I8) (0 e: Is (I8.neq y +0i8)): I8 = #I8.div x y 66 | 67 | def I8.mod (x y: I8): Maybe I8 = 68 | (case (I8.neq y +0i8)) (λ _ => Maybe I8) 69 | (Maybe.Some I8 (#I8.mod x y)) 70 | (Maybe.None I8) 71 | 72 | def I8.modSafe (x y: I8) (0 e: Is (I8.neq y +0i8)): I8 = #I8.mod x y 73 | 74 | def I8.pow: ∀ (x: I8) (y: U32) -> I8 = #I8.pow 75 | def I8.shl: ∀ (x: U32) (y: I8) -> I8 = #I8.shl 76 | def I8.shr: ∀ (x: U32) (y: I8) -> I8 = #I8.shr 77 | def I8.rol: ∀ (x: U32) (y: I8) -> I8 = #I8.rol 78 | def I8.ror: ∀ (x: U32) (y: I8) -> I8 = #I8.ror 79 | 80 | def I8.countZeros: ∀ (x: I8) -> U32 = #I8.count_zeros 81 | def I8.countOnes: ∀ (x: I8) -> U32 = #I8.count_ones 82 | 83 | def I8.toU8 (x: I8): Maybe #U8 = 84 | (case (I8.sgn x)) (λ _ => Maybe #U8) 85 | (Maybe.Some #U8 (#I8.to_U8 x)) 86 | (Maybe.None #U8) 87 | 88 | def I8.toU8Safe (x: I8) (0 e: Is (I8.sgn x)): #U8 = #I8.to_U8 x 89 | 90 | def I8.toU16 (x: I8): Maybe #U16 = 91 | (case (I8.sgn x)) (λ _ => Maybe #U16) 92 | (Maybe.Some #U16 (#I8.to_U16 x)) 93 | (Maybe.None #U16) 94 | 95 | def I8.toU16Safe (x: I8) (0 e: Is (I8.sgn x)): #U16 = #I8.to_U16 x 96 | 97 | def I8.toU32 (x: I8): Maybe #U32 = 98 | (case (I8.sgn x)) (λ _ => Maybe #U32) 99 | (Maybe.Some #U32 (#I8.to_U32 x)) 100 | (Maybe.None #U32) 101 | 102 | def I8.toU32Safe (x: I8) (0 e: Is (I8.sgn x)): #U32 = #I8.to_U32 x 103 | 104 | def I8.toU64 (x: I8): Maybe #U64 = 105 | (case (I8.sgn x)) (λ _ => Maybe #U64) 106 | (Maybe.Some #U64 (#I8.to_U64 x)) 107 | (Maybe.None #U64) 108 | 109 | def I8.toU64Safe (x: I8) (0 e: Is (I8.sgn x)): #U64 = #I8.to_U64 x 110 | 111 | def I8.toNat (x: I8): Maybe #Nat = 112 | (case (I8.sgn x)) (λ _ => Maybe #Nat) 113 | (Maybe.Some #Nat (#I8.to_Nat x)) 114 | (Maybe.None #Nat) 115 | 116 | def I8.toNatSafe (x: I8) (0 e: Is (I8.sgn x)): #Nat = #I8.to_Nat x 117 | 118 | def I8.toI16: ∀ (x: I8) -> #I16 = #I8.to_I16 119 | def I8.toI32: ∀ (x: I8) -> #I32 = #I8.to_I32 120 | def I8.toI64: ∀ (x: I8) -> #I64 = #I8.to_I64 121 | def I8.toInt: ∀ (x: I8) -> #Int = #I8.to_Int 122 | -------------------------------------------------------------------------------- /u64.ya: -------------------------------------------------------------------------------- 1 | package u64 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def U64: Type = #U64 10 | 11 | def U64.MAX: U64 = #U64.max 12 | def U64.MIN: U64 = #U64.min 13 | 14 | def U64.eql: ∀ (x y: U64) -> Bool = #U64.eql 15 | def U64.lte: ∀ (x y: U64) -> Bool = #U64.lte 16 | def U64.lth: ∀ (x y: U64) -> Bool = #U64.lth 17 | def U64.gte: ∀ (x y: U64) -> Bool = #U64.gte 18 | def U64.gth: ∀ (x y: U64) -> Bool = #U64.gth 19 | def U64.and: ∀ (x y: U64) -> Bool = #U64.and 20 | def U64.xor: ∀ (x y: U64) -> Bool = #U64.xor 21 | def U64.or: ∀ (x y: U64) -> Bool = #U64.or 22 | def U64.neq (x y: U64): Bool = Bool.not (U64.eql x y) 23 | 24 | def U64.add: ∀ (x y: U64) -> U64 = #U64.add 25 | def U64.addSafe (x y: U64) (0 e: Is (U64.gte (#U64.add x y) x)): U64 26 | = #U64.add x y 27 | 28 | def U64.sub: ∀ (x y: U64) -> U64 = #U64.sub 29 | def U64.subSafe (x y: U64) (0 e: Is (U64.lte y x)): U64 = #U64.sub x y 30 | 31 | def U64.mul: ∀ (x y: U64) -> U64 = #U64.mul 32 | 33 | def U64.SafeMul (x y: U64): Bool = 34 | (case (U64.eql x 0u64)) (λ _ => Bool) 35 | Bool.True 36 | (U64.eql (#U64.div (#U64.mul x y) x) y) 37 | 38 | def U64.mulSafe (x y: U64) (0 e: Is (U64.SafeMul x y)): U64 = #U64.mul x y 39 | 40 | def U64.div (x y: U64): Maybe U64 = 41 | (case (U64.neq y 0u64)) (λ _ => Maybe U64) 42 | (Maybe.Some U64 (#U64.div x y)) 43 | (Maybe.None U64) 44 | 45 | def U64.divSafe (x y: U64) (0 e: Is (U64.neq y 0)): U64 = #U64.div x y 46 | 47 | def U64.mod (x y: U64): Maybe U64 = 48 | (case (U64.neq y 0u64)) (λ _ => Maybe U64) 49 | (Maybe.Some U64 (#U64.mod x y)) 50 | (Maybe.None U64) 51 | 52 | def U64.modSafe (x y: U64) (0 e: Is (U64.neq y 0)): U64 = #U64.mod x y 53 | 54 | def U64.pow: ∀ (x: U64) (y: U32) -> U64 = #U64.pow 55 | def U64.shl: ∀ (x: U32) (y: U64) -> U64 = #U64.shl 56 | def U64.shr: ∀ (x: U32) (y: U64) -> U64 = #U64.shr 57 | def U64.rol: ∀ (x: U32) (y: U64) -> U64 = #U64.rol 58 | def U64.ror: ∀ (x: U32) (y: U64) -> U64 = #U64.ror 59 | 60 | def U64.countZeros: ∀ (x: U64) -> U32 = #U64.count_zeros 61 | def U64.countOnes: ∀ (x: U64) -> U32 = #U64.count_ones 62 | 63 | def U64.toU8 (x: U64): Maybe #U8 = 64 | (case (U64.lte x (#U8.to_U64 #U8.max))) (λ _ => Maybe #U8) 65 | (Maybe.Some #U8 (#U64.to_U8 x)) 66 | (Maybe.None #U8) 67 | 68 | def U64.toU8Safe (x: U64) (0 e: Is (U64.lte x (#U8.to_U64 #U8.max))): #U8 69 | = #U64.to_U8 x 70 | 71 | def U64.toU16 (x: U64): Maybe #U16 = 72 | (case (U64.lte x (#U16.to_U64 #U16.max))) (λ _ => Maybe #U16) 73 | (Maybe.Some #U16 (#U64.to_U16 x)) 74 | (Maybe.None #U16) 75 | 76 | def U64.toU16Safe (x: U64) (0 e: Is (U64.lte x (#U16.to_U64 #U16.max))): #U16 77 | = #U64.to_U16 x 78 | 79 | def U64.toU32 (x: U64): Maybe #U32 = 80 | (case (U64.lte x (#U32.to_U64 #U32.max))) (λ _ => Maybe #U32) 81 | (Maybe.Some #U32 (#U64.to_U32 x)) 82 | (Maybe.None #U32) 83 | 84 | def U64.toU32Safe (x: U64) (0 e: Is (U64.lte x (#U32.to_U64 #U32.max))): #U32 85 | = #U64.to_U32 x 86 | 87 | def U64.toI8 (x: U64): Maybe #I8 = 88 | (case (U64.lte x (#I8.to_U64 #I8.max))) (λ _ => Maybe #I8) 89 | (Maybe.Some #I8 (#U64.to_I8 x)) 90 | (Maybe.None #I8) 91 | 92 | def U64.toI8Safe (x: U64) (0 e: Is (U64.lte x (#I8.to_U64 #I8.max))): #I8 93 | = #U64.to_I8 x 94 | 95 | def U64.toI16 (x: U64): Maybe #I16 = 96 | (case (U64.lte x (#I16.to_U64 #I16.max))) (λ _ => Maybe #I16) 97 | (Maybe.Some #I16 (#U64.to_I16 x)) 98 | (Maybe.None #I16) 99 | 100 | def U64.toI16Safe (x: U32) (0 e: Is (U64.lte x (#I16.to_U32 #I16.max))): #I16 101 | = #U32.to_I16 x 102 | 103 | def U64.toI32 (x: U64): Maybe #I32 = 104 | (case (U64.lte x (#I32.to_U64 #I32.max))) (λ _ => Maybe #I32) 105 | (Maybe.Some #I32 (#U64.to_I32 x)) 106 | (Maybe.None #I32) 107 | 108 | def U64.toI32Safe (x: U64) (0 e: Is (U64.lte x (#I32.to_U64 #I32.max))): #I32 109 | = #U64.to_I32 x 110 | 111 | def U64.toI64 (x: U64): Maybe #I64 = 112 | (case (U64.lte x (#I64.to_U64 #I64.max))) (λ _ => Maybe #I64) 113 | (Maybe.Some #I64 (#U64.to_I64 x)) 114 | (Maybe.None #I64) 115 | 116 | def U64.toI64Safe (x: U64) (0 e: Is (U64.lte x (#I64.to_U64 #I64.max))): #I64 117 | = #U64.to_I64 x 118 | 119 | def U64.toNat: ∀ (x: U64) -> #Nat = #U64.to_Nat 120 | def U64.toInt: ∀ (x: U64) -> #Int = #U64.to_Int 121 | -------------------------------------------------------------------------------- /i16.ya: -------------------------------------------------------------------------------- 1 | package i16 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def I16: Type = #I16 10 | 11 | def I16.MAX: I16 = #I16.max 12 | def I16.MIN: I16 = #I16.min 13 | 14 | def I16.abs: ∀ (x: I16) -> #U16 = #I16.abs 15 | def I16.sgn: ∀ (x: I16) -> Bool = #I16.sgn 16 | 17 | def I16.eql: ∀ (x y: I16) -> Bool = #I16.eql 18 | def I16.lte: ∀ (x y: I16) -> Bool = #I16.lte 19 | def I16.lth: ∀ (x y: I16) -> Bool = #I16.lth 20 | def I16.gte: ∀ (x y: I16) -> Bool = #I16.gte 21 | def I16.gth: ∀ (x y: I16) -> Bool = #I16.gth 22 | def I16.and: ∀ (x y: I16) -> Bool = #I16.and 23 | def I16.xor: ∀ (x y: I16) -> Bool = #I16.xor 24 | def I16.or: ∀ (x y: I16) -> Bool = #I16.or 25 | def I16.neq (x y: I16): Bool = Bool.not (I16.eql x y) 26 | 27 | def I16.add: ∀ (x y: I16) -> I16 = #I16.add 28 | 29 | def I16.SafeAdd (x y: I16): Bool = 30 | Bool.not 31 | (Bool.and 32 | (Bool.eql (I16.sgn x) (I16.sgn y)) 33 | (Bool.neq (I16.sgn x) (I16.sgn (#I16.add x y))) 34 | ) 35 | 36 | def I16.addSafe (x y: I16) (0 e: Is (I16.SafeAdd x y)): I16 = #I16.add x y 37 | 38 | def I16.sub: ∀ (x y: I16) -> I16 = #I16.sub 39 | 40 | def I16.SafeSub (x y: I16): Bool = 41 | Bool.not 42 | (Bool.and 43 | (Bool.eql (I16.sgn x) (Bool.not (I16.sgn y))) 44 | (Bool.neq (I16.sgn x) (I16.sgn (#I16.sub x y))) 45 | ) 46 | 47 | def I16.subSafe (x y: I16) (0 e: Is (I16.lte y x)): I16 = #I16.sub x y 48 | 49 | def I16.mul: ∀ (x y: I16) -> I16 = #I16.mul 50 | 51 | def I16.SafeMul (x y: I16): Bool = 52 | Bool.or (I16.eql x +0i16) 53 | ((case (I16.eql y +0i16)) (λ _ => Bool) 54 | Bool.True 55 | (I16.eql (#I16.div (#I16.mul x y) y) x) 56 | ) 57 | 58 | def I16.mulSafe (x y: I16) (0 e: Is (I16.SafeMul x y)): I16 = #I16.mul x y 59 | 60 | def I16.div (x y: I16): Maybe I16 = 61 | (case (I16.neq y +0i16)) (λ _ => Maybe I16) 62 | (Maybe.Some I16 (#I16.div x y)) 63 | (Maybe.None I16) 64 | 65 | def I16.divSafe (x y: I16) (0 e: Is (I16.neq y +0i16)): I16 = #I16.div x y 66 | 67 | def I16.mod (x y: I16): Maybe I16 = 68 | (case (I16.neq y +0i16)) (λ _ => Maybe I16) 69 | (Maybe.Some I16 (#I16.mod x y)) 70 | (Maybe.None I16) 71 | 72 | def I16.modSafe (x y: I16) (0 e: Is (I16.neq y +0i8)): I16 = #I16.mod x y 73 | 74 | def I16.pow: ∀ (x: I16) (y: U32) -> I16 = #I16.pow 75 | def I16.shl: ∀ (x: U32) (y: I16) -> I16 = #I16.shl 76 | def I16.shr: ∀ (x: U32) (y: I16) -> I16 = #I16.shr 77 | def I16.rol: ∀ (x: U32) (y: I16) -> I16 = #I16.rol 78 | def I16.ror: ∀ (x: U32) (y: I16) -> I16 = #I16.ror 79 | 80 | def I16.countZeros: ∀ (x: I16) -> U32 = #I16.count_zeros 81 | def I16.countOnes: ∀ (x: I16) -> U32 = #I16.count_ones 82 | 83 | def I16.SafeToU8 (x: I16): Bool = Bool.and (I16.sgn x) (I16.lte x (#U8.to_I16 #U8.max)) 84 | 85 | def I16.toU8 (x: I16): Maybe #U8 = 86 | (case (I16.SafeToU8 x)) (λ _ => Maybe #U8) 87 | (Maybe.Some #U8 (#I16.to_U8 x)) 88 | (Maybe.None #U8) 89 | 90 | def I16.toU8Safe (x: I16) (0 e: Is (I16.SafeToU8 x)): #U8 = #I16.to_U8 x 91 | 92 | def I16.toU16 (x: I16): Maybe #U16 = 93 | (case (I16.sgn x)) (λ _ => Maybe #U16) 94 | (Maybe.Some #U16 (#I16.to_U16 x)) 95 | (Maybe.None #U16) 96 | 97 | def I16.toU16Safe (x: I16) (0 e: Is (I16.sgn x)): #U16 = #I16.to_U16 x 98 | 99 | def I16.toU32 (x: I16): Maybe #U32 = 100 | (case (I16.sgn x)) (λ _ => Maybe #U32) 101 | (Maybe.Some #U32 (#I16.to_U32 x)) 102 | (Maybe.None #U32) 103 | 104 | def I16.toU32Safe (x: I16) (0 e: Is (I16.sgn x)): #U32 = #I16.to_U32 x 105 | 106 | def I16.toU64 (x: I16): Maybe #U64 = 107 | (case (I16.sgn x)) (λ _ => Maybe #U64) 108 | (Maybe.Some #U64 (#I16.to_U64 x)) 109 | (Maybe.None #U64) 110 | 111 | def I16.toU64Safe (x: I16) (0 e: Is (I16.sgn x)): #U64 = #I16.to_U64 x 112 | 113 | def I16.toNat (x: I16): Maybe #Nat = 114 | (case (I16.sgn x)) (λ _ => Maybe #Nat) 115 | (Maybe.Some #Nat (#I16.to_Nat x)) 116 | (Maybe.None #Nat) 117 | 118 | def I16.toNatSafe (x: I16) (0 e: Is (I16.sgn x)): #Nat = #I16.to_Nat x 119 | 120 | def I16.SafeToI8 (x: I16): Bool = 121 | Bool.or (I16.gte x (#I8.to_I16 #I8.min)) (I16.lte x (#I8.to_I16 #I8.max)) 122 | 123 | def I16.toI8 (x: I16): Maybe #I8 = 124 | (case (I16.SafeToI8 x)) (λ _ => Maybe #I8) 125 | (Maybe.Some #I8 (#I16.to_I8 x)) 126 | (Maybe.None #I8) 127 | 128 | def I16.toI8Safe (x: I16) (0 e: Is (I16.SafeToI8 x)): #I8 = #I16.to_I8 x 129 | 130 | def I16.toI32: ∀ (x: I16) -> #I32 = #I16.to_I32 131 | def I16.toI64: ∀ (x: I16) -> #I64 = #I16.to_I64 132 | def I16.toInt: ∀ (x: I16) -> #Int = #I16.to_Int 133 | -------------------------------------------------------------------------------- /text.ya: -------------------------------------------------------------------------------- 1 | package text 2 | import bool 3 | import is 4 | import pair 5 | import char 6 | import nat 7 | import maybe 8 | import u8 9 | import ord 10 | where 11 | 12 | def Text: Type = #Text 13 | 14 | def Text.nil: Text = "" 15 | def Text.cons: ∀ Char Text -> Text = #Text.cons 16 | 17 | def Text.single (c: Char): Text = Text.cons c Text.nil 18 | 19 | def Text.lenChars: ∀ Text -> Nat = #Text.len_chars 20 | def Text.lenBytes: ∀ Text -> Nat = #Text.len_bytes 21 | def Text.lenLines: ∀ Text -> Nat = #Text.len_lines 22 | 23 | def Text.append: ∀ Text Text -> Text = #Text.append 24 | def Text.insert: ∀ Nat Text Text -> Text = #Text.insert 25 | def Text.remove: ∀ Nat Nat Text -> Text = #Text.remove 26 | 27 | def Text.take: ∀ Nat Text -> Text = #Text.take 28 | def Text.drop: ∀ Nat Text -> Text = #Text.drop 29 | 30 | def Text.split (n: Nat) (txt: Text): Pair Text Text = 31 | Pair.New Text Text (Text.take n txt) (Text.drop n txt) 32 | 33 | def Text.eql: ∀ Text Text -> Bool = #Text.eql 34 | def Text.lte: ∀ Text Text -> Bool = #Text.lte 35 | def Text.lth: ∀ Text Text -> Bool = #Text.lth 36 | def Text.gte: ∀ Text Text -> Bool = #Text.gte 37 | def Text.gth: ∀ Text Text -> Bool = #Text.gth 38 | 39 | def Text.compare (x y: Text): Ordering = 40 | (case (Text.lth x y)) (λ _ => Ordering) 41 | Ordering.LT 42 | ((case (Text.eql x y)) (λ _ => Ordering) Ordering.EQ Ordering.GT) 43 | 44 | def Text.neq (x y: Text): Bool = Bool.not (Text.eql x y) 45 | 46 | def Text.char (idx: Nat) (txt: Text): Maybe Char = 47 | (case (Nat.lth idx (Text.lenChars txt))) (λ _ => Maybe Char) 48 | (Maybe.Some Char (#Text.char idx txt)) 49 | (Maybe.None Char) 50 | 51 | def Text.charSafe 52 | (idx: Nat) (txt: Text) (0 e: Is (Nat.lth idx (Text.lenChars txt))) 53 | : Char 54 | = #Text.char idx txt 55 | 56 | def Text.byte (idx: Nat) (txt: Text): Maybe U8 = 57 | (case (Nat.lth idx (Text.lenBytes txt))) (λ _ => Maybe U8) 58 | (Maybe.Some U8 (#Text.byte idx txt)) 59 | (Maybe.None U8) 60 | 61 | def Text.byteSafe 62 | (idx: Nat) (txt: Text) (0 e: Is (Nat.lth idx (Text.lenBytes txt))) 63 | : U8 64 | = #Text.byte idx txt 65 | 66 | def Text.line (idx: Nat) (txt: Text): Maybe Text = 67 | (case (Nat.lth idx (Text.lenLines txt))) (λ _ => Maybe Text) 68 | (Maybe.Some Text (#Text.line idx txt)) 69 | (Maybe.None Text) 70 | 71 | def Text.lineSafe 72 | (idx: Nat) (txt: Text) (0 e: Is (Nat.lth idx (Text.lenLines txt))): Text 73 | = #Text.line idx txt 74 | 75 | def Text.charAtByte (idx: Nat) (txt: Text): Maybe Nat = 76 | (case (Nat.lth idx (Text.lenBytes txt))) (λ _ => Maybe Nat) 77 | (Maybe.Some Nat (#Text.char_at_byte idx txt)) 78 | (Maybe.None Nat) 79 | 80 | def Text.charAtByteSafe 81 | (idx: Nat) (txt: Text) (0 e: Is (Nat.lth idx (Text.lenBytes txt))) 82 | : Nat 83 | = #Text.char_at_byte idx txt 84 | 85 | def Text.byteAtChar (idx: Nat) (txt: Text): Maybe Nat = 86 | (case (Nat.lth idx (Text.lenChars txt))) (λ _ => Maybe Nat) 87 | (Maybe.Some Nat (#Text.byte_at_char idx txt)) 88 | (Maybe.None Nat) 89 | 90 | def Text.byteAtCharSafe 91 | (i: Nat) (x: Text) (0 e: Is (Nat.lth i (Text.lenChars x))) 92 | : Nat 93 | = #Text.byte_at_char i x 94 | 95 | def Text.lineAtChar (idx: Nat) (txt: Text): Maybe Nat = 96 | (case (Nat.lth idx (Text.lenChars txt))) (λ _ => Maybe Nat) 97 | (Maybe.Some Nat (#Text.line_at_char idx txt)) 98 | (Maybe.None Nat) 99 | 100 | def Text.lineAtCharSafe 101 | (i: Nat) (x: Text) (0 e: Is (Nat.lth i (Text.lenChars x))) 102 | : Nat 103 | = #Text.line_at_char i x 104 | 105 | def Text.lineAtByte (idx: Nat) (txt: Text): Maybe Nat = 106 | (case (Nat.lth idx (Text.lenBytes txt))) (λ _ => Maybe Nat) 107 | (Maybe.Some Nat (#Text.line_at_byte idx txt)) 108 | (Maybe.None Nat) 109 | 110 | def Text.lineAtByteSafe 111 | (i: Nat) (x: Text) (0 e: Is (Nat.lth i (Text.lenBytes x))): Nat 112 | = #Text.line_at_byte i x 113 | 114 | def Text.lineStartChar (idx: Nat) (txt: Text): Maybe Nat = 115 | (case (Nat.lth idx (Text.lenLines txt))) (λ _ => Maybe Nat) 116 | (Maybe.Some Nat (#Text.line_start_char idx txt)) 117 | (Maybe.None Nat) 118 | 119 | def Text.lineStartCharSafe 120 | (i: Nat) (x: Text) (0 e: Is (Nat.lth i (Text.lenLines x))) 121 | : Nat 122 | = #Text.line_start_char i x 123 | 124 | def Text.lineStartByte (idx: Nat) (txt: Text): Maybe Nat = 125 | (case (Nat.lth idx (Text.lenLines txt))) (λ _ => Maybe Nat) 126 | (Maybe.Some Nat (#Text.line_start_byte idx txt)) 127 | (Maybe.None Nat) 128 | 129 | def Text.lineStartByteSafe 130 | (i: Nat) (x: Text) (0 e: Is (Nat.lth i (Text.lenLines x))) 131 | : Nat 132 | = #Text.line_start_byte i x 133 | -------------------------------------------------------------------------------- /i32.ya: -------------------------------------------------------------------------------- 1 | package i32 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def I32: Type = #I32 10 | 11 | def I32.MAX: I32 = #I32.max 12 | def I32.MIN: I32 = #I32.min 13 | 14 | def I32.abs: ∀ (x: I32) -> #U32 = #I32.abs 15 | def I32.sgn: ∀ (x: I32) -> Bool = #I32.sgn 16 | 17 | def I32.eql: ∀ (x y: I32) -> Bool = #I32.eql 18 | def I32.lte: ∀ (x y: I32) -> Bool = #I32.lte 19 | def I32.lth: ∀ (x y: I32) -> Bool = #I32.lth 20 | def I32.gte: ∀ (x y: I32) -> Bool = #I32.gte 21 | def I32.gth: ∀ (x y: I32) -> Bool = #I32.gth 22 | def I32.and: ∀ (x y: I32) -> Bool = #I32.and 23 | def I32.xor: ∀ (x y: I32) -> Bool = #I32.xor 24 | def I32.or: ∀ (x y: I32) -> Bool = #I32.or 25 | def I32.neq (x y: I32): Bool = Bool.not (I32.eql x y) 26 | 27 | def I32.add: ∀ (x y: I32) -> I32 = #I32.add 28 | 29 | def I32.SafeAdd (x y: I32): Bool = 30 | Bool.not 31 | (Bool.and 32 | (Bool.eql (I32.sgn x) (I32.sgn y)) 33 | (Bool.neq (I32.sgn x) (I32.sgn (#I32.add x y))) 34 | ) 35 | 36 | def I32.addSafe (x y: I32) (0 e: Is (I32.SafeAdd x y)): I32 = #I32.add x y 37 | 38 | def I32.sub: ∀ (x y: I32) -> I32 = #I32.sub 39 | 40 | def I32.SafeSub (x y: I32): Bool = 41 | Bool.not 42 | (Bool.and 43 | (Bool.eql (I32.sgn x) (Bool.not (I32.sgn y))) 44 | (Bool.neq (I32.sgn x) (I32.sgn (#I32.sub x y))) 45 | ) 46 | 47 | def I32.subSafe (x y: I32) (0 e: Is (I32.lte y x)): I32 = #I32.sub x y 48 | 49 | def I32.mul: ∀ (x y: I32) -> I32 = #I32.mul 50 | 51 | def I32.SafeMul (x y: I32): Bool = 52 | Bool.or (I32.eql x +0i32) 53 | ((case (I32.eql y +0i32)) (λ _ => Bool) 54 | Bool.True 55 | (I32.eql (#I32.div (#I32.mul x y) y) x) 56 | ) 57 | 58 | def I32.mulSafe (x y: I32) (0 e: Is (I32.SafeMul x y)): I32 = #I32.mul x y 59 | 60 | def I32.div (x y: I32): Maybe I32 = 61 | (case (I32.neq y +0i32)) (λ _ => Maybe I32) 62 | (Maybe.Some I32 (#I32.div x y)) 63 | (Maybe.None I32) 64 | 65 | def I32.divSafe (x y: I32) (0 e: Is (I32.neq y +0i32)): I32 = #I32.div x y 66 | 67 | def I32.mod (x y: I32): Maybe I32 = 68 | (case (I32.neq y +0i32)) (λ _ => Maybe I32) 69 | (Maybe.Some I32 (#I32.mod x y)) 70 | (Maybe.None I32) 71 | 72 | def I32.modSafe (x y: I32) (0 e: Is (I32.neq y +0i8)): I32 = #I32.mod x y 73 | 74 | def I32.pow: ∀ (x: I32) (y: U32) -> I32 = #I32.pow 75 | def I32.shl: ∀ (x: U32) (y: I32) -> I32 = #I32.shl 76 | def I32.shr: ∀ (x: U32) (y: I32) -> I32 = #I32.shr 77 | def I32.rol: ∀ (x: U32) (y: I32) -> I32 = #I32.rol 78 | def I32.ror: ∀ (x: U32) (y: I32) -> I32 = #I32.ror 79 | 80 | def I32.countZeros: ∀ (x: I32) -> U32 = #I32.count_zeros 81 | def I32.countOnes: ∀ (x: I32) -> U32 = #I32.count_ones 82 | 83 | def I32.SafeToU8 (x: I32): Bool = Bool.and (I32.sgn x) (I32.lte x (#U8.to_I32 #U8.max)) 84 | 85 | def I32.toU8 (x: I32): Maybe #U8 = 86 | (case (I32.SafeToU8 x)) (λ _ => Maybe #U8) 87 | (Maybe.Some #U8 (#I32.to_U8 x)) 88 | (Maybe.None #U8) 89 | 90 | def I32.toU8Safe (x: I32) (0 e: Is (I32.SafeToU8 x)): #U8 = #I32.to_U8 x 91 | 92 | def I32.SafeToU16 (x: I32): Bool = Bool.and (I32.sgn x) (I32.lte x (#U16.to_I32 #U16.max)) 93 | 94 | def I32.toU16 (x: I32): Maybe #U16 = 95 | (case (I32.SafeToU16 x)) (λ _ => Maybe #U16) 96 | (Maybe.Some #U16 (#I32.to_U16 x)) 97 | (Maybe.None #U16) 98 | 99 | def I32.toU16Safe (x: I32) (0 e: Is (I32.SafeToU16 x)): #U16 = #I32.to_U16 x 100 | 101 | 102 | def I32.toU32 (x: I32): Maybe #U32 = 103 | (case (I32.sgn x)) (λ _ => Maybe #U32) 104 | (Maybe.Some #U32 (#I32.to_U32 x)) 105 | (Maybe.None #U32) 106 | 107 | def I32.toU32Safe (x: I32) (0 e: Is (I32.sgn x)): #U32 = #I32.to_U32 x 108 | 109 | def I32.toU64 (x: I32): Maybe #U64 = 110 | (case (I32.sgn x)) (λ _ => Maybe #U64) 111 | (Maybe.Some #U64 (#I32.to_U64 x)) 112 | (Maybe.None #U64) 113 | 114 | def I32.toU64Safe (x: I32) (0 e: Is (I32.sgn x)): #U64 = #I32.to_U64 x 115 | 116 | def I32.toNat (x: I32): Maybe #Nat = 117 | (case (I32.sgn x)) (λ _ => Maybe #Nat) 118 | (Maybe.Some #Nat (#I32.to_Nat x)) 119 | (Maybe.None #Nat) 120 | 121 | def I32.toNatSafe (x: I32) (0 e: Is (I32.sgn x)): #Nat = #I32.to_Nat x 122 | 123 | def I32.SafeToI8 (x: I32): Bool = 124 | Bool.or (I32.gte x (#I8.to_I32 #I8.min)) (I32.lte x (#I8.to_I32 #I8.max)) 125 | 126 | def I32.toI8 (x: I32): Maybe #I8 = 127 | (case (I32.SafeToI8 x)) (λ _ => Maybe #I8) 128 | (Maybe.Some #I8 (#I32.to_I8 x)) 129 | (Maybe.None #I8) 130 | 131 | def I32.toI8Safe (x: I32) (0 e: Is (I32.SafeToI8 x)): #I8 = #I32.to_I8 x 132 | 133 | def I32.SafeToI16 (x: I32): Bool = 134 | Bool.or (I32.gte x (#I16.to_I32 #I16.min)) (I32.lte x (#I16.to_I32 #I16.max)) 135 | 136 | def I32.toI16 (x: I32): Maybe #I16 = 137 | (case (I32.SafeToI16 x)) (λ _ => Maybe #I16) 138 | (Maybe.Some #I16 (#I32.to_I16 x)) 139 | (Maybe.None #I16) 140 | 141 | def I32.toI16Safe (x: I32) (0 e: Is (I32.SafeToI16 x)): #I16 = #I32.to_I16 x 142 | 143 | def I32.toI64: ∀ (x: I32) -> #I64 = #I32.to_I64 144 | def I32.toInt: ∀ (x: I32) -> #Int = #I32.to_Int 145 | -------------------------------------------------------------------------------- /i64.ya: -------------------------------------------------------------------------------- 1 | package i64 2 | import bool 3 | import is 4 | import pair 5 | import maybe 6 | import u32 7 | where 8 | 9 | def I64: Type = #I64 10 | 11 | def I64.MAX: I64 = #I64.max 12 | def I64.MIN: I64 = #I64.min 13 | 14 | def I64.abs: ∀ (x: I64) -> #U64 = #I64.abs 15 | def I64.sgn: ∀ (x: I64) -> Bool = #I64.sgn 16 | 17 | def I64.eql: ∀ (x y: I64) -> Bool = #I64.eql 18 | def I64.lte: ∀ (x y: I64) -> Bool = #I64.lte 19 | def I64.lth: ∀ (x y: I64) -> Bool = #I64.lth 20 | def I64.gte: ∀ (x y: I64) -> Bool = #I64.gte 21 | def I64.gth: ∀ (x y: I64) -> Bool = #I64.gth 22 | def I64.and: ∀ (x y: I64) -> Bool = #I64.and 23 | def I64.xor: ∀ (x y: I64) -> Bool = #I64.xor 24 | def I64.or: ∀ (x y: I64) -> Bool = #I64.or 25 | def I64.neq (x y: I64): Bool = Bool.not (I64.eql x y) 26 | 27 | def I64.add: ∀ (x y: I64) -> I64 = #I64.add 28 | 29 | def I64.SafeAdd (x y: I64): Bool = 30 | Bool.not 31 | (Bool.and 32 | (Bool.eql (I64.sgn x) (I64.sgn y)) 33 | (Bool.neq (I64.sgn x) (I64.sgn (#I64.add x y))) 34 | ) 35 | 36 | def I64.addSafe (x y: I64) (0 e: Is (I64.SafeAdd x y)): I64 = #I64.add x y 37 | 38 | def I64.sub: ∀ (x y: I64) -> I64 = #I64.sub 39 | 40 | def I64.SafeSub (x y: I64): Bool = 41 | Bool.not 42 | (Bool.and 43 | (Bool.eql (I64.sgn x) (Bool.not (I64.sgn y))) 44 | (Bool.neq (I64.sgn x) (I64.sgn (#I64.sub x y))) 45 | ) 46 | 47 | def I64.subSafe (x y: I64) (0 e: Is (I64.lte y x)): I64 = #I64.sub x y 48 | 49 | def I64.mul: ∀ (x y: I64) -> I64 = #I64.mul 50 | 51 | def I64.SafeMul (x y: I64): Bool = 52 | Bool.or (I64.eql x +0i64) 53 | ((case (I64.eql y +0i64)) (λ _ => Bool) 54 | Bool.True 55 | (I64.eql (#I64.div (#I64.mul x y) y) x) 56 | ) 57 | 58 | def I64.mulSafe (x y: I64) (0 e: Is (I64.SafeMul x y)): I64 = #I64.mul x y 59 | 60 | def I64.div (x y: I64): Maybe I64 = 61 | (case (I64.neq y +0i64)) (λ _ => Maybe I64) 62 | (Maybe.Some I64 (#I64.div x y)) 63 | (Maybe.None I64) 64 | 65 | def I64.divSafe (x y: I64) (0 e: Is (I64.neq y +0i64)): I64 = #I64.div x y 66 | 67 | def I64.mod (x y: I64): Maybe I64 = 68 | (case (I64.neq y +0i64)) (λ _ => Maybe I64) 69 | (Maybe.Some I64 (#I64.mod x y)) 70 | (Maybe.None I64) 71 | 72 | def I64.modSafe (x y: I64) (0 e: Is (I64.neq y +0i8)): I64 = #I64.mod x y 73 | 74 | def I64.pow: ∀ (x: I64) (y: U32) -> I64 = #I64.pow 75 | def I64.shl: ∀ (x: U32) (y: I64) -> I64 = #I64.shl 76 | def I64.shr: ∀ (x: U32) (y: I64) -> I64 = #I64.shr 77 | def I64.rol: ∀ (x: U32) (y: I64) -> I64 = #I64.rol 78 | def I64.ror: ∀ (x: U32) (y: I64) -> I64 = #I64.ror 79 | 80 | def I64.countZeros: ∀ (x: I64) -> U32 = #I64.count_zeros 81 | def I64.countOnes: ∀ (x: I64) -> U32 = #I64.count_ones 82 | 83 | def I64.SafeToU8 (x: I64): Bool = Bool.and (I64.sgn x) (I64.lte x (#U8.to_I64 #U8.max)) 84 | 85 | def I64.toU8 (x: I64): Maybe #U8 = 86 | (case (I64.SafeToU8 x)) (λ _ => Maybe #U8) 87 | (Maybe.Some #U8 (#I64.to_U8 x)) 88 | (Maybe.None #U8) 89 | 90 | def I64.toU8Safe (x: I64) (0 e: Is (I64.SafeToU8 x)): #U8 = #I64.to_U8 x 91 | 92 | def I64.SafeToU16 (x: I64): Bool 93 | = Bool.and (I64.sgn x) (I64.lte x (#U16.to_I64 #U16.max)) 94 | 95 | def I64.toU16 (x: I64): Maybe #U16 = 96 | (case (I64.SafeToU16 x)) (λ _ => Maybe #U16) 97 | (Maybe.Some #U16 (#I64.to_U16 x)) 98 | (Maybe.None #U16) 99 | 100 | def I64.toU16Safe (x: I64) (0 e: Is (I64.SafeToU16 x)): #U16 = #I64.to_U16 x 101 | 102 | 103 | def I64.toU32 (x: I64): Maybe #U32 = 104 | (case (I64.sgn x)) (λ _ => Maybe #U32) 105 | (Maybe.Some #U32 (#I64.to_U32 x)) 106 | (Maybe.None #U32) 107 | 108 | def I64.toU32Safe (x: I64) (0 e: Is (I64.sgn x)): #U32 = #I64.to_U32 x 109 | 110 | def I64.toU64 (x: I64): Maybe #U64 = 111 | (case (I64.sgn x)) (λ _ => Maybe #U64) 112 | (Maybe.Some #U64 (#I64.to_U64 x)) 113 | (Maybe.None #U64) 114 | 115 | def I64.toU64Safe (x: I64) (0 e: Is (I64.sgn x)): #U64 = #I64.to_U64 x 116 | 117 | def I64.toNat (x: I64): Maybe #Nat = 118 | (case (I64.sgn x)) (λ _ => Maybe #Nat) 119 | (Maybe.Some #Nat (#I64.to_Nat x)) 120 | (Maybe.None #Nat) 121 | 122 | def I64.toNatSafe (x: I64) (0 e: Is (I64.sgn x)): #Nat = #I64.to_Nat x 123 | 124 | def I64.SafeToI8 (x: I64): Bool = 125 | Bool.or (I64.gte x (#I8.to_I64 #I8.min)) (I64.lte x (#I8.to_I64 #I8.max)) 126 | 127 | def I64.toI8 (x: I64): Maybe #I8 = 128 | (case (I64.SafeToI8 x)) (λ _ => Maybe #I8) 129 | (Maybe.Some #I8 (#I64.to_I8 x)) 130 | (Maybe.None #I8) 131 | 132 | def I64.toI8Safe (x: I64) (0 e: Is (I64.SafeToI8 x)): #I8 = #I64.to_I8 x 133 | 134 | def I64.SafeToI16 (x: I64): Bool = 135 | Bool.or (I64.gte x (#I16.to_I64 #I16.min)) (I64.lte x (#I16.to_I64 #I16.max)) 136 | 137 | def I64.toI16 (x: I64): Maybe #I16 = 138 | (case (I64.SafeToI16 x)) (λ _ => Maybe #I16) 139 | (Maybe.Some #I16 (#I64.to_I16 x)) 140 | (Maybe.None #I16) 141 | 142 | def I64.toI16Safe (x: I64) (0 e: Is (I64.SafeToI16 x)): #I16 = #I64.to_I16 x 143 | 144 | def I64.SafeToI32 (x: I64): Bool = 145 | Bool.or (I64.gte x (#I32.to_I64 #I32.min)) (I64.lte x (#I32.to_I64 #I32.max)) 146 | 147 | def I64.toI32 (x: I64): Maybe #I32 = 148 | (case (I64.SafeToI32 x)) (λ _ => Maybe #I32) 149 | (Maybe.Some #I32 (#I64.to_I32 x)) 150 | (Maybe.None #I32) 151 | 152 | def I64.toI32Safe (x: I64) (0 e: Is (I64.SafeToI32 x)): #I32 = #I64.to_I32 x 153 | 154 | def I64.toInt: ∀ (x: I64) -> #Int = #I64.to_Int 155 | -------------------------------------------------------------------------------- /show.ya: -------------------------------------------------------------------------------- 1 | package show 2 | import text 3 | where 4 | 5 | type Show (A: Type) { 6 | New (show: ∀ A -> Text) 7 | } 8 | 9 | //def show (0 A: Type) (impl: Show A) (x: A): #Text 10 | // = (case impl) (λ _ => #Text) 11 | // (λ show_a => show_a x) 12 | 13 | //def stringShow: Show #Text 14 | // = newShow #Text (λ s => #cat "\"" (#cat s "\"")) 15 | // 16 | //def base64 : List #Char = 17 | // (List.cons #Char '0' (List.cons #Char '1' (List.cons #Char '2' (List.cons #Char '3' (List.cons #Char '4' (List.cons #Char '5' 18 | // (List.cons #Char '6' (List.cons #Char '7' (List.cons #Char '8' (List.cons #Char '9' (List.cons #Char 'A' (List.cons #Char 'B' 19 | // (List.cons #Char 'C' (List.cons #Char 'D' (List.cons #Char 'E' (List.cons #Char 'F' (List.cons #Char 'G' (List.cons #Char 'H' 20 | // (List.cons #Char 'I' (List.cons #Char 'J' (List.cons #Char 'K' (List.cons #Char 'L' (List.cons #Char 'M' (List.cons #Char 'N' 21 | // (List.nil #Char))))))))))))))))))))))))) 22 | // 23 | // (List.cons #Char 'O' (List.cons #Char 'P' (List.cons #Char 'Q' (List.cons #Char 'R' (List.cons #Char 'S' (List.cons #Char 'T' 24 | // (List.cons #Char 'U' (List.cons #Char 'V' (List.cons #Char 'W' (List.cons #Char 'X' (List.cons #Char 'Y' (List.cons #Char 'Z' 25 | // (List.cons #Char 'a' (List.cons #Char 'b' (List.cons #Char 'c' (List.cons #Char 'd' (List.cons #Char 'e' (List.cons #Char 'f' 26 | // (List.cons #Char 'g' (List.cons #Char 'h' (List.cons #Char 'i' (List.cons #Char 'j' (List.cons #Char 'k' (List.cons #Char 'l' 27 | // (List.cons #Char 'm' (List.cons #Char 'n' (List.cons #Char 'o' (List.cons #Char 'p' (List.cons #Char 'q' (List.cons #Char 'r' 28 | // (List.cons #Char 's' (List.cons #Char 't' (List.cons #Char 'u' (List.cons #Char 'v' (List.cons #Char 'w' (List.cons #Char 'x' 29 | // (List.cons #Char 'y' (List.cons #Char 'z' (List.cons #Char '+' (List.cons #Char '/' (List.nil #Char)))) 30 | // ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 31 | // 32 | // 33 | //def showDigit (base n : Nat): #Text 34 | // = 35 | // let m : Nat = mod n base; 36 | // #Text.cons 37 | // (if #Char 38 | // (and (gtn base (from_natural 0)) (lte base (from_natural 64))) 39 | // (Maybe.default #Char (List.at #Char base64 m) '#') 40 | // '#' 41 | // ) 42 | // "" 43 | // 44 | //def toBase (base : Nat) (n : Nat): List Nat 45 | // = letrec fun : (forall Nat Nat (List Nat) -> List Nat) = 46 | // (λ base n list => (case (divMod n base)) (λ _ => List Nat) 47 | // (λ div mod => 48 | // let l : List Nat = List.cons Nat mod list; 49 | // (case div) (λ _ => List Nat) 50 | // l 51 | // (λ _ => fun base div l) 52 | // ) 53 | // ); 54 | // fun base n (List.nil Nat) 55 | // 56 | //def toStringOfBase (base : Nat) (n : Nat): #Text 57 | // = let digits : List Nat = toBase base n; 58 | // List.foldr Nat #Text (λ digit str => #Text.concat str (showDigit (from_natural 10) digit)) "" digits 59 | // 60 | //def natShow: Show Nat 61 | // = newShow Nat (toStringOfBase (from_natural 10)) 62 | // 63 | // 64 | //def deriveMaybeShow (A : Type) (impl : Show A): Show (Maybe A) 65 | // = newShow (Maybe A) 66 | // (λ m => 67 | // (case m) (λ _ => #Text) 68 | // "none" 69 | // (λ a => #Text.concat "just " (show A impl a)) 70 | // ) 71 | // 72 | //def deriveListShow (A : Type) (impl : Show A): Show (List A) 73 | // = let subShow : forall A #Text -> #Text = (λ a str => 74 | // #Text.concat str (#Text.concat ", " (show A impl a)) 75 | // ); 76 | // newShow (List A) 77 | // (λ list => 78 | // #Text.concat "List [" 79 | // (#Text.concat ((case list) (λ _ => #Text) 80 | // "" 81 | // (λ head tail => List.foldr A #Text subShow (show A impl head) list) 82 | // ) 83 | // "]") 84 | // ) 85 | // 86 | //def derivePairShow (A B : Type) (implA : Show A) (implB : Show B): Show (Pair A B) 87 | // = newShow (Pair A B) 88 | // (λ p => 89 | // (case p) (λ _ => #Text) 90 | // (λ a b => #Text.concat "(" 91 | // (#Text.concat (show A implA a) 92 | // (#Text.concat ", " (#Text.concat (show B implB b) ")"))) 93 | // ) 94 | // ) 95 | // 96 | //def deriveMapShow (K V : Type) (ord : Ordered K) (implK : Show K) (implV : Show V): Show (Map K V ord) 97 | // = 98 | // letrec pairShow : ∀ (Pair K V) -> #Text = (λ p => 99 | // #Text.concat (show K implK (Pair.fst K V p)) 100 | // (#Text.concat " => " (show V implV (Pair.snd K V p))) 101 | // ); 102 | // letrec subShow : ∀ (Pair K V) #Text -> #Text = (λ p str => 103 | // #Text.concat str (#Text.concat ", " (pairShow p)) 104 | // ); 105 | // newShow (Map K V ord) 106 | // (λ m => 107 | // let list : List (Pair K V) = Map.toList K V ord m; 108 | // #Text.concat "Map {" 109 | // (#Text.concat ((case list) (λ _ => #Text) 110 | // "" 111 | // (λ head tail => List.foldr (Pair K V) #Text subShow (pairShow head) tail) 112 | // ) 113 | // "}") 114 | // ) 115 | // 116 | //def deriveVectorShow (0 A : Type) (size : Nat) (impl : Show A): Show (Vector A size) = 117 | // letrec showIt : ∀ A -> #Text = show A impl; 118 | // let subShow : forall A #Text -> #Text = (λ a str => 119 | // #Text.concat str (#Text.concat ", " (showIt a)) 120 | // ); 121 | // newShow (Vector A size) 122 | // (λ vec => 123 | // #Text.concat "Vector (" 124 | // (#Text.concat (show Nat natShow size) 125 | // (#Text.concat ") [" 126 | // (#Text.concat ((case vec) (λ _ _ => #Text) 127 | // "" 128 | // (λ size head tail => Vector.foldr A #Text size subShow (showIt head) tail)) 129 | // "]"))) 130 | // ) 131 | -------------------------------------------------------------------------------- /dict.ya: -------------------------------------------------------------------------------- 1 | package dict 2 | import pair 3 | import ord 4 | import nat 5 | import list 6 | import maybe 7 | import bool 8 | import text 9 | where 10 | 11 | type Dict (V: Type) { 12 | Tip, 13 | Bin (size: Nat) (key: Text) (val: V) (left: Dict V) (right: Dict V), 14 | } 15 | 16 | def Dict.empty (0 V: Type) : Dict V 17 | = Dict.Tip V 18 | 19 | def Dict.single (0 V: Type) (k: Text) (v: V): Dict V 20 | = Dict.Bin V 1 k v (Dict.Tip V) (Dict.Tip V) 21 | 22 | def Dict.null (0 V: Type) (m: Dict V) : Bool 23 | = (case m) (λ _ => Bool) (Bool.True) (λ _ _ _ _ _ => Bool.False) 24 | 25 | def Dict.size (0 V: Type) (m: Dict V) : Nat 26 | = (case m) (λ _ => Nat) 0 (λ size _ _ _ _ => size) 27 | 28 | def Dict.lookup (0 V: Type) (key: Text) (m: Dict V): Maybe V 29 | = 30 | letrec go (k: Text) (m: Dict V): Maybe V = (case m) (λ _ => Maybe V) 31 | (Maybe.None V) 32 | (λ _ kx x l r => (case (Text.compare k kx)) (λ _ => Maybe V) 33 | (go k l) 34 | (Maybe.Some V x) 35 | (go k r) 36 | ); 37 | go key m 38 | 39 | def Dict.lookupAssoc (0 V: Type) (key: Text) (m: Dict V): Maybe (Pair Text V) 40 | = 41 | letrec go (k: Text) (m: Dict V): Maybe (Pair Text V) = (case m) (λ _ => Maybe (Pair Text V)) 42 | (Maybe.None (Pair Text V)) 43 | (λ _ kx x l r => (case (Text.compare k kx)) (λ _ => Maybe (Pair Text V)) 44 | (go k l) 45 | (Maybe.Some (Pair Text V) (Pair.New Text V k x)) 46 | (go k r) 47 | ); 48 | go key m 49 | 50 | def Dict.member (0 V: Type) (key: Text) (m: Dict V): Bool 51 | = 52 | letrec go (k: Text) (m: Dict V): Bool = (case m) (λ _ => Bool) 53 | (Bool.False) 54 | (λ _ kx _ l r => (case (Text.compare k kx)) (λ _ => Bool) 55 | (go k l) 56 | (Bool.True) 57 | (go k r) 58 | ); 59 | go key m 60 | 61 | def Dict.notMember (0 V: Type) (key: Text) (m: Dict V): Bool 62 | = Bool.not (Dict.member V key m) 63 | 64 | def Dict.find (0 V: Type) (default: V) (key: Text) (m: Dict V): V 65 | = Maybe.default V (default) (Dict.lookup V key m) 66 | 67 | def Dict.bin (0 V: Type) (k: Text) (v: V) (left right: Dict V): Dict V 68 | = Dict.Bin V (Nat.S (Nat.add (Dict.size V left) (Dict.size V right))) k v left right 69 | 70 | def Dict.rotateLeft (V: Type) (k: Text) (v: V) (left right: Dict V): Dict V = 71 | (case right) (λ _ => Dict V) 72 | (Dict.empty V) 73 | (λ _ _ _ ly ry => Bool.if (Dict V) (Nat.lth (Dict.size V ly) (Nat.mul 2 (Dict.size V ry))) 74 | ((case right) (λ _ => Dict V) 75 | (Dict.empty V) 76 | (λ _ k2 v2 left2 right2 => Dict.bin V k2 v2 (Dict.bin V k v left left2) right2) 77 | ) 78 | ((case right) (λ _ => Dict V) 79 | (Dict.empty V) 80 | (λ _ k2 v2 left2 right2 => (case left2) (λ _ => Dict V) 81 | (Dict.empty V) 82 | (λ _ k3 v3 left3 right3 => Dict.bin V k3 v3 (Dict.bin V k v left left3) (Dict.bin V k2 v2 right3 right2)) 83 | ) 84 | ) 85 | ) 86 | 87 | def Dict.rotateRight (V: Type) (k: Text) (v: V) (left right: Dict V): Dict V = 88 | (case left) (λ _ => Dict V) 89 | (Dict.empty V) 90 | (λ _ _ _ ly ry => Bool.if (Dict V) (Nat.lth (Dict.size V ry) (Nat.mul 2 (Dict.size V ly))) 91 | ((case left) (λ _ => Dict V) 92 | (Dict.empty V) 93 | (λ _ k2 v2 left2 right2 => Dict.bin V k2 v2 left2 (Dict.bin V k v left2 right2))) 94 | ((case left) (λ _ => Dict V) 95 | (Dict.empty V) 96 | (λ _ k2 v2 left2 right2 => (case right2) (λ _ => Dict V) 97 | (Dict.empty V) 98 | (λ _ k3 v3 left3 right3 => Dict.bin V k3 v3 (Dict.bin V k2 v2 left2 left3) (Dict.bin V k v right3 right)) 99 | ) 100 | ) 101 | ) 102 | 103 | def Dict.balance (V: Type) (k: Text) (v: V) (left right: Dict V): Dict V 104 | = let leftSize: Nat = Dict.size V left; 105 | let rightSize: Nat = Dict.size V right; 106 | let xSize: Nat = Nat.S (Nat.add leftSize rightSize); 107 | Bool.if (Dict V) (Nat.lte (Nat.add leftSize rightSize) 1) 108 | (Dict.Bin V xSize k v left right) 109 | (Bool.if (Dict V) (Nat.gte rightSize (Nat.mul 5 leftSize)) 110 | (Dict.rotateLeft V k v left right) 111 | (Bool.if (Dict V) (Nat.gte leftSize (Nat.mul 5 rightSize)) 112 | (Dict.rotateRight V k v left right) 113 | (Dict.Bin V xSize k v left right) 114 | ) 115 | ) 116 | 117 | def Dict.deleteFindMin (V: Type) (m: Dict V): Maybe (Pair (Pair Text V) (Dict V)) 118 | = (case m) (λ _ => Maybe (Pair (Pair Text V) (Dict V))) 119 | (Maybe.None (Pair (Pair Text V) (Dict V))) 120 | (λ _ k v l r => (case l) (λ _ => Maybe (Pair (Pair Text V) (Dict V))) 121 | (Maybe.Some (Pair (Pair Text V) (Dict V)) (Pair.New (Pair Text V) (Dict V) (Pair.New Text V k v) r)) 122 | (λ _ _ _ _ _ => Maybe.map (Pair (Pair Text V) (Dict V)) (Pair (Pair Text V) (Dict V)) 123 | (λ p => 124 | Pair.map (Pair Text V) (Dict V) (Dict V) 125 | (λ newLeft => Dict.balance V k v newLeft r) 126 | p 127 | ) 128 | (Dict.deleteFindMin V l) 129 | )) 130 | 131 | def Dict.deleteFindMax (V: Type) (m: Dict V): Maybe (Pair (Pair Text V) (Dict V)) 132 | = (case m) (λ _ => Maybe (Pair (Pair Text V) (Dict V))) 133 | (Maybe.None (Pair (Pair Text V) (Dict V))) 134 | (λ _ k v l r => (case r) (λ _ => Maybe (Pair (Pair Text V) (Dict V))) 135 | (Maybe.Some (Pair (Pair Text V) (Dict V))(Pair.New (Pair Text V) (Dict V) (Pair.New Text V k v) l)) 136 | (λ _ _ _ _ _ => Maybe.map (Pair (Pair Text V) (Dict V)) (Pair (Pair Text V) (Dict V)) 137 | (λ p => 138 | Pair.map (Pair Text V) (Dict V) (Dict V) 139 | (λ newRight => Dict.balance V k v l newRight) 140 | p 141 | ) 142 | (Dict.deleteFindMax V l) 143 | )) 144 | 145 | def Dict.glue (V: Type) (left right: Dict V): Dict V 146 | = (case left) (λ _ => Dict V) 147 | (right) 148 | (λ _ _ _ _ _ => (case right) (λ _ => Dict V) 149 | (left) 150 | (λ _ _ _ _ _ => (Bool.if (Dict V) (Nat.gth (Dict.size V left) (Dict.size V right)) 151 | ((case (Dict.deleteFindMax V left)) (λ _ => Dict V) 152 | (Dict.empty V) 153 | (λ result => 154 | let keyValue: Pair Text V = Pair.fst (Pair Text V) (Dict V) result; 155 | let newLeft: Dict V = Pair.snd (Pair Text V) (Dict V) result; 156 | let maxKey: Text = Pair.fst Text V keyValue; 157 | let maxValue: V = Pair.snd Text V keyValue; 158 | Dict.balance V maxKey maxValue newLeft right) 159 | ) 160 | ((case (Dict.deleteFindMin V right)) (λ _ => Dict V) 161 | (Dict.empty V) 162 | (λ result => 163 | let keyValue: Pair Text V = Pair.fst (Pair Text V) (Dict V) result; 164 | let newRight: Dict V = Pair.snd (Pair Text V) (Dict V) result; 165 | let minKey: Text = Pair.fst Text V keyValue; 166 | let minValue: V = Pair.snd Text V keyValue; 167 | Dict.balance V minKey minValue left newRight) 168 | ) 169 | ) 170 | ) 171 | ) 172 | 173 | def Dict.insert (V: Type) (k: Text) (v: V) (m: Dict V): Dict V 174 | = (case m) (λ _ => Dict V) 175 | (Dict.single V k v) 176 | (λ s actK actV left right => 177 | (case (Text.compare k actK)) (λ _ => Dict V) 178 | (Dict.balance V actK actV (Dict.insert V k v left) right) 179 | (Dict.Bin V s k v left right) 180 | (Dict.balance V actK actV left (Dict.insert V k v right)) 181 | ) 182 | 183 | def Dict.delete (V: Type) (k: Text) (m: Dict V): Dict V 184 | = (case m) (λ _ => Dict V) 185 | (Dict.Tip V) 186 | (λ s actK actV left right => 187 | (case (Text.compare k actK)) (λ _ => Dict V) 188 | (Dict.balance V actK actV (Dict.delete V k left) right) 189 | (Dict.glue V left right) 190 | (Dict.balance V actK actV left (Dict.delete V k right)) 191 | ) 192 | -------------------------------------------------------------------------------- /parsec.ya: -------------------------------------------------------------------------------- 1 | // This package is an adaptation of the Haskell Megaparsec library found at 2 | // https://hackage.haskell.org/package/megaparsec 3 | package parsec 4 | import unit 5 | import bool 6 | import list 7 | import maybe 8 | import char 9 | import text 10 | import nat 11 | import either 12 | import parsec.error 13 | import parsec.state 14 | import parsec.reply 15 | where 16 | 17 | // A parser is a continuation: 18 | // For custom State type S, custom Error type E, and return type A, 19 | // For all possible continuation types B (i.e. all possible parser compositions) 20 | // We take a Parsec.State with custom state and errors 21 | // and run one of four possible continuation functions on it 22 | // - (eok) processes a state and a value when no input was consumed 23 | // - (eer) processes a state and an error when no input was consumed 24 | // - (cok) processes a state and a value when input was consumed 25 | // - (cer) processes a state and an error when input was consumed 26 | def Parsec (S E A: Type): Type = 27 | ∀ (B: Type) 28 | (state: State S E) 29 | (∀ (State S E) A -> B) 30 | (∀ (State S E) (Error E) -> B) 31 | (∀ (State S E) A -> B) 32 | (∀ (State S E) (Error E) -> B) 33 | -> B 34 | 35 | def Parsec.run (S E A: Type) (parser: Parsec S E A) (state: State S E): Reply S E A 36 | = parser (Reply S E A) state 37 | (Reply.EOK S E A) 38 | (Reply.EER S E A) 39 | (Reply.COK S E A) 40 | (Reply.CER S E A) 41 | 42 | def Parsec.parse (S E A: Type) (parser: Parsec S E A) (state: State S E) 43 | : Either (Error E) A 44 | = Reply.toEither S E A (Parsec.run S E A parser state) 45 | 46 | def Parsec.Parsed (S E A: Type) (reply: Reply S E A): Type = 47 | (case reply) (λ _ => Type) 48 | (λ _ _ => A) 49 | (λ _ _ => Error E) 50 | (λ _ _ => A) 51 | (λ _ _ => Error E) 52 | 53 | def Parsec.parsed (S E A: Type) (parser: Parsec S E A) (state: State S E) 54 | : Parsec.Parsed S E A (Parsec.run S E A parser state) 55 | = (case (Parsec.run S E A parser state)) (λ reply => Parsec.Parsed S E A reply) 56 | (λ _ x => x) 57 | (λ _ e => e) 58 | (λ _ x => x) 59 | (λ _ e => e) 60 | 61 | def Parsec.pure (S E A: Type) (a: A): Parsec S E A = λ _ s eok _ _ _ => eok s a 62 | 63 | def Parsec.map (S E A B: Type) (f: ∀ A -> B) (p: Parsec S E A): Parsec S E B = 64 | λ B s1 eok eer cok cer => p B s1 65 | (λ s2 a => eok s2 (f a)) 66 | eer 67 | (λ s2 a => cok s2 (f a)) 68 | cer 69 | 70 | def Parsec.bind (S E A B: Type) (p: Parsec S E A) (f: ∀ A -> Parsec S E B) 71 | : Parsec S E B 72 | = λ B s1 eok eer cok cer => p B s1 73 | (λ s2 a => f a B s2 (λ s3 b => eok s3 b) eer (λ s3 b => cok s3 b) cer) 74 | eer 75 | (λ s2 a => f a B s2 (λ s3 b => cok s3 b) cer (λ s3 b => cok s3 b) cer) 76 | cer 77 | 78 | def Parsec.ap (S E A B: Type) (pf: Parsec S E (∀ A -> B)) (pa: Parsec S E A) 79 | : Parsec S E B 80 | = λ B s1 eok eer cok cer => pf B s1 81 | (λ s2 f => pa B s2 (λ s3 a => eok s3 (f a)) eer (λ s3 a => cok s3 (f a)) cer) 82 | eer 83 | (λ s2 f => pa B s2 (λ s3 a => cok s3 (f a)) cer (λ s3 a => cok s3 (f a)) cer) 84 | cer 85 | 86 | def Parsec.state (S E: Type): Parsec S E (State S E) = 87 | λ B s1 eok eer cok cer => eok s1 s1 88 | 89 | def Parsec.token (S E A: Type) (f: ∀ Char -> Maybe A) (exps: List Item): Parsec S E A 90 | = λ B s1 eok eer cok cer => 91 | (case s1) (λ _ => B) (λ pos txt err ste => 92 | (case txt) (λ _ => B) 93 | (eer s1 (Error.Trivial E pos (Maybe.Some Item Item.Eof) exps)) 94 | (λ c cs => (case (f c)) (λ _ => B) 95 | (eer s1 96 | (Error.Trivial E pos 97 | (Maybe.Some Item (Item.Tokens (Text.single c))) 98 | exps 99 | ) 100 | ) 101 | (λ x => cok (State.New S E (Nat.S pos) cs err ste) x) 102 | ) 103 | ) 104 | 105 | def Parsec.char (S E: Type) (c: Char): Parsec S E Char = 106 | Parsec.token S E Char 107 | (λ x => (case (Char.eql x c)) (λ _ => Maybe Char) 108 | (Maybe.Some Char c) 109 | (Maybe.None Char) 110 | ) 111 | (List.single Item (Item.Tokens (Text.single c))) 112 | 113 | def Parsec.anyChar (S E: Type): Parsec S E Char = 114 | Parsec.token S E Char (Maybe.Some Char) (List.single Item (Item.Label "any char")) 115 | 116 | def Parsec.zero (S E A: Type): Parsec S E A = λ B s1 eok eer cok cer => 117 | (case s1) (λ _ => B) (λ pos _ _ _ => 118 | eer s1 (Error.Trivial E pos (Maybe.None Item) (List.Nil Item)) 119 | ) 120 | 121 | def Parsec.plus (S E A: Type) (x y: Parsec S E A): Parsec S E A = 122 | λ B s1 eok eer cok cer => x B s1 123 | eok 124 | (λ s2 xe => y B s1 125 | eok 126 | (λ s3 ye => eer (State.longestMatch S E s2 s3) (Error.merge E xe ye)) 127 | cok 128 | (λ s3 ye => cer (State.longestMatch S E s2 s3) (Error.merge E xe ye)) 129 | ) 130 | cok 131 | cer 132 | 133 | def Parsec.choice (S E A: Type) (ps: List (Parsec S E A)): Parsec S E A = 134 | (case ps) (λ _ => Parsec S E A) 135 | (Parsec.zero S E A) 136 | (λ p ps => Parsec.plus S E A p (Parsec.choice S E A ps)) 137 | 138 | def Parsec.eof (S E: Type): Parsec S E Unit = λ B s1 eok eer cok cer => 139 | (case s1) (λ _ => B) (λ pos input err ste => 140 | (case input) (λ _ => B) 141 | (eok s1 Unit.New) 142 | (λ c cs => eer s1 (Error.Trivial E pos 143 | (Maybe.Some Item (Item.Tokens (Text.single c))) 144 | (List.single Item Item.Eof) 145 | ) 146 | ) 147 | ) 148 | 149 | def Parsec.fail (S E A: Type) (msg: Text): Parsec S E A = λ B s1 eok eer cok cer => 150 | (case s1) (λ _ => B) (λ pos txt errs ste => 151 | eer s1 (Error.Fancy E pos (List.single (Fancy E) (Fancy.Fail E msg))) 152 | ) 153 | 154 | def Parsec.try (S E A: Type) (p: Parsec S E A): Parsec S E A = 155 | λ B s1 eok eer cok cer => p B s1 156 | eok (λ s2 e => eer s1 e) cok (λ s2 e => eer s1 e) 157 | 158 | def Parsec.label (S E A: Type) (msg: Text) (p: Parsec S E A): Parsec S E A = 159 | λ B s1 eok eer cok cer => p B s1 160 | eok 161 | (λ s2 e => (case e) (λ _ => B) 162 | (λ pos unx exp => eer s2 163 | (Error.Trivial E pos unx (List.single Item (Item.Label msg))) 164 | ) 165 | (λ _ _ => eer s2 e) 166 | ) 167 | cok 168 | cer 169 | 170 | def Parsec.make (S E A: Type) (f: ∀ (State S E) -> Reply S E A): Parsec S E A = 171 | λ B s1 eok eer cok cer => (case (f s1)) (λ _ => B) eok eer cok cer 172 | 173 | def Parsec.optional (S E A: Type) (p: Parsec S E A): Parsec S E (Maybe A) = 174 | Parsec.plus S E (Maybe A) 175 | (Parsec.map S E A (Maybe A) (Maybe.Some A) p) 176 | (Parsec.pure S E (Maybe A) (Maybe.None A)) 177 | 178 | def Parsec.many (S E A: Type) (p: Parsec S E A): Parsec S E (List A) = 179 | Parsec.bind S E (Maybe A) (List A) 180 | (Parsec.optional S E A p) 181 | (λ x => (case x) (λ _ => Parsec S E (List A)) 182 | (Parsec.pure S E (List A) (List.Nil A)) 183 | (λ a => Parsec.map S E (List A) (List A) (List.Cons A a) 184 | (Parsec.many S E A p)) 185 | ) 186 | 187 | def Parsec.take (S E: Type) (err: Text) (n: Nat): Parsec S E Text = 188 | λ B s1 eok eer cok cer => (case s1) (λ _ => B) (λ pos inp errs ste => 189 | (case (Nat.gth n (Text.lenChars inp))) (λ _ => B) 190 | (eer s1 (Error.Trivial E pos (Maybe.Some Item Item.Eof) 191 | (List.single Item (Item.Label err))) 192 | ) 193 | ((case (Text.split n inp)) (λ _ => B) (λ took rest => 194 | cok (State.New S E (Nat.add n pos) rest errs ste) took 195 | )) 196 | ) 197 | 198 | def Parsec.manyTill (S E A B: Type) (p: Parsec S E A) (end: Parsec S E B) 199 | : Parsec S E (List A) 200 | = Parsec.plus S E (List A) 201 | (Parsec.bind S E B (List A) end (λ _ => Parsec.pure S E (List A) (List.Nil A))) 202 | (Parsec.bind S E A (List A) p (λ x => 203 | (Parsec.bind S E (List A) (List A) (Parsec.manyTill S E A B p end) (λ xs => 204 | (Parsec.pure S E (List A) (List.Cons A x xs)))))) 205 | 206 | def Parsec.observing (S E A: Type) (p: Parsec S E A): Parsec S E (Either (Error E) A) 207 | = λ B s1 eok eer cok cer => p B s1 208 | (λ s2 x => eok s2 (Either.Right (Error E) A x)) 209 | (λ s2 e => eok s2 (Either.Left (Error E) A e)) 210 | (λ s2 x => cok s2 (Either.Right (Error E) A x)) 211 | (λ s2 e => cok s2 (Either.Left (Error E) A e)) 212 | 213 | def Parsec.peek (S E A: Type) (p: Parsec S E A): Parsec S E A = 214 | λ B s1 eok eer cok cer => p B s1 215 | (λ s2 a => eok s1 a) 216 | eer 217 | (λ s2 a => cok s1 a) 218 | cer 219 | 220 | -------------------------------------------------------------------------------- /map.ya: -------------------------------------------------------------------------------- 1 | //package map 2 | // import pair 3 | // import ord 4 | // import nat 5 | // import list 6 | // import maybe 7 | // import bool 8 | //where 9 | // 10 | // type Map (K V: Type) (O: Ord K): Type 11 | // | Tip: Map K V O 12 | // | Bin Nat K V (Map K V ord) (Map K V ord): Map K V O 13 | // 14 | //type Map (K V: Type) (O: Ord K) { 15 | // Tip, 16 | // Bin (size: Nat) (key: K) (val: V) (left: Map K V O) (right: Map K V O), 17 | //} 18 | // 19 | //def Map.empty (0 K V: Type) (O: Ord K): Map K V O 20 | // = Map.Tip K V O 21 | // 22 | //def Map.single (0 K V: Type) (O: Ord K) (k: K) (v: V): Map K V O 23 | // = Map.Bin K V O 1 k v (Map.Tip K V O) (Map.Tip K V O) 24 | // 25 | //def Map.null (0 K V: Type) (O: Ord K) (m: Map K V O) : Bool 26 | // = (case m) (λ _ => Bool) (Bool.True) (λ _ _ _ _ _ => Bool.False) 27 | // 28 | //def Map.size (0 K V: Type) (O: Ord K) (m: Map K V O) : Nat 29 | // = (case m) (λ _ => Nat) 0 (λ size _ _ _ _ => size) 30 | // 31 | //def Map.lookup (0 K V: Type) (O: Ord K) (key: K) (m: Map K V O): Maybe V 32 | // = 33 | // letrec go (k: K) (m: Map K V O): Maybe V = (case m) (λ _ => Maybe V) 34 | // (Maybe.None V) 35 | // (λ _ kx x l r => (case (Ord.compare K O k kx)) (λ _ => Maybe V) 36 | // (go k l) 37 | // (Maybe.Some V x) 38 | // (go k r) 39 | // ); 40 | // go key m 41 | // 42 | //def Map.lookupAssoc (0 K V: Type) (O: Ord K) (key: K) (m: Map K V O): Maybe (Pair K V) 43 | // = 44 | // letrec go (k: K) (m: Map K V O): Maybe (Pair K V) = (case m) (λ _ => Maybe (Pair K V)) 45 | // (Maybe.None (Pair K V)) 46 | // (λ _ kx x l r => (case (Ord.compare K O k kx)) (λ _ => Maybe (Pair K V)) 47 | // (go k l) 48 | // (Maybe.Some (Pair K V) (Pair.New K V k x)) 49 | // (go k r) 50 | // ); 51 | // go key m 52 | // 53 | //def Map.member (0 K V: Type) (O: Ord K) (key: K) (m: Map K V O): Bool 54 | // = 55 | // letrec go (k: K) (m: Map K V O): Bool = (case m) (λ _ => Bool) 56 | // (Bool.False) 57 | // (λ _ kx _ l r => (case (Ord.compare K O k kx)) (λ _ => Bool) 58 | // (go k l) 59 | // (Bool.True) 60 | // (go k r) 61 | // ); 62 | // go key m 63 | // 64 | //def Map.notMember (0 K V: Type) (O: Ord K) (key: K) (m: Map K V O): Bool 65 | // = Bool.not (Map.member K V O key m) 66 | // 67 | //def Map.find (0 K V: Type) (O: Ord K) (default: V) (key: K) (m: Map K V O): V 68 | // = Maybe.default V (default) (Map.lookup K V O key m) 69 | // 70 | //def Map.bin (0 K V: Type) (O: Ord K) (k: K) (v: V) (left right: Map K V O): Map K V O 71 | // = Map.Bin K V O (Nat.S (Nat.add (Map.size K V O left) (Map.size K V O right))) k v left right 72 | // 73 | //def Map.rotateLeft (0 K V: Type) (O: Ord K) (k: K) (v: V) (left right: Map K V O): Map K V O = 74 | // (case right) (λ _ => Map K V O) 75 | // (Map.empty K V O) 76 | // (λ _ _ _ ly ry => Bool.if (Map K V O) (Nat.lth (Map.size K V O ly) (Nat.mul 2 (Map.size K V O ry))) 77 | // ((case right) (λ _ => Map K V O) 78 | // (Map.empty K V O) 79 | // (λ _ k2 v2 left2 right2 => Map.bin K V O k2 v2 (Map.bin K V O k v left left2) right2) 80 | // ) 81 | // ((case right) (λ _ => Map K V O) 82 | // (Map.empty K V O) 83 | // (λ _ k2 v2 left2 right2 => (case left2) (λ _ => Map K V O) 84 | // (Map.empty K V O) 85 | // (λ _ k3 v3 left3 right3 => Map.bin K V O k3 v3 (Map.bin K V O k v left left3) (Map.bin K V O k2 v2 right3 right2)) 86 | // ) 87 | // ) 88 | // ); 89 | // 90 | //def Map.rotateRight (0 K V: Type) (O: Ord K) (k: K) (v: V) (left right: Map K V O): Map K V O = 91 | // (case left) (λ _ => Map K V O) 92 | // (Map.empty K V O) 93 | // (λ _ _ _ ly ry => Bool.if (Map K V O) (Nat.lth (Map.size K V O ry) (Nat.mul 2 (Map.size K V O ly))) 94 | // ((case left) (λ _ => Map K V O) 95 | // (Map.empty K V O) 96 | // (λ _ k2 v2 left2 right2 => Map.bin K V O k2 v2 left2 (Map.bin K V O k v left2 right2))) 97 | // ((case left) (λ _ => Map K V O) 98 | // (Map.empty K V O) 99 | // (λ _ k2 v2 left2 right2 => (case right2) (λ _ => Map K V O) 100 | // (Map.empty K V O) 101 | // (λ _ k3 v3 left3 right3 => Map.bin K V O k3 v3 (Map.bin K V O k2 v2 left2 left3) (Map.bin K V O k v right3 right)) 102 | // ) 103 | // ) 104 | // ) 105 | // 106 | //def Map.balance (0 K V: Type) (O: Ord K) (k: K) (v: V) (left right: Map K V O): Map K V O 107 | // = let leftSize: Nat = Map.size K V O left; 108 | // let rightSize: Nat = Map.size K V O right; 109 | // let xSize: Nat = Nat.S (Nat.add leftSize rightSize); 110 | // Bool.if (Map K V O) (Nat.lte (Nat.add leftSize rightSize) 1) 111 | // (Map.Bin K V O xSize k v left right) 112 | // (Bool.if (Map K V O) (Nat.gte rightSize (Nat.mul 5 leftSize)) 113 | // (Map.rotateLeft K V O k v left right) 114 | // (Bool.if (Map K V O) (Nat.gte leftSize (Nat.mul 5 rightSize)) 115 | // (rotateRight K V O k v left right) 116 | // (Map.Bin K V O xSize k v left right) 117 | // ) 118 | // ) 119 | // 120 | //def Map.deleteFindMin (0 K V: Type) (O: Ord K) (m: Map K V O): Maybe (Pair (Pair K V) (Map K V O)) 121 | // = (case m) (λ _ => Maybe (Pair (Pair K V) (Map K V O))) 122 | // (Maybe.None (Pair (Pair K V) (Map K V O))) 123 | // (λ _ k v l r => (case l) (λ _ => Maybe (Pair (Pair K V) (Map K V O))) 124 | // (Maybe.Some (Pair (Pair K V) (Map K V O)) (Pair.New (Pair K V) (Map K V O) (Pair.New K V k v) r)) 125 | // (λ _ _ _ _ _ => Maybe.map (Pair (Pair K V) (Map K V O)) (Pair (Pair K V) (Map K V O)) 126 | // (λ p => 127 | // Pair.map (Pair K V) (Map K V O) (Map K V O) 128 | // (λ newLeft => Map.balance K V O k v newLeft r) 129 | // p 130 | // ) 131 | // (Map.deleteFindMin K V O l) 132 | // )) 133 | // 134 | //def Map.deleteFindMax (0 K V: Type) (O: Ord K) (m: Map K V O): Maybe (Pair (Pair K V) (Map K V O)) 135 | // = (case m) (λ _ => Maybe (Pair (Pair K V) (Map K V O))) 136 | // (Maybe.None (Pair (Pair K V) (Map K V O))) 137 | // (λ _ k v l r => (case r) (λ _ => Maybe (Pair (Pair K V) (Map K V O))) 138 | // (Maybe.Some (Pair (Pair K V) (Map K V O))(Pair.New (Pair K V) (Map K V O) (Pair.New K V k v) l)) 139 | // (λ _ _ _ _ _ => Maybe.map (Pair (Pair K V) (Map K V O)) (Pair (Pair K V) (Map K V O)) 140 | // (λ p => 141 | // Pair.map (Pair K V) (Map K V O) (Map K V O) 142 | // (λ newRight => Map.balance K V O k v l newRight) 143 | // p 144 | // ) 145 | // (Map.deleteFindMax K V O l) 146 | // )) 147 | // 148 | //def Map.glue (0 K V: Type) (O: Ord K) (left right: Map K V O): Map K V O 149 | // = (case left) (λ _ => Map K V O) 150 | // (right) 151 | // (λ _ _ _ _ _ => (case right) (λ _ => Map K V O) 152 | // (left) 153 | // (λ _ _ _ _ _ => (Bool.if (Map K V O) (Nat.gth (Map.size K V O left) (Map.size K V O right)) 154 | // ((case (Map.deleteFindMax K V O left)) (λ _ => Map K V O) 155 | // (Map.empty K V O) 156 | // (λ result => 157 | // let keyValue: Pair K V = Pair.fst (Pair K V) (Map K V O) result; 158 | // let newLeft: Map K V O = Pair.snd (Pair K V) (Map K V O) result; 159 | // let maxKey: K = Pair.fst K V keyValue; 160 | // let maxValue: V = Pair.snd K V keyValue; 161 | // Map.balance K V O maxKey maxValue newLeft right) 162 | // ) 163 | // ((case (Map.deleteFindMin K V O right)) (λ _ => Map K V O) 164 | // (Map.empty K V O) 165 | // (λ result => 166 | // let keyValue: Pair K V = Pair.fst (Pair K V) (Map K V O) result; 167 | // let newRight: Map K V O = Pair.snd (Pair K V) (Map K V O) result; 168 | // let minKey: K = Pair.fst K V keyValue; 169 | // let minValue: V = Pair.snd K V keyValue; 170 | // Map.balance K V O minKey minValue left newRight) 171 | // ) 172 | // ) 173 | // ) 174 | // ) 175 | // 176 | //def Map.insert (0 K V: Type) (O: Ord K) (k: K) (v: V) (m: Map K V O): Map K V O 177 | // = (case m) (λ _ => Map K V O) 178 | // (Map.single K V O k v) 179 | // (λ s actK actV left right => 180 | // (case (Ord.compare K O k actK)) (λ _ => Map K V O) 181 | // (Map.balance K V O actK actV (Map.insert K V O k v left) right) 182 | // (Map.Bin K V O s k v left right) 183 | // (Map.balance K V O actK actV left (Map.insert K V O k v right)) 184 | // ) 185 | // 186 | //def Map.delete (0 K V: Type) (O: Ord K) (k: K) (m: Map K V O): Map K V O 187 | // = (case m) (λ _ => Map K V O) 188 | // (Map.Tip K V O) 189 | // (λ s actK actV left right => 190 | // (case (Ord.compare K O k actK)) (λ _ => Map K V O) 191 | // (Map.balance K V O actK actV (Map.delete K V O k left) right) 192 | // (Map.glue K V O left right) 193 | // (Map.balance K V O actK actV left (Map.delete K V O k right)) 194 | // ) 195 | // 196 | // 197 | //def Map.put (0 K V: Type) (ord: Ord K) (m: Map K V ord) (key: K) (val: V) 198 | // : Map K V ord 199 | // = (case m) (λ _ => Map K V ord) (Map.single K V ord key val) 200 | // (λ tKey tVal lft rgt => 201 | // (case (Ord.compare K ord key tKey)) (λ _ => Map K V ord) 202 | // (Map.Bin K V ord key tVal (put K V ord lft key val) rgt) 203 | // (Map.Bin K V ord key val lft rgt) 204 | // (Map.Bin K V ord key tVal lft (put K V ord rgt key val)) 205 | // ) 206 | // 207 | // 208 | //def fromList (K V: Type) (ord: Ord K) (xs : List (Pair K V)): Map K V ord 209 | // = (case xs) (λ _ => Map K V ord) 210 | // (empty K V ord) 211 | // (λ x xs => 212 | // let xKey: K = Pair.fst K V x; 213 | // let xVal: V = Pair.snd K V x; 214 | // (case xs) (λ _ => Map K V ordering) 215 | // (singleton K V ord xKey xVal) 216 | // (λ y ys => 217 | // let yKey: K = Pair.fst K V y; 218 | // let yVal: V = Pair.snd K V y; 219 | // (case (Ord.compare K ord xKey yKey)) (λ _ => Map K V ord) 220 | // (tie K V ord key val (fromList K V ord xs) empty) 221 | // (tie K V ord key val (fromList K V ord ys) empty) 222 | // (tie K V ord key val empty (fromList K V ord xs)) 223 | // ) 224 | // ) 225 | // 226 | //def toList (0 K V: Type) (ordering : Ordered K) (map : Map K V ordering): List (Pair K V) 227 | // = (case map) (λ _ => List (Pair K V)) 228 | // (List.nil (Pair K V)) 229 | // (λ key value left right => 230 | // List.cons (Pair K V) (Pair.new K V key value) 231 | // (List.concat (Pair K V) (toList K V ordering left) (toList K V ordering right)) 232 | // ) 233 | // 234 | //def mapMap (K V BK BV : Type) (ord : Ordered K) (ordB : Ordered BK) (f : ∀ (Pair K V) -> (Pair BK BV)) (map : Map K V ord): Map BK BV ordB 235 | // = 236 | // let l : List (Pair K V) = toList K V ord map; 237 | // fromList BK BV ordB (List.map (Pair K V) (Pair BK BV) f l) 238 | // 239 | // 240 | --------------------------------------------------------------------------------