├── LICENSE ├── README.md ├── TODO ├── bin ├── README.md ├── bootstrap.js ├── hs │ ├── CHANGELOG.md │ ├── Formality.cabal │ ├── LICENSE │ ├── README.md │ └── src │ │ ├── Formality.hs │ │ ├── FormalityInternal.hs │ │ ├── Main.hs │ │ └── Setup.hs ├── js │ ├── package-lock.json │ ├── package.json │ └── src │ │ ├── cache.js │ │ ├── formality.js │ │ └── main.js ├── package-lock.json └── package.json ├── blog └── 0-goodbye-javascript.md └── src ├── Bit.fm ├── Bits.fm ├── Bool.fm ├── Char.fm ├── Cmp.fm ├── Debug.fm ├── Either.fm ├── Empty.fm ├── Equal.fm ├── Fm.fm ├── IO.fm ├── List.fm ├── Main.fm ├── Map.fm ├── Maybe.fm ├── Monad.fm ├── Nat.fm ├── Pair.fm ├── Parser.fm ├── Set.fm ├── Sigma.fm ├── String.fm ├── U16.fm ├── U32.fm ├── U64.fm ├── Unit.fm ├── Vector.fm └── Word.fm /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016-2019 Ethereum Foundation 4 | Copyright (c) 2019 Sunshine Cybernetics 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Formality 2 | ========= 3 | 4 | A modern programming language featuring formal proofs. Now written in itself! 5 | 6 | Why formal proofs? 7 | ------------------ 8 | 9 | When most people hear about formal proofs, they naturally think about 10 | mathematics and security, or, "boring stuff". While it is true that formal 11 | proofs can be used to formalize theorems and verify software correctness, 12 | Formality's approach is different: we focus in using proofs as a tool to 13 | **enhance developer productivity**. 14 | 15 | There is little doubt left that adding types to untyped languages greatly 16 | increases productivity, specially when the codebase grows past a certain point: 17 | just see the surge of TypeScript. Formal proofs are, in a way, an evolution of 18 | the simple types used in common languages. 19 | 20 | We believe that proofs are superpowers waiting to be explored, and the proper 21 | usage of them can enhance the productivity of a developer in a disruptive 22 | manner: think of Haskell's Hackage on steroids. Formality was designed to 23 | explore and enable that side of formal proofs, and we'll be publishing more 24 | about that soon. 25 | 26 | Why Formality? 27 | -------------- 28 | 29 | There are some interesting proof languages, or theorem provers, as they're often 30 | called, in the market. [Agda](Agda), [Coq](Coq), [Lean](Lean), [Idris](Idris), 31 | to name a few. But these (perhaps with exception of Idris, which we love!) 32 | aren't aligned with the vision highlighted above, in some key aspects: 33 | 34 | ### Auditability 35 | 36 | Formality is entirely compiled to a small [trusted core](FormCoreJS) that has 37 | 700 lines of code. This is 1 to 2 orders of magnitude smaller than existing 38 | alternatives. Because of that, auditing Formality is much easier, decreasing the 39 | need for trust and solving the "who verifies that the verifier" problem. 40 | 41 | ### Portability 42 | 43 | Being compiled to such a small core also allows Formality to be easily compiled 44 | to multiple targets, making it very portable. For example, out 45 | [Formality-to-Haskell](FormalityToHaskell) compiler was developed in an evening 46 | and has less than 1000 lines of code. This allows Formality to be used as a a 47 | lazy, pure functional language that is compiled directly by Haskell's GHC. 48 | 49 | ### Performance 50 | 51 | Formality has a long-term approach to performance: make the language fast in 52 | theory, then build great compilers for each specific target. Our JavaScript 53 | compiler, for example, is tuned to generate small, fast JS, allowing Formality 54 | to be used for web development. Other targets may have different optimizations, 55 | and we're constantly researching new ways of evaluating functional programs; see 56 | our post about [interaction nets and optimal reduction](absal). 57 | 58 | [FormCoreJS]: https://github.com/moonad/formcorejs 59 | 60 | [Formality-to-Haskell]: https://github.com/moonad/FormCoreJS/blob/master/FmcToHs.js 61 | 62 | [formality.js]: https://github.com/moonad/FormalityFM/blob/master/bin/js/src/formality.js 63 | 64 | [Agda]: https://github.com/agda/agda 65 | 66 | [Idris]: https://github.com/idris-lang/Idris-dev 67 | 68 | [Coq]: https://github.com/coq/coq 69 | 70 | [Lean]: https://github.com/leanprover/lean 71 | 72 | [Absal]: https://medium.com/@maiavictor/solving-the-mystery-behind-abstract-algorithms-magical-optimizations-144225164b07 73 | 74 | ### Fun! 75 | 76 | For a programming language to be fun, it can't be too serious. It must have 77 | great supporting tools such as a package manager, an editor. It must have 78 | friendly error messages. It must have a fast type-checker. It must have a 79 | non-cryptic syntax that everyone can use and understand. It must be stable and 80 | provide long term support. All of these are non-goals for many of the existing 81 | alternatives, but are high priorities for Formaltiy. 82 | 83 | Usage 84 | ----- 85 | 86 | 1. Install 87 | 88 | Using the JavaScript release (`fmjs`): 89 | 90 | ```bash 91 | npm i -g formality-js 92 | ``` 93 | 94 | Using the Haskell release (uses `fmhs` instead of `fmjs`): 95 | 96 | ```bash 97 | git clone https://github.com/moonad/formality 98 | cd formality/bin/hs 99 | cabal install 100 | ``` 101 | 102 | 2. Clone the base libraries 103 | 104 | ```bash 105 | git clone https://github.com/moonad/formality 106 | cd formality/src 107 | ``` 108 | 109 | 3. Edit, check and run 110 | 111 | Edit `Main.fm` on `formality/src` to add your code: 112 | 113 | ```c 114 | Main: IO(Unit) 115 | do IO { 116 | IO.print("Hello, world!") 117 | } 118 | ``` 119 | 120 | Type-check to see errors and goals: 121 | 122 | ```bash 123 | fmjs Main.fm 124 | ``` 125 | 126 | Run to see results: 127 | 128 | ```bash 129 | fmjs Main --run 130 | ``` 131 | 132 | Since Formality doesn't have a module system yet, you must be at 133 | `formality/src` to use the base types (lists, strings, etc.). In this early 134 | phase, we'd like all the development to be contained in that directory. Feel 135 | encouraged to send your programs and proofs as a PR! 136 | 137 | Quick Introduction 138 | ------------------ 139 | 140 | ### A simple, clear and fun syntax 141 | 142 | > If you can't explain it simply, you don't understand it well enough. 143 | 144 | Why make it hard? Formality aims to frame advanced concepts in ways that 145 | everyone can understand. For example, if you ask a Haskeller to sum a list of 146 | positive ints (Nats), he might write: 147 | 148 | ```c 149 | sum(list: List(Nat)): Nat 150 | case list { 151 | nil : 0 152 | cons : list.head + sum(list.tail) 153 | } 154 | 155 | Main: IO(Unit) 156 | do IO { 157 | IO.print("Sum is: " | Nat.show(sum([1, 2, 3]))) 158 | } 159 | ``` 160 | 161 | Or, if he is enlightened enough: 162 | 163 | ```c 164 | sum(list: List(Nat)): Nat 165 | List.fold<_>(list)<_>(0, Nat.add) 166 | 167 | Main: IO(Unit) 168 | do IO { 169 | IO.print("Sum is: " | Nat.show(sum([1, 2, 3]))) 170 | } 171 | ``` 172 | 173 | But, while recursion and folds are nice, this is fine too: 174 | 175 | ```c 176 | sum(list: List(Nat)): Nat 177 | let sum = 0 178 | for x in list: 179 | sum = x + sum 180 | sum 181 | ``` 182 | 183 | The code above isn't impure, Formality translates loops to pure folds. It is 184 | just written in a way that is more familiar to some. Proof languages are already 185 | hard enough, so why make syntax yet another obstacle? 186 | 187 | *(You can test the examples above by editing `Main.fm`, and typing `fmjs Main.fm` 188 | and `fmjs Main --run` on the `Formality/src` directory.)* 189 | 190 | ### Powerful types 191 | 192 | Let's now see how to write structures with increasingly complex types. Below is 193 | the simple list, a "variant type" with two constructors, one for the `empty` 194 | list, and one to `push` a positive number (`Nat`) to another list: 195 | 196 | ```c 197 | // NatList is a linked list of Nats 198 | type NatList { 199 | empty 200 | push(head: Nat, tail: NatList) 201 | } 202 | ``` 203 | 204 | As usual, we can make it **more generic** with polymorphic types: 205 | 206 | ```c 207 | // List is a linked list of A's (for any type A) 208 | type List (A: Type) { 209 | empty 210 | push(head: A, tail: List(A)) 211 | } 212 | ``` 213 | 214 | But we can make it **more specific** with indexed types: 215 | 216 | ```c 217 | // Vector is a linked list of Nats with a statically known size 218 | type Vector ~ (len: Nat) { 219 | empty ~ (len: 0) 220 | push(len: Nat, head: Nat, tail: Vector(len)) ~ (len: 1 + len) 221 | } 222 | ``` 223 | 224 | The type above isn't of a *fixed length* list, but of one that has a length that 225 | is *statically known*. The difference is that we can still grown and shrink it, 226 | but we can't, for example, get the the `head` of an empty list. For example: 227 | 228 | ```c 229 | Main: IO(Unit) 230 | def list = [1,2,3] 231 | def vect = Vector.from_list(list) 232 | def head = Vector.head(vect) 233 | do IO { 234 | IO.print("First is: " | Nat.show(head)) 235 | } 236 | ``` 237 | 238 | Works fine, but, if you change the list to be empty, it will result in a type 239 | error! This is in contrast to Haskell, where `head []` results in a runtime 240 | crash. Formality programs can't crash. Ever! 241 | 242 | *(You can also check the program above by editing `Main.fm`.)* 243 | 244 | ### Theorem proving 245 | 246 | Proof languages go beyound checking lengths though. Everything you can think of 247 | can be statically verified by the type system. With subset types, written as 248 | `{x: A} -> B(x)`, you can restrict a type arbitrarily. For example, here we use 249 | subsets to represent even numbers: 250 | 251 | ```c 252 | // An "EvenNat" is a Nat `x`, such that `(x % 2) == 0` 253 | EvenNat: Type 254 | {x: Nat} (x % 2) == 0 255 | 256 | six_as_even: EvenNat 257 | 6 ~ refl 258 | ``` 259 | 260 | This program only type-checks because `6` is even: try changing it to `7` and it 261 | will be a type error! But what about `~ refl`? This is a **proof** that `6` is 262 | indeed even. Since `6` is a compile-time constant, it is very easy for Formality 263 | to verify that it is even (it just needs to run `6 % 2`), so we write `refl`, 264 | which stands for "reflexive", or "just reduce it". 265 | 266 | But what if it was an expression instead? For example, what if we wanted to 267 | write a function that receives a Nat `x`, and returns `x*2` as an EvenNat? It 268 | makes sense, because the double of every number is even. But if we just write: 269 | 270 | ```c 271 | double_as_even(n: Nat): EvenNat 272 | (2 * n) ~ refl 273 | ``` 274 | 275 | Formality will complain: 276 | 277 | ``` 278 | Type mismatch. 279 | - Expected: Nat.mod(Nat.double(n),2) == 0 280 | - Detected: 0 == 0 281 | ``` 282 | 283 | That's because Formality doesn't know that `(n*2)%2 == 0` is necessarily true 284 | for every `n`. We need to convince the type-checker by proving it. Proofs are 285 | like functions, we just create a separate function that, given a `n: Nat`, 286 | returns a proof that `((n*2)%2)==0`. That proof will be done by case analysis 287 | and induction, but we won't get into details on how it works; for now, suffice 288 | to say it is just pattern-matching and recursion. Here is it: 289 | 290 | ```c 291 | EvenNat: Type 292 | {x: Nat} (x % 2) == 0 293 | 294 | six_as_even: EvenNat 295 | 6 ~ refl 296 | 297 | double_as_even(n: Nat): EvenNat 298 | (2 * n) ~ double_is_even(n) 299 | 300 | double_is_even(n: Nat): ((2 * n) % 2) == 0 301 | case n { 302 | zero: refl 303 | succ: double_is_even(n.pred) 304 | }! 305 | ``` 306 | 307 | To sum up, `EvenNat` is the type of `Nat`s that are even. `six_as_even` is just 308 | the number `6`, viewed as an `EvenNat`; since Formality can verify that 6 is 309 | even, we write `~ refl` on it. `double_as_even` is a function that, for any 310 | `Nat` `n`, returns `n*2` as an `EvenNat`. Formality can't verify that `n*2` is 311 | always even by itself, so, to convince it, we write a separate proof called 312 | `double_is_even(n)`. 313 | 314 | *(Check this program too!)* 315 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | - DONE syntax for Debug.log: `log("a", "b")` 2 | - DONE smart motives for case-of 3 | - DONE remove the need for ; in many places 4 | - DONE add `let {x,y} = ...` syntax for pair destruction 5 | - DONE add `open x` for destruction 6 | - DONE improve JS compiler 7 | - DONE check a whole file with `fmfm file.fm` 8 | - DONE show only first type error + hole errors, to avoid overwhelming user 9 | - DONE show location on parse and type errors 10 | - remove need for name on the do-notation 11 | - lambdas with annotations `(b:A) x` 12 | - done create HS compiler 13 | - let case-of create a let for its "as" value 14 | - implicit arguments 15 | - more string escape sequences 16 | -------------------------------------------------------------------------------- /bin/README.md: -------------------------------------------------------------------------------- 1 | Bootstrap 2 | ========= 3 | 4 | This generates all implementations from the `formality.fm` file. In order for it 5 | to work, it must load the last bootstrapped version (`formality.js`). Moreover, 6 | since `formality.fm` doesn't implement the JS compiler, it must also import 7 | `FormCoreJS`, which has an efficient `FormCore -> JavaScript` compiler. Then it 8 | works as follows: 9 | 10 | ``` 11 | formality.js compiles formality.fm to formality.fmc 12 | FormCore compiles formality.fmc to formality.js 13 | ... other langs to be generated soon ... 14 | ``` 15 | -------------------------------------------------------------------------------- /bin/bootstrap.js: -------------------------------------------------------------------------------- 1 | var {execSync} = require("child_process"); 2 | var fs = require("fs"); 3 | var path = require("path"); 4 | var {fmc_to_js, fmc_to_hs, fmc} = require("formcore-lang"); // FormCore, which has the JS compiler 5 | //var {fmc_to_js, fmc} = require("./../../FormCoreJS"); // FormCore, which has the JS compiler 6 | 7 | var fmjs_path = path.join(__dirname, "js/src/formality.js"); 8 | var fmhs_path = path.join(__dirname, "hs/src/FormalityInternal.hs"); 9 | process.chdir(path.join(__dirname, "../src")); 10 | 11 | // Restores last formality.js from git in case we destroyed it 12 | execSync("git checkout "+fmjs_path); 13 | 14 | // Creates formality.js 15 | console.log("Generating formality.js"); 16 | execSync("fmjs Fm --js --module | js-beautify >> "+fmjs_path+".tmp"); 17 | execSync("mv "+fmjs_path+".tmp "+fmjs_path); 18 | 19 | // Creates formality.hs 20 | console.log("Generating formality.hs"); 21 | execSync("fmjs Fm --hs --module FormalityInternal >> "+fmhs_path+".tmp"); 22 | execSync("mv "+fmhs_path+".tmp "+fmhs_path); 23 | 24 | // Using the old version (deprecated) 25 | //console.log("Using old Formality to generate formality.js"); 26 | //execSync("rm "+file); 27 | //execSync("fmjs Fm | js-beautify >> "+file); 28 | //fs.writeFileSync(file,fs.readFileSync(file,"utf8").split("\n").slice(0,-1).join("\n")); // removes module.exports lines 29 | -------------------------------------------------------------------------------- /bin/hs/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for Formality 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /bin/hs/Formality.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | -- Initial package description 'Formality.cabal' generated by 'cabal init'. 3 | -- For further documentation, see http://haskell.org/cabal/users-guide/ 4 | 5 | name: Formality 6 | version: 0.1.0.0 7 | description: A modern proof language 8 | license: MIT 9 | license-file: LICENSE 10 | author: Victor Maia 11 | maintainer: srvictormaia@gmail.com 12 | build-type: Simple 13 | 14 | executable fmhs 15 | hs-source-dirs: src 16 | main-is: Main.hs 17 | build-depends: base >=3 && <5 18 | default-language: Haskell2010 19 | 20 | Library 21 | hs-source-dirs: src 22 | Build-Depends: base >= 3 && < 5 23 | Exposed-modules: Formality 24 | Other-modules: FormalityInternal 25 | ghc-options: -Wall 26 | -------------------------------------------------------------------------------- /bin/hs/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020 maiavictor 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 | -------------------------------------------------------------------------------- /bin/hs/README.md: -------------------------------------------------------------------------------- 1 | Formality-Haskell 2 | ================= 3 | 4 | Formality compiled to Haskell and exposed as a Haskell project. 5 | 6 | Installing 7 | ---------- 8 | 9 | ... todo ... 10 | 11 | Using 12 | ----- 13 | 14 | ``` 15 | fmhs file.fm # type-checks a file's contents 16 | ``` 17 | -------------------------------------------------------------------------------- /bin/hs/src/Formality.hs: -------------------------------------------------------------------------------- 1 | -- This is the main API of the Formality library. It is a thin wrapper around 2 | -- FormalityInternal.hs (internal file, generated from Formality), re-exporting 3 | -- some of its functions with proper type signatures and documentation. 4 | 5 | module Formality where 6 | 7 | import FormalityInternal 8 | 9 | -- | 'report' type-checks a source file, returning a report of errors and goals 10 | report :: String -> String 11 | report = fm_checker_code 12 | -------------------------------------------------------------------------------- /bin/hs/src/Main.hs: -------------------------------------------------------------------------------- 1 | -- This is FormalityHS's command-line interface. It is a thin wrapper around 2 | -- FormalityInternal.hs (internal file, generated from Formality) allowing the 3 | -- user to access Formality features from the command line. 4 | 5 | import System.Environment 6 | import FormalityInternal 7 | import Data.List 8 | 9 | main :: IO () 10 | main = do 11 | args <- getArgs 12 | if null args then do 13 | putStrLn "# FormalityHS" 14 | putStrLn "" 15 | putStrLn "Usage:" 16 | putStrLn "" 17 | putStrLn " fmhs # type-checks a definition" 18 | putStrLn " fmhs # type-checks a file" 19 | putStrLn "" 20 | putStrLn "Examples:" 21 | putStrLn "" 22 | putStrLn " # Check all types inside the file 'example.fm':" 23 | putStrLn " fmhs example.fm" 24 | putStrLn "" 25 | putStrLn " # Check only one definition named 'foo':" 26 | putStrLn " fmhs foo" 27 | putStrLn "" 28 | else do 29 | let name = head args 30 | if ".fm" `isSuffixOf` name then do 31 | run (fm_checker_io_file name) 32 | else do 33 | run (fm_checker_io_one name) 34 | -------------------------------------------------------------------------------- /bin/hs/src/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bin/js/package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "formality-js", 3 | "version": "0.2.20", 4 | "lockfileVersion": 2, 5 | "requires": true, 6 | "packages": { 7 | "": { 8 | "name": "formality-js", 9 | "version": "0.2.20", 10 | "license": "MIT", 11 | "dependencies": { 12 | "formcore-lang": "^0.1.17" 13 | }, 14 | "bin": { 15 | "fmjs": "src/main.js" 16 | } 17 | }, 18 | "node_modules/formcore-lang": { 19 | "version": "0.1.17", 20 | "resolved": "https://registry.npmjs.org/formcore-lang/-/formcore-lang-0.1.17.tgz", 21 | "integrity": "sha512-aJ7apOA6Nm5tc6MPGkHRCSk3ksFIAc1FyEIdEVW9aA/bYVkAef/0BCmtv1oZGc3JlaYi6TXtCEp6fDYEgYkFsA==", 22 | "bin": { 23 | "fmc": "main.js" 24 | } 25 | } 26 | }, 27 | "dependencies": { 28 | "formcore-lang": { 29 | "version": "0.1.17", 30 | "resolved": "https://registry.npmjs.org/formcore-lang/-/formcore-lang-0.1.17.tgz", 31 | "integrity": "sha512-aJ7apOA6Nm5tc6MPGkHRCSk3ksFIAc1FyEIdEVW9aA/bYVkAef/0BCmtv1oZGc3JlaYi6TXtCEp6fDYEgYkFsA==" 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /bin/js/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "formality-js", 3 | "version": "0.2.21", 4 | "description": "Formality Language in JavaScript", 5 | "main": "src/formality.js", 6 | "scripts": { 7 | "test": "echo \"Error: no test specified\" && exit 1" 8 | }, 9 | "bin": { 10 | "fmjs": "src/main.js" 11 | }, 12 | "repository": { 13 | "type": "git", 14 | "url": "git+https://github.com/moonad/formality.git" 15 | }, 16 | "author": "Victor Maia", 17 | "license": "MIT", 18 | "bugs": { 19 | "url": "https://github.com/moonad/formality/issues" 20 | }, 21 | "homepage": "https://github.com/moonad/formality#readme", 22 | "dependencies": { 23 | "formcore-lang": "^0.1.17" 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /bin/js/src/cache.js: -------------------------------------------------------------------------------- 1 | var fs = require("fs"); 2 | var path = require("path"); 3 | var cachedir = path.join(__dirname, "../.fmcache"); 4 | var memo_path = key => path.join(cachedir, key); 5 | 6 | function get(key) { 7 | var mpath = memo_path(key); 8 | if (fs.existsSync(mpath)) { 9 | return fs.readFileSync(mpath, "utf8"); 10 | } else { 11 | return null; 12 | } 13 | } 14 | 15 | function set(key,val) { 16 | var mpath = memo_path(key); 17 | if (!fs.existsSync(cachedir)) { 18 | fs.mkdirSync(cachedir); 19 | } 20 | fs.writeFileSync(mpath, val); 21 | return null; 22 | } 23 | 24 | function del(key) { 25 | var mpath = memo_path(key); 26 | if (fs.existsSync(mpath)) { 27 | fs.unlinkSync(mpath); 28 | } 29 | } 30 | 31 | module.exports = {get, set, del}; 32 | 33 | /* 34 | var cache = require("./cache.js"); 35 | if (_done$6) { 36 | var new_cached_term = Fm$Term$show(_term$4); 37 | var new_cached_type = Fm$Term$show(_type$5); 38 | cache.set(_name$3+".cached.term", new_cached_term); 39 | cache.set(_name$3+".cached.type", new_cached_type); 40 | //console.log(""); 41 | //console.log("CACHE ", _name$3); 42 | //console.log("new_cached_type", new_cached_type); 43 | //console.log("new_cached_term", new_cached_term); 44 | return Fm$set(_name$3)(Fm$Def$new(_file$1)(_code$2)(_name$3)(_term$4)(_type$5)(_stat$9))(_defs$7) 45 | } else { 46 | var old_cached_term = cache.get(_name$3+".cached.term"); 47 | var old_cached_type = cache.get(_name$3+".cached.type"); 48 | var old_source_term = cache.get(_name$3+".source.term"); 49 | var old_source_type = cache.get(_name$3+".source.type"); 50 | var new_source_term = Fm$Term$show(_term$4); 51 | var new_source_type = Fm$Term$show(_type$5); 52 | //console.log(""); 53 | //console.log("DEFINE ", _name$3); 54 | //console.log("old_source_type", old_source_type); 55 | //console.log("new_source_type", new_source_type); 56 | //console.log("old_cached_type", old_cached_type); 57 | //console.log("old_source_term", old_source_term); 58 | //console.log("new_source_term", new_source_term); 59 | //console.log("old_cached_term", old_cached_term); 60 | cache.set(_name$3+".source.term", new_source_term); 61 | cache.set(_name$3+".source.type", new_source_type); 62 | cache.del(_name$3+".cached.term"); 63 | cache.del(_name$3+".cached.type"); 64 | if ( old_source_term === new_source_term 65 | && old_source_type === new_source_type 66 | && old_cached_term 67 | && old_cached_type) { 68 | console.log("CACHED!",_name$3); 69 | try { 70 | console.log("cached:", old_cached_term); 71 | var cached_type = Fm$Term$read(old_cached_type).value; 72 | var cached_term = Fm$Term$read(old_cached_term).value; 73 | console.log("cached:", Fm$Term$show(cached_term)); 74 | var cached_type = Fm$Term$bind(List$nil)(Bits$i)(cached_type); 75 | var cached_term = Fm$Term$bind(List$nil)(Bits$o)(cached_term); 76 | console.log("cached:", Fm$Term$show(cached_term)); 77 | console.log("-------"); 78 | return Fm$set(_name$3)(Fm$Def$new(_file$1)(_code$2)(_name$3)(cached_term)(cached_type)(_stat$9))(_defs$7) 79 | } catch (e) { 80 | console.log(e); 81 | } 82 | } 83 | } 84 | 85 | */ 86 | -------------------------------------------------------------------------------- /bin/js/src/main.js: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env node 2 | 3 | var fm = require("./formality.js"); 4 | var fs = require("fs"); 5 | var path = require("path"); 6 | var {fmc_to_js, fmc_to_hs} = require("formcore-lang"); 7 | 8 | if (!process.argv[2] || process.argv[2] === "--help" || process.argv[2] === "-h") { 9 | console.log("# FormalityJS"); 10 | console.log(""); 11 | console.log("Usage:"); 12 | console.log(""); 13 | console.log(" fmjs # type-checks a file"); 14 | console.log(" fmjs
--fmc # compiles to FormCore"); 15 | console.log(" fmjs
--js # compiles to JavaScript"); 16 | console.log(" fmjs
--hs # compiles to Haskell"); 17 | console.log(" fmjs
--run # runs with JavaScript"); 18 | console.log(""); 19 | console.log("Examples:"); 20 | console.log(""); 21 | console.log(" # Check all types inside a file:"); 22 | console.log(" fmjs example.fm"); 23 | console.log(""); 24 | console.log(" # Compile to JS, with 'main' as the entry point:"); 25 | console.log(" fmjs main --js"); 26 | console.log(""); 27 | process.exit(); 28 | } 29 | 30 | 31 | (async () => { 32 | var name = process.argv[2]; 33 | 34 | // FormCore compilation 35 | if (process.argv[3] === "--fmc") { 36 | console.log(await fm.run(fm["Fm.to_core.io.one"](name))); 37 | 38 | // JavaScript compilation 39 | } else if (process.argv[3] === "--js") { 40 | var module = process.argv[4] === "--module"; 41 | try { 42 | var fmcc = await fm.run(fm["Fm.to_core.io.one"](name)); 43 | console.log(fmc_to_js.compile(fmcc, name, {module})); 44 | } catch (e) { 45 | console.log("Compilation error."); 46 | //console.log(e); 47 | } 48 | 49 | // JavaScript execution 50 | } else if (process.argv[3] === "--run") { 51 | try { 52 | var fmcc = await fm.run(fm["Fm.to_core.io.one"](name)); 53 | var asjs = fmc_to_js.compile(fmcc, name, {}); 54 | var js_path = path.join(__dirname,"_formality_tmp_.js"); 55 | try { fs.unlinkSync(js_path); } catch (e) {}; 56 | fs.writeFileSync(js_path, asjs); 57 | require(js_path); 58 | fs.unlinkSync(js_path); 59 | } catch (e) { 60 | console.log("Compilation error."); 61 | //console.log(e); 62 | } 63 | 64 | // Haskell compilation 65 | } else if (process.argv[3] === "--hs") { 66 | var module = process.argv[4] === "--module" ? process.argv[5]||"Main" : null; 67 | try { 68 | var fmcc = await fm.run(fm["Fm.to_core.io.one"](name)); 69 | console.log(fmc_to_hs.compile(fmcc, name, {module})); 70 | } catch (e) { 71 | console.log("Compilation error."); 72 | //console.log(e); 73 | } 74 | 75 | // Type-Checking 76 | } else { 77 | if (name.slice(-3) !== ".fm" && name.slice(-5) !== ".fmfm") { 78 | fm.run(fm["Fm.checker.io.one"](name)); 79 | } else if (name) { 80 | fm.run(fm["Fm.checker.io.file"](name)); 81 | } 82 | } 83 | })(); 84 | -------------------------------------------------------------------------------- /bin/package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "formality-bootstrap", 3 | "version": "0.1.0", 4 | "lockfileVersion": 2, 5 | "requires": true, 6 | "packages": { 7 | "": { 8 | "name": "formality-bootstrap", 9 | "version": "0.1.0", 10 | "license": "MIT", 11 | "dependencies": { 12 | "formality-lang": "^0.5.1", 13 | "formcore-lang": "^0.1.17" 14 | } 15 | }, 16 | "node_modules/formality-lang": { 17 | "version": "0.5.1", 18 | "resolved": "https://registry.npmjs.org/formality-lang/-/formality-lang-0.5.1.tgz", 19 | "integrity": "sha512-dOZG0pS2Ca84I4WBBWOC//SV2EUGf5UnlgiIYtJNuFGoDvxmq2BPtJY/2KrxYO3HUO/5MPnkJar75Gsx6OY1qw==", 20 | "dependencies": { 21 | "xmlhttprequest": "^1.8.0" 22 | }, 23 | "bin": { 24 | "evm2fm": "bin/evm2fm.js", 25 | "evmfm": "bin/evm2fm.js", 26 | "fm": "bin/fm.js", 27 | "fm2evm": "bin/fm2evm.js", 28 | "fm2fmc": "bin/fm2fmc.js", 29 | "fm2js": "bin/fm2js.js", 30 | "fmc": "bin/fmc.js", 31 | "fmevm": "bin/fm2evm.js", 32 | "fmfast": "bin/fmfast.js", 33 | "fmfmc": "bin/fm2fmc.js", 34 | "fmio": "bin/fmio.js", 35 | "fmjs": "bin/fm2js.js", 36 | "fmopt": "bin/fmopt.js", 37 | "fms": "bin/fms.js" 38 | } 39 | }, 40 | "node_modules/formcore-lang": { 41 | "version": "0.1.17", 42 | "resolved": "https://registry.npmjs.org/formcore-lang/-/formcore-lang-0.1.17.tgz", 43 | "integrity": "sha512-aJ7apOA6Nm5tc6MPGkHRCSk3ksFIAc1FyEIdEVW9aA/bYVkAef/0BCmtv1oZGc3JlaYi6TXtCEp6fDYEgYkFsA==", 44 | "bin": { 45 | "fmc": "main.js" 46 | } 47 | }, 48 | "node_modules/xmlhttprequest": { 49 | "version": "1.8.0", 50 | "resolved": "https://registry.npmjs.org/xmlhttprequest/-/xmlhttprequest-1.8.0.tgz", 51 | "integrity": "sha1-Z/4HXFwk/vOfnWX197f+dRcZaPw=", 52 | "engines": { 53 | "node": ">=0.4.0" 54 | } 55 | } 56 | }, 57 | "dependencies": { 58 | "formality-lang": { 59 | "version": "0.5.1", 60 | "resolved": "https://registry.npmjs.org/formality-lang/-/formality-lang-0.5.1.tgz", 61 | "integrity": "sha512-dOZG0pS2Ca84I4WBBWOC//SV2EUGf5UnlgiIYtJNuFGoDvxmq2BPtJY/2KrxYO3HUO/5MPnkJar75Gsx6OY1qw==", 62 | "requires": { 63 | "xmlhttprequest": "^1.8.0" 64 | } 65 | }, 66 | "formcore-lang": { 67 | "version": "0.1.17", 68 | "resolved": "https://registry.npmjs.org/formcore-lang/-/formcore-lang-0.1.17.tgz", 69 | "integrity": "sha512-aJ7apOA6Nm5tc6MPGkHRCSk3ksFIAc1FyEIdEVW9aA/bYVkAef/0BCmtv1oZGc3JlaYi6TXtCEp6fDYEgYkFsA==" 70 | }, 71 | "xmlhttprequest": { 72 | "version": "1.8.0", 73 | "resolved": "https://registry.npmjs.org/xmlhttprequest/-/xmlhttprequest-1.8.0.tgz", 74 | "integrity": "sha1-Z/4HXFwk/vOfnWX197f+dRcZaPw=" 75 | } 76 | } 77 | } 78 | -------------------------------------------------------------------------------- /bin/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "formality-bootstrap", 3 | "version": "0.1.0", 4 | "description": "", 5 | "main": "bootstrap.js", 6 | "scripts": { 7 | "test": "echo \"Error: no test specified\" && exit 1" 8 | }, 9 | "author": "", 10 | "license": "MIT", 11 | "dependencies": { 12 | "formality-lang": "^0.5.1", 13 | "formcore-lang": "^0.1.17" 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /blog/0-goodbye-javascript.md: -------------------------------------------------------------------------------- 1 | Goodbye, JavaScript! 2 | ==================== 3 | 4 | Formality has now received its largest and most important update to date: its 5 | entire implementation was rewritten in itself! That means its parser, 6 | type-checker, interpreter, unifier and so on are now contained in a Formality 7 | file, [Fm.fm](https://github.com/moonad/FormalityFM/blob/master/src/Fm.fm). That 8 | file is then compiled to multiple back-ends, including 9 | [JavaScript](https://github.com/moonad/FormalityFM/blob/master/bin/js/src/formality.js), 10 | [Haskell](https://github.com/moonad/FormalityFM/blob/master/bin/hs/src/FormalityInternal.hs) 11 | and, in a future, Scheme, Clojure and others. That means Formality programs can 12 | run be imported inside virtually any language; and, of course, since Formality 13 | is written itself, you can also import its type-checker as a library, anywhere. 14 | Our reliance on JavaScript is finally over, and the jump in code quality is 15 | unprecedented, as the whole language is formalized in a proof assistant: itself! 16 | 17 | ### Becoming a mature language 18 | 19 | That marks the beginning of a new era for Formality: one where it stops being a 20 | research project, towards becoming a language that is mature, stable, productive 21 | and joyful to use. One that developers and mathematicians can use to write 22 | types, algorithms, theorems and proofs. Compared to most alternatives, 23 | Formality's type-checker is, by far, the fastest on the market, Formality's 24 | compiled binaries are the most efficient, Formality's syntax is terser and more 25 | modern. And it will only get better: since we're so confident on the quality of 26 | our new codebase, we're able to add features, without fearing breaking old code, 27 | or having to maintain even more JavaScript. This open doors for a flood of 28 | future improvements that will make Formality evolve at unprecedented rates. 29 | 30 | ### Abandoning experimental ideas 31 | 32 | Formality's vision also changed in some substantial ways. For a long time, we 33 | focused aspects that were, at best, experimental. While that was important to 34 | shape the language we have today, as we mature towards the goal of becoming 35 | ready for the market, some ideas must be abandoned in favor of these that are 36 | proven to work: that's evolution at its finest. Specifically, that means we no 37 | longer consider minimalism or interaction nets as core aspects. The goal of 38 | being portable is achieved by being bootstrapped and having a small core, but 39 | the language is now meant to grow. Moreover, we now consider ourselves 40 | computation agnostic: Formality isn't strict nor lazy, nor attached to any 41 | particular evaluation method. Instead, we rely on multiple back-ends to evaluate 42 | the programs we write on it. 43 | 44 | ### Formality's vision 45 | 46 | Ultimately, Formality's vision is simple: we want it to leverage concepts of 47 | type theory to create the ultimate programming language. One that unifies 48 | programming and mathematics. One that is fast and minimal, but also joyful to 49 | use, modern-looking and productive. We want to use formal proofs and dependent 50 | types not just as tools for security, but as a way to completely rethink the way 51 | we write software, letting developers reach unforeseen levels of productivity 52 | and code quality. 53 | 54 | ### A new way of writting software 55 | 56 | (write about provit's development model) 57 | 58 | (several concrete examples of how it'd work) 59 | 60 | 61 | -------------------------------------------------------------------------------- /src/Bit.fm: -------------------------------------------------------------------------------- 1 | type Bit { 2 | o, 3 | i, 4 | } 5 | 6 | Bit.not(b: Bit): Bit 7 | case b { 8 | o: Bit.i, 9 | i: Bit.o, 10 | } 11 | -------------------------------------------------------------------------------- /src/Bits.fm: -------------------------------------------------------------------------------- 1 | type Bits { 2 | e, 3 | o(pred: Bits), 4 | i(pred: Bits), 5 | } 6 | 7 | Bits.inc(a: Bits): Bits 8 | case a { 9 | e: Bits.i(Bits.e), 10 | o: Bits.i(a.pred), 11 | i: Bits.o(Bits.inc(a.pred)), 12 | } 13 | 14 | Bits.add(a: Bits, b: Bits): Bits 15 | case b { 16 | e: a, 17 | o: case a { 18 | e: b, 19 | o: Bits.o(Bits.add(a.pred, b.pred)), 20 | i: Bits.i(Bits.add(a.pred, b.pred)), 21 | }, 22 | i: case a { 23 | e: b, 24 | o: Bits.i(Bits.add(a.pred, b.pred)), 25 | i: Bits.o(Bits.add(Bits.inc(a.pred), b.pred)) 26 | } 27 | } 28 | 29 | Bits.eql(a: Bits, b: Bits): Bool 30 | case a { 31 | e: case b { 32 | e: Bool.true, 33 | o: Bool.false, 34 | i: Bool.false, 35 | }, 36 | o: case b { 37 | e: Bool.false, 38 | o: Bits.eql(a.pred, b.pred), 39 | i: Bool.false, 40 | }, 41 | i: case b { 42 | e: Bool.false, 43 | o: Bool.false, 44 | i: Bits.eql(a.pred, b.pred), 45 | } 46 | } 47 | 48 | Bits.tail(a: Bits): Bits 49 | case a { 50 | e: Bits.e, 51 | o: a.pred, 52 | i: a.pred, 53 | } 54 | 55 | Bits.show(a: Bits): String 56 | case a { 57 | e: "", 58 | o: String.cons('0', Bits.show(a.pred)), 59 | i: String.cons('1', Bits.show(a.pred)), 60 | } 61 | 62 | Bits.reverse(a: Bits): Bits 63 | Bits.reverse.tco(a, Bits.e) 64 | 65 | Bits.reverse.tco(a: Bits, r: Bits): Bits 66 | case a { 67 | e: r, 68 | o: Bits.reverse.tco(a.pred, Bits.o(r)), 69 | i: Bits.reverse.tco(a.pred, Bits.i(r)) 70 | } 71 | 72 | Bits.concat(a: Bits, b: Bits): Bits 73 | case a { 74 | e: b, 75 | o: Bits.o(Bits.concat(a.pred, b)), 76 | i: Bits.i(Bits.concat(a.pred, b)) 77 | } 78 | 79 | Bits.chunks_of.go( 80 | len : Nat, // length of each chunk 81 | bits : Bits, // bits to be split 82 | need : Nat, // number of vals to complete chunk 83 | chunk : Bits // current chunk 84 | ) : List(Bits) 85 | case bits { 86 | e: List.cons<_>(Bits.reverse(chunk), List.nil<_>), 87 | o: case need { 88 | zero: 89 | let head = Bits.reverse(chunk); 90 | let tail = Bits.chunks_of.go(len, bits, len, Bits.e); 91 | List.cons<_>(head, tail), 92 | succ: 93 | let chunk = Bits.o(chunk); 94 | Bits.chunks_of.go(len, bits.pred, need.pred, chunk) 95 | }, 96 | i: case need { 97 | zero: 98 | let head = Bits.reverse(chunk); 99 | let tail = Bits.chunks_of.go(len, bits, len, Bits.e); 100 | List.cons<_>(head, tail), 101 | succ: 102 | let chunk = Bits.i(chunk); 103 | Bits.chunks_of.go(len, bits.pred, need.pred, chunk) 104 | } 105 | } 106 | 107 | Bits.chunks_of(len: Nat, bits: Bits): List(Bits) 108 | Bits.chunks_of.go(len, bits, len, Bits.e) 109 | 110 | Bits.to_nat(b: Bits): Nat 111 | case b { 112 | e: 0, 113 | o: Nat.mul(2, Bits.to_nat(b.pred)), 114 | i: Nat.succ(Nat.mul(2, Bits.to_nat(b.pred))) 115 | } 116 | 117 | -------------------------------------------------------------------------------- /src/Bool.fm: -------------------------------------------------------------------------------- 1 | type Bool { 2 | true, 3 | false, 4 | } 5 | 6 | Bool.not(a: Bool): Bool 7 | case a { 8 | true: Bool.false, 9 | false: Bool.true, 10 | } 11 | 12 | Bool.and(a: Bool, b: Bool): Bool 13 | case a { 14 | true: b, 15 | false: Bool.false, 16 | } 17 | 18 | Bool.or(a: Bool, b: Bool): Bool 19 | case a { 20 | true: Bool.true, 21 | false: b, 22 | } 23 | 24 | Bool.eql(a: Bool, b: Bool): Bool 25 | case a { 26 | true: b, 27 | false: Bool.not(b), 28 | } 29 | 30 | // Converts to a string 31 | Bool.show(b: Bool): String 32 | case b{ 33 | true : "Bool.true" 34 | false: "Bool.false" 35 | } 36 | 37 | // If-then-else 38 | Bool.if(cond: Bool, true_case: A, false_case: A): A 39 | case cond{ 40 | true : true_case 41 | false: false_case 42 | } 43 | -------------------------------------------------------------------------------- /src/Char.fm: -------------------------------------------------------------------------------- 1 | Char: Type 2 | U16 3 | 4 | Char.new( 5 | b0: Bit, b1: Bit, b2: Bit, b3: Bit, 6 | b4: Bit, b5: Bit, b6: Bit, b7: Bit, 7 | b8: Bit, b9: Bit, bA: Bit, bB: Bit, 8 | bC: Bit, bD: Bit, bE: Bit, bF: Bit, 9 | ): U16 10 | let kF = b0<(x) Word( 0) -> Word( 1)>(Word.o<_>, Word.i<_>); 11 | let kE = b1<(x) Word( 1) -> Word( 2)>(Word.o<_>, Word.i<_>); 12 | let kD = b2<(x) Word( 2) -> Word( 3)>(Word.o<_>, Word.i<_>); 13 | let kC = b3<(x) Word( 3) -> Word( 4)>(Word.o<_>, Word.i<_>); 14 | let kB = b4<(x) Word( 4) -> Word( 5)>(Word.o<_>, Word.i<_>); 15 | let kA = b5<(x) Word( 5) -> Word( 6)>(Word.o<_>, Word.i<_>); 16 | let k9 = b6<(x) Word( 6) -> Word( 7)>(Word.o<_>, Word.i<_>); 17 | let k8 = b7<(x) Word( 7) -> Word( 8)>(Word.o<_>, Word.i<_>); 18 | let k7 = b8<(x) Word( 8) -> Word( 9)>(Word.o<_>, Word.i<_>); 19 | let k6 = b9<(x) Word( 9) -> Word(10)>(Word.o<_>, Word.i<_>); 20 | let k5 = bA<(x) Word(10) -> Word(11)>(Word.o<_>, Word.i<_>); 21 | let k4 = bB<(x) Word(11) -> Word(12)>(Word.o<_>, Word.i<_>); 22 | let k3 = bC<(x) Word(12) -> Word(13)>(Word.o<_>, Word.i<_>); 23 | let k2 = bD<(x) Word(13) -> Word(14)>(Word.o<_>, Word.i<_>); 24 | let k1 = bE<(x) Word(14) -> Word(15)>(Word.o<_>, Word.i<_>); 25 | let k0 = bF<(x) Word(15) -> Word(16)>(Word.o<_>, Word.i<_>); 26 | let kx = Word.e; 27 | U16.new(k0(k1(k2(k3(k4(k5(k6(k7(k8(k9(kA(kB(kC(kD(kE(kF(kx))))))))))))))))) 28 | 29 | Char.eql(a: Char, b: Char): Bool 30 | U16.eql(a, b) 31 | -------------------------------------------------------------------------------- /src/Cmp.fm: -------------------------------------------------------------------------------- 1 | type Cmp { 2 | ltn, 3 | eql, 4 | gtn, 5 | } 6 | 7 | // n == m 8 | Cmp.as_eql(cmp: Cmp): Bool 9 | case cmp { 10 | ltn: Bool.false, 11 | eql: Bool.true, 12 | gtn: Bool.false, 13 | } 14 | 15 | // n >= m 16 | Cmp.as_gte(cmp: Cmp): Bool 17 | case cmp { 18 | ltn: Bool.false, 19 | eql: Bool.true, 20 | gtn: Bool.true, 21 | } 22 | 23 | // n > m 24 | Cmp.as_gtn(cmp: Cmp): Bool 25 | case cmp { 26 | ltn: Bool.false, 27 | eql: Bool.false, 28 | gtn: Bool.true, 29 | } 30 | 31 | // n <= m 32 | Cmp.as_lte(cmp: Cmp): Bool 33 | case cmp { 34 | ltn: Bool.true, 35 | eql: Bool.true, 36 | gtn: Bool.false, 37 | } 38 | 39 | // n < m 40 | Cmp.as_ltn(cmp: Cmp): Bool 41 | case cmp { 42 | ltn: Bool.true, 43 | eql: Bool.false, 44 | gtn: Bool.false, 45 | } 46 | 47 | -------------------------------------------------------------------------------- /src/Debug.fm: -------------------------------------------------------------------------------- 1 | // Logs to the console 2 | Debug.log(s: String, x: Unit -> A): A 3 | x(Unit.new) 4 | 5 | -------------------------------------------------------------------------------- /src/Either.fm: -------------------------------------------------------------------------------- 1 | type Either { 2 | left(value: A), 3 | right(value: B), 4 | } 5 | 6 | -------------------------------------------------------------------------------- /src/Empty.fm: -------------------------------------------------------------------------------- 1 | type Empty { 2 | } 3 | 4 | // If we have an element of the empty type, then we can prove anything. 5 | Empty.absurd(x: Empty): P 6 | case x {} 7 | 8 | -------------------------------------------------------------------------------- /src/Equal.fm: -------------------------------------------------------------------------------- 1 | type Equal (a: A) ~ (b: A) { 2 | refl ~ (b: a) 3 | } 4 | 5 | Equal.mirror(e: Equal(A, a, b)): Equal(A, b, a) 6 | case e { 7 | refl: Equal.refl 8 | } : Equal(A, e.b, a) 9 | 10 | Equal.rewrite Type>(e: Equal(A,a,b), x: P(a)): P(b) 11 | case e { 12 | refl: x 13 | } : P(e.b) 14 | 15 | Equal.apply B>(e: Equal(A,a,b)): Equal(B, f(a), f(b)) 16 | case e { 17 | refl: Equal.refl 18 | } : Equal(B, f(a), f(e.b)) 19 | 20 | Equal.chain(d: Equal(A,a,b), e: Equal(A,b,c)): Equal(A,a,c) 21 | case e { 22 | refl: d 23 | } : Equal(A, a, e.b) 24 | -------------------------------------------------------------------------------- /src/Fm.fm: -------------------------------------------------------------------------------- 1 | // Types 2 | // ===== 3 | 4 | // A Formality Letter is a character in: [A-Za-z0-9._] 5 | Fm.Letter: Type 6 | Char 7 | 8 | // A Formality Name is a string of letters 9 | Fm.Name: Type 10 | String 11 | 12 | // A Formality term (high-order) 13 | type Fm.Term { 14 | // A variable bound by another constructor 15 | var( 16 | name: Fm.Name, // the variable name, used for pretty printing 17 | indx: Nat, // the variable bruijn level, used for equality and binding 18 | ), 19 | // A reference to a top-level definition 20 | ref( 21 | name: Fm.Name, // the reference name 22 | ), 23 | // The type of types 24 | typ, 25 | // The self-dependent function type (self-Pi) 26 | all( 27 | eras: Bool, // if it is erased at runtime 28 | self: Fm.Name, // the term name 29 | name: Fm.Name, // the input name 30 | xtyp: Fm.Term, // the input type 31 | body: Fm.Term -> Fm.Term -> Fm.Term, // the returned type 32 | ), 33 | // An anonymous function (lambda) 34 | lam( 35 | name: Fm.Name, // the input name 36 | body: Fm.Term -> Fm.Term, // the returned body 37 | ), 38 | // A function application 39 | app( 40 | func: Fm.Term, // the function 41 | argm: Fm.Term, // the argument 42 | ), 43 | // A local definition 44 | let( 45 | name: Fm.Name, // the expression name 46 | expr: Fm.Term, // the expression value 47 | body: Fm.Term -> Fm.Term, // the body where name=value 48 | ), 49 | // A local alias 50 | def( 51 | name: Fm.Name, // the expression name 52 | expr: Fm.Term, // the expression value 53 | body: Fm.Term -> Fm.Term, // the body where name=value 54 | ), 55 | // An inline annotation 56 | ann( 57 | done: Bool, // was this type-checked? 58 | term: Fm.Term, // the annotated term 59 | type: Fm.Term, // the annotated type 60 | ), 61 | // A hole to show the goal 62 | gol( 63 | name: Fm.Name, // the goal's name 64 | dref: List(Bits), // a list of labels to expand when displaying it 65 | verb: Bool, // show labels of expandable terms? 66 | ), 67 | // A hole to be auto-filled 68 | hol( 69 | path: Bits, 70 | ), 71 | // A natural number 72 | nat( 73 | natx: Nat, 74 | ), 75 | // A character 76 | chr( 77 | chrx: Char, 78 | ), 79 | // A string 80 | str( 81 | strx: String, 82 | ), 83 | // A case-of expression 84 | cse( 85 | path: Bits, 86 | expr: Fm.Term, 87 | name: Fm.Name, 88 | with: List(Fm.Def), 89 | cses: Map(Fm.Term), 90 | moti: Maybe(Fm.Term), 91 | ), 92 | // An origin 93 | ori( 94 | orig: Fm.Origin, 95 | expr: Fm.Term, 96 | ) 97 | } 98 | 99 | type Fm.Origin { 100 | new( 101 | file: String, 102 | from: Nat, 103 | upto: Nat, 104 | ) 105 | } 106 | 107 | // A primitive type ( 108 | type Fm.Prim { 109 | bool, 110 | nat, 111 | u16, 112 | string, 113 | data(ctrs: List(Nat)), 114 | //bits, 115 | } 116 | 117 | // A compilable term intermediate format 118 | type Fm.Comp { 119 | nil, 120 | var(name: Fm.Name), 121 | ref(name: Fm.Name), 122 | lam(name: Fm.Name, body: Fm.Comp), 123 | app(func: Fm.Comp, argm: Fm.Comp), 124 | let(name: Fm.Name, expr: Fm.Comp, body: Fm.Comp), 125 | eli(prim: Fm.Prim, expr: Fm.Comp), 126 | ins(prim: Fm.Prim, expr: Fm.Comp), 127 | nat(natx: Nat), 128 | chr(chrx: Char), 129 | str(strx: String), 130 | } 131 | 132 | // A constructor 133 | type Fm.Constructor { 134 | new( 135 | name: Fm.Name, 136 | args: List(Fm.Binder), 137 | inds: List(Fm.Binder), 138 | ) 139 | } 140 | 141 | // An algebraic datatype 142 | type Fm.Datatype { 143 | new( 144 | name: Fm.Name, 145 | pars: List(Fm.Binder), 146 | inds: List(Fm.Binder), 147 | ctrs: List(Fm.Constructor), 148 | ) 149 | } 150 | 151 | // A type error 152 | type Fm.Error { 153 | // Two types do not match 154 | type_mismatch( 155 | origin: Maybe(Fm.Origin), 156 | expected: Either(String, Fm.Term), 157 | detected: Either(String, Fm.Term), 158 | context: Fm.Context, 159 | ), 160 | // Found a goal to be shown 161 | show_goal( 162 | name: Fm.Name, 163 | dref: List(Bits), 164 | verb: Bool, 165 | goal: Maybe(Fm.Term), 166 | context: Fm.Context, 167 | ), 168 | // Waits for another term's type checking 169 | waiting( 170 | name: Fm.Name, 171 | ), 172 | // Error in a dependency 173 | indirect( 174 | name: Fm.Name, 175 | ), 176 | // Patch the original term 177 | patch( 178 | path: Bits, 179 | term: Fm.Term, 180 | ), 181 | // Some reference isn't found 182 | undefined_reference( 183 | origin: Maybe(Fm.Origin), 184 | name: Fm.Name, 185 | ), 186 | // A lambda without a type 187 | cant_infer( 188 | origin: Maybe(Fm.Origin), 189 | term: Fm.Term, 190 | context: Fm.Context, 191 | ), 192 | } 193 | 194 | // The result of a type-checking attempt 195 | type Fm.Check { 196 | result( 197 | value: Maybe(V), // the returned value 198 | errors: List(Fm.Error), // a list of errors 199 | ), 200 | } 201 | 202 | // Status of a type-checking process 203 | type Fm.Status { 204 | init, 205 | wait, 206 | done, 207 | fail(errors: List(Fm.Error)), 208 | } 209 | 210 | // A top-level definition 211 | type Fm.Def { 212 | new( 213 | file: String, 214 | code: String, 215 | name: Fm.Name, 216 | term: Fm.Term, 217 | type: Fm.Term, 218 | stat: Fm.Status, 219 | ), 220 | } 221 | 222 | type Fm.Binder { 223 | new( 224 | eras: Bool, 225 | name: Fm.Name, 226 | term: Fm.Term, 227 | ) 228 | } 229 | 230 | // A map from Names to definitions 231 | Fm.Defs: Type 232 | Map(Fm.Def) 233 | 234 | // A context is a list of (name, term) pairs 235 | Fm.Context: Type 236 | List(Pair(Fm.Name,Fm.Term)) 237 | 238 | // A path 239 | Fm.Path: Type 240 | Bits -> Bits 241 | 242 | // Maybe a path 243 | Fm.MPath: Type 244 | Maybe(Fm.Path) 245 | 246 | // Paths 247 | // ===== 248 | 249 | Fm.Path.to_bits(path: Fm.Path): Bits 250 | path(Bits.e) 251 | 252 | Fm.Path.nil: Fm.Path 253 | (x) x 254 | 255 | Fm.Path.o(path: Fm.Path): Fm.Path 256 | (x) path(Bits.o(x)) 257 | 258 | Fm.Path.i(path: Fm.Path): Fm.Path 259 | (x) path(Bits.i(x)) 260 | 261 | Fm.MPath.to_bits(path: Maybe(Fm.Path)): Bits 262 | case path { 263 | none: Bits.e, 264 | some: path.value(Bits.e), 265 | } 266 | 267 | Fm.MPath.nil: Maybe(Fm.Path) 268 | Maybe.some<_>(Fm.Path.nil) 269 | 270 | Fm.MPath.o(path: Maybe(Fm.Path)): Maybe(Fm.Path) 271 | Maybe.mapped<_>(path)<_>(Fm.Path.o) 272 | 273 | Fm.MPath.i(path: Maybe(Fm.Path)): Maybe(Fm.Path) 274 | Maybe.mapped<_>(path)<_>(Fm.Path.i) 275 | 276 | // Contexts 277 | // ======== 278 | 279 | // Gets a core term from a map by its name 280 | Fm.get(name: Fm.Name, map: Map(A)): Maybe(A) 281 | Map.get(Fm.Name.to_bits(name), map) 282 | 283 | // Adds a name, core term pair to a map 284 | Fm.set(name: Fm.Name, val: A, map: Map(A)): Map(A) 285 | Map.set(Fm.Name.to_bits(name), val, map) 286 | 287 | // Finds a value in a context 288 | Fm.Context.find(name: Fm.Name, ctx: Fm.Context): Maybe(Fm.Term) 289 | case ctx { 290 | nil: 291 | Maybe.none<_>, 292 | cons: 293 | case ctx.head { 294 | new: 295 | if Fm.Name.eql(name, ctx.head.fst) then 296 | Maybe.some<_>(ctx.head.snd) 297 | else 298 | Fm.Context.find(name, ctx.tail) 299 | } 300 | } 301 | 302 | // Gets the names of a context 303 | Fm.Context.names(ctx: Fm.Context): List(Fm.Name) 304 | List.mapped<_>(ctx)<_>((x) Pair.fst<_,_>(x)) 305 | 306 | // Stringification 307 | // =============== 308 | 309 | Fm.Error.origin(error: Fm.Error): Maybe(Fm.Origin) 310 | case error { 311 | type_mismatch: error.origin, 312 | waiting: Maybe.none<_>, 313 | indirect: Maybe.none<_>, 314 | show_goal: Maybe.none<_>, 315 | patch: Maybe.none<_>, 316 | undefined_reference: error.origin, 317 | cant_infer: error.origin, 318 | } 319 | 320 | // Stringifies an error 321 | Fm.Error.show(error: Fm.Error, defs: Fm.Defs): String 322 | case error { 323 | type_mismatch: 324 | let expected = case error.expected { 325 | left: error.expected.value, 326 | right: Fm.Term.show(Fm.Term.normalize(error.expected.value, Map.new<_>)), 327 | }; 328 | let detected = case error.detected { 329 | left: error.detected.value, 330 | right: Fm.Term.show(Fm.Term.normalize(error.detected.value, Map.new<_>)), 331 | }; 332 | String.flatten([ 333 | "Type mismatch.\n", 334 | "- Expected: ", expected, "\n", 335 | "- Detected: ", detected, "\n", 336 | case error.context { 337 | nil : "", 338 | cons: String.flatten(["With context:\n", Fm.Context.show(error.context)]), 339 | }, 340 | ]), 341 | waiting: 342 | String.flatten([ 343 | "Waiting for '", error.name, "'." 344 | ]), 345 | indirect: 346 | String.flatten([ 347 | "Error on dependency '", error.name, "'." 348 | ]), 349 | show_goal: 350 | let goal_name = String.flatten(["Goal ?", Fm.Name.show(error.name), ":\n"]); 351 | let with_type = case error.goal { 352 | none: "", 353 | some: 354 | let goal = Fm.Term.expand(error.dref, error.goal.value, defs); 355 | String.flatten([ 356 | "With type: ", 357 | if error.verb then 358 | Fm.Term.show.go(goal, Maybe.some Bits>((x) x)) 359 | else 360 | Fm.Term.show(goal), 361 | "\n", 362 | ]), 363 | }; 364 | let with_ctxt = case error.context { 365 | nil: "", 366 | cons: String.flatten([ 367 | "With ctxt:\n", 368 | Fm.Context.show(error.context), 369 | ]), 370 | }; 371 | String.flatten([goal_name, with_type, with_ctxt]), 372 | patch: 373 | String.flatten([ 374 | "Patching: ", Fm.Term.show(error.term), 375 | ]), 376 | undefined_reference: 377 | String.flatten([ 378 | "Undefined reference: ", Fm.Name.show(error.name), "\n", 379 | ]), 380 | cant_infer: 381 | let term = Fm.Term.show(error.term); 382 | let context = Fm.Context.show(error.context); 383 | String.flatten([ 384 | "Can't infer type of: ", term, "\n", 385 | "With ctxt:\n", context, 386 | ]) 387 | } 388 | 389 | // Return the first type error, plus all hole errors. 390 | Fm.Error.relevant(errors: List(Fm.Error), got: Bool): List(Fm.Error) 391 | case errors { 392 | nil: 393 | List.nil, 394 | cons: 395 | let keep = case errors.head { 396 | type_mismatch: Bool.not(got), 397 | show_goal: Bool.true, 398 | waiting: Bool.false, 399 | indirect: Bool.false, 400 | patch: Bool.false, 401 | undefined_reference: Bool.not(got), 402 | cant_infer: Bool.not(got), 403 | }; 404 | let got = case errors.head { 405 | type_mismatch: Bool.true, 406 | show_goal: got, 407 | waiting: got, 408 | indirect: got, 409 | patch: got, 410 | undefined_reference: Bool.true, 411 | cant_infer: got, 412 | }; 413 | let tail = Fm.Error.relevant(errors.tail, got); 414 | if keep then 415 | List.cons<_>(errors.head, tail) 416 | else 417 | tail 418 | } 419 | 420 | // Stringifies a context 421 | Fm.Context.show(context: Fm.Context): String 422 | case context { 423 | nil: "", 424 | cons: case context.head { 425 | new: 426 | let name = Fm.Name.show(context.head.fst); 427 | let type = Fm.Term.show(context.head.snd); 428 | let rest = Fm.Context.show(context.tail); 429 | String.flatten([ 430 | rest, 431 | "- ", 432 | name, 433 | ": ", 434 | type, 435 | "\n", 436 | ]) 437 | } 438 | } 439 | 440 | // Attempts to view a term as a Nat literal 441 | Fm.Term.show.as_nat.go(term: Fm.Term): Maybe(Nat) 442 | case term { 443 | app: case term.func { 444 | ref: 445 | if String.eql(term.func.name, "Nat.succ") then do Maybe { 446 | var pred = Fm.Term.show.as_nat.go(term.argm); 447 | return Nat.succ(pred); 448 | } else 449 | Maybe.none<_>, 450 | _: Maybe.none<_>, 451 | }, 452 | ref: 453 | if String.eql(term.name, "Nat.zero") then 454 | Maybe.some<_>(0) 455 | else 456 | Maybe.none<_>, 457 | _: Maybe.none<_>, 458 | } 459 | 460 | Fm.Term.show.as_nat(term: Fm.Term): Maybe(String) 461 | Maybe.mapped<_>(Fm.Term.show.as_nat.go(term))<_>(Nat.show) 462 | 463 | Fm.color(col: String, str: String): String 464 | String.cons(Nat.to_u16(27), 465 | String.cons('[', 466 | String.concat(col, 467 | String.cons('m', 468 | String.concat(str, 469 | String.cons(Nat.to_u16(27), 470 | String.cons('[', 471 | String.cons('0', 472 | String.cons('m', 473 | String.nil))))))))) 474 | 475 | Fm.Term.show.is_ref(term: Fm.Term, name: Fm.Name): Bool 476 | case term { 477 | ref: String.eql(name, term.name), 478 | _: Bool.false, 479 | } 480 | 481 | Fm.Term.show.app(term: Fm.Term, path: Maybe(Bits -> Bits), args: List(String)): String 482 | case term { 483 | app: 484 | let argm = Fm.Term.show.go(term.argm, Fm.MPath.i(path)); 485 | Fm.Term.show.app(term.func, Fm.MPath.o(path), List.cons<_>(argm, args)), 486 | _: 487 | let arity = List.length<_>(args); 488 | if Bool.and(Fm.Term.show.is_ref(term,"Equal"), Nat.eql(arity,3)) then 489 | let func = Fm.Term.show.go(term, path); 490 | let eq_lft = Maybe.default<_>("?", List.at<_>(1, args)); 491 | let eq_rgt = Maybe.default<_>("?", List.at<_>(2, args)); 492 | String.flatten([eq_lft, " == ", eq_rgt]) 493 | else 494 | let func = Fm.Term.show.go(term, path); 495 | let wrap = case func {nil: Bool.false, cons: U16.eql(func.head,'(')}; 496 | let args = String.join(",", args); 497 | let func = if wrap then String.flatten(["(",func,")"]) else func; 498 | String.flatten([func, "(", args, ")"]), 499 | } 500 | 501 | // SHOW: Stringifies a term 502 | Fm.Term.show.go(term: Fm.Term, path: Maybe(Bits -> Bits)): String 503 | case Fm.Term.show.as_nat(term) as as_nat { 504 | some: as_nat.value, 505 | none: case term { 506 | ref: 507 | let name = Fm.Name.show(term.name); 508 | case path { 509 | none: 510 | name, 511 | //String.flatten(["$", name]), 512 | some: 513 | let path_val = Bits.concat(Fm.Path.to_bits(path.value), Bits.i(Bits.e)); 514 | let path_str = Nat.show(Bits.to_nat(path_val)); 515 | String.flatten([name, Fm.color("2", String.concat("-", path_str))]), 516 | }, 517 | var: 518 | Fm.Name.show(term.name), 519 | //String.flatten([Fm.Name.show(term.name), "#", Nat.show(term.indx)]), 520 | typ: 521 | "Type", 522 | all: 523 | let eras = term.eras; 524 | let self = Fm.Name.show(term.self); 525 | let name = Fm.Name.show(term.name); 526 | let type = Fm.Term.show.go(term.xtyp, Fm.MPath.o(path)); 527 | let open = if eras then "<" else "("; 528 | let clos = if eras then ">" else ")"; 529 | let body = Fm.Term.show.go( 530 | term.body( 531 | Fm.Term.var(term.self, 0), 532 | Fm.Term.var(term.name, 0)), 533 | Fm.MPath.i(path)); 534 | String.flatten([self,open,name,":",type,clos," ",body]), 535 | lam: 536 | let name = Fm.Name.show(term.name); 537 | let body = Fm.Term.show.go( 538 | term.body(Fm.Term.var(term.name, 0)), 539 | Fm.MPath.o(path)); 540 | String.flatten(["(",name,") ",body]), 541 | app: Fm.Term.show.app(term, path, List.nil<_>), 542 | let: 543 | let name = Fm.Name.show(term.name); 544 | let expr = Fm.Term.show.go(term.expr, Fm.MPath.o(path)); 545 | let body = Fm.Term.show.go( 546 | term.body(Fm.Term.var(term.name, 0)), 547 | Fm.MPath.i(path)); 548 | String.flatten(["let ", name, " = ", expr, "; ", body]), 549 | def: 550 | let name = Fm.Name.show(term.name); 551 | let expr = Fm.Term.show.go(term.expr, Fm.MPath.o(path)); 552 | let body = Fm.Term.show.go( 553 | term.body(Fm.Term.var(term.name, 0)), 554 | Fm.MPath.i(path)); 555 | String.flatten(["def ", name, " = ", expr, "; ", body]), 556 | ann: 557 | let term = Fm.Term.show.go(term.term, Fm.MPath.o(path)); 558 | let type = Fm.Term.show.go(term.type, Fm.MPath.i(path)); 559 | String.flatten([term,"::",type]), 560 | gol: 561 | let name = Fm.Name.show(term.name); 562 | String.flatten(["?", name]), 563 | hol: 564 | "_", 565 | nat: 566 | String.flatten([Nat.show(term.natx)]), 567 | chr: 568 | String.flatten(["'", Fm.escape.char(term.chrx), "'"]), 569 | str: 570 | String.flatten(["\"", Fm.escape(term.strx), "\""]), 571 | cse: 572 | let expr = Fm.Term.show.go(term.expr, Fm.MPath.o(path)); 573 | let name = Fm.Name.show(term.name); 574 | let wyth = String.join("", List.mapped<_>(term.with)<_>((defn) 575 | case defn { 576 | new: 577 | let name = Fm.Name.show(defn.name); 578 | let type = Fm.Term.show.go(defn.type, Maybe.none<_>); 579 | let term = Fm.Term.show.go(defn.term, Maybe.none<_>); 580 | String.flatten([name, ": ", type, " = " term, ";"]) 581 | })); 582 | let cses = Map.to_list<_>(term.cses); 583 | let cses = String.join("", List.mapped<_>(cses)<_>((x) 584 | let name = Fm.Name.from_bits(Pair.fst<_,_>(x)); 585 | let term = Fm.Term.show.go(Pair.snd<_,_>(x), Maybe.none<_>); 586 | String.flatten([name, ": ", term, "; "]))); 587 | let moti = case term.moti { 588 | none: "", 589 | some: String.flatten([": ", Fm.Term.show.go(term.moti.value, Maybe.none<_>)]), 590 | }; 591 | String.flatten(["case ",expr," as ",name,wyth," { ",cses,"}",moti]), 592 | ori: 593 | Fm.Term.show.go(term.expr, path), 594 | } 595 | } 596 | 597 | 598 | Fm.Term.show(term: Fm.Term): String 599 | Fm.Term.show.go(term, Maybe.none<_>) 600 | 601 | // Stringifies a defs 602 | Fm.Defs.show(defs: Fm.Defs): String 603 | let str = ""; 604 | for name_defn in Map.to_list(defs) with str: 605 | case name_defn { 606 | new: case name_defn.snd as defn { 607 | new: String.flatten([ 608 | str, 609 | Fm.Name.show(defn.name), 610 | ": ", 611 | Fm.Term.show(defn.type), 612 | "\n ", 613 | Fm.Term.show(defn.term), 614 | "\n", 615 | ]) 616 | } 617 | } 618 | 619 | // Reduction 620 | // ========= 621 | 622 | // BIND: Binds named variables to their lambdas 623 | Fm.Term.bind(vars: Fm.Context, path: Fm.Path, term: Fm.Term): Fm.Term 624 | case term { 625 | ref: case Fm.Context.find(term.name, vars) as got { 626 | none: Fm.Term.ref(term.name), 627 | some: got.value, 628 | }, 629 | var: case List.at_last<_>(term.indx, vars) as got { 630 | none: Fm.Term.var(term.name, term.indx), 631 | some: Pair.snd<_,_>(got.value), 632 | }, 633 | typ: Fm.Term.typ, 634 | all: 635 | let vlen = List.length<_>(vars); 636 | def xtyp = Fm.Term.bind(vars, Fm.Path.o(path), term.xtyp); 637 | def body = (s,x) Fm.Term.bind( 638 | List.cons<_>({term.name,x}, 639 | List.cons<_>({term.self,s}, 640 | vars)), 641 | Fm.Path.i(path), 642 | term.body( 643 | Fm.Term.var(term.self, vlen), 644 | Fm.Term.var(term.name, Nat.succ(vlen)))); 645 | Fm.Term.all(term.eras, term.self, term.name, xtyp, body), 646 | lam: 647 | let vlen = List.length<_>(vars); 648 | def body = (x) Fm.Term.bind( 649 | List.cons<_>({term.name,x},vars), 650 | Fm.Path.o(path), 651 | term.body(Fm.Term.var(term.name, vlen))); 652 | Fm.Term.lam(term.name, body), 653 | app: 654 | def func = Fm.Term.bind(vars, Fm.Path.o(path), term.func); 655 | def argm = Fm.Term.bind(vars, Fm.Path.i(path), term.argm); 656 | Fm.Term.app(func, argm), 657 | let: 658 | let vlen = List.length<_>(vars); 659 | def expr = Fm.Term.bind(vars, Fm.Path.o(path), term.expr); 660 | def body = (x) Fm.Term.bind( 661 | List.cons<_>({term.name,x}, vars), 662 | Fm.Path.i(path), 663 | term.body(Fm.Term.var(term.name, vlen))); 664 | Fm.Term.let(term.name, expr, body), 665 | def: 666 | let vlen = List.length<_>(vars); 667 | def expr = Fm.Term.bind(vars, Fm.Path.o(path), term.expr); 668 | def body = (x) Fm.Term.bind( 669 | List.cons<_>({term.name,x}, vars), 670 | Fm.Path.i(path), 671 | term.body(Fm.Term.var(term.name, vlen))); 672 | Fm.Term.def(term.name, expr, body), 673 | ann: 674 | def term = Fm.Term.bind(vars, Fm.Path.o(path), term.term); 675 | def type = Fm.Term.bind(vars, Fm.Path.i(path), term.type); 676 | Fm.Term.ann(term.done, term, type), 677 | gol: 678 | Fm.Term.gol(term.name, term.dref, term.verb), 679 | hol: 680 | Fm.Term.hol(Fm.Path.to_bits(path)), 681 | nat: 682 | Fm.Term.nat(term.natx), 683 | chr: 684 | Fm.Term.chr(term.chrx), 685 | str: 686 | Fm.Term.str(term.strx), 687 | cse: 688 | let expr = Fm.Term.bind(vars, Fm.Path.o(path), term.expr); 689 | let name = term.name; // TODO 690 | let wyth = term.with; // TODO 691 | let cses = term.cses; // TODO 692 | let moti = term.moti; // TODO 693 | Fm.Term.cse(Fm.Path.to_bits(path), expr, name, wyth, cses, moti), 694 | ori: 695 | Fm.Term.ori(term.orig, Fm.Term.bind(vars, path, term.expr)), 696 | } 697 | 698 | // REDUCE: Reduces a high order term to weak head normal form 699 | Fm.Term.reduce(term: Fm.Term, defs: Fm.Defs): Fm.Term 700 | case term { 701 | ref: case Fm.get<_>(term.name, defs) as got { 702 | none: Fm.Term.ref(term.name), 703 | some: case got.value { new: Fm.Term.reduce(got.value.term, defs) }, 704 | }, 705 | app: 706 | let func = Fm.Term.reduce(term.func, defs); 707 | case func { 708 | lam: Fm.Term.reduce(func.body(term.argm), defs), 709 | _: term, 710 | }, 711 | let: 712 | Fm.Term.reduce(term.body(term.expr), defs), 713 | def: 714 | Fm.Term.reduce(term.body(term.expr), defs), 715 | ann: 716 | Fm.Term.reduce(term.term, defs), 717 | nat: 718 | Fm.Term.reduce(Fm.Term.unroll_nat(term.natx), defs), 719 | chr: 720 | Fm.Term.reduce(Fm.Term.unroll_chr(term.chrx), defs), 721 | str: 722 | Fm.Term.reduce(Fm.Term.unroll_str(term.strx), defs), 723 | ori: 724 | Fm.Term.reduce(term.expr, defs), 725 | _: term, 726 | } 727 | 728 | // NORMALIZE: Normalizes a high order term 729 | Fm.Term.normalize(term: Fm.Term, defs: Fm.Defs): Fm.Term 730 | case Fm.Term.reduce(term, defs) as term { 731 | ref: 732 | Fm.Term.ref(term.name), 733 | var: 734 | Fm.Term.var(term.name, term.indx), 735 | typ: 736 | Fm.Term.typ, 737 | all: 738 | def xtyp = Fm.Term.normalize(term.xtyp, defs); 739 | def body = (s,x) Fm.Term.normalize(term.body(s,x), defs); 740 | Fm.Term.all(term.eras, term.self, term.name, xtyp, body), 741 | lam: 742 | def body = (x) Fm.Term.normalize(term.body(x), defs); 743 | Fm.Term.lam(term.name, body), 744 | app: 745 | def func = Fm.Term.normalize(term.func, defs); 746 | def argm = Fm.Term.normalize(term.argm, defs); 747 | Fm.Term.app(func, argm), 748 | let: 749 | def expr = Fm.Term.normalize(term.expr, defs); 750 | def body = (x) Fm.Term.normalize(term.body(x), defs); 751 | Fm.Term.let(term.name, expr, body), 752 | def: 753 | def expr = Fm.Term.normalize(term.expr, defs); 754 | def body = (x) Fm.Term.normalize(term.body(x), defs); 755 | Fm.Term.def(term.name, expr, body), 756 | ann: 757 | def term = Fm.Term.normalize(term.term, defs); 758 | def type = Fm.Term.normalize(term.type, defs); 759 | Fm.Term.ann(term.done, term, type), 760 | gol: 761 | Fm.Term.gol(term.name, term.dref, term.verb), 762 | hol: 763 | Fm.Term.hol(term.path), 764 | nat: 765 | Fm.Term.nat(term.natx), 766 | chr: 767 | Fm.Term.chr(term.chrx), 768 | str: 769 | Fm.Term.str(term.strx), 770 | cse: 771 | term, 772 | ori: 773 | Fm.Term.normalize(term.expr, defs), 774 | } 775 | 776 | //Fm.Term.clean(term: Fm.Term, defs: Fm.Defs): Fm.Term 777 | //case term { 778 | //ref: 779 | //Fm.Term.ref(term.name), 780 | //var: 781 | //Fm.Term.var(term.name, term.indx), 782 | //typ: 783 | //Fm.Term.typ, 784 | //all: 785 | //def xtyp = Fm.Term.clean(term.xtyp, defs); 786 | //def body = (s,x) Fm.Term.clean(term.body(s,x), defs); 787 | //Fm.Term.all(term.eras, term.self, term.name, xtyp, body), 788 | //lam: 789 | //def body = (x) Fm.Term.clean(term.body(x), defs); 790 | //Fm.Term.lam(term.name, body), 791 | //app: 792 | //def func = Fm.Term.clean(term.func, defs); 793 | //def argm = Fm.Term.clean(term.argm, defs); 794 | //Fm.Term.app(func, argm), 795 | //let: 796 | //def expr = Fm.Term.clean(term.expr, defs); 797 | //def body = (x) Fm.Term.clean(term.body(x), defs); 798 | //Fm.Term.let(term.name, expr, body), 799 | //def: 800 | //def expr = Fm.Term.clean(term.expr, defs); 801 | //def body = (x) Fm.Term.clean(term.body(x), defs); 802 | //Fm.Term.def(term.name, expr, body), 803 | //ann: 804 | //def term = Fm.Term.clean(term.term, defs); 805 | //def type = Fm.Term.clean(term.type, defs); 806 | //Fm.Term.ann(term.done, term, type), 807 | //gol: 808 | //Fm.Term.gol(term.name, term.dref, term.verb), 809 | //hol: 810 | //Fm.Term.hol(term.path), 811 | //nat: 812 | //Fm.Term.nat(term.natx), 813 | //chr: 814 | //Fm.Term.chr(term.chrx), 815 | //str: 816 | //Fm.Term.str(term.strx), 817 | //cse: 818 | //term, 819 | //ori: 820 | //Fm.Term.clean(term.expr, defs), 821 | //} 822 | 823 | // Patching 824 | // ======== 825 | 826 | Fm.define( 827 | file: String, 828 | code: String, 829 | name: Fm.Name, 830 | term: Fm.Term, 831 | type: Fm.Term, 832 | done: Bool, 833 | defs: Fm.Defs, 834 | ): Fm.Defs 835 | //let skip = Debug.log<_>(String.flatten(["define: ", name]), (x) Unit.new); 836 | let stat = if done then Fm.Status.done else Fm.Status.init; 837 | Fm.set<_>(name, Fm.Def.new(file, code, name, term, type, stat), defs) 838 | 839 | // PATCH_AT Does something at a specific path 840 | Fm.Term.patch_at(path: Bits, term: Fm.Term, fn: Fm.Term -> Fm.Term): Fm.Term 841 | case term { 842 | all: case path { 843 | e: fn(term), 844 | o: Fm.Term.all(term.eras, term.self, term.name, Fm.Term.patch_at(path.pred,term.xtyp,fn), term.body), 845 | i: Fm.Term.all(term.eras, term.self, term.name, term.xtyp, (s,x) Fm.Term.patch_at(path.pred,term.body(s,x),fn)), 846 | }, 847 | lam: case path { 848 | e: fn(term), 849 | o: Fm.Term.lam(term.name, (x) Fm.Term.patch_at(Bits.tail(path), term.body(x), fn)), 850 | i: Fm.Term.lam(term.name, (x) Fm.Term.patch_at(Bits.tail(path), term.body(x), fn)), 851 | }, 852 | app: case path { 853 | e: fn(term), 854 | o: Fm.Term.app(Fm.Term.patch_at(path.pred,term.func,fn), term.argm), 855 | i: Fm.Term.app(term.func, Fm.Term.patch_at(path.pred,term.argm,fn)), 856 | }, 857 | let: case path { 858 | e: fn(term), 859 | o: Fm.Term.let(term.name, Fm.Term.patch_at(path.pred,term.expr,fn), term.body), 860 | i: Fm.Term.let(term.name, term.expr, (x) Fm.Term.patch_at(path.pred,term.body(x),fn)), 861 | }, 862 | def: case path { 863 | e: fn(term), 864 | o: Fm.Term.def(term.name, Fm.Term.patch_at(path.pred,term.expr,fn), term.body), 865 | i: Fm.Term.def(term.name, term.expr, (x) Fm.Term.patch_at(path.pred,term.body(x),fn)), 866 | }, 867 | ann: case path { 868 | e: fn(term), 869 | o: Fm.Term.ann(term.done, Fm.Term.patch_at(path,term.term,fn), term.type), 870 | i: Fm.Term.ann(term.done, Fm.Term.patch_at(path,term.term,fn), term.type), 871 | }, 872 | ori: Fm.Term.patch_at(path, term.expr, fn), 873 | _: case path { 874 | e: fn(term), 875 | o: term, 876 | i: term, 877 | }, 878 | } 879 | 880 | // Expands the ref at given path 881 | Fm.Term.expand_at(path: Bits, term: Fm.Term, defs: Fm.Defs): Fm.Term 882 | Fm.Term.patch_at(path, term, (term) case term { 883 | ref: case Fm.get<_>(term.name, defs) as got { 884 | none: Fm.Term.ref(term.name), 885 | some: case got.value { new: got.value.term }, 886 | }, 887 | _: term, 888 | }) 889 | 890 | // Expands constructor applications for better pretty printing 891 | Fm.Term.expand_ct(term: Fm.Term, defs: Fm.Defs, arity: Nat): Fm.Term 892 | case term { 893 | ref: // TODO: support constructors generally, not hardcodedly 894 | let expand = Bool.false; 895 | let expand = Bool.or(Bool.and(String.eql(term.name, "Nat.succ"), Nat.gtn(arity, 1)), expand); 896 | let expand = Bool.or(Bool.and(String.eql(term.name, "Nat.zero"), Nat.gtn(arity, 0)), expand); 897 | let expand = Bool.or(Bool.and(String.eql(term.name, "Bool.true"), Nat.gtn(arity, 0)), expand); 898 | let expand = Bool.or(Bool.and(String.eql(term.name, "Bool.false"), Nat.gtn(arity, 0)), expand); 899 | if expand then 900 | case Fm.get<_>(term.name, defs) as got { 901 | none: Fm.Term.ref(term.name), 902 | some: case got.value { new: got.value.term }, 903 | } 904 | else 905 | Fm.Term.ref(term.name), 906 | var: 907 | Fm.Term.var(term.name, term.indx), 908 | typ: 909 | Fm.Term.typ, 910 | all: 911 | def xtyp = Fm.Term.expand_ct(term.xtyp, defs, 0); 912 | def body = (s,x) Fm.Term.expand_ct(term.body(s,x), defs, 0); 913 | Fm.Term.all(term.eras, term.self, term.name, xtyp, body), 914 | lam: 915 | def body = (x) Fm.Term.expand_ct(term.body(x), defs, 0); 916 | Fm.Term.lam(term.name, body), 917 | app: 918 | def func = Fm.Term.expand_ct(term.func, defs, Nat.succ(arity)); 919 | def argm = Fm.Term.expand_ct(term.argm, defs, 0); 920 | Fm.Term.app(func, argm), 921 | let: 922 | def expr = Fm.Term.expand_ct(term.expr, defs, 0); 923 | def body = (x) Fm.Term.expand_ct(term.body(x), defs, 0); 924 | Fm.Term.let(term.name, expr, body), 925 | def: 926 | def expr = Fm.Term.expand_ct(term.expr, defs, 0); 927 | def body = (x) Fm.Term.expand_ct(term.body(x), defs, 0); 928 | Fm.Term.def(term.name, expr, body), 929 | ann: 930 | def term = Fm.Term.expand_ct(term.term, defs, 0); 931 | def type = Fm.Term.expand_ct(term.type, defs, 0); 932 | Fm.Term.ann(term.done, term, type), 933 | gol: 934 | Fm.Term.gol(term.name, term.dref, term.verb), 935 | hol: 936 | Fm.Term.hol(term.path), 937 | nat: 938 | Fm.Term.nat(term.natx), 939 | chr: 940 | Fm.Term.chr(term.chrx), 941 | str: 942 | Fm.Term.str(term.strx), 943 | cse: 944 | term, 945 | ori: 946 | def expr = Fm.Term.expand_ct(term.expr, defs, 0); 947 | Fm.Term.ori(term.orig, term.expr), 948 | } 949 | 950 | // Expands a term for pretty printing 951 | Fm.Term.expand(dref: List(Bits), term: Fm.Term, defs: Fm.Defs): Fm.Term 952 | let term = Fm.Term.normalize(term, Map.new<_>); 953 | for path in dref with term: 954 | let term = Fm.Term.expand_at(path, term, defs); 955 | let term = Fm.Term.normalize(term, Map.new<_>); 956 | let term = Fm.Term.expand_ct(term, defs, 0); 957 | let term = Fm.Term.normalize(term, Map.new<_>); 958 | term 959 | 960 | // Equality 961 | // ======== 962 | 963 | Fm.Term.serialize.name(name: String): Bits 964 | Fm.Name.to_bits(name) 965 | 966 | // Helper function 967 | Fm.Term.serialize(term: Fm.Term, depth: Nat, init: Nat, x: Bits): Bits 968 | case term { 969 | ref: 970 | let name = Bits.concat(Fm.Term.serialize.name(term.name)); 971 | Bits.o(Bits.o(Bits.o(name(x)))), 972 | var: 973 | if Nat.gte(term.indx, init) then 974 | let name = Bits.concat(Nat.to_bits(Nat.pred(Nat.sub(depth,term.indx)))); 975 | Bits.o(Bits.o(Bits.i(name(x)))) 976 | else 977 | let name = Bits.concat(Nat.to_bits(term.indx)); 978 | Bits.o(Bits.i(Bits.o(name(x)))), 979 | typ: 980 | Bits.o(Bits.i(Bits.i(x))), 981 | all: 982 | let eras = if term.eras then Bits.i else Bits.o 983 | let self = Bits.concat(Fm.Name.to_bits(term.self)); 984 | let xtyp = Fm.Term.serialize(term.xtyp, depth, init); 985 | let body = Fm.Term.serialize( 986 | term.body( 987 | Fm.Term.var(term.self, depth), 988 | Fm.Term.var(term.name, Nat.succ(depth))), 989 | Nat.succ(Nat.succ(depth)), 990 | init); 991 | Bits.i(Bits.o(Bits.o(eras(self(xtyp(body(x))))))), 992 | lam: 993 | let body = Fm.Term.serialize( 994 | term.body(Fm.Term.var(term.name, depth)), 995 | Nat.succ(depth), 996 | init); 997 | Bits.i(Bits.o(Bits.i(body(x)))), 998 | app: 999 | let func = Fm.Term.serialize(term.func, depth, init); 1000 | let argm = Fm.Term.serialize(term.argm, depth, init); 1001 | Bits.i(Bits.i(Bits.o(func(argm(x))))), 1002 | let: 1003 | let expr = Fm.Term.serialize(term.expr, depth, init); 1004 | let body = Fm.Term.serialize( 1005 | term.body(Fm.Term.var(term.name, depth)), 1006 | Nat.succ(depth), 1007 | init); 1008 | Bits.i(Bits.i(Bits.i(expr(body(x))))), 1009 | def: 1010 | Fm.Term.serialize(term.body(term.expr), depth, init, x), 1011 | ann: 1012 | Fm.Term.serialize(term.term, depth, init, x), 1013 | gol: 1014 | let name = Bits.concat(Fm.Name.to_bits(term.name)); 1015 | Bits.o(Bits.o(Bits.o(name(x)))), 1016 | hol: 1017 | x, 1018 | nat: 1019 | Fm.Term.serialize(Fm.Term.unroll_nat(term.natx), depth, init, x), 1020 | chr: 1021 | Fm.Term.serialize(Fm.Term.unroll_chr(term.chrx), depth, init, x), 1022 | str: 1023 | Fm.Term.serialize(Fm.Term.unroll_str(term.strx), depth, init, x), 1024 | cse: 1025 | x, 1026 | ori: 1027 | Fm.Term.serialize(term.expr, depth, init, x), 1028 | } 1029 | 1030 | // Determines if two terms are identical 1031 | Fm.Term.identical(a: Fm.Term, b: Fm.Term, lv: Nat): Bool 1032 | let ah = Fm.Term.serialize(a, lv, lv, Bits.e); 1033 | let bh = Fm.Term.serialize(b, lv, lv, Bits.e); 1034 | Bits.eql(ah, bh) 1035 | 1036 | // Helper function 1037 | Fm.Term.equal.patch(path: Bits, term: Fm.Term, ret: A): Fm.Check(A) 1038 | Fm.Check.result<_>(Maybe.some<_>(ret), [Fm.Error.patch(path, Fm.Term.normalize(term, Map.new<_>))]) 1039 | 1040 | // Fills some extra holes that aren't captured by the Equal function. For 1041 | // example, `Sigma(A, B) == Sigma(_, _)` won't fill these holes since it will 1042 | // fall on the seen (recursive) case. Since, at that point, we assume both sides 1043 | // are equal, then we can unify the respective holes. 1044 | Fm.Term.equal.extra_holes( 1045 | a: Fm.Term, 1046 | b: Fm.Term, 1047 | ): Fm.Check(Unit) 1048 | case a { 1049 | app: case b { 1050 | app: do Fm.Check { 1051 | Fm.Term.equal.extra_holes(a.func, b.func); 1052 | Fm.Term.equal.extra_holes(a.argm, b.argm); 1053 | }, 1054 | ori: Fm.Term.equal.extra_holes(a, b.expr), 1055 | hol: Fm.Term.equal.patch<_>(b.path, a, Unit.new), 1056 | _: do Fm.Check { return Unit.new; }, 1057 | }, 1058 | ori: Fm.Term.equal.extra_holes(a.expr, b), 1059 | hol: Fm.Term.equal.patch<_>(a.path, b, Unit.new), 1060 | _: case b { 1061 | ori: Fm.Term.equal.extra_holes(a, b.expr), 1062 | hol: Fm.Term.equal.patch<_>(b.path, a, Unit.new), 1063 | _: do Fm.Check { return Unit.new; }, 1064 | } 1065 | } 1066 | 1067 | // EQUAL: Determines if two terms are equal 1068 | Fm.Term.equal(a: Fm.Term, b: Fm.Term, defs: Fm.Defs, lv: Nat, seen: Set): Fm.Check(Bool) 1069 | let ah = Fm.Term.serialize(Fm.Term.reduce(a,Map.new<_>), lv, lv, Bits.e); 1070 | let bh = Fm.Term.serialize(Fm.Term.reduce(b,Map.new<_>), lv, lv, Bits.e); 1071 | if Bits.eql(ah, bh) then do Fm.Check { 1072 | return Bool.true; 1073 | } else do Fm.Check { 1074 | let a1 = Fm.Term.reduce(a, defs); 1075 | let b1 = Fm.Term.reduce(b, defs); 1076 | let ah = Fm.Term.serialize(a1, lv, lv, Bits.e); 1077 | let bh = Fm.Term.serialize(b1, lv, lv, Bits.e); 1078 | if Bits.eql(ah, bh) then do Fm.Check { 1079 | return Bool.true; 1080 | } else do Fm.Check { 1081 | let id = Bits.concat(ah, bh); 1082 | if Set.has(id, seen) then do Fm.Check { 1083 | Fm.Term.equal.extra_holes(a, b); 1084 | return Bool.true; 1085 | } else case a1 { 1086 | all: case b1 { 1087 | all: do Fm.Check { 1088 | let seen = Set.set(id, seen); 1089 | let a1_body = a1.body( 1090 | Fm.Term.var(a1.self, lv), 1091 | Fm.Term.var(a1.name, Nat.succ(lv))); 1092 | let b1_body = b1.body( 1093 | Fm.Term.var(b1.self, lv), 1094 | Fm.Term.var(b1.name, Nat.succ(lv))); 1095 | let eq_self = String.eql(a1.self, b1.self); 1096 | let eq_eras = Bool.eql(a1.eras, b1.eras); 1097 | if Bool.and(eq_self, eq_eras) then do Fm.Check { 1098 | var eq_type = Fm.Term.equal(a1.xtyp, b1.xtyp, defs, lv, seen); 1099 | var eq_body = Fm.Term.equal(a1_body, b1_body, defs, Nat.succ(Nat.succ(lv)), seen); 1100 | return Bool.and(eq_type, eq_body); 1101 | } else do Fm.Check { 1102 | return Bool.false; 1103 | }; 1104 | }, 1105 | hol: 1106 | Fm.Term.equal.patch<_>(b1.path, a, Bool.true), 1107 | _: do Fm.Check { 1108 | return Bool.false; 1109 | }, 1110 | }, 1111 | lam: case b1 { 1112 | lam: do Fm.Check { 1113 | let seen = Set.set(id, seen); 1114 | let a1_body = a1.body(Fm.Term.var(a1.name, lv)); 1115 | let b1_body = b1.body(Fm.Term.var(b1.name, lv)); 1116 | var eq_body = Fm.Term.equal(a1_body, b1_body, defs, Nat.succ(lv), seen); 1117 | return eq_body; 1118 | }, 1119 | hol: Fm.Term.equal.patch<_>(b1.path, a, Bool.true), 1120 | _: do Fm.Check { 1121 | return Bool.false; 1122 | }, 1123 | }, 1124 | app: case b1 { 1125 | app: do Fm.Check { 1126 | let seen = Set.set(id, seen); 1127 | var eq_func = Fm.Term.equal(a1.func, b1.func, defs, lv, seen); 1128 | var eq_argm = Fm.Term.equal(a1.argm, b1.argm, defs, lv, seen); 1129 | return Bool.and(eq_func, eq_argm); 1130 | }, 1131 | hol: Fm.Term.equal.patch<_>(b1.path, a, Bool.true), 1132 | _: do Fm.Check { 1133 | return Bool.false; 1134 | }, 1135 | }, 1136 | let: case b1 { 1137 | let: do Fm.Check { 1138 | let seen = Set.set(id, seen); 1139 | let a1_body = a1.body(Fm.Term.var(a1.name, lv)); 1140 | let b1_body = b1.body(Fm.Term.var(b1.name, lv)); 1141 | var eq_expr = Fm.Term.equal(a1.expr, b1.expr, defs, lv, seen); 1142 | var eq_body = Fm.Term.equal(a1_body, b1_body, defs, Nat.succ(lv), seen); 1143 | return Bool.and(eq_expr, eq_body); 1144 | }, 1145 | hol: 1146 | Fm.Term.equal.patch<_>(b1.path, a, Bool.true), 1147 | _: do Fm.Check { 1148 | return Bool.false; 1149 | }, 1150 | }, 1151 | hol: 1152 | Fm.Term.equal.patch<_>(a1.path, b, Bool.true), 1153 | _: case b1 { 1154 | hol: Fm.Term.equal.patch<_>(b1.path, a, Bool.true), 1155 | _: do Fm.Check { 1156 | return Bool.false; 1157 | }, 1158 | }, 1159 | }; 1160 | }; 1161 | } 1162 | 1163 | // Type Checking 1164 | // ============= 1165 | 1166 | // Fm.Check monad pure 1167 | Fm.Check.pure(value: V): Fm.Check(V) 1168 | Fm.Check.result(Maybe.some(value), []) 1169 | 1170 | // Fm.Check monad bind 1171 | Fm.Check.bind(a: Fm.Check(A), f: A -> Fm.Check(B)): Fm.Check(B) 1172 | case a { 1173 | result: case a.value as got { 1174 | none: Fm.Check.result(Maybe.none, a.errors), 1175 | some: case f(got.value) as b { 1176 | result: Fm.Check.result(b.value, List.concat<_>(a.errors,b.errors)), 1177 | } 1178 | } 1179 | } 1180 | 1181 | // Fm.Check monad 1182 | Fm.Check.monad: Monad(Fm.Check) 1183 | Monad.new(Fm.Check.bind, Fm.Check.pure) 1184 | 1185 | // Fm.Check to Maybe 1186 | Fm.Check.value(chk: Fm.Check(A)): Maybe(A) 1187 | case chk { 1188 | result: chk.value 1189 | } 1190 | 1191 | // Fm.Check none 1192 | Fm.Check.none: Fm.Check(A) 1193 | Fm.Check.result(Maybe.none, []) 1194 | 1195 | // CHECK: Checks the type of a core term 1196 | Fm.Term.check( 1197 | term: Fm.Term, 1198 | type: Maybe(Fm.Term), 1199 | defs: Fm.Defs, 1200 | ctx: Fm.Context, 1201 | path: Fm.MPath, 1202 | orig: Maybe(Fm.Origin), 1203 | ): Fm.Check(Fm.Term) 1204 | do Fm.Check { 1205 | var infr = case term { 1206 | ref: case Fm.get<_>(term.name, defs) as got { 1207 | none: Fm.Check.result<_>(type, [Fm.Error.undefined_reference(orig, term.name)]), 1208 | some: case got.value { 1209 | new: 1210 | let ref_name = got.value.name; 1211 | let ref_type = got.value.type; 1212 | let ref_term = got.value.term; 1213 | let ref_stat = got.value.stat; 1214 | case ref_stat { 1215 | init: Fm.Check.result<_>(Maybe.some<_>(ref_type), [Fm.Error.waiting(ref_name)]), 1216 | wait: Fm.Check.result<_>(Maybe.some<_>(ref_type), []), 1217 | done: Fm.Check.result<_>(Maybe.some<_>(ref_type), []), 1218 | fail: Fm.Check.result<_>(Maybe.some<_>(ref_type), [Fm.Error.indirect(ref_name)]), 1219 | }, 1220 | } 1221 | }, 1222 | var: case List.at_last<_>(term.indx, ctx) as got { 1223 | none: Fm.Check.result<_>(type, [Fm.Error.undefined_reference(orig, term.name)]), 1224 | some: do Fm.Check { return case got.value { new: got.value.snd }; }, 1225 | }, 1226 | typ: do Fm.Check { 1227 | return Fm.Term.typ; 1228 | }, 1229 | all: do Fm.Check { 1230 | let ctx_size = List.length<_>(ctx); 1231 | let self_var = Fm.Term.var(term.self, ctx_size); 1232 | let body_var = Fm.Term.var(term.name, Nat.succ(ctx_size)); 1233 | let body_ctx = List.cons<_>({term.name,term.xtyp}, List.cons<_>({term.self,term}, ctx)); 1234 | Fm.Term.check(term.xtyp, Maybe.some<_>(Fm.Term.typ), defs, ctx, Fm.MPath.o(path), orig); 1235 | Fm.Term.check(term.body(self_var,body_var), Maybe.some<_>(Fm.Term.typ), defs, body_ctx, Fm.MPath.i(path), orig); 1236 | return Fm.Term.typ; 1237 | }, 1238 | lam: case type { 1239 | none: do Fm.Check { 1240 | Fm.Check.result<_>(type, [Fm.Error.cant_infer(orig, term, ctx)]); 1241 | }, 1242 | some: do Fm.Check { 1243 | let typv = Fm.Term.reduce(type.value, defs); 1244 | case typv { 1245 | all: do Fm.Check { 1246 | let ctx_size = List.length<_>(ctx); 1247 | let self_var = term; 1248 | let body_var = Fm.Term.var(term.name, ctx_size); 1249 | let body_typ = typv.body(self_var, body_var); 1250 | let body_ctx = List.cons<_>({term.name,typv.xtyp}, ctx); 1251 | Fm.Term.check(term.body(body_var), Maybe.some<_>(body_typ), defs, body_ctx, Fm.MPath.o(path), orig); 1252 | return type.value; 1253 | }, 1254 | _: do Fm.Check { 1255 | let expected = Either.left<_,_>("Function"); 1256 | let detected = Either.right<_,_>(type.value); 1257 | Fm.Check.result<_>(type, [Fm.Error.type_mismatch(orig, expected, detected, ctx)]); 1258 | } 1259 | }; 1260 | } 1261 | }, 1262 | app: do Fm.Check { 1263 | var func_typ = Fm.Term.check(term.func, Maybe.none<_>, defs, ctx, Fm.MPath.o(path), orig); 1264 | let func_typ = Fm.Term.reduce(func_typ, defs); 1265 | case func_typ { 1266 | all: do Fm.Check { 1267 | Fm.Term.check(term.argm, Maybe.some<_>(func_typ.xtyp), defs, ctx, Fm.MPath.i(path), orig); 1268 | return func_typ.body(term.func, term.argm); 1269 | }, 1270 | _: do Fm.Check { 1271 | let expected = Either.left<_,_>("Function"); 1272 | let detected = Either.right<_,_>(func_typ); 1273 | Fm.Check.result<_>(type, [Fm.Error.type_mismatch(orig, expected, detected, ctx)]); 1274 | }, 1275 | }; 1276 | }, 1277 | ann: 1278 | if term.done then do Fm.Check { 1279 | return term.type; 1280 | } else do Fm.Check { 1281 | Fm.Term.check(term.term, Maybe.some<_>(term.type), defs, ctx, Fm.MPath.o(path), orig); 1282 | Fm.Term.check(term.type, Maybe.some<_>(Fm.Term.typ), defs, ctx, Fm.MPath.i(path), orig); 1283 | return term.type; 1284 | }, 1285 | let: do Fm.Check { 1286 | let ctx_size = List.length<_>(ctx); 1287 | var expr_typ = Fm.Term.check(term.expr, Maybe.none<_>, defs, ctx, Fm.MPath.o(path), orig); 1288 | let body_val = term.body(Fm.Term.var(term.name, ctx_size)); 1289 | let body_ctx = List.cons<_>({term.name, expr_typ}, ctx); 1290 | var body_typ = Fm.Term.check(body_val, type, defs, body_ctx, Fm.MPath.i(path), orig); 1291 | return body_typ; 1292 | }, 1293 | def: do Fm.Check { 1294 | Fm.Term.check(term.body(term.expr), type, defs, ctx, path, orig); 1295 | }, 1296 | nat: do Fm.Check { 1297 | return Fm.Term.ref("Nat"); 1298 | }, 1299 | chr: do Fm.Check { 1300 | return Fm.Term.ref("Char"); 1301 | }, 1302 | str: do Fm.Check { 1303 | return Fm.Term.ref("String"); 1304 | }, 1305 | cse: do Fm.Check { 1306 | let expr = term.expr; 1307 | var etyp = Fm.Term.check(expr, Maybe.none<_>, defs, ctx, Fm.MPath.o(path), orig); 1308 | // If cse has no moti and we have an inferred type, then we guess it 1309 | // with the information we have, substituting selfs and indices. 1310 | // Otherwise, we just replace it by a normal hole. 1311 | let dsug = case term.moti { 1312 | none: 1313 | let moti = case type { 1314 | none: 1315 | Fm.Term.hol(Bits.e), 1316 | some: 1317 | let size = List.length<_>(ctx); 1318 | let moti = Fm.SmartMotive.make(term.name, term.expr, etyp, type.value, size, defs); 1319 | moti, 1320 | }; 1321 | Maybe.some<_>(Fm.Term.cse(term.path, term.expr, term.name, term.with, term.cses, Maybe.some<_>(moti))), 1322 | some: 1323 | Fm.Term.desugar_cse(term.expr, term.name, term.with, term.cses, term.moti.value, etyp, defs, ctx), 1324 | }; 1325 | case dsug { 1326 | none: Fm.Check.result<_>(type, [Fm.Error.cant_infer(orig, term, ctx)]), 1327 | some: Fm.Check.result<_>(type, [Fm.Error.patch(Fm.MPath.to_bits(path),dsug.value)]), 1328 | }; 1329 | }, 1330 | gol: do Fm.Check { 1331 | Fm.Check.result<_>(type, [ 1332 | Fm.Error.show_goal(term.name, term.dref, term.verb, type, ctx) 1333 | ]); 1334 | }, 1335 | hol: do Fm.Check { 1336 | Fm.Check.result<_>(type, []); 1337 | }, 1338 | ori: do Fm.Check { 1339 | Fm.Term.check(term.expr, type, defs, ctx, path, Maybe.some<_>(term.orig)); 1340 | }, 1341 | }; 1342 | case type { 1343 | none: 1344 | Fm.Check.result<_>(Maybe.some<_>(infr), []), 1345 | some: do Fm.Check { 1346 | var eqls = Fm.Term.equal(type.value, infr, defs, List.length<_>(ctx), Set.new); 1347 | if eqls then do Fm.Check { 1348 | return type.value; 1349 | } else Fm.Check.result<_>(type, [ 1350 | Fm.Error.type_mismatch( 1351 | orig, 1352 | Either.right<_,_>(type.value), 1353 | Either.right<_,_>(infr), 1354 | ctx) 1355 | ]); 1356 | } 1357 | }; 1358 | } 1359 | 1360 | // SmartMotive 1361 | // ========== 1362 | 1363 | // Replaces a term by another. Assumes bound variables are linked to native 1364 | // lambdas, so no shifting is necessary. Used in desugarers. TODO: variable 1365 | // captures may happen if the motive has lambdas with identical names to the 1366 | // case-of name/indices. To improve this, we would need to replace term.body by 1367 | // variables. But since variables are bruijn-leveled, this won't work since the 1368 | // motive desugarer adds lambdas. Thus, in order for it to work, we'd need 1369 | // either bruijn indices, or to make the motive desugarer call level-shift for 1370 | // each lambda it adds. 1371 | Fm.SmartMotive.replace(term: Fm.Term, from: Fm.Term, to: Fm.Term, lv: Nat): Fm.Term 1372 | //let skip = Debug.log<_>(String.flatten(["replace term=", Fm.Term.show(term), " from=", Fm.Term.show(from), " to=", Fm.Term.show(to), " lv=", Nat.show(lv)]), (x) Unit.new); 1373 | if Fm.Term.identical(term, from, lv) then 1374 | to 1375 | else case term { 1376 | ref: 1377 | Fm.Term.ref(term.name), 1378 | var: 1379 | Fm.Term.var(term.name, term.indx), 1380 | typ: 1381 | Fm.Term.typ, 1382 | all: 1383 | let xtyp = Fm.SmartMotive.replace(term.xtyp, from, to, lv); 1384 | let body = term.body(Fm.Term.ref(term.self),Fm.Term.ref(term.name)); 1385 | let body = Fm.SmartMotive.replace(body, from, to, Nat.succ(Nat.succ(lv))); 1386 | Fm.Term.all(term.eras, term.self, term.name, xtyp, (s,x) body), 1387 | lam: 1388 | let body = term.body(Fm.Term.ref(term.name)); 1389 | let body = Fm.SmartMotive.replace(body, from, to, Nat.succ(lv)); 1390 | Fm.Term.lam(term.name, (x) body), 1391 | app: 1392 | let func = Fm.SmartMotive.replace(term.func, from, to, lv); 1393 | let argm = Fm.SmartMotive.replace(term.argm, from, to, lv); 1394 | Fm.Term.app(func, argm), 1395 | let: 1396 | let expr = Fm.SmartMotive.replace(term.expr, from, to, lv); 1397 | let body = term.body(Fm.Term.ref(term.name)) 1398 | let body = Fm.SmartMotive.replace(body, from, to, Nat.succ(lv)); 1399 | Fm.Term.let(term.name, expr, (x) body), 1400 | def: 1401 | let expr = Fm.SmartMotive.replace(term.expr, from, to, lv); 1402 | let body = term.body(Fm.Term.ref(term.name)) 1403 | let body = Fm.SmartMotive.replace(body, from, to, Nat.succ(lv)); 1404 | Fm.Term.def(term.name, expr, (x) body), 1405 | ann: 1406 | let term = Fm.SmartMotive.replace(term.term, from, to, lv); 1407 | let type = Fm.SmartMotive.replace(term.type, from, to, lv); 1408 | Fm.Term.ann(term.done, term, type), 1409 | gol: 1410 | term, 1411 | hol: 1412 | term, 1413 | nat: 1414 | term, 1415 | chr: 1416 | term, 1417 | str: 1418 | term, 1419 | cse: 1420 | term, 1421 | ori: 1422 | Fm.SmartMotive.replace(term.expr, from, to, lv), 1423 | } 1424 | 1425 | Fm.SmartMotive.vals(expr: Fm.Term, type: Fm.Term, defs: Fm.Defs): List(Fm.Term) 1426 | case Fm.Term.reduce(type, defs) as type { 1427 | all: Fm.SmartMotive.vals(expr, type.body(Fm.Term.typ,Fm.Term.typ), defs), 1428 | _: Fm.SmartMotive.vals.cont(expr, type, [], defs), 1429 | } 1430 | 1431 | Fm.SmartMotive.vals.cont(expr: Fm.Term, term: Fm.Term, args: List(Fm.Term), defs: Fm.Defs): List(Fm.Term) 1432 | case Fm.Term.reduce(term, defs) as term { 1433 | app: Fm.SmartMotive.vals.cont(expr, term.func, List.cons<_>(term.argm, args), defs), 1434 | _: List.cons<_>(expr, List.tail<_>(List.reverse<_>(args))), 1435 | } 1436 | 1437 | Fm.SmartMotive.nams(name: Fm.Name, type: Fm.Term, defs: Fm.Defs): List(Fm.Name) 1438 | case Fm.Term.reduce(type, defs) as type { 1439 | all: Fm.SmartMotive.nams.cont(name, type.xtyp, [], defs), 1440 | _: [], 1441 | } 1442 | 1443 | Fm.SmartMotive.nams.cont(name: Fm.Name, term: Fm.Term, binds: List(Fm.Name), defs: Fm.Defs): List(Fm.Name) 1444 | case Fm.Term.reduce(term, defs) as term { 1445 | all: Fm.SmartMotive.nams.cont( 1446 | name, 1447 | term.body(Fm.Term.ref(term.self),Fm.Term.ref(term.name)), 1448 | List.cons<_>(String.flatten([name, ".", term.name]), binds), 1449 | defs), 1450 | _: List.cons<_>(name, List.tail<_>(binds)), 1451 | } 1452 | 1453 | Fm.SmartMotive.make( 1454 | name: Fm.Name, 1455 | expr: Fm.Term, 1456 | type: Fm.Term, 1457 | moti: Fm.Term, 1458 | lv : Nat, 1459 | defs: Fm.Defs, 1460 | ): Fm.Term 1461 | let vals = Fm.SmartMotive.vals(expr,type,defs); 1462 | let nams = Fm.SmartMotive.nams(name,type,defs); 1463 | let subs = List.zip<_,_>(nams,vals); 1464 | //let skip = Debug.log<_>(String.flatten(["-expr: ", Fm.Term.show(expr)]), (x) Unit.new); 1465 | //let skip = Debug.log<_>(String.flatten(["-type: ", Fm.Term.show(type)]), (x) Unit.new); 1466 | //let skip = Debug.log<_>(String.flatten(["-type: ", Fm.Term.show(Fm.Term.reduce(type,defs))]), (x) Unit.new); 1467 | //let skip = Debug.log<_>(String.flatten(["-vals: ", String.join(", ", List.mapped<_>(vals)<_>(Fm.Term.show))]), (x) Unit.new); 1468 | //let skip = Debug.log<_>(String.flatten(["-nams: ", String.join(", ", nams)]), (x) Unit.new); 1469 | //let skip = Debug.log<_>(String.flatten(["-moti: ", Fm.Term.show(moti)]), (x) Unit.new); 1470 | let moti = List.fold<_>(subs)<_>(moti, (sub,moti) case sub { 1471 | new: Fm.SmartMotive.replace(moti, sub.snd, Fm.Term.ref(sub.fst), lv), 1472 | }); 1473 | //let skip = Debug.log<_>(String.flatten(["+moti: ", Fm.Term.show(moti)]), (x) Unit.new); 1474 | moti 1475 | 1476 | // Sugars 1477 | // ====== 1478 | 1479 | // Unrolls a natural number 1480 | Fm.Term.unroll_nat(natx: Nat): Fm.Term 1481 | case natx { 1482 | zero: 1483 | Fm.Term.ref(Fm.Name.read("Nat.zero")), 1484 | succ: 1485 | let func = Fm.Term.ref(Fm.Name.read("Nat.succ")); 1486 | let argm = Fm.Term.nat(natx.pred); 1487 | Fm.Term.app(func, argm), 1488 | } 1489 | 1490 | // Unrolls a character 1491 | Fm.Term.unroll_chr(chrx: Char): Fm.Term 1492 | let bits = U16.to_bits(chrx); 1493 | let term = Fm.Term.ref(Fm.Name.read("Word.from_bits")); 1494 | let term = Fm.Term.app(term, Fm.Term.nat(16)); 1495 | let term = Fm.Term.app(term, Fm.Term.unroll_chr.bits(bits)); 1496 | let term = Fm.Term.app(Fm.Term.ref(Fm.Name.read("U16.new")), term); 1497 | term 1498 | 1499 | Fm.Term.unroll_chr.bits(bits: Bits): Fm.Term 1500 | case bits { 1501 | e: Fm.Term.ref(Fm.Name.read("Bits.e")), 1502 | o: Fm.Term.app(Fm.Term.ref(Fm.Name.read("Bits.o")), Fm.Term.unroll_chr.bits(bits.pred)), 1503 | i: Fm.Term.app(Fm.Term.ref(Fm.Name.read("Bits.i")), Fm.Term.unroll_chr.bits(bits.pred)), 1504 | } 1505 | 1506 | // Unrolls a string 1507 | Fm.Term.unroll_str(strx: String): Fm.Term 1508 | case strx { 1509 | nil: 1510 | Fm.Term.ref(Fm.Name.read("String.nil")), 1511 | cons: 1512 | let char = Fm.Term.chr(strx.head); 1513 | let term = Fm.Term.ref(Fm.Name.read("String.cons")); 1514 | let term = Fm.Term.app(term, char); 1515 | let term = Fm.Term.app(term, Fm.Term.str(strx.tail)); 1516 | term, 1517 | } 1518 | 1519 | // Desugars the case-of expression (wraps lambdas around arguments) 1520 | Fm.Term.desugar_cse( 1521 | expr: Fm.Term, 1522 | name: Fm.Name, 1523 | with: List(Fm.Def), 1524 | cses: Map(Fm.Term), 1525 | moti: Fm.Term, 1526 | type: Fm.Term, 1527 | defs: Fm.Defs, 1528 | ctxt: Fm.Context, 1529 | ): Maybe(Fm.Term) 1530 | case Fm.Term.reduce(type, defs) as type { 1531 | all: 1532 | let moti = Fm.Term.desugar_cse.motive(with, moti); 1533 | let argm = Fm.Term.desugar_cse.argument(name, [], type.xtyp, moti, defs); 1534 | let expr = Fm.Term.app(expr, argm); 1535 | let type = type.body(Fm.Term.var(type.self,0), Fm.Term.var(type.name,0)); 1536 | Maybe.some<_>(Fm.Term.desugar_cse.cases(expr, name, with, cses, type, defs, ctxt)), 1537 | _: 1538 | Maybe.none<_>, 1539 | } 1540 | 1541 | // Desugars the case-of expression (cases) 1542 | Fm.Term.desugar_cse.cases( 1543 | expr: Fm.Term, 1544 | name: Fm.Name, 1545 | wyth: List(Fm.Def), 1546 | cses: Map(Fm.Term), 1547 | type: Fm.Term, 1548 | defs: Fm.Defs, 1549 | ctxt: Fm.Context, 1550 | ): Fm.Term 1551 | case Fm.Term.reduce(type, defs) as type { 1552 | all: 1553 | let got = Maybe.or<_>(Fm.get<_>(type.name, cses), Fm.get<_>("_", cses)); 1554 | case got { 1555 | some: 1556 | let argm = Fm.Term.desugar_cse.argument(name, wyth, type.xtyp, got.value, defs); 1557 | let expr = Fm.Term.app(expr, argm); 1558 | let type = type.body(Fm.Term.var(type.self,0), Fm.Term.var(type.name,0)); 1559 | Fm.Term.desugar_cse.cases(expr, name, wyth, cses, type, defs, ctxt), 1560 | none: 1561 | for defn in wyth with expr: 1562 | case defn { 1563 | new: Fm.Term.app(expr, defn.term) 1564 | }, 1565 | }, 1566 | _: 1567 | for defn in wyth with expr: 1568 | Fm.Term.app(expr, case defn { new: defn.term }), 1569 | } 1570 | 1571 | // Extends a type with motive variables 1572 | Fm.Term.desugar_cse.motive( 1573 | wyth: List(Fm.Def), 1574 | moti: Fm.Term, 1575 | ): Fm.Term 1576 | case wyth { 1577 | cons: case wyth.head { 1578 | new: 1579 | def all_name = wyth.head.name; 1580 | def all_xtyp = wyth.head.type; 1581 | def all_body = (s,x) Fm.Term.desugar_cse.motive(wyth.tail, moti); 1582 | Fm.Term.all(Bool.false, "", all_name, all_xtyp, all_body) 1583 | }, 1584 | nil: moti, 1585 | } 1586 | 1587 | // Desugars the case-of expression (wraps lambdas around an argument) 1588 | Fm.Term.desugar_cse.argument( 1589 | name: Fm.Name, 1590 | wyth: List(Fm.Def), 1591 | type: Fm.Term, 1592 | body: Fm.Term, 1593 | defs: Fm.Defs, 1594 | ): Fm.Term 1595 | case Fm.Term.reduce(type, defs) as type { 1596 | all: 1597 | def type = type.body(Fm.Term.var(type.self,0), Fm.Term.var(type.name,0)); 1598 | def lam_name = 1599 | if String.is_empty(type.name) then 1600 | name 1601 | else 1602 | String.flatten([name, ".", type.name]); 1603 | def lam_body = (x) Fm.Term.desugar_cse.argument(name, wyth, type, body, defs); 1604 | Fm.Term.lam(lam_name, lam_body), 1605 | _: case wyth { 1606 | cons: case wyth.head { 1607 | new: 1608 | def lam_name = wyth.head.name; 1609 | def lam_body = (x) Fm.Term.desugar_cse.argument(name, wyth.tail, type, body, defs); 1610 | Fm.Term.lam(lam_name, lam_body) 1611 | }, 1612 | nil: body, 1613 | } 1614 | } 1615 | 1616 | // Builds the type of a datatype 1617 | Fm.Datatype.build_type(type: Fm.Datatype): Fm.Term 1618 | case type { 1619 | new: Fm.Datatype.build_type.go(type, type.name, type.pars, type.inds), 1620 | } 1621 | 1622 | Fm.Datatype.build_type.go( 1623 | type: Fm.Datatype, 1624 | name: Fm.Name, 1625 | pars: List(Fm.Binder), 1626 | inds: List(Fm.Binder), 1627 | ): Fm.Term 1628 | case pars { 1629 | cons: case pars.head { 1630 | new: 1631 | def par_eras = pars.head.eras; 1632 | def par_name = pars.head.name; 1633 | def par_xtyp = pars.head.term; 1634 | def par_body = (s,x) Fm.Datatype.build_type.go(type, name, pars.tail, inds); 1635 | Fm.Term.all(Bool.false, "", par_name, par_xtyp, par_body) 1636 | }, 1637 | nil: case inds { 1638 | cons: case inds.head { 1639 | new: 1640 | def ind_eras = inds.head.eras; 1641 | def ind_name = inds.head.name; 1642 | def ind_xtyp = inds.head.term; 1643 | def ind_body = (s,x) Fm.Datatype.build_type.go(type, name, pars, inds.tail); 1644 | Fm.Term.all(Bool.false, "", ind_name, ind_xtyp, ind_body) 1645 | }, 1646 | nil: Fm.Term.typ, 1647 | } 1648 | } 1649 | 1650 | // Builds the term of a datatype (motive) 1651 | Fm.Datatype.build_term.motive( 1652 | type: Fm.Datatype, 1653 | ): Fm.Term 1654 | case type { 1655 | new: Fm.Datatype.build_term.motive.go(type, type.name, type.inds), 1656 | } 1657 | 1658 | Fm.Datatype.build_term.motive.go( 1659 | type: Fm.Datatype, 1660 | name: Fm.Name, 1661 | inds: List(Fm.Binder), 1662 | ): Fm.Term 1663 | case inds { 1664 | cons: case inds.head { 1665 | new: 1666 | def ind_eras = inds.head.eras; 1667 | def ind_name = inds.head.name; 1668 | def ind_xtyp = inds.head.term; 1669 | def ind_body = (s,x) Fm.Datatype.build_term.motive.go(type, name, inds.tail); 1670 | Fm.Term.all(ind_eras, "", ind_name, ind_xtyp, ind_body), 1671 | }, 1672 | nil: 1673 | case type { 1674 | new: 1675 | let slf = Fm.Term.ref(name); 1676 | let slf = for var in type.pars: 1677 | Fm.Term.app(slf, Fm.Term.ref(case var { new: var.name })); 1678 | let slf = for var in type.inds: 1679 | Fm.Term.app(slf, Fm.Term.ref(case var { new: var.name })); 1680 | Fm.Term.all(Bool.false, "", "", slf, (s,x) Fm.Term.typ) 1681 | } 1682 | } 1683 | 1684 | // Builds the term of a datatype (constructors) 1685 | Fm.Datatype.build_term.constructors(type: Fm.Datatype): Fm.Term 1686 | case type { 1687 | new: Fm.Datatype.build_term.constructors.go(type, type.name, type.ctrs) 1688 | } 1689 | 1690 | Fm.Datatype.build_term.constructors.go( 1691 | type: Fm.Datatype, 1692 | name: Fm.Name, 1693 | ctrs: List(Fm.Constructor), 1694 | ): Fm.Term 1695 | case ctrs { 1696 | cons: case ctrs.head { 1697 | new: Fm.Term.all(Bool.false, "", 1698 | ctrs.head.name, 1699 | Fm.Datatype.build_term.constructor(type, ctrs.head), 1700 | (s,x) Fm.Datatype.build_term.constructors.go(type, name, ctrs.tail)) 1701 | }, 1702 | nil: 1703 | case type { 1704 | new: 1705 | let ret = Fm.Term.ref(Fm.Name.read("P")); 1706 | let ret = for var in type.inds: 1707 | Fm.Term.app(ret, Fm.Term.ref(case var { new: var.name })); 1708 | Fm.Term.app(ret, Fm.Term.ref(String.concat(name,".Self"))) 1709 | } 1710 | } 1711 | 1712 | // Builds the term of a datatype (constructor) 1713 | Fm.Datatype.build_term.constructor(type: Fm.Datatype, ctor: Fm.Constructor): Fm.Term 1714 | case ctor { 1715 | new: Fm.Datatype.build_term.constructor.go(type, ctor, ctor.args), 1716 | } 1717 | 1718 | Fm.Datatype.build_term.constructor.go( 1719 | type: Fm.Datatype, 1720 | ctor: Fm.Constructor, 1721 | args: List(Fm.Binder), 1722 | ): Fm.Term 1723 | case args { 1724 | cons: case args.head { 1725 | new: 1726 | let eras = args.head.eras; 1727 | let name = args.head.name; 1728 | let xtyp = args.head.term; 1729 | let body = Fm.Datatype.build_term.constructor.go(type, ctor, args.tail); 1730 | Fm.Term.all(eras, "", name, xtyp, (s,x) body) 1731 | }, 1732 | nil: 1733 | case type { 1734 | new: case ctor { 1735 | new: 1736 | let ret = Fm.Term.ref(Fm.Name.read("P")); 1737 | let ret = for var in ctor.inds: 1738 | Fm.Term.app(ret, case var { new: var.term }); 1739 | let ctr = String.flatten([type.name,Fm.Name.read("."),ctor.name]); 1740 | let slf = Fm.Term.ref(ctr); 1741 | let slf = for var in type.pars: 1742 | Fm.Term.app(slf, Fm.Term.ref(case var { new: var.name })); 1743 | let slf = for var in ctor.args: 1744 | Fm.Term.app(slf, Fm.Term.ref(case var { new: var.name })); 1745 | Fm.Term.app(ret, slf) 1746 | } 1747 | } 1748 | } 1749 | 1750 | // Builds the term of a datatype 1751 | Fm.Datatype.build_term(type: Fm.Datatype): Fm.Term 1752 | case type { 1753 | new: Fm.Datatype.build_term.go(type, type.name, type.pars, type.inds), 1754 | } 1755 | 1756 | Fm.Datatype.build_term.go( 1757 | type: Fm.Datatype, 1758 | name: Fm.Name, 1759 | pars: List(Fm.Binder), 1760 | inds: List(Fm.Binder), 1761 | ): Fm.Term 1762 | case pars { 1763 | cons: case pars.head { 1764 | new: 1765 | def par_name = pars.head.name; 1766 | def par_body = (x) Fm.Datatype.build_term.go(type, name, pars.tail, inds); 1767 | Fm.Term.lam(par_name, par_body), 1768 | }, 1769 | nil: case inds { 1770 | cons: case inds.head { 1771 | new: 1772 | def ind_name = inds.head.name; 1773 | def ind_body = (x) Fm.Datatype.build_term.go(type, name, pars, inds.tail); 1774 | Fm.Term.lam(ind_name, ind_body), 1775 | }, 1776 | nil: 1777 | def moti = Fm.Datatype.build_term.motive(type); 1778 | def body = (s,x) Fm.Datatype.build_term.constructors(type); // TODO 1779 | Fm.Term.all(Bool.true, String.concat(name,".Self"), Fm.Name.read("P"), moti, body) 1780 | } 1781 | } 1782 | 1783 | Fm.Constructor.build_type(type: Fm.Datatype, ctor: Fm.Constructor): Fm.Term 1784 | case type { 1785 | new: case ctor { 1786 | new: Fm.Constructor.build_type.go( 1787 | type, 1788 | ctor, 1789 | type.name, 1790 | type.pars, 1791 | ctor.args) 1792 | } 1793 | } 1794 | 1795 | Fm.Constructor.build_type.go( 1796 | type: Fm.Datatype, 1797 | ctor: Fm.Constructor, 1798 | name: Fm.Name, 1799 | pars: List(Fm.Binder), 1800 | args: List(Fm.Binder), 1801 | ): Fm.Term 1802 | case pars { 1803 | cons: case pars.head { 1804 | new: 1805 | def pars_eras = pars.head.eras; 1806 | def pars_name = pars.head.name; 1807 | def pars_xtyp = pars.head.term; 1808 | def pars_body = (s,x) Fm.Constructor.build_type.go(type, ctor, name, pars.tail, args); 1809 | Fm.Term.all(pars_eras, "", pars_name, pars_xtyp, pars_body), 1810 | }, 1811 | nil: case args { 1812 | cons: case args.head { 1813 | new: 1814 | def ctr_eras = args.head.eras; 1815 | def ctr_name = args.head.name; 1816 | def ctr_xtyp = args.head.term; 1817 | def ctr_body = (s,x) Fm.Constructor.build_type.go(type, ctor, name, pars, args.tail); 1818 | Fm.Term.all(ctr_eras, "", ctr_name, ctr_xtyp, ctr_body), 1819 | }, 1820 | nil: case type { 1821 | new: case ctor { 1822 | new: 1823 | let type = Fm.Term.ref(name); 1824 | let type = for var in type.pars: 1825 | Fm.Term.app(type, Fm.Term.ref(case var { new: var.name })); 1826 | let type = for var in ctor.inds: 1827 | Fm.Term.app(type, case var { new: var.term }); 1828 | type, 1829 | } 1830 | } 1831 | } 1832 | } 1833 | 1834 | Fm.Constructor.build_term.opt(type: Fm.Datatype, ctor: Fm.Constructor): Fm.Term 1835 | case type { 1836 | new: Fm.Constructor.build_term.opt.go(type, ctor, type.ctrs) 1837 | } 1838 | 1839 | Fm.Constructor.build_term.opt.go( 1840 | type: Fm.Datatype, 1841 | ctor: Fm.Constructor, 1842 | ctrs: List(Fm.Constructor), 1843 | ): Fm.Term 1844 | case ctrs { 1845 | cons: case ctrs.head { 1846 | new: 1847 | def name = ctrs.head.name; 1848 | def body = (x) Fm.Constructor.build_term.opt.go(type, ctor, ctrs.tail); 1849 | Fm.Term.lam(name, body) 1850 | }, 1851 | nil: 1852 | case ctor { 1853 | new: 1854 | let ret = Fm.Term.ref(ctor.name); 1855 | let ret = for arg in ctor.args: 1856 | Fm.Term.app(ret, Fm.Term.ref(case arg { new: arg.name })); 1857 | ret 1858 | }, 1859 | } 1860 | 1861 | Fm.Constructor.build_term(type: Fm.Datatype, ctor: Fm.Constructor): Fm.Term 1862 | case type { 1863 | new: case ctor { 1864 | new: Fm.Constructor.build_term.go(type, ctor, type.name, type.pars, ctor.args) 1865 | } 1866 | } 1867 | 1868 | Fm.Constructor.build_term.go( 1869 | type: Fm.Datatype, 1870 | ctor: Fm.Constructor, 1871 | name: Fm.Name, 1872 | pars: List(Fm.Binder), 1873 | args: List(Fm.Binder), 1874 | ): Fm.Term 1875 | case pars { 1876 | cons: case pars.head { 1877 | new: 1878 | def par_name = pars.head.name; 1879 | def par_body = (x) Fm.Constructor.build_term.go(type, ctor, name, pars.tail, args); 1880 | Fm.Term.lam(par_name, par_body), 1881 | }, 1882 | nil: case args { 1883 | cons: case args.head { 1884 | new: 1885 | def ctr_name = args.head.name; 1886 | def ctr_body = (x) Fm.Constructor.build_term.go(type, ctor, name, pars, args.tail); 1887 | Fm.Term.lam(ctr_name, ctr_body), 1888 | }, 1889 | nil: 1890 | def lam_name = Fm.Name.read("P"); 1891 | def lam_body = (x) Fm.Constructor.build_term.opt(type, ctor); 1892 | Fm.Term.lam(lam_name, lam_body), 1893 | } 1894 | } 1895 | 1896 | // Parsing 1897 | // ======= 1898 | 1899 | // Is this character a valid letter? 1900 | Fm.Name.is_letter(chr: Char): Bool 1901 | if U16.btw('A', chr, 'Z') then Bool.true 1902 | else if U16.btw('a', chr, 'z') then Bool.true 1903 | else if U16.btw('0', chr, '9') then Bool.true 1904 | else if U16.eql('.', chr) then Bool.true 1905 | else if U16.eql('_', chr) then Bool.true 1906 | else Bool.false 1907 | 1908 | // Converts a String to a Fm.Name 1909 | Fm.Name.read(str: String): Fm.Name 1910 | str 1911 | 1912 | // Converts a Fm.Name to a String 1913 | Fm.Name.show(name: Fm.Name): String 1914 | name 1915 | 1916 | // Converts a name to a bits 1917 | Fm.Name.to_bits(name: Fm.Name): Bits 1918 | case name { 1919 | nil: 1920 | Bits.e, 1921 | cons: 1922 | let chr = name.head; 1923 | let u16 = 1924 | if U16.btw('A', chr, 'Z') then U16.sub(chr, Nat.to_u16(65)) 1925 | else if U16.btw('a', chr, 'z') then U16.sub(chr, Nat.to_u16(71)) 1926 | else if U16.btw('0', chr, '9') then U16.add(chr, Nat.to_u16(4)) 1927 | else if U16.eql('.', chr) then Nat.to_u16(62) 1928 | else if U16.eql('_', chr) then Nat.to_u16(63) 1929 | else Nat.to_u16(0); 1930 | let bts = case u16 { new: Word.to_bits<6>(Word.trim<16>(6, u16.value)) }; 1931 | Bits.concat(Bits.reverse(bts), Fm.Name.to_bits(name.tail)), 1932 | } 1933 | 1934 | // Converts a bits to a name 1935 | Fm.Name.from_bits(bits: Bits): Fm.Name 1936 | let list = Bits.chunks_of(6, bits); 1937 | let name = List.fold<_>(list)<_>(String.nil, (bts, name) 1938 | let u16 = U16.new(Word.from_bits(16, Bits.reverse(bts))); 1939 | let chr = 1940 | if U16.btw( Nat.to_u16(0), u16, Nat.to_u16(25)) then U16.add(u16, Nat.to_u16(65)) 1941 | else if U16.btw(Nat.to_u16(26), u16, Nat.to_u16(51)) then U16.add(u16, Nat.to_u16(71)) 1942 | else if U16.btw(Nat.to_u16(52), u16, Nat.to_u16(61)) then U16.sub(u16, Nat.to_u16(4)) 1943 | else if U16.eql(Nat.to_u16(62), u16) then Nat.to_u16(46) 1944 | else Nat.to_u16(95); 1945 | String.cons(chr, name)); 1946 | name 1947 | 1948 | // Are two names the same? 1949 | Fm.Name.eql(a: Fm.Name, b: Fm.Name): Bool 1950 | String.eql(a, b) 1951 | 1952 | Fm.backslash: Char 1953 | Nat.to_u16(92) 1954 | 1955 | // String escapable sequences 1956 | // TODO: '\\' isn't working, investigate 1957 | Fm.escapes: List(Pair(String, Char)) 1958 | [ 1959 | {"\\b" , '\b'}, 1960 | {"\\f" , '\f'}, 1961 | {"\\n" , '\n'}, 1962 | {"\\r" , '\r'}, 1963 | {"\\t" , '\t'}, 1964 | {"\\v" , '\v'}, 1965 | {String.cons(Fm.backslash, String.cons(Fm.backslash, String.nil)), Fm.backslash}, 1966 | {"\\\"", '"'}, 1967 | {"\\0" , '\0'}, 1968 | {"\\'" , '\''}, 1969 | ] 1970 | 1971 | Fm.escape.char(chr: Char): String 1972 | if U16.eql(chr, Fm.backslash) then 1973 | String.cons(Fm.backslash, String.cons(chr, String.nil)) 1974 | else if U16.eql(chr, '"') then 1975 | String.cons(Fm.backslash, String.cons(chr, String.nil)) 1976 | else if U16.eql(chr, '\'') then 1977 | String.cons(Fm.backslash, String.cons(chr, String.nil)) 1978 | else if U16.btw(' ', chr, '~') then 1979 | String.cons(chr, String.nil) 1980 | else 1981 | String.flatten([ 1982 | String.cons(Fm.backslash, String.nil), 1983 | "u{", U16.show_hex(chr), "}", 1984 | String.nil, 1985 | ]) 1986 | 1987 | 1988 | Fm.escape(str: String): String 1989 | case str { 1990 | nil: 1991 | String.nil, 1992 | cons: 1993 | let head = Fm.escape.char(str.head); 1994 | let tail = Fm.escape(str.tail); 1995 | String.concat(head, tail) 1996 | } 1997 | 1998 | // Spaces and comments 1999 | Fm.Parser.spaces: Parser(List(Unit)) 2000 | Parser.many<_>(Parser.first_of<_>([ 2001 | Parser.text(" "), 2002 | Parser.text("\n"), 2003 | do Parser { 2004 | Parser.text("//"); 2005 | Parser.until<_>(Parser.text("\n"), Parser.one); 2006 | return Unit.new; 2007 | } 2008 | ])) 2009 | 2010 | Fm.Parser.init: Parser(Nat) 2011 | do Parser { 2012 | Fm.Parser.spaces; 2013 | var from = Parser.get_index; 2014 | return from; 2015 | } 2016 | 2017 | Fm.Parser.stop(from: Nat): Parser(Fm.Origin) 2018 | do Parser { 2019 | var upto = Parser.get_index; 2020 | let orig = Fm.Origin.new("", from, upto); 2021 | return orig; 2022 | } 2023 | 2024 | // Parses spaces then a text 2025 | Fm.Parser.text(text: String): Parser(Unit) 2026 | do Parser { 2027 | Fm.Parser.spaces; 2028 | Parser.text(text); 2029 | } 2030 | 2031 | // Parses a letter: @[a-zA-Z_.]@ 2032 | Fm.Parser.letter: Parser(Fm.Letter) 2033 | (idx, code) case code { 2034 | nil: Parser.Reply.error<_>(idx, code, "Unexpected eof."), 2035 | cons: 2036 | if Fm.Name.is_letter(code.head) then 2037 | Parser.Reply.value<_>(Nat.succ(idx), code.tail, code.head) 2038 | else 2039 | Parser.Reply.error<_>(idx, code, "Expected letter."), 2040 | } 2041 | 2042 | // Parses a (possibly empty) name: @[a-zA-Z_.]*@ 2043 | Fm.Parser.name: Parser(Fm.Name) 2044 | do Parser { 2045 | Fm.Parser.spaces; 2046 | var chrs = Parser.many(Fm.Parser.letter); 2047 | return List.fold<_>(chrs)<_>(String.nil, String.cons); 2048 | } 2049 | 2050 | // Parses a non-empty name: @[a-zA-Z_.]+@ 2051 | Fm.Parser.name1: Parser(Fm.Name) 2052 | do Parser { 2053 | Fm.Parser.spaces; 2054 | var chrs = Parser.many1(Fm.Parser.letter); 2055 | return List.fold<_>(chrs)<_>(String.nil, String.cons); 2056 | } 2057 | 2058 | // Parses a type: @Type@ 2059 | Fm.Parser.type: Parser(Fm.Term) 2060 | do Parser { 2061 | var init = Fm.Parser.init; 2062 | Fm.Parser.text("Type"); 2063 | var orig = Fm.Parser.stop(init); 2064 | return Fm.Term.ori(orig, Fm.Term.typ); 2065 | } 2066 | 2067 | // Parses a lambda (erased): @ body@ 2068 | Fm.Parser.lambda.erased: Parser(Fm.Term) 2069 | do Parser { 2070 | var init = Fm.Parser.init; 2071 | Fm.Parser.text("<"); 2072 | var name = Parser.until1<_>( 2073 | Fm.Parser.text(">"), 2074 | Fm.Parser.item<_>(Fm.Parser.name1)); 2075 | var body = Fm.Parser.term; 2076 | var orig = Fm.Parser.stop(init); 2077 | let expr = Fm.Parser.make_lambda(name, body); 2078 | return Fm.Term.ori(orig, expr); 2079 | } 2080 | 2081 | // Parses a lambda: @(name) body@ 2082 | Fm.Parser.lambda: Parser(Fm.Term) 2083 | do Parser { 2084 | var init = Fm.Parser.init; 2085 | Fm.Parser.text("("); 2086 | var name = Parser.until1<_>( 2087 | Fm.Parser.text(")"), 2088 | Fm.Parser.item<_>(Fm.Parser.name1)); 2089 | var body = Fm.Parser.term; 2090 | var orig = Fm.Parser.stop(init); 2091 | let expr = Fm.Parser.make_lambda(name, body); 2092 | return Fm.Term.ori(orig, expr); 2093 | } 2094 | 2095 | // Parses a lambda: @() body@ 2096 | Fm.Parser.lambda.nameless: Parser(Fm.Term) 2097 | do Parser { 2098 | var init = Fm.Parser.init; 2099 | Fm.Parser.text("()"); 2100 | var body = Fm.Parser.term; 2101 | var orig = Fm.Parser.stop(init); 2102 | let expr = Fm.Term.lam("", (x) body); 2103 | return Fm.Term.ori(orig, expr); 2104 | } 2105 | 2106 | // Parses a parenthesis: @(term)@ 2107 | Fm.Parser.parenthesis: Parser(Fm.Term) 2108 | do Parser { 2109 | Fm.Parser.text("("); 2110 | var term = Fm.Parser.term; 2111 | Fm.Parser.text(")"); 2112 | return term; 2113 | } 2114 | 2115 | // Parses a name:term pair 2116 | Fm.Parser.name_term: Parser(Pair(Fm.Name, Fm.Term)) 2117 | do Parser { 2118 | var name = Fm.Parser.name; 2119 | Fm.Parser.text(":"); 2120 | var type = Fm.Parser.term; 2121 | return {name, type}; 2122 | } 2123 | 2124 | // Parses a binding list, @(a: A, b: B, c: C)@ 2125 | Fm.Parser.binder.homo(eras: Bool): Parser(List(Fm.Binder)) 2126 | do Parser { 2127 | Fm.Parser.text(if eras then "<" else "("); 2128 | var bind = Parser.until1<_>( 2129 | Fm.Parser.text(if eras then ">" else ")"), 2130 | Fm.Parser.item<_>(Fm.Parser.name_term)); 2131 | return List.mapped<_>(bind)<_>((pair) case pair { 2132 | new: Fm.Binder.new(eras, pair.fst, pair.snd) 2133 | }); 2134 | } 2135 | 2136 | // Parses a mixed binding list, @(c: C, d: D)@ 2137 | Fm.Parser.binder: Parser(List(Fm.Binder)) 2138 | do Parser { 2139 | var lists = Parser.many1<_>(Parser.first_of<_>([ 2140 | Fm.Parser.binder.homo(Bool.true), 2141 | Fm.Parser.binder.homo(Bool.false), 2142 | ])); 2143 | return List.flatten<_>(lists); 2144 | } 2145 | 2146 | // Parses a forall: @self(a: A, b: B, c: C) D@ 2147 | Fm.Parser.forall: Parser(Fm.Term) 2148 | do Parser { 2149 | var init = Fm.Parser.init; 2150 | var self = Fm.Parser.name; 2151 | var bind = Fm.Parser.binder; 2152 | Parser.maybe<_>(Fm.Parser.text("->")); 2153 | var body = Fm.Parser.term; 2154 | let term = List.fold<_>(bind)<_>(body, (x,t) case x { 2155 | new: Fm.Term.all(x.eras, "", x.name, x.term, (s,x) t) 2156 | }); 2157 | var orig = Fm.Parser.stop(init); 2158 | return case term { 2159 | all: Fm.Term.ori(orig, Fm.Term.all(term.eras, self, term.name, term.xtyp, term.body)), 2160 | _: term, 2161 | }; 2162 | } 2163 | 2164 | // Parses a let: @let name = expr; body@ 2165 | Fm.Parser.let: Parser(Fm.Term) 2166 | do Parser { 2167 | var init = Fm.Parser.init; 2168 | Fm.Parser.text("let "); 2169 | var name = Fm.Parser.name; 2170 | Fm.Parser.text("="); 2171 | var expr = Fm.Parser.term; 2172 | Parser.maybe<_>(Fm.Parser.text(";")); 2173 | var body = Fm.Parser.term; 2174 | var orig = Fm.Parser.stop(init); 2175 | return Fm.Term.ori(orig, Fm.Term.let(name, expr, (x) body)); 2176 | } 2177 | 2178 | // Parses a getter: @let {x,y} = expr; body@ 2179 | Fm.Parser.get: Parser(Fm.Term) 2180 | do Parser { 2181 | var init = Fm.Parser.init; 2182 | Fm.Parser.text("let "); 2183 | Fm.Parser.text("{"); 2184 | var nam0 = Fm.Parser.name; 2185 | Fm.Parser.text(","); 2186 | var nam1 = Fm.Parser.name; 2187 | Fm.Parser.text("}"); 2188 | Fm.Parser.text("="); 2189 | var expr = Fm.Parser.term; 2190 | Parser.maybe<_>(Fm.Parser.text(";")); 2191 | var body = Fm.Parser.term; 2192 | var orig = Fm.Parser.stop(init); 2193 | let term = expr; 2194 | let term = Fm.Term.app(term, Fm.Term.lam("x", (x) Fm.Term.hol(Bits.e))); 2195 | let term = Fm.Term.app(term, Fm.Term.lam(nam0, (x) Fm.Term.lam(nam1, (y) body))); 2196 | return Fm.Term.ori(orig, term); 2197 | } 2198 | 2199 | // Parses a def: @def name = expr; body@ 2200 | Fm.Parser.def: Parser(Fm.Term) 2201 | do Parser { 2202 | var init = Fm.Parser.init; 2203 | Fm.Parser.text("def "); 2204 | var name = Fm.Parser.name; 2205 | Fm.Parser.text("="); 2206 | var expr = Fm.Parser.term; 2207 | Parser.maybe<_>(Fm.Parser.text(";")); 2208 | var body = Fm.Parser.term; 2209 | var orig = Fm.Parser.stop(init); 2210 | return Fm.Term.ori(orig, Fm.Term.def(name, expr, (x) body)); 2211 | } 2212 | 2213 | // Parses an if-then-else: @if b then t else f@ 2214 | Fm.Parser.if: Parser(Fm.Term) 2215 | do Parser { 2216 | var init = Fm.Parser.init; 2217 | Fm.Parser.text("if "); 2218 | var cond = Fm.Parser.term; 2219 | Fm.Parser.text("then"); 2220 | var tcse = Fm.Parser.term; 2221 | Fm.Parser.text("else"); 2222 | var fcse = Fm.Parser.term; 2223 | var orig = Fm.Parser.stop(init); 2224 | let term = cond; 2225 | let term = Fm.Term.app(term, Fm.Term.lam("", (x) Fm.Term.hol(Bits.e))); 2226 | let term = Fm.Term.app(term, tcse); 2227 | let term = Fm.Term.app(term, fcse); 2228 | return Fm.Term.ori(orig, term); 2229 | } 2230 | 2231 | // Parses a single char 2232 | Fm.Parser.char.single: Parser(Char) 2233 | Parser.first_of<_>([ 2234 | Parser.first_of<_>(List.mapped<_>(Fm.escapes)<_>((esc) case esc { 2235 | new: do Parser { 2236 | Parser.text(esc.fst); 2237 | return esc.snd; 2238 | } 2239 | })), 2240 | Parser.one, 2241 | ]) 2242 | 2243 | // Parses a char literal: @'x'@ 2244 | Fm.Parser.char: Parser(Fm.Term) 2245 | do Parser { 2246 | var init = Fm.Parser.init; 2247 | Fm.Parser.text("'"); 2248 | var chrx = Fm.Parser.char.single; 2249 | Parser.text("'"); 2250 | var orig = Fm.Parser.stop(init); 2251 | return Fm.Term.ori(orig, Fm.Term.chr(chrx)); 2252 | } 2253 | 2254 | // Parses a string literal: @"foo"@ 2255 | Fm.Parser.string: Parser(Fm.Term) 2256 | do Parser { 2257 | var init = Fm.Parser.init; 2258 | let quot = String.cons('"', String.nil); 2259 | Fm.Parser.text(quot); 2260 | var chrs = Parser.until<_>(Parser.text(quot), Fm.Parser.char.single); 2261 | let strx = List.fold<_>(chrs)<_>(String.nil, String.cons); 2262 | var orig = Fm.Parser.stop(init); 2263 | return Fm.Term.ori(orig, Fm.Term.str(strx)); 2264 | } 2265 | 2266 | // Parses a pair literal: @{1, 2}@ 2267 | Fm.Parser.pair: Parser(Fm.Term) 2268 | do Parser { 2269 | var init = Fm.Parser.init; 2270 | Fm.Parser.text("{"); 2271 | var val0 = Fm.Parser.term; 2272 | Fm.Parser.text(","); 2273 | var val1 = Fm.Parser.term; 2274 | Fm.Parser.text("}"); 2275 | var orig = Fm.Parser.stop(init); 2276 | let term = Fm.Term.ref("Pair.new"); 2277 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2278 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2279 | let term = Fm.Term.app(term, val0); 2280 | let term = Fm.Term.app(term, val1); 2281 | return Fm.Term.ori(orig, term); 2282 | } 2283 | 2284 | // Parses a sigma type literal: @{x : A} P(x)@ 2285 | Fm.Parser.sigma.type: Parser(Fm.Term) 2286 | do Parser { 2287 | var init = Fm.Parser.init; 2288 | Fm.Parser.text("{"); 2289 | var name = Fm.Parser.name1; 2290 | Fm.Parser.text(":"); 2291 | var typ0 = Fm.Parser.term; 2292 | Fm.Parser.text("}"); 2293 | var typ1 = Fm.Parser.term; 2294 | var orig = Fm.Parser.stop(init); 2295 | let term = Fm.Term.ref("Sigma"); 2296 | let term = Fm.Term.app(term, typ0); 2297 | let term = Fm.Term.app(term, Fm.Term.lam("x", (x) typ1)); 2298 | return Fm.Term.ori(orig, term); 2299 | } 2300 | 2301 | // Parses the some constructor of the Maybe type: @some(x)@ 2302 | Fm.Parser.some: Parser(Fm.Term) 2303 | do Parser { 2304 | var init = Fm.Parser.init; 2305 | Fm.Parser.text("some("); 2306 | var expr = Fm.Parser.term; 2307 | Fm.Parser.text(")"); 2308 | var orig = Fm.Parser.stop(init); 2309 | let term = Fm.Term.ref("Maybe.some"); 2310 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2311 | let term = Fm.Term.app(term, expr); 2312 | return Fm.Term.ori(orig, term); 2313 | } 2314 | 2315 | // Parses the Equal.apply function: @apply(f,x)@ 2316 | Fm.Parser.apply: Parser(Fm.Term) 2317 | do Parser { 2318 | var init = Fm.Parser.init; 2319 | Fm.Parser.text("apply("); 2320 | var func = Fm.Parser.term; 2321 | Fm.Parser.text(","); 2322 | var equa = Fm.Parser.term; 2323 | Fm.Parser.text(")"); 2324 | var orig = Fm.Parser.stop(init); 2325 | let term = Fm.Term.ref("Equal.apply"); 2326 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2327 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2328 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2329 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2330 | let term = Fm.Term.app(term, func); 2331 | let term = Fm.Term.app(term, equa); 2332 | return Fm.Term.ori(orig, term); 2333 | } 2334 | 2335 | // Parses a list literal: @[1, 2, 3]@ 2336 | Fm.Parser.list: Parser(Fm.Term) 2337 | do Parser { 2338 | var init = Fm.Parser.init; 2339 | Fm.Parser.text("["); 2340 | var vals = Parser.until<_>( 2341 | Fm.Parser.text("]"), 2342 | Fm.Parser.item<_>(Fm.Parser.term)); 2343 | var orig = Fm.Parser.stop(init); 2344 | return List.fold<_>(vals)<_>( 2345 | Fm.Term.app(Fm.Term.ref(Fm.Name.read("List.nil")), Fm.Term.hol(Bits.e)), 2346 | (x,xs) 2347 | let term = Fm.Term.ref(Fm.Name.read("List.cons")); 2348 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2349 | let term = Fm.Term.app(term, x); 2350 | let term = Fm.Term.app(term, xs); 2351 | Fm.Term.ori(orig, term)); 2352 | } 2353 | 2354 | // Parses a logger: @log("foo", "bar")@ 2355 | Fm.Parser.log: Parser(Fm.Term) 2356 | do Parser { 2357 | var init = Fm.Parser.init; 2358 | Fm.Parser.text("log("); 2359 | var strs = Parser.until<_>(Fm.Parser.text(")"), Fm.Parser.item<_>(Fm.Parser.term)); 2360 | var cont = Fm.Parser.term; 2361 | let term = Fm.Term.ref("Debug.log"); 2362 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2363 | let args = List.fold<_>(strs)<_>(Fm.Term.ref("String.nil"), (x,xs) 2364 | let arg = Fm.Term.ref("String.concat"); 2365 | let arg = Fm.Term.app(arg, x); 2366 | let arg = Fm.Term.app(arg, xs); 2367 | arg); 2368 | let term = Fm.Term.app(term, args); 2369 | let term = Fm.Term.app(term, Fm.Term.lam("x", (x) cont)); 2370 | var orig = Fm.Parser.stop(init); 2371 | return Fm.Term.ori(orig, term); 2372 | } 2373 | 2374 | // Parses a for-in expression 2375 | Fm.Parser.forin: Parser(Fm.Term) 2376 | do Parser { 2377 | var init = Fm.Parser.init; 2378 | Fm.Parser.text("for "); 2379 | var elem = Fm.Parser.name1; 2380 | Fm.Parser.text("in"); 2381 | var list = Fm.Parser.term; 2382 | Fm.Parser.text("with"); 2383 | var name = Fm.Parser.name1; 2384 | Fm.Parser.text(":"); 2385 | var loop = Fm.Parser.term; 2386 | var orig = Fm.Parser.stop(init); 2387 | let term = Fm.Term.ref("List.for"); 2388 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2389 | let term = Fm.Term.app(term, list); 2390 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2391 | let term = Fm.Term.app(term, Fm.Term.ref(name)); 2392 | let lamb = Fm.Term.lam(elem, (i) Fm.Term.lam(name, (x) loop)); 2393 | let term = Fm.Term.app(term, lamb); 2394 | let term = Fm.Term.let(name, term, (x) Fm.Term.ref(name)); 2395 | return Fm.Term.ori(orig, term); 2396 | } 2397 | 2398 | // Parses a for-in expression, second style 2399 | Fm.Parser.forin2: Parser(Fm.Term) 2400 | do Parser { 2401 | var init = Fm.Parser.init; 2402 | Fm.Parser.text("for "); 2403 | var elem = Fm.Parser.name1; 2404 | Fm.Parser.text("in"); 2405 | var list = Fm.Parser.term; 2406 | Fm.Parser.text(":"); 2407 | var name = Fm.Parser.name1; 2408 | Fm.Parser.text("="); 2409 | var loop = Fm.Parser.term; 2410 | Parser.maybe<_>(Fm.Parser.text(";")); 2411 | var body = Fm.Parser.term; 2412 | var orig = Fm.Parser.stop(init); 2413 | let term = Fm.Term.ref("List.for"); 2414 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2415 | let term = Fm.Term.app(term, list); 2416 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2417 | let term = Fm.Term.app(term, Fm.Term.ref(name)); 2418 | let lamb = Fm.Term.lam(elem, (i) Fm.Term.lam(name, (x) loop)); 2419 | let term = Fm.Term.app(term, lamb); 2420 | let term = Fm.Term.let(name, term, (x) body); 2421 | return Fm.Term.ori(orig, term); 2422 | } 2423 | 2424 | // Parses a let-for-in expression 2425 | Fm.Parser.letforin: Parser(Fm.Term) 2426 | do Parser { 2427 | var init = Fm.Parser.init; 2428 | Fm.Parser.text("let "); 2429 | var name = Fm.Parser.name1; 2430 | Fm.Parser.text("="); 2431 | Fm.Parser.text("for "); 2432 | var elem = Fm.Parser.name1; 2433 | Fm.Parser.text("in"); 2434 | var list = Fm.Parser.term; 2435 | Fm.Parser.text(":"); 2436 | var loop = Fm.Parser.term; 2437 | Parser.maybe<_>(Fm.Parser.text(";")); 2438 | var body = Fm.Parser.term; 2439 | var orig = Fm.Parser.stop(init); 2440 | let term = Fm.Term.ref("List.for"); 2441 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2442 | let term = Fm.Term.app(term, list); 2443 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2444 | let term = Fm.Term.app(term, Fm.Term.ref(name)); 2445 | let lamb = Fm.Term.lam(elem, (i) Fm.Term.lam(name, (x) loop)); 2446 | let term = Fm.Term.app(term, lamb); 2447 | let term = Fm.Term.let(name, term, (x) body); 2448 | return Fm.Term.ori(orig, term); 2449 | } 2450 | 2451 | // Parses statements of the do-notation 2452 | Fm.Parser.do.statements(monad_name: Fm.Name): Parser(Fm.Term) 2453 | Parser.first_of<_>([ 2454 | // Binding call: @ask x = expr; rest@ 2455 | do Parser { 2456 | var init = Fm.Parser.init; 2457 | Fm.Parser.text("var "); 2458 | var name = Fm.Parser.name1; 2459 | Fm.Parser.text("="); 2460 | var expr = Fm.Parser.term; 2461 | Parser.maybe<_>(Fm.Parser.text(";")); 2462 | var body = Fm.Parser.do.statements(monad_name); 2463 | var orig = Fm.Parser.stop(init); 2464 | let term = Fm.Term.app(Fm.Term.ref("Monad.bind"), Fm.Term.ref(monad_name)); 2465 | let term = Fm.Term.app(term, Fm.Term.ref(String.concat(monad_name, ".monad"))); 2466 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2467 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2468 | let term = Fm.Term.app(term, expr); 2469 | let term = Fm.Term.app(term, Fm.Term.lam(name, (x) body)); 2470 | return Fm.Term.ori(orig, term); 2471 | }, 2472 | // Local definition (let): @let x = expr; rest@ 2473 | do Parser { 2474 | var init = Fm.Parser.init; 2475 | Fm.Parser.text("let "); 2476 | var name = Fm.Parser.name1; 2477 | Fm.Parser.text("="); 2478 | var expr = Fm.Parser.term; 2479 | Parser.maybe<_>(Fm.Parser.text(";")); 2480 | var body = Fm.Parser.do.statements(monad_name); 2481 | var orig = Fm.Parser.stop(init); 2482 | return Fm.Term.ori(orig, Fm.Term.let(name, expr, (x) body)); 2483 | }, 2484 | // Return pure: @return expr;@ 2485 | do Parser { 2486 | var init = Fm.Parser.init; 2487 | Fm.Parser.text("return "); 2488 | var expr = Fm.Parser.term; 2489 | Parser.maybe<_>(Fm.Parser.text(";")); 2490 | var orig = Fm.Parser.stop(init); 2491 | let term = Fm.Term.app(Fm.Term.ref("Monad.pure"), Fm.Term.ref(monad_name)); 2492 | let term = Fm.Term.app(term, Fm.Term.ref(String.concat(monad_name, ".monad"))); 2493 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2494 | let term = Fm.Term.app(term, expr); 2495 | return Fm.Term.ori(orig, term); 2496 | }, 2497 | // Non-binding call: @expr; rest@ 2498 | do Parser { 2499 | var init = Fm.Parser.init; 2500 | var expr = Fm.Parser.term; 2501 | Parser.maybe<_>(Fm.Parser.text(";")); 2502 | var body = Fm.Parser.do.statements(monad_name); 2503 | var orig = Fm.Parser.stop(init); 2504 | let term = Fm.Term.app(Fm.Term.ref("Monad.bind"), Fm.Term.ref(monad_name)); 2505 | let term = Fm.Term.app(term, Fm.Term.ref(String.concat(monad_name, ".monad"))); 2506 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2507 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2508 | let term = Fm.Term.app(term, expr); 2509 | let term = Fm.Term.app(term, Fm.Term.lam("", (x) body)); 2510 | return Fm.Term.ori(orig, term); 2511 | }, 2512 | // Return direct: @expr;@ 2513 | do Parser { 2514 | var expr = Fm.Parser.term; 2515 | Parser.maybe<_>(Fm.Parser.text(";")); 2516 | return expr; 2517 | }, 2518 | ]) 2519 | 2520 | // Parses a block of the do-notation 2521 | Fm.Parser.do: Parser(Fm.Term) 2522 | do Parser { 2523 | Fm.Parser.text("do "); 2524 | var name = Fm.Parser.name1; 2525 | Fm.Parser.text("{"); 2526 | var term = Fm.Parser.do.statements(name); 2527 | Fm.Parser.text("}"); 2528 | return term; 2529 | } 2530 | 2531 | // Parses a with statement of a case 2532 | Fm.Parser.case.with: Parser(Fm.Def) 2533 | do Parser { 2534 | Fm.Parser.text("with"); 2535 | var name = Fm.Parser.name1; 2536 | Fm.Parser.text(":"); 2537 | var type = Fm.Parser.term; 2538 | Fm.Parser.text("="); 2539 | var term = Fm.Parser.term; 2540 | return Fm.Def.new("", "", name, term, type, Fm.Status.init); 2541 | } 2542 | 2543 | // Parses a case statement of a case 2544 | Fm.Parser.case.case: Parser(Pair(Fm.Name, Fm.Term)) 2545 | do Parser { 2546 | var name = Fm.Parser.name1; 2547 | Fm.Parser.text(":"); 2548 | var term = Fm.Parser.term; 2549 | Parser.maybe<_>(Fm.Parser.text(",")); 2550 | return {name, term}; 2551 | } 2552 | 2553 | // Parses a case: @case f(x) as k with a:A = X; { zero: x, succ: y } : T@ 2554 | Fm.Parser.case: Parser(Fm.Term) 2555 | do Parser { 2556 | var init = Fm.Parser.init; 2557 | Fm.Parser.text("case "); 2558 | Fm.Parser.spaces; 2559 | var expr = Fm.Parser.term; 2560 | var name = Parser.maybe<_>(do Parser { 2561 | Fm.Parser.text("as"); 2562 | Fm.Parser.name1; 2563 | }); 2564 | let name = case name { 2565 | none: case Fm.Term.reduce(expr, Map.new<_>) as expr { 2566 | ref: expr.name, 2567 | var: expr.name, 2568 | _: Fm.Name.read("self"), 2569 | }, 2570 | some: name.value, 2571 | }; 2572 | var wyth = Parser.many<_>(Fm.Parser.case.with); 2573 | Fm.Parser.text("{"); 2574 | var cses = Parser.until<_>(Fm.Parser.text("}"), Fm.Parser.case.case); 2575 | let cses = Map.from_list<_,_>(Fm.Name.to_bits, cses); 2576 | var moti = Parser.first_of<_>([ 2577 | // Explicit motive 2578 | do Parser { 2579 | Fm.Parser.text(":"); 2580 | var term = Fm.Parser.term; 2581 | return Maybe.some<_>(term); 2582 | }, 2583 | // Smart motive 2584 | do Parser { 2585 | Fm.Parser.text("!"); 2586 | return Maybe.none<_>; 2587 | }, 2588 | // Hole motive 2589 | do Parser { 2590 | return Maybe.some<_>(Fm.Term.hol(Bits.e)); 2591 | }, 2592 | ]); 2593 | var orig = Fm.Parser.stop(init); 2594 | //let moti = case moti { none: Fm.Term.hol(Bits.e), some: moti.value }; 2595 | return Fm.Term.ori(orig, Fm.Term.cse(Bits.e, expr, name, wyth, cses, moti)); 2596 | } 2597 | 2598 | // Parses a case: @case f(x) as k with a:A = X; { zero: x, succ: y } : T@ 2599 | Fm.Parser.open: Parser(Fm.Term) 2600 | do Parser { 2601 | var init = Fm.Parser.init; 2602 | Fm.Parser.text("open "); 2603 | Fm.Parser.spaces; 2604 | var expr = Fm.Parser.term; 2605 | var name = Parser.maybe<_>(do Parser { 2606 | Fm.Parser.text("as"); 2607 | Fm.Parser.name1; 2608 | }); 2609 | Parser.maybe<_>(Fm.Parser.text(";")); 2610 | let name = case name { 2611 | none: case Fm.Term.reduce(expr, Map.new<_>) as expr { 2612 | ref: expr.name, 2613 | var: expr.name, 2614 | _: Fm.Name.read("self"), 2615 | }, 2616 | some: name.value, 2617 | }; 2618 | let wyth = []; 2619 | var rest = Fm.Parser.term; 2620 | let cses = Map.from_list<_,_>(Fm.Name.to_bits, [{"_",rest}]); 2621 | let moti = Maybe.some<_>(Fm.Term.hol(Bits.e)); 2622 | var orig = Fm.Parser.stop(init); 2623 | return Fm.Term.ori(orig, Fm.Term.cse(Bits.e, expr, name, wyth, cses, moti)); 2624 | } 2625 | 2626 | // Parses a goal: @?name@ 2627 | Fm.Parser.goal: Parser(Fm.Term) 2628 | do Parser { 2629 | var init = Fm.Parser.init; 2630 | Fm.Parser.text("?"); 2631 | var name = Fm.Parser.name; 2632 | var dref = Parser.many<_>(do Parser { 2633 | Fm.Parser.text("-"); 2634 | var nat = Parser.nat; 2635 | let bits = Bits.reverse(Bits.tail(Bits.reverse(Nat.to_bits(nat)))); 2636 | do Parser { return bits; }; 2637 | }); 2638 | var verb = do Parser { 2639 | var verb = Parser.maybe<_>(Parser.text("-")); 2640 | return Maybe.to_bool<_>(verb); 2641 | }; 2642 | var orig = Fm.Parser.stop(init); 2643 | return Fm.Term.ori(orig, Fm.Term.gol(name, dref, verb)); 2644 | } 2645 | 2646 | // Parses a hole: @_@ 2647 | Fm.Parser.hole: Parser(Fm.Term) 2648 | do Parser { 2649 | var init = Fm.Parser.init; 2650 | Fm.Parser.text("_"); 2651 | var orig = Fm.Parser.stop(init); 2652 | return Fm.Term.ori(orig, Fm.Term.hol(Bits.e)); 2653 | } 2654 | 2655 | // Parses a natural number: @123@ 2656 | Fm.Parser.nat: Parser(Fm.Term) 2657 | do Parser { 2658 | var init = Fm.Parser.init; 2659 | Fm.Parser.spaces; 2660 | var natx = Parser.nat; 2661 | var orig = Fm.Parser.stop(init); 2662 | return Fm.Term.ori(orig, Fm.Term.nat(natx)); 2663 | } 2664 | 2665 | // Parses a reference: @name@ 2666 | Fm.Parser.reference: Parser(Fm.Term) 2667 | do Parser { 2668 | var init = Fm.Parser.init; 2669 | var name = Fm.Parser.name1; 2670 | if String.eql(name, "case") then do Parser { 2671 | Parser.fail<_>("Reserved keyword."); 2672 | } else if String.eql(name, "do") then do Parser { 2673 | Parser.fail<_>("Reserved keyword."); 2674 | } else if String.eql(name, "if") then do Parser { 2675 | Parser.fail<_>("Reserved keyword."); 2676 | //} else if String.eql(name, "then") then do Parser { 2677 | //Parser.fail<_>("Reserved keyword."); 2678 | //} else if String.eql(name, "else") then do Parser { 2679 | //Parser.fail<_>("Reserved keyword."); 2680 | } else if String.eql(name, "let") then do Parser { 2681 | Parser.fail<_>("Reserved keyword."); 2682 | } else if String.eql(name, "def") then do Parser { 2683 | Parser.fail<_>("Reserved keyword."); 2684 | } else if String.eql(name, "true") then do Parser { 2685 | return Fm.Term.ref("Bool.true"); 2686 | } else if String.eql(name, "false") then do Parser { 2687 | return Fm.Term.ref("Bool.false"); 2688 | } else if String.eql(name, "unit") then do Parser { 2689 | return Fm.Term.ref("Unit.new"); 2690 | } else if String.eql(name, "none") then do Parser { 2691 | let term = Fm.Term.ref("Maybe.none"); 2692 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2693 | return term; 2694 | } else if String.eql(name, "refl") then do Parser { 2695 | let term = Fm.Term.ref("Equal.refl"); 2696 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2697 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2698 | return term; 2699 | } else do Parser { 2700 | var orig = Fm.Parser.stop(init); 2701 | return Fm.Term.ori(orig, Fm.Term.ref(name)); 2702 | }; 2703 | } 2704 | 2705 | // Parses an optional comma after 2706 | Fm.Parser.item(parser: Parser(V)): Parser(V) 2707 | do Parser { 2708 | Fm.Parser.spaces; 2709 | var value = parser; 2710 | Parser.maybe<_>(Fm.Parser.text(",")); 2711 | return value; 2712 | } 2713 | 2714 | // Parses an application (erased): @func@ 2715 | Fm.Parser.application.erased(init: Nat, func: Fm.Term): Parser(Fm.Term) 2716 | do Parser { 2717 | var init = Parser.get_index; 2718 | Parser.text("<"); 2719 | var args = Parser.until1<_>( 2720 | Parser.spaces_text(">"), 2721 | Fm.Parser.item<_>(Fm.Parser.term)); 2722 | var orig = Fm.Parser.stop(init); 2723 | let expr = List.for<_>(args)<_>(func, (x,f) Fm.Term.app(f, x)); 2724 | return Fm.Term.ori(orig, expr); 2725 | } 2726 | 2727 | // Parses an application: @func@ 2728 | Fm.Parser.application(init: Nat, func: Fm.Term): Parser(Fm.Term) 2729 | do Parser { 2730 | Parser.text("("); 2731 | var args = Parser.until1<_>( 2732 | Fm.Parser.text(")"), 2733 | Fm.Parser.item<_>(Fm.Parser.term)); 2734 | var orig = Fm.Parser.stop(init); 2735 | let expr = List.for<_>(args)<_>(func, (x,f) Fm.Term.app(f, x)); 2736 | return Fm.Term.ori(orig, expr); 2737 | } 2738 | 2739 | // Parses an arrow: @A -> B@ 2740 | Fm.Parser.arrow(init: Nat, xtyp: Fm.Term): Parser(Fm.Term) 2741 | do Parser { 2742 | Fm.Parser.text("->"); 2743 | var body = Fm.Parser.term; 2744 | var orig = Fm.Parser.stop(init); 2745 | return Fm.Term.ori(orig, Fm.Term.all(Bool.false, "", "", xtyp, (s,x) body)); 2746 | } 2747 | 2748 | // Parses an operation: @x + y@ 2749 | Fm.Parser.op(sym: String, ref: String, init: Nat, val0: Fm.Term): Parser(Fm.Term) 2750 | do Parser { 2751 | Fm.Parser.text(sym); 2752 | var val1 = Fm.Parser.term; 2753 | var orig = Fm.Parser.stop(init); 2754 | let term = Fm.Term.ref(ref); 2755 | let term = Fm.Term.app(term, val0); 2756 | let term = Fm.Term.app(term, val1); 2757 | return Fm.Term.ori(orig, term); 2758 | } 2759 | 2760 | // Parses an addition: @x + y@ 2761 | Fm.Parser.add: Nat -> Fm.Term -> Parser(Fm.Term) 2762 | Fm.Parser.op("+", "Nat.add") 2763 | 2764 | // Parses a subtraction: @x - y@ 2765 | Fm.Parser.sub: Nat -> Fm.Term -> Parser(Fm.Term) 2766 | Fm.Parser.op("+", "Nat.add") 2767 | 2768 | // Parses a multiplication: @x * y@ 2769 | Fm.Parser.mul: Nat -> Fm.Term -> Parser(Fm.Term) 2770 | Fm.Parser.op("*", "Nat.mul") 2771 | 2772 | // Parses a division: @x / y@ 2773 | Fm.Parser.div: Nat -> Fm.Term -> Parser(Fm.Term) 2774 | Fm.Parser.op("/", "Nat.div") 2775 | 2776 | // Parses a modulus: @x % y@ 2777 | Fm.Parser.mod: Nat -> Fm.Term -> Parser(Fm.Term) 2778 | Fm.Parser.op("%", "Nat.mod") 2779 | 2780 | // Parses a list conser: @head & tail@ 2781 | Fm.Parser.cons(init: Nat, head: Fm.Term): Parser(Fm.Term) 2782 | do Parser { 2783 | Fm.Parser.text("&"); 2784 | var tail = Fm.Parser.term; 2785 | var orig = Fm.Parser.stop(init); 2786 | let term = Fm.Term.ref("List.cons"); 2787 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2788 | let term = Fm.Term.app(term, head); 2789 | let term = Fm.Term.app(term, tail); 2790 | var orig = Fm.Parser.stop(init); 2791 | return Fm.Term.ori(orig, term); 2792 | } 2793 | 2794 | // Parses a list concat: @xs ++ ys@ 2795 | Fm.Parser.concat(init: Nat, lst0: Fm.Term): Parser(Fm.Term) 2796 | do Parser { 2797 | Fm.Parser.text("++"); 2798 | var lst1 = Fm.Parser.term; 2799 | var orig = Fm.Parser.stop(init); 2800 | let term = Fm.Term.ref("List.concat"); 2801 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2802 | let term = Fm.Term.app(term, lst0); 2803 | let term = Fm.Term.app(term, lst1); 2804 | var orig = Fm.Parser.stop(init); 2805 | return Fm.Term.ori(orig, term); 2806 | } 2807 | 2808 | // Parses a string concat: @xs | ys@ 2809 | Fm.Parser.string_concat(init: Nat, str0: Fm.Term): Parser(Fm.Term) 2810 | do Parser { 2811 | Fm.Parser.text("|"); 2812 | var str1 = Fm.Parser.term; 2813 | var orig = Fm.Parser.stop(init); 2814 | let term = Fm.Term.ref("String.concat"); 2815 | let term = Fm.Term.app(term, str0); 2816 | let term = Fm.Term.app(term, str1); 2817 | var orig = Fm.Parser.stop(init); 2818 | return Fm.Term.ori(orig, term); 2819 | } 2820 | 2821 | // Parses a sigma literal: @1 ~ 2@ 2822 | Fm.Parser.sigma(init: Nat, val0: Fm.Term): Parser(Fm.Term) 2823 | do Parser { 2824 | Fm.Parser.text("~"); 2825 | var val1 = Fm.Parser.term; 2826 | var orig = Fm.Parser.stop(init); 2827 | let term = Fm.Term.ref("Sigma.new"); 2828 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2829 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2830 | let term = Fm.Term.app(term, val0); 2831 | let term = Fm.Term.app(term, val1); 2832 | return Fm.Term.ori(orig, term); 2833 | } 2834 | 2835 | // Parses an equality: @a == b@ 2836 | Fm.Parser.equality(init: Nat, val0: Fm.Term): Parser(Fm.Term) 2837 | do Parser { 2838 | Fm.Parser.text("=="); 2839 | var val1 = Fm.Parser.term; 2840 | var orig = Fm.Parser.stop(init); 2841 | let term = Fm.Term.ref("Equal"); 2842 | let term = Fm.Term.app(term, Fm.Term.hol(Bits.e)); 2843 | let term = Fm.Term.app(term, val0); 2844 | let term = Fm.Term.app(term, val1); 2845 | return Fm.Term.ori(orig, term); 2846 | } 2847 | 2848 | // Parses an annotation: @term :: type@ 2849 | Fm.Parser.annotation(init: Nat, term: Fm.Term): Parser(Fm.Term) 2850 | do Parser { 2851 | Fm.Parser.text("::"); 2852 | var type = Fm.Parser.term; 2853 | var orig = Fm.Parser.stop(init); 2854 | return Fm.Term.ori(orig, Fm.Term.ann(Bool.false, term, type)); 2855 | } 2856 | 2857 | // Parses a core term (prefix phase) 2858 | Fm.Parser.term: Parser(Fm.Term) 2859 | do Parser { 2860 | var code = Parser.get_code; 2861 | var init = Fm.Parser.init; 2862 | var term = Parser.first_of<_>([ 2863 | Fm.Parser.type, 2864 | Fm.Parser.forall, 2865 | Fm.Parser.lambda, 2866 | Fm.Parser.lambda.erased, 2867 | Fm.Parser.lambda.nameless, 2868 | Fm.Parser.parenthesis, 2869 | Fm.Parser.letforin, 2870 | Fm.Parser.let, 2871 | Fm.Parser.get, 2872 | Fm.Parser.def, 2873 | Fm.Parser.if, 2874 | Fm.Parser.char, 2875 | Fm.Parser.string, 2876 | Fm.Parser.pair, 2877 | Fm.Parser.sigma.type, 2878 | Fm.Parser.some, 2879 | Fm.Parser.apply, 2880 | Fm.Parser.list, 2881 | Fm.Parser.log, 2882 | Fm.Parser.forin, 2883 | Fm.Parser.forin2, 2884 | Fm.Parser.do, 2885 | Fm.Parser.case, 2886 | Fm.Parser.open, 2887 | Fm.Parser.goal, 2888 | Fm.Parser.hole, 2889 | Fm.Parser.nat, 2890 | Fm.Parser.reference, 2891 | ]); 2892 | Fm.Parser.suffix(init, term); 2893 | } 2894 | 2895 | // Parses a core term (suffix phase) 2896 | Fm.Parser.suffix(init: Nat, term: Fm.Term): Parser(Fm.Term) 2897 | (idx, code) 2898 | let suffix_parser = Parser.first_of<_>([ 2899 | Fm.Parser.application(init, term), 2900 | Fm.Parser.application.erased(init, term), 2901 | Fm.Parser.arrow(init, term), 2902 | Fm.Parser.add(init, term), 2903 | Fm.Parser.sub(init, term), 2904 | Fm.Parser.mul(init, term), 2905 | Fm.Parser.div(init, term), 2906 | Fm.Parser.mod(init, term), 2907 | Fm.Parser.cons(init, term), 2908 | Fm.Parser.concat(init, term), 2909 | Fm.Parser.string_concat(init, term), 2910 | Fm.Parser.sigma(init, term), 2911 | Fm.Parser.equality(init, term), 2912 | Fm.Parser.annotation(init, term), 2913 | ]); 2914 | case suffix_parser(idx, code) as suffix_parsed { 2915 | error: Parser.Reply.value<_>(idx, code, term), 2916 | value: Fm.Parser.suffix(init, suffix_parsed.val, suffix_parsed.idx, suffix_parsed.code), 2917 | } 2918 | 2919 | // Builds a chained forall 2920 | Fm.Parser.make_forall(binds: List(Fm.Binder), body: Fm.Term): Fm.Term 2921 | case binds { 2922 | nil: body, 2923 | cons: case binds.head { 2924 | new: 2925 | def all_eras = binds.head.eras; 2926 | def all_self = ""; 2927 | def all_name = binds.head.name; 2928 | def all_xtyp = binds.head.term; 2929 | def all_body = (s,x) Fm.Parser.make_forall(binds.tail, body); 2930 | Fm.Term.all(all_eras, all_self, all_name, all_xtyp, all_body), 2931 | } 2932 | } 2933 | 2934 | // Builds a chained lambda 2935 | Fm.Parser.make_lambda(names: List(Fm.Name), body: Fm.Term): Fm.Term 2936 | case names { 2937 | nil: body, 2938 | cons: Fm.Term.lam(names.head, (x) Fm.Parser.make_lambda(names.tail, body)), 2939 | } 2940 | 2941 | // Parses a constructor: @foo(a: A, b: B, c: C) ~ (i: I, j: J)@ 2942 | Fm.Parser.constructor(namespace: Fm.Name): Parser(Fm.Constructor) 2943 | do Parser { 2944 | var name = Fm.Parser.name1; 2945 | var args = Parser.maybe<_>(Fm.Parser.binder); 2946 | var inds = Parser.maybe<_>(do Parser { 2947 | Fm.Parser.text("~"); 2948 | Fm.Parser.binder; 2949 | }); 2950 | let args = Maybe.default<_>([], args); 2951 | let inds = Maybe.default<_>([], inds); 2952 | return Fm.Constructor.new(name, args, inds); 2953 | } 2954 | 2955 | // Parses a datatype: @type Foo (x: A) ~ (i: I) { ctor0(a: A) ~ (i: I), ... }@ 2956 | Fm.Parser.datatype: Parser(Fm.Datatype) 2957 | do Parser { 2958 | Fm.Parser.text("type "); 2959 | var name = Fm.Parser.name1; 2960 | var pars = Parser.maybe<_>(Fm.Parser.binder); 2961 | var inds = Parser.maybe<_>(do Parser { 2962 | Fm.Parser.text("~"); 2963 | Fm.Parser.binder; 2964 | }); 2965 | let pars = Maybe.default<_>([], pars); 2966 | let inds = Maybe.default<_>([], inds); 2967 | Fm.Parser.text("{"); 2968 | var ctrs = Parser.until<_>( 2969 | Fm.Parser.text("}"), 2970 | Fm.Parser.item<_>(Fm.Parser.constructor(name))); 2971 | return Fm.Datatype.new(name, pars, inds, ctrs); 2972 | } 2973 | 2974 | // Parses a definition 2975 | Fm.Parser.file.def(file: String, code: String, defs: Fm.Defs): Parser(Fm.Defs) 2976 | do Parser { 2977 | var name = Fm.Parser.name1; 2978 | var args = Parser.many<_>(Fm.Parser.binder); 2979 | let args = List.flatten<_>(args); 2980 | Fm.Parser.text(":"); 2981 | var type = Fm.Parser.term; 2982 | var term = Fm.Parser.term; 2983 | let type = Fm.Parser.make_forall(args, type); 2984 | let term = Fm.Parser.make_lambda(List.mapped<_>(args)<_>((x) case x { new: x.name }),term); 2985 | let type = Fm.Term.bind([], (x) Bits.i(x), type); 2986 | let term = Fm.Term.bind([], (x) Bits.o(x), term); 2987 | let defs = Fm.define(file, code, name, term, type, Bool.false, defs); 2988 | return defs; 2989 | } 2990 | 2991 | // Parses an ADT 2992 | Fm.Parser.file.adt(file: String, code: String, defs: Fm.Defs): Parser(Fm.Defs) 2993 | do Parser { 2994 | var adt = Fm.Parser.datatype; 2995 | case adt { 2996 | new: do Parser { 2997 | let term = Fm.Datatype.build_term(adt); 2998 | let term = Fm.Term.bind([], (x) Bits.i(x), term); 2999 | let type = Fm.Datatype.build_type(adt); 3000 | let type = Fm.Term.bind([], (x) Bits.o(x), type); 3001 | let defs = Fm.define(file, code, adt.name, term, type, Bool.false, defs); 3002 | let defs = List.fold<_>(adt.ctrs)<_>(defs, (ctr, defs) 3003 | let typ_name = adt.name; 3004 | let ctr_name = String.flatten([typ_name, Fm.Name.read("."), case ctr { new: ctr.name }]); 3005 | let ctr_term = Fm.Constructor.build_term(adt, ctr); 3006 | let ctr_term = Fm.Term.bind([], (x) Bits.i(x), ctr_term); 3007 | let ctr_type = Fm.Constructor.build_type(adt, ctr); 3008 | let ctr_type = Fm.Term.bind([], (x) Bits.o(x), ctr_type); 3009 | Fm.define(file, code, ctr_name, ctr_term, ctr_type, Bool.false, defs)); 3010 | return defs; 3011 | } 3012 | }; 3013 | } 3014 | 3015 | // Parses the end of a file 3016 | Fm.Parser.file.end(file: String, code: String, defs: Fm.Defs): Parser(Fm.Defs) 3017 | do Parser { 3018 | Fm.Parser.spaces; 3019 | Parser.eof; 3020 | return defs; 3021 | } 3022 | 3023 | // Parses many definitions 3024 | Fm.Parser.file(file: String, code: String, defs: Fm.Defs): Parser(Fm.Defs) 3025 | do Parser { 3026 | var stop = Parser.is_eof; 3027 | if stop then do Parser { 3028 | return defs; 3029 | } else Parser.first_of<_>([ 3030 | do Parser { 3031 | Fm.Parser.text("#"); 3032 | var file = Fm.Parser.name1; 3033 | Fm.Parser.file(file, code, defs); 3034 | }, 3035 | do Parser { 3036 | var defs = Parser.first_of<_>([ 3037 | Fm.Parser.file.def(file, code, defs), 3038 | Fm.Parser.file.adt(file, code, defs), 3039 | Fm.Parser.file.end(file, code, defs), 3040 | ]); 3041 | Fm.Parser.file(file, code, defs); 3042 | }, 3043 | ]); 3044 | } 3045 | 3046 | // Stringifies a parser error 3047 | Fm.highlight.tc( 3048 | code: String, 3049 | ix0: Nat, 3050 | ix1: Nat, 3051 | col: Nat, 3052 | row: Nat, 3053 | lft: Maybe(Nat), 3054 | lin: String, 3055 | res: List(String), 3056 | ): String 3057 | //use skip = Debug.log<_>(String.flatten([ 3058 | //"ix0=", Nat.show(ix0), " ", 3059 | //"ix1=", Nat.show(ix1), " ", 3060 | //"col=", Nat.show(col), " ", 3061 | //"row=", Nat.show(row), " ", 3062 | //"lft=", case lft { none: "-", some: Nat.show(lft.value) }, " ", 3063 | //"len=", Nat.show(String.length(code)), " ", 3064 | //"chr=", Fm.escape.char(case code { nil: '_', cons: code.head }), " ", 3065 | //"res={", String.join("|", List.reverse<_>(res)), "}", 3066 | //])) 3067 | case code { 3068 | nil: 3069 | Fm.highlight.end(col, row, List.reverse<_>(res)), 3070 | cons: 3071 | if U16.eql(code.head, '\n') then 3072 | let stp = Maybe.extract<_>(lft)<_>(Bool.false, Nat.is_zero); 3073 | if stp then 3074 | Fm.highlight.end(col, row, List.reverse<_>(res)) 3075 | else 3076 | let spa = 3; 3077 | let siz = Nat.succ(Nat.double(spa)); 3078 | let lft = case ix1 { 3079 | zero: case lft { 3080 | none: Maybe.some<_>(spa), 3081 | some: Maybe.some<_>(Nat.pred(lft.value)), 3082 | }, 3083 | succ: lft, 3084 | }; 3085 | let ix0 = Nat.pred(ix0); 3086 | let ix1 = Nat.pred(ix1); 3087 | let col = 0; 3088 | let row = Nat.succ(row); 3089 | let res = List.take<_>(siz, List.cons<_>(String.reverse(lin), res)); 3090 | let lin = String.reverse(String.flatten([ 3091 | String.pad_left(4, ' ', Nat.show(row)), 3092 | " | " 3093 | ])); 3094 | Fm.highlight.tc(code.tail, ix0, ix1, col, row, lft, lin, res) 3095 | else 3096 | let chr = String.cons(code.head, String.nil); 3097 | let chr = 3098 | if Bool.and(Nat.is_zero(ix0), Bool.not(Nat.is_zero(ix1))) then 3099 | String.reverse(Fm.color("31", Fm.color("4", chr))) 3100 | else 3101 | chr; 3102 | let ix0 = Nat.pred(ix0); 3103 | let ix1 = Nat.pred(ix1); 3104 | let col = Nat.succ(col); 3105 | let lin = String.flatten([chr, lin]); 3106 | Fm.highlight.tc(code.tail, ix0, ix1, col, row, lft, lin, res) 3107 | } 3108 | 3109 | Fm.highlight.end( 3110 | col: Nat, 3111 | row: Nat, 3112 | res: List(String), 3113 | ): String 3114 | String.join("\n", res) 3115 | 3116 | Fm.highlight( 3117 | code: String, 3118 | idx0: Nat, 3119 | idx1: Nat, 3120 | ): String 3121 | Fm.highlight.tc(code, idx0, idx1, 0, 1, Maybe.none<_>, String.reverse(" 1 | "), []) 3122 | 3123 | // Reads a term from string 3124 | Fm.Term.read(code: String): Maybe(Fm.Term) 3125 | case Fm.Parser.term(0,code) as parsed { 3126 | error: Maybe.none<_>, 3127 | value: Maybe.some<_>(parsed.val), 3128 | } 3129 | 3130 | // Reads a defs from string 3131 | Fm.Defs.read(file: String, code: String, defs: Fm.Defs): Either(String, Fm.Defs) 3132 | case Fm.Parser.file(file, code, defs, 0, code) as parsed { 3133 | error: 3134 | let err = parsed.err; 3135 | let hig = Fm.highlight(code, parsed.idx, Nat.succ(parsed.idx)); 3136 | let str = String.flatten([err, "\n", hig]); 3137 | Either.left<_,_>(str), 3138 | value: 3139 | Either.right<_,_>(parsed.val), 3140 | } 3141 | 3142 | // FormCore 3143 | // ======== 3144 | 3145 | Fm.Term.core(term: Fm.Term): String 3146 | case term { 3147 | ref: 3148 | Fm.Name.show(term.name), 3149 | var: 3150 | Fm.Name.show(term.name), 3151 | typ: 3152 | "*", 3153 | all: 3154 | let eras = term.eras; 3155 | let init = if eras then "%" else "@" 3156 | let self = Fm.Name.show(term.self); 3157 | let name = Fm.Name.show(term.name); 3158 | let xtyp = Fm.Term.core(term.xtyp); 3159 | let body = Fm.Term.core(term.body(Fm.Term.var(term.self,0),Fm.Term.var(term.name,0))); 3160 | String.flatten([init,self,"(",name,":",xtyp,") ",body]), 3161 | lam: 3162 | let name = Fm.Name.show(term.name); 3163 | let body = Fm.Term.core(term.body(Fm.Term.var(term.name,0))); 3164 | String.flatten(["#",name," ",body]), 3165 | app: 3166 | let func = Fm.Term.core(term.func); 3167 | let argm = Fm.Term.core(term.argm); 3168 | String.flatten(["(",func," ",argm,")"]), 3169 | let: 3170 | let name = Fm.Name.show(term.name); 3171 | let expr = Fm.Term.core(term.expr); 3172 | let body = Fm.Term.core(term.body(Fm.Term.var(term.name,0))); 3173 | String.flatten(["!", name, " = ", expr, "; ", body]), 3174 | def: 3175 | let name = Fm.Name.show(term.name); 3176 | let expr = Fm.Term.core(term.expr); 3177 | let body = Fm.Term.core(term.body(Fm.Term.var(term.name,0))); 3178 | String.flatten(["$", name, " = ", expr, "; ", body]), 3179 | ann: 3180 | let term = Fm.Term.core(term.term); 3181 | let type = Fm.Term.core(term.type); 3182 | String.flatten(["{",term,":",type,"}"]), 3183 | gol: 3184 | "", 3185 | hol: 3186 | "", 3187 | nat: 3188 | String.flatten(["+", Nat.show(term.natx)]), 3189 | chr: 3190 | String.flatten(["'", Fm.escape.char(term.chrx), "'"]), 3191 | str: 3192 | String.flatten(["\"", Fm.escape(term.strx), "\""]), 3193 | cse: 3194 | "", 3195 | ori: 3196 | Fm.Term.core(term.expr), 3197 | } 3198 | 3199 | // Converts everything to FormCore 3200 | Fm.Defs.core(defs: Fm.Defs): String 3201 | let result = ""; 3202 | for defn in Map.values<_>(defs) with result: 3203 | case defn { 3204 | new: 3205 | case defn.stat { 3206 | done: 3207 | let name = defn.name; 3208 | let term = Fm.Term.core(defn.term); 3209 | let type = Fm.Term.core(defn.type); 3210 | String.flatten([result, name, " : ", type, " = ", term, ";\n"]), 3211 | wait: result, 3212 | init: result, 3213 | fail: result, 3214 | } 3215 | } 3216 | 3217 | // Synth 3218 | // ===== 3219 | 3220 | // SYNTH: Fixes a list of errors, if possible 3221 | Fm.Synth.fix( 3222 | file: String, 3223 | code: String, 3224 | name: Fm.Name, 3225 | term: Fm.Term, 3226 | type: Fm.Term, 3227 | defs: Fm.Defs, 3228 | errs: List(Fm.Error), 3229 | fixd: Bool, 3230 | ): IO(Maybe(Fm.Defs)) 3231 | case errs { 3232 | nil: 3233 | if fixd then do IO { 3234 | let type = Fm.Term.bind([], (x) Bits.i(x), type); 3235 | let term = Fm.Term.bind([], (x) Bits.o(x), term); 3236 | let defs = Fm.set<_>(name, Fm.Def.new(file, code, name, term, type, Fm.Status.init), defs); 3237 | return Maybe.some<_>(defs); 3238 | } else do IO { 3239 | return Maybe.none<_>; 3240 | }, 3241 | cons: case errs.head { 3242 | waiting: do IO { 3243 | var defs = Fm.Synth.one(errs.head.name, defs); 3244 | Fm.Synth.fix(file, code, name, term, type, defs, errs.tail, Bool.true); 3245 | }, 3246 | undefined_reference: do IO { 3247 | var defs = Fm.Synth.one(errs.head.name, defs); 3248 | Fm.Synth.fix(file, code, name, term, type, defs, errs.tail, Bool.true); 3249 | }, 3250 | patch: case errs.head.path { 3251 | e: do IO { // shouldn't happen 3252 | return Maybe.none<_>; 3253 | }, 3254 | o: do IO { // hole is on term 3255 | let term = Fm.Term.patch_at(errs.head.path.pred, term, (x) errs.head.term); 3256 | Fm.Synth.fix(file, code, name, term, type, defs, errs.tail, Bool.true); 3257 | }, 3258 | i: do IO { // hole is on type 3259 | let type = Fm.Term.patch_at(errs.head.path.pred, type, (x) errs.head.term); 3260 | Fm.Synth.fix(file, code, name, term, type, defs, errs.tail, Bool.true); 3261 | }, 3262 | }, 3263 | // The error isn't fixable 3264 | _: Fm.Synth.fix(file, code, name, term, type, defs, errs.tail, fixd), 3265 | } 3266 | } 3267 | 3268 | Fm.Synth.file_of(name: Fm.Name): String 3269 | case name { 3270 | nil: ".fm" 3271 | cons: if U16.eql(name.head, '.') 3272 | then ".fm" 3273 | else String.cons(name.head, Fm.Synth.file_of(name.tail)) 3274 | } 3275 | 3276 | Fm.Synth.load(name: Fm.Name, defs: Fm.Defs): IO(Maybe(Fm.Defs)) 3277 | do IO { 3278 | let file = Fm.Synth.file_of(name); 3279 | //let skip = Debug.log<_>(String.flatten(["loading file: ", file, " (", name, ")"]), (x) Unit.new); 3280 | var code = IO.get_file(file); 3281 | let read = Fm.Defs.read(file, code, defs); 3282 | case read { 3283 | left: do IO { // TODO: should return parse error somehow... or perhaps add that on Fm.Synth.file? 3284 | return Maybe.none<_>; 3285 | }, 3286 | right: do IO { 3287 | let defs = read.value; 3288 | case Fm.get<_>(name, defs) as got { 3289 | none: do IO { 3290 | return Maybe.none<_>; 3291 | }, 3292 | some: do IO { 3293 | return Maybe.some<_>(defs); 3294 | }, 3295 | }; 3296 | }, 3297 | }; 3298 | } 3299 | 3300 | // Synths one def 3301 | Fm.Synth.one(name: Fm.Name, defs: Fm.Defs): IO(Fm.Defs) 3302 | case Fm.get<_>(name, defs) as got { 3303 | none: do IO { 3304 | var loaded = Fm.Synth.load(name, defs); 3305 | case loaded { 3306 | none: do IO { 3307 | IO.print(String.flatten(["Undefined: ", name])); 3308 | return defs; 3309 | }, 3310 | some: do IO { 3311 | Fm.Synth.one(name, loaded.value); 3312 | }, 3313 | }; 3314 | }, 3315 | some: case got.value { 3316 | new: do IO { 3317 | let file = got.value.file; 3318 | let code = got.value.code; 3319 | let name = got.value.name; 3320 | let term = got.value.term; 3321 | let type = got.value.type; 3322 | let stat = got.value.stat; 3323 | //let skip = Debug.log<_>(String.flatten([name, ": ", Fm.Term.show(type), " = ", Fm.Term.show(term)]), (x) Unit.new); 3324 | //Debug.log<_>(String.flatten(["synth ", name, " ", case stat { init: "INIT", wait: "WAIT", done: "DONE", fail: "FAIL" }]), (x) 3325 | case stat { 3326 | wait: do IO { return defs; }, 3327 | done: do IO { return defs; }, 3328 | fail: do IO { return defs; }, 3329 | init: do IO { 3330 | let defs = Fm.set<_>(name, Fm.Def.new(file, code, name, term, type, Fm.Status.wait), defs); 3331 | let checked = do Fm.Check { 3332 | var chk_type = Fm.Term.check(type, Maybe.some<_>(Fm.Term.typ), defs, [], Fm.MPath.i(Fm.MPath.nil), Maybe.none<_>); 3333 | var chk_term = Fm.Term.check(term, Maybe.some<_>(type), defs, [], Fm.MPath.o(Fm.MPath.nil), Maybe.none<_>); 3334 | return Unit.new; 3335 | }; 3336 | case checked { 3337 | result: 3338 | //let skip = Debug.log<_>(String.join("\n", List.mapped<_>(checked.errors)<_>((x) String.concat("-- ", Fm.Error.show(x,Map.new<_>)))), (x) Unit.new); 3339 | if List.is_empty<_>(checked.errors) then do IO { 3340 | let defs = Fm.define(file, code, name, term, type, Bool.true, defs); 3341 | //let defs = Fm.set<_>(name, Fm.Def.new(file, code, name, term, type, Fm.Status.done), defs); 3342 | return defs; 3343 | } else do IO { 3344 | var fixed = Fm.Synth.fix(file, code, name, term, type, defs, checked.errors, Bool.false); 3345 | case fixed { 3346 | none: do IO { 3347 | let stat = Fm.Status.fail(checked.errors); 3348 | let defs = Fm.set<_>(name, Fm.Def.new(file, code, name, term, type, stat), defs); 3349 | return defs; 3350 | }, 3351 | some: Fm.Synth.one(name, fixed.value), 3352 | }; 3353 | } 3354 | }; 3355 | } 3356 | }; 3357 | } 3358 | } 3359 | } 3360 | 3361 | // Synths many defs 3362 | Fm.Synth.many(names: List(String), defs: Fm.Defs): IO(Fm.Defs) 3363 | case names { 3364 | nil: do IO { 3365 | return defs; 3366 | }, 3367 | cons: do IO { 3368 | var defs = Fm.Synth.one(names.head, defs); 3369 | Fm.Synth.many(names.tail, defs); 3370 | }, 3371 | } 3372 | 3373 | Fm.Synth.file(file: String, defs: Fm.Defs): IO(Either(String, Pair(List(Fm.Name), Fm.Defs))) 3374 | do IO { 3375 | var code = IO.get_file(file); 3376 | let read = Fm.Defs.read(file, code, defs); 3377 | case read { 3378 | left: do IO { 3379 | return Either.left<_,_>(read.value); 3380 | }, 3381 | right: do IO { 3382 | let file_defs = read.value; 3383 | let file_keys = Map.keys<_>(file_defs); 3384 | let file_nams = List.mapped<_>(file_keys)<_>(Fm.Name.from_bits); 3385 | var defs = Fm.Synth.many(file_nams, file_defs); 3386 | return Either.right<_,_>({file_nams, defs}); 3387 | }, 3388 | }; 3389 | } 3390 | 3391 | // Load 3392 | // ==== 3393 | 3394 | //Fm.Load.missing(errors: List(Fm.Error)): List(String) 3395 | //case errors { 3396 | //nil: List.nil<_>, 3397 | //cons: 3398 | //let tail = Fm.Load.missing(errors.tail); 3399 | //case errors.head { 3400 | //undefined_reference: List.cons<_>(errors.head.name, tail), 3401 | //_: tail, 3402 | //} 3403 | //} 3404 | 3405 | //Fm.Load.one(name: Fm.Name, defs: Fm.Defs): IO(Fm.Defs) 3406 | //let skip = Debug.log<_>(String.flatten(["Fm.Load.one ", name]), (x) Unit.new); 3407 | ////let skip = Debug.log<_>(String.flatten(["load_name ", name, " ", String.join("|",List.mapped<_>(Map.keys<_>(defs))<_>(Fm.Name.from_bits))]), (x) Unit.new); 3408 | //let defs = Fm.Synth.one(name, defs); 3409 | //case Fm.get<_>(name, defs) as got { 3410 | //some: case got.value { 3411 | //new: 3412 | //let file = got.value.file; 3413 | //let code = got.value.code; 3414 | //let name = got.value.name; 3415 | //let term = got.value.term; 3416 | //let type = got.value.type; 3417 | //let stat = got.value.stat; 3418 | //case stat { 3419 | //init: do IO { return defs; }, 3420 | //wait: do IO { return defs; }, 3421 | //done: do IO { return defs; }, 3422 | //fail: do IO { 3423 | //let missing = Fm.Load.missing(stat.errors); 3424 | //case missing { 3425 | //nil : do IO { return defs; }, 3426 | //cons: do IO { 3427 | //let defs = Fm.set<_>(name, Fm.Def.new(file,code,name,term,type,Fm.Status.init), defs); 3428 | //var defs = Fm.Load.many(missing, defs); 3429 | //var defs = Fm.Load.one(name, defs); 3430 | //return defs; 3431 | //}, 3432 | //}; 3433 | //}, 3434 | //} 3435 | //}, 3436 | //none: do IO { 3437 | //let file = Fm.Load.file_of(name); 3438 | //var code = IO.get_file(file); 3439 | //let read = Fm.Defs.read(file, code, defs); 3440 | //let skip = Debug.log<_>(String.flatten(["loading file: ", file]), (x) Unit.new); 3441 | //case read { 3442 | //left: do IO { return defs; }, 3443 | //right: do IO { 3444 | //let defs = read.value; 3445 | //case Fm.get<_>(name, defs) as got { 3446 | //none: do IO { return defs; }, 3447 | //some: Fm.Load.one(name, defs) 3448 | //}; 3449 | //}, 3450 | //}; 3451 | //}, 3452 | //} 3453 | 3454 | //Fm.Load.many(names: List(Fm.Name), defs: Fm.Defs): IO(Fm.Defs) 3455 | //do IO { 3456 | //case names { 3457 | //nil: do IO { return defs; }, 3458 | //cons: do IO { 3459 | //var defs = Fm.Load.one(names.head, defs); 3460 | //Fm.Load.many(names.tail, defs); 3461 | //} 3462 | //}; 3463 | //} 3464 | 3465 | // API 3466 | // === 3467 | 3468 | Fm.Defs.report.go(defs: Fm.Defs, list: List(Fm.Name), errs: String, typs: String): String 3469 | case list { 3470 | nil: String.flatten([ 3471 | typs, "\n", 3472 | case errs { 3473 | nil: "All terms check.", 3474 | cons: errs, 3475 | } 3476 | ]), 3477 | cons: 3478 | let name = list.head; 3479 | case Fm.get<_>(name, defs) as got { 3480 | none: Fm.Defs.report.go(defs, list.tail, errs, typs), 3481 | some: case got.value { 3482 | new: 3483 | let typs = String.flatten([typs, name,": ",Fm.Term.show(got.value.type),"\n"]); 3484 | case got.value.stat { 3485 | init: Fm.Defs.report.go(defs, list.tail, errs, typs), 3486 | wait: Fm.Defs.report.go(defs, list.tail, errs, typs), 3487 | done: Fm.Defs.report.go(defs, list.tail, errs, typs), 3488 | fail: case got.value.stat.errors { 3489 | nil: Fm.Defs.report.go(defs, list.tail, errs, typs), 3490 | cons: 3491 | let name_str = Fm.Name.show(got.value.name); 3492 | let rel_errs = Fm.Error.relevant(got.value.stat.errors, Bool.false); 3493 | let rel_msgs = List.mapped<_>(rel_errs)<_>((err) 3494 | String.flatten([ 3495 | Fm.Error.show(err, defs), 3496 | case Fm.Error.origin(err) as origin { 3497 | none: "", 3498 | some: case origin.value { 3499 | new: String.flatten([ 3500 | "Inside '", got.value.file, "':\n", 3501 | Fm.highlight(got.value.code, origin.value.from, origin.value.upto), 3502 | "\n", 3503 | ]) 3504 | }, 3505 | } 3506 | ])); 3507 | let errs = String.flatten([errs, String.join("\n", rel_msgs), "\n"]); 3508 | Fm.Defs.report.go(defs, list.tail, errs, typs) 3509 | } 3510 | } 3511 | } 3512 | } 3513 | } 3514 | 3515 | Fm.Defs.report(defs: Fm.Defs, list: List(Fm.Name)): String 3516 | Fm.Defs.report.go(defs, list, "", "") 3517 | 3518 | Fm.to_core.io.one(name: String): IO(String) 3519 | do IO { 3520 | var defs = Fm.Synth.one(name, Map.new<_>); 3521 | return Fm.Defs.core(defs); 3522 | } 3523 | 3524 | Fm.checker.io.one(name: String): IO(Unit) 3525 | do IO { 3526 | var defs = Fm.Synth.one(name, Map.new<_>); 3527 | IO.print(Fm.Defs.report(defs, [name])); 3528 | } 3529 | 3530 | Fm.checker.io.file(file: String): IO(Unit) 3531 | do IO { 3532 | var loaded = Fm.Synth.file(file, Map.new<_>); 3533 | case loaded { 3534 | left: do IO { 3535 | IO.print(String.flatten(["On '", file, "':"])); 3536 | IO.print(loaded.value); 3537 | }, 3538 | right: case loaded.value { 3539 | new: do IO { 3540 | let nams = loaded.value.fst; 3541 | let defs = loaded.value.snd; 3542 | IO.print(Fm.Defs.report(defs, nams)); 3543 | } 3544 | }, 3545 | }; 3546 | } 3547 | 3548 | // Receives a Formality code and returns the type checker reports. Since synth 3549 | // is IO, we need to "purify" it in order to implement a `String->String` 3550 | // function. Since IO is a pure datatype, we can do it by just answering all 3551 | // calls with an empty string. This will work as long as Synth doesn't request 3552 | // external files, which is the case when the source code has no dependencies. 3553 | Fm.checker.code(code: String): String 3554 | case Fm.Defs.read("Main.fm", code, Map.new<_>) as read { 3555 | left: 3556 | read.value, 3557 | right: IO.purify(do IO { 3558 | let defs = read.value; 3559 | let nams = List.mapped<_>(Map.keys<_>(defs))<_>(Fm.Name.from_bits); 3560 | var defs = Fm.Synth.many(nams, defs); 3561 | return Fm.Defs.report(defs, nams); 3562 | }), 3563 | } 3564 | 3565 | //Fm: IO(Unit) 3566 | //do IO { 3567 | //IO.print(Fm.checker.code("type Bit { o, i } main: Bit ?a")); 3568 | //} 3569 | 3570 | Fm: IO(Unit) 3571 | do IO { 3572 | let _ = Fm.to_core.io.one; 3573 | let _ = Fm.checker.io.one; 3574 | let _ = Fm.checker.io.file; 3575 | let _ = Fm.checker.code; 3576 | let _ = Fm.Term.read; 3577 | Fm.checker.io.file("Main.fm"); 3578 | } 3579 | -------------------------------------------------------------------------------- /src/IO.fm: -------------------------------------------------------------------------------- 1 | type IO { 2 | end(value: A), 3 | ask(query: String, param: String, then: (response: String) IO(A)), 4 | } 5 | 6 | IO.bind(a: IO(A), f: A -> IO(B)): IO(B) 7 | case a { 8 | end: f(a.value), 9 | ask: IO.ask(a.query, a.param, (x) IO.bind(a.then(x), f)), 10 | } 11 | 12 | IO.get_line: IO(String) 13 | IO.ask("get_line", "", (line) 14 | IO.end(line)) 15 | 16 | IO.get_file(name: String): IO(String) 17 | IO.ask("get_file", name, (file) 18 | IO.end(file)) 19 | 20 | IO.get_args: IO(String) 21 | IO.ask("get_args", "", (line) 22 | IO.end(line)) 23 | 24 | IO.monad: Monad(IO) 25 | Monad.new(IO.bind, IO.end) 26 | 27 | IO.print(text: String): IO(Unit) 28 | IO.ask("print", text, (skip) 29 | IO.end(Unit.new)) 30 | 31 | IO.prompt(text: String): IO(String) 32 | IO.ask("print", text, (skip) 33 | IO.ask("get_line", "", (line) 34 | IO.end(line))) 35 | 36 | // Always responds queries with an empty string 37 | IO.purify(io: IO(A)): A 38 | case io { 39 | end: io.value, 40 | ask: IO.purify(io.then("")), 41 | } 42 | 43 | -------------------------------------------------------------------------------- /src/List.fm: -------------------------------------------------------------------------------- 1 | type List { 2 | nil, 3 | cons(head: A, tail: List(A)), 4 | } 5 | 6 | List.tail(xs: List(A)): List(A) 7 | case xs { 8 | nil: List.nil<_>, 9 | cons: xs.tail, 10 | } 11 | 12 | List.take(n: Nat, xs: List(A)): List(A) 13 | case xs { 14 | nil : List.nil<_>, 15 | cons: case n { 16 | zero: List.nil<_>, 17 | succ: List.cons<_>(xs.head,List.take<_>(n.pred, xs.tail)) 18 | } 19 | } 20 | 21 | List.fold(list: List(A)): -> P -> (A -> P -> P) -> P 22 |

(nil, cons) 23 | case list { 24 | nil : nil, 25 | cons: cons(list.head, List.fold(list.tail)

(nil, cons)) 26 | } 27 | 28 | List.for(xs: List(A))(b: B, f: A -> B -> B): B 29 | case xs { 30 | nil : b, 31 | cons: List.for(xs.tail)(f(xs.head,b),f) 32 | } 33 | 34 | List.map(f: A -> B, as: List(A)): List(B) 35 | case as { 36 | nil: List.nil<_>, 37 | cons: List.cons<_>(f(as.head), List.map<_,_>(f,as.tail)), 38 | } 39 | 40 | List.reverse(xs: List(A)) : List(A) 41 | List.reverse.go<_>(xs,List.nil<_>) 42 | 43 | List.reverse.go(xs: List(A), res: List(A)): List(A) 44 | case xs { 45 | nil: res, 46 | cons: List.reverse.go<_>(xs.tail,List.cons<_>(xs.head,res)) 47 | } 48 | 49 | List.concat(as: List(A), bs: List(A)): List(A) 50 | case as { 51 | nil: bs, 52 | cons: List.cons<_>(as.head, List.concat<_>(as.tail,bs)) 53 | } 54 | 55 | List.flatten(xs: List(List(A))): List(A) 56 | case xs { 57 | nil: List.nil<_>, 58 | cons: List.concat<_>(xs.head, List.flatten<_>(xs.tail)) 59 | } 60 | 61 | List.is_empty(list: List(A)): Bool 62 | case list { 63 | nil: Bool.true, 64 | cons: Bool.false, 65 | } 66 | 67 | // Computes the length of the list. 68 | List.length(xs: List(A)): Nat 69 | case xs { 70 | nil: 0, 71 | cons: Nat.succ(List.length(xs.tail)), 72 | } 73 | 74 | // A range of nats 75 | List.range.nat.go(nat: Nat, list: List(Nat)): List(Nat) 76 | case nat { 77 | zero: list, 78 | succ: List.range.nat.go(nat.pred, List.cons<_>(nat.pred, list)), 79 | } 80 | 81 | List.range.nat(nat: Nat): List(Nat) 82 | List.range.nat.go(nat, List.nil<_>) 83 | 84 | List.eql(eql: A -> A -> Bool, a: List(A), b: List(A)): Bool 85 | case a { 86 | nil: case b { 87 | nil: Bool.true, 88 | cons: Bool.false, 89 | }, 90 | cons: case b { 91 | nil: Bool.false, 92 | cons: Bool.and(eql(a.head, b.head), List.eql(eql, a.tail, b.tail)), 93 | }, 94 | } 95 | 96 | List.mapped(as: List(A))(f: A -> B): List(B) 97 | case as { 98 | nil: List.nil<_>, 99 | cons: List.cons<_>(f(as.head),List.mapped(as.tail)(f)) 100 | } 101 | 102 | List.at(index: Nat, list: List(A)): Maybe(A) 103 | case list { 104 | nil: Maybe.none<_>, 105 | cons: case index { 106 | zero: Maybe.some<_>(list.head), 107 | succ: List.at<_>(index.pred, list.tail), 108 | } 109 | } 110 | 111 | List.at_last(index: Nat, list: List(A)): Maybe(A) 112 | List.at(index, List.reverse<_>(list)) 113 | 114 | List.init(list: List(A)): List(A) 115 | case list { 116 | cons: case list.tail { 117 | cons: List.cons<_>(list.head, List.init(list.tail)), 118 | nil: List.nil<_>, 119 | }, 120 | nil: List.nil<_>, 121 | } 122 | 123 | List.zip(as: List(A), bs: List(B)): List(Pair(A,B)) 124 | case as { 125 | nil: List.nil<_>, 126 | cons: case bs { 127 | nil: List.nil<_>, 128 | cons: List.cons<_>(Pair.new<_,_>(as.head, bs.head), List.zip(as.tail, bs.tail)), 129 | } 130 | } 131 | -------------------------------------------------------------------------------- /src/Main.fm: -------------------------------------------------------------------------------- 1 | EvenNat: Type 2 | {x: Nat} (x % 2) == 0 3 | 4 | double_is_even(n: Nat): ((2*n)%2) == 0 5 | case n { 6 | zero: refl 7 | succ: double_is_even(n.pred) 8 | }! 9 | 10 | to_even(n: Nat): EvenNat 11 | (2 * n) ~ double_is_even(n) 12 | -------------------------------------------------------------------------------- /src/Map.fm: -------------------------------------------------------------------------------- 1 | type Map { 2 | new, 3 | tie(val: Maybe(A), lft: Map(A), rgt: Map(A)), 4 | } 5 | 6 | Map.fold(map: Map(A)): -> P -> (Maybe(A) -> P -> P -> P) -> P 7 |

(new, tie) 8 | case map { 9 | new: new, 10 | tie: 11 | tie( 12 | map.val, 13 | Map.fold(map.lft)

(new, tie), 14 | Map.fold(map.rgt)

(new, tie)), 15 | } 16 | 17 | Map.get(bits: Bits, map: Map(A)): Maybe(A) 18 | case bits { 19 | e: case map { 20 | new: Maybe.none<_>, 21 | tie: map.val, 22 | }, 23 | o: case map { 24 | new: Maybe.none<_>, 25 | tie: Map.get<_>(bits.pred, map.lft), 26 | }, 27 | i: case map { 28 | new: Maybe.none<_>, 29 | tie: Map.get<_>(bits.pred, map.rgt), 30 | } 31 | } 32 | 33 | Map.set(bits: Bits, val: A, map: Map(A)): Map(A) 34 | case bits { 35 | e: case map { 36 | new: Map.tie<_>(Maybe.some<_>(val), Map.new<_>, Map.new<_>), 37 | tie: Map.tie<_>(Maybe.some<_>(val), map.lft, map.rgt) 38 | }, 39 | o: case map { 40 | new: Map.tie<_>(Maybe.none<_>, Map.set<_>(bits.pred, val, Map.new<_>), Map.new<_>), 41 | tie: Map.tie<_>(map.val, Map.set<_>(bits.pred, val, map.lft), map.rgt) 42 | }, 43 | i: case map { 44 | new: Map.tie<_>(Maybe.none<_>, Map.new<_>, Map.set<_>(bits.pred, val, Map.new<_>)), 45 | tie: Map.tie<_>(map.val, map.lft, Map.set<_>(bits.pred, val, map.rgt)) 46 | } 47 | } 48 | 49 | Map.delete(key: Bits, map: Map(A)): Map(A) 50 | case map { 51 | new: Map.new<_>, 52 | tie: case key { 53 | e: Map.tie<_>(Maybe.none<_>, map.lft, map.rgt), 54 | o: Map.delete<_>(key.pred, map.lft), 55 | i: Map.delete<_>(key.pred, map.rgt) 56 | } 57 | } 58 | 59 | Map.from_list(f: A -> Bits, xs: List(Pair(A,B))): Map(B) 60 | case xs { 61 | nil : Map.new<_>, 62 | cons: case xs.head as p { 63 | new: Map.set<_>(f(p.fst), p.snd, Map.from_list<_,_>(f, xs.tail)) 64 | } 65 | } 66 | 67 | Map.to_list(xs: Map(A)): List(Pair(Bits,A)) 68 | List.reverse<_>(Map.to_list.go<_>(xs, Bits.e, List.nil<_>)) 69 | 70 | Map.to_list.go(xs: Map(A), key: Bits, list: List(Pair(Bits,A))): List(Pair(Bits,A)) 71 | case xs { 72 | new: 73 | list, 74 | tie: 75 | let list0 = case xs.val { 76 | none: list, 77 | some: List.cons<_>(Pair.new<_,_>(Bits.reverse(key), xs.val.value), list), 78 | }; 79 | let list1 = Map.to_list.go<_>(xs.lft, Bits.o(key), list0); 80 | let list2 = Map.to_list.go<_>(xs.rgt, Bits.i(key), list1); 81 | list2 82 | } 83 | 84 | Map.keys(xs: Map(A)): List(Bits) 85 | List.reverse<_>(Map.keys.go<_>(xs, Bits.e, List.nil<_>)) 86 | 87 | Map.keys.go(xs: Map(A), key: Bits, list: List(Bits)): List(Bits) 88 | case xs { 89 | new: 90 | list, 91 | tie: 92 | let list0 = case xs.val { none: list, some: List.cons<_>(Bits.reverse(key), list) }; 93 | let list1 = Map.keys.go<_>(xs.lft, Bits.o(key), list0); 94 | let list2 = Map.keys.go<_>(xs.rgt, Bits.i(key), list1); 95 | list2 96 | } 97 | 98 | Map.values(xs: Map(A)): List(A) 99 | Map.values.go(xs, List.nil<_>) 100 | 101 | Map.values.go(xs: Map(A), list: List(A)): List(A) 102 | case xs { 103 | new: 104 | list, 105 | tie: 106 | let list0 = case xs.val { none: list, some: List.cons<_>(xs.val.value, list) }; 107 | let list1 = Map.values.go<_>(xs.lft, list0); 108 | let list2 = Map.values.go<_>(xs.rgt, list1); 109 | list2 110 | } 111 | 112 | -------------------------------------------------------------------------------- /src/Maybe.fm: -------------------------------------------------------------------------------- 1 | type Maybe { 2 | none, 3 | some(value: A), 4 | } 5 | 6 | Maybe.mapped(m: Maybe(A))(f: A -> B): Maybe(B) 7 | case m { 8 | none: Maybe.none, 9 | some: Maybe.some(f(m.value)), 10 | } 11 | 12 | Maybe.pure(a: A): Maybe(A) 13 | Maybe.some(a) 14 | 15 | Maybe.bind(m: Maybe(A), f: A -> Maybe(B)): Maybe(B) 16 | case m { 17 | none: Maybe.none, 18 | some: f(m.value), 19 | } 20 | 21 | Maybe.monad: Monad(Maybe) 22 | Monad.new(Maybe.bind, Maybe.some) 23 | 24 | Maybe.extract(m: Maybe(A))(a: B, f: A -> B): B 25 | case m { 26 | none: a, 27 | some: f(m.value), 28 | } 29 | 30 | Maybe.default(a: A, m: Maybe(A)): A 31 | case m { 32 | none: a, 33 | some: m.value, 34 | } 35 | 36 | Maybe.to_bool(m: Maybe(A)): Bool 37 | case m { 38 | none: Bool.false, 39 | some: Bool.true, 40 | } 41 | 42 | Maybe.or(a: Maybe(A), b: Maybe(A)): Maybe(A) 43 | case a { 44 | none: b, 45 | some: Maybe.some<_>(a.value), 46 | } 47 | 48 | -------------------------------------------------------------------------------- /src/Monad.fm: -------------------------------------------------------------------------------- 1 | type Monad Type> { 2 | new( 3 | bind: (m: M(A)) (f: (x:A) M(B)) M(B), 4 | pure: (x: A) M(A), 5 | ) 6 | } 7 | 8 | Monad.pure Type>(m: Monad(M)): -> A -> M(A) 9 | case m { 10 | new: m.pure 11 | } 12 | 13 | Monad.bind Type>(m: Monad(M)): -> M(A) -> (A -> M(B)) -> M(B) 14 | case m { 15 | new: m.bind 16 | } 17 | 18 | -------------------------------------------------------------------------------- /src/Nat.fm: -------------------------------------------------------------------------------- 1 | type Nat { 2 | zero, 3 | succ(pred: Nat), 4 | } 5 | 6 | Nat.pred(n: Nat): Nat 7 | case n { 8 | zero: Nat.zero, 9 | succ: n.pred 10 | } 11 | 12 | Nat.is_zero(n: Nat): Bool 13 | case n { 14 | zero: Bool.true, 15 | succ: Bool.false, 16 | } 17 | 18 | Nat.apply(n: Nat, f: (x:A) A, x: A): A 19 | case n { 20 | zero: x, 21 | succ: Nat.apply(n.pred, f, f(x)), 22 | } 23 | 24 | Nat.to_base(base: Nat, nat: Nat): List(Nat) 25 | Nat.to_base.go(base, nat, List.nil) 26 | 27 | Nat.to_base.go(base: Nat, nat: Nat, res: List(Nat)): List(Nat) 28 | case Nat.div_mod(nat, base) as div_mod { 29 | new: case div_mod.fst { 30 | zero: List.cons<_>(div_mod.snd, res), 31 | succ: Nat.to_base.go(base, div_mod.fst, List.cons<_>(div_mod.snd, res)) 32 | } 33 | } 34 | 35 | Nat.from_base(base: Nat, ds: List(Nat)) : Nat 36 | Nat.from_base.go(base, List.reverse<_>(ds),1,0) 37 | 38 | Nat.from_base.go(b: Nat, ds: List(Nat), p: Nat, res: Nat) : Nat 39 | case ds { 40 | nil: res, 41 | cons: Nat.from_base.go(b,ds.tail,Nat.mul(b,p), Nat.add(Nat.mul(ds.head,p),res)) 42 | } 43 | 44 | Nat.to_string_base(base: Nat, nat: Nat): String 45 | List.fold<_>(Nat.to_base(base, nat))<_>( 46 | String.nil, 47 | (n, str) String.cons(Nat.show_digit(base,n), str)) 48 | 49 | Nat.to_bits(n: Nat): Bits 50 | case n { 51 | zero: Bits.e, 52 | succ: Bits.inc(Nat.to_bits(n.pred)) 53 | } 54 | 55 | Nat.add(n: Nat, m: Nat): Nat 56 | case n { 57 | zero: m, 58 | succ: Nat.succ(Nat.add(n.pred, m)), 59 | } 60 | 61 | Nat.sub(n: Nat, m: Nat): Nat 62 | case m { 63 | zero: n, 64 | succ: case n { 65 | zero: 0, 66 | succ: Nat.sub(n.pred, m.pred), 67 | } 68 | } 69 | 70 | Nat.cmp(a: Nat, b: Nat): Cmp 71 | case a { 72 | zero: case b { 73 | zero: Cmp.eql, 74 | succ: Cmp.ltn, 75 | }, 76 | succ: case b { 77 | zero: Cmp.gtn, 78 | succ: Nat.cmp(a.pred, b.pred), 79 | }, 80 | } 81 | 82 | Nat.mul(n: Nat, m: Nat): Nat 83 | case m { 84 | zero: Nat.zero, 85 | succ: Nat.add(n, Nat.mul(n, m.pred)), 86 | } 87 | 88 | //Nat.mul(n: Nat, m: Nat): Nat 89 | //case n { 90 | //zero: Nat.zero, 91 | //succ: Nat.add(m, Nat.mul(n.pred, m)) 92 | //} 93 | 94 | Nat.sub_rem(n: Nat, m: Nat): Either(Nat, Nat) 95 | case m { 96 | zero: Either.left<_,_>(n), 97 | succ: case n { 98 | zero: Either.right<_,_>(Nat.succ(m.pred)), 99 | succ: Nat.sub_rem(n.pred, m.pred), 100 | } 101 | } 102 | 103 | Nat.div_mod(n: Nat, m: Nat): Pair(Nat, Nat) 104 | Nat.div_mod.go(n, m, Nat.zero) 105 | 106 | Nat.div_mod.go(n: Nat, m: Nat, d: Nat): Pair(Nat, Nat) 107 | case Nat.sub_rem(n, m) as p { 108 | left: Nat.div_mod.go(p.value, m, Nat.succ(d)), 109 | right: Pair.new<_,_>(d, n), 110 | } 111 | 112 | Nat.div(n: Nat, m: Nat): Nat 113 | Pair.fst<_,_>(Nat.div_mod(n, m)) 114 | 115 | Nat.mod(n: Nat, m: Nat): Nat 116 | Nat.mod.go(n, m, 0) 117 | 118 | Nat.mod.go(n: Nat, m: Nat, r: Nat): Nat 119 | case m { 120 | zero: Nat.mod.go(n, r, m), 121 | succ: case n { 122 | zero: r, 123 | succ: Nat.mod.go(n.pred, m.pred, Nat.succ(r)), 124 | } 125 | } 126 | 127 | Nat.double(n: Nat): Nat 128 | case n { 129 | zero: Nat.zero, 130 | succ: Nat.succ(Nat.succ(Nat.double(n.pred))), 131 | } 132 | 133 | // n >= m 134 | Nat.gte(n: Nat, m: Nat): Bool 135 | case m { 136 | zero: Bool.true, 137 | succ: case n { 138 | zero: Bool.false, 139 | succ: Nat.gte(n.pred, m.pred), 140 | } 141 | } 142 | 143 | // n > m 144 | Nat.gtn(n: Nat, m: Nat): Bool 145 | case n { 146 | zero: Bool.false, 147 | succ: case m { 148 | zero: Bool.true, 149 | succ: Nat.gtn(n.pred, m.pred), 150 | } 151 | } 152 | 153 | // n == m 154 | Nat.eql(n: Nat, m: Nat): Bool 155 | case n { 156 | zero: case m { 157 | zero: Bool.true, 158 | succ: Bool.false, 159 | }, 160 | succ: case m { 161 | zero: Bool.false, 162 | succ: Nat.eql(n.pred, m.pred), 163 | }, 164 | } 165 | 166 | // n <= m 167 | Nat.lte(n: Nat, m: Nat): Bool 168 | case n { 169 | zero: Bool.true, 170 | succ: case m { 171 | zero: Bool.false, 172 | succ: Nat.lte(n.pred, m.pred), 173 | } 174 | } 175 | 176 | // n < m 177 | Nat.ltn(n: Nat, m: Nat): Bool 178 | case m { 179 | zero: Bool.false, 180 | succ: case n { 181 | zero: Bool.true, 182 | succ: Nat.ltn(n.pred, m.pred), 183 | } 184 | } 185 | 186 | Nat.is_even(n: Nat): Bool 187 | case n { 188 | zero: true, 189 | succ: Bool.not(Nat.is_even(n.pred)), 190 | } 191 | 192 | Nat.show(n: Nat): String 193 | Nat.to_string_base(10,n) 194 | 195 | Nat.show_digit(base: Nat, n: Nat) : Char 196 | let m = Nat.mod(n,base); 197 | let base64 = 198 | ['0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' 199 | ,'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V' 200 | ,'W','X','Y','Z','a','b','c','d','e','f','g','h','i','j','k','l' 201 | ,'m','n','o','p','q','r','s','t','u','v','w','x','y','z','+','/']; 202 | if Bool.and(Nat.gtn(base,0),Nat.lte(base,64)) then 203 | case List.at<_>(m,base64) as c { 204 | none: '#', 205 | some: c.value, 206 | } 207 | else '#' 208 | 209 | // TODO: optimize (this is swapped on the JS compiler though) 210 | Nat.to_u16(n: Nat): U16 211 | Nat.apply(n, U16.inc, U16.zero) 212 | 213 | -------------------------------------------------------------------------------- /src/Pair.fm: -------------------------------------------------------------------------------- 1 | type Pair { 2 | new(fst: A, snd: B) 3 | } 4 | 5 | Pair.fst(pair: Pair(A, B)): A 6 | case pair { 7 | new: pair.fst 8 | } 9 | 10 | Pair.snd(pair: Pair(A, B)): B 11 | case pair { 12 | new: pair.snd 13 | } 14 | 15 | -------------------------------------------------------------------------------- /src/Parser.fm: -------------------------------------------------------------------------------- 1 | type Parser.Reply { 2 | error(idx: Nat, code: String, err: String), 3 | value(idx: Nat, code: String, val: V), 4 | } 5 | 6 | // A parser is a function that receives a string and returns a reply 7 | Parser(V: Type): Type 8 | Nat -> String -> Parser.Reply(V) 9 | 10 | type Parser.ErrorAt { 11 | new(idx: Nat, code: String, err: String) 12 | } 13 | 14 | // Parser monadic binder 15 | Parser.bind(parse: Parser(A), next: A -> Parser(B)): Parser(B) 16 | (idx,code) case parse(idx,code) as reply { 17 | error: Parser.Reply.error(reply.idx, reply.code, reply.err), 18 | value: next(reply.val, reply.idx, reply.code), 19 | } 20 | 21 | // Parser monadic injection 22 | Parser.pure(value: V): Parser(V) 23 | (idx,code) Parser.Reply.value(idx, code, value) 24 | 25 | // Perser monad 26 | Parser.monad: Monad(Parser) 27 | Monad.new(Parser.bind, Parser.pure) 28 | 29 | // Throws an error 30 | Parser.fail(error: String): Parser(V) 31 | (idx,code) Parser.Reply.error(idx, code, error) 32 | 33 | // Consumes a specific text, returns the remaining code 34 | Parser.text.go(text: String): Parser(Unit) 35 | (idx,code) 36 | case text { 37 | nil: 38 | Parser.Reply.value(idx, code, Unit.new), 39 | cons: case code { 40 | nil: 41 | let error = String.flatten(["Expected '", text, "', found end of file."]); 42 | Parser.Reply.error(idx, code, error) 43 | cons: 44 | if U16.eql(text.head, code.head) then 45 | Parser.text(text.tail, Nat.succ(idx), code.tail) 46 | else 47 | let error = String.flatten(["Expected '", text, "', found '", String.cons(code.head, String.nil), "'."]); 48 | Parser.Reply.error(idx, code, error) 49 | } 50 | } 51 | 52 | Parser.text(text: String): Parser(Unit) 53 | (idx,code) case Parser.text.go(text, idx,code) as reply { 54 | error: Parser.Reply.error(idx, code, reply.err), 55 | value: Parser.Reply.value(reply.idx, reply.code, reply.val), 56 | } 57 | 58 | Parser.one: Parser(Char) 59 | (idx,code) case code { 60 | nil: Parser.Reply.error(idx, code, "Unexpected end of file."), 61 | cons: Parser.Reply.value(Nat.succ(idx), code.tail, code.head), 62 | } 63 | 64 | Parser.if_not(a: Parser(Unit), b: Parser(A)): Parser(A) 65 | (idx,code) case a(idx,code) { 66 | error: b(idx,code), 67 | value: Parser.Reply.error(idx, code, "Prevented."), 68 | } 69 | 70 | // Repeats a parse until it fails, returns a list of results 71 | Parser.many(parser: Parser(V)): Parser(List(V)) 72 | Parser.many.go(parser, (x) x) 73 | 74 | Parser.many.go(parse: Parser(V), values: List(V) -> List(V), idx: Nat, code: String): Parser.Reply(List(V)) 75 | case parse(idx,code) as reply { 76 | error: Parser.Reply.value(idx, code, values([])), 77 | value: Parser.many.go(parse, (xs) values(List.cons<_>(reply.val, xs)), reply.idx, reply.code), 78 | } 79 | 80 | // Same as Parser.many, but parses at least one instance 81 | Parser.many1(parser: Parser(V)): Parser(List(V)) 82 | do Parser { 83 | var head = parser; 84 | var tail = Parser.many(parser); 85 | return List.cons(head, tail); 86 | } 87 | 88 | // Repeats a parse until it finds a delimiter. Better errors than Parser.many 89 | Parser.until(until: Parser(Unit), parse: Parser(V)): Parser(List(V)) 90 | Parser.until.go(until, parse, (x) x) 91 | 92 | Parser.until.go( 93 | until: Parser(Unit), 94 | parse: Parser(V), 95 | values: List(V) -> List(V), 96 | idx: Nat, 97 | code: String 98 | ): Parser.Reply(List(V)) 99 | let until_reply = until(idx,code); 100 | case until_reply { 101 | error: 102 | let reply = parse(idx,code); 103 | case reply { 104 | error: 105 | Parser.Reply.error(reply.idx, reply.code, reply.err), 106 | value: 107 | def values = (xs) values(List.cons(reply.val, xs)); 108 | Parser.until.go(until, parse, values, reply.idx, reply.code) 109 | } 110 | value: 111 | Parser.Reply.value(until_reply.idx, until_reply.code, values([])), 112 | } 113 | 114 | // Same as Parser.many, but parses at least one instance 115 | Parser.until1(cond: Parser(Unit), parser: Parser(V)): Parser(List(V)) 116 | do Parser { 117 | var head = parser; 118 | var tail = Parser.until(cond, parser); 119 | return List.cons(head, tail); 120 | } 121 | 122 | // Parses an optional 123 | Parser.maybe(parse: Parser(V)): Parser(Maybe(V)) 124 | (idx,code) case parse(idx,code) as reply { 125 | error: Parser.Reply.value(idx, code, Maybe.none), 126 | value: Parser.Reply.value(reply.idx, reply.code, Maybe.some(reply.val)), 127 | } 128 | 129 | Parser.ErrorAt.combine( 130 | a: Maybe(Parser.ErrorAt), 131 | b: Maybe(Parser.ErrorAt), 132 | ): Maybe(Parser.ErrorAt) 133 | case a { 134 | none: b, 135 | some: case b { 136 | none: a, 137 | some: case a.value { 138 | new: case b.value { 139 | new: if Nat.gtn(a.value.idx, b.value.idx) then a else b 140 | } 141 | } 142 | } 143 | } 144 | 145 | // Parses the first in a list 146 | Parser.first_of.go(pars: List(Parser(A)), err: Maybe(Parser.ErrorAt)): Parser(A) 147 | (idx,code) 148 | case pars { 149 | nil: case err { 150 | none: Parser.Reply.error<_>(idx, code, "No parse."), 151 | some: case err.value { 152 | new: Parser.Reply.error<_>(err.value.idx, err.value.code, err.value.err), 153 | } 154 | }, 155 | cons: 156 | let parsed = pars.head(idx, code); 157 | case parsed { 158 | error: 159 | let neo = Maybe.some<_>(Parser.ErrorAt.new(parsed.idx, parsed.code, parsed.err)); 160 | let err = Parser.ErrorAt.combine(neo, err); 161 | Parser.first_of.go<_>(pars.tail, err, idx, code), 162 | value: 163 | Parser.Reply.value<_>(parsed.idx, parsed.code, parsed.val), 164 | } 165 | } 166 | 167 | Parser.first_of(pars: List(Parser(A))): Parser(A) 168 | Parser.first_of.go(pars, Maybe.none<_>) 169 | 170 | // Skips whitespaces 171 | Parser.spaces: Parser(List(Unit)) 172 | Parser.many<_>(Parser.first_of<_>([ 173 | Parser.text(" "), 174 | Parser.text("\n"), 175 | ])) 176 | 177 | // Checks if it is the end of the file 178 | Parser.is_eof: Parser(Bool) 179 | (idx,code) case code { 180 | nil: Parser.Reply.value<_>(idx, code, Bool.true), 181 | cons: Parser.Reply.value<_>(idx, code, Bool.false), 182 | } 183 | 184 | // Parses end of file 185 | Parser.eof: Parser(Unit) 186 | (idx,code) case code { 187 | nil: Parser.Reply.value<_>(idx, code, Unit.new), 188 | cons: Parser.Reply.error<_>(idx, code, "Expected end-of-file."), 189 | } 190 | 191 | // Parses spaces then a text 192 | Parser.spaces_text(text: String): Parser(Unit) 193 | do Parser { 194 | Parser.spaces; 195 | Parser.text(text); 196 | } 197 | 198 | // Parses a character 199 | Parser.char_if(fun: Char -> Bool): Parser(Char) 200 | (idx,code) case code { 201 | nil: Parser.Reply.error<_>(idx, code, "No parse."), 202 | cons: 203 | if fun(code.head) then 204 | Parser.Reply.value<_>(Nat.succ(idx), code.tail, code.head) 205 | else 206 | Parser.Reply.error<_>(idx, code, "No parse."), 207 | } 208 | 209 | // Parses a digit: [0123456789] 210 | Parser.digit: Parser(Nat) 211 | (idx, code) case code { 212 | nil: 213 | Parser.Reply.error<_>(idx, code, "Not a digit."), 214 | cons: 215 | let sidx = Nat.succ(idx); 216 | if U16.eql(code.head, '0') then Parser.Reply.value<_>(sidx, code.tail, 0) 217 | else if U16.eql(code.head, '1') then Parser.Reply.value<_>(sidx, code.tail, 1) 218 | else if U16.eql(code.head, '2') then Parser.Reply.value<_>(sidx, code.tail, 2) 219 | else if U16.eql(code.head, '3') then Parser.Reply.value<_>(sidx, code.tail, 3) 220 | else if U16.eql(code.head, '4') then Parser.Reply.value<_>(sidx, code.tail, 4) 221 | else if U16.eql(code.head, '5') then Parser.Reply.value<_>(sidx, code.tail, 5) 222 | else if U16.eql(code.head, '6') then Parser.Reply.value<_>(sidx, code.tail, 6) 223 | else if U16.eql(code.head, '7') then Parser.Reply.value<_>(sidx, code.tail, 7) 224 | else if U16.eql(code.head, '8') then Parser.Reply.value<_>(sidx, code.tail, 8) 225 | else if U16.eql(code.head, '9') then Parser.Reply.value<_>(sidx, code.tail, 9) 226 | else Parser.Reply.error<_>(idx, code, "Not a digit."), 227 | } 228 | 229 | // Parses a natural number: 123 230 | Parser.nat: Parser(Nat) 231 | do Parser { 232 | var digits = Parser.many1(Parser.digit); 233 | return Nat.from_base(10, digits); 234 | } 235 | 236 | // Gets the current code 237 | Parser.get_code: Parser(String) 238 | (idx, code) Parser.Reply.value<_>(idx, code, code) 239 | 240 | // Gets the current index 241 | Parser.get_index: Parser(Nat) 242 | (idx, code) Parser.Reply.value<_>(idx, code, idx) 243 | 244 | // Sets the current index 245 | Parser.set_index(new_idx: Nat): Parser(Unit) 246 | (idx, code) Parser.Reply.value<_>(new_idx, code, Unit.new) 247 | 248 | // Gets the current code 249 | Parser.log_code: Parser(Unit) 250 | (idx, code) Debug.log<_>(code, (x) Parser.Reply.value<_>(idx, code, Unit.new)) 251 | 252 | // Parses something 253 | Parser.log(str: String): Parser(Unit) 254 | (idx, code) Debug.log<_>(str, (x) Parser.Reply.value<_>(idx, code, Unit.new)) 255 | 256 | -------------------------------------------------------------------------------- /src/Set.fm: -------------------------------------------------------------------------------- 1 | Set: Type 2 | Map(Unit) 3 | 4 | Set.new: Set 5 | Map.new 6 | 7 | Set.del(key: Bits, set: Set): Set 8 | Map.delete(key, set) 9 | 10 | Set.set(bits: Bits, set: Set): Set 11 | Map.set(bits, Unit.new, set) 12 | 13 | Set.has(bits: Bits, set: Set): Bool 14 | case Map.get(bits, set) { 15 | none: Bool.false, 16 | some: Bool.true, 17 | } 18 | 19 | -------------------------------------------------------------------------------- /src/Sigma.fm: -------------------------------------------------------------------------------- 1 | type Sigma (A: Type) (B: A -> Type) { 2 | new(fst: A, snd: B(fst)) 3 | } 4 | 5 | Sigma.fst Type>(sig: Sigma(A, B)): A 6 | case sig { 7 | new: sig.fst 8 | } 9 | 10 | Sigma.snd Type>(sig: Sigma(A, B)): B(Sigma.fst(sig)) 11 | case sig { 12 | new: sig.snd 13 | }: B(Sigma.fst(sig)) 14 | 15 | -------------------------------------------------------------------------------- /src/String.fm: -------------------------------------------------------------------------------- 1 | type String { 2 | nil, 3 | cons(head: Char, tail: String), 4 | } 5 | 6 | // A string with only one character. 7 | String.pure(x : Char) : String 8 | String.cons(x, String.nil) 9 | 10 | String.is_empty(str: String): Bool 11 | case str { 12 | nil: Bool.true, 13 | cons: Bool.false, 14 | } 15 | 16 | // Computes the length of the list. 17 | String.length(xs: String): Nat 18 | String.length.go(xs, 0) 19 | 20 | // Computes the length of the list. 21 | String.length.go(xs: String, n: Nat): Nat 22 | case xs { 23 | nil : n, 24 | cons: String.length.go(xs.tail, Nat.succ(n)) 25 | } 26 | 27 | String.concat(as: String, bs: String): String 28 | case as { 29 | nil: bs, 30 | cons: String.cons(as.head, String.concat(as.tail,bs)), 31 | } 32 | 33 | String.eql(a: String, b: String): Bool 34 | case a { 35 | nil: case b { 36 | nil: Bool.true, 37 | cons: Bool.false, 38 | }, 39 | cons: case b { 40 | nil: Bool.false, 41 | cons: Bool.and(U16.eql(a.head, b.head), String.eql(a.tail,b.tail)), 42 | }, 43 | } 44 | 45 | String.join.go(sep: String, list: List(String), fst: Bool): String 46 | case list { 47 | nil: "", 48 | cons: String.flatten([ 49 | if fst then "" else sep, 50 | list.head, 51 | String.join.go(sep, list.tail, Bool.false), 52 | ]), 53 | } 54 | 55 | String.join(sep: String, list: List(String)): String 56 | String.join.go(sep, list, Bool.true) 57 | 58 | String.flatten.go(xs: List(String), res: String): String 59 | case xs { 60 | nil: res, 61 | cons: String.flatten.go(xs.tail, String.concat(res, xs.head)), 62 | } 63 | 64 | String.flatten(xs: List(String)): String 65 | String.flatten.go(xs, "") 66 | 67 | // Reverse the order of the characters of the string 68 | String.reverse(xs: String) : String 69 | String.reverse.go(xs,String.nil) 70 | 71 | String.reverse.go(xs: String, res: String): String 72 | case xs { 73 | nil: res, 74 | cons: String.reverse.go(xs.tail,String.cons(xs.head,res)), 75 | } 76 | 77 | String.pad_left(size: Nat, chr: Char, str: String): String 78 | String.reverse(String.pad_right(size, chr, String.reverse(str))) 79 | 80 | String.pad_right(size: Nat, chr: Char, str: String): String 81 | case size { 82 | zero: str, 83 | succ: case str { 84 | nil: String.cons(chr, String.pad_right(size.pred, chr, "")), 85 | cons: String.cons(str.head, String.pad_right(size.pred, chr, str.tail)), 86 | } 87 | } 88 | 89 | // Appends character to the end of the string. 90 | String.append(as: String, a: Char): String 91 | case as{ 92 | nil : String.pure(a) 93 | cons: String.cons(as.head,String.append(as.tail, a)) 94 | } 95 | 96 | // Check if "xs" starts with "match" 97 | String.starts_with(xs: String, match: String): Bool 98 | case match{ 99 | nil : Bool.true 100 | cons: case xs{ 101 | nil : Bool.false 102 | cons: case Char.eql(match.head, xs.head){ 103 | true : String.starts_with(xs.tail, match.tail) 104 | false: Bool.false 105 | } 106 | } 107 | } 108 | 109 | // Check if a String ends with another String 110 | String.ends_with(xs: String, match: String): Bool 111 | let xs_reserved = String.reverse(xs) 112 | let match_reversed = String.reverse(match) 113 | String.starts_with(xs_reserved, match_reversed) 114 | 115 | // Removes all characters that do not satisfy a condition. 116 | String.filter(f: Char -> Bool, xs: String): String 117 | case xs{ 118 | nil : String.nil 119 | cons: case f(xs.head){ 120 | true : String.cons(xs.head,String.filter(f, xs.tail)) 121 | false: String.filter(f, xs.tail) 122 | } 123 | } 124 | 125 | // Creates a String from a List(Char) 126 | String.from_list(xs: List(Char)) : String 127 | case xs{ 128 | nil : String.nil 129 | cons: String.cons(xs.head,String.from_list(xs.tail)) 130 | } 131 | 132 | // Get the head of a nonempty string 133 | String.head(xs: String): Maybe(Char) 134 | case xs{ 135 | nil : Maybe.none<_> 136 | cons: Maybe.some<_>(xs.head) 137 | } 138 | 139 | // Check if "xs" includes "match" 140 | String.includes(xs: String, match: String): Bool 141 | case String.starts_with(xs, match){ 142 | true : Bool.true 143 | false: case String.includes.go(xs, match){ 144 | nil : Bool.false 145 | cons: Bool.true 146 | } 147 | } 148 | 149 | // Search for a Substring 150 | // if finds it, returns the tail containg the "match" String 151 | String.includes.go(xs: String, match: String): String 152 | case xs{ 153 | nil : String.nil 154 | cons: case String.starts_with(xs.tail, match){ 155 | true : xs.tail 156 | false: String.includes.go(xs.tail, match) 157 | } 158 | } 159 | 160 | // Applies a function to all characters of the string. 161 | String.map(f: Char -> Char, as: String): String 162 | case as{ 163 | nil : String.nil 164 | cons: String.cons(f(as.head),String.map(f,as.tail)) 165 | } 166 | 167 | // A proposition that a string is not the empty string 168 | String.not_empty(xs: String): Type 169 | case xs{ 170 | nil : Empty 171 | cons: Unit 172 | } 173 | 174 | String.null(xs: String): Bool 175 | case xs{ 176 | nil : Bool.true 177 | cons: Bool.false 178 | } 179 | 180 | // Remove "match" from the beginning of "xs" 181 | String.remove_start_with(xs: String, match: String): String 182 | case xs{ 183 | nil : String.nil 184 | cons: case String.starts_with(xs, match){ 185 | true : String.remove_start_with.go(xs, match) 186 | false: xs 187 | } 188 | } 189 | 190 | // Removes "match" from the beginning of the String and returns the tail 191 | String.remove_start_with.go(xs: String, match: String): String 192 | case match{ 193 | nil : xs 194 | cons: case xs{ 195 | nil : String.nil //xs < match 196 | cons: case Char.eql(match.head, xs.head){ 197 | true : String.remove_start_with.go(xs.tail, match.tail) 198 | false: xs.tail 199 | } 200 | } 201 | } 202 | 203 | // Repeats a String for "n" times 204 | String.repeat(xs: String, n: Nat): String 205 | case n{ 206 | zero: String.nil 207 | succ: String.concat(xs, String.repeat(xs, n.pred)) 208 | } 209 | 210 | // Returns the first characters of a string, discards the rest. 211 | String.take(n: Nat, xs: String): String 212 | case xs{ 213 | nil : String.nil 214 | cons: case n{ 215 | zero : String.nil 216 | succ: String.cons(xs.head,String.take(n.pred, xs.tail)) 217 | } 218 | } 219 | 220 | // Removes the first characters of a string. 221 | String.drop(n: Nat, xs: String): String 222 | case n{ 223 | zero: xs 224 | succ: case xs{ 225 | nil : String.nil 226 | cons: String.drop(n.pred,xs.tail) 227 | } 228 | } 229 | 230 | // Get a substring from index i to j 231 | String.slice(i: Nat, j: Nat, xs: String): String 232 | String.take(Nat.sub(j, i), String.drop(i, xs)) 233 | 234 | // Splits a String given a separator ("match") 235 | String.split(xs: String, match: String): List(String) 236 | case xs{ 237 | nil : List.nil<_> 238 | cons: case String.starts_with(xs, match){ 239 | true: case match{ 240 | nil : List.cons(String.cons(xs.head, String.nil), String.split(xs.tail, match)) 241 | cons: List.cons("", String.split(String.drop(String.length(match), xs), match)) 242 | } 243 | false: 244 | case String.split(xs.tail, match) as split{ 245 | nil : List.nil<_> // FIXME: mark this impossible 246 | cons: List.cons<_>(String.cons(xs.head, split.head), split.tail) 247 | } 248 | } 249 | } 250 | 251 | // String.to_bits(str: String): Bits 252 | // case str{ 253 | // nil : Bits.nil 254 | // cons: Bits.concat(U16.to_bits(str.head))(String.to_bits(str.tail)) 255 | // } 256 | -------------------------------------------------------------------------------- /src/U16.fm: -------------------------------------------------------------------------------- 1 | type U16 { 2 | new(value: Word(16)) 3 | } 4 | 5 | U16.to_word(a: U16): Word(16) 6 | case a { 7 | new: a.value 8 | } 9 | 10 | // 0 11 | U16.zero: U16 12 | U16.new(Word.zero(16)) 13 | 14 | // ++a 15 | U16.inc(a: U16): U16 16 | case a { 17 | new: U16.new(Word.inc<_>(a.value)) 18 | } 19 | 20 | // a + b 21 | U16.add(a: U16, b: U16): U16 22 | case a { 23 | new: case b { 24 | new: U16.new(Word.add<_>(a.value, b.value)) 25 | } 26 | } 27 | 28 | // a - b 29 | U16.sub(a: U16, b: U16): U16 30 | case a { 31 | new: case b { 32 | new: U16.new(Word.sub<_>(a.value, b.value)) 33 | } 34 | } 35 | 36 | // a == b 37 | U16.eql(a: U16, b: U16): Bool 38 | case a { 39 | new: case b { 40 | new: Word.eql<_>(a.value, b.value) 41 | } 42 | } 43 | 44 | // a >= b 45 | U16.gte(a: U16, b: U16): Bool 46 | case a { 47 | new: case b { 48 | new: Word.gte<_>(a.value, b.value) 49 | } 50 | } 51 | 52 | // a > b 53 | U16.gtn(a: U16, b: U16): Bool 54 | case a { 55 | new: case b { 56 | new: Word.gtn<_>(a.value, b.value) 57 | } 58 | } 59 | 60 | // a <= b 61 | U16.lte(a: U16, b: U16): Bool 62 | case a { 63 | new: case b { 64 | new: Word.lte<_>(a.value, b.value) 65 | } 66 | } 67 | 68 | // a < b 69 | U16.ltn(a: U16, b: U16): Bool 70 | case a { 71 | new: case b { 72 | new: Word.ltn<_>(a.value, b.value) 73 | } 74 | } 75 | 76 | // a <= b <= c 77 | U16.btw(a: U16, b: U16, c: U16): Bool 78 | Bool.and(U16.lte(a, b), U16.lte(b, c)) 79 | 80 | // Stringifies to hex 81 | U16.show_hex(a: U16): String 82 | case a { 83 | new: Nat.to_string_base(16, Bits.to_nat(Word.to_bits<16>(a.value))) 84 | } 85 | 86 | 87 | U16.to_bits(a: U16): Bits 88 | case a { 89 | new: Word.to_bits<16>(a.value) 90 | } 91 | 92 | -------------------------------------------------------------------------------- /src/U32.fm: -------------------------------------------------------------------------------- 1 | type U32 { 2 | new(value: Word(32)) 3 | } 4 | 5 | // 0 6 | U32.zero: U32 7 | U32.new(Word.zero(32)) 8 | 9 | U32.add(a: U32, b: U32): U32 10 | case a { 11 | new: case b { 12 | new: U32.new(Word.add<_>(a.value, b.value)) 13 | } 14 | } 15 | 16 | U32.and(a: U32, b: U32): U32 17 | case a { 18 | new: case b { 19 | new: U32.new(Word.and<_>(a.value, b.value)) 20 | } 21 | } 22 | 23 | U32.concat(a: U32, b: U32): U64 24 | case a { 25 | new: case b { 26 | new: U64.new(Word.concat<_,_>(a.value, b.value)) 27 | } 28 | } 29 | 30 | // a / b 31 | U32.div(a: U32, b: U32): U32 32 | case a { 33 | new: case b { 34 | new: U32.new(Word.div<_>(a.value, b.value)) 35 | } 36 | } 37 | 38 | // a == b 39 | U32.eql(a: U32, b: U32): Bool 40 | case a { 41 | new: case b { 42 | new: Word.eql<_>(a.value, b.value) 43 | } 44 | } 45 | 46 | U32.for(state: S, from: U32, til: U32, func: U32 -> S -> S): S 47 | case U32.eql(from, til){ 48 | true : state 49 | false: U32.for(func(from, state), U32.inc(from), til, func) 50 | } 51 | 52 | // a >= b 53 | U32.gte(a: U32, b: U32): Bool 54 | case a { 55 | new: case b { 56 | new: Word.gte<_>(a.value, b.value) 57 | } 58 | } 59 | 60 | // a > b 61 | U32.gtn(a: U32, b: U32): Bool 62 | case a { 63 | new: case b { 64 | new: Word.gtn<_>(a.value, b.value) 65 | } 66 | } 67 | 68 | U32.inc(a: U32): U32 69 | case a{ 70 | new: U32.new(Word.inc<_>(a.value)) 71 | } 72 | 73 | U32.length(str: String): U32 74 | U32.length(str) 75 | 76 | // a <= b 77 | U32.lte(a: U32, b: U32): Bool 78 | case a { 79 | new: case b { 80 | new: Word.lte<_>(a.value, b.value) 81 | } 82 | } 83 | 84 | // a < b 85 | U32.ltn(a: U32, b: U32): Bool 86 | case a { 87 | new: case b { 88 | new: Word.ltn<_>(a.value, b.value) 89 | } 90 | } 91 | 92 | // a % b 93 | U32.mod(a: U32, b: U32): U32 94 | case a { 95 | new: case b { 96 | new: U32.new(Word.mod<_>(a.value, b.value)) 97 | } 98 | } 99 | 100 | // a * b 101 | U32.mul(a: U32, b: U32): U32 102 | case a { 103 | new: case b { 104 | new: U32.new(Word.mul<_>(a.value, b.value)) 105 | } 106 | } 107 | 108 | // U32.needed_depth(size: U32): Nat 109 | // U32.needed_depth.go(U32.sub(size, 1u)) 110 | 111 | // U32.needed_depth.go(n: U32): Nat 112 | // case U32.eql(n, 0u){ 113 | // true : 0 114 | // false: Nat.succ(U32.needed_depth.go(U32.shr(n,1u))) 115 | // } 116 | 117 | U32.or(a: U32, b: U32): U32 118 | case a { 119 | new: case b { 120 | new: U32.new(Word.or<_>(a.value, b.value)) 121 | } 122 | } 123 | 124 | // U32.parse_hex(str: String): U32 125 | // U32.new(Word.from_bits(32, Bits.parse_hex(str))) 126 | 127 | // U32.percent(p: U32, t: U32): U32 128 | // U32.div(U32.mul(p, t), 100u) 129 | 130 | U32.pow(a: U32, b: U32): U32 131 | case a { 132 | new: case b { 133 | new: U32.new(Word.pow<_>(a.value, b.value)) 134 | } 135 | } 136 | 137 | // U32.read_base(base: U32, str: String): U32 138 | // U32.read_base(base, str) 139 | 140 | // TODO 141 | U32.shl(n: U32, a: U32): U32 142 | U32.shl(n, a) 143 | 144 | // TODO 145 | U32.shr(n: U32, a: U32): U32 146 | U32.shr(n, a) 147 | 148 | // TODO 149 | U32.slice(i: U32, j: U32, str: String): String 150 | U32.slice(i, j, str) 151 | 152 | U32.sub(a: U32, b: U32): U32 153 | case a { 154 | new: case b { 155 | new: U32.new(Word.sub<_>(a.value, b.value)) 156 | } 157 | } 158 | 159 | U32.to_bits(a: U32): Bits 160 | case a { 161 | new: Word.to_bits<_>(a.value) 162 | } 163 | 164 | // U32.to_f64(a: U32): F64 165 | // U32.to_f64(a) 166 | 167 | // U32.to_nat(a: U32): Nat 168 | // case a{ 169 | // new: Word.to_nat<_>(a.value) 170 | // } 171 | 172 | // TODO: optimize 173 | // U32.to_string(n: U32): String 174 | // Nat.to_string_base(10, U32.to_nat(n)) 175 | 176 | U32.xor(a: U32, b: U32): U32 177 | case a { 178 | new: case b { 179 | new: U32.new(Word.xor<_>(a.value, b.value)) 180 | } 181 | } 182 | 183 | -------------------------------------------------------------------------------- /src/U64.fm: -------------------------------------------------------------------------------- 1 | type U64 { 2 | new(a: Word(64)) 3 | } 4 | -------------------------------------------------------------------------------- /src/Unit.fm: -------------------------------------------------------------------------------- 1 | type Unit { 2 | new 3 | } 4 | 5 | -------------------------------------------------------------------------------- /src/Vector.fm: -------------------------------------------------------------------------------- 1 | type Vector ~ (size: Nat) { 2 | nil ~ (size: Nat.zero), 3 | ext(head: A, tail: Vector(A,size)) ~ (size: Nat.succ(size)), 4 | } 5 | 6 | Vector.head(vector: Vector(A, Nat.succ(size))): A 7 | case vector { 8 | nil: Unit.new 9 | ext: vector.head 10 | }: case vector.size { zero: Unit, succ: A } 11 | 12 | Vector.tail(vector: Vector(A, Nat.succ(size))): Vector(A, size) 13 | case vector { 14 | nil: Unit.new 15 | ext: vector.tail 16 | }: case vector.size { zero: Unit, succ: Vector(A, Nat.pred(vector.size)) } 17 | 18 | Vector.from_list(xs: List(A)): Vector(A, List.length(xs)) 19 | case xs { 20 | nil : Vector.nil 21 | cons : Vector.ext(_, xs.head, Vector.from_list(xs.tail)) 22 | }! 23 | 24 | Vector.main: Nat 25 | Vector.head<_,3>(Vector.from_list<_>([1, 2, 3])) 26 | -------------------------------------------------------------------------------- /src/Word.fm: -------------------------------------------------------------------------------- 1 | type Word ~ (size: Nat) { 2 | e ~ (size: Nat.zero), 3 | o(pred: Word(size)) ~ (size: Nat.succ(size)), 4 | i(pred: Word(size)) ~ (size: Nat.succ(size)), 5 | } 6 | 7 | Word.to_bits(a: Word(size)): Bits 8 | case a { 9 | e: Bits.e, 10 | o: Bits.o(Word.to_bits(a.pred)), 11 | i: Bits.i(Word.to_bits(a.pred)), 12 | } 13 | 14 | Word.from_bits(size: Nat, bits: Bits): Word(size) 15 | case size { 16 | zero: Word.e, 17 | succ: case bits { 18 | e: Word.o(Word.from_bits(size.pred, Bits.e)), 19 | o: Word.o(Word.from_bits(size.pred, bits.pred)), 20 | i: Word.i(Word.from_bits(size.pred, bits.pred)) 21 | } : Word(Nat.succ(size.pred)) 22 | } : Word(size) 23 | 24 | Word.zero(size: Nat): Word(size) 25 | case size { 26 | zero: Word.e, 27 | succ: Word.o(Word.zero(size.pred)) 28 | } : Word(size) 29 | 30 | Word.cmp.go(a: Word(size), b: Word(size), c: Cmp): Cmp 31 | case a with b : Word(a.size) = b { 32 | e: c, 33 | o: case b with a.pred : Word(Nat.pred(b.size)) = a.pred { 34 | e: c, 35 | o: Word.cmp.go(a.pred, b.pred, c), 36 | i: Word.cmp.go(a.pred, b.pred, Cmp.ltn) 37 | }, 38 | i: case b with a.pred : Word(Nat.pred(b.size)) = a.pred { 39 | e: c, 40 | o: Word.cmp.go(a.pred, b.pred, Cmp.gtn), 41 | i: Word.cmp.go(a.pred, b.pred, c) 42 | } 43 | } 44 | 45 | // Right fold a word 46 | Word.fold Type, m: Nat>( 47 | nil : P(Nat.zero), 48 | w0 : -> P(n) -> P(Nat.succ(n)), 49 | w1 : -> P(n) -> P(Nat.succ(n)), 50 | word : Word(m) 51 | ) : P(m) 52 | case word { 53 | e: nil, 54 | o: w0(Word.fold(nil, w0, w1, word.pred)), 55 | i: w1(Word.fold(nil, w0, w1, word.pred)) 56 | } : P(word.size) 57 | 58 | // Left fold a word 59 | Word.foldl Type, m: Nat>( 60 | nil : P(Nat.zero), 61 | w0 : -> P(n) -> P(Nat.succ(n)), 62 | w1 : -> P(n) -> P(Nat.succ(n)), 63 | word : Word(m), 64 | ) : P(m) 65 | case word { 66 | e: 67 | nil, 68 | o: 69 | def P = (n) P(Nat.succ(n)); 70 | def nil = w0(nil); 71 | def w0 = w0; 72 | def w1 = w1; 73 | Word.foldl(nil, w0, w1, word.pred), 74 | i: 75 | def P = (n) P(Nat.succ(n)); 76 | def nil = w1(nil); 77 | def w0 = w0; 78 | def w1 = w1; 79 | Word.foldl(nil, w0, w1, word.pred), 80 | } : P(word.size) 81 | 82 | Word.trim(new_size: Nat, word: Word(size)): Word(new_size) 83 | case new_size { 84 | zero: Word.e, 85 | succ: case word { 86 | e: Word.o(Word.trim(new_size.pred, Word.e)), 87 | o: Word.o(Word.trim(new_size.pred, word.pred)), 88 | i: Word.i(Word.trim(new_size.pred, word.pred)) 89 | } 90 | } : Word(new_size) 91 | 92 | Word.adder(a: Word(size), b: Word(size), c: Bool): Word(size) 93 | case a with b: Word(a.size) = b { 94 | e: Word.e, 95 | o: case b with a.pred: Word(Nat.pred(b.size)) = a.pred { 96 | e: Word.e, 97 | o: case c { 98 | true : Word.i(Word.adder(a.pred, b.pred, Bool.false)), 99 | false: Word.o(Word.adder(a.pred, b.pred, Bool.false)), 100 | }, 101 | i: case c { 102 | true: Word.o(Word.adder(a.pred, b.pred, Bool.true)), 103 | false: Word.i(Word.adder(a.pred, b.pred, Bool.false)), 104 | } 105 | } : Word(b.size), 106 | i: case b with a.pred: Word(Nat.pred(b.size)) = a.pred { 107 | e: Word.e, 108 | o: case c { 109 | true : Word.o(Word.adder(a.pred, b.pred, Bool.true)), 110 | false: Word.i(Word.adder(a.pred, b.pred, Bool.false)), 111 | }, 112 | i: case c { 113 | true : Word.i(Word.adder(a.pred, b.pred, Bool.true)), 114 | false: Word.o(Word.adder(a.pred, b.pred, Bool.true)), 115 | } 116 | } : Word(b.size) 117 | } : Word(a.size) 118 | 119 | Word.subber(a: Word(size), b: Word(size), c: Bool): Word(size) 120 | case a with b: Word(a.size) = b { 121 | e: Word.e, 122 | o: case b with a.pred: Word(Nat.pred(b.size)) = a.pred { 123 | e: Word.e, 124 | o: case c { 125 | true : Word.i(Word.subber(a.pred, b.pred, Bool.true)), 126 | false: Word.o(Word.subber(a.pred, b.pred, Bool.false)), 127 | }, 128 | i: case c { 129 | true: Word.o(Word.subber(a.pred, b.pred, Bool.true)), 130 | false: Word.i(Word.subber(a.pred, b.pred, Bool.true)), 131 | } 132 | } : Word(b.size), 133 | i: case b with a.pred: Word(Nat.pred(b.size)) = a.pred { 134 | e: Word.e, 135 | o: case c { 136 | true : Word.o(Word.subber(a.pred, b.pred, Bool.false)), 137 | false: Word.i(Word.subber(a.pred, b.pred, Bool.false)), 138 | }, 139 | i: case c { 140 | true : Word.i(Word.subber(a.pred, b.pred, Bool.true)), 141 | false: Word.o(Word.subber(a.pred, b.pred, Bool.false)), 142 | } 143 | } : Word(b.size) 144 | } : Word(a.size) 145 | 146 | Word.concat(a: Word(a_size), b: Word(b_size)) 147 | : Word(Nat.add(a_size, b_size)) 148 | case a { 149 | e: b 150 | o: let rest = Word.concat(a.pred, b) 151 | Word.o(rest) 152 | i: let rest = Word.concat(a.pred, b) 153 | Word.i(rest) 154 | }: Word(Nat.add(a.size, b_size)) 155 | 156 | // ++a 157 | Word.inc(word: Word(size)): Word(size) 158 | case word { 159 | e: Word.e, 160 | o: Word.i(word.pred), 161 | i: Word.o(Word.inc(word.pred)) 162 | } : Word(word.size) 163 | 164 | // a + b 165 | Word.add(a: Word(size), b: Word(size)): Word(size) 166 | Word.adder(a)(b)(Bool.false) 167 | 168 | // a - b 169 | Word.sub(a: Word(size), b: Word(size)): Word(size) 170 | Word.subber(a, b, Bool.false) 171 | 172 | // a ? b 173 | Word.cmp(a: Word(size), b: Word(size)): Cmp 174 | Word.cmp.go(a, b, Cmp.eql) 175 | 176 | // a <= b 177 | Word.lte(a: Word(size), b: Word(size)): Bool 178 | Cmp.as_lte(Word.cmp(a, b)) 179 | 180 | // a < b 181 | Word.ltn(a: Word(size), b: Word(size)): Bool 182 | Cmp.as_ltn(Word.cmp(a, b)) 183 | 184 | // a == b 185 | Word.eql(a: Word(size), b: Word(size)): Bool 186 | Cmp.as_eql(Word.cmp(a, b)) 187 | 188 | // a >= b 189 | Word.gte(a: Word(size), b: Word(size)): Bool 190 | Cmp.as_gte(Word.cmp(a, b)) 191 | 192 | // a > b 193 | Word.gtn(a: Word(size), b: Word(size)): Bool 194 | Cmp.as_gtn(Word.cmp(a, b)) 195 | 196 | // a <= b <= c 197 | Word.btw(a: Word(size), b: Word(size), c: Word(size)): Bool 198 | Bool.and(Word.lte(a, b), Word.lte(b, c)) 199 | 200 | // TODO Multiplies two words 201 | Word.mul(a: Word(size), b: Word(size)): Word(size) 202 | Word.mul(a,b) 203 | 204 | // TODO 205 | Word.and(a: Word(size), b: Word(size)): Word(size) 206 | Word.and(a,b) 207 | 208 | // TODO word division 209 | Word.div(a: Word(size), b: Word(size)): Word(size) 210 | Word.div(a,b) 211 | 212 | // TODO word modulus 213 | Word.mod(a: Word(size), b: Word(size)): Word(size) 214 | Word.mod(a,b) 215 | 216 | // TODO bitwise OR between two words 217 | Word.or(a: Word(size), b: Word(size)): Word(size) 218 | Word.or(a,b) 219 | 220 | // TODO word exponentiation 221 | Word.pow(a: Word(size), b: Word(size)): Word(size) 222 | Word.pow(a, b) 223 | 224 | // TODO bitwise XOR between two words 225 | Word.xor(a: Word(size), b: Word(size)): Word(size) 226 | Word.xor(a, b) 227 | --------------------------------------------------------------------------------