├── package.json ├── LICENSE ├── main.js ├── escoc.hs ├── README.md ├── escoc.js └── main.escoc /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "escoc", 3 | "version": "0.1.2", 4 | "description": "A nano proof language.", 5 | "main": "main.js", 6 | "bin": { 7 | "escoc": "main.js" 8 | }, 9 | "scripts": { 10 | "test": "echo \"Error: no test specified\" && exit 1" 11 | }, 12 | "repository": { 13 | "type": "git", 14 | "url": "git+https://github.com/maiavictor/ESCoC.git" 15 | }, 16 | "keywords": [ 17 | "theorem-proving", 18 | "lambda-calculus", 19 | "functional-programming", 20 | "type-theory" 21 | ], 22 | "author": "Victor Maia", 23 | "license": "MIT", 24 | "bugs": { 25 | "url": "https://github.com/maiavictor/ESCoC/issues" 26 | }, 27 | "homepage": "https://github.com/maiavictor/ESCoC#readme" 28 | } 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019 Victor Hernandes Silva Maia 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /main.js: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env node 2 | 3 | var fs = require("fs"); 4 | var path = require("path"); 5 | var escoc = require("./escoc.js"); 6 | 7 | try { 8 | var args = [].slice.call(process.argv, 2); 9 | var file = args[args.length - 1] || "./main.escoc"; 10 | var code = fs.readFileSync("./" + (file.indexOf(".") === -1 ? file + ".escoc" : file), "utf8"); 11 | } catch (e) { 12 | console.log("ESCoC: a nano proof language."); 13 | console.log("Usage: escoc file_name[.escoc]"); 14 | process.exit(); 15 | } 16 | 17 | var defs = escoc.parse(code); 18 | var term = defs.main.term; 19 | 20 | console.log("Term:\n" + escoc.show(term) + "\n"); 21 | 22 | try { 23 | console.log("Norm (head):\n" + escoc.show(escoc.norm(escoc.norm(term, defs, false), {}, true)) + "\n"); 24 | } catch (e) { 25 | console.log("Norm (head):\n\n"); 26 | } 27 | 28 | try { 29 | console.log("Norm (full):\n" + escoc.show(escoc.norm(term, defs, true)) + "\n"); 30 | } catch (e) { 31 | console.log("Norm (full):\n\n"); 32 | } 33 | 34 | try { 35 | var type = escoc.infer(term, defs); 36 | console.log("Type:\n" + escoc.show(escoc.norm(type, {}, true))); 37 | } catch (e) { 38 | console.log("Type:"); 39 | console.log(e); 40 | } 41 | -------------------------------------------------------------------------------- /escoc.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | 3 | data Term 4 | = Var Int 5 | | Typ 6 | | All String Term Term 7 | | Lam String (Maybe Term) Term 8 | | App Term Term 9 | | Ref String 10 | 11 | type Context = [(String, (Maybe Term, Maybe Term))] 12 | 13 | get_bind :: Context -> Int -> Maybe (String, (Maybe Term, Maybe Term)) 14 | get_bind [] i = Nothing 15 | get_bind (bind : rest) 0 = Just bind 16 | get_bind (bind : rest) i = fmap shift_bind (get_bind rest (i - 1)) where 17 | shift_bind (nam, (ter, typ)) = (nam, (shift_maybe ter, shift_maybe typ)) 18 | shift_maybe Nothing = Nothing 19 | shift_maybe term = term 20 | 21 | get_name :: Context -> Int -> Maybe String 22 | get_name ctx i = fmap fst (get_bind ctx i) 23 | 24 | get_type :: Context -> Int -> Maybe Term 25 | get_type ctx i = get_bind ctx i >>= (fst . snd) 26 | 27 | get_term :: Context -> Int -> Maybe Term 28 | get_term ctx i = get_bind ctx i >>= (snd . snd) 29 | 30 | index_of :: Context -> String -> Maybe Int 31 | index_of ctx name = findIndex (\x -> fst x == name) ctx 32 | 33 | str :: Term -> Context -> String 34 | str (Var index) ctx = maybe "*" id (get_name ctx index) 35 | str Typ ctx = "Type" 36 | str (All name bind body) ctx = "{" ++ name ++ " : " ++ str bind ((name, (Nothing, Nothing)) : ctx) ++ "} " ++ str body ((name, (Nothing, Nothing)) : ctx) 37 | str (Lam name Nothing body) ctx = "[" ++ name ++ "] " ++ str body ((name, (Nothing, Nothing)) : ctx) 38 | str (Lam name (Just bind) body) ctx = "[" ++ name ++ " : " ++ str bind ((name, (Nothing, Nothing)) : ctx) ++ "] " ++ str body ((name, (Nothing, Nothing)) : ctx) 39 | str (App func argm) ctx = "(" ++ str func ctx ++ " " ++ str argm ctx ++ ")" 40 | str (Ref name) ctx = name 41 | 42 | -- TODO port remaining of JS implementation 43 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ESCoC: Expanded-Scope Calculus of Constructions 2 | 3 | A nano (500 JS LOC, including parser and bidirectional type-checker) "theorem prover" capable of inductive reasoning. Compared to [Cedille-Core](https://github.com/maiavictor/cedille-core), ESCoC is 1. much simpler to implement, 2. much simpler to use, due to lack of redundancy. But it has no consistency proof (see the point at the end). 4 | 5 | ## Usage 6 | 7 | ``` 8 | npm i -g escoc 9 | escoc main.escoc 10 | ``` 11 | 12 | ESCoC was initially implemented in JS for no special reason, but a Haskell/Rust version would be nice and smaller. 13 | 14 | ## Why? 15 | 16 | I believe elegance is an important heuristics of mathematical exploration. Whenever a mathematical problem is solved in a complex, "human-engineered" manner, such solution is probably broken, and a correct, elegant, simple and clever solution probably exists, waiting to be found. Designing a proof language may be one of those things waiting for an elegant solution. Proof assistants such as Coq and Agda are built by extending an arguably elegant language (CoC) with inductive datatypes, a complex system that feels suspiciously human-engineered. This is necessary to enable inductive reasoning, essential to mathematical practice, and which CoC unfortunately lacks. Under this point of view, exploring simpler alternatives to inductive datatypes is valuable, because it might let us find such "elegant solution". 17 | 18 | ## How it works? 19 | 20 | ESCoC takes the CoC and 1. expands the scope of the dependent function type, so that, in `Π (x : A) B`, `x` is bound in `A`, 2. enables recursive definitions. And that's it. Notice that there are no extra primitives such as dependent intersections or self types, and no fundamental changes such as involving untyped terms in equality checking. ESCoC doesn't extend (recursive) CoC with anything new, just expands in a very minor way its existing constructs. To explain it, remember that, in CoC, the return type of a function can depend on its argument. That is, in an application such as `(f a)`, if the type of `f` is `Π (x : A) B`, then the type of `(f a)` is `[a/x]B`. The difference is that, in ESCoC, the input type of a function can also depend on its argument. That is, in an application such as `(f a)`, instead of checking if `a : A`, we check if `a : [a/x]A`. ESCoC is defined by the following syntax: 21 | 22 | ```haskell 23 | term ::= 24 | Type -- the type of types 25 | {var : term} term -- dependent function type 26 | [var : term] term -- a lambda 27 | (term term) -- an application 28 | var : term = term -- a recursive definition 29 | var -- a variable 30 | ``` 31 | 32 | And the following typing rules: 33 | 34 | ```haskell 35 | 36 | ----------- type in type (temporary?) 37 | Type : Type 38 | 39 | (var, type) in ctx 40 | ------------------ variables 41 | ctx |- var : type 42 | 43 | ctx, x : A |- A : Type ctx, x : A |- B : Type 44 | ------------------------------------------------ pi (dependent function type) 45 | ctx |- {x : A} B : Type 46 | 47 | ctx, x : A |- f : B ctx |- {a : A} B : Type 48 | ---------------------------------------------- lambda (dependent function intro) 49 | ctx |- [x : A] B : {x : A} B 50 | 51 | ctx |- f : {x : A} B ctx |- a : [a/x]A 52 | ----------------------------------------- application (dependent function elim) 53 | ctx |- (f a) : [a/x]B 54 | ``` 55 | 56 | Notice that the only change with respect to (recursive) CoC is that `x` is always bound in `A`. This is simple to implement, and any CoC implementation can adopt it with almost no change. 57 | 58 | ## How can one implement inductive datatypes on it? 59 | 60 | To start with a simple example, let's see the Boolean type. In Agda, you'd write it as such: 61 | 62 | ```agda 63 | data Bool : Set where 64 | true : Bool 65 | false : Bool 66 | ``` 67 | 68 | That is, it is just a type without constructors. Inductive proofs can be expressed with: 69 | 70 | ```agda 71 | elim : (b : Bool) -> (P : Bool -> Set) -> P true -> P false -> P b 72 | elim true P t f = t 73 | elim false P t f = f 74 | ``` 75 | 76 | In CoC, you can represent booleans with Church-encodings: 77 | 78 | ```haskell 79 | Bool : Type = 80 | {Prop : Type} 81 | {true : Prop} 82 | {false : Prop} 83 | Prop 84 | 85 | true : Bool = [Prop] [true] [false] true 86 | false : Bool = [Prop] [true] [false] false 87 | ``` 88 | 89 | (Note that I'll hide the type annotations of lambdas when they can be recovered by bidirectional type checking.) This isn't too different from the Agda definition, other than the need to write `Prop` instead of `Bool`. This is because the Church-encoding represents a datatype as its own fold, and `Prop` allows us to define type returned when folding over it. Unfortunatelly, there is no way to implement elimination for such a type. In ESCoC, you're able to represent indutive booleans as their own induction principles: 90 | 91 | ```haskell 92 | Bool 93 | : {self : (Bool self)} Type 94 | = [self] 95 | {Prop : {self : (Bool self)} Type} 96 | {true : (Prop Bool.true)} 97 | {false : (Prop Bool.false)} 98 | (Prop self) 99 | 100 | Bool.true : (Bool Bool.true) = [Prop] [true] [false] true 101 | Bool.false : (Bool Bool.false) = [Prop] [true] [false] false 102 | ``` 103 | 104 | Compared to the former representation, the main change is that, now, `Bool` isn't a type, but a function that receives a `Bool` and returns a type. It also refers to its own constructors, `Bool.true` and `Bool.false`, in a mutually recursive fashion; this is the reason we don't need dependent intersections. There isn't a single `Bool` type, but many: `Bool.true`, for example, isn't of type `Bool`, but of type `(Bool BOol.true)`, which is different of the type of `false`, which is `(Bool Bool.false)`. But that's not a problem in practice, because we're still able to implement functions that operate on both: 105 | 106 | ```haskell 107 | id 108 | : {b : (Bool b)} (Bool b) 109 | = [b] self 110 | ``` 111 | 112 | This is the main power of ESCoC: it can express "super-polymorphic" functions that operate on different types, as long as they are "indexed by their own values". So, despite `true` and `false` having different types, they can still be used as one. This allows us to implement induction easily: 113 | 114 | ```haskell 115 | Bool.induct 116 | : {self : (Bool self)} 117 | {Prop : {self : (Bool self)} Type} 118 | {true : (Prop Bool.true)} 119 | {false : (Prop Bool.false)} 120 | (Prop self) 121 | = [self] [Prop] [true] [false] 122 | (self Prop true false) 123 | ``` 124 | 125 | This is just identity because, under this encoding, datatypes are represented precisely by their induction principles. Now you might be wondering: how do we implement something like `not`? If we try this: 126 | 127 | ```haskell 128 | Bool.not 129 | : {b : (Bool b)} (Bool b) 130 | = [b] (b 131 | [b](Bool b) 132 | Bool.false 133 | Bool.true) 134 | ``` 135 | 136 | We get a type error. The problem is that, when setting the return type, we wrote `(Bool b)`, where `b` is the value of the input, yet, on the `Bool.true` case, we returned `Bool.false`, which has type `(Bool Bool.false)`, not `(Bool Bool.true)`. We could fix this issue by flipping the arguments, but then that'd turn it into the identity function, not the negation. What we want is to change the return type: 137 | 138 | ```haskell 139 | Bool.not 140 | : {b : (Bool b)} (Bool (Bool.not b)) 141 | = [b] (b 142 | [b](Bool (Bool.not b)) 143 | Bool.false 144 | Bool.true) 145 | ``` 146 | 147 | This now says that `not` is a function that takes a `Bool` indexed on itself, and returns a `Bool` indexed on its negation. So, for example, if you give it `true : (Bool true)`, then it will return a `false : (Bool (not true))`. Recursive types like `Nat` can be done using the same concept: 148 | 149 | ```haskell 150 | Nat 151 | : {self : (Nat self)} Type 152 | = [self] 153 | {Prop : {self : (Nat self)} Type} 154 | {succ : {pred : (Nat pred)} (Prop (Nat.succ pred))} 155 | {zero : (Prop Nat.zero)} 156 | (Prop self) 157 | 158 | Nat.succ 159 | : {pred : (Nat pred)} (Nat (Nat.succ pred)) 160 | = [pred] [Nat.] [succ.] [zero.] 161 | (succ. pred) 162 | 163 | Nat.zero 164 | : (Nat Nat.zero) 165 | = [Nat.] [succ.] [zero.] zero. 166 | ``` 167 | 168 | Here, again, `Nat` is a type indexed on itself. The only difference is that the `succ` case has an extra field, `pred`, which is, as expected, `(Nat pred)`. This realizes the Scott-encoding, which are computationally equivalent to Haskell's algebraic datatypes. One can implement inductive Parigot and Church encodings too, but I'm not sure if it is possible to implement certain recursive functions such as `is_even : {n : (PNat n)} (Bool (is_even n))`. Equality can be implemented as such: 169 | 170 | ```haskell 171 | Eq 172 | : {T : {self : (T self)} Type} 173 | {a : (T a)} 174 | {b : (T b)} 175 | {self : (Eq T a b self)} 176 | Type 177 | = [T] [a] [b] [self] 178 | {Prop : {b : (T b)} {self : (Eq T a b self)} Type} 179 | {refl : (Prop a (Eq.refl T a))} 180 | (Prop b self) 181 | 182 | Eq.refl 183 | : {T : {self : (T self)} Type} 184 | {a : (T a)} 185 | (Eq T a a (Eq.refl T a)) 186 | = [T] [a] [Prop] [refl] 187 | refl 188 | ``` 189 | 190 | Notice that this is basically the `J` axiom, with one difference: instead of being parameterized `T : Type`, it is parameterized by a `T : {self : (T self)} Type`, allowing you to express equalities on self-referential types. Something interesting about this representation is that, since `Eq` is indexed on itself, its type essentially carries the evidence of equality around. I'm not sure what this implies. More examples can be seen on the [`main.escoc`](main.escoc) file, including some simple theorems on those types. 191 | 192 | ## But what about consistency? 193 | 194 | CoC with equirecursion isn't consistent, as it is trivial to inhabit the empty type: 195 | 196 | ``` 197 | loop : {P : Type} P = loop 198 | ``` 199 | 200 | But it shouldn't be hard to use ESCoC as the foundation of a consistent language. If we, for example, simply restrict recursion to positive type ocurrences, then, I believe we could easily prove strong normalization by erasure to Fω, as done on the [Self Types](http://homepage.cs.uiowa.edu/~astump/papers/fu-stump-rta-tlca-14.pdf) paper. This would allow us to, for example, use Parigot (but not Scott) encodings for inductive reasoning. An alternative would be to use alternatives to classic logic, such as [light logics](https://arxiv.org/pdf/0704.2448.pdf), which, as argued on the paper, are consistent even in the presence of arbitrary type recursion. This may be attractive for a bunch of reasons, as it simplifies the theory and allows efficient compilation to interaction combinators. This repository will not include any particular restriction though, as it should be just a template to explore those ideas. Termination is to be considered a separate concern that must be addressed when using ESCoC as the foundation of another language. 201 | -------------------------------------------------------------------------------- /escoc.js: -------------------------------------------------------------------------------- 1 | // An ESCoC term is an ADT represented by a JSON 2 | const Var = (index) => ["Var", {index}, "#" + index]; 3 | const Typ = () => ["Typ", {}, "*"]; 4 | const All = (name, bind, body) => ["All", {name, bind, body}, "&" + bind[2] + body[2]]; 5 | const Lam = (name, bind, body) => ["Lam", {name, bind, body}, "^" + (bind?bind[2]:"") + body[2]]; 6 | const App = (func, argm) => ["App", {func, argm}, "@" + func[2] + argm[2]]; 7 | const Ref = (name) => ["Ref", {name}, "{" + name + "}"]; 8 | 9 | // A context is an array of (name, type, term) triples 10 | const Ctx = () => null; 11 | 12 | const extend = (ctx, bind) => { 13 | return {head: bind, tail: ctx}; 14 | } 15 | 16 | const get_bind = (ctx, i, j = 0) => { 17 | if (!ctx) { 18 | return null; 19 | } else if (j < i) { 20 | return get_bind(ctx.tail, i, j + 1); 21 | } else { 22 | return [ctx.head[0], ctx.head[1] ? shift(ctx.head[1], i, 0) : null]; 23 | } 24 | } 25 | 26 | const get_name = (ctx, i) => { 27 | const count = (ctx, name, i) => { 28 | return i === 0 ? 0 : (ctx.head[0] === name ? 1 : 0) + count(ctx.tail, name, i - 1); 29 | } 30 | const repeat = (str, i) => { 31 | return i === 0 ? "" : str + repeat(str, i - 1); 32 | } 33 | var bind = get_bind(ctx, i); 34 | if (bind) { 35 | return bind[0] + repeat("'", count(ctx, bind[0], i)); 36 | } else { 37 | return "#" + i; 38 | } 39 | } 40 | 41 | const get_term = (ctx, i) => { 42 | return get_bind(ctx, i) ? get_bind(ctx, i)[1] : null; 43 | } 44 | 45 | const index_of = (ctx, name, skip, i = 0) => { 46 | if (!ctx) { 47 | return null; 48 | } else if (ctx.head[0] === name && skip > 0) { 49 | return index_of(ctx.tail, name, skip - 1, i + 1); 50 | } else if (ctx.head[0] !== name) { 51 | return index_of(ctx.tail, name, skip, i + 1); 52 | } else { 53 | return i; 54 | } 55 | } 56 | 57 | // Pretty prints a context 58 | const show_context = (ctx, i = 0) => { 59 | var bind = get_bind(ctx, i); 60 | if (bind) { 61 | var term = " : " + (bind[1] ? show(norm(bind[1], {}, true), ctx) : "?"); 62 | return show_context(ctx, i + 1) + bind[0] + term + "\n"; 63 | } else { 64 | return ""; 65 | } 66 | } 67 | 68 | // Converts a term to a string 69 | const show = ([ctor, args], ctx = Ctx()) => { 70 | switch (ctor) { 71 | case "Var": 72 | return get_name(ctx, args.index) || "#" + args.index; 73 | case "Typ": 74 | return "Type"; 75 | case "All": 76 | var name = args.name; 77 | var bind = show(args.bind, extend(ctx, [args.name, null])); 78 | var body = show(args.body, extend(ctx, [args.name, null])); 79 | return "{" + name + " : " + bind + "} " + body; 80 | case "Lam": 81 | var name = args.name; 82 | var bind = args.bind && show(args.bind, extend(ctx, [name, null])); 83 | var body = show(args.body, extend(ctx, [name, null])); 84 | return bind ? "[" + name + " : " + bind + "] " + body : "[" + name + "] " + body; 85 | case "App": 86 | var text = ")"; 87 | var term = [ctor, args]; 88 | while (term[0] === "App") { 89 | text = " " + show(term[1].argm, ctx) + text; 90 | term = term[1].func; 91 | } 92 | return "(" + show(term, ctx) + text; 93 | case "Ref": 94 | return args.name; 95 | } 96 | } 97 | 98 | // Converts a string to a term 99 | const parse = (code) => { 100 | function is_space(char) { 101 | return char === " " || char === "\t" || char === "\n"; 102 | } 103 | 104 | function is_name_char(char) { 105 | return "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_.~-".indexOf(char) !== -1; 106 | } 107 | 108 | function skip_spaces() { 109 | while (index < code.length && is_space(code[index])) { 110 | index += 1; 111 | } 112 | return index; 113 | } 114 | 115 | function match(string) { 116 | skip_spaces(); 117 | var sliced = code.slice(index, index + string.length); 118 | if (sliced === string) { 119 | index += string.length; 120 | return true; 121 | } 122 | return false; 123 | } 124 | 125 | function error(text) { 126 | text += "This is the relevant code:\n\n<<<"; 127 | text += code.slice(index - 64, index) + "<<>>"; 128 | text += code.slice(index, index + 64) + ">>>"; 129 | throw text; 130 | } 131 | 132 | function parse_exact(string) { 133 | if (!match(string)) { 134 | error("Parse error, expected '" + string + "'.\n"); 135 | } 136 | } 137 | 138 | function parse_name() { 139 | skip_spaces(); 140 | var name = ""; 141 | while (index < code.length && is_name_char(code[index])) { 142 | name = name + code[index]; 143 | index += 1; 144 | } 145 | return name; 146 | } 147 | 148 | function parse_term(ctx) { 149 | // Comment 150 | if (match("--")) { 151 | while (index < code.length && code[index] !== "\n") { 152 | index += 1; 153 | } 154 | return parse_term(ctx); 155 | } 156 | 157 | // Application 158 | else if (match("(")) { 159 | var func = parse_term(ctx); 160 | while (index < code.length && !match(")")) { 161 | var argm = parse_term(ctx); 162 | var func = App(func, argm); 163 | skip_spaces(); 164 | } 165 | return func; 166 | } 167 | 168 | // Type 169 | else if (match("Type")) { 170 | return Typ(); 171 | } 172 | 173 | // Forall 174 | else if (match("{")) { 175 | var name = parse_name(); 176 | var skip = parse_exact(":"); 177 | var bind = parse_term(extend(ctx, [name, Var(0)])); 178 | var skip = parse_exact("}"); 179 | var body = parse_term(extend(ctx, [name, Var(0)])); 180 | return All(name, bind, body); 181 | } 182 | 183 | // Lambda 184 | else if (match("[")) { 185 | var name = parse_name(); 186 | var bind = match(":") ? parse_term(extend(ctx, [name, Var(0)])) : null; 187 | var skip = parse_exact("]"); 188 | var body = parse_term(extend(ctx, [name, Var(0)])); 189 | return Lam(name, bind, body); 190 | } 191 | 192 | // Let 193 | else if (match("let")) { 194 | var name = parse_name(); 195 | var copy = parse_term(ctx); 196 | var body = parse_term(extend(ctx, [name, Var(0)])); 197 | return subst(body, copy, 0); 198 | } 199 | 200 | // Variable / Reference 201 | else { 202 | var name = parse_name(); 203 | var skip = 0; 204 | while (match("'")) { 205 | skip += 1; 206 | } 207 | var var_index = index_of(ctx, name, skip); 208 | if (var_index === null) { 209 | return Ref(name, false); 210 | } else { 211 | return get_bind(ctx, var_index)[1]; 212 | } 213 | } 214 | } 215 | 216 | var index = 0; 217 | var defs = {}; 218 | while (index < code.length) { 219 | if (match("--")) { 220 | while (index < code.length && code[index] !== "\n") { 221 | index += 1; 222 | } 223 | } else { 224 | var name = parse_name(); 225 | var type = match(":") ? parse_term(Ctx()) : null; 226 | var skip = parse_exact("="); 227 | var term = parse_term(Ctx()); 228 | defs[name] = {term: term, type: type, done: false}; 229 | skip_spaces(); 230 | } 231 | } 232 | 233 | return defs; 234 | } 235 | 236 | // Shifts a term 237 | const shift = ([ctor, term], inc, depth) => { 238 | switch (ctor) { 239 | case "Var": 240 | return Var(term.index < depth ? term.index : term.index + inc); 241 | case "Typ": 242 | return Typ(); 243 | case "All": 244 | var name = term.name; 245 | var bind = shift(term.bind, inc, depth + 1); 246 | var body = shift(term.body, inc, depth + 1); 247 | return All(name, bind, body); 248 | case "Lam": 249 | var name = term.name; 250 | var bind = term.bind && shift(term.bind, inc, depth + 1); 251 | var body = shift(term.body, inc, depth + 1); 252 | return Lam(name, bind, body); 253 | case "App": 254 | var func = shift(term.func, inc, depth); 255 | var argm = shift(term.argm, inc, depth); 256 | return App(func, argm); 257 | case "Ref": 258 | return Ref(term.name); 259 | } 260 | } 261 | 262 | // Checks if two terms are equal 263 | const equals = (a, b, defs) => { 264 | const Eql = (a, b) => ["Eql", {a, b}]; 265 | const Bop = (v, x, y) => ["Bop", {v, x, y}]; 266 | const Val = (v) => ["Val", {v}]; 267 | 268 | const step = (node) => { 269 | switch (node[0]) { 270 | // An equality test 271 | case "Eql": 272 | var {a, b} = node[1]; 273 | 274 | // Gets whnfs with and without dereferencing 275 | var ax = norm(a, {}, false); 276 | var bx = norm(b, {}, false); 277 | var ay = norm(a, defs, false); 278 | var by = norm(b, defs, false); 279 | 280 | // Optional optimization: if hashes are equal, then a == b 281 | if (a[2] === b[2] || ax[2] === bx[2] || ay[2] === by[2]) { 282 | return Val(true); 283 | } 284 | 285 | // If non-deref whnfs are app and fields are equal, then a == b 286 | var x = null; 287 | if (ax[2] !== ay[2] || bx[2] !== by[2]) { 288 | if (ax[0] === "Ref" && bx[0] === "Ref" && ax[1].name === bx[1].name) { 289 | x = Val(true); 290 | } else if (ax[0] === "App" && bx[0] === "App") { 291 | var func = Eql(ax[1].func, bx[1].func); 292 | var argm = Eql(ax[1].argm, bx[1].argm); 293 | x = Bop(false, func, argm); 294 | } 295 | } 296 | 297 | // If whnfs are equal and fields are equal, then a == b 298 | var y = null; 299 | if (ay[0] === "Typ" && by[0] === "Typ") { 300 | y = Val(true); 301 | } else if (ay[0] === "All" && by[0] === "All") { 302 | y = Bop(false, Eql(ay[1].bind, by[1].bind), Eql(ay[1].body, by[1].body)); 303 | } else if (ay[0] === "Lam" && by[0] === "Lam") { 304 | y = Eql(ay[1].body, by[1].body) 305 | } else if (ay[0] === "App" && by[0] === "App") { 306 | y = Bop(false, Eql(ay[1].func, by[1].func), Eql(ay[1].argm, by[1].argm)); 307 | } else if (ay[0] === "Var" && by[0] === "Var") { 308 | y = Val(ay[1].index === by[1].index); 309 | } else { 310 | y = Val(false); 311 | } 312 | 313 | return x ? Bop(true, x, y) : y; 314 | 315 | // A binary operation (or / and) 316 | case "Bop": 317 | var {v, x, y} = node[1]; 318 | if (x[0] === "Val") { 319 | return x[1].v === v ? Val(v) : y; 320 | } else if (y[0] === "Val") { 321 | return y[1].v === v ? Val(v) : x; 322 | } else { 323 | return Bop(v, step(x), step(y)); 324 | } 325 | 326 | // A result value (true / false) 327 | case "Val": 328 | return node; 329 | } 330 | } 331 | 332 | // Expands the search tree until it finds an answer 333 | var tree = Eql(a, b); 334 | while (tree[0] !== "Val") { 335 | var tree = step(tree); 336 | } 337 | return tree[1].v; 338 | } 339 | 340 | // Reduces a term to normal form or head normal form 341 | const norm = ([ctor, term], defs, full) => { 342 | const cont = full ? norm : (x => x); 343 | const apply = (func, argm) => { 344 | var func = norm(func, defs, false); 345 | if (func[0] === "Lam") { 346 | return norm(subst(func[1].body, argm, 0), defs, full); 347 | } else { 348 | return App(cont(func, defs, false), cont(argm, defs, full)); 349 | } 350 | } 351 | const dereference = (name) => { 352 | if (defs[name] && !defs[name].seen) { 353 | return norm(defs[name].term, defs, full); 354 | } else { 355 | return Ref(name); 356 | } 357 | } 358 | switch (ctor) { 359 | case "Var": return Var(term.index); 360 | case "Typ": return Typ(); 361 | case "All": return All(term.name, cont(term.bind, defs, false), cont(term.body, defs, full)); 362 | case "Lam": return Lam(term.name, term.bind && cont(term.bind, defs, false), cont(term.body, defs, full)); 363 | case "App": return apply(term.func, term.argm); 364 | case "Ref": return dereference(term.name); 365 | } 366 | } 367 | 368 | // Substitution 369 | const subst = ([ctor, term], val, depth) => { 370 | switch (ctor) { 371 | case "Var": 372 | return depth === term.index ? val : Var(term.index - (term.index > depth ? 1 : 0)); 373 | case "Typ": 374 | return Typ(); 375 | case "All": 376 | var name = term.name; 377 | var bind = subst(term.bind, val && shift(val, 1, 0), depth + 1); 378 | var body = subst(term.body, val && shift(val, 1, 0), depth + 1); 379 | return All(name, bind, body); 380 | case "Lam": 381 | var name = term.name; 382 | var bind = term.bind && subst(term.bind, val && shift(val, 1, 0), depth + 1); 383 | var body = subst(term.body, val && shift(val, 1, 0), depth + 1); 384 | return Lam(name, bind, body); 385 | case "App": 386 | var func = subst(term.func, val, depth); 387 | var argm = subst(term.argm, val, depth); 388 | return App(func, argm); 389 | case "Ref": 390 | var name = term.name; 391 | return Ref(name); 392 | } 393 | } 394 | 395 | // Infers the type of a term 396 | const infer = (term, defs, ctx = Ctx()) => { 397 | switch (term[0]) { 398 | case "Typ": 399 | return Typ(); 400 | case "All": 401 | var ex_ctx = extend(ctx, [term[1].name, term[1].bind]); 402 | var bind_t = infer(term[1].bind, defs, ex_ctx); 403 | var body_t = infer(term[1].body, defs, ex_ctx); 404 | if (!equals(bind_t, Typ(), defs, ctx) || !equals(body_t, Typ(), defs, ctx)) { 405 | throw "[ERROR]\nForall not a type: `" + show(term, ctx) + "`.\n\n[CONTEXT]\n" + show_context(ctx); 406 | } 407 | return Typ(); 408 | case "Lam": 409 | if (term[1].bind === null) { 410 | throw "[ERROR]\nCan't infer non-annotated lambda `"+show(term,ctx)+"`.\n\n[CONTEXT]\n" + show_context(ctx); 411 | } else { 412 | var ex_ctx = extend(ctx, [term[1].name, term[1].bind]); 413 | var body_t = infer(term[1].body, defs, ex_ctx); 414 | var term_t = All(term[1].name, term[1].bind, body_t); 415 | infer(term_t, defs, ctx); 416 | return term_t; 417 | } 418 | case "App": 419 | var func_t = norm(infer(term[1].func, defs, ctx), defs, false); 420 | if (func_t[0] !== "All") { 421 | throw "[ERROR]\nNon-function application on `" + show(term, ctx) + "`.\n\n[CONTEXT]\n" + show_context(ctx); 422 | } 423 | var bind_t = subst(func_t[1].bind, term[1].argm, 0); 424 | var argm_v = check(term[1].argm, bind_t, defs, ctx, () => "`" + show(term, ctx) + "`'s argument"); 425 | return subst(func_t[1].body, argm_v, 0); 426 | case "Ref": 427 | if (defs[term[1].name]) { 428 | var def = defs[term[1].name]; 429 | if (def.done) { 430 | return def.type; 431 | } else { 432 | def.done = true; 433 | if (def.type) { 434 | check(def.term, def.type, defs, ctx, () => "`" + term[1].name + "`'s annotated type"); 435 | } else { 436 | def.type = infer(def.term, defs, ctx); 437 | } 438 | return def.type; 439 | } 440 | } else { 441 | throw "[ERROR]\nUndefined reference: `" + term[1].name + "`."; 442 | } 443 | case "Var": 444 | return get_term(ctx, term[1].index); 445 | } 446 | } 447 | 448 | // Checks if a term has given type 449 | const check = (term, type, defs, ctx = Ctx(), expr) => { 450 | var expr = expr || (() => show(term, ctx)); 451 | var type = norm(type, defs, false); 452 | if (type[0] === "All" && term[0] === "Lam" && !term[1].bind) { 453 | infer(type, defs, ctx); 454 | var ex_ctx = extend(ctx, [type[1].name, type[1].bind]); 455 | var body_v = check(term[1].body, type[1].body, defs, ex_ctx, () => "`" + show(term, ctx) + "`'s body"); 456 | return Lam(type[1].name, type[1].bind, body_v); 457 | } else { 458 | var term_t = infer(term, defs, ctx); 459 | try { 460 | var checks = equals(type, term_t, defs, ctx); 461 | } catch (e) { 462 | var checks = false; 463 | console.log("Couldn't decide if terms are equal."); 464 | console.log(e); 465 | } 466 | if (!checks) { 467 | throw show_mismatch(type, norm(term_t, defs, false), expr, ctx); 468 | } 469 | return term; 470 | } 471 | } 472 | 473 | // Formats a type-mismatch error message 474 | const show_mismatch = (expect, actual, expr, ctx) => { 475 | var text = ""; 476 | text += "[ERROR]\nType mismatch on " + expr() + ".\n"; 477 | text += "- Expect = " + show(norm(expect, {}, true), ctx) + "\n"; 478 | text += "- Actual = " + show(norm(actual, {}, true), ctx) + "\n" 479 | text += "\n[CONTEXT]\n" 480 | text += show_context(ctx); 481 | return text; 482 | } 483 | 484 | module.exports = { 485 | Ctx, 486 | extend, 487 | get_bind, 488 | get_name, 489 | get_term, 490 | index_of, 491 | show_context, 492 | show_mismatch, 493 | Var, 494 | Typ, 495 | All, 496 | Lam, 497 | App, 498 | Ref, 499 | show, 500 | parse, 501 | norm, 502 | infer, 503 | check, 504 | equals 505 | }; 506 | -------------------------------------------------------------------------------- /main.escoc: -------------------------------------------------------------------------------- 1 | -- This does not type check because it lacks a whnf 2 | 3 | inconsistent 4 | : {P : Type} P 5 | = inconsistent 6 | 7 | -- Identity 8 | 9 | the 10 | : {A : Type} {u : A} A 11 | = [A] [u] u 12 | 13 | -- A self-referential type 14 | 15 | Self 16 | : {T : (Self T)} Type 17 | = [T] {self : (T self)} Type 18 | 19 | -- The empty, uninhabited type 20 | 21 | Empty 22 | : (Self Empty) 23 | = [self] 24 | {Prop : (Self Empty)} 25 | (Prop self) 26 | 27 | -- The unit type 28 | 29 | Unit 30 | : (Self Unit) 31 | = [self] 32 | {Prop : (Self Unit)} 33 | {new : (Prop Unit.new)} 34 | (Prop self) 35 | 36 | Unit.new 37 | : (Unit Unit.new) 38 | = [Prop] [new] new 39 | 40 | -- The booleans true and false 41 | 42 | Bool 43 | : (Self Bool) 44 | = [self] 45 | {Prop : (Self Bool)} 46 | {true : (Prop Bool.true)} 47 | {false : (Prop Bool.false)} 48 | (Prop self) 49 | 50 | Bool.true 51 | : (Bool Bool.true) 52 | = [Prop] [true] [false] true 53 | 54 | Bool.false 55 | : (Bool Bool.false) 56 | = [Prop] [true] [false] false 57 | 58 | Bool.induct 59 | : {self : (Bool self)} 60 | {Prop : (Self Bool)} 61 | {true : (Prop Bool.true)} 62 | {false : (Prop Bool.false)} 63 | (Prop self) 64 | = [self] [Prop] [true] [false] 65 | (self Prop true false) 66 | 67 | Bool.not 68 | : {self : (Bool self)} (Bool (Bool.not self)) 69 | = [self] 70 | (self 71 | [self] (Bool (Bool.not self)) 72 | Bool.false 73 | Bool.true) 74 | 75 | -- Natural numbers (Scott) 76 | 77 | Nat 78 | : (Self Nat) 79 | = [self] 80 | {Prop : (Self Nat)} 81 | {succ : {pred : (Nat pred)} (Prop (Nat.succ pred))} 82 | {zero : (Prop Nat.zero)} 83 | (Prop self) 84 | 85 | Nat.succ 86 | : {pred : (Nat pred)} (Nat (Nat.succ pred)) 87 | = [pred] [Nat.] [succ.] [zero.] 88 | (succ. pred) 89 | 90 | Nat.zero 91 | : (Nat Nat.zero) 92 | = [Nat.] [succ.] [zero.] zero. 93 | 94 | Nat.0 : (Nat Nat.0) = Nat.zero 95 | Nat.1 : (Nat Nat.1) = (Nat.succ Nat.0) 96 | Nat.2 : (Nat Nat.2) = (Nat.succ Nat.1) 97 | Nat.3 : (Nat Nat.3) = (Nat.succ Nat.2) 98 | Nat.4 : (Nat Nat.4) = (Nat.succ Nat.3) 99 | Nat.5 : (Nat Nat.5) = (Nat.succ Nat.4) 100 | Nat.6 : (Nat Nat.6) = (Nat.succ Nat.5) 101 | Nat.7 : (Nat Nat.7) = (Nat.succ Nat.6) 102 | Nat.8 : (Nat Nat.8) = (Nat.succ Nat.7) 103 | Nat.9 : (Nat Nat.9) = (Nat.succ Nat.8) 104 | 105 | Nat.id 106 | : {a : (Nat a)} (Nat (Nat.id a)) 107 | = [a] 108 | (a 109 | [a] (Nat (Nat.id a)) 110 | [pred] (Nat.succ (Nat.id pred)) 111 | Nat.zero) 112 | 113 | Nat.same 114 | : {a : (Nat a)} (Nat (Nat.same a)) 115 | = [a] [Prop] [succ] [zero] 116 | (a [a] (Prop (Nat.same a)) 117 | [pred] (succ (Nat.same pred)) 118 | zero) 119 | 120 | Nat.double 121 | : {n : (Nat n)} (Nat (Nat.double n)) 122 | = [n] 123 | (n [n] (Nat (Nat.double n)) 124 | [pred] (Nat.succ (Nat.succ (Nat.double pred))) 125 | Nat.zero) 126 | 127 | Nat.add 128 | : {a : (Nat a)} {b : (Nat b)} (Nat (Nat.add a b)) 129 | = [a] [b] (a 130 | [a] (Nat (Nat.add a b)) 131 | [a] (Nat.succ (Nat.add a b)) 132 | b) 133 | 134 | Nat.add_zero_r 135 | : {a : (Nat a)} (Eq Nat (Nat.add a Nat.zero) a (Nat.add_zero_r a)) 136 | = [a] 137 | (a 138 | [self] (Eq Nat (Nat.add self Nat.zero) self (Nat.add_zero_r self)) 139 | [pred] (Eq.cong Nat Nat (Nat.add pred Nat.zero) pred (Nat.add_zero_r pred) Nat.succ) 140 | (Eq.refl Nat Nat.zero)) 141 | 142 | Nat.add_succ_r 143 | : {a : (Nat a)} {b : (Nat b)} (Eq Nat (Nat.add a (Nat.succ b)) (Nat.succ (Nat.add a b)) (Nat.add_succ_r a b)) 144 | = [a] [b] 145 | (a 146 | [self] (Eq Nat (Nat.add self (Nat.succ b)) (Nat.succ (Nat.add self b)) (Nat.add_succ_r self b)) 147 | [pred] (Eq.cong Nat Nat (Nat.add pred (Nat.succ b)) (Nat.succ (Nat.add pred b)) (Nat.add_succ_r pred b) Nat.succ) 148 | (Eq.refl Nat (Nat.succ b))) 149 | 150 | Nat.add_comm 151 | : {a : (Nat a)} {b : (Nat b)} (Eq Nat (Nat.add a b) (Nat.add b a) (Nat.add_comm a b)) 152 | = [a : (Nat a)] 153 | (a 154 | [self] {b : (Nat b)} (Eq Nat (Nat.add self b) (Nat.add b self) (Nat.add_comm self b)) 155 | [pred] [b] 156 | (Eq.subst Nat 157 | (Nat.add b pred) (Nat.add pred b) (Eq.sym Nat (Nat.add pred b) (Nat.add b pred) (Nat.add_comm pred b)) 158 | [x : (Nat x)] (Eq Nat (Nat.succ x) (Nat.add b (Nat.succ pred))) 159 | (Eq.sym Nat (Nat.add b (Nat.succ pred)) (Nat.succ (Nat.add b pred)) (Nat.add_succ_r b pred))) 160 | [b] (Eq.sym Nat (Nat.add b Nat.zero) b (Nat.add_zero_r b))) 161 | 162 | 163 | Nat.add_assoc 164 | : {a : (Nat a)} {b : (Nat b)} {c : (Nat c)} (Eq Nat (Nat.add (Nat.add a b) c) (Nat.add a (Nat.add b c)) (Nat.add_assoc a b c)) 165 | = [a] [b] [c] 166 | let motive [self] 167 | (Eq Nat (Nat.add (Nat.add self b) c) (Nat.add self (Nat.add b c)) (Nat.add_assoc self b c)) 168 | let case_succ [a] 169 | let ab_c (Nat.add (Nat.add a b) c) 170 | let a_bc (Nat.add a (Nat.add b c)) 171 | (Eq.cong Nat Nat ab_c a_bc (Nat.add_assoc a b c) Nat.succ) 172 | let case_zero 173 | (Eq.refl Nat (Nat.add b c)) 174 | (a motive case_succ case_zero) 175 | 176 | Nat.add_assoc_r 177 | : {a : (Nat a)} {b : (Nat b)} {c : (Nat c)} (Eq Nat (Nat.add a (Nat.add b c)) (Nat.add (Nat.add a b) c) (Nat.add_assoc_r a b c)) 178 | = [a] [b] [c] 179 | (Eq.sym Nat (Nat.add (Nat.add a b) c) (Nat.add a (Nat.add b c)) (Nat.add_assoc a b c)) 180 | 181 | -- Proof that `a + (b + c) = b + (a + c)` 182 | Nat.add_swap 183 | : {a : (Nat a)} {b : (Nat b)} {c : (Nat c)} (Eq Nat (Nat.add a (Nat.add b c)) (Nat.add b (Nat.add a c)) (Nat.add_swap a b c)) 184 | = [a] [b] [c] 185 | (Eq.r_trans Nat 186 | (Nat.add a (Nat.add b c)) (Nat.add (Nat.add a b) c) (Nat.add b (Nat.add a c)) (Nat.add_assoc a b c) 187 | (Eq.trans Nat (Nat.add (Nat.add a b) c) (Nat.add (Nat.add b a) c) (Nat.add b (Nat.add a c)) 188 | (Eq.cong Nat Nat (Nat.add a b) (Nat.add b a) (Nat.add_comm a b) [x : (Nat x)] (Nat.add x c)) 189 | (Nat.add_assoc b a c))) 190 | 191 | Nat.mul 192 | : {a : (Nat a)} {b : (Nat b)} (Nat (Nat.mul a b)) 193 | = [a] [b] 194 | (a [a] (Nat (Nat.mul a b)) 195 | [pred] (Nat.add b (Nat.mul pred b)) 196 | Nat.zero) 197 | 198 | Nat.mul_zero_r 199 | : {a : (Nat a)} (Eq Nat (Nat.mul a Nat.zero) Nat.zero (Nat.mul_zero_r a)) 200 | = [a] 201 | let motive [self] 202 | (Eq Nat (Nat.mul self Nat.zero) Nat.zero (Nat.mul_zero_r self)) 203 | let case_succ [a] 204 | (Eq.cong Nat Nat (Nat.mul a Nat.zero) Nat.zero (Nat.mul_zero_r a) (Nat.add Nat.zero)) 205 | let case_zero 206 | (Eq.refl Nat Nat.zero) 207 | (a motive case_succ case_zero) 208 | 209 | Nat.mul_one_r 210 | : {a : (Nat a)} (Eq Nat (Nat.mul a (Nat.succ Nat.zero)) a (Nat.mul_one_r a)) 211 | = [a] 212 | let motive [self] 213 | (Eq Nat (Nat.mul self (Nat.succ Nat.zero)) self (Nat.mul_a_one self)) 214 | let case_succ [a] 215 | (Eq.cong Nat Nat (Nat.mul a (Nat.succ Nat.zero)) a (Nat.mul_one_r a) Nat.succ) 216 | let case_zero 217 | (Eq.refl Nat Nat.zero) 218 | (a motive case_succ case_zero) 219 | 220 | Nat.mul_succ_r 221 | : {a : (Nat a)} {b : (Nat b)} (Eq Nat (Nat.mul a (Nat.succ b)) (Nat.add a (Nat.mul a b)) (Nat.mul_succ_r a b)) 222 | = [a] 223 | let motive [self] {b : (Nat b)} 224 | (Eq Nat (Nat.mul self (Nat.succ b)) (Nat.add self (Nat.mul self b)) (Nat.mul_succ_r self b)) 225 | let case_succ [a] [b] 226 | (Eq.cong Nat Nat 227 | (Nat.add b (Nat.mul a (Nat.succ b))) 228 | (Nat.add a (Nat.add b (Nat.mul a b))) 229 | (Eq.trans Nat 230 | (Nat.add b (Nat.mul a (Nat.succ b))) 231 | (Nat.add b (Nat.add a (Nat.mul a b))) 232 | (Nat.add a (Nat.add b (Nat.mul a b))) 233 | (Eq.cong Nat Nat 234 | (Nat.mul a (Nat.succ b)) 235 | (Nat.add a (Nat.mul a b)) 236 | (Nat.mul_succ_r a b) 237 | [x : (Nat x)] (Nat.add b x)) 238 | (Nat.add_swap b a (Nat.mul a b))) 239 | Nat.succ) 240 | let case_zero [b] 241 | (Eq.refl Nat Nat.zero) 242 | (a motive case_succ case_zero) 243 | 244 | Nat.mul_comm 245 | : {a : (Nat a)} {b : (Nat b)} (Eq Nat (Nat.mul a b) (Nat.mul b a) (Nat.mul_comm a b)) 246 | = [a] 247 | let motive [self] {b : (Nat b)} 248 | (Eq Nat (Nat.mul self b) (Nat.mul b self) (Nat.mul_comm self b)) 249 | let case_succ [a] [b] 250 | (Eq.trans_r Nat (Nat.add b (Nat.mul a b)) (Nat.add b (Nat.mul b a)) 251 | (Nat.mul b (Nat.succ a)) 252 | (Eq.cong Nat Nat (Nat.mul a b) (Nat.mul b a) (Nat.mul_comm a b) [x : (Nat x)] (Nat.add b x)) 253 | (Nat.mul_succ_r b a)) 254 | let case_zero [b] 255 | (Eq.sym Nat (Nat.mul b Nat.zero) Nat.zero (Nat.mul_zero_r b)) 256 | (a motive case_succ case_zero) 257 | 258 | -- Proof that `(a + b) * c == (a * c) + (b * c)` 259 | Nat.mul_distr_r 260 | : {a : (Nat a)} {b : (Nat b)} {c : (Nat c)} 261 | (Eq Nat (Nat.mul (Nat.add a b) c) (Nat.add (Nat.mul a c) (Nat.mul b c)) (Nat.mul_distr_r a b c)) 262 | = [a] 263 | let motive [self] {b : (Nat b)} {c : (Nat c)} 264 | (Eq Nat (Nat.mul (Nat.add self b) c) (Nat.add (Nat.mul self c) (Nat.mul b c)) (Nat.mul_distr_r self b c)) 265 | let case_succ [a] [b] [c] 266 | (Eq.subst Nat (Nat.add (Nat.mul a c) (Nat.mul b c)) (Nat.mul (Nat.add a b) c) 267 | (Eq.sym Nat (Nat.mul (Nat.add a b) c) (Nat.add (Nat.mul a c) (Nat.mul b c)) (Nat.mul_distr_r a b c)) 268 | [x : (Nat x)] (Eq Nat (Nat.add c x) (Nat.add (Nat.add c (Nat.mul a c)) (Nat.mul b c))) 269 | (Nat.add_assoc_r c (Nat.mul a c) (Nat.mul b c))) 270 | let case_zero [b] [c] (Eq.refl Nat (Nat.mul b c)) 271 | (a motive case_succ case_zero) 272 | 273 | -- Natural numbers (Church) 274 | 275 | Cat 276 | : (Self Cat) 277 | = [self] 278 | {P : (Self P)} 279 | {s : {x : (P x)} (P (s x))} 280 | {z : (P z)} 281 | (P (self P s z)) 282 | 283 | Cat.succ 284 | : {n : (Cat n)} (Cat (Cat.succ n)) 285 | = [n] [P] [s] [z] 286 | (s (n P s z)) 287 | 288 | Cat.zero 289 | : (Cat Cat.zero) 290 | = [P] [s] [z] 291 | z 292 | 293 | Cat.0 : (Cat Cat.0) = Cat.zero 294 | Cat.1 : (Cat Cat.1) = (Cat.succ Cat.0) 295 | Cat.2 : (Cat Cat.2) = (Cat.succ Cat.1) 296 | Cat.3 : (Cat Cat.3) = (Cat.succ Cat.2) 297 | Cat.4 : (Cat Cat.4) = (Cat.succ Cat.3) 298 | Cat.5 : (Cat Cat.5) = (Cat.succ Cat.4) 299 | Cat.6 : (Cat Cat.6) = (Cat.succ Cat.5) 300 | Cat.7 : (Cat Cat.7) = (Cat.succ Cat.6) 301 | Cat.8 : (Cat Cat.8) = (Cat.succ Cat.7) 302 | Cat.9 : (Cat Cat.9) = (Cat.succ Cat.8) 303 | 304 | Cat.add 305 | : {n : (Cat n)} {m : (Cat m)} (Cat (Cat.add n m)) 306 | = [n] [m] [P] [s] [z] 307 | (n P s (m P s z)) 308 | 309 | Cat.mul 310 | : {n : (Cat n)} {m : (Cat m)} (Cat (Cat.mul n m)) 311 | = [n] [m] [P] [s] [z] 312 | (n P (m P s) z) 313 | 314 | Cat.ex 315 | : (Eq Cat Cat.zero Cat.zero (Eq.refl Cat Cat.zero)) 316 | = (Eq.refl Cat Cat.zero) 317 | 318 | Cat.even 319 | : {n : (Cat n)} (Bool (Cat.even n)) 320 | = [n] 321 | (n 322 | [n : (Bool n)] (Bool n) 323 | [n : (Bool n)] (Bool.not n) 324 | Bool.true) 325 | 326 | -- Natural numbers (Parigot) 327 | 328 | Rat 329 | : (Self Rat) 330 | = [self] 331 | {Prop : {self : (Rat self)} {fold : (Prop self fold)} Type} 332 | {succ : {pred : (Rat pred)} {fold : (Prop pred fold)} (Prop (Rat.succ pred) (succ pred fold))} 333 | {zero : (Prop Rat.zero zero)} 334 | (Prop self (self Prop succ zero)) 335 | 336 | Rat.succ 337 | : {pred : (Rat pred)} (Rat (Rat.succ pred)) 338 | = [pred] [Rat] [succ] [zero] 339 | (succ pred (pred Rat succ zero)) 340 | 341 | Rat.zero 342 | : (Rat Rat.zero) 343 | = [Rat] [succ] [zero] zero 344 | 345 | Rat.0 : (Rat Rat.0) = Rat.zero 346 | Rat.1 : (Rat Rat.1) = (Rat.succ Rat.0) 347 | Rat.2 : (Rat Rat.2) = (Rat.succ Rat.1) 348 | Rat.3 : (Rat Rat.3) = (Rat.succ Rat.2) 349 | Rat.4 : (Rat Rat.4) = (Rat.succ Rat.3) 350 | Rat.5 : (Rat Rat.5) = (Rat.succ Rat.4) 351 | Rat.6 : (Rat Rat.6) = (Rat.succ Rat.5) 352 | Rat.7 : (Rat Rat.7) = (Rat.succ Rat.6) 353 | Rat.8 : (Rat Rat.8) = (Rat.succ Rat.7) 354 | Rat.9 : (Rat Rat.9) = (Rat.succ Rat.8) 355 | 356 | Rat.to_cat 357 | : {n : (Rat n)} (Cat (Rat.to_cat n)) 358 | = [n] (n 359 | [self : (Rat self)] [fold : (Cat fold)] (Cat fold) 360 | [pred : (Rat pred)] [fold : (Cat fold)] (Cat.succ fold) 361 | Cat.zero) 362 | 363 | Rat.id 364 | : {n : (Rat n)} (Rat (Rat.id n)) 365 | = [n] (n 366 | [self : (Rat self)] [fold : (Rat fold)] (Rat fold) 367 | [pred : (Rat pred)] [fold : (Rat fold)] (Rat.succ (Rat.succ (Rat.succ fold))) 368 | Rat.zero) 369 | 370 | Rat.add_n_zero 371 | : {n : (Rat n)} (Eq Rat (Rat.add n Rat.zero) n (Rat.add_n_zero n)) 372 | = [n] 373 | let motive [self : (Rat self)] [fold : (Eq Rat (Rat.add self Rat.zero) self fold)] 374 | (Eq Rat (Rat.add self Rat.zero) self fold) 375 | let case_succ [pred : (Rat pred)] [fold : (Eq Rat (Rat.add pred Rat.zero) pred fold)] 376 | (Eq.cong Rat Rat (Rat.add pred Rat.zero) pred (Rat.add_n_zero pred) Rat.succ) 377 | let case_zero 378 | (Eq.refl Rat Rat.zero) 379 | (n motive case_succ case_zero) 380 | 381 | Rat.add 382 | : {n : (Rat n)} {m : (Rat m)} (Rat (Rat.add n m)) 383 | = [n] [m] (n 384 | [n : (Rat n)] [r : (Rat r)] (Rat r) 385 | [n : (Rat n)] [r : (Rat r)] (Rat.succ r) 386 | m) 387 | 388 | -- Equality 389 | 390 | Eq 391 | : {T : (Self T)} 392 | {a : (T a)} 393 | {b : (T b)} 394 | {self : (Eq T a b self)} 395 | Type 396 | = [T] [a] [b] [self] 397 | {Prop : {b : (T b)} {self : (Eq T a b self)} Type} 398 | {refl : (Prop a (Eq.refl T a))} 399 | (Prop b self) 400 | 401 | Eq.refl 402 | : {T : (Self T)} 403 | {a : (T a)} 404 | (Eq T a a (Eq.refl T a)) 405 | = [T] [a] [Prop] [refl] 406 | refl 407 | 408 | Eq.sym 409 | : {T : {self : (T self)} Type} 410 | {a : (T a)} 411 | {b : (T b)} 412 | {e : (Eq T a b e)} 413 | (Eq T b a (Eq.sym T a b e)) 414 | = [T] [a] [b] [e] 415 | (e [b] [self] (Eq T b a (Eq.sym T a b self)) 416 | (Eq.refl T a)) 417 | 418 | Eq.cong 419 | : {A : {self : (A self)} Type} 420 | {B : {self : (B self)} Type} 421 | {a : (A a)} 422 | {b : (A b)} 423 | {e : (Eq A a b e)} 424 | {f : {a : (A a)} (B (f a))} 425 | (Eq B (f a) (f b) (Eq.cong A B a b e f)) 426 | = [A] [B] [a] [b] [e] [f] 427 | (e [b] [self] (Eq B (f a) (f b) (Eq.cong A B a b self f)) 428 | (Eq.refl B (f a))) 429 | 430 | Eq.subst 431 | : {T : (Self T)} 432 | {a : (T a)} 433 | {b : (T b)} 434 | {e : (Eq T a b e)} 435 | {P : {a : (T a)} (Self (P a))} 436 | {x : (P a x)} 437 | (P b (Eq.subst T a b e P x)) 438 | = [T] [a] [b] [e] [P] [x] 439 | (e [b] [self] (P b (Eq.subst T a b self P x)) x) 440 | 441 | -- Transitivity of equality: a proof that `a == b` and `b == c` implies `a == c` (and all other permutations) 442 | Eq.trans 443 | : {T : {self : (T self)} Type} 444 | {a : (T a)} 445 | {b : (T b)} 446 | {c : (T c)} 447 | {e1 : (Eq T a b e1)} 448 | {e2 : (Eq T b c e2)} 449 | (Eq T a c (Eq.trans T a b c e1 e2)) 450 | = [T] [a] [b] [c] [e1] 451 | (e1 [b] [self] {e2 : (Eq T b c e2)} (Eq T a c (Eq.trans T a b c self e2)) 452 | [e2] e2) 453 | 454 | Eq.trans_r 455 | : {T : {self : (T self)} Type} 456 | {a : (T a)} 457 | {b : (T b)} 458 | {c : (T c)} 459 | {e1 : (Eq T a b e1)} 460 | {e2 : (Eq T c b e2)} 461 | (Eq T a c (Eq.trans_r T a b c e1 e2)) 462 | = [T] [a] [b] [c] [e1] 463 | (e1 [b] [self] {e2 : (Eq T c b e2)} (Eq T a c (Eq.trans_r T a b c self e2)) 464 | [e2] (Eq.sym T c a e2)) 465 | 466 | Eq.r_trans 467 | : {T : {self : (T self)} Type} 468 | {a : (T a)} 469 | {b : (T b)} 470 | {c : (T c)} 471 | {e1 : (Eq T b a e1)} 472 | {e2 : (Eq T b c e2)} 473 | (Eq T a c (Eq.r_trans T a b c e1 e2)) 474 | = [T] [a] [b] [c] [e1] 475 | (e1 [a] [self] {e2 : (Eq T b c e2)} (Eq T a c (Eq.r_trans T a b c self e2)) 476 | [e2] e2) 477 | 478 | Eq.r_trans_r 479 | : {T : {self : (T self)} Type} 480 | {a : (T a)} 481 | {b : (T b)} 482 | {c : (T c)} 483 | {e1 : (Eq T b a e1)} 484 | {e2 : (Eq T c b e2)} 485 | (Eq T a c (Eq.r_trans_r T a b c e1 e2)) 486 | = [T] [a] [b] [c] [e1] 487 | (e1 [a] [self] {e2 : (Eq T c b e2)} (Eq T a c (Eq.r_trans_r T a b c self e2)) 488 | [e2] (Eq.sym T c b e2)) 489 | 490 | -- Binary 491 | 492 | Bin 493 | : (Self Bin) 494 | = [self] 495 | {Prop : (Self Bin)} 496 | {O : {pred : (Bin pred)} (Prop (Bin.O pred))} 497 | {I : {pred : (Bin pred)} (Prop (Bin.I pred))} 498 | {E : (Prop Bin.E)} 499 | (Prop self) 500 | 501 | Bin.O 502 | : {pred : (Bin pred)} 503 | (Bin (Bin.O pred)) 504 | = [pred] [Prop] [O] [I] [E] 505 | (O pred) 506 | 507 | Bin.I 508 | : {pred : (Bin pred)} 509 | (Bin (Bin.I pred)) 510 | = [pred] [Prop] [O] [I] [E] 511 | (I pred) 512 | 513 | Bin.E 514 | : (Bin Bin.E) 515 | = [Prop] [O] [I] [E] 516 | E 517 | 518 | Bin.inc 519 | : {x : (Bin x)} 520 | (Bin (Bin.inc x)) 521 | = [xs] 522 | (xs [self : (Bin self)] (Bin (Bin.inc self)) 523 | [pred] (Bin.I pred) 524 | [pred] (Bin.O (Bin.inc pred)) 525 | Bin.E) 526 | 527 | -- Dependent pairs 528 | 529 | Sigma 530 | : {A : (Self A)} 531 | {B : {x : (A x)} (Self (B x))} 532 | {self : (Sigma A B self)} 533 | Type 534 | = [A] [B] [self] 535 | {Prop : {self : (Sigma A B self)} Type} 536 | {new : {a : (A a)} {b : (B a b)} (Prop (Sigma.new A B a b))} 537 | (Prop self) 538 | 539 | Sigma.new 540 | : {A : (Self A)} 541 | {B : {x : (A x)} (Self (B x))} 542 | {a : (A a)} 543 | {b : (B a b)} 544 | (Sigma A B (Sigma.new A B a b)) 545 | = [A] [B] [a] [b] [Prop] [new] 546 | (new a b) 547 | 548 | Sigma.fst 549 | : {A : (Self A)} 550 | {B : {x : (A x)} (Self (B x))} 551 | {sigma : (Sigma A B sigma)} 552 | (A (Sigma.fst A B sigma)) 553 | = [A] [B] [sigma] 554 | (sigma 555 | [self] (A (Sigma.fst A B self)) 556 | [a] [b] a) 557 | 558 | Sigma.snd 559 | : {A : (Self A)} 560 | {B : {x : (A x)} (Self (B x))} 561 | {sigma : (Sigma A B sigma)} 562 | (B (Sigma.fst A B sigma) (Sigma.snd A B sigma)) 563 | = [A] [B] [sigma] 564 | (sigma 565 | [self] (B (Sigma.fst A B self) (Sigma.snd A B self)) 566 | [a] [b] b) 567 | 568 | Sigma.example 569 | = (Sigma.new Nat [x : (Nat x)](Eq Nat x x) Nat.3 (Eq.refl Nat Nat.3)) 570 | 571 | main 572 | = Nat.mul_distr_r 573 | --------------------------------------------------------------------------------