├── .pantagruel.jdn ├── priv ├── unary.pant ├── app.pant ├── domain-reference.pant ├── extend.pant ├── arithmetic.pant ├── case-with-any.pant ├── promotion.pant ├── do.pant ├── import.pant ├── case-with-expr.pant ├── cards-case-rank.pant.error ├── cards-case-rank.pant ├── cards-case-branches.pant ├── thunk-application.pant ├── references.pant ├── procedure-type.pant ├── comprehensions.pant ├── extend.pant.error ├── fib.pant ├── concat.pant ├── cards-case-branches.pant.error ├── update.pant ├── app.pant.error ├── exact-values.pant ├── checkout.pant ├── cards.pant ├── binding.pant └── reference.md ├── .gitignore ├── project.janet ├── pantagruel ├── types │ ├── errors.janet │ ├── literals.janet │ ├── type-checking.janet │ ├── utils.janet │ ├── syntactic-types.janet │ ├── gcd.janet │ └── types.janet ├── print-src.janet ├── stdlib.janet ├── lexer.janet ├── parser.janet └── eval │ └── engine.janet ├── lockfile.jdn ├── test ├── util.janet ├── integration.janet ├── engine-test.janet ├── lexer_test.janet ├── types-test.janet └── parser_test.janet ├── README.md └── pantagruel.janet /.pantagruel.jdn: -------------------------------------------------------------------------------- 1 | {"path" "priv"} 2 | -------------------------------------------------------------------------------- /priv/unary.pant: -------------------------------------------------------------------------------- 1 | n => [Real]. 2 | --- 3 | #n = 1. 4 | -------------------------------------------------------------------------------- /priv/app.pant: -------------------------------------------------------------------------------- 1 | f x: Nat. 2 | --- 3 | f 1. 4 | f "ok". 5 | -------------------------------------------------------------------------------- /priv/domain-reference.pant: -------------------------------------------------------------------------------- 1 | User. 2 | --- 3 | User = Int. 4 | -------------------------------------------------------------------------------- /priv/extend.pant: -------------------------------------------------------------------------------- 1 | val xs => {Nat}. 2 | --- 3 | extend xs ... 1,2. 4 | extend xs ... "ok". 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /tags 2 | 3 | pant_lexer.erl 4 | pant_parser.erl 5 | 6 | /build 7 | /jpm_tree 8 | -------------------------------------------------------------------------------- /priv/arithmetic.pant: -------------------------------------------------------------------------------- 1 | Trit = {0, 1, 2}. 2 | add (x, y): Trit => Trit. 3 | --- 4 | add 1 2 = 0. 5 | -------------------------------------------------------------------------------- /priv/case-with-any.pant: -------------------------------------------------------------------------------- 1 | f => Nat0. 2 | --- 3 | case f ... 4 | 1 => "ok", 5 | _ => "also ok". 6 | -------------------------------------------------------------------------------- /priv/promotion.pant: -------------------------------------------------------------------------------- 1 | Status = {"ok", "error"}. 2 | inc n: Nat => Status. 3 | --- 4 | inc 0 = "ok". 5 | -------------------------------------------------------------------------------- /priv/do.pant: -------------------------------------------------------------------------------- 1 | f n: Nat0. 2 | b => Bool. 3 | --- 4 | case b ... 5 | true => f 3, 6 | false => do f 1; f 2. 7 | -------------------------------------------------------------------------------- /priv/import.pant: -------------------------------------------------------------------------------- 1 | module IMPORTER. 2 | import CHECKOUT. 3 | 4 | additional_procedure d: Document. 5 | --- 6 | -------------------------------------------------------------------------------- /priv/case-with-expr.pant: -------------------------------------------------------------------------------- 1 | fib_primitive x : Nat => Nat. 2 | --- 3 | fib_primitive x = case x ... 4 | 1 => 1, 5 | 2 => 1. 6 | -------------------------------------------------------------------------------- /priv/cards-case-rank.pant.error: -------------------------------------------------------------------------------- 1 | @[@{:left @{:literal "\"ok\""} 2 | :right @{:literal "\"no\""} 3 | :type :gcd-case-test 4 | :extra {}}] 5 | 6 | -------------------------------------------------------------------------------- /priv/cards-case-rank.pant: -------------------------------------------------------------------------------- 1 | Card. 2 | Rank = {"ok"}. 3 | rank c: Card => Rank. 4 | value c: Card => Nat. 5 | --- 6 | case (rank c) ... 7 | "no" => 8, 8 | 1 => 9. 9 | -------------------------------------------------------------------------------- /priv/cards-case-branches.pant: -------------------------------------------------------------------------------- 1 | Card. 2 | Rank = {1, 2}. 3 | rank c: Card => Rank. 4 | value c: Card => Nat. 5 | --- 6 | case (rank c) ... 7 | 2 => "ok", 8 | 1 => 9. 9 | -------------------------------------------------------------------------------- /priv/thunk-application.pant: -------------------------------------------------------------------------------- 1 | f x: Any => {String}. 2 | --- 3 | [all s: String, s in f x ... s]. 4 | [all chapter: String, chapter in (f x), ss: Char, ss in chapter ... ss]. 5 | -------------------------------------------------------------------------------- /priv/references.pant: -------------------------------------------------------------------------------- 1 | Line = String. 2 | Reference = Line. 3 | Note = [Line]. 4 | references n: Note => [Reference]. 5 | --- 6 | all line: Line, line in n ... line in (references n). 7 | 8 | -------------------------------------------------------------------------------- /priv/procedure-type.pant: -------------------------------------------------------------------------------- 1 | Player. 2 | Card. 3 | 4 | val scores p: Player => Nat0. 5 | play p: Player, c: Card, table: {Card}. 6 | --- 7 | 8 | scores' = update scores ... p => (scores p) +1. 9 | -------------------------------------------------------------------------------- /priv/comprehensions.pant: -------------------------------------------------------------------------------- 1 | User. 2 | is_admin? u: User => Bool. 3 | admins => [User]. 4 | --- 5 | admins = [all u: User, is_admin? u ... u]. 6 | [all u': User, u in [all u: User ... u] ... u'] = admins. 7 | -------------------------------------------------------------------------------- /priv/extend.pant.error: -------------------------------------------------------------------------------- 1 | @[@{:left @{:kind :concrete 2 | :name "Nat" 3 | :type @{:kind :meta-domain :name "Domain"}} 4 | :right @{:literal "\"ok\""} 5 | :type :gcd-set-extension 6 | :extra {}}] 7 | -------------------------------------------------------------------------------- /priv/fib.pant: -------------------------------------------------------------------------------- 1 | fib x : Nat => Nat. 2 | --- 3 | fib x = case ... 4 | x > 2 => fib (x - 1) + fib (x - 2), 5 | x = 1 => 1, 6 | x = 2 => 1. 7 | 8 | fib x = case x ... 9 | 1 => 1, 10 | 2 => 1, 11 | x => fib (x - 1) + fib (x - 2). 12 | -------------------------------------------------------------------------------- /priv/concat.pant: -------------------------------------------------------------------------------- 1 | concat (s, r): String => String. 2 | --- 3 | #(concat s r) = #s + #r. 4 | 5 | (concat s r) 0 = s 0. 6 | (concat s r) s = 0. 7 | 8 | where 9 | 10 | SampleValues = {"ok", "error"}. 11 | --- 12 | all x: SampleValues ... concat "" x = x. 13 | -------------------------------------------------------------------------------- /priv/cards-case-branches.pant.error: -------------------------------------------------------------------------------- 1 | @[@{:left @{:kind :concrete :name "String" 2 | :type @{:kind :meta-domain :name "Domain"}} 3 | :right @{:kind :concrete :name "Nat" 4 | :type @{:kind :meta-domain :name "Domain"}} 5 | :type :gcd-case-branches 6 | :extra {}}] 7 | -------------------------------------------------------------------------------- /priv/update.pant: -------------------------------------------------------------------------------- 1 | map key: Any => Any. 2 | delete m: map, key: Any => map. 3 | val xs => {Nat}. 4 | --- 5 | 6 | delete m key = update m ... 7 | key => nil. 8 | 9 | where 10 | 11 | complex_procedure (x, y): Nat => Nat. 12 | --- 13 | 14 | update complex_procedure ... 15 | (2, 10) => 10. 16 | 17 | extend xs ... 1, 2. 18 | -------------------------------------------------------------------------------- /project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "pantagruel" 3 | :dependencies 4 | [{:repo "https://github.com/andrewchambers/janet-yacc.git" :tag "main"} 5 | "spork"]) 6 | 7 | (declare-source 8 | :source ["pantagruel.janet" "pantagruel/"]) 9 | 10 | (declare-executable 11 | :entry "pantagruel.janet" 12 | :name "pant") 13 | -------------------------------------------------------------------------------- /priv/app.pant.error: -------------------------------------------------------------------------------- 1 | @[@{:extra {:f {:args {:tuple-of (@{:kind :concrete :name "Nat" :type @{:kind :meta-domain :name "Domain"}})} :decl-name "f" :yields @{:kind :concrete :name "Void" :type @{:kind :meta-domain :name "Domain"}}}} :left @{:kind :concrete :name "Nat" :type @{:kind :meta-domain :name "Domain"}} :right @{:literal "\"ok\""} :type :gcd-app}] 2 | 3 | -------------------------------------------------------------------------------- /pantagruel/types/errors.janet: -------------------------------------------------------------------------------- 1 | (def- ResolutionError @{}) 2 | 3 | (defn throw 4 | ``` 5 | Handle type errors encountered during type resolution. 6 | 7 | This doesn't include errors or gaps in type resolution logic, which will be 8 | raised immediately. 9 | ``` 10 | [t &opt vars] 11 | (default vars @{}) 12 | (error (table/setproto (merge vars @{:type t}) ResolutionError))) 13 | 14 | -------------------------------------------------------------------------------- /lockfile.jdn: -------------------------------------------------------------------------------- 1 | @[{:url "https://github.com/andrewchambers/janet-yacc.git" :tag "b23ff868208d0f8a1a6d9a6747b014461f2791cf" :type :git} 2 | {:url "https://github.com/janet-lang/pkgs.git" :tag "162d3375ea45617075d7120b77d89f7d866a2494" :type :git} 3 | {:url "https://github.com/janet-lang/spork.git" :tag "d02df68bc462e63ea7a7151ac7f21e478d23666e" :type :git} 4 | {:url "https://github.com/pyrmont/testament.git" :tag "e404bbb38c82ef88f91c0b259855631365543f7b" :type :git}] 5 | -------------------------------------------------------------------------------- /priv/exact-values.pant: -------------------------------------------------------------------------------- 1 | StatusS = {"ok", "error"}. 2 | reportSl sl: StatusS => Bool. 3 | reportSs ss: String => Bool. 4 | --- 5 | 6 | reportSl "ok". 7 | reportSs "hello". 8 | 9 | where 10 | 11 | StatusN = {1, 2}. 12 | reportNl nl: StatusN => Bool. 13 | reportNn nn: Nat => Bool. 14 | --- 15 | 16 | reportNl 2. 17 | reportNn 3. 18 | 2 + 1. 19 | 2 > 1. 20 | 2 and 1. 21 | 22 | where 23 | 24 | Section = {"head", "body"}. 25 | section => Section. 26 | --- 27 | 28 | case section ... 29 | "head" => true, 30 | "body" => false. 31 | -------------------------------------------------------------------------------- /test/util.janet: -------------------------------------------------------------------------------- 1 | (def . {:kind :.}) 2 | (def bind {:kind ::}) 3 | (def --- {:kind :line}) 4 | (def => {:kind :yields}) 5 | (def ... {:kind :...}) 6 | (def = {:kind := :text "="}) 7 | (def + {:kind :arithmetic-operator2 :text "+"}) 8 | (def lp {:kind :lparen}) 9 | (def rp {:kind :rparen}) 10 | (def card {:kind :unary-operator :text "#"}) 11 | (def comma {:kind :comma :text ","}) 12 | 13 | (def head-placeholder [{:kind :sym :text "f"} . ---]) 14 | 15 | (defn sym [text] {:kind :sym :text text}) 16 | (defn num [text] {:kind :num :text text}) 17 | -------------------------------------------------------------------------------- /priv/checkout.pant: -------------------------------------------------------------------------------- 1 | module CHECKOUT. 2 | 3 | User. 4 | Document. 5 | owner d : Document => User. 6 | 7 | // A specification for a small document management system. 8 | 9 | check_out u:User, d:Document. 10 | --- 11 | 12 | // A user may check out a document if they have permission to access it and 13 | // it's not currently checked out. 14 | 15 | owner d = nobody and has_perm? u d -> owner d' = u. 16 | owner d != nobody or ~(has_perm? u d) -> owner d' = owner d. 17 | 18 | where 19 | 20 | nobody => User. 21 | has_perm? u:User, d:Document => Bool. 22 | --- 23 | -------------------------------------------------------------------------------- /pantagruel/types/literals.janet: -------------------------------------------------------------------------------- 1 | (def- literals @{}) 2 | 3 | (defn intern 4 | ``` 5 | Get or create an object around a specific literal value. 6 | ``` 7 | [proto value] 8 | (if-let [interned (literals value)] 9 | interned 10 | (let [literal (table/setproto @{:literal value} proto)] 11 | (put literals value literal) 12 | literal))) 13 | 14 | (defn widen 15 | ``` 16 | Given a literal type, widen it to its prototype. 17 | ``` 18 | [t] 19 | (match t 20 | {:literal _ } 21 | (table/getproto t) 22 | 23 | t)) 24 | 25 | -------------------------------------------------------------------------------- /priv/cards.pant: -------------------------------------------------------------------------------- 1 | module CARDS. 2 | 3 | Player. 4 | Card. 5 | 6 | Suit = {"diamonds", "hearts", "clubs", "spades"}. 7 | Rank = {"jack", "queen", "king"} + Nat. 8 | 9 | deal => Void. 10 | 11 | rank c: Card => Rank. 12 | suit c: Card => Suit. 13 | 14 | sum cs: {Card} => Nat0. 15 | 16 | hand p: Player => {Card}. 17 | 18 | value c: Card => Nat. 19 | --- 20 | 21 | // The capturing values of the cards are simply the numeric values up to 7, and 22 | // then 8, 9, 10 for the courts. 23 | value c = case (rank c) ... 24 | "jack" => 8, 25 | "queen" => 9, 26 | "king" => 10, 27 | rank c => rank c. 28 | -------------------------------------------------------------------------------- /pantagruel/print-src.janet: -------------------------------------------------------------------------------- 1 | (import spork/path) 2 | 3 | (defn print-src 4 | ``` 5 | Given a span, return the slice of the source document that corresponds to it. 6 | ``` 7 | [{:span span} src] 8 | (string/slice src ;span)) 9 | 10 | (defn- line-no 11 | ``` 12 | Find the line number of an index into `src`. 13 | ``` 14 | [{:span [n]} src] 15 | (var line 1) 16 | (for i 0 n 17 | (case (src i) 18 | (chr "\n") (+= line 1))) 19 | line) 20 | 21 | (defn line-starter 22 | [file src] 23 | (fn [sym] 24 | (eprinf "%s:%i: " 25 | (path/basename file) 26 | (line-no sym src)))) 27 | -------------------------------------------------------------------------------- /pantagruel/types/type-checking.janet: -------------------------------------------------------------------------------- 1 | ## Type checking. 2 | ## 3 | ## Responsible for using the type resolution logic to check the types of a 4 | ## document and report errors if found. 5 | (import spork/path) 6 | 7 | (import /pantagruel/stdlib) 8 | (import /pantagruel/types/types) 9 | 10 | (defn get-type-errors 11 | ``` 12 | Attempt full type resolution, sequentially, of each body expression in a 13 | document. Output error messages for each type error found and, if any were 14 | found, exit with a non-zero status code. 15 | ``` 16 | [tree env file src] 17 | 18 | (let [type-errors @[]] 19 | 20 | (defn check-expr 21 | [e] 22 | (try 23 | (types/resolve-type e env) 24 | ([err fib] 25 | (if (table? err) 26 | (array/push type-errors [e err]) 27 | (propagate err fib))))) 28 | 29 | (var type-error false) 30 | (each {:head head :body body} (tree :chapters) 31 | (each head-expr head 32 | (when (head-expr :bindings) 33 | (check-expr head-expr))) 34 | (each body-expr body 35 | (check-expr body-expr))) 36 | 37 | type-errors)) 38 | -------------------------------------------------------------------------------- /priv/binding.pant: -------------------------------------------------------------------------------- 1 | Section. 2 | Program = [Section]. 3 | 4 | eval p : Program => Bool. 5 | 6 | // A section head must have at least one statement; a section body 7 | // can be empty. 8 | 9 | section head : Head, body : Body, #head > 0 => Section. 10 | 11 | Head = [Comment + Declaration + Alias]. 12 | Body = [Comment + Expression]. 13 | (Comment, Declaration, Alias, Expression) = String. 14 | --- 15 | eval p <-> all sect : Section, sect in p ... all_bound? sect. 16 | 17 | where 18 | 19 | all_bound? sect : Section => Bool. 20 | --- 21 | 22 | // All variables referred to in a section head must be defined by 23 | // the end of that section head. All the variables in a section 24 | // body, however, must be defined by the end of the *next* section 25 | // body. 26 | 27 | all_bound? sect <-> 28 | all sym : String, sym in head_of sect ... bound? sym 29 | and 30 | all sym : String, sym in body_of (p (p sect - 1)) ... bound? sym. 31 | 32 | where 33 | 34 | head_of sect : Section => Head. 35 | body_of sect : Section => Body. 36 | 37 | bound? sym : String => Bool. 38 | --- 39 | 40 | bound? sym <-> (sym in (env p) (p sect)) or (sym in base_env). 41 | 42 | where 43 | 44 | env p : Program => [Scope]. 45 | base_env => Scope. 46 | Scope = {String}. 47 | --- 48 | -------------------------------------------------------------------------------- /pantagruel/stdlib.janet: -------------------------------------------------------------------------------- 1 | (def base-env @{}) 2 | 3 | (def Domain @{:kind :meta-domain 4 | :name "Domain"}) 5 | (put base-env "Domain" Domain) 6 | 7 | (defmacro- deftype 8 | [name parent] 9 | ~(upscope 10 | (def ,name (table/setproto @{:kind :concrete 11 | :name ,(string name) 12 | :type Domain} 13 | ,parent)) 14 | (put base-env ,(string name) ,name))) 15 | 16 | (defmacro- defvalue 17 | [name parent] 18 | (let [sym (symbol "pant-" name)] 19 | ~(upscope 20 | (def ,sym @{:value ,(string name) :type ,parent}) 21 | (put base-env ,(string name) ,sym)))) 22 | 23 | (def Any @{:kind :concrete 24 | :name "Any" 25 | :type Domain}) 26 | (put base-env "Any" Any) 27 | 28 | (deftype Real Any) 29 | (deftype Rat Real) 30 | (deftype Int Rat) 31 | (deftype Nat0 Int) 32 | (deftype Bool Nat0) 33 | (deftype Nat Nat0) 34 | (deftype Char Nat) 35 | 36 | (deftype String Any) 37 | (deftype Date Any) 38 | (deftype Void Any) 39 | 40 | (defvalue "true" Bool) 41 | (defvalue "false" Bool) 42 | (defvalue "nil" Any) 43 | 44 | (def arithmetic-operators ["-" "+" "*" "/" "mod"]) 45 | 46 | (def comparison-operators ["=" "!=" "<" ">" "=<" ">="]) 47 | 48 | (def boolean-operators ["~" "and" "or" "xor" "->" "<->"]) 49 | -------------------------------------------------------------------------------- /pantagruel/types/utils.janet: -------------------------------------------------------------------------------- 1 | (import /pantagruel/types/gcd) 2 | (import /pantagruel/stdlib :prefix "") 3 | 4 | (defn number-type 5 | ``` 6 | Given a number, resolve the narrowest element of the number tower it is a 7 | member of. 8 | ``` 9 | [n] 10 | (cond 11 | (and (nat? n) (> n 0)) Nat 12 | (nat? n) Nat0 13 | (int? n) Int 14 | 15 | Real)) 16 | 17 | (defn sum-inner 18 | [t] 19 | (case (t :kind) 20 | :sum (t :inner) 21 | [t])) 22 | 23 | (defn sum-type 24 | ``` 25 | Handle sum type syntax, either: 26 | - Foo + Bar 27 | - {value1, value2} 28 | ``` 29 | [left-t right-t] 30 | # If either side is itself a sum type, unpack it; in other words, 31 | # (X + Y) + Z = {X, Y, Z}. 32 | (let [t1 (sum-inner left-t) 33 | t2 (sum-inner right-t)] 34 | (cond 35 | (and (all |($ :literal) t1) 36 | (all |($ :literal) t2)) 37 | {:kind :sum :inner (distinct [;t1 ;t2])} 38 | 39 | (let [gcd (protect (gcd/gcd-type t1 t2 :gcd-sum))] 40 | (cond 41 | # If the two types are unifiable, return the common denominator. 42 | (gcd 0) (gcd 1) 43 | # If both sides are equivalent, we don't need a sum. In other words, 44 | # X + X = X. 45 | (and (= t1 t2) (one? (length t1))) (t1 0) 46 | 47 | {:kind :sum 48 | :inner (distinct [;t1 ;t2])}))))) 49 | -------------------------------------------------------------------------------- /test/integration.janet: -------------------------------------------------------------------------------- 1 | (use testament) 2 | 3 | (import spork/path) 4 | 5 | (import /pantagruel) 6 | 7 | (setdyn :exit-on-error false) 8 | 9 | (def tests (->> (os/dir "priv") (filter |(string/has-suffix? ".pant" $)))) 10 | 11 | (deftest integration 12 | (each test tests 13 | (let [full-path (path/join "priv" test) 14 | error-path (string full-path ".error") 15 | src (slurp full-path) 16 | available-modules (pantagruel/populate-available-modules {"path" "priv"}) 17 | eval-errors (try 18 | (pantagruel/handle-src full-path src available-modules) 19 | ([err fib] 20 | (is (nil? err) 21 | (string/format "[%s] Integration test execution failure: %q" test err))))] 22 | 23 | (if (os/stat error-path) 24 | (do 25 | (each eval-error eval-errors 26 | (is 27 | (= 2 (length eval-error)) 28 | (string/format "[%s] Integration test got unexpected errors: %j" test eval-error))) 29 | 30 | (let [type-errors (map (fn [[_ err]] err) eval-errors) 31 | error-message (parse (slurp error-path)) 32 | assert-message (string/format 33 | "[%s]\nExpected type errors: %q\nFound type errors: %q\n" 34 | test 35 | error-message 36 | type-errors)] 37 | (assert-equivalent error-message type-errors assert-message))) 38 | 39 | (is (empty? eval-errors) (string/format "[%s] Integration test errors: %q" test eval-errors)))))) 40 | 41 | (run-tests!) 42 | -------------------------------------------------------------------------------- /pantagruel/lexer.janet: -------------------------------------------------------------------------------- 1 | ## PEG-based grammar and lexer. 2 | 3 | (defn- wrap-rule 4 | [[kw peg]] 5 | [kw ~(cmt 6 | (* ($) (constant ,kw) (<- ,peg) ($)) 7 | ,(fn 8 | [left kind text right-or-num &opt maybe-right] 9 | # Special handling of numbers: 10 | # We use cmt with scan-number to parse numbers, meaning that in a 11 | # number match there'll be an extra argument. If there are 5 12 | # arguments, treat the last argument as the right span and then 13 | # second-to-last as the original input to the cmt form. 14 | (let [right (if maybe-right maybe-right right-or-num)] 15 | {:kind kind :text text :span [left right]})))]) 16 | 17 | (defn- rules-to-peg 18 | [rules] 19 | (def rules (map wrap-rule rules)) 20 | (def grammar @{}) 21 | (each [kw p] rules 22 | (put grammar kw p)) 23 | (merge-into 24 | grammar 25 | ~{:main (* (any :tok) (choice (not 1) :lex-error)) 26 | :tok ,(tuple 'choice ;(map first rules)) 27 | :lex-error (* (cmt ($) ,|{:kind :lex-error :span [$ $]}) 1)}) 28 | (table/to-struct grammar)) 29 | 30 | (def- lexer-grammar 31 | # Symbol grammar cribbed from Janet spec. 32 | (let [digits-peg '(some (+ (range "09" "AZ" "az") (set "_"))) 33 | sym-peg '(some (+ (range "09" "AZ" "az" "\x80\xFF") (set "'!$%?@_")))] 34 | 35 | (defn kwd 36 | [word] 37 | ~(* ,word (not ,sym-peg))) 38 | 39 | ~[[:comment (* "//" (thru "\n"))] 40 | [:string (* `"` (thru `"`))] 41 | [:ws :s+] 42 | [:directive (+ ,(kwd "module") ,(kwd "import"))] 43 | [:where ,(kwd "where")] 44 | [:line (at-least 3 "-")] 45 | [:... "..."] 46 | [:. "."] 47 | [:yields "=>"] 48 | [:: ":"] 49 | [:semicolon ";"] 50 | [:+ "+"] 51 | [:comma ","] 52 | [:update ,(kwd "update")] 53 | [:extend ,(kwd "extend")] 54 | [:case ,(kwd "case")] 55 | [:all ,(kwd "all")] 56 | [:some1 ,(kwd "some1")] 57 | [:some ,(kwd "some")] 58 | [:val ,(kwd "val")] 59 | [:do ,(kwd "do")] 60 | [:lparen "("] 61 | [:rparen ")"] 62 | [:lsquare "["] 63 | [:rsquare "]"] 64 | [:lbrace "{"] 65 | [:rbrace "}"] 66 | [:logical-operator (+ "<->" "->")] 67 | [:boolean-operator (+ "=<" ">=" ">" "<" "!=" 68 | ,(kwd "in") 69 | ,(kwd "or") 70 | ,(kwd "and") 71 | ,(kwd "xor"))] 72 | [:= "="] 73 | [:arithmetic-operator1 (+ "*" "/" "^" ,(kwd "mod"))] 74 | [:arithmetic-operator2 (+ "-" "|" "&")] 75 | [:unary-operator (+ "~" "#")] 76 | [:num (cmt (<- (+ 77 | (* ,digits-peg "." ,digits-peg) 78 | (* "." ,digits-peg) 79 | ,digits-peg)) 80 | ,scan-number)] 81 | [:sym ,sym-peg]])) 82 | 83 | (def- lexer (-> lexer-grammar (rules-to-peg) (peg/compile))) 84 | 85 | (defn lex 86 | ``` 87 | Generate an array of tokens from document text. 88 | ``` 89 | [text] 90 | (def tokens (peg/match lexer text)) 91 | (filter |(not (index-of ($ :kind) [:ws :comment])) tokens)) 92 | -------------------------------------------------------------------------------- /pantagruel/types/syntactic-types.janet: -------------------------------------------------------------------------------- 1 | ## Logic to derive type information from purely syntactic forms. 2 | 3 | (import /pantagruel/types/utils) 4 | (import /pantagruel/types/literals) 5 | (import /pantagruel/stdlib :prefix "") 6 | 7 | (defn- distribute-bindings-types 8 | ``` 9 | Handle binding form (x, y, z):T, shorthand for x:T, y:T, z:T. 10 | ``` 11 | [bindings] 12 | 13 | (defn distribute-binding-type 14 | [binding] 15 | (match binding 16 | {:kind :binding 17 | :name {:container :parens :inner {:seq inner}} 18 | :expr expr} 19 | (map (fn [_] expr) inner) 20 | 21 | {:kind :binding 22 | :expr expr} 23 | [expr] 24 | 25 | # Bindings lists can have arbitrary expressions as guards; those don't 26 | # assign any types to any variables. 27 | {} 28 | [] 29 | 30 | (errorf "Attempted to distribute binding type; got binding %q" binding))) 31 | 32 | (mapcat distribute-binding-type bindings)) 33 | 34 | (defn type-of-form 35 | ``` 36 | All forms that syntactically establish some type. 37 | ``` 38 | [form] 39 | 40 | (defn unwrap 41 | [wrapped] 42 | (if (one? (length wrapped)) 43 | (type-of-form (wrapped 0)) 44 | (map type-of-form wrapped))) 45 | 46 | (match form 47 | {:container :list-of 48 | :inner inner} 49 | {:list-of (type-of-form inner)} 50 | 51 | {:container :set-of 52 | :inner inner} 53 | {:set-of (type-of-form inner)} 54 | 55 | {:kind :domain-sum 56 | :inner inner} 57 | (or 58 | (reduce2 utils/sum-type (map type-of-form inner)) 59 | {:set-of []}) 60 | 61 | {:kind :domain-set 62 | :inner {:seq inner}} 63 | (or 64 | (reduce2 utils/sum-type (map type-of-form inner)) 65 | {:set-of []}) 66 | 67 | {:container :parens 68 | :inner inner} 69 | (let [inner-t (type-of-form inner)] 70 | (if (array? inner-t) 71 | {:tuple-of inner-t} 72 | inner-t)) 73 | 74 | {:kind :declaration 75 | :name {:text name} 76 | :yields yields 77 | :bindings {:seq bindings}} 78 | {:decl-name name 79 | :yields (type-of-form yields) 80 | :args {:tuple-of (map type-of-form (distribute-bindings-types bindings))}} 81 | 82 | ({:kind :declaration 83 | :name {:text name} 84 | :bindings {:seq bindings}} (empty? bindings)) 85 | (if (= (name 0) ((string/ascii-upper name) 0)) 86 | Domain 87 | {:decl-name name 88 | :args {:tuple-of []} 89 | :yields Void}) 90 | 91 | {:kind :declaration 92 | :name {:text name} 93 | :bindings {:seq bindings}} 94 | {:decl-name name 95 | :args {:tuple-of (map type-of-form (distribute-bindings-types bindings))} 96 | :yields Void} 97 | 98 | {:kind :string :text text} 99 | (literals/intern String text) 100 | 101 | {:kind :num 102 | :text n} 103 | (literals/intern (utils/number-type n) n) 104 | 105 | # Recursive cases 106 | ({:seq wrapped} (tuple? wrapped)) 107 | (unwrap wrapped) 108 | 109 | (wrapped (tuple? wrapped)) 110 | (unwrap wrapped) 111 | 112 | # Fall-through case: if we can't tell the type now, defer it for later. 113 | {:thunk form})) 114 | 115 | -------------------------------------------------------------------------------- /test/engine-test.janet: -------------------------------------------------------------------------------- 1 | (use testament) 2 | 3 | (import /pantagruel/eval/engine) 4 | (import /pantagruel/stdlib) 5 | (import /pantagruel/lexer) 6 | (import /pantagruel/parser) 7 | 8 | (defn do-parse 9 | [src] 10 | (-> src 11 | (lexer/lex) 12 | (parser/parse-tokens))) 13 | 14 | (defn is-eval 15 | [expected-env src] 16 | (let [evaluator (engine/Evaluator "unit test" src) 17 | tree (do-parse src) 18 | [success? res] (protect (:eval evaluator tree))] 19 | (is success? (string/format "eval failure:\n\n%s\n\nFails with:\n%s" 20 | (string src) 21 | (if (table? res) (string/format "%q" res) (string res)))) 22 | (if success? 23 | (is (== expected-env (table/to-struct res)))))) 24 | 25 | (deftest eval-single-declaration 26 | (is-eval 27 | {"f" {:kind :domain 28 | :type {:decl-name "f" 29 | :args {:tuple-of ()} 30 | :yields stdlib/Void}}} 31 | `f. 32 | --- 33 | `)) 34 | 35 | (deftest eval-declaration-with-binding 36 | (is-eval 37 | {"X" { 38 | :kind :domain 39 | :type stdlib/Domain} 40 | "f" { 41 | :kind :procedure 42 | :type {:decl-name "f" 43 | :args {:tuple-of @[{:thunk {:kind :sym :span [7 8] :text "X"}}]} 44 | :yields stdlib/Void}} 45 | "x" {:kind :bound :type {:thunk {:kind :sym :span [7 8] :text "X"}}} 46 | "x'" {:kind :bound :type {:thunk {:kind :sym :span [7 8] :text "X"}}}} 47 | ` 48 | X. 49 | f x:X. 50 | --- 51 | `)) 52 | 53 | (deftest eval-declaration-with-yields 54 | (is-eval 55 | {"F" {:kind :domain 56 | :type stdlib/Domain} 57 | "f" {:kind :procedure 58 | :type {:decl-name "f" 59 | :args {:tuple-of @[]} 60 | :yields {:thunk {:kind :sym :span [8 9] :text "F"}}}}} 61 | ` 62 | F. 63 | f => F. 64 | --- 65 | `)) 66 | 67 | (deftest eval-alias-declaration 68 | (is-eval 69 | {"F" {:kind :domain 70 | :type stdlib/Domain} 71 | "f" {:kind :domain 72 | :type {:thunk {:kind :sym :span [7 8] :text "F"}}}} 73 | ` 74 | F. 75 | f = F. 76 | --- 77 | `)) 78 | 79 | (deftest eval-alias-declaration-container 80 | (is-eval 81 | {"F" {:kind :domain 82 | :type stdlib/Domain} 83 | "f" {:kind :domain 84 | :type {:list-of {:thunk {:kind :sym :span [8 9] :text "F"}}}}} 85 | ` 86 | F. 87 | f = [F]. 88 | --- 89 | `)) 90 | 91 | (deftest eval-body 92 | (is-eval 93 | {"g" {:kind :domain 94 | :type {:decl-name "g" 95 | :args {:tuple-of ()} 96 | :yields stdlib/Void}}} 97 | `g. 98 | --- 99 | g. 100 | `)) 101 | 102 | (deftest eval-qualification 103 | (is-eval 104 | {"f" {:kind :domain 105 | :type {:decl-name "f" 106 | :args {:tuple-of ()} 107 | :yields stdlib/Void}}} 108 | 109 | `f. 110 | --- 111 | some x:Nat, x > 1 ... x < 10. 112 | `)) 113 | 114 | (deftest eval-quantification-with-container 115 | (is-eval 116 | {"A" {:kind :domain 117 | :type stdlib/Domain}} 118 | `A. 119 | --- 120 | some (a, b):A ... a + b. 121 | `)) 122 | 123 | (deftest eval-chapter 124 | (is-eval 125 | {"X" {:kind :domain 126 | :type stdlib/Domain} 127 | "f" {:kind :procedure 128 | :type {:decl-name "f" 129 | :args {:tuple-of @[{:thunk {:kind :sym :span [10 11] :text "X"}}]} 130 | :yields stdlib/Void}} 131 | "x" {:kind :bound 132 | :type {:thunk {:kind :sym :span [10 11] :text "X"}}} 133 | "x'" {:kind :bound 134 | :type {:thunk {:kind :sym :span [10 11] :text "X"}}} 135 | "y" {:kind :domain 136 | :type {:decl-name "y" 137 | :args {:tuple-of ()} 138 | :yields stdlib/Void}}} 139 | ` 140 | X. 141 | y. 142 | f x:X. 143 | --- 144 | y. 145 | `)) 146 | 147 | (deftest eval-fib 148 | (is-eval 149 | {"fib" {:kind :procedure 150 | :type {:decl-name "fib" 151 | :args {:tuple-of @[{:thunk {:kind :sym :span [8 11] :text "Nat"}}]} 152 | :yields {:thunk {:kind :sym :span [15 18] :text "Nat"}}}} 153 | "x" {:kind :bound 154 | :type {:thunk {:kind :sym :span [8 11] :text "Nat"}}}} 155 | 156 | (slurp "priv/fib.pant"))) 157 | 158 | (run-tests!) 159 | -------------------------------------------------------------------------------- /pantagruel/types/gcd.janet: -------------------------------------------------------------------------------- 1 | (import /pantagruel/types/errors) 2 | (import /pantagruel/stdlib :prefix "") 3 | 4 | (defn gcd-type 5 | ``` 6 | Type unification logic. 7 | 8 | For any two types, find the "greatest common denominator", that is, the 9 | narrowest type, if any, that is common to the hierarchy of both. 10 | 11 | This explicity excludes Any, which is present in the hierarchy of all types, 12 | unless one of the two types *is* itself Any. That is: Any is the greatest 13 | common denominator of itself and any other type, but it's not the greatest 14 | common denominator of two non-Any types. 15 | 16 | User-defined types always behave as though they are directly descended from 17 | Any. Built-in types have a more elaborate hierarchy, allowing for meaningful 18 | interactions between, for instance, different members of the numeric tower. 19 | 20 | Accepts the "original arguments" in the case that this is a recursive call. 21 | If we reach the bottom of our recursion and have to throw a type error, they 22 | will be the ones we throw with. 23 | ``` 24 | [left right error-code &keys {:original-left original-left 25 | :original-right original-right 26 | :extra extra}] 27 | (default original-left left) 28 | (default original-right right) 29 | (default extra {}) 30 | 31 | (defn recurse 32 | [t t2] 33 | ``` 34 | Recurse over two new arguments, preserving the initial arguments. 35 | ``` 36 | (gcd-type 37 | t t2 38 | :original-left original-left 39 | :original-right original-right 40 | :error error-code 41 | :extra extra)) 42 | 43 | (defn find-gcd- 44 | ``` 45 | Basic type unification. Recursively seek the "shallowest" type present in 46 | the hierarchies of both `t` and `t2`, where `n` is the depth of the search. 47 | ``` 48 | [t t2 n] 49 | (or (and (= t t2) [n t]) 50 | (let [t-proto (and (table? t2) 51 | (find-gcd- t (table/getproto t2) (inc n))) 52 | t2-proto (and (table? t) 53 | (find-gcd- (table/getproto t) t2 (inc n)))] 54 | (extreme (fn [x y] 55 | (cond 56 | (and x (not y)) true 57 | (and y (not x)) false 58 | (and x y) (<= (x 0) (y 0)))) 59 | [t-proto t2-proto])))) 60 | 61 | (defn find-gcd 62 | ``` 63 | Type unification logic wrapping `find-gcd-` with special handling of `Any`. 64 | ``` 65 | [t t2] 66 | (cond 67 | (= t Any) Any 68 | (= t2 Any) Any 69 | (if-let [[_n gcd] (find-gcd- t t2 0)] 70 | (if (and gcd (not= gcd Any)) 71 | gcd)))) 72 | 73 | (if-let [gcd (match [left right] 74 | # Handle any 1-tuples we've received, eg, from type summing. 75 | ([lt _] (tuple? lt) (one? (length lt))) 76 | (recurse (lt 0) right) 77 | 78 | ([_ rt] (tuple? rt) (one? (length rt))) 79 | (recurse left (rt 0)) 80 | 81 | [{:kind :sum 82 | :inner ts} 83 | {:kind :sum 84 | :inner ts2}] 85 | (let [gcds @{}] 86 | (each t ts 87 | (each t2 ts2 88 | (try 89 | (let [success-type (recurse t t2)] 90 | (put gcds success-type true)) 91 | ([err] :ok)))) 92 | (when (not (empty? gcds)) 93 | {:kind :sum 94 | :inner (keys gcds)})) 95 | 96 | [{:kind :sum :inner ts} t2] 97 | (do 98 | (var gcd nil) 99 | (each t ts 100 | (try 101 | (let [success-type (recurse t t2)] 102 | (set gcd success-type) 103 | (break)) 104 | ([err] :ok))) 105 | gcd) 106 | 107 | [t {:kind :sum :inner t2s}] 108 | (do 109 | (var gcd nil) 110 | (each t2 t2s 111 | (try 112 | (let [success-type (recurse t t2)] 113 | (set gcd success-type) 114 | (break)) 115 | ([err] :ok))) 116 | gcd) 117 | 118 | [{:list-of t} {:set-of t2}] 119 | {:set-of (recurse t t2)} 120 | 121 | [{:set-of t} {:list-of t2}] 122 | {:set-of (recurse t t2)} 123 | 124 | [{:list-of t} {:list-of t2}] 125 | {:list-of (recurse t t2)} 126 | 127 | [{:set-of t} {:set-of t2}] 128 | {:set-of (recurse t t2)} 129 | 130 | [{:tuple-of ts} {:tuple-of ts2}] 131 | (when (= (length ts) (length ts2)) 132 | {:tuple-of (map recurse ts ts2)}) 133 | 134 | [{:args args-t :yields yields-t} {:args args-t2 :yields yields-t2}] 135 | (let [args-gcd (recurse args-t args-t2) 136 | yield-gcd (recurse yields-t yields-t2)] 137 | {:args args-gcd :yields yield-gcd}) 138 | 139 | # When unifying two literal values, compare them directly; 140 | # don't try to find a GCD. 141 | [{:literal lit-left} {:literal lit-right}] 142 | (cond 143 | (= lit-left lit-right) 144 | left 145 | 146 | nil) 147 | 148 | [t t2] 149 | (find-gcd t t2))] 150 | gcd 151 | (errors/throw error-code {:left original-left 152 | :right original-right 153 | :extra extra}))) 154 | -------------------------------------------------------------------------------- /test/lexer_test.janet: -------------------------------------------------------------------------------- 1 | (use testament) 2 | 3 | (import /pantagruel/lexer) 4 | 5 | (defn- is-lex 6 | [src tokens] 7 | (is (== tokens 8 | (map |{:kind ($ :kind) :text ($ :text)} (lexer/lex src))) 9 | (string/format "Lex failure on\n\n%s" src tokens))) 10 | 11 | (deftest basic-declaration 12 | (is-lex 13 | "f." 14 | [{:kind :sym :text "f"} {:kind :. :text "."}])) 15 | 16 | (deftest declaration-yields 17 | (is-lex 18 | "f => g." 19 | [{:kind :sym :text "f"} {:kind :yields :text "=>"} {:kind :sym :text "g"} {:kind :. :text "."}])) 20 | 21 | (deftest declaration-binding-yields 22 | (is-lex 23 | "f x:X => g." 24 | [{:kind :sym :text "f"} 25 | {:kind :sym :text "x"} 26 | {:kind :: :text ":"} 27 | {:kind :sym :text "X"} 28 | {:kind :yields :text "=>"} {:kind :sym :text "g"} {:kind :. :text "."}])) 29 | 30 | (deftest declaration-bindings-yields 31 | (is-lex 32 | "f x:X, y:Y => g." 33 | [{:kind :sym :text "f"} 34 | {:kind :sym :text "x"} 35 | {:kind :: :text ":"} 36 | {:kind :sym :text "X"} 37 | {:kind :comma :text ","} 38 | {:kind :sym :text "y"} 39 | {:kind :: :text ":"} 40 | {:kind :sym :text "Y"} 41 | {:kind :yields :text "=>"} {:kind :sym :text "g"} {:kind :. :text "."}])) 42 | 43 | (deftest basic-head 44 | (is-lex 45 | ` 46 | f. 47 | --- 48 | ` 49 | [{:kind :sym :text "f"} {:kind :. :text "."} {:kind :line :text "---"}])) 50 | 51 | (deftest basic-chapter 52 | (is-lex 53 | ` 54 | f. 55 | --- 56 | g. 57 | ` 58 | [{:kind :sym :text "f"} {:kind :. :text "."} 59 | {:kind :line :text "---"} 60 | {:kind :sym :text "g"} {:kind :. :text "."}])) 61 | 62 | (deftest multiple-chapters 63 | (is-lex 64 | ` 65 | f. 66 | --- 67 | g. 68 | 69 | where 70 | 71 | h. 72 | ` 73 | [{:kind :sym :text "f"} {:kind :. :text "."} 74 | {:kind :line :text "---"} 75 | {:kind :sym :text "g"} {:kind :. :text "."} 76 | {:kind :where :text "where"} 77 | {:kind :sym :text "h"} {:kind :. :text "."}])) 78 | 79 | (deftest quantifier 80 | (is-lex "some (a,b):A => a + b" 81 | [{:kind :some :text "some"} 82 | {:kind :lparen :text "("} 83 | {:kind :sym :text "a"} {:kind :comma :text ","} 84 | {:kind :sym :text "b"} 85 | {:kind :rparen :text ")"} 86 | {:kind :: :text ":"} 87 | {:kind :sym :text "A"} 88 | {:kind :yields :text "=>"} 89 | {:kind :sym :text "a"} {:kind :+ :text "+"} {:kind :sym :text "b"}])) 90 | 91 | (deftest mapping-form 92 | (is-lex 93 | ` 94 | fib x = case x ... 95 | a => b, 96 | y => z. 97 | ` 98 | [{:kind :sym :text "fib"} {:kind :sym :text "x"} {:kind := :text "="} 99 | {:kind :case :text "case"} {:kind :sym :text "x"} {:kind :... :text "..."} 100 | {:kind :sym :text "a"} {:kind :yields :text "=>"} 101 | {:kind :sym :text "b"} {:kind :comma :text ","} 102 | {:kind :sym :text "y"} {:kind :yields :text "=>"} 103 | {:kind :sym :text "z"} {:kind :. :text "."}])) 104 | 105 | (deftest fibonacci 106 | (is-lex 107 | ` 108 | fib x : Nat => Nat. 109 | --- 110 | fib x = case ... 111 | x > 2 => fib (x - 1) + fib (x - 2), 112 | x = 1 => 1, 113 | x = 2 => 1. 114 | ` 115 | [{:kind :sym :text "fib"} 116 | {:kind :sym :text "x"} {:kind :: :text ":"} {:kind :sym :text "Nat"} 117 | {:kind :yields :text "=>"} 118 | {:kind :sym :text "Nat"} {:kind :. :text "."} 119 | {:kind :line :text "---"} 120 | {:kind :sym :text "fib"} {:kind :sym :text "x"} {:kind := :text "="} 121 | {:kind :case :text "case"} {:kind :... :text "..."} 122 | {:kind :sym :text "x"} {:kind :boolean-operator :text ">"} 123 | {:kind :num :text 2} {:kind :yields :text "=>"} 124 | {:kind :sym :text "fib"} 125 | {:kind :lparen :text "("} 126 | {:kind :sym :text "x"} {:kind :arithmetic-operator2 :text "-"} {:kind :num :text 1} 127 | {:kind :rparen :text ")"} 128 | {:kind :+ :text "+"} 129 | {:kind :sym :text "fib"} {:kind :lparen :text "("} 130 | {:kind :sym :text "x"} {:kind :arithmetic-operator2 :text "-"} {:kind :num :text 2} 131 | {:kind :rparen :text ")"} {:kind :comma :text ","} 132 | {:kind :sym :text "x"} {:kind := :text "="} {:kind :num :text 1} 133 | {:kind :yields :text "=>"} {:kind :num :text 1} {:kind :comma :text ","} 134 | {:kind :sym :text "x"} {:kind := :text "="} {:kind :num :text 2} 135 | {:kind :yields :text "=>"} {:kind :num :text 1} {:kind :. :text "."}])) 136 | 137 | (deftest comment-test 138 | (is-lex 139 | ` 140 | f. 141 | // single-line comment 142 | g. 143 | ` 144 | [{:kind :sym :text "f"} {:kind :. :text "."} 145 | {:kind :sym :text "g"} {:kind :. :text "."}]) 146 | 147 | (is-lex 148 | ` 149 | f. // partial comment 150 | g. 151 | ` 152 | [{:kind :sym :text "f"} {:kind :. :text "."} 153 | {:kind :sym :text "g"} {:kind :. :text "."}])) 154 | 155 | (deftest symbols 156 | (is-lex "f" [{:kind :sym :text "f"}]) 157 | (is-lex "f2" [{:kind :sym :text "f2"}]) 158 | (is-lex "f'" [{:kind :sym :text "f'"}]) 159 | (is-lex "f_g" [{:kind :sym :text "f_g"}]) 160 | (is-lex "δ'" [{:kind :sym :text "δ'"}])) 161 | 162 | (deftest strings 163 | (is-lex `"foo" bar` [{:kind :string :text `"foo"`} 164 | {:kind :sym :text "bar"}])) 165 | 166 | (deftest floats 167 | (is-lex `1.5` [{:kind :num :text 1.5}])) 168 | 169 | (deftest qualification 170 | (is-lex "some x:Nat, x > 1 => x < 10" 171 | [{:kind :some :text "some"} 172 | {:kind :sym :text "x"} {:kind :: :text ":"} {:kind :sym :text "Nat"} 173 | {:kind :comma :text ","} 174 | {:kind :sym :text "x"} {:kind :boolean-operator :text ">"} {:kind :num :text 1} 175 | {:kind :yields :text "=>"} 176 | {:kind :sym :text "x"} {:kind :boolean-operator :text "<"} {:kind :num :text 10}])) 177 | 178 | (run-tests!) 179 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Pantagruel: A Most Learned Assistant for Rigorous Thinking 2 | 3 | Pantagruel is two things: 4 | 5 | - A *syntax* for writing documents in; 6 | - A *program* which can read documents written in the Pantagruel syntax and 7 | validate that they are correct. 8 | 9 | For a Pantagruel document to be *correct* means: 10 | 11 | - The document author has *introduced* their vocabulary in a structured way; 12 | - The document author has *used* their vocabulary according to how it was 13 | introduced. 14 | 15 | Ideally, the constraints of syntax and sense mean that common sources of 16 | ambiguity in natural human language will be harder to fall into. 17 | 18 | Pantagruel should be well-suited for describing sets of rules, behaviours, 19 | systems, or processes. This includes things like: 20 | 21 | - Card games; 22 | - Computer programs; 23 | - Poetic forms; 24 | - Dress codes; 25 | - etc. 26 | 27 | ## A sample document 28 | 29 | Here's a trivial but complete Pantagruel document, translated from an example 30 | from *The Way of Z*. It describes the rules for a simple computer program for 31 | managing the checking-out of documents by users. 32 | 33 | ```pantagruel 34 | // par. 1 35 | module CHECKOUT. 36 | 37 | // par. 2 38 | User. 39 | Document. 40 | owner d: Document => User. 41 | 42 | // par. 3 43 | // A specification for a small document management system. 44 | 45 | // par. 4 46 | check_out u:User, d:Document. 47 | --- 48 | 49 | // par. 5 50 | // A user may check out a document if they have permission to access it and 51 | // it's not currently checked out. 52 | 53 | // par. 6 54 | owner d = nobody and has_perm? u d -> owner d' = u. 55 | owner d != nobody or ~(has_perm? u d) -> owner d' = owner d. 56 | 57 | where 58 | 59 | // par. 7 60 | nobody => User. 61 | has_perm? u:User, d:Document => Bool. 62 | --- 63 | ``` 64 | 65 | This document consists of two *chapters*. Every Pantagruel chapter has a *head* 66 | and a *body*, separated by a horizontal line. 67 | 68 | In the first chapter head we introduce some vocabulary. Vocabulary is of two 69 | basic kinds: *domains*, which represents sets or types of things; and 70 | *procedures*, which represent behaviours with, or relationships between, things 71 | of a certain type. In the first chapter body we make some statements about that 72 | vocabulary: things that are always true about the concepts we're introducing. 73 | 74 | In the second section, introduced by the word 75 | `where`, we gloss any new vocabulary that was used in the first section. 76 | 77 | ¶1: (optional) Module declaration. 78 | 79 | ¶2: The introduction of our two domains, *User*s and *Document*s, and a 80 | procedure `owner` that specifies the ownership relation between the two. 81 | 82 | ¶3: A comment introducing the program. 83 | 84 | ¶4: The introduction of a procedure, *check-out*, which takes *u*, 85 | a *User*, and *d*, a *Document*. 86 | 87 | Between ¶4 and ¶5 there is a horizontal line; this separates the introduction 88 | of terms and the statement of propositions about those terms. 89 | 90 | ¶5: A comment describing our specification in natural language. 91 | 92 | ¶6: Two propositions describing the expected state after the 93 | *check-out* procedure. The first says that if the owner of *d* is 94 | *nobody* and *has-perm? u d* is true and *check-out u d* is evaluated, 95 | then the successor to *d* (that is, *d* at some next point in time) will 96 | have an owner of *u*. The second line says if either of the two first 97 | conditions is otherwise, the successor to *d* will have the same owner 98 | as *d* does. 99 | 100 | `where` acts as a section separator. 101 | 102 | ¶7: Provides a gloss for the two procedures referred to in the previous 103 | section, *nobody* and *has-perm?*. *nobody* is a procedure which yields a 104 | *User*, in this case understood to represent a document with no owner. 105 | *has-perm?* is a procedure which will return a Boolean value indicating whether 106 | a user has permission to check out a document or not; in this specification 107 | we've left it at that. In a different document or if we were also interested in 108 | the specifics of who can check out a document and when, we could continue the 109 | specification with statements about *has-perm?*. 110 | 111 | ## Installing Pantagruel 112 | 113 | ### From AUR 114 | 115 | On any system that uses the [AUR](https://aur.archlinux.org/) (Arch Linux, 116 | Manjaro, et al), Pantagruel can be installed using `pacman` or an equivalent: 117 | 118 | ``` 119 | ⊕ yay -S pantagruel 120 | ``` 121 | 122 | ### From source 123 | 124 | The Pantagruel checker is written in [Janet][]. To build from source, make sure 125 | that Janet and `jpm` are installed, and then run: 126 | 127 | ``` 128 | ⊕ jpm --local deps 129 | ... Dependencies are installed ... 130 | ⊕ jpm --local build 131 | ... The `pant` binary is compiled and put into `./build` 132 | ``` 133 | 134 | [Janet]: https://janet-lang.org/ 135 | 136 | You can then copy the resulting binary into your path. 137 | 138 | ## Using the Pantagruel document checker 139 | 140 | Run `pant` to evaluate a Pantagruel document. 141 | 142 | The above document is available at `priv/checkout.pant`. We can check the 143 | document like this: 144 | 145 | ``` 146 | ⊕ pant ./priv/checkout.pant 147 | ⊕ 148 | ``` 149 | 150 | The document checker runs on the document and, seeing no errors, exits with 151 | status code 0. 152 | 153 | ### Checking that terms have been introduced 154 | 155 | The first feature that `pant` exposes is the ability to check that all terms 156 | used in a document have been *bound*, *introduced*, or *glossed*, appropriately. 157 | 158 | This is a feature common to nearly every programming language; if a variable 159 | isn't bound, then referring to it should be an error that will crash the 160 | program. However, because Pantagruel documents aren't programs, the binding 161 | rules are slightly more lenient. 162 | 163 | Terms can be used in the body of a Pantagruel section without being properly 164 | introduced; however, they need to be "introduced" in the next section for the 165 | document to be correct. 166 | 167 | We can see an example of this in the `CHECKOUT` module. In 6, we refer to 168 | `nobody`, even though that word hasn't been defined yet. It's in the *next* 169 | section, in 7, that we actually gloss the term `nobody`. 170 | 171 | This allows us to write documents in an explanatory manner, progressively 172 | introducing and defining terms. Such a mode is not available in a completely 173 | axiomatic system, that requires us to build up our concepts from the most 174 | atomic elements. At the same time, the presence of some requirements around 175 | introducing and glossing terms ensures a greater degree of rigor than a 176 | completely unstructured document. 177 | 178 | The `pant` program will check that we have defined all our terms. To see this 179 | in action, we can remove 7 entirely and re-run the document checker: 180 | 181 | ``` 182 | ⊕ pant priv/checkout.pant 183 | checkout.pant:15: unglossed symbol error: has_perm? 184 | checkout.pant:16: unglossed symbol error: has_perm? 185 | checkout.pant:16: unglossed symbol error: nobody 186 | checkout.pant:15: unglossed symbol error: nobody 187 | ``` 188 | 189 | The document checker has identified the symbols that we failed to define in 190 | time and exits with a non-zero status code. 191 | 192 | ### Checking types 193 | 194 | The second sort of check performed by the document checker is *type checking*. 195 | 196 | Just as with binding checks, this is a feature present in many programming 197 | languages. Statically-typed languages can analyze their programs without 198 | running them and assert that they are *well-typed*: for instance, that a 199 | function is only ever called with arguments that match its declared argument 200 | types, or that operators are only ever called on operands with compatible types. 201 | 202 | While Pantagruel's type checking works similarly, it's important to remember 203 | that Pantagruel documents aren't programs, and the purpose of type-checking 204 | them is to encourage rigorous thinking-through---not to avoid illegal program 205 | states that might cause a crash. 206 | 207 | Thus, Pantagruel attempts to alert the user to any obvious violations of the 208 | stated domains of their functions and variables, while still allowing for a 209 | wide degree of expression. 210 | 211 | To see the type checker in action, we can make another change to the example 212 | document. Let's change the first expression in 6 to have a somewhat 213 | nonsensical expression in it, changing our first usage of `nobody` to the 214 | number `0`. 215 | 216 | ``` 217 | owner d = 0 and has_perm? u d -> owner d' = u. 218 | ``` 219 | 220 | Then run the document checker: 221 | 222 | ``` 223 | ⊕ pant priv/checkout.pant 224 | checkout.pant:15: type error. couldn't unify types for comparison: User and Nat0 225 | 226 | in expression: 227 | 228 | owner d = 0 and has_perm? u d -> owner d' = u 229 | ``` 230 | 231 | The document checker identifies a type error: the procedure `owner` is supposed 232 | to yield a result in the domain `User`; however, it encountered a value in the 233 | domain `Nat0` (the natural numbers, including 0) instead. 234 | 235 | Pantagruel's type system, while quite simple by programming language standards, 236 | has some details worth understanding; see the [language reference](./priv/reference.md) for the full 237 | details. 238 | -------------------------------------------------------------------------------- /pantagruel/parser.janet: -------------------------------------------------------------------------------- 1 | ## Parser generator grammar. 2 | 3 | (import yacc) 4 | 5 | (defn span 6 | [left right] 7 | (cond 8 | (nil? left) (right :span) 9 | (nil? right) (left :span) 10 | (nil? (left :span)) (right :span) 11 | (nil? (right :span)) (left :span) 12 | 13 | [((left :span) 0) ((right :span) 0)])) 14 | 15 | (defn wrap 16 | [container] 17 | (fn [left inner right] 18 | {:container container 19 | :inner inner 20 | :span (span left right)})) 21 | 22 | (defn new-seq 23 | [&opt expr] 24 | {:kind :seq 25 | :seq (if expr [expr] []) 26 | :span (if expr (expr :span) nil)}) 27 | 28 | (defn cons-seq 29 | [expr _ rest] 30 | {:kind :seq 31 | :seq [expr ;(rest :seq)] 32 | :span (span expr rest)}) 33 | 34 | (defn binary-operation 35 | [left op right] 36 | {:kind :binary-operation 37 | :left left 38 | :right right 39 | :operator (op :text) 40 | :span (span left right)}) 41 | 42 | (defn just [v] (fn [& rest] v)) 43 | 44 | (def grammar 45 | ~(yacc 46 | 47 | (%left :logical-operator) 48 | (%left :boolean-operator) 49 | (%left :=) 50 | (%left :+) 51 | (%left :arithmetic-operator2) 52 | (%left :arithmetic-operator1) 53 | (%left :funcapp) 54 | (%left :unary-operator) 55 | 56 | (program (directives chapters) ,|{:directives $0 57 | :chapters $1}) 58 | 59 | ## Directives 60 | # Module management statements for the checker. 61 | 62 | (directives 63 | () ,tuple 64 | (directive directives) ,|(tuple $0 ;$1)) 65 | 66 | (directive (:directive sym :.) ,|{:kind :directive 67 | :statement ($0 :text) 68 | :args $1 69 | :span (span $0 $2)}) 70 | 71 | ## Chapters 72 | # The main body of a document. 73 | 74 | (chapters 75 | () ,tuple 76 | (chapter) ,tuple 77 | (chapter :where chapters) ,|(tuple $0 ;$2)) 78 | 79 | (chapter (head body) ,|{:kind :chapter 80 | :head $0 81 | :body $1 82 | :span (span ($0 0) (last $1))}) 83 | 84 | ### Head 85 | # The text above the line in a chapter. 86 | 87 | (head 88 | (:line) ,(just []) 89 | (head-line :. head) ,|(tuple $0 ;$2)) 90 | 91 | (head-line 92 | (:val declaration) ,(fn [_ decl] (struct ;(kvs decl) :value true)) 93 | (sym-or-tuple-of-syms := domain) ,|{:kind :decl-alias 94 | :name $0 95 | :alias $2 96 | :span (span $0 $2)} 97 | (declaration) ,identity) 98 | 99 | (declaration 100 | (sym domain-bindings-exprs) ,|{:kind :declaration 101 | :name $0 102 | :bindings $1 103 | :span (span $0 $1)} 104 | (sym domain-bindings-exprs :yields domain) ,|{:kind :declaration 105 | :name $0 106 | :bindings $1 107 | :yields $3 108 | :span (span $0 $3)}) 109 | ### Body 110 | # The text below the line in a chapter. 111 | 112 | (body 113 | () ,tuple 114 | (body-line) ,tuple 115 | (body-line body) ,|(tuple $0 ;$1)) 116 | 117 | (body-line (expr :.) ,|(struct ;(kvs $0) :span (span $0 $1))) 118 | 119 | ### Domains 120 | 121 | (domain 122 | (:lparen domains :rparen) ,(wrap :parens) 123 | (:lsquare domain :rsquare) ,(wrap :list-of) 124 | (:lbrace domain :rbrace) ,(wrap :set-of) 125 | (:lbrace literals :rbrace) ,|{:kind :domain-set 126 | :span (span $0 $2) 127 | :inner $1} 128 | (domain :+ domain) ,|(let [inner (match $0 129 | ({:inner inner} (indexed? inner)) 130 | [;inner $2] 131 | 132 | ({:inner {:seq inner}} (indexed? inner)) 133 | [;inner $2] 134 | 135 | [$0 $2])] 136 | {:kind :domain-sum 137 | :span (span $0 $2) 138 | :inner inner}) 139 | (sym) ,identity) 140 | 141 | (domains 142 | () ,new-seq 143 | (domain) ,new-seq 144 | (domain :comma domains) ,cons-seq) 145 | 146 | ### Special forms 147 | 148 | #### Binding form: x:X 149 | 150 | ##### Binding forms that admit only domains. 151 | 152 | (domain-bindings-exprs 153 | () ,new-seq 154 | (domain-binding-expr) ,new-seq 155 | (domain-binding-expr :comma domain-bindings-exprs) ,cons-seq) 156 | 157 | (domain-binding-expr 158 | (domain-binding) ,identity 159 | (expr) ,identity) 160 | 161 | (domain-binding (sym-or-tuple-of-syms :: domain) ,|{:kind :binding 162 | :binding-type :: 163 | :name $0 164 | :expr $2}) 165 | 166 | (bindings-exprs 167 | () ,new-seq 168 | (binding-expr) ,new-seq 169 | (binding-expr :comma bindings-exprs) ,cons-seq) 170 | 171 | (binding-expr 172 | (domain-binding) ,identity 173 | (expr) ,identity) 174 | 175 | #### Mapping forms: case, update 176 | 177 | (mapping-word 178 | (:update) ,identity 179 | (:case) ,identity) 180 | 181 | (mapping-clauses 182 | (mapping-clause) ,new-seq 183 | (mapping-clause :comma mapping-clauses) ,cons-seq) 184 | 185 | (mapping-clause (expr :yields expr) ,|{:kind :map 186 | :left $0 187 | :right $2 188 | :span (span $0 $2)}) 189 | 190 | #### Extension forms 191 | 192 | (expr-clauses 193 | (expr) ,new-seq 194 | (expr :comma expr-clauses) ,cons-seq) 195 | 196 | (stmt-clauses 197 | (expr) ,new-seq 198 | (expr :semicolon stmt-clauses) ,cons-seq) 199 | 200 | #### Quantification: some, all, some1 201 | 202 | (quantification-word 203 | (:all) ,identity 204 | (:some) ,identity 205 | (:some1) ,identity) 206 | 207 | (quantification 208 | (quantification-word bindings-exprs :... expr) ,|{:kind :quantification 209 | :quantifier $0 210 | :bindings $1 211 | :expr $3 212 | # Quantification 213 | # can introduce 214 | # bindings into 215 | # temporary 216 | # body-level 217 | # scopes; generate 218 | # a slot to put the 219 | # scope into. 220 | :scope @[nil] 221 | :span (span $0 $3)}) 222 | ### Expressions 223 | 224 | (expr 225 | (mapping-word maybe-expr :... mapping-clauses) ,|{:kind ($0 :kind) 226 | :case $1 227 | :mapping $3 228 | :span (span $0 $3)} 229 | 230 | (:extend expr :... expr-clauses) ,|{:kind :extend 231 | :expr $1 232 | :exprs $3 233 | :span (span $0 $3)} 234 | 235 | (:do stmt-clauses) ,|{:kind :do 236 | :exprs $1 237 | :span (span $0 $1)} 238 | 239 | (expr :logical-operator expr) ,binary-operation 240 | (expr :boolean-operator expr) ,binary-operation 241 | # = and + are special cased because they are normal binary operators, 242 | # but also special syntax (= is used for domain aliasing, + is used for 243 | # sum typing). So here we detect them specifically and roll them into 244 | # the binary-operation node type. 245 | (expr := expr) ,binary-operation 246 | (expr :+ expr) ,binary-operation 247 | (expr :arithmetic-operator1 expr) ,binary-operation 248 | (expr :arithmetic-operator2 expr) ,binary-operation 249 | 250 | (:unary-operator expr) ,|{:kind :unary-operation 251 | :left $1 252 | :operator ($0 :text) 253 | :span (span $0 $1)} 254 | 255 | (quantification) ,identity 256 | 257 | (expr expr %prec :funcapp) ,|{:kind :application 258 | :f $0 259 | :x $1 260 | :span (span $0 $1)} 261 | 262 | # Parens as value: tuple of values. 263 | (:lparen exprs :rparen) ,(wrap :parens) 264 | # Square as value: comprehension. 265 | (:lsquare quantification :rsquare) ,(wrap :list-comprehension) 266 | (:lbrace quantification :rbrace) ,(wrap :set-comprehension) 267 | 268 | (string) ,identity 269 | (sym) ,identity 270 | (num) ,identity) 271 | 272 | (maybe-expr 273 | () ,nil 274 | (expr) ,identity) 275 | 276 | (exprs 277 | () ,tuple 278 | (expr) ,tuple 279 | (expr :comma exprs) ,|(tuple $0 ;$2)) 280 | 281 | (literals 282 | () ,new-seq 283 | (literal) ,new-seq 284 | (literal :comma literals) ,cons-seq) 285 | 286 | (literal 287 | (:num) ,identity 288 | (:string) ,identity) 289 | 290 | (binary-operator 291 | (:logical-operator) ,identity 292 | (:boolean-operator) ,identity 293 | (:=) ,identity 294 | (:+) ,identity 295 | (:arithmetic-operator1) ,identity 296 | (:arithmetic-operator2) ,identity) 297 | 298 | (sym-or-tuple-of-syms 299 | (:lparen syms :rparen) ,(wrap :parens) 300 | (sym) ,identity) 301 | 302 | (syms (sym) ,new-seq 303 | (sym :comma syms) ,cons-seq) 304 | 305 | (string (:string) ,identity) 306 | 307 | (sym (:sym) ,identity) 308 | 309 | (num (:num) ,identity))) 310 | 311 | (def parser-tables (yacc/compile grammar)) 312 | 313 | (defn parse-tokens 314 | ``` 315 | Generate an AST from a sequence of tokens. 316 | ``` 317 | [tokens] 318 | (if (os/getenv "PANT_DEBUG") (setdyn :yydebug @"")) 319 | 320 | (-> parser-tables 321 | (yacc/parse tokens) 322 | (match 323 | [:ok tree] tree 324 | [:syntax-error form] (error 325 | {:err :syntax 326 | :form form})))) 327 | -------------------------------------------------------------------------------- /pantagruel.janet: -------------------------------------------------------------------------------- 1 | (use spork/argparse) 2 | 3 | (import spork/path) 4 | 5 | (import /pantagruel/lexer) 6 | (import /pantagruel/parser) 7 | (import /pantagruel/eval/engine) 8 | (import /pantagruel/types/type-checking) 9 | (import /pantagruel/print-src) 10 | 11 | (def version "0.9.1") 12 | (def default-path "pantagruel") 13 | 14 | (def params 15 | [``` 16 | A program specification notation. 17 | 18 | Usage: 19 | pant | evaluate Pantagruel document files 20 | pant | read Pantagruel from stdin 21 | ``` 22 | "version" {:kind :flag 23 | :short "v" 24 | :help "Show version and exit"} 25 | "path" {:kind :option 26 | :short "p" 27 | :help "The module path"} 28 | "config" {:kind :option 29 | :short "c" 30 | :help "The config file to consult, in JDN format" 31 | :default ".pantagruel.jdn"} 32 | :default {:kind :accumulate}]) 33 | 34 | (defn handle-syntax-error 35 | [err file src] 36 | 37 | (def start-line (print-src/line-starter file src)) 38 | 39 | (defn- in-bounds 40 | [n mx] 41 | (if (< n 0) 42 | (max n (- mx)) 43 | (min n mx))) 44 | 45 | (let [form (or (err :form) 46 | {:span [(dec (length src)) (length src)] 47 | :text ""}) 48 | from (if-let [from (get-in form [:span 0])] 49 | (- from 10) 50 | -20) 51 | to (if-let [to (get-in form [:span 1])] 52 | (+ to 10) 53 | -1) 54 | prefix (if (or (= from (- (length src))) 55 | (= from 0)) 56 | "" 57 | "…") 58 | suffix (if (or (= to (length src)) 59 | (= to -1)) 60 | "" 61 | "…")] 62 | 63 | (if (os/getenv "PANT_DEBUG") (print (dyn :yydebug))) 64 | 65 | (start-line form) 66 | (eprintf 67 | ``` 68 | syntax error: `%s` (%q) 69 | 70 | in 71 | 72 | %s%s%s 73 | ``` 74 | (string (form :text)) 75 | (form :kind) 76 | prefix 77 | (string/slice src (in-bounds from (length src)) (in-bounds to (length src))) 78 | suffix)) 79 | 80 | (when (dyn :exit-on-error) 81 | (os/exit 1))) 82 | 83 | (defn- print-types 84 | [str & args] 85 | 86 | (defn- render-type 87 | [t] 88 | 89 | (defn- join 90 | [ts] 91 | (string/format "(%s)" (-> (map render-type ts) (string/join ", ")))) 92 | 93 | (defn- render-procedure 94 | [args yields] 95 | (string/format "%s => %s" (render-type args) (render-type yields))) 96 | 97 | (match t 98 | (ts (indexed? ts)) (join ts) 99 | {:literal literal} (string literal) 100 | {:name t-name} t-name 101 | # Special case the empty set. 102 | {:set-of ()} "{}" 103 | {:set-of t} (string/format "{%s}" (render-type t)) 104 | {:list-of t} (string/format "[%s]" (render-type t)) 105 | {:tuple-of ts} (join ts) 106 | {:kind :sum :inner ts} (-> (map render-type ts) (string/join " + ")) 107 | {:decl-name name :args args :yields yields} (string/format 108 | "%s %s" 109 | name 110 | (render-procedure args yields)) 111 | {:args args :yields yields} (render-procedure args yields) 112 | {:thunk thunk} (render-type thunk) 113 | {:kind :sym :text text} text 114 | t (string/format "%q" t))) 115 | 116 | (eprintf (string "type error. " str) ;(map render-type args))) 117 | 118 | (defn handle-evaluation-error 119 | [err] 120 | (let [{:evaluator {:src src :file file}} err] 121 | 122 | (def start-line (print-src/line-starter file src)) 123 | 124 | (case (err :err) 125 | :evaluation 126 | (each sym (keys (err :symbols)) 127 | (start-line sym) 128 | (eprintf "unglossed symbol error: %s" 129 | (sym :text))) 130 | 131 | :single-binding 132 | (do 133 | (start-line (err :sym)) 134 | (print-types 135 | "can't bind %s to `%s`, already bound to `%s`" 136 | (get-in err [:sym :text]) 137 | (get-in err [:t :type]) 138 | (get-in err [:already :type]))) 139 | 140 | :import 141 | (do 142 | (start-line (err :to-import)) 143 | (eprintf "import error: module `%s` not found. Available modules: %s" 144 | (get-in err [:to-import :text]) 145 | (-> (err :available-modules) (keys) (string/join ", ")))) 146 | 147 | :import-cycle 148 | (do 149 | (start-line (err :to-import)) 150 | (eprintf "import cycle error: encountered cycle: %s" 151 | (string/join (err :currently-importing-modules) " -> "))) 152 | 153 | (errorf "Got unknown evaluation error: %q" err))) 154 | 155 | (when (dyn :exit-on-error) (os/exit 1))) 156 | 157 | (defn handle-version 158 | [] 159 | (print (string "Pantagruel " version))) 160 | 161 | (defn lex-and-parse 162 | [file src] 163 | 164 | (let [lexed (lexer/lex src) 165 | tree (try 166 | (parser/parse-tokens lexed) 167 | ([err fib] 168 | (when (struct? err) (handle-syntax-error err file src)) 169 | (propagate err fib)))] 170 | tree)) 171 | 172 | (defn- handle-resolution-error 173 | [err] 174 | (case (err :type) 175 | :list-application-multiple-args 176 | (print-types "attempted to apply to multiple arguments: `%s`" 177 | (err :xs)) 178 | 179 | :list-application-bad-arg 180 | (print-types "attempted to apply type: %s to an argument of type: %s" 181 | (err :f) 182 | (err :x)) 183 | 184 | :application 185 | (print-types "attempted to apply type: %s to type: %s" 186 | (err :f) 187 | (err :x)) 188 | 189 | :container 190 | (print-types "attempted to check for membership or cardinality in non-container type: %s" 191 | (err :t)) 192 | 193 | :arg-length 194 | (print-types "received invalid arguments: %s to procedure %s" 195 | (err :args) 196 | (err :f)) 197 | 198 | :gcd-app 199 | (print-types "couldn't bind value of type %s to argument of type %s in procedure: %s" (err :right) (err :left) (get-in err [:extra :f])) 200 | 201 | :gcd-comp 202 | (print-types "couldn't unify types for comparison: %s and %s" (err :left) (err :right)) 203 | 204 | :gcd-arith 205 | (print-types "couldn't unify types for arithmetic: %s and %s" (err :left) (err :right)) 206 | 207 | :gcd-in 208 | (print-types "couldn't unify set element type %s when checking membership of %s" (err :left) (err :right)) 209 | 210 | :gcd-case-test 211 | (print-types "couldn't unify test expression of `case` %s with branch %s" (err :left) (err :right)) 212 | 213 | :gcd-case-branches 214 | (print-types "couldn't unify branch expressions of `case` %s and %s" (err :left) (err :right)) 215 | 216 | :gcd-update-procedure-args 217 | (print-types "couldn't unify procedure argument type of `update` %s with left side of mapping %s" (err :left) (err :right)) 218 | 219 | :gcd-update-procedure-yields 220 | (print-types "couldn't unify procedure yields type of `update` %s with right side of mapping %s" (err :left) (err :right)) 221 | 222 | :gcd-set-update 223 | (print-types "couldn't unify set of %s when updating with element type %s" (err :left) (err :right)) 224 | 225 | :gcd-list-update 226 | (print-types "couldn't unify list of %s when updating with element type %s" (err :left) (err :right)) 227 | 228 | :gcd-set-extension 229 | (print-types "couldn't unify set of %s when extending with element type %s" (err :left) (err :right)) 230 | 231 | :gcd-list-extension 232 | (print-types "couldn't unify list of %s when extending with element type %s" (err :left) (err :right)) 233 | 234 | :gcd 235 | (print-types "couldn't unify types: %s and %s" (err :left) (err :right)) 236 | 237 | (print-types "unknown type resolution error: %s" err))) 238 | 239 | (defn handle-src 240 | ``` 241 | Given some input file, fully evaluate it as a Pantagruel document. 242 | ``` 243 | [file src available-modules] 244 | 245 | (defn evaluator-callback 246 | ``` 247 | The logic to slurp and parse a file, encapsulated and passed into the :eval 248 | method. This way, the evaluator logic knows how to call this callback but 249 | it doesn't know how to lex and parse by itself. 250 | ``` 251 | [file] 252 | (let [src (slurp file) 253 | tree (lex-and-parse file src)] 254 | [tree (engine/Evaluator file src)])) 255 | 256 | (array/clear engine/currently-importing-modules) 257 | 258 | (let [start-line (print-src/line-starter file src) 259 | tree (lex-and-parse file src) 260 | evaluator (engine/Evaluator file src) 261 | env (try (:eval evaluator tree available-modules evaluator-callback) 262 | ([err fib] (when (table? err) (handle-evaluation-error err)) 263 | (propagate err fib))) 264 | type-errors (type-checking/get-type-errors tree env file src)] 265 | 266 | (each [body-expr type-error] type-errors 267 | (start-line body-expr) 268 | (handle-resolution-error type-error) 269 | (eprintf "\nin expression:\n\n%s\n" (print-src/print-src body-expr src))) 270 | 271 | (when (and (not (empty? type-errors)) 272 | (dyn :exit-on-error)) 273 | (os/exit 1)) 274 | 275 | type-errors)) 276 | 277 | (defn- maybe-read 278 | [filename] 279 | (when (os/stat filename) (slurp filename))) 280 | 281 | (defn populate-available-modules 282 | ``` 283 | Read the module path and parse all the Pantagruel files that are there. Build 284 | a map of module names (for any file that declares one) to file paths. 285 | ``` 286 | [args] 287 | 288 | (defn pantagruel-files 289 | [path] 290 | (if (os/stat path) 291 | (->> (os/dir path) 292 | (filter |(= (path/ext $) ".pant")) 293 | (map |(path/join path $))) 294 | @[])) 295 | 296 | (def available-modules @{}) 297 | 298 | (let [config (or (-?> (args "config") (maybe-read) (parse)) {}) 299 | path (-> (or (args "path") (config "path") default-path)) 300 | cur-path (pantagruel-files ".") 301 | module-path (pantagruel-files path)] 302 | (each file (array ;module-path ;cur-path) 303 | (let [src (slurp file) 304 | start-line (print-src/line-starter file src) 305 | {:directives directives} (lex-and-parse file src)] 306 | 307 | (var module-name nil) 308 | (each directive directives 309 | (match directive 310 | {:statement "module" :args {:text directive-name}} 311 | (do 312 | (when module-name 313 | (start-line directive) 314 | (eprintf "module name `%s` already declared; found module declaration `%s`" 315 | module-name 316 | directive-name) 317 | (when (dyn :exit-on-error) (os/exit 1)) 318 | (error :available-modules-error)) 319 | 320 | (set module-name directive-name)))) 321 | 322 | (when module-name 323 | (put available-modules module-name file))))) 324 | 325 | available-modules) 326 | 327 | (defn main 328 | ``` 329 | Main application logic. 330 | 331 | Load file(s) or read a document from stdin. 332 | 333 | Evaluate it and check; if all checks pass, return 0. 334 | ``` 335 | [& _args] 336 | 337 | (def args (argparse ;params)) 338 | (unless args (os/exit 1)) 339 | (setdyn :exit-on-error true) 340 | 341 | (cond 342 | (args "version") (handle-version) 343 | (let [available-modules (populate-available-modules args)] 344 | 345 | (if-let [filenames (args :default)] 346 | (each file filenames 347 | (let [src (slurp file)] 348 | (handle-src file src available-modules))) 349 | 350 | (let [src (file/read stdin :all)] 351 | 352 | (handle-src "" src available-modules)))))) 353 | -------------------------------------------------------------------------------- /pantagruel/eval/engine.janet: -------------------------------------------------------------------------------- 1 | ## Evaluation of a Pantagruel document. 2 | ## 3 | ## Recursively evaluate the AST of an entire document, resulting in a binding 4 | ## context mapping all symbols in the documents to the available type 5 | ## information. 6 | ## 7 | ## If any symbol has been introduced but not successfully bound into the 8 | ## environment according to the binding rules of the language, will throw an 9 | ## Evaluation Error. 10 | 11 | (import /pantagruel/stdlib) 12 | (import /pantagruel/types/syntactic-types) 13 | 14 | (def currently-importing-modules @[]) 15 | 16 | (defn currently-importing? 17 | [module] 18 | (index-of module currently-importing-modules)) 19 | 20 | (defn currently-importing 21 | [module] 22 | (array/push currently-importing-modules module)) 23 | 24 | (defn- normalize-thunk 25 | [obj] 26 | (match obj 27 | @[:span _] [] 28 | 29 | {:kind :bound :type thunk} 30 | (normalize-thunk thunk) 31 | 32 | {:kind :procedure :type {:args {:tuple-of @[]} :yields yields}} 33 | (normalize-thunk yields) 34 | 35 | (o (dictionary? o)) 36 | (struct ;(mapcat normalize-thunk (pairs o))) 37 | 38 | (i (indexed? i)) 39 | (map normalize-thunk i) 40 | 41 | obj)) 42 | 43 | (defn- resolve-references 44 | ``` 45 | Given an environment and a set of symbol references, eliminate all references 46 | that are bound with respect to that environment. 47 | ``` 48 | [env references] 49 | 50 | (each reference (keys references) 51 | (when (env (reference :text)) 52 | (put references reference nil)))) 53 | 54 | (def Evaluator- 55 | @{:throw 56 | (fn throw 57 | [self type args] 58 | (error (merge {:err type :evaluator self} args))) 59 | 60 | :check-references 61 | (fn check-references 62 | # Throw if any references haven't been resolved. 63 | [self env references locale] 64 | (if (not (empty? references)) 65 | (:throw self :evaluation {:symbols references :locale locale}))) 66 | 67 | :introduce-bindings-and-references 68 | (fn introduce-bindings-and-references 69 | # Handle any given AST form for environment bindings. 70 | 71 | # If it's a binding form, introduce it into the execution environment, 72 | # associated with the syntactically derived type information (or a thunk, if 73 | # type information is not available syntactically and needs resolution after 74 | # the environment has been fully populated). 75 | [self form env symbol-references include-prime] 76 | 77 | (defn recurse 78 | [form &opt include-prime] 79 | (default include-prime false) 80 | (:introduce-bindings-and-references self form env symbol-references include-prime)) 81 | 82 | (defn introduce 83 | [sym t &opt force-prime] 84 | (default force-prime false) 85 | 86 | (match sym 87 | {:kind :sym 88 | :text text 89 | :span span} 90 | (do 91 | (when-let [already (env text)] 92 | (if (not= (normalize-thunk already) 93 | (normalize-thunk t)) 94 | (:throw self :single-binding {:sym sym :already already :t t}))) 95 | (put env text t) 96 | # Optionally introduce a "successor" symbol, with a `'` appended, 97 | # and the same type. 98 | (if (or include-prime force-prime) (put env (string text "'") t))) 99 | 100 | (errorf "Don't know how to introduce symbol: %q" sym))) 101 | 102 | (match form 103 | {:kind :decl-alias 104 | :name name 105 | :alias t} 106 | (let [f |(introduce $ {:kind :domain 107 | :type (syntactic-types/type-of-form t)})] 108 | (match name 109 | # Alias each symbol in a sequence of symbols to the type form `t`. 110 | {:container _ :inner {:seq names}} 111 | (each name names (f name)) 112 | 113 | # Alias a single symbol to the type form `t`. 114 | (f name)) 115 | 116 | (recurse t)) 117 | 118 | {:kind :declaration 119 | :name name 120 | :bindings {:seq bindings}} 121 | (let [yields (form :yields) 122 | value? (form :value) 123 | kind (if (and (nil? yields) (empty? bindings)) 124 | :domain 125 | :procedure) 126 | t (syntactic-types/type-of-form form)] 127 | (introduce name {:kind kind :type t}) 128 | # If `name` was declared with the `val` keyword, introduce a 129 | # successor symbol. 130 | (when value? (introduce name {:kind kind :type t} true)) 131 | 132 | (recurse yields) 133 | 134 | (each binding bindings 135 | # If this procedure declaration doesn't yield any value, treat it 136 | # as effectful and introduce a successor symbol for each argument 137 | # binding. 138 | (recurse binding (nil? yields)))) 139 | 140 | {:kind :binding 141 | :binding-type binding-type 142 | :name name 143 | :expr expr} 144 | (let [f |(introduce $ {:kind :bound 145 | :type (syntactic-types/type-of-form expr)})] 146 | (match name 147 | # Assign the type of `expr` to each symbol in a sequence of symbols. 148 | {:container _ :inner {:seq names}} 149 | (each name names (f name)) 150 | 151 | # Assign the type of `expr` to a single symbol. 152 | (f name)) 153 | 154 | (recurse expr)) 155 | 156 | {:kind :case 157 | :mapping {:seq mapping-form}} 158 | (do 159 | (recurse (form :case)) 160 | (each {:left left :right right} mapping-form 161 | # Special-case: treat the symbol '_' as a match-any. 162 | (unless (= (left :text) "_") 163 | (recurse left)) 164 | (recurse right))) 165 | 166 | {:kind :update 167 | :mapping {:seq mapping-form}} 168 | (do 169 | (recurse (form :case)) 170 | (each {:left left :right right} mapping-form 171 | (recurse left) 172 | (recurse right))) 173 | 174 | {:kind :extend 175 | :expr expr 176 | :exprs {:seq exprs}} 177 | (do 178 | (recurse expr) 179 | (each expr exprs 180 | (recurse expr))) 181 | 182 | {:kind :do 183 | :exprs {:seq exprs}} 184 | (do 185 | (each expr exprs 186 | (recurse expr))) 187 | 188 | {:kind :quantification 189 | :bindings {:seq bindings} 190 | :expr expr} 191 | (do 192 | # Close around the current, extended environment, linking it back to the 193 | # AST form that it's associated with. 194 | (put-in form [:scope 0] env) 195 | (each binding bindings 196 | (recurse binding)) 197 | (recurse expr)) 198 | 199 | {:kind :binary-operation 200 | :left left 201 | :right right} 202 | (do 203 | (recurse left) 204 | (recurse right)) 205 | 206 | {:kind :unary-operation 207 | :left left} 208 | (recurse left) 209 | 210 | {:kind :application 211 | :f f 212 | :x x} 213 | (do 214 | (recurse f) 215 | (recurse x)) 216 | 217 | {:container _ :inner {:seq exprs}} 218 | (each expr exprs 219 | (recurse expr)) 220 | 221 | ({:container _ :inner exprs} (tuple? exprs)) 222 | (each expr exprs 223 | (recurse expr)) 224 | 225 | {:container _ :inner expr} 226 | (recurse expr) 227 | 228 | {:kind :domain-sum 229 | :inner inner} 230 | (each domain inner 231 | (recurse domain)) 232 | 233 | {:kind :sym 234 | :text sym} 235 | (put symbol-references form true) 236 | 237 | # Domains built out of sets of literal values, hence, guaranteed not to 238 | # contain symbol references or bindings 239 | {:kind :domain-set} 240 | :ok 241 | 242 | {:kind :num} :ok 243 | 244 | {:kind :string} :ok 245 | 246 | (@ 'nil) :ok 247 | 248 | (printf "Unknown form in engine: %q" form))) 249 | 250 | :eval-subsection 251 | (fn eval-subsection 252 | # Evaluate a subsection for any environment bindings. 253 | [self subsection env symbol-references] 254 | (each statement subsection 255 | (:introduce-bindings-and-references self statement env symbol-references false))) 256 | 257 | :eval 258 | (fn eval 259 | # Main evaluation logic. Optionally, accepts a map of modules to import 260 | # and a callback to call in order to import them. If not passed in, 261 | # the import pass is skipped. 262 | [self {:directives directives :chapters chapters} 263 | &opt 264 | available-modules evaluator-callback] 265 | 266 | # Environment setup. Create a root environment and then merge in any 267 | # imported modules. 268 | 269 | (def env (table/setproto @{} stdlib/base-env)) 270 | 271 | (when (and available-modules evaluator-callback) 272 | (each directive directives 273 | (match directive 274 | {:statement "module" :args sym} 275 | (let [current-module (sym :text)] 276 | (unless (currently-importing? current-module) 277 | (currently-importing current-module))) 278 | 279 | {:statement "import" :args sym} 280 | (if-let [to-import (sym :text) 281 | path (available-modules to-import)] 282 | (let [err? (currently-importing? to-import) 283 | [tree evaluator] (evaluator-callback path)] 284 | (currently-importing to-import) 285 | (if err? 286 | (:throw self :import-cycle {:currently-importing-modules currently-importing-modules 287 | :to-import sym})) 288 | (merge-into env (-> 289 | evaluator 290 | (:eval tree available-modules evaluator-callback) 291 | # Convert the imported environment into a struct in order to 292 | # drop the prototype. 293 | (table/to-struct)))) 294 | (:throw self :import {:available-modules available-modules 295 | :to-import sym}))))) 296 | 297 | # Evaluation pass on this document. 298 | 299 | (defn eval-chapter 300 | # Handle a single chapter, binding any introduced symbols into the 301 | # environment and resolving any references that are due. 302 | [prev-references {:head head :body body}] 303 | (let [head-references @{}] 304 | # Populate environment and references with bindings and references from 305 | # chapter head. 306 | (:eval-subsection self head env head-references) 307 | 308 | # Clear outstanding references in previous chapter that were bound in head. 309 | (resolve-references env prev-references) 310 | # Check that references in previous chapter have all been cleared. 311 | (:check-references self env prev-references :body) 312 | 313 | # Clear outstanding references in head that were bound in head. 314 | (resolve-references env head-references) 315 | # Check that references in head have all been cleared. 316 | (:check-references self env head-references :chapter) 317 | 318 | # We've validated all references up until this point; begin capturing 319 | # references for validation in the *next* chapter. 320 | (let [body-references @{} 321 | # Push a new scope on the stack for body-declared bindings. 322 | body-env (table/setproto @{} env)] 323 | # Populate body references, and new scope with body bindings. 324 | (:eval-subsection self body body-env body-references) 325 | # Clear outstanding references in this body using the bindings in the 326 | # body (as well as existing env). 327 | (resolve-references body-env body-references) 328 | # Pass on any outstanding references; they will have to be resolved 329 | # using document-level bindings. 330 | body-references))) 331 | 332 | (let [remaining-references (reduce eval-chapter @{} chapters)] 333 | # Check for any body references that were made in the last chapter but 334 | # never bound. 335 | (:check-references self env remaining-references :body) 336 | env))}) 337 | 338 | (defn Evaluator 339 | ``` 340 | Document evaluation object. Tracks the file being evaluated, in order to be 341 | able to bubble up evaluation errors from imported documents correctly. 342 | ``` 343 | [file src] 344 | (table/setproto 345 | @{:file file 346 | :src src} 347 | Evaluator-)) 348 | -------------------------------------------------------------------------------- /pantagruel/types/types.janet: -------------------------------------------------------------------------------- 1 | ## All logic concerned with type algebra and resolution: determining the type 2 | ## of all valid typed expressions, and the entire algebra available for 3 | ## manipulating types. 4 | ## 5 | ## The main entry point is `resolve-type`, which will take an AST element and 6 | ## return its type in the context of a fully-populated environment. However, 7 | ## the evaluation engine, responsible for the population of that environment, 8 | ## also calls into this logic for types that are fully resolvable without an 9 | ## environment. 10 | 11 | (import /pantagruel/types/gcd) 12 | (import /pantagruel/types/utils) 13 | (import /pantagruel/types/literals) 14 | (import /pantagruel/types/errors) 15 | (import /pantagruel/stdlib :prefix "") 16 | 17 | (defn- is-in-hierarchy? 18 | ``` 19 | Determine if type `haystack` is a descendent of type `needle`. 20 | ``` 21 | [needle haystack] 22 | (cond 23 | (not (table? haystack)) false 24 | (= needle haystack) true 25 | 26 | (match (table/getproto haystack) 27 | 'nil false 28 | 'needle true 29 | proto (is-in-hierarchy? needle proto)))) 30 | 31 | (defn- member-type 32 | ``` 33 | Resolve the type of a membership operation, ie, get the type of a container's 34 | elements. 35 | ``` 36 | [t] 37 | (match t 38 | {:set-of inner-t} 39 | inner-t 40 | 41 | {:list-of inner-t} 42 | inner-t 43 | 44 | {:tuple-of inner-ts} 45 | (reduce2 utils/sum-type inner-ts) 46 | 47 | (@ String) 48 | Char 49 | 50 | (errors/throw :container {:t t}))) 51 | 52 | (defn- collapse-application-args 53 | ``` 54 | Procedure application is represented in the syntax tree as a series of 55 | single-argument applications. Given some application node, recurse through 56 | it, collapsing all applications into a single array, until we find some other 57 | node. 58 | ``` 59 | [x] 60 | (match x 61 | {:kind :application 62 | :f arg1 63 | :x arg2} 64 | [arg1 ;(collapse-application-args arg2)] 65 | 66 | [x])) 67 | 68 | (defn- application-type 69 | ``` 70 | Resolve the type of a function application expression. Possible inferences are: 71 | 72 | - Normal procedure application 73 | - List application: 74 | - Application of a list to the type of its elements => the type of an index 75 | into the list 76 | - Application of a list to the type of an index => the type of its elements 77 | ``` 78 | [f x] 79 | (match [f x] 80 | [{:args {:tuple-of f-args} :yields yields} arg-ts] 81 | (do 82 | (unless (= (length f-args) (length arg-ts)) 83 | (errors/throw :arg-length {:f f :args arg-ts})) 84 | (if (every? (map |(gcd/gcd-type $0 $1 :gcd-app 85 | :extra {:f f}) 86 | f-args 87 | arg-ts)) 88 | yields)) 89 | 90 | ([{:list-of t1} ts] (one? (length ts)) (= t1 (ts 0))) 91 | Nat0 92 | 93 | ([{:list-of t1} ts] (one? (length ts)) (is-in-hierarchy? Int (ts 0))) 94 | t1 95 | 96 | ([{:list-of t1} ts] (> (length ts) 1)) 97 | (errors/throw :list-application-multiple-args {:xs ts}) 98 | 99 | [{:list-of t1} ts] 100 | (errors/throw :list-application-bad-arg {:f t1 :x (ts 0)}) 101 | 102 | ([{:tuple-of tuple-ts} ts] (one? (length ts)) (is-in-hierarchy? Int (ts 0))) 103 | (reduce2 utils/sum-type tuple-ts) 104 | 105 | # For now, Strings are special-cased here. 106 | ([(@ String) [t1]] (index-of t1 [Char String])) 107 | Nat0 108 | 109 | ([(@ String) ts] (one? (length ts)) (is-in-hierarchy? Int (ts 0))) 110 | Char 111 | 112 | (errors/throw :application {:f f :x x}))) 113 | 114 | (defn resolve-type 115 | ``` 116 | Get the type of some AST expression when it is fully evaluated (ie, reduced). 117 | ``` 118 | [expr env] 119 | 120 | (match expr 121 | 122 | {:kind :sym 123 | :text s} 124 | (let [looked-up (env s)] 125 | (unless looked-up 126 | (errors/throw :unknown-symbol {:sym s})) 127 | (case (looked-up :kind) 128 | # When we encounter a bare symbol, and it's a reference to a domain, it's a 129 | # direct reference to that domain and therefore has the type of Domain (not 130 | # of the domain its referencing). 131 | :domain Domain 132 | :concrete Domain 133 | # If it's not a reference to a domain, it has the type of the domain of 134 | # the value it refers to. 135 | (resolve-type looked-up env))) 136 | 137 | # When we encounter a deferred reference to a symbol, fully resolve it (if 138 | # it's a reference to a domain, it's been stored to be fully evaluated and 139 | # then assigned as the type of a static value). Go straight to type 140 | # resolution, skipping the `Domain` check above. 141 | {:thunk {:kind :sym 142 | :text s}} 143 | (let [looked-up (env s)] 144 | (if (and (= :domain (looked-up :kind)) 145 | (= :meta-domain (get-in looked-up [:type :kind]))) 146 | # If the stored type is `Domain` (why doesn't `= Domain` work here?) then 147 | # `s` is a symbol that was declared as a concrete domain, not an alias 148 | # to an existing domain. 149 | {:kind :concrete :name s :type Domain} 150 | (resolve-type looked-up env))) 151 | 152 | # Any other deferred references should be unwrapped and continued to be 153 | # evaluated. 154 | {:thunk thunk} 155 | (resolve-type thunk env) 156 | 157 | {:kind :application 158 | :f f 159 | :x x} 160 | (let [args (collapse-application-args x)] 161 | (application-type (resolve-type f env) 162 | (map |(resolve-type $ env) args))) 163 | 164 | {:kind :quantification 165 | :bindings {:seq bindings} 166 | :expr quant-expr} 167 | # Look up the extended environment for just this quantification form (which 168 | # contains any symbols bound by the quantification) inside the overall 169 | # environment. 170 | (let [closed-env (get-in expr [:scope 0])] 171 | (each binding-or-guard bindings 172 | # Type-check any guard expressions for side-effects. 173 | (unless (= (binding-or-guard :kind) :binding) 174 | (resolve-type binding-or-guard closed-env))) 175 | (resolve-type quant-expr closed-env)) 176 | 177 | ({:operator boolop 178 | :left left} (index-of boolop boolean-operators)) 179 | (let [right (expr :right)] 180 | (resolve-type left env) 181 | (if right (resolve-type right env)) 182 | Bool) 183 | 184 | ({:operator compop 185 | :left left 186 | :right right} (index-of compop comparison-operators)) 187 | (let [t (literals/widen (resolve-type left env)) 188 | t2 (literals/widen (resolve-type right env))] 189 | (if (gcd/gcd-type t t2 :gcd-comp) 190 | Bool)) 191 | 192 | ({:operator arithop 193 | :left left 194 | :right right} (index-of arithop arithmetic-operators)) 195 | (gcd/gcd-type (literals/widen (resolve-type left env)) 196 | (literals/widen (resolve-type right env)) 197 | :gcd-arith) 198 | 199 | {:operator "in" 200 | :left left 201 | :right right} 202 | (let [element-t (resolve-type left env) 203 | inner-t (member-type (resolve-type right env))] 204 | (if (gcd/gcd-type inner-t element-t :gcd-in) 205 | Bool)) 206 | 207 | {:operator "#" 208 | :left left} 209 | (if (member-type (resolve-type left env)) 210 | Nat0) 211 | 212 | {:kind :case 213 | :mapping {:seq mapping}} 214 | (do 215 | # If the `:case` is populated, then attempt to unify its type with the 216 | # types of all branch patterns. 217 | (when-let [test (expr :case) 218 | test-type (resolve-type test env) 219 | left-sides (map |($ :left) mapping) 220 | # Special-case "_" in case as match-any. 221 | filter-anys (filter |(not= ($ :text ) "_") left-sides) 222 | case-types (map |(resolve-type $ env) filter-anys)] 223 | (each case-type case-types 224 | (gcd/gcd-type test-type case-type :gcd-case-test))) 225 | # In all cases, attempt to unify the types of all branch expressions. 226 | (let [resolve |(resolve-type ($ :right) env) 227 | # When unifying branches, widen any literals to their containing 228 | # sets. 229 | resolve-and-widen (comp literals/widen resolve) 230 | all-exprs (map resolve-and-widen mapping) 231 | f |(gcd/gcd-type $0 $1 :gcd-case-branches)] 232 | (reduce2 f all-exprs))) 233 | 234 | {:kind :update 235 | :mapping {:seq mapping} 236 | :case test} 237 | (let [test-type (resolve-type test env) 238 | case-types (map |(resolve-type ($ :left) env) mapping) 239 | expr-types (map |(resolve-type ($ :right) env) mapping)] 240 | 241 | (defn maybe-wrap-args 242 | ``` 243 | The type of procedure arguments is always a tuple. In the case that the 244 | left side of the mapping expression when updating a procedure is *not* 245 | a tuple, assume it's meant as the single argument to a unary procedure 246 | and wrap it in a tuple before type-checking. 247 | ``` 248 | [t] 249 | (if-not (t :tuple-of) {:tuple-of [t]} t)) 250 | 251 | # The update case is a procedure mapping args to yields. In updating, 252 | # type the left sides against the arguments and the right sides against 253 | # the yields. 254 | (match test-type 255 | # Update a procedure. 256 | {:args args-type 257 | :yields yield-type} 258 | (let [wrapped-cases (map maybe-wrap-args case-types)] 259 | (each args-case wrapped-cases 260 | (gcd/gcd-type args-type args-case :gcd-update-procedure-args)) 261 | (each yields-case expr-types 262 | (gcd/gcd-type yield-type yields-case :gcd-update-procedure-yields)) 263 | 264 | test-type) 265 | 266 | # Update a container. 267 | {:set-of t} 268 | (let [f |(gcd/gcd-type $0 $1 :gcd-set-update)] 269 | {:set-of (reduce2 f [t ;case-types])}) 270 | 271 | {:list-of t} 272 | (let [f |(gcd/gcd-type $0 $1 :gcd-list-update)] 273 | {:list-of (reduce2 f [t ;case-types])}) 274 | 275 | # TODO: Handle updates on other data types 276 | (errorf "Couldn't type update of type: %q" test-type))) 277 | 278 | {:kind :extend 279 | :expr test 280 | :exprs {:seq exprs}} 281 | (let [test-type (resolve-type test env) 282 | exprs-types (map |(resolve-type $ env) exprs)] 283 | 284 | (match test-type 285 | # extend a container. 286 | {:set-of t} 287 | (let [f |(gcd/gcd-type $0 $1 :gcd-set-extension)] 288 | {:set-of (reduce2 f [t ;exprs-types])}) 289 | 290 | {:list-of t} 291 | (let [f |(gcd/gcd-type $0 $1 :gcd-list-extension)] 292 | {:list-of (reduce2 f [t ;exprs-types])}) 293 | 294 | (errorf "Couldn't type extension of type: %q" test-type))) 295 | 296 | {:kind :do 297 | :exprs {:seq exprs}} 298 | (do 299 | (var t nil) 300 | (each expr exprs 301 | (set t (resolve-type expr env))) 302 | t) 303 | 304 | {:container :parens 305 | :inner inner} 306 | (let [inner-ts (map |(resolve-type $ env) inner)] 307 | (if (one? (length inner-ts)) 308 | (inner-ts 0) 309 | {:tuple-of inner-ts})) 310 | 311 | {:container :set-comprehension 312 | :inner inner} 313 | {:set-of (resolve-type inner env)} 314 | 315 | {:container :list-comprehension 316 | :inner inner} 317 | {:list-of (resolve-type inner env)} 318 | 319 | {:kind :string :text text} 320 | (literals/intern String text) 321 | 322 | {:kind :num 323 | :text n} 324 | (literals/intern (utils/number-type n) n) 325 | 326 | # Special-case procedures with no arguments: treat them as singletons (that 327 | # is, to mention a procedure with no arguments is the same as applying it). 328 | ({:kind :procedure 329 | :type {:args {:tuple-of args} 330 | :yields yields}} 331 | (empty? args) (not= yields Void)) 332 | (resolve-type yields env) 333 | 334 | # Main procedure case. 335 | {:kind :procedure 336 | :type {:args args 337 | :yields yields}} 338 | 339 | {:decl-name (get-in expr [:type :decl-name]) 340 | :args (resolve-type args env) 341 | :yields (resolve-type yields env)} 342 | 343 | {:list-of inner} 344 | {:list-of (resolve-type inner env)} 345 | 346 | ({:set-of inner} (empty? inner)) 347 | expr 348 | 349 | {:set-of inner} 350 | {:set-of (resolve-type inner env)} 351 | 352 | {:tuple-of inner} 353 | {:tuple-of (tuple/slice (map |(resolve-type $ env) inner))} 354 | 355 | {:kind :sum 356 | :inner ts} 357 | (reduce2 utils/sum-type (map |(resolve-type $ env) ts)) 358 | 359 | {:kind :bound 360 | :type t} 361 | (resolve-type t env) 362 | 363 | {:kind :domain 364 | :type t} 365 | (resolve-type t env) 366 | 367 | {:value _ 368 | :type t} 369 | (resolve-type t env) 370 | 371 | # Head cases 372 | {:bindings {:seq bindings} 373 | :kind :declaration} 374 | (each binding bindings 375 | (if-not (= (binding :kind) :binding) 376 | (resolve-type binding env))) 377 | 378 | # The base case: a type defined in the base environment. 379 | {:kind :concrete} 380 | expr 381 | 382 | (errorf "Couldn't determine type of expression\n%q" expr))) 383 | -------------------------------------------------------------------------------- /test/types-test.janet: -------------------------------------------------------------------------------- 1 | (use testament) 2 | 3 | (import /pantagruel/stdlib) 4 | (import /pantagruel/types/types) 5 | (import /pantagruel/types/type-checking) 6 | 7 | (import /test/util :prefix "") 8 | 9 | (defn is-type 10 | [t form env] 11 | (let [env (table/setproto env stdlib/base-env) 12 | [success resolved] (protect (types/resolve-type form env))] 13 | (if success 14 | (is (== t resolved) (string/format "Type of %q" form)) 15 | (is false (string/format "Type of: %q\ncaught: %q" form resolved))))) 16 | 17 | (deftest singleton-test 18 | (is-type 19 | stdlib/Nat 20 | {:kind :sym :text "n"} 21 | @{"n" {:kind :procedure 22 | :type {:args {:tuple-of ()} 23 | :yields {:thunk {:kind :sym :text "Nat"}}}}})) 24 | 25 | (deftest domain-mention-test 26 | (is-type 27 | stdlib/Domain 28 | {:kind :sym :text "Nat"} 29 | @{})) 30 | 31 | (deftest domain-alias-test 32 | (let [env @{"P" {:kind :domain 33 | :type {:list-of {:thunk {:kind :sym :text "String"}}}} 34 | "p" {:kind :procedure 35 | :type {:args {:tuple-of @[]} :yields {:thunk {:kind :sym :text "P"}}}}}] 36 | (is-type 37 | {:list-of stdlib/String} 38 | {:kind :sym :text "p"} 39 | env) 40 | 41 | (is-type 42 | stdlib/Domain 43 | {:kind :sym :text "P"} 44 | env))) 45 | 46 | (deftest application-test 47 | (let [env @{"f" {:kind :procedure 48 | :type {:args {:tuple-of @[{:thunk {:kind :sym 49 | :text "Nat"}}]} 50 | :yields {:thunk {:kind :sym 51 | :text "Real"}}}} 52 | "x" {:kind :bound 53 | :type {:thunk {:kind :sym 54 | :text "Nat"}}}}] 55 | (is-type 56 | stdlib/Nat 57 | {:kind :sym :text "x"} 58 | env) 59 | 60 | (is-type 61 | {:args {:tuple-of [stdlib/Nat]} :yields stdlib/Real} 62 | {:kind :sym :text "f"} 63 | env) 64 | 65 | (is-type 66 | stdlib/Real 67 | {:kind :application 68 | :f {:kind :sym :text "f"} 69 | :x {:kind :num :text 1}} 70 | env))) 71 | 72 | (deftest nested-sums 73 | (let [env @{"Alias" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "String"}}}} 74 | "Body" {:kind :domain 75 | :type {:list-of {:inner @[{:thunk {:kind :sym 76 | :text "Comment"}} 77 | {:thunk {:kind :sym 78 | :text "Expression"}}] 79 | :kind :sum}}} 80 | "Comment" {:kind :domain :type {:list-of {:thunk {:kind :sym 81 | :text "String"}}}} 82 | "Expression" {:kind :domain :type {:list-of {:thunk {:kind :sym 83 | :text "String"}}}} 84 | "b" {:kind :procedure :type {:args {:tuple-of @[]} 85 | :yields {:thunk {:kind :sym 86 | :text "Body"}}}}}] 87 | (is-type 88 | {:list-of {:list-of @{:kind :concrete :name "String" 89 | :type @{:kind :meta-domain :name "Domain"}}}} 90 | 91 | {:kind :sym :text "b"} 92 | env))) 93 | 94 | (deftest binding-regression 95 | (let [env @{"Alias" {:kind :domain 96 | :type {:list-of {:thunk {:kind :sym 97 | :text "String"}}}} 98 | "Body" {:kind :domain 99 | :type {:list-of {:inner @[{:thunk {:kind :sym 100 | :text "Comment"}} 101 | {:thunk {:kind :sym 102 | :text "Expression"}}] 103 | :kind :sum}}} 104 | "Comment" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "String"}}}} 105 | "Declaration" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "String"}}}} 106 | "Expression" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "String"}}}} 107 | "Head" {:kind :domain 108 | :type {:list-of {:inner @[{:inner @[{:thunk {:kind :sym :text "Comment"}} 109 | {:thunk {:kind :sym :text "Declaration"}}] 110 | :kind :sum} 111 | {:thunk {:kind :sym :text "Alias"}}] :kind :sum}}} 112 | "Program" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "Section"}}}} 113 | "Scope" {:kind :domain :type {:set-of {:thunk {:kind :sym :text "String"}}}} 114 | "Section" {:kind :domain :type @{:kind :meta-domain :name "Domain"}} 115 | "b" {:kind :member 116 | :type {:thunk {:f {:kind :sym :text "body"} 117 | :kind :application 118 | :x {:container :parens 119 | :inner [{:f {:kind :sym :text "p"} 120 | :kind :application 121 | :x {:container :parens 122 | :inner [{:kind :binary-operation 123 | :left {:f {:kind :sym :text "p"} 124 | :kind :application 125 | :x {:kind :sym :text "sect"}} 126 | :operator "-" 127 | :right {:kind :num :text 1}}]}}]}}}} 128 | "body" {:kind :bound :type {:thunk {:kind :sym :text "Body"}}} 129 | "env" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Program"}}]} 130 | :yields {:list-of {:thunk {:kind :sym :text "Scope"}}}}} 131 | "eval" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Program"}}]} 132 | :yields {:thunk {:kind :sym :text "Bool"}}}} 133 | "h" {:kind :member :type {:thunk {:f {:kind :sym :text "head"} 134 | :kind :application 135 | :x {:kind :sym :text "sect"}}}} 136 | "head" {:kind :bound :type {:thunk {:kind :sym :text "Head"}}} 137 | "init_scope" {:kind :procedure :type {:args {:tuple-of @[]} 138 | :yields {:thunk {:kind :sym :text "Scope"}}}} 139 | "is_all_bound?" {:kind :procedure 140 | :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Section"}}]} 141 | :yields {:thunk {:kind :sym :text "Bool"}}}} 142 | "is_bound?" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "String"}}]} 143 | :yields {:thunk {:kind :sym :text "Bool"}}}} 144 | "p" {:kind :bound :type {:thunk {:kind :sym :text "Program"}}} 145 | 146 | "section" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Head"}} 147 | {:thunk {:kind :sym :text "Body"}}]} 148 | :yields {:thunk {:kind :sym :text "Section"}}}} 149 | "sym" {:kind :bound :type {:thunk {:kind :sym :text "String"}}}} 150 | closure (table/setproto @{"sect" {:kind :bound :type {:thunk {:kind :sym :text "Section"}}}} env)] 151 | # A compound alias to built-in types. 152 | (is-type 153 | stdlib/Domain 154 | {:kind :sym :text "Body"} 155 | env) 156 | # A compound alias to a user-defined concrete type. 157 | (is-type 158 | stdlib/Domain 159 | {:kind :sym :text "Program"} 160 | env) 161 | # A user-defined concrete type. 162 | (is-type 163 | stdlib/Domain 164 | {:kind :sym :text "Section"} 165 | env) 166 | 167 | (is-type 168 | stdlib/Bool 169 | {:f {:kind :sym 170 | :text "eval"} 171 | :kind :application 172 | :x {:kind :sym 173 | :text "p"}} 174 | env))) 175 | 176 | (deftest zk-regression-test 177 | (let [env @{"Index" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "Line"}}}} 178 | "Line" {:kind :domain :type {:thunk {:kind :sym :text "String"}}} 179 | "Note" {:kind :domain :type {:list-of {:thunk {:kind :sym :text "Line"}}}} 180 | "Reference" {:kind :domain :type {:thunk {:kind :sym :text "Line"}}} 181 | "backlinks" {:kind :procedure 182 | :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Note"}}]} 183 | :yields {:set-of {:thunk {:kind :sym :text "Reference"}}}}} 184 | "body" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Note"}}]} 185 | :yields {:list-of {:thunk {:kind :sym :text "Line"}}}}} 186 | "bracketed" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "String"}}]} 187 | :yields {:thunk {:kind :sym :text "String"}}}} 188 | "created_at" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Note"}}]} 189 | :yields {:thunk {:kind :sym :text "Date"}}}} 190 | "escape" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "String"}}]} 191 | :yields {:thunk {:kind :sym :text "String"}}}} 192 | "i" {:kind :bound :type {:thunk {:kind :sym :text "Index"}}} 193 | "index" {:kind :procedure 194 | :type {:args {:tuple-of @[{:list-of {:thunk {:kind :sym :text "Note"}}}]} 195 | :yields @{:kind :concrete :name "Void" 196 | :type @{:kind :meta-domain :name "Domain"}}}} 197 | "line" {:kind :member :type {:thunk {:kind :sym :text "n"}}} 198 | "n" {:kind :bound :type {:thunk {:kind :sym :text "Note"}}} 199 | "name" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Note"}}]} 200 | :yields {:thunk {:kind :sym :text "String"}}}} 201 | "notes" {:kind :bound :type {:list-of {:thunk {:kind :sym :text "Note"}}}} 202 | "r" {:kind :member :type {:thunk {:f {:kind :sym :text "references"} 203 | :kind :application 204 | :x {:kind :sym :text "n"}}}} 205 | "ref" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "String"}}]} 206 | :yields {:thunk {:kind :sym :text "Reference"}}}} 207 | "ref_note" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Note"}}]} 208 | :yields {:thunk {:kind :sym :text "Reference"}}}} 209 | "references" {:kind :procedure :type {:args {:tuple-of @[{:thunk {:kind :sym :text "Note"}}]} 210 | :yields {:list-of {:thunk {:kind :sym :text "Reference"}}}}} 211 | "s" {:kind :bound :type {:thunk {:kind :sym :text "String"}}}} 212 | closure (table/setproto @{"m" {:kind :bound 213 | :type {:thunk {:kind :sym :text "Note"}}}} env)] 214 | (is-type 215 | {:set-of stdlib/String} 216 | {:container :set-comprehension 217 | :inner {:bindings {:kind :seq 218 | :seq [{:binding-type :: 219 | :expr {:kind :sym :text "Note"} 220 | :kind :binding 221 | :name {:kind :sym :text "m"}} 222 | {:kind :binary-operation 223 | :left {:container :parens 224 | :inner [{:f {:kind :sym :text "bracketed"} 225 | :kind :application 226 | :x {:container :parens 227 | :inner [{:f {:kind :sym :text "name"} 228 | :kind :application 229 | :x {:kind :sym :text "n"}}]}}]} 230 | :operator "in" 231 | :right {:kind :sym :text "m"}}]} 232 | :expr {:f {:kind :sym :text "ref_note"} 233 | :kind :application 234 | :x {:kind :sym :text "m"}} 235 | :kind :quantification 236 | :scope @[closure] 237 | :quantifier {:kind :all :text "all"}}} 238 | 239 | env))) 240 | 241 | (run-tests!) 242 | -------------------------------------------------------------------------------- /test/parser_test.janet: -------------------------------------------------------------------------------- 1 | (use testament) 2 | 3 | (import yacc) 4 | (import /pantagruel/parser) 5 | (import /test/util :prefix "") 6 | 7 | (defn- is-parse 8 | [tokens ast &opt dbg] 9 | (var parsed nil) 10 | 11 | (defn- parse [] (set parsed (yacc/parse parser/parser-tables tokens))) 12 | 13 | (if dbg 14 | (with-dyns [:yydebug @""] 15 | (parse) 16 | (print (dyn :yydebug))) 17 | (parse)) 18 | 19 | (is (== ast parsed))) 20 | 21 | (deftest empty-program 22 | (is-parse 23 | [] 24 | [:ok {:directives [] :chapters []}])) 25 | 26 | (deftest base-head 27 | (is-parse 28 | head-placeholder 29 | [:ok {:directives [] :chapters [{:kind :chapter 30 | :head [{:kind :declaration 31 | :name {:kind :sym :text "f"} 32 | :bindings {:kind :seq 33 | :seq []}}] 34 | :body []}]}])) 35 | 36 | (deftest base-chapter 37 | (is-parse 38 | [;head-placeholder 39 | (sym "g") .] 40 | [:ok {:directives [] :chapters [{:kind :chapter 41 | :head [{:kind :declaration 42 | :name (sym "f") 43 | :bindings {:kind :seq 44 | :seq []}}] 45 | :body [(sym "g")]}]}])) 46 | 47 | (deftest head-with-binding 48 | (is-parse 49 | [(sym "f") (sym "x") bind (sym "X") . 50 | ---] 51 | [:ok {:directives [] :chapters [{:kind :chapter 52 | :head [{:kind :declaration 53 | :name (sym "f") 54 | :bindings {:kind :seq 55 | :seq [{:kind :binding 56 | :binding-type :: 57 | :expr (sym "X") 58 | :name (sym "x")}]}}] 59 | :body []}]}])) 60 | 61 | (deftest head-with-binding-expr-equals 62 | (is-parse 63 | [(sym "X") = (sym "Nat") . 64 | (sym "f") (sym "x") bind (sym "X") comma (sym "x") = (num 1) . 65 | ---] 66 | [:ok {:chapters [{:body () 67 | :head [{:alias {:kind :sym :text "Nat"} 68 | :kind :decl-alias 69 | :name {:kind :sym :text "X"}} 70 | {:bindings {:kind :seq 71 | :seq [{:expr {:kind :sym :text "X"} 72 | :kind :binding 73 | :binding-type :: 74 | :name {:kind :sym :text "x"}} 75 | {:kind :binary-operation 76 | :left {:kind :sym :text "x"} 77 | :operator "=" 78 | :right (num 1)}]} 79 | :kind :declaration 80 | :name {:kind :sym :text "f"}}] 81 | :kind :chapter}] 82 | :directives ()}])) 83 | 84 | (deftest head-with-yields 85 | (is-parse 86 | [(sym "f") => (sym "F") . 87 | ---] 88 | [:ok {:directives [] :chapters [{:kind :chapter 89 | :head [{:kind :declaration 90 | :name (sym "f") 91 | :bindings {:kind :seq :seq []} 92 | :yields (sym "F")}] 93 | :body []}]}])) 94 | 95 | (deftest head-with-alias 96 | (is-parse 97 | [(sym "f") = (sym "F") . 98 | ---] 99 | [:ok {:directives [] :chapters [{:kind :chapter 100 | :head [{:kind :decl-alias 101 | :name (sym "f") 102 | :alias (sym "F")}] 103 | :body []}]}])) 104 | 105 | (deftest head-with-tuple-alias 106 | (is-parse 107 | [lp (sym "f") comma (sym "g") rp = (sym "F") . 108 | ---] 109 | [:ok {:directives [] :chapters [{:kind :chapter 110 | :head [{:kind :decl-alias 111 | :name {:container :parens 112 | :inner {:kind :seq 113 | :seq [{:kind :sym :text "f"} 114 | {:kind :sym :text "g"}]}} 115 | :alias (sym "F")}] 116 | :body []}]}])) 117 | (deftest head-with-alias-container 118 | (is-parse 119 | [(sym "f") = {:kind :lsquare} (sym "F") {:kind :rsquare} . 120 | ---] 121 | [:ok {:directives [] :chapters [{:kind :chapter 122 | :head [{:kind :decl-alias 123 | :name (sym "f") 124 | :alias {:container :list-of 125 | :inner (sym "F")}}] 126 | :body []}]}])) 127 | 128 | (deftest multiple-chapters 129 | (is-parse 130 | [;head-placeholder 131 | (sym "g") 132 | . 133 | {:kind :where} 134 | (sym "h") 135 | . 136 | ---] 137 | [:ok {:directives [] :chapters [{:kind :chapter 138 | :head [{:kind :declaration 139 | :name (sym "f") 140 | :bindings {:kind :seq :seq []}}] 141 | :body [(sym "g")]} 142 | {:kind :chapter 143 | :head [{:kind :declaration 144 | :name (sym "h") 145 | :bindings {:kind :seq :seq []}}] 146 | :body []}]}])) 147 | 148 | (deftest qualification 149 | (with-dyns [:normalize-syms true] 150 | (is-parse 151 | [(sym "x") 152 | . 153 | --- 154 | {:kind :some} 155 | (sym "x") bind (sym "Nat") 156 | {:kind :comma} 157 | (sym "x") {:kind :boolean-operator :text ">"} (num 1) 158 | ... 159 | (sym "x") {:kind :boolean-operator :text "<"} (num 10) 160 | .] 161 | [:ok {:directives [] :chapters [{:body [{:bindings 162 | {:kind :seq 163 | :seq [{:expr (sym "Nat") 164 | :kind :binding 165 | :binding-type :: 166 | :name (sym "x")} 167 | {:kind :binary-operation 168 | :left (sym "x") 169 | :operator ">" 170 | :right (num 1)}]} 171 | :expr {:kind :binary-operation 172 | :left (sym "x") 173 | :operator "<" 174 | :right (num 10)} 175 | :kind :quantification 176 | :scope @[nil] 177 | :quantifier {:kind :some}}] 178 | :head [{:bindings {:kind :seq :seq []} 179 | :kind :declaration 180 | :name (sym "x")}] 181 | :kind :chapter}]}]))) 182 | 183 | (deftest quantification-with-container 184 | (with-dyns [:normalize-syms true] 185 | (is-parse [(sym "A") . 186 | --- 187 | {:kind :some :text "some"} 188 | lp 189 | {:kind :sym :text "a"} {:kind :comma} 190 | (sym "b") 191 | rp 192 | bind 193 | (sym "A") 194 | ... 195 | (sym "a") + (sym "b") 196 | .] 197 | [:ok {:directives [] 198 | :chapters [{:body [{:bindings 199 | {:kind :seq 200 | :seq [{:expr (sym "A") 201 | :kind :binding 202 | :binding-type :: 203 | :name {:container :parens 204 | :inner {:kind :seq 205 | :seq [(sym "a") (sym "b")]}}}]} 206 | :expr {:kind :binary-operation 207 | :left (sym "a") 208 | :operator "+" 209 | :right (sym "b")} 210 | :kind :quantification 211 | :scope @[nil] 212 | :quantifier {:kind :some :text "some"}}] 213 | :head [{:bindings {:kind :seq :seq []} 214 | :kind :declaration 215 | :name (sym "A")}] 216 | :kind :chapter}]}]))) 217 | 218 | (deftest precedence 219 | (is-parse 220 | [;head-placeholder 221 | (sym "x") {:kind :arithmetic-operator2 :text "-"} (num 1) 222 | = 223 | (sym "y") + (num 2) .] 224 | [:ok {:directives [] :chapters [{:body [{:kind :binary-operation 225 | :left {:kind :binary-operation :left (sym "x") 226 | :operator "-" 227 | :right (num 1)} 228 | :operator "=" 229 | :right {:kind :binary-operation 230 | :left (sym "y") 231 | :operator "+" 232 | :right (num 2)}}] 233 | :head [{:bindings {:kind :seq :seq []} 234 | :kind :declaration :name (sym "f")}] 235 | :kind :chapter}]}])) 236 | 237 | (deftest multiple-application 238 | (is-parse 239 | [;head-placeholder 240 | (sym "x") (sym "y") (num 1) .] 241 | [:ok {:chapters [{:body [{:f (sym "x") 242 | :kind :application 243 | :x {:f (sym "y") 244 | :kind :application 245 | :x (num 1)}}] 246 | :head [{:bindings {:kind :seq :seq []} 247 | :kind :declaration 248 | :name (sym "f")}] 249 | :kind :chapter}] 250 | :directives []}])) 251 | 252 | (deftest unary-application 253 | (is-parse 254 | [;head-placeholder 255 | card (sym "x") 256 | = 257 | card (sym "s") .] 258 | [:ok {:chapters [{:body [{:kind :binary-operation 259 | :left {:kind :unary-operation 260 | :operator "#" 261 | :left (sym "x")} 262 | :operator "=" 263 | :right {:kind :unary-operation 264 | :left (sym "s") 265 | :operator "#"}}] 266 | :head [{:bindings {:kind :seq :seq []} 267 | :kind :declaration 268 | :name (sym "f")}] 269 | :kind :chapter}] 270 | :directives ()}]) 271 | 272 | (is-parse 273 | [;head-placeholder 274 | card (sym "x") {:kind :boolean-operator :text "-"} (num 1) .] 275 | [:ok {:chapters [{:body [{:kind :binary-operation 276 | :left {:kind :unary-operation 277 | :operator "#" 278 | :left (sym "x")} 279 | :operator "-" 280 | :right (num 1)}] 281 | :head [{:bindings {:kind :seq :seq []} 282 | :kind :declaration 283 | :name (sym "f")}] 284 | :kind :chapter}] 285 | :directives ()}]) 286 | 287 | (is-parse 288 | [;head-placeholder 289 | card lp (sym "concat") (sym "s") (sym "r") rp 290 | = 291 | card (sym "s") + card (sym "r") .] 292 | [:ok {:chapters [{:body [{:kind :binary-operation 293 | :operator "=" 294 | :left {:kind :unary-operation 295 | :operator "#" 296 | :left {:container :parens 297 | :inner [{:f (sym "concat") 298 | :kind :application 299 | :x {:f (sym "s") 300 | :kind :application 301 | :x (sym "r")}}]}} 302 | :right {:kind :binary-operation 303 | :operator "+" 304 | :left {:kind :unary-operation 305 | :left (sym "s") 306 | :operator "#"} 307 | :right {:kind :unary-operation 308 | :left (sym "r") 309 | :operator "#"}}}] 310 | :head [{:bindings {:kind :seq :seq []} 311 | :kind :declaration 312 | :name (sym "f")}] 313 | :kind :chapter}] 314 | :directives ()}])) 315 | 316 | (deftest directives 317 | (is-parse 318 | [{:kind :directive :text "module"} 319 | (sym "FIB") . 320 | ;head-placeholder] 321 | [:ok {:chapters [{:body [] :head [{:bindings {:kind :seq :seq []} :kind :declaration :name (sym "f")}] 322 | :kind :chapter}] 323 | :directives [{:args (sym "FIB") 324 | :kind :directive 325 | :statement "module"}]}])) 326 | 327 | (deftest fib 328 | (is-parse 329 | [(sym "fib") (sym "x") bind (sym "Nat") => (sym "Nat") . 330 | --- 331 | (sym "fib") (sym "x") = 332 | {:kind :case :text "case"} {:kind :... :text "..."} 333 | (sym "x") {:kind :boolean-operator :text ">"} (num 2) => 334 | (sym "fib") 335 | lp (sym "x") {:kind :arithmetic-operator2 :text "-"} (num 1) rp 336 | + (sym "fib") 337 | lp (sym "x") {:kind :arithmetic-operator2 :text "-"} (num 2) rp 338 | comma 339 | (sym "x") = (num 1) 340 | => (num 1) comma 341 | (sym "x") = (num 2) 342 | => (num 1) .] 343 | [:ok {:directives [] 344 | :chapters [{:body 345 | [{:kind :binary-operation 346 | :operator "=" 347 | :left {:f (sym "fib") :kind :application :x (sym "x")} 348 | :right {:kind :case 349 | :mapping {:kind :seq 350 | :seq [{:kind :map 351 | :left {:kind :binary-operation 352 | :operator ">" 353 | :left (sym "x") 354 | :right (num 2)} 355 | :right {:kind :binary-operation 356 | :operator "+" 357 | :left {:kind :application 358 | :f (sym "fib") 359 | :x {:container :parens 360 | :inner [{:kind :binary-operation 361 | :operator "-" 362 | :left (sym "x") 363 | :right (num 1)}]}} 364 | :right {:kind :application 365 | :f (sym "fib") 366 | :x {:container :parens 367 | :inner [{:kind :binary-operation 368 | :operator "-" 369 | :left (sym "x") 370 | :right (num 2)}]}}}} 371 | {:kind :map 372 | :left {:kind :binary-operation 373 | :operator "=" 374 | :left (sym "x") 375 | :right (num 1)} 376 | :right (num 1)} 377 | {:kind :map 378 | :left {:kind :binary-operation 379 | :operator "=" 380 | :left (sym "x") 381 | :right (num 2)} 382 | :right (num 1)}]}}}] 383 | :head [{:bindings 384 | {:kind :seq 385 | :seq [{:expr (sym "Nat") 386 | :kind :binding 387 | :binding-type :: 388 | :name (sym "x")}]} 389 | :kind :declaration 390 | :name (sym "fib") 391 | :yields (sym "Nat")}] 392 | :kind :chapter}]}])) 393 | 394 | (run-tests!) 395 | -------------------------------------------------------------------------------- /priv/reference.md: -------------------------------------------------------------------------------- 1 | # Pantagruel Language Reference 2 | 3 | A Pantagruel document consists of a series of definitions and statements about 4 | *domains* and *procedures*. The Pantagruel language is parseable by the 5 | Pantagruel document checker, which will parse the document and check it for 6 | errors. 7 | 8 | ## Pantagruel Syntax 9 | 10 | A Pantagruel **document** consists of a series of **chapters**. Each chapter 11 | consists of a **head** and an optional **body**. 12 | 13 | At the top of a document, in a chapter head, and in a chapter body, are written 14 | a series of **statements**. Every statement is finished with a period: `.`. 15 | Because every statement is finished with a period, statements can cover 16 | multiple lines of text. 17 | 18 | At the top of the program are optional **directives**. Currently, there are two 19 | recognized directives: 20 | 21 | - `module` 22 | - `import` 23 | 24 | ### Module Statements 25 | 26 | The first line of a Pantagruel program is, optionally, a module directive. It looks like this: 27 | 28 | ```pantagruel 29 | module NUMBERS. 30 | ``` 31 | 32 | This will make the subsequent program available for import under the module 33 | name `NUMBERS`. 34 | 35 | ### Import Statements 36 | 37 | Import directives are used to introduce bindings defined by another module (see 38 | `module`, above) into the evaluation environment for the current document. 39 | 40 | ### Chapter Heads 41 | 42 | A Pantagruel chapter head introduces one or more terms, of two kinds: 43 | **domains** and **procedures**. 44 | 45 | Domains are *sets* or *types* of things. Some domains are built in, as: the 46 | natural numbers, the booleans (true and false), et cetera. Most documents will 47 | introduce some additional domains that they're concerned with describing: 48 | `User`, `File`, `Card`. 49 | 50 | Procedures are everything that isn't a domain: procedures are individual 51 | processes, behaviours, actions, functions, programs, etc., that act on domains. 52 | 53 | Some procedures *produce* or *go to* some domain: addition, for instance, can 54 | be seen as a procedure that goes from two natural numbers to some other natural 55 | number. 56 | 57 | Some procedures don't produce any additional values, but instead are understood 58 | to have *side effects*: they are understood to effect some change in the state 59 | of the world. 60 | 61 | There are two expression forms possible in a chapter head: 62 | 63 | #### Domain alias 64 | 65 | The simplest type of statement available in a chapter head is a **domain alias**. 66 | This is a simple statement of equivalence between a new domain and some 67 | existing one. It uses the **equals** symbol `=`. 68 | 69 | Here's an example domain alias: 70 | 71 | ```pantagruel 72 | Status = {"ok", "error"}. 73 | ``` 74 | 75 | which introduces a domain `Status` which is equivalent to the set of values 76 | `ok` and `error`. 77 | 78 | #### Procedure declaration 79 | 80 | Procedure declarations are more complex, as they tend to represent the "meat" 81 | of a Pantagruel document: domains by themselves are static things, and we 82 | introduce one or more procedure as individual instances of change in our world. 83 | 84 | Here is an example procedure declaration: 85 | 86 | ```pantagruel 87 | fib n: Nat => Nat. 88 | ``` 89 | 90 | It introduces a procedure called `fib`, which takes one argument, `n` in the 91 | domain `Nat`. The `=>` indicates that this procedure *yields*, *produces*, or 92 | *goes to* a value in some domain (known in mathematics as the procedure's 93 | *codomain*), which in this case is also `Nat`. 94 | 95 | It is a simple description of the name and type of a mathematical function that 96 | produces Fibonacci numbers. 97 | 98 | ##### Procedure declaration forms 99 | 100 | Procedures can be declared with or without: 101 | 102 | - arguments, 103 | - codomains, 104 | - and predicates. 105 | 106 | The simplest syntactically valid form to introduce a procedure is to simply 107 | write the name of the procedure on a single line in a chapter head: 108 | 109 | ```pantagruel 110 | f. 111 | ``` 112 | 113 | This establishes that there is some procedure named `f`, which takes no 114 | arguments and yields nothing. 115 | 116 | Procedure arguments are specified by a comma-separated list of argument 117 | **bindings**. On the left side of the binding is the name of the argument, and 118 | the right side is the domain of the argument. In the example of `fib`, there 119 | was a single argument, named `n`, in the domain `Nat`. 120 | 121 | The comma-separated list may also contain other arbitrary **predicates**, 122 | representing some constraint on the procedure domain. 123 | 124 | Here's a procedure declaration with a predicate: 125 | 126 | ```pantagruel 127 | f x: Nat, x > 5. 128 | ``` 129 | 130 | The second element in the list indicates that `f` is defined for any 131 | natural number `x` greater than 5. 132 | 133 | ```pantagruel 134 | f x: Nat, x > 5, x < 10. 135 | ``` 136 | 137 | This declares a procedure `f` that's defined for any natural number `x` 138 | greater than 5 and less than 10. 139 | 140 | This list of colon-separated bindings with optional predicates is a **binding 141 | sequence** and will show up elsewhere in the language. 142 | 143 | Any procedure can also yield some domain, as above. 144 | 145 | ##### Procedures with side effects 146 | 147 | A procedure that has no codomain is understood to cause some change in the 148 | world. Therefore, it makes sense to talk about the state of things *before* and 149 | *after* the procedure takes place. 150 | 151 | When a procedure is declared that yields no values, each argument name is 152 | introduced in two ways: as written, and appended with a `'` (for instance, `x` 153 | and `x'`). We can use the value with a `'` to refer to the state of the 154 | argument after the procedure has taken place. 155 | 156 | We can see an example: 157 | 158 | ```pantagruel 159 | check_out u:User, d:Document. 160 | --- 161 | owner d = nobody and has_perm? u d -> owner d' = u. 162 | ``` 163 | 164 | It introduces a procedure, `check_out`, which takes some `User` and some 165 | `Document`. To check out a document is to update who its owner currently is; 166 | thus, we can refer to `d`---the document being checked out---as well as 167 | `d'`---the same document, after the `check_out` procedure takes place. 168 | 169 | #### Values 170 | 171 | We can use the keyword `val` in chapter heads to provide a subtle but useful 172 | variation on procedures. 173 | 174 | Most of the time, individual things in Pantagruel don't have names; because we 175 | want to describe things that are always true, we will usually use 176 | quantification (see below) to talk about some generic instance of a domain. 177 | 178 | At times, however, it's useful to introduce individual objects that can be 179 | referred to in the same way we refer to procedures. For instance, describing a 180 | card game, we might want to refer to the cards currently on the table, and 181 | describe how they change over time. Using the keyword `val` gives a name to a 182 | particular thing, and lets us describe how it changes over time. 183 | 184 | To illustrate the example of cards on the table, for instance: 185 | 186 | ``` 187 | val table => {Card}. 188 | --- 189 | ``` 190 | 191 | We can also understand values as *tables* associating arguments with some 192 | value. For instance: 193 | 194 | ``` 195 | val scores p: Player => Nat0. 196 | score_goal p: Player. 197 | --- 198 | score_goal p -> scores' = update scores ... p => (scores p) + 1. 199 | ``` 200 | 201 | In this example, `scores` is a mapping from `Player`s to `Nat0`s, and so 202 | `(scores p)` is the score for a particular player at a particular point in 203 | time. 204 | 205 | ### Chapter Bodies 206 | 207 | Chapter **bodies** are separated from chapter heads with a horizontal 208 | line, consisting of three or more hyphens (`---`): 209 | 210 | ```pantagruel 211 | f. 212 | --- 213 | f x = 1. 214 | ``` 215 | 216 | Chapter bodies consist of one or more **statements**. Each statement expresses 217 | some **proposition** about a procedure or domain and is terminated by a period. 218 | 219 | A top-level statement can be made of any valid **expression**. 220 | 221 | ### Multiple Chapters 222 | 223 | Multiple chapters are separated by the symbol `where`. The chapter separator 224 | begins a new chapter head. 225 | 226 | ### Expressions 227 | 228 | The stuff that Pantagruel statements are made up of is not natural language. 229 | While one can---and should---use comments (any line beginning with `//`) to 230 | give a natural-language gloss on the statements being put down, the statements 231 | themselves are written in a formal, logical notation. 232 | 233 | Like a programming language, this syntax can be completely and unambiguously 234 | parsed by a computer program. Like mathematical notation, it's designed to be 235 | compressed and expressive, easily written by hand, easily edited and updated. 236 | 237 | #### Variables 238 | 239 | Most of the terms in a Pantagruel document will be those introduced by the 240 | author. These are *variables*---their meaning is contextual. They are analogous 241 | to mathematical variables, which allow us to express universal truths: `x + x = 242 | x * 2`, for instance, regardless of the value given for `x`. 243 | 244 | To give a trival example, we can return to our Fibonacci function: 245 | 246 | ```pantagruel 247 | fib n: Nat => Nat. 248 | --- 249 | fib n = fib (n - 1) + fib (n - 2). 250 | ``` 251 | 252 | Having introduced `fib` and `n` as terms above the line, we can use them in 253 | expressions below the line. 254 | 255 | We can author Pantagruel documents that are about things entirely other than 256 | mathematics, too. Returning to a previous example: 257 | 258 | ```pantagruel 259 | User. 260 | Document. 261 | check_out u:User, d:Document. 262 | --- 263 | owner d = nobody and has_perm? u d -> owner d' = u. 264 | ``` 265 | 266 | We see that all the terms in use are purely symbolic; what's useful is the 267 | logical and symbolic relations between them. 268 | 269 | #### Values 270 | 271 | That said: we need not establish every domain entirely symbolically. We can use 272 | *literal* syntax---that is, things we recognize as values rather than symbolic 273 | names that stand for something else---for data that it would be useful to 274 | manipulate. 275 | 276 | ##### Integers 277 | 278 | Integer values are represented as normal numbers: `1`, `1000`. 279 | 280 | ##### Real numbers 281 | 282 | Real numbers are written with a decimal point: `2.47`, `10.0`. 283 | 284 | ##### Text 285 | 286 | Literal text values are represented with quotation marks: `"ok"`, `"error"`. 287 | 288 | ##### Operators 289 | 290 | There is a closed set of symbols that are recognized as **operators**, 291 | that are applied infix instead of prefix, eg: `1 + 1`. `x in Y`. 292 | 293 | ###### Binary operators 294 | 295 | Binary operators take two arguments. 296 | 297 | - `+` 298 | - `-` 299 | - `*` 300 | - `/` 301 | - `^` 302 | - `mod` 303 | - `|` 304 | - `&` 305 | - `->` 306 | - `<->` 307 | - `=` 308 | - `>` 309 | - `<` 310 | - `=<` 311 | - `>=` 312 | - `!=` 313 | - `and` 314 | - `or` 315 | - `xor` 316 | - `in` 317 | 318 | ###### Unary operators 319 | 320 | Unary operators take one argument. 321 | 322 | - `#` 323 | - `~` 324 | 325 | ###### Sum and product types 326 | 327 | `+` and `*` can be applied to domains as well as values. 328 | 329 | `+` produces a sum type; for instance, `String + Nat + Bool` denotes the domain 330 | consisting of all strings, natural numbers, and boolean values. 331 | 332 | `*` produces a product type; for instance, `String * Nat` denotes the domain of 333 | all *pairs* of strings and natural numbers. 334 | 335 | ##### Symbols 336 | 337 | Symbols are identifiers to which values are bound, as in function 338 | declarations. They can contain any alphanumeric character that is not 339 | an operator. 340 | 341 | #### Procedure application 342 | 343 | Application of `f` to `x` is represented by the syntax `f x`. 344 | 345 | Procedure application can be performed on any number of arguments, eg.: `f x y 346 | z`. 347 | 348 | #### Quantification 349 | 350 | `all` and `some` Represent the logical quantifications "for all..." and "there 351 | is some...", respectively. They have the form of a **quantifier**, followed by 352 | a comma-separated list of **binding** or **expression** forms, followed by a 353 | **yields** sign, followed by a statement about the bound variables. 354 | 355 | ```pantagruel 356 | all x: Nat, y: Nat, x > y ... (x - y) > 0. 357 | ``` 358 | 359 | This example says that for any x and y in the natural numbers where x is 360 | greater than y, x minus y is greater than 0. It could also be written in a 361 | slightly more compressed form, binding multiple variables from the same domain: 362 | 363 | ```pantagruel 364 | all (x, y): Nat, x > y ... (x - y) > 0. 365 | ``` 366 | 367 | #### Containers 368 | 369 | There are three **containers** in Pantagruel. Containers are represented by 370 | surrounding an expression or comma-separated list of expressions by a pair of 371 | delimiters which reflects the type of container being represented. 372 | 373 | - parens: `()` 374 | - set: `{}` 375 | - sequence: `[]` 376 | 377 | ##### Parentheses 378 | 379 | Any expression can be wrapped in parentheses to bind more tightly. For 380 | instance, whereas `f x y z a` denotes the application of `f` to the four 381 | arguments `x`, `y`, `z`, and `a`, `f x (y z a)` denotes the application of `f` 382 | to two arguments: `x` and the result of the application of `y` to `z` and `a`. 383 | 384 | ##### Sets and sequences 385 | 386 | Sets and sequences represent groups of values or domains. 387 | 388 | The notation `{1, 2, 3}` represents the unordered set of the natural numbers 1, 389 | 2, 3. The notation `[1, 2, 3]` represents the ordering of those same values in 390 | that order. 391 | 392 | Set and sequence notation, when applied to domains, denotes a "set of" or 393 | "sequence of" domain. For instance, `[String]` is the domain of sequences of 394 | strings. 395 | 396 | **sequence comprehensions** may be formed by wrapping a quantification in 397 | square brackets. For instance, 398 | 399 | ```pantagruel 400 | [all x : X ... x ^ 2]. 401 | ``` 402 | 403 | denotes a sequence made up every element in the domain X, squared. 404 | 405 | #### Case 406 | 407 | A case expression consists of the symbol `case`, an optional expression, and a 408 | series of **mappings** of expressions to expressions. Each mapping is separated 409 | by a comma, and the left side is mapped to the right side with a `=>`. 410 | 411 | For instance: 412 | 413 | ``` 414 | fib x = case ... 415 | x > 2 => fib (x - 1) + fib (x - 2), 416 | x = 1 => 1, 417 | x = 2 => 1. 418 | ``` 419 | 420 | If there's no expression between `case` and `...`, then the left-hand side of 421 | each mapping clause is typed as a statement that might be true or false. If 422 | there's an expression between `case` and `...`, it will be type-checked against 423 | the left-hand sides of the mapping clauses. For instance: 424 | 425 | ``` 426 | fib x = case x ... 427 | 1 => 1, 428 | 2 => 1, 429 | _ => fib (x - 1) + fib (x - 2). 430 | ``` 431 | 432 | While this resembles the sort of pattern-matching found in some programming 433 | languages, it's simpler than that: the "pattern" side of a mapping clause here 434 | doesn't introduce a new symbol to the scope of the expression side. However, 435 | within `case` syntax, we *can* use the special symbol `_`, as in the above 436 | example, to denote an "else" branch that always evaluates to true if none of 437 | the earlier branches match. 438 | 439 | #### Update 440 | 441 | An update expression consists of the symbol `update`, an expression, and 442 | mapping clauses. 443 | 444 | For instance: 445 | 446 | ``` 447 | fib' = update fib ... 448 | 5 => 100. 449 | ``` 450 | 451 | Represents a procedure which behaves exactly like `fib`, except when it is 452 | called on `5`. 453 | 454 | #### Do 455 | 456 | A `do` expression consists of the symbol `do` followed by an arbitrary sequence 457 | of expressions separated by semicolons. 458 | 459 | For instance: 460 | 461 | ``` 462 | do 463 | alert "ok"; 464 | true. 465 | ``` 466 | 467 | The expressions in the sequence need have no typing relationship to each other 468 | and the type of the whole expression is simply the type of the last expression 469 | in the sequence. 470 | 471 | This can be useful when describing a sequence of events or effectful procedures 472 | that need to happen, without (for instance) constructing a boolean expression 473 | by joining that sequence with `and`s. 474 | 475 | ## Binding 476 | 477 | The Pantagruel interpreter evaluates a program for the purpose of 478 | enforcing Pantagruel's **binding** rules. To sum them up, they are: 479 | 480 | 1. Any symbol referred to in a chapter head must be bound by the end of that 481 | head. 482 | 2. Any symbol referred to in a chapter body must be bound by the end of the 483 | body of the *next* chapter. 484 | 485 | This structure is crucial in establishing the Pantagruel style of 486 | specification, where new terms are introduced so as to provide refinement for 487 | known terms, eg: 488 | 489 | ```pantagruel 490 | pred n:Nat. 491 | --- 492 | pred n = is_even? n and n > 5. 493 | 494 | where 495 | 496 | is_even? n:Nat => Bool. 497 | --- 498 | is_even? 0. 499 | ~(is_even? 1). 500 | is_even? n <-> is_even? (n - 2). 501 | ``` 502 | 503 | This example consists of two chapters, the first introducing a procedure `pred` 504 | and establishing some facts about it; the second glosses the terminology 505 | referred to in the facts. 506 | 507 | It describes the behavior of a predicate as checking `is_even?` and `> 5`. It 508 | then goes on in the next chapter to fill in what `is_even?` involves. This 509 | allows it to be defined in context; if a symbol had to be defined before it was 510 | used, as is often the case in programming languages, the narrative thread of 511 | increasing detail would be lost and specifications would be all preamble. 512 | 513 | ### Binding Forms 514 | 515 | Symbols are bound into the program environment in one of two ways: either 516 | they're built into the language, or they're introduced with one of a 517 | few specific forms. 518 | 519 | #### Procedure declarations 520 | 521 | When a procedure is declared, the name of the procedure is bound into the 522 | environment, as are the names of the variables the procedure takes. 523 | 524 | ``` 525 | f x:Y, x > z => a 526 | * * 527 | ``` 528 | 529 | #### Domain aliases 530 | 531 | When a domain alias is introduced, the name of the alias is bound into the 532 | environment. 533 | ``` 534 | D = X 535 | * 536 | ``` 537 | 538 | In the case of these chapter head statements, all other symbol positions 539 | must be bound by the end of the subchapter. 540 | 541 | #### Quantifications 542 | 543 | Expressions within quantifications have similar binding behavior as procedures. 544 | 545 | ``` 546 | all x: Y, x > z ... f x 547 | * 548 | ``` 549 | 550 | #### Binding Operators 551 | 552 | A symbol can be bound with `:` to give it the type of the domain on the right 553 | of the operator: 554 | 555 | ``` 556 | all x: Nat ... x. 557 | ``` 558 | 559 | `x` is of the type `Nat`. 560 | 561 | ## Types 562 | 563 | Every expression in a Pantagruel document has a type. The type of an expression 564 | is the domain to which the values it produces belong. 565 | 566 | ### Static forms 567 | 568 | #### Sets and sequences 569 | 570 | The type of any expression `[e]` is `sequence of (type of e)`, and the type of 571 | `{e}` is `set of (type of e)`. 572 | 573 | The type of `{v1, v2, v3}` is the sum of the types of values `v1, v2, v3`. 574 | 575 | Similarly, the type of `D1 + D2` is the sum of the domains `D1` and `D2`. 576 | 577 | #### Declarations 578 | 579 | The type of a procedure declaration is a procedure type, typed by all the 580 | arguments and the codomain of the function (the part to the right of the `=>`). 581 | 582 | If a procedure has no `=>`, its codomain is `Void`. 583 | 584 | For bare declarations, with no arguments or `=>`: 585 | 586 | If the symbol begins with a lower-case letter, it will be typed as a 0-argument 587 | `Void` function. 588 | 589 | If it begins with an upper case letter, it will be typed as a domain. 590 | 591 | ### Expressions 592 | 593 | #### Singletons 594 | 595 | If a procedure is declared with some codomain and no arguments, then a 596 | reference to that procedure is typed as its codomain. This lets us denote 597 | singleton values as procedures. For instance: 598 | 599 | ``` 600 | User. 601 | nobody => User. 602 | --- 603 | nobody. 604 | ``` 605 | 606 | The type of `nobody` in this chapter body is `User`. 607 | 608 | #### Application 609 | 610 | ##### Procedure application 611 | 612 | The type of the application of a procedure to its arguments is the codomain of 613 | that procedure. 614 | 615 | ##### Sequence application 616 | 617 | The application of a sequence to a value of the type contained by the sequence 618 | is typed as getting the index of that value. For instance: 619 | 620 | ``` 621 | User. 622 | users => [User]. 623 | admin => User. 624 | --- 625 | users admin. 626 | ``` 627 | 628 | This is interpreted as getting the index of `admin` within `users` and so is 629 | typed as `Nat0`. 630 | 631 | The application of a sequence to some integer is typed as indexing within that 632 | sequence. For instance: 633 | 634 | ``` 635 | User. 636 | users => [User]. 637 | --- 638 | users 0. 639 | ``` 640 | 641 | This is interpreted as getting the 0th element of `users`. 642 | 643 | The above applies to strings as well, where the element domain can be either 644 | `String` or `Char`. 645 | 646 | #### Booleans 647 | 648 | The type of a boolean operation is `Bool`. Boolean arguments are checked for 649 | unification (see below). 650 | 651 | #### Comparisons 652 | 653 | The type of a comparison operation is `Bool`. Comparison arguments are checked 654 | for unification (see below). 655 | 656 | #### `in` 657 | 658 | The type of the `in` operator is `Bool`. The righthand operand must be either a 659 | set or sequence (including strings), and the lefthand operator must be 660 | unifiable (see below) with the inner type of the right. 661 | 662 | #### `#` 663 | 664 | The type of the `#` unary operator is `Nat0`. The operand must be either a set 665 | or sequence. 666 | 667 | #### Other Binary Operators 668 | 669 | The type of an arithmetic binary operation is the unification of the two sides 670 | (see below). 671 | 672 | #### Cases 673 | 674 | The type of a case expression is the unification of the types of all its 675 | expressions all its branches (see below). 676 | 677 | If there is expression between `case` and `...`, then the document checker will 678 | additionally check that that expression's type can be unified with the types of 679 | the patterns of all its branches. 680 | 681 | ### Type Unification 682 | 683 | Pantagruel has a type system that is somewhat more lenient than those found in 684 | ordinary programming languages. Simply put, the *unification* of any two types 685 | is the **nearest common ancestor** they share in their type hierarchies. 686 | 687 | For instance: 688 | 689 | The unification of `Nat` and `Nat` is `Nat`. 690 | 691 | The unification of `Nat` and `Nat0` is `Nat0`; `Nat0` contains all the values 692 | in `Nat0`. 693 | 694 | The unification of `Bool` and `Char` is `Nat0`. See the full type hierarchy 695 | diagram below. 696 | 697 | The domain `Any` contains all other types. Therefore: 698 | 699 | The unification of `Bool` and `Any` is `Any`. 700 | 701 | The unification of some user-declared domain `Foo` and `Any` is `Any`. 702 | 703 | However: non-Any types which only share `Any` as an ancestor type are *not* 704 | unifiable. Thus: 705 | 706 | There is no unification of `Real` and `String`. 707 | 708 | There is no unification of some user-declared domain `Foo` and `Nat`. 709 | 710 | It's important to note that these rules allow operations which would be 711 | disallowed in standard programming language type systems. For instance, 712 | 713 | ``` 714 | inc: Nat => Nat. 715 | --- 716 | inc 0. 717 | ``` 718 | 719 | is a valid Pantagruel document. While 0 is not a member of the set of natural 720 | numbers, it is unifiable with them. On the other hand, 721 | 722 | ``` 723 | inc: Nat => Nat. 724 | --- 725 | inc "ok". 726 | ``` 727 | 728 | produces a type error: the only shared ancestor between `String` and `Nat` is 729 | `Any`. 730 | 731 | These rules have been chosen to produce the greatest number of helpful type 732 | errors while making sure to err on the side of unintrusiveness. The purpose of 733 | the Pantagruel type system is not to prevent illegal runtime operations; thus, 734 | we don't want document authors to ever feel that they are "fighting the type 735 | system" in order to express themselves. 736 | 737 | ### Type Hierarchy 738 | 739 | The following domains are included in the base environment. 740 | 741 | ``` 742 | Any__________________ 743 | | \ \ \ \ 744 | Real Domain String Date Void 745 | | 746 | Rat 747 | | 748 | Int 749 | | 750 | Nat0 751 | / | 752 | Bool Nat 753 | | 754 | Char 755 | ``` 756 | 757 | ### Type Errors 758 | 759 | To type-check a document, the Pantagruel checker attempts to determine the type 760 | of each top-level statement in order. If any expression either: 761 | 762 | - Can't be fully resolved due to a type unification failure anywhere inside the 763 | expression; 764 | - Fails one of the special-case type checks noted above (eg., checking that 765 | the operand of `#` is a container type) 766 | 767 | Then the checker will emit a type error and the document will fail the check. 768 | --------------------------------------------------------------------------------