Repository: ytakano/blisp Branch: master Commit: b0ae5499141f Files: 26 Total size: 603.8 KB Directory structure: gitextract_wiwtvaga/ ├── .gitignore ├── Cargo.toml ├── LICENSE ├── README.md ├── docs/ │ ├── Makefile │ ├── index.adoc │ ├── index.html │ ├── index.ja.adoc │ └── index.ja.html ├── embed_macro/ │ ├── Cargo.toml │ ├── LICENSE │ ├── README.md │ └── src/ │ └── lib.rs ├── history.md ├── specification/ │ ├── Makefile │ ├── language.md │ └── typing.tex ├── src/ │ ├── coq.rs │ ├── lib.rs │ ├── macro.rs │ ├── parser.rs │ ├── prelude.lisp │ ├── runtime.rs │ └── semantics.rs └── tests/ ├── embedded.rs └── transpile.rs ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitignore ================================================ target/ Cargo.lock .DS_Store ================================================ FILE: Cargo.toml ================================================ [package] name = "blisp" version = "0.4.7" authors = ["Yuuki Takano ", "Fumiya Saito"] edition = "2021" description = "A lisp like statically typed programing language for no_std." repository = "https://github.com/ytakano/blisp" keywords = [ "no_std", "scripting", "scripting-engine", "scripting-language", "embedded", ] categories = ["no-std", "embedded"] license-file = "LICENSE" readme = "README.md" homepage = "https://ytakano.github.io/blisp/" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] blisp_embedded = "0.1" [dependencies.num-bigint] version = "0.4" default-features = false [dependencies.num-traits] version = "0.2" default-features = false features = ["libm"] [lib] crate-type = ["rlib"] ================================================ FILE: LICENSE ================================================ MIT License Copyright (c) 2020 Yuuki Takano , Fumiya Saito Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ================================================ FILE: README.md ================================================ # BLisp BLisp is a statically typed Lisp like programming language which adopts effect system for no_std environments. BLisp supports higher order RPC like higher order functions of functional programming languages. This repository provides only a library crate. Please see [blisp-repl](https://github.com/ytakano/blisp-repl) to use BLisp, and [baremetalisp](https://github.com/ytakano/baremetalisp) which is a toy OS. **[Homepage](https://ytakano.github.io/blisp/) is here.** ## Features - Algebraic data type - Generics - Hindley–Milner based type inference - Effect system to separate side effects from pure functions - Hygienic macro expansion for local binders introduced by macro templates - Big integer - Supporting no_std environments ## How to Use ```rust use blisp; fn main() { let code = "(export factorial (n) (Pure (-> (Int) Int)) (if (<= n 0) 1 (* n (factorial (- n 1)))))"; let exprs = blisp::init(code, vec![]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let e = "(factorial 10)"; blisp::eval(e, &ctx).unwrap(); } ``` If Rust compiler or linker says warning of fmod, please add fmod manually as follows. ```rust #[no_mangle] extern "C" fn fmod(x: f64, y: f64) -> f64 { libm::fmod(x, y) } ``` Cargo.toml ```toml [dependencies.blisp] version = "0.4" ``` ## Examples ```lisp "Hello, World!" ; "Hello, World!" (+ 0x10 0x20) ; 48 (+ 0b111 0b101) ; 12 (+ 0o777 0o444) ; 803 (car '(1 2 3)) ; (Some 1) (cdr '(1 2 3)) ; '(2 3) (map (lambda (x) (* x 2)) '(8 9 10)) ; '(16 18 20) (fold + 0 '(1 2 3 4 5 6 7 8 9)) ; 45 (reverse '(1 2 3 4 5 6 7 8 9)) ; '(9 8 7 6 5 4 3 2 1) (filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9)) ; '(2 4 6 8) ``` ================================================ FILE: docs/Makefile ================================================ all: index.html index.ja.html index.html: index.adoc asciidoctor index.adoc index.ja.html: index.ja.adoc asciidoctor index.ja.adoc ================================================ FILE: docs/index.adoc ================================================ = BLisp: A Statically Typed Lisp Like Language Yuuki Takano v0.4.0, 2023-02 :doctype: article :toc: :sectnums: :encoding: utf-8 :stem: latexmath :source-highlighter: pygments BLisp is a statically typed Lisp like programming language which adopts effect system for no_std environments. BLisp supports higher order RPC like higher order functions of functional programming languages. * https://github.com/ytakano/blisp[GitHub's Repository] * https://crates.io/crates/blisp[BLisp's crates.io] This repository provides only a library crate. Please see https://github.com/ytakano/blisp-repl[blisp-repl] to use BLisp, and https://github.com/ytakano/baremetalisp[baremetalisp] which is a toy OS. https://ytakano.github.io/blisp/index.ja.html[日本語版はこちら] .BLisp on no_std Environment image:https://cdn-ak.f.st-hatena.com/images/fotolife/y/ytakano/20210221/20210221155657.gif[BLisp on no_std Environment] == Features * Algebraic data type * Generics * Hindley–Milner based type inference * Effect system to separate side effects from pure functions * Big integer * Supporting no_std environments == Values .values [source, lisp] ---- `A` ; character literal "Hello" ; string literal 144 ; integer value 0xabcDEF ; hexadecimal 0o777 ; octal 0b1001 ; binary true ; boolean value false ; boolean value [true 10] ; tuple [] ; empty tuple '(1 2 3) ; list '() ; empty list, Nil ---- == Basic Types .types [source, lisp] ---- Char ; character String ; string Int ; signed integer Bool ; boolean '(Int) ; list of Int [Int Bool] ; tuple of Int and Bool (Pure (-> (Int Int) Bool)) ; Pure function, which takes 2 integers and return boolean value (IO (-> (Int) [])) ; IO function, which takes an integer and return [] ---- Pure and IO are function effects. In IO functions, both Pure and IO functions can be called. However, in Pure functions, calling only Pure functions is permitted. == Function Definition Functions can be defined by defun or export. "defun" defines a local function which cannot be called from Rust's eval function. Suppose following 2 functions. .defun [source, lisp] ---- (defun double (x) ; function name is "double" and "x" is an argument (Pure (-> (Int) Int)) ; function Type (* 2 x)) ; function body ---- .export [source, lisp] ---- (export quad (x) ; function name is "quad" and "x" is an argument (Pure (-> (Int) Int)) ; function Type (double (double x))) ; function body ---- double cannot be called from Rust's eval, but can be called from internally defined functions. quad can be called from Rust's eval, and it calls double internally. This is the code what actually do in Rust. .Rust's eval [source, rust] ---- use blisp; fn eval(e: &str, ctx: &blisp::semantics::Context) { // evaluate expressions let exprs = match blisp::eval(e, ctx) { Ok(es) => es, Err(err) => { println!("error:{}:{}: {}", err.pos.line, err.pos.column, err.msg); return; } }; for r in exprs { match r { Ok(msg) => { println!("{}", msg); } Err(msg) => { println!("error: {}", msg); } } } } fn main() { // internal code let code = " (defun double (x) ; function name is double and x is an argument (Pure (-> (Int) Int)) ; function Type (* 2 x)) ; function body (export quad (x) ; function name is quad and x is an argument (Pure (-> (Int) Int)) ; function Type (double (double x))) ; function body "; let exprs = blisp::init(code, vec![]).unwrap(); let ctx = blisp::typing(&exprs).unwrap(); let e = "(double 10) ; error"; eval(e, &ctx); let e = "(quad 10) ; OK"; eval(e, &ctx); } ---- This code output as follows. error:0:1: Typing Error: double is not defined 40 == Arithmetic Operations .basic [source, lisp] ---- ; (Pure (-> (Int Int) Int)) (+ 10 20) (- 30 40) (* 6 100) (/ 100 2) (% 10 3) ---- == Boolean Operations .logical [source, lisp] ---- ; (Pure (-> (Bool Bool) Bool)) (and true false) (or true false) (xor true false) ---- .negation [source, lisp] ---- ; (Pure (-> (Bool) Bool)) (not true) ---- == Comparison =, !=, <, >, \<=, >= can be used for 2 values whose types are same. .comparison between 2 values whose types are same [source, lisp] ---- ; (Pure (-> (t t) Bool)) (= 4 4) ; true (!= 4 4) ; false (= "Hello" "Hello") ; true (= (Some 1) (Some 2)) ; false (< 6 7) (> 6 7) (<= 30 40) (>= 30 40) (< "Hello" "World") (<= (Some 1) (Some 2)) ---- _eq_, _neq_, _lt_, _gt_, _leq_, _geq_ can be used for any 2 values .comparison between any 2 values [source, lisp] ---- ; (Pure (-> (t1 t1) Bool)) (geq (Some 1) "Hello") ; (Some 1) is greater than or qeual to "Hello" (eq "Hello" 100) ; Is "Hello" qeual to 100? (neq "Hello" 100) ; Is "Hello" not equal to 100? (lt 100 (Some 20)) ; Is 100 less than (Some 20)? (gt 200 "Hello") ; Is 200 greater than "Hello" ---- == Bitwise Operations [source, lisp] ---- (band 1 0) ; bitwise and (band 1 1) ; bitwise and (bor 1 0) ; bitwise or (bor 1 1) ; bitwise or (bxor 1 0) ; bitwise xor ---- .bit shift [source, lisp] ---- ; (Pure (-> (Int Int) (Option Int))) (<< 8 4) ; (Some 128) (>> 128 4) ; (Some 8) (>> -128 4) ; (Some -8) ---- If 2nd argument is greater or equal to 2^64^, then these function return None. == Mathematical Operations [source, lisp] ---- ; (Pure (-> (Int Int) (Option Int))) (pow 10 20) ; (Some 100000000000000000000) ; (Pure (-> (Int) (Option Int))) (sqrt 16) ; (Some 4) ---- If _pow_'s exponent portion is greater or equal to 2^32^, then _pow_ returns None. If _sqrt_'s argument is less than 0. then _sqrt_ returns None. == Algebraic Data Type Algebraic data type can be defined as follows. [source, lisp] ---- ; in BLisp (data Cardinal ; type name East ; value North ; value West ; value South) ; value ---- Type name's and its value's first character must be uppercase. This is equivalent to Rust's following code. [source, rust] ---- // in Rust enum Cardinal { East, North, West, South } ---- Each element can have values as follows. [source, lisp] ---- ; in BLisp (data Dim2 (Dim2 Int Int)) ; Dim2 has integers ---- Dim2 can be instantiated as follows. [source, lisp] ---- (Dim2 10 20) ---- This type is equivalent to Rust's following type. [source, rust] ---- // in Rust use num_bigint::BigInt; enum Dim2 { Dim2(BigInt, BigInt) } ---- == Generics Option and Result types are defined internally. [source, lisp] ---- (data (Option t) (Some t) None) (data (Result t e) (Ok t) (Err e)) ---- _t_ and _e_ are type variables. This code is equivalent to Rust's following code. [source, rust] ---- // in Rust enum Option { Some(T), None, } enum Result { Ok(T), Err(E), } ---- List type is a built-in type as follows. [source, lisp] ---- (data (List t) (Cons t (List t)) Nil) ---- So, following 2 lists are equivalent. [source, lisp] ---- (Cons 1 (Cons 2 (Cons 3 Nil))) '(1 2 3) ---- == Generic Function _car_ and _cdr_ are internally defined generic functions. These definitions are as follows. [source, lisp] ---- (export car (x) (Pure (-> ('(t)) (Option t))) (match x ((Cons n _) (Some n)) (_ None))) (export cdr (x) (Pure (-> ('(t)) '(t))) (match x ((Cons _ l) l) (_ '()))) ---- _t_ is a type variable. These functions can be used as follows. [source, lisp] ---- (car '(3 8 9)) ; returns (Some 3) (cdr '(8 10 4)) ; returns '(10 4) ---- Normal and type variables' first character must be lowercase. == If Expression Straightforward. [source, lisp] ---- (if (< 10 20) '(1 2 3) '()) ---- == Match Expression A list can be matched as follows. [source, lisp] ---- (match '(1 2 3) ((Cons n _) n) ('() 0)) ---- The expression (Cons n _) is a pattern. If the pattern is matched to '(1 2 3), 1 is assigned to a variable _n_. Then, _n_, namely 1, is returned. This is an example of pattern matching of tuple. [source, lisp] ---- (match [1 3] ([x y] [y x])) ---- This code swap 1st and 2nd elements of the tuple. Integer values can be also used for pattern matching. [source, lisp] ---- (match 20 (20 true) (_ false)) ---- More complex example is a as follows. [source, lisp] ---- (match [(Some 10) true] ([(Some 10) false] 1) ([(Some 10) true] 2) (_ 0)) ---- BLisp checks exhaustively of pattern. So, following code will be rejected. [source, lisp] ---- (match '(1 2) ('() 0)) ---- == Let Expression Let expression is used to bind variables as follows. [source, lisp] ---- (let ((x 10) (y 20)) ; x is 10, y is 20 (* x y)) (let ((x 10) (x (* x x)) (x (* x x))) ; x = 10, x = x * x, x = x * x x) ---- Destructuring can be also performed as follows. [source, lisp] ---- (let (((Some x) (Some 10))) ; x is 10 (* x 2)) (let (([x y] [10 20])) ; x is 10, y is 20 (* x y)) ---- == Lambda Expression Lambda expression is defined as follows. [source, lisp] ---- (lambda (x y) (* x y)) ---- This lambda takes 2 integers and return the multiplication. Applying arguments to this is simple as follows. [source, lisp] ---- ((lambda (x y) (* x y)) 10 20) ---- Every lambda expression is Pure. IO functions cannot be called in any lambda expressions. _map_ and _fold_ functions are internally defined as follows. [source, lisp] ---- (export map (f x) (Pure (-> ((Pure (-> (a) b)) '(a)) '(b))) (match x ((Cons h l) (Cons (f h) (map f l))) (_ '()))) (export fold (f init x) (Pure (-> ((Pure (-> (a b) b)) b '(a)) b)) (match x ((Cons h l) (fold f (f h init) l)) (_ init))) ---- _map_ can be used to apply functions to elements of a list as follows. [source, lisp] ---- ; square each element (let ((l '(1 2 3)) (f (lambda (x) (* x x)))) (map f l)) ---- _fold_ can be used to calculate over elements of a list. For example, summation can be computed as follows. [source, lisp] ---- ; summation (let ((l '(20 50 60)) (f (lambda (x y) (+ x y)))) (fold f 0 l)) ; 0 is an initial value ---- Of course, this can be written as follows. [source, lisp] ---- ; summation (fold + 0 '(20 50 60)) ---- == Macro Macros can be defined by `macro`. Each rule consists of a pattern and a template, and the first matching rule is expanded. [source, lisp] ---- (macro add ((add $e1 $e2) (+ $e1 $e2)) ((add $e1 $e2 $e3 ...) (+ $e1 (add $e2 $e3 ...)))) ---- Identifiers beginning with `$` are pattern variables. They are substituted with the expressions matched at the call site. `...` can be used after a pattern variable or a template fragment to match and expand the remaining arguments. [source, lisp] ---- (add 1 2) ; 3 (add 1 2 3 4 5) ; 15 ---- Macros can also generate expressions that introduce local bindings. For example, a temporary variable can be introduced in a lambda expression. [source, lisp] ---- (macro with_tmp ((_ $x) ((lambda (tmp) (+ tmp $x)) 1))) (export test (tmp) (Pure (-> (Int) Int)) (with_tmp tmp)) ---- BLisp macros are hygienic for local binders introduced by macro templates. Variables introduced by `lambda` arguments, `let` bindings, and `match` pattern variables are renamed to fresh internal names during expansion, so they do not capture variables from the call site. Top-level names such as `defun`, `export`, and `data` definitions are not renamed automatically. == String and Character _chars_ converts String to (List Char). [source, lisp] ---- ; (Pure (-> (String) (List Char))) (chars "Hello") ; '(`H` `e` `l` `l` `o`) ---- _str_ converts (List Char) to String. [source, lisp] ---- ; (Pure (-> ((List Char)) String)) (str '(`H` `e` `l` `l` `o`)) ; "Hello" ---- == Foreign Function Interface _blisp::embedded_ is a macro for foreign function interface. By using this, Rust's functions can be called from BLisp easily. For example, first of all, define a Rust function as follows. [source, rust] ---- use blisp::embedded; use num_bigint::{BigInt, ToBigInt}; #[embedded] fn add_four_ints(a: BigInt, b: (BigInt, BigInt), c: Option) -> Result { let mut result = a + b.0 + b.1; if let Some(n) = c { result += n; } Ok(result) } ---- _blisp::embedded_ macro generates a type definition for FFI. This function can be called from BLisp as follows. [source, lisp] ---- (export call_add_four_ints (n) (IO (-> ((Option Int)) (Result Int String))) (add_four_ints 1 [2 3] n)) ---- To register FFIs, a vector of the definition generated by _embedded_ macro must be passed to _blisp::init_ as follows. [source, rust] ---- // add_for_ints let code = "(export call_add_four_ints (n) (IO (-> ((Option Int)) (Result Int String))) (add_four_ints 1 [2 3] n) )"; let exprs = blisp::init(code, vec![Box::new(AddFourInts)]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let result = blisp::eval("(call_add_four_ints (Some 4))", &ctx).unwrap(); ---- The function name is _add_four_ints_, then _AddFourInts_, which is camel case, must be passed to _blisp::init_ capsulated by _Box_ and _Vec_. FFIs in Rust take and return only types described as follows. Other types, like _Vec_, are not supported, but _Vec>_ is accepted. Types between BLisp and Rust are automatically converted by the function generated by _embedded_ macro. .Type Conversion between BLisp and Rust |=== |BLisp | Rust |_Int_ | _BigInt_ |_Bool_ | _bool_ |_Char_ | _char_ |_String_ | _String_ |_'(T)_ | _Vec_ |_[T0, T1]_ | _(T0, T1)_ |_(Option T)_ | _Option_ |_(Result T E)_ | _Result_ |=== Note that every FFI is treated as IO functions. == Transpilation to Coq (Experimental) BLisp experimentally implements a transpiler to Coq. It can be invoked by calling _blisp::transpile_ as follows. [source, coq] ---- let expr = " (defun snoc (l y) (Pure (-> ( '(t) t) '(t))) (match l (nil (Cons y nil)) ((Cons h b) (Cons h (snoc b y))))) (defun rev (l) (Pure (-> ( '(t)) '(t))) (match l (nil nil) ((Cons h t) (snoc (rev t) h)))) "; let exprs = blisp::init(expr, vec![]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); println!("{}", blisp::transpile(&ctx)); ---- This outputs Coq code as follows. It includes as well as the prelude of BLisp. [source, coq] ---- Require Import ZArith. Require Import Coq.Lists.List. Inductive Option (t: Type): Type := | Some (x0: t) | None. Arguments Some{t}. Arguments None{t}. Inductive Result (t e: Type): Type := | Ok (x0: t) | Err (x0: e). Arguments Ok{t e}. Arguments Err{t e}. Definition car {t: Type} (x: list t): Option t := match x with | (cons n _) => (Some n) | _ => (None) end. Definition cdr {t: Type} (x: list t): list t := match x with | (cons _ l) => l | _ => nil end. Definition filter {t: Type} (f: t -> bool) (x: list t): list t := (reverse (filter' f x nil ) ). Fixpoint filter' {t: Type} (f: t -> bool) (x l: list t): list t := match x with | (cons h a) => match (f h ) with | true => (filter' f a (cons h l) ) | false => (filter' f a l ) end | _ => l end. Fixpoint fold {a b: Type} (f: a -> b -> b) (init: b) (x: list a): b := match x with | (cons h l) => (fold f (f h init ) l ) | _ => init end. Fixpoint map {a b: Type} (f: a -> b) (x: list a): list b := match x with | (cons h l) => (cons (f h ) (map f l )) | _ => nil end. Fixpoint rev {t: Type} (l: list t): list t := match l with | nil => nil | (cons h t) => (snoc (rev t ) h ) end. Definition reverse {t: Type} (x: list t): list t := (reverse' x nil ). Fixpoint reverse' {t: Type} (x l: list t): list t := match x with | (cons h a) => (reverse' a (cons h l) ) | _ => l end. Fixpoint snoc {t: Type} (l: list t) (y: t): list t := match l with | nil => (cons y nil) | (cons h b) => (cons h (snoc b y )) end. ---- Not that this transpiler is experimental. So, Coq cannot interpret some outputs. Please fix it manually when you encounter that situation. It is probably easy. == Examples === Reverse _reverse_ is a internally defined function. It reverses order of a list. [source, lisp] ---- (reverse '(1 2 3 4 5 6 7 8 9)) ---- This outputs as follows. '(9 8 7 6 5 4 3 2 1) === Filter _filter_ is a internally defined function. It filters the elements in a list. [source, lisp] ---- (filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9)) ---- This outputs as follows. '(2 4 6 8) _filter_'s type is as follows. [source, lisp] ---- (Pure (-> ((Pure (-> (t) Bool)) ; take a function '(t)) ; take a list '(t))) ; return a list ---- === Factorial Tail call factorial can be coded as follows. [source, lisp] ---- (export factorial (n) (Pure (-> (Int) Int)) (fact n 1)) (defun fact (n total) (Pure (-> (Int Int) Int)) (if (<= n 0) total (fact (- n 1) (* n total)))) ---- This function can be called as follows. >> (factorial 10) 3628800 >> >> (factorial 1000) 402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 >> >> (factorial 100) 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000 >> >> (factorial 500) 1220136825991110068701238785423046926253574342803192842192413588385845373153881997605496447502203281863013616477148203584163378722078177200480785205159329285477907571939330603772960859086270429174547882424912726344305670173270769461062802310452644218878789465754777149863494367781037644274033827365397471386477878495438489595537537990423241061271326984327745715546309977202781014561081188373709531016356324432987029563896628911658974769572087926928871281780070265174507768410719624390394322536422605234945850129918571501248706961568141625359056693423813008856249246891564126775654481886506593847951775360894005745238940335798476363944905313062323749066445048824665075946735862074637925184200459369692981022263971952597190945217823331756934581508552332820762820023402626907898342451712006207714640979456116127629145951237229913340169552363850942885592018727433795173014586357570828355780158735432768888680120399882384702151467605445407663535984174430480128938313896881639487469658817504506926365338175055478128640000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ================================================ FILE: docs/index.html ================================================ BLisp: A Statically Typed Lisp Like Language

BLisp is a statically typed Lisp like programming language which adopts effect system for no_std environments. BLisp supports higher order RPC like higher order functions of functional programming languages.

This repository provides only a library crate. Please see blisp-repl to use BLisp, and baremetalisp which is a toy OS.

日本語版はこちら

BLisp on no_std Environment

BLisp on no_std Environment

1. Features

  • Algebraic data type

  • Generics

  • Hindley–Milner based type inference

  • Effect system to separate side effects from pure functions

  • Big integer

  • Supporting no_std environments

2. Values

values
`A`       ; character literal
"Hello"   ; string literal
144       ; integer value
0xabcDEF  ; hexadecimal
0o777     ; octal
0b1001    ; binary
true      ; boolean value
false     ; boolean value
[true 10] ; tuple
[]        ; empty tuple
'(1 2 3)  ; list
'()       ; empty list, Nil

3. Basic Types

types
Char       ; character
String     ; string
Int        ; signed integer
Bool       ; boolean
'(Int)     ; list of Int
[Int Bool] ; tuple of Int and Bool
(Pure (-> (Int Int) Bool)) ; Pure function, which takes 2 integers and return boolean value
(IO (-> (Int) [])) ; IO function, which takes an integer and return []

Pure and IO are function effects. In IO functions, both Pure and IO functions can be called. However, in Pure functions, calling only Pure functions is permitted.

4. Function Definition

Functions can be defined by defun or export. "defun" defines a local function which cannot be called from Rust’s eval function.

Suppose following 2 functions.

defun
(defun double (x)         ; function name is "double" and "x" is an argument
    (Pure (-> (Int) Int)) ; function Type
    (* 2 x))              ; function body
export
(export quad (x)          ; function name is "quad" and "x" is an argument
    (Pure (-> (Int) Int)) ; function Type
    (double (double x)))  ; function body

double cannot be called from Rust’s eval, but can be called from internally defined functions. quad can be called from Rust’s eval, and it calls double internally.

This is the code what actually do in Rust.

Rust’s eval
use blisp;

fn eval(e: &str, ctx: &blisp::semantics::Context) {
    // evaluate expressions
    let exprs = match blisp::eval(e, ctx) {
        Ok(es) => es,
        Err(err) => {
            println!("error:{}:{}: {}", err.pos.line, err.pos.column, err.msg);
            return;
        }
    };

    for r in exprs {
        match r {
            Ok(msg) => {
                println!("{}", msg);
            }
            Err(msg) => {
                println!("error: {}", msg);
            }
        }
    }
}

fn main() {
    // internal code
    let code = "
(defun double (x)         ; function name is double and x is an argument
    (Pure (-> (Int) Int)) ; function Type
    (* 2 x))              ; function body

(export quad (x)          ; function name is quad and x is an argument
    (Pure (-> (Int) Int)) ; function Type
    (double (double x)))  ; function body
";
    let exprs = blisp::init(code, vec![]).unwrap();
    let ctx = blisp::typing(&exprs).unwrap();

    let e = "(double 10) ; error";
    eval(e, &ctx);

    let e = "(quad 10) ; OK";
    eval(e, &ctx);
}

This code output as follows.

error:0:1: Typing Error: double is not defined
40

5. Arithmetic Operations

basic
; (Pure (-> (Int Int) Int))
(+ 10 20)
(- 30 40)
(* 6 100)
(/ 100 2)
(% 10 3)

6. Boolean Operations

logical
; (Pure (-> (Bool Bool) Bool))
(and true false)
(or true false)
(xor true false)
negation
; (Pure (-> (Bool) Bool))
(not true)

7. Comparison

=, !=, <, >, <=, >= can be used for 2 values whose types are same.

comparison between 2 values whose types are same
; (Pure (-> (t t) Bool))
(= 4 4)               ; true
(!= 4 4)              ; false
(= "Hello" "Hello")   ; true
(= (Some 1) (Some 2)) ; false
(< 6 7)
(> 6 7)
(<= 30 40)
(>= 30 40)
(< "Hello" "World")
(<= (Some 1) (Some 2))

eq, neq, lt, gt, leq, geq can be used for any 2 values

comparison between any 2 values
; (Pure (-> (t1 t1) Bool))
(geq (Some 1) "Hello") ; (Some 1) is greater than or qeual to "Hello"
(eq "Hello" 100)       ; Is "Hello" qeual to 100?
(neq "Hello" 100)      ; Is "Hello" not equal to 100?
(lt 100 (Some 20))     ; Is 100 less than (Some 20)?
(gt 200 "Hello")       ; Is 200 greater than "Hello"

8. Bitwise Operations

(band 1 0) ; bitwise and
(band 1 1) ; bitwise and
(bor 1 0)  ; bitwise or
(bor 1 1)  ; bitwise or
(bxor 1 0) ; bitwise xor
bit shift
; (Pure (-> (Int Int) (Option Int)))
(<< 8 4)   ; (Some 128)
(>> 128 4) ; (Some 8)
(>> -128 4) ; (Some -8)

If 2nd argument is greater or equal to 264, then these function return None.

9. Mathematical Operations

; (Pure (-> (Int Int) (Option Int)))
(pow 10 20) ; (Some 100000000000000000000)

; (Pure (-> (Int) (Option Int)))
(sqrt 16)   ; (Some 4)

If pow's exponent portion is greater or equal to 232, then pow returns None.

If sqrt's argument is less than 0. then sqrt returns None.

10. Algebraic Data Type

Algebraic data type can be defined as follows.

; in BLisp
(data Cardinal ; type name
    East       ; value
    North      ; value
    West       ; value
    South)     ; value

Type name’s and its value’s first character must be uppercase. This is equivalent to Rust’s following code.

// in Rust
enum Cardinal {
    East,
    North,
    West,
    South
}

Each element can have values as follows.

; in BLisp
(data Dim2
    (Dim2 Int Int)) ; Dim2 has integers

Dim2 can be instantiated as follows.

(Dim2 10 20)

This type is equivalent to Rust’s following type.

// in Rust
use num_bigint::BigInt;
enum Dim2 {
    Dim2(BigInt, BigInt)
}

11. Generics

Option and Result types are defined internally.

(data (Option t)
    (Some t)
    None)

(data (Result t e)
    (Ok t)
    (Err e))

t and e are type variables. This code is equivalent to Rust’s following code.

// in Rust
enum Option<T> {
    Some(T),
    None,
}

enum Result<T, E> {
    Ok(T),
    Err(E),
}

List type is a built-in type as follows.

(data (List t)
    (Cons t (List t))
    Nil)

So, following 2 lists are equivalent.

(Cons 1 (Cons 2 (Cons 3 Nil)))
'(1 2 3)

12. Generic Function

car and cdr are internally defined generic functions. These definitions are as follows.

(export car (x) (Pure (-> ('(t)) (Option t)))
    (match x
        ((Cons n _) (Some n))
        (_ None)))

(export cdr (x) (Pure (-> ('(t)) '(t)))
    (match x
        ((Cons _ l) l)
        (_ '())))

t is a type variable. These functions can be used as follows.

(car '(3 8 9))  ; returns (Some 3)
(cdr '(8 10 4)) ; returns '(10 4)

Normal and type variables' first character must be lowercase.

13. If Expression

Straightforward.

(if (< 10 20)
    '(1 2 3)
    '())

14. Match Expression

A list can be matched as follows.

(match '(1 2 3)
    ((Cons n _) n)
    ('() 0))

The expression

(Cons n _)

is a pattern. If the pattern is matched to '(1 2 3), 1 is assigned to a variable n. Then, n, namely 1, is returned.

This is an example of pattern matching of tuple.

(match [1 3]
    ([x y] [y x]))

This code swap 1st and 2nd elements of the tuple.

Integer values can be also used for pattern matching.

(match 20
    (20 true)
    (_ false))

More complex example is a as follows.

(match [(Some 10) true]
    ([(Some 10) false] 1)
    ([(Some 10) true] 2)
    (_ 0))

BLisp checks exhaustively of pattern. So, following code will be rejected.

(match '(1 2)
    ('() 0))

15. Let Expression

Let expression is used to bind variables as follows.

(let ((x 10) (y 20)) ; x is 10, y is 20
    (* x y))

(let ((x 10) (x (* x x)) (x (* x x))) ; x = 10, x = x * x, x = x * x
    x)

Destructuring can be also performed as follows.

(let (((Some x) (Some 10))) ; x is 10
    (* x 2))

(let (([x y] [10 20])) ; x is 10, y is 20
    (* x y))

16. Lambda Expression

Lambda expression is defined as follows.

(lambda (x y) (* x y))

This lambda takes 2 integers and return the multiplication. Applying arguments to this is simple as follows.

((lambda (x y) (* x y)) 10 20)

Every lambda expression is Pure. IO functions cannot be called in any lambda expressions.

map and fold functions are internally defined as follows.

(export map (f x) (Pure (-> ((Pure (-> (a) b)) '(a)) '(b)))
    (match x
        ((Cons h l) (Cons (f h) (map f l)))
        (_ '())))

(export fold (f init x) (Pure (-> ((Pure (-> (a b) b)) b '(a)) b))
    (match x
        ((Cons h l) (fold f (f h init) l))
        (_ init)))

map can be used to apply functions to elements of a list as follows.

; square each element
(let ((l '(1 2 3))
      (f (lambda (x) (* x x))))
        (map f l))

fold can be used to calculate over elements of a list. For example, summation can be computed as follows.

; summation
(let ((l '(20 50 60))
      (f (lambda (x y) (+ x y))))
        (fold f 0 l)) ; 0 is an initial value

Of course, this can be written as follows.

; summation
(fold + 0 '(20 50 60))

17. Macro

Macros can be defined by macro. Each rule consists of a pattern and a template, and the first matching rule is expanded.

(macro add
    ((add $e1 $e2) (+ $e1 $e2))
    ((add $e1 $e2 $e3 ...) (+ $e1 (add $e2 $e3 ...))))

Identifiers beginning with $ are pattern variables. They are substituted with the expressions matched at the call site. …​ can be used after a pattern variable or a template fragment to match and expand the remaining arguments.

(add 1 2)         ; 3
(add 1 2 3 4 5)   ; 15

Macros can also generate expressions that introduce local bindings. For example, a temporary variable can be introduced in a lambda expression.

(macro with_tmp
    ((_ $x) ((lambda (tmp) (+ tmp $x)) 1)))

(export test (tmp) (Pure (-> (Int) Int))
    (with_tmp tmp))

BLisp macros are hygienic for local binders introduced by macro templates. Variables introduced by lambda arguments, let bindings, and match pattern variables are renamed to fresh internal names during expansion, so they do not capture variables from the call site. Top-level names such as defun, export, and data definitions are not renamed automatically.

18. String and Character

chars converts String to (List Char).

; (Pure (-> (String) (List Char)))
(chars "Hello") ; '(`H` `e` `l` `l` `o`)

str converts (List Char) to String.

; (Pure (-> ((List Char)) String))
(str '(`H` `e` `l` `l` `o`)) ; "Hello"

19. Foreign Function Interface

blisp::embedded is a macro for foreign function interface. By using this, Rust’s functions can be called from BLisp easily.

For example, first of all, define a Rust function as follows.

use blisp::embedded;
use num_bigint::{BigInt, ToBigInt};

#[embedded]
fn add_four_ints(a: BigInt, b: (BigInt, BigInt), c: Option<BigInt>) -> Result<BigInt, String> {
    let mut result = a + b.0 + b.1;
    if let Some(n) = c {
        result += n;
    }

    Ok(result)
}

blisp::embedded macro generates a type definition for FFI. This function can be called from BLisp as follows.

(export call_add_four_ints (n)
    (IO (-> ((Option Int)) (Result Int String)))
    (add_four_ints 1 [2 3] n))

To register FFIs, a vector of the definition generated by embedded macro must be passed to blisp::init as follows.

// add_for_ints
let code = "(export call_add_four_ints (n)
    (IO (-> ((Option Int)) (Result Int String)))
    (add_four_ints 1 [2 3] n)
)";
let exprs = blisp::init(code, vec![Box::new(AddFourInts)]).unwrap();
let ctx = blisp::typing(exprs).unwrap();
let result = blisp::eval("(call_add_four_ints (Some 4))", &ctx).unwrap();

The function name is add_four_ints, then AddFourInts, which is camel case, must be passed to blisp::init capsulated by Box and Vec.

FFIs in Rust take and return only types described as follows. Other types, like Vec<u64>, are not supported, but Vec<Option<bool>> is accepted. Types between BLisp and Rust are automatically converted by the function generated by embedded macro.

Table 1. Type Conversion between BLisp and Rust
BLisp Rust

Int

BigInt

Bool

bool

Char

char

String

String

'(T)

Vec<T>

[T0, T1]

(T0, T1)

(Option T)

Option<T>

(Result T E)

Result<T, E>

Note that every FFI is treated as IO functions.

20. Transpilation to Coq (Experimental)

BLisp experimentally implements a transpiler to Coq. It can be invoked by calling blisp::transpile as follows.

let expr = "
(defun snoc (l y)
(Pure (-> (
    '(t) t)
'(t)))
(match l
    (nil (Cons y nil))
    ((Cons h b) (Cons h (snoc b y)))))

(defun rev (l)
(Pure (-> (
    '(t))
'(t)))
(match l
    (nil nil)
    ((Cons h t) (snoc (rev t) h))))
    ";
let exprs = blisp::init(expr, vec![]).unwrap();
let ctx = blisp::typing(exprs).unwrap();

println!("{}", blisp::transpile(&ctx));

This outputs Coq code as follows. It includes as well as the prelude of BLisp.

Require Import ZArith.
Require Import Coq.Lists.List.

Inductive Option (t: Type): Type :=
| Some (x0: t)
| None.

Arguments Some{t}.
Arguments None{t}.

Inductive Result (t e: Type): Type :=
| Ok (x0: t)
| Err (x0: e).

Arguments Ok{t e}.
Arguments Err{t e}.

Definition car {t: Type} (x: list t): Option t :=
match x with
  | (cons n _) => (Some n)
  | _ => (None)
  end.

Definition cdr {t: Type} (x: list t): list t :=
match x with
  | (cons _ l) => l
  | _ => nil
  end.

Definition filter {t: Type} (f: t -> bool) (x: list t): list t :=
(reverse (filter' f x nil ) ).

Fixpoint filter' {t: Type} (f: t -> bool) (x l: list t): list t :=
match x with
  | (cons h a) => match (f h ) with
    | true => (filter' f a (cons h l) )
    | false => (filter' f a l )
    end
  | _ => l
  end.

Fixpoint fold {a b: Type} (f: a -> b -> b) (init: b) (x: list a): b :=
match x with
  | (cons h l) => (fold f (f h init ) l )
  | _ => init
  end.

Fixpoint map {a b: Type} (f: a -> b) (x: list a): list b :=
match x with
  | (cons h l) => (cons (f h ) (map f l ))
  | _ => nil
  end.

Fixpoint rev {t: Type} (l: list t): list t :=
match l with
  | nil => nil
  | (cons h t) => (snoc (rev t ) h )
  end.

Definition reverse {t: Type} (x: list t): list t :=
(reverse' x nil ).

Fixpoint reverse' {t: Type} (x l: list t): list t :=
match x with
  | (cons h a) => (reverse' a (cons h l) )
  | _ => l
  end.

Fixpoint snoc {t: Type} (l: list t) (y: t): list t :=
match l with
  | nil => (cons y nil)
  | (cons h b) => (cons h (snoc b y ))
  end.

Not that this transpiler is experimental. So, Coq cannot interpret some outputs. Please fix it manually when you encounter that situation. It is probably easy.

21. Examples

21.1. Reverse

reverse is a internally defined function. It reverses order of a list.

(reverse '(1 2 3 4 5 6 7 8 9))

This outputs as follows.

'(9 8 7 6 5 4 3 2 1)

21.2. Filter

filter is a internally defined function. It filters the elements in a list.

(filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9))

This outputs as follows.

'(2 4 6 8)

filter's type is as follows.

(Pure (->
    ((Pure (-> (t) Bool)) ; take a function
     '(t))                ; take a list
    '(t))) ; return a list

21.3. Factorial

Tail call factorial can be coded as follows.

(export factorial (n) (Pure (-> (Int) Int))
    (fact n 1))

(defun fact (n total) (Pure (-> (Int Int) Int))
    (if (<= n 0)
        total
        (fact (- n 1) (* n total))))

This function can be called as follows.

>> (factorial 10)
3628800
>>
>> (factorial 1000)
402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
>>
>> (factorial 100)
93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
>>
>> (factorial 500)
1220136825991110068701238785423046926253574342803192842192413588385845373153881997605496447502203281863013616477148203584163378722078177200480785205159329285477907571939330603772960859086270429174547882424912726344305670173270769461062802310452644218878789465754777149863494367781037644274033827365397471386477878495438489595537537990423241061271326984327745715546309977202781014561081188373709531016356324432987029563896628911658974769572087926928871281780070265174507768410719624390394322536422605234945850129918571501248706961568141625359056693423813008856249246891564126775654481886506593847951775360894005745238940335798476363944905313062323749066445048824665075946735862074637925184200459369692981022263971952597190945217823331756934581508552332820762820023402626907898342451712006207714640979456116127629145951237229913340169552363850942885592018727433795173014586357570828355780158735432768888680120399882384702151467605445407663535984174430480128938313896881639487469658817504506926365338175055478128640000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
================================================ FILE: docs/index.ja.adoc ================================================ = BLisp: Lispっぽい静的型付け言語 Yuuki Takano v0.4.0, 2023-02 :doctype: article :toc: :sectnums: :lang: ja :encoding: utf-8 :stem: latexmath :source-highlighter: pygments BLispは静的型付けされたLispライクなプログラミング言語で、no_std環境用のエフェクトシステムを採用しています。BLispは関数型プログラミング言語の高階関数のような高階のRPCをサポートしています。 * https://github.com/ytakano/blisp[GitHubリポジトリ] * https://crates.io/crates/blisp[BLispのcrates.io] 本リポジトリではライブラリクレートのみを提供しています。BLispを利用するには https://github.com/ytakano/blisp-repl[blisp-repl] か、おもちゃのOSである https://github.com/ytakano/baremetalisp[baremetalisp] を参照してください。 https://ytakano.github.io/blisp/[English version is here.] .no_stdで動くBLisp image:https://cdn-ak.f.st-hatena.com/images/fotolife/y/ytakano/20210221/20210221155657.gif[no_stdで動くBLisp] == 特徴 * 代数的データ型 * ジェネリクス * 型推論 * IOと純粋な関数を分離するためのエフェクトシステム * 多倍長整数 * no_std環境のサポート == 値 .values [source, lisp] ---- `A` ; 文字リテラル "Hello" ; 文字列リテラル 144 ; 整数値 0xabcDEF ; 16進数 0o777 ; 8進数 0b1001 ; 2進数 true ; 真偽値 false ; 真偽値 [true 10] ; タプル [] ; 空のタプル '(1 2 3) ; リスト '() ; 空のリスト、Nil ---- == 基本型 .types [source, lisp] ---- Char ; 文字型 String ; 文字列型 Int ; 整数型 Bool ; 真偽値型 '(Int) ; Int型のリスト型 [Int Bool] ; Int型とBool型のタプル型 (Pure (-> (Int Int) Bool)) ; Int型の値を2つとり、Bool型の値をリターンする純粋な関数 (IO (-> (Int) [])) ; Int型の値をとり[]をリターンするIOのある関数 ---- PureとIOは関数の効果です。IO関数内では、Pure関数とIO関数の両方を呼び出すことができます。しかし、Pure関数内では、Pure関数の呼び出しのみ許可されています。 == 関数定義 関数はdefunやexportで定義することができます。"defun"はRustのeval関数からは呼び出せないローカル関数を定義します。 以下の2つの関数があるとしましょう。 .defun [source, lisp] ---- (defun double (x) ; 関数名がdoubleでxは引数 (Pure (-> (Int) Int)) ; 関数の型 (* 2 x)) ; 関数の中身 ---- .export [source, lisp] ---- (export quad (x) ; 関数名がquadで引数はx (Pure (-> (Int) Int)) ; 関数の型 (double (double x))) ; 関数の中身 ---- doubleはRustのevalからは呼び出せませんが、内部で定義された関数からは呼び出せます。quadはRustのevalから呼び出すことができ、内部的にdoubleを呼び出します。 これはRustで実際に行うコードです。 .Rust's eval [source, rust] ---- use blisp; fn eval(e: &str, ctx: &blisp::semantics::Context) { // evaluate expressions let exprs = match blisp::eval(e, ctx) { Ok(es) => es, Err(err) => { println!("error:{}:{}: {}", err.pos.line, err.pos.column, err.msg); return; } }; for r in exprs { match r { Ok(msg) => { println!("{}", msg); } Err(msg) => { println!("error: {}", msg); } } } } fn main() { // internal code let code = " (defun double (x) ; 関数名がdoubleでxは引数 (Pure (-> (Int) Int)) ; 関数の型 (* 2 x)) ; 関数の中身 (export quad (x) ; 関数名がquadで引数はx (Pure (-> (Int) Int)) ; 関数の型 (double (double x))) ; 関数の中身 "; let exprs = blisp::init(code, vec![]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let e = "(double 10) ; エラー"; eval(e, &ctx); let e = "(quad 10) ; OK"; eval(e, &ctx); } ---- このコードは以下のように出力します。 error:0:1: Typing Error: double is not defined 40 == 算術演算 .基本 [source, lisp] ---- ; (Pure (-> (Int Int) Int)) (+ 10 20) (- 30 40) (* 6 100) (/ 100 2) (% 10 3) ---- == 真偽値演算 .logical [source, lisp] ---- ; (Pure (-> (Bool Bool) Bool)) (and true false) (or true false) (xor true false) ---- .negation [source, lisp] ---- ; (Pure (-> (Bool) Bool)) (not true) ---- == 比較演算 =, !=, <, >, \<=, >= といった関数は、同じ型の2つの値に対して適用できます。 .comparison between 2 values whose types are same [source, lisp] ---- ; (Pure (-> (t t) Bool)) (= 4 4) ; true (!= 4 4) ; false (= "Hello" "Hello") ; true (= (Some 1) (Some 2)) ; false (< 6 7) (> 6 7) (<= 30 40) (>= 30 40) (< "Hello" "World") (<= (Some 1) (Some 2)) ---- _eq_, _neq_, _lt_, _gt_, _leq_, _geq_ といった関数は、異なる型同士の値でも比較可能です。 .comparison between any 2 values [source, lisp] ---- ; (Pure (-> (t1 t1) Bool)) (geq (Some 1) "Hello") ; (Some 1)は"Hello"より大きい、もしくは等しいか？ (eq "Hello" 100) ; "Hello"と100は等しいか？ (neq "Hello" 100) ; "Hello"と100は等しくないか？ (lt 100 (Some 20)) ; 100は(Some 20)より小さいか？ (gt 200 "Hello") ; 200は"Hello"より大きいか？ ---- == ビット演算 [source, lisp] ---- (band 1 0) ; ビット積 (band 1 1) ; ビット積 (bor 1 0) ; ビット和 (bor 1 1) ; ビット和 (bxor 1 0) ; ビット排他的論理和 ---- .ビットシフト [source, lisp] ---- ; (Pure (-> (Int Int) (Option Int))) (<< 8 4) ; (Some 128) (>> 128 4) ; (Some 8) (>> -128 4) ; (Some -8) ---- 2番目の引数が2^64^以上の場合はNoneをリターンします。 == 数学的演算 [source, lisp] ---- ; (Pure (-> (Int Int) (Option Int))) (pow 10 20) ; (Some 100000000000000000000) namely 10^20 ; (Pure (-> (Int) (Option Int))) (sqrt 16) ; (Some 4) ---- powの指数部が2^32^以上の場合は、powはNoneをリターンします。 sqrtの引数が0以下の場合は、sqrtはNoneをリターンします。 == 代数的データ型 代数的データ型は以下のように定義できます。 [source, lisp] ---- ; in BLisp (data Cardinal ; 型名 East ; 値 North ; 値 West ; 値 South) ; 値 ---- 型名とその値の最初の文字は大文字でなければなりません。これはRustの以下のコードと同等です。 [source, rust] ---- // in Rust enum Cardinal { East, North, West, South } ---- 各要素は以下のような値を持つことができます。 [source, lisp] ---- ; in BLisp (data Dim2 (Dim2 Int Int)) ; Dim2は2つのInt型の値を持つ ---- Dim2は以下のようにインスタンス化することができます。 [source, lisp] ---- (Dim2 10 20) ---- この型はRustの以下の型と同等です。 [source, rust] ---- // in Rust use num_bigint::BigInt; enum Dim2 { Dim2(BigInt, BigInt) } ---- == ジェネリクス Option型とResult型は内部で定義されています。 [source, lisp] ---- (data (Option t) (Some t) None) (data (Result t e) (Ok t) (Err e)) ---- _t_ と _e_ は型変数です。このコードは、Rustの以下のコードと同等です。 [source, rust] ---- // in Rust enum Option { Some(T), None, } enum Result { Ok(T), Err(E), } ---- リスト型は以下のような組み込み型です。 [source, lisp] ---- (data (List t) (Cons t (List t)) Nil) ---- したがって、以下の2つのリストは等価です。 [source, lisp] ---- (Cons 1 (Cons 2 (Cons 3 Nil))) '(1 2 3) ---- == ジェネリック関数 _car_ と _cdr_ は内部的に定義されたジェネリック関数です。これらの定義は以下の通りです。 [source, lisp] ---- (export car (x) (Pure (-> ('(t)) (Option t))) (match x ((Cons n _) (Some n)) (_ None))) (export cdr (x) (Pure (-> ('(t)) '(t))) (match x ((Cons _ l) l) (_ '()))) ---- t_は型変数です。これらの関数は以下のように使うことができます。 [source, lisp] ---- (car '(3 8 9)) ; returns (Some 3) (cdr '(8 10 4)) ; returns '(10 4) ---- 通常変数と型変数の最初の文字は小文字でなければなりません。 == If式 単純です. [source, lisp] ---- (if (< 10 20) '(1 2 3) '()) ---- == Match式 リストは以下のようにマッチさせることができます。 [source, lisp] ---- (match '(1 2 3) ((Cons n _) n) ('() 0)) ---- この、 (Cons n _) という式はパターンです。 パターンが '(1 2 3) にマッチした場合、1は可変変数 _n_ に代入されます。そうすると、_n_ つまり1が返されます。 タプルのパターンマッチングの例です。 [source, lisp] ---- (match [1 3] ([x y] [y x])) ---- このコードはタプルの第1要素と第2要素を入れ替えます。 整数値はパターンマッチングにも使用できます。 [source, lisp] ---- (match 20 (20 true) (_ false)) ---- より複雑な例としては、以下のようなものがあります。 [source, lisp] ---- (match [(Some 10) true] ([(Some 10) false] 1) ([(Some 10) true] 2) (_ 0)) ---- BLispはパターンを網羅的にチェックします。そのため、以下のコードは拒否されます。 [source, lisp] ---- (match '(1 2) ('() 0)) ---- == Let式 変数のバインドには、以下のようにLet式を使用します。 [source, lisp] ---- (let ((x 10) (y 20)) ; x is 10, y is 20 (* x y)) (let ((x 10) (x (* x x)) (x (* x x))) ; x = 10, x = x * x, x = x * x x) ---- また、以下のように分配束縛を行うこともできます。 [source, lisp] ---- (let (((Some x) (Some 10))) ; x is 10 (* x 2)) (let (([x y] [10 20])) ; x is 10, y is 20 (* x y)) ---- == ラムダ式 ラムダ式は以下のように定義されます。 [source, lisp] ---- (lambda (x y) (* x y)) ---- このラムダは2つの整数を受け取り、それらの乗算を返します。これに引数を適用するのは次のように簡単に行えます。 [source, lisp] ---- ((lambda (x y) (* x y)) 10 20) ---- すべてのラムダ式は純粋です。よって、ラムダ式からIO関数を呼び出すことはできません。 _map_ と _fold_ 関数は内部的に以下のように定義されています。 [source, lisp] ---- (export map (f x) (Pure (-> ((Pure (-> (a) b)) '(a)) '(b))) (match x ((Cons h l) (Cons (f h) (map f l))) (_ '()))) (export fold (f init x) (Pure (-> ((Pure (-> (a b) b)) b '(a)) b)) (match x ((Cons h l) (fold f (f h init) l)) (_ init))) ---- _map_ を使うと、以下のようにリストの要素に関数を適用することができます。 [source, lisp] ---- ; それぞれをの要素を2乗 (let ((l '(1 2 3)) (f (lambda (x) (* x x)))) (map f l)) ---- _fold_ を使用して、リストの要素にまたがって計算することができます。例えば、合計は以下のように計算できます。 [source, lisp] ---- ; 合計 (let ((l '(20 50 60)) (f (lambda (x y) (+ x y)))) (fold f 0 l)) ; 0 is an initial value ---- 当然、これは以下のようにも記述できます。 [source, lisp] ---- ; summation (fold + 0 '(20 50 60)) ---- == マクロ マクロは `macro` で定義できます。 各ルールはパターンとテンプレートの組からなり、最初に一致したルールが展開されます。 [source, lisp] ---- (macro add ((add $e1 $e2) (+ $e1 $e2)) ((add $e1 $e2 $e3 ...) (+ $e1 (add $e2 $e3 ...)))) ---- `$` で始まる識別子はパターン変数です。 パターン変数には、マクロ呼び出し側で一致した式がそのまま代入されます。 `...` は、パターン変数やテンプレート断片の後ろに置くことで、残りの引数を可変長部分としてまとめて扱えます。 [source, lisp] ---- (add 1 2) ; 3 (add 1 2 3 4 5) ; 15 ---- マクロは局所変数を導入する式も生成できます。 たとえば、一時変数を含むラムダ式は以下のように書けます。 [source, lisp] ---- (macro with_tmp ((_ $x) ((lambda (tmp) (+ tmp $x)) 1))) (export test (tmp) (Pure (-> (Int) Int)) (with_tmp tmp)) ---- BLispのマクロは、テンプレートが導入する局所 binder に対して衛生的です。 `lambda` の引数、`let` の束縛、`match` のパターン変数は展開時に fresh な内部名へ自動的にリネームされるため、呼び出し側の同名変数を変数捕捉しません。 一方で、`defun`、`export`、`data` のようなトップレベル名は自動では改名されません。 == 文字列と文字 _chars_ はStringから(List Char)へ変換します。 [source, lisp] ---- ; (Pure (-> (String) (List Char))) (chars "Hello") ; '(`H` `e` `l` `l` `o`) ---- _str_ は(List Char)からStringへ変換します。 [source, lisp] ---- ; (Pure (-> ((List Char)) String)) (str '(`H` `e` `l` `l` `o`)) ; "Hello" ---- == 外部関数呼び出し _blisp::embedded_ は、外部関数呼び出し用のマクロです。 このマクロを利用すると、Rustの関数をBLispから容易に呼び出せるようになります。 たとえば、はじめに、Rustの関数を以下のように定義します。 [source, rust] ---- use blisp::embedded; use num_bigint::{BigInt, ToBigInt}; #[embedded] fn add_four_ints(a: BigInt, b: (BigInt, BigInt), c: Option) -> Result { let mut result = a + b.0 + b.1; if let Some(n) = c { result += n; } Ok(result) } ---- _blisp::embedded_ マクロは外部関数呼び出し用の型定義を生成します。 この関数は、以下のようにBLispから呼び出せます。 [source, lisp] ---- (export call_add_four_ints (n) (IO (-> ((Option Int)) (Result Int String))) (add_four_ints 1 [2 3] n)) ---- 外部関数を登録するためには、以下のように、 _embedded_ によって生成される型定義のベクタを _blisp::init_ に渡します。 [source, rust] ---- // add_for_ints let code = "(export call_add_four_ints (n) (IO (-> ((Option Int)) (Result Int String))) (add_four_ints 1 [2 3] n) )"; let exprs = blisp::init(code, vec![Box::new(AddFourInts)]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let result = blisp::eval("(call_add_four_ints (Some 4))", &ctx).unwrap(); ---- ここでは、関数名が _add_four_ints_ のため、そのキャメルケースの _AddFourInts_ を _Box_ と _Vec_ に包んで _blisp::init_ に渡さなければなりません。 Rustの外部関数は以下に示される型のみ引数と返り値で利用可能です。 _Vec_ のような他の型はサポート外ですが、 _Vec>_ のような型はOKです。 BLispとRustの間の型変換は _embedded_ マクロが生成する関数によって自動的に行われます。 .Type Conversion between BLisp and Rust |=== |BLisp | Rust |_Int_ | _BigInt_ |_Bool_ | _bool_ |_Char_ | _char_ |_String_ | _String_ |_'(T)_ | _Vec_ |_[T0, T1]_ | _(T0, T1)_ |_(Option T)_ | _Option_ |_(Result T E)_ | _Result_ |=== == Coqへのトランスパイラ (実験的) BLispは実験的にCoqへのトランスパイラを実装しています。 トランスパイラは、以下のように _blisp::transpile_ を呼び出すことで実行されます。 [source, coq] ---- let expr = " (defun snoc (l y) (Pure (-> ( '(t) t) '(t))) (match l (nil (Cons y nil)) ((Cons h b) (Cons h (snoc b y))))) (defun rev (l) (Pure (-> ( '(t)) '(t))) (match l (nil nil) ((Cons h t) (snoc (rev t) h)))) "; let exprs = blisp::init(expr, vec![]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); println!("{}", blisp::transpile(&ctx)); ---- これは以下のようなCoqのコードを出力します。 この出力には、BLispのプレリュードも含まれます。 [source, coq] ---- Require Import ZArith. Require Import Coq.Lists.List. Inductive Option (t: Type): Type := | Some (x0: t) | None. Arguments Some{t}. Arguments None{t}. Inductive Result (t e: Type): Type := | Ok (x0: t) | Err (x0: e). Arguments Ok{t e}. Arguments Err{t e}. Definition car {t: Type} (x: list t): Option t := match x with | (cons n _) => (Some n) | _ => (None) end. Definition cdr {t: Type} (x: list t): list t := match x with | (cons _ l) => l | _ => nil end. Definition filter {t: Type} (f: t -> bool) (x: list t): list t := (reverse (filter' f x nil ) ). Fixpoint filter' {t: Type} (f: t -> bool) (x l: list t): list t := match x with | (cons h a) => match (f h ) with | true => (filter' f a (cons h l) ) | false => (filter' f a l ) end | _ => l end. Fixpoint fold {a b: Type} (f: a -> b -> b) (init: b) (x: list a): b := match x with | (cons h l) => (fold f (f h init ) l ) | _ => init end. Fixpoint map {a b: Type} (f: a -> b) (x: list a): list b := match x with | (cons h l) => (cons (f h ) (map f l )) | _ => nil end. Fixpoint rev {t: Type} (l: list t): list t := match l with | nil => nil | (cons h t) => (snoc (rev t ) h ) end. Definition reverse {t: Type} (x: list t): list t := (reverse' x nil ). Fixpoint reverse' {t: Type} (x l: list t): list t := match x with | (cons h a) => (reverse' a (cons h l) ) | _ => l end. Fixpoint snoc {t: Type} (l: list t) (y: t): list t := match l with | nil => (cons y nil) | (cons h b) => (cons h (snoc b y )) end. ---- このトランスパイラは実験的なものであることに注意してください。 よって、いくつかの出力はCoqが解釈できません。 その場合は、手動でソースコードを修正してください。 簡単にできるはずです。 == 例 === リバース _reverse_ は内部で定義されている関数です。この関数はリストを反転します。 [source, lisp] ---- (reverse '(1 2 3 4 5 6 7 8 9)) ---- このコードの出力は以下の通りです。 '(9 8 7 6 5 4 3 2 1) === Filter _filter_ は内部で定義されている関数です。この関数はリストの中身をフィルターします。 [source, lisp] ---- (filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9)) ---- このコードの出力は以下の通りです。 '(2 4 6 8) _filter_' の型は以下の通りです。 [source, lisp] ---- (Pure (-> ((Pure (-> (t) Bool)) ; 関数を引数にとる '(t)) ; リストを引数にとる '(t))) ; リストをリターン ---- === 階乗 末尾呼び出し版の階乗関数は、以下のように実装できます。 [source, lisp] ---- (export factorial (n) (Pure (-> (Int) Int)) (fact n 1)) (defun fact (n total) (Pure (-> (Int Int) Int)) (if (<= n 0) total (fact (- n 1) (* n total)))) ---- この関数は以下のように呼び出すことができます。 >> (factorial 10) 3628800 >> >> (factorial 1000) 402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 >> >> (factorial 100) 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000 >> >> (factorial 500) 1220136825991110068701238785423046926253574342803192842192413588385845373153881997605496447502203281863013616477148203584163378722078177200480785205159329285477907571939330603772960859086270429174547882424912726344305670173270769461062802310452644218878789465754777149863494367781037644274033827365397471386477878495438489595537537990423241061271326984327745715546309977202781014561081188373709531016356324432987029563896628911658974769572087926928871281780070265174507768410719624390394322536422605234945850129918571501248706961568141625359056693423813008856249246891564126775654481886506593847951775360894005745238940335798476363944905313062323749066445048824665075946735862074637925184200459369692981022263971952597190945217823331756934581508552332820762820023402626907898342451712006207714640979456116127629145951237229913340169552363850942885592018727433795173014586357570828355780158735432768888680120399882384702151467605445407663535984174430480128938313896881639487469658817504506926365338175055478128640000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ================================================ FILE: docs/index.ja.html ================================================ BLisp: Lispっぽい静的型付け言語

BLispは静的型付けされたLispライクなプログラミング言語で、no_std環境用のエフェクトシステムを採用しています。BLispは関数型プログラミング言語の高階関数のような高階のRPCをサポートしています。

本リポジトリではライブラリクレートのみを提供しています。BLispを利用するには blisp-repl か、おもちゃのOSである baremetalisp を参照してください。

English version is here.

no_stdで動くBLisp

no_stdで動くBLisp

1. 特徴

  • 代数的データ型

  • ジェネリクス

  • 型推論

  • IOと純粋な関数を分離するためのエフェクトシステム

  • 多倍長整数

  • no_std環境のサポート

2. 値

values
`A`       ; 文字リテラル
"Hello"   ; 文字列リテラル
144       ; 整数値
0xabcDEF  ; 16進数
0o777     ; 8進数
0b1001    ; 2進数
true      ; 真偽値
false     ; 真偽値
[true 10] ; タプル
[]        ; 空のタプル
'(1 2 3)  ; リスト
'()       ; 空のリスト、Nil

3. 基本型

types
Char       ; 文字型
String     ; 文字列型
Int        ; 整数型
Bool       ; 真偽値型
'(Int)     ; Int型のリスト型
[Int Bool] ; Int型とBool型のタプル型
(Pure (-> (Int Int) Bool)) ; Int型の値を2つとり、Bool型の値をリターンする純粋な関数
(IO (-> (Int) [])) ; Int型の値をとり[]をリターンするIOのある関数

PureとIOは関数の効果です。IO関数内では、Pure関数とIO関数の両方を呼び出すことができます。しかし、Pure関数内では、Pure関数の呼び出しのみ許可されています。

4. 関数定義

関数はdefunやexportで定義することができます。"defun"はRustのeval関数からは呼び出せないローカル関数を定義します。

以下の2つの関数があるとしましょう。

defun
(defun double (x)         ; 関数名がdoubleでxは引数
    (Pure (-> (Int) Int)) ; 関数の型
    (* 2 x))              ; 関数の中身
export
(export quad (x)          ; 関数名がquadで引数はx
    (Pure (-> (Int) Int)) ; 関数の型
    (double (double x)))  ; 関数の中身

doubleはRustのevalからは呼び出せませんが、内部で定義された関数からは呼び出せます。quadはRustのevalから呼び出すことができ、内部的にdoubleを呼び出します。

これはRustで実際に行うコードです。

Rust’s eval
use blisp;

fn eval(e: &str, ctx: &blisp::semantics::Context) {
    // evaluate expressions
    let exprs = match blisp::eval(e, ctx) {
        Ok(es) => es,
        Err(err) => {
            println!("error:{}:{}: {}", err.pos.line, err.pos.column, err.msg);
            return;
        }
    };

    for r in exprs {
        match r {
            Ok(msg) => {
                println!("{}", msg);
            }
            Err(msg) => {
                println!("error: {}", msg);
            }
        }
    }
}

fn main() {
    // internal code
    let code = "
(defun double (x)         ; 関数名がdoubleでxは引数
    (Pure (-> (Int) Int)) ; 関数の型
    (* 2 x))              ; 関数の中身

(export quad (x)          ; 関数名がquadで引数はx
    (Pure (-> (Int) Int)) ; 関数の型
    (double (double x)))  ; 関数の中身
";
    let exprs = blisp::init(code, vec![]).unwrap();
    let ctx = blisp::typing(exprs).unwrap();

    let e = "(double 10) ; エラー";
    eval(e, &ctx);

    let e = "(quad 10) ; OK";
    eval(e, &ctx);
}

このコードは以下のように出力します。

error:0:1: Typing Error: double is not defined
40

5. 算術演算

基本
; (Pure (-> (Int Int) Int))
(+ 10 20)
(- 30 40)
(* 6 100)
(/ 100 2)
(% 10 3)

6. 真偽値演算

logical
; (Pure (-> (Bool Bool) Bool))
(and true false)
(or true false)
(xor true false)
negation
; (Pure (-> (Bool) Bool))
(not true)

7. 比較演算

=, !=, <, >, <=, >= といった関数は、同じ型の2つの値に対して適用できます。

comparison between 2 values whose types are same
; (Pure (-> (t t) Bool))
(= 4 4)               ; true
(!= 4 4)              ; false
(= "Hello" "Hello")   ; true
(= (Some 1) (Some 2)) ; false
(< 6 7)
(> 6 7)
(<= 30 40)
(>= 30 40)
(< "Hello" "World")
(<= (Some 1) (Some 2))

eq, neq, lt, gt, leq, geq といった関数は、異なる型同士の値でも比較可能です。

comparison between any 2 values
; (Pure (-> (t1 t1) Bool))
(geq (Some 1) "Hello") ; (Some 1)は"Hello"より大きい、もしくは等しいか？
(eq "Hello" 100)       ; "Hello"と100は等しいか？
(neq "Hello" 100)      ; "Hello"と100は等しくないか？
(lt 100 (Some 20))     ; 100は(Some 20)より小さいか？
(gt 200 "Hello")       ; 200は"Hello"より大きいか？

8. ビット演算

(band 1 0) ; ビット積
(band 1 1) ; ビット積
(bor 1 0)  ; ビット和
(bor 1 1)  ; ビット和
(bxor 1 0) ; ビット排他的論理和
ビットシフト
; (Pure (-> (Int Int) (Option Int)))
(<< 8 4)   ; (Some 128)
(>> 128 4) ; (Some 8)
(>> -128 4) ; (Some -8)

2番目の引数が264以上の場合はNoneをリターンします。

9. 数学的演算

; (Pure (-> (Int Int) (Option Int)))
(pow 10 20) ; (Some 100000000000000000000) namely 10^20

; (Pure (-> (Int) (Option Int)))
(sqrt 16)   ; (Some 4)

powの指数部が232以上の場合は、powはNoneをリターンします。

sqrtの引数が0以下の場合は、sqrtはNoneをリターンします。

10. 代数的データ型

代数的データ型は以下のように定義できます。

; in BLisp
(data Cardinal ; 型名
    East       ; 値
    North      ; 値
    West       ; 値
    South)     ; 値

型名とその値の最初の文字は大文字でなければなりません。これはRustの以下のコードと同等です。

// in Rust
enum Cardinal {
    East,
    North,
    West,
    South
}

各要素は以下のような値を持つことができます。

; in BLisp
(data Dim2
    (Dim2 Int Int)) ; Dim2は2つのInt型の値を持つ

Dim2は以下のようにインスタンス化することができます。

(Dim2 10 20)

この型はRustの以下の型と同等です。

// in Rust
use num_bigint::BigInt;
enum Dim2 {
    Dim2(BigInt, BigInt)
}

11. ジェネリクス

Option型とResult型は内部で定義されています。

(data (Option t)
    (Some t)
    None)

(data (Result t e)
    (Ok t)
    (Err e))

t と e は型変数です。このコードは、Rustの以下のコードと同等です。

// in Rust
enum Option<T> {
    Some(T),
    None,
}

enum Result<T, E> {
    Ok(T),
    Err(E),
}

リスト型は以下のような組み込み型です。

(data (List t)
    (Cons t (List t))
    Nil)

したがって、以下の2つのリストは等価です。

(Cons 1 (Cons 2 (Cons 3 Nil)))
'(1 2 3)

12. ジェネリック関数

car と cdr は内部的に定義されたジェネリック関数です。これらの定義は以下の通りです。

(export car (x) (Pure (-> ('(t)) (Option t)))
    (match x
        ((Cons n _) (Some n))
        (_ None)))

(export cdr (x) (Pure (-> ('(t)) '(t)))
    (match x
        ((Cons _ l) l)
        (_ '())))

t_は型変数です。これらの関数は以下のように使うことができます。

(car '(3 8 9))  ; returns (Some 3)
(cdr '(8 10 4)) ; returns '(10 4)

通常変数と型変数の最初の文字は小文字でなければなりません。

13. If式

単純です.

(if (< 10 20)
    '(1 2 3)
    '())

14. Match式

リストは以下のようにマッチさせることができます。

(match '(1 2 3)
    ((Cons n _) n)
    ('() 0))

この、

(Cons n _)

という式はパターンです。 パターンが '(1 2 3) にマッチした場合、1は可変変数 n に代入されます。そうすると、n つまり1が返されます。

タプルのパターンマッチングの例です。

(match [1 3]
    ([x y] [y x]))

このコードはタプルの第1要素と第2要素を入れ替えます。

整数値はパターンマッチングにも使用できます。

(match 20
    (20 true)
    (_ false))

より複雑な例としては、以下のようなものがあります。

(match [(Some 10) true]
    ([(Some 10) false] 1)
    ([(Some 10) true] 2)
    (_ 0))

BLispはパターンを網羅的にチェックします。そのため、以下のコードは拒否されます。

(match '(1 2)
    ('() 0))

15. Let式

変数のバインドには、以下のようにLet式を使用します。

(let ((x 10) (y 20)) ; x is 10, y is 20
    (* x y))

(let ((x 10) (x (* x x)) (x (* x x))) ; x = 10, x = x * x, x = x * x
    x)

また、以下のように分配束縛を行うこともできます。

(let (((Some x) (Some 10))) ; x is 10
    (* x 2))

(let (([x y] [10 20])) ; x is 10, y is 20
    (* x y))

16. ラムダ式

ラムダ式は以下のように定義されます。

(lambda (x y) (* x y))

このラムダは2つの整数を受け取り、それらの乗算を返します。これに引数を適用するのは次のように簡単に行えます。

((lambda (x y) (* x y)) 10 20)

すべてのラムダ式は純粋です。よって、ラムダ式からIO関数を呼び出すことはできません。

map と fold 関数は内部的に以下のように定義されています。

(export map (f x) (Pure (-> ((Pure (-> (a) b)) '(a)) '(b)))
    (match x
        ((Cons h l) (Cons (f h) (map f l)))
        (_ '())))

(export fold (f init x) (Pure (-> ((Pure (-> (a b) b)) b '(a)) b))
    (match x
        ((Cons h l) (fold f (f h init) l))
        (_ init)))

map を使うと、以下のようにリストの要素に関数を適用することができます。

; それぞれをの要素を2乗
(let ((l '(1 2 3))
      (f (lambda (x) (* x x))))
        (map f l))

fold を使用して、リストの要素にまたがって計算することができます。例えば、合計は以下のように計算できます。

; 合計
(let ((l '(20 50 60))
      (f (lambda (x y) (+ x y))))
        (fold f 0 l)) ; 0 is an initial value

当然、これは以下のようにも記述できます。

; summation
(fold + 0 '(20 50 60))

17. マクロ

マクロは macro で定義できます。 各ルールはパターンとテンプレートの組からなり、最初に一致したルールが展開されます。

(macro add
    ((add $e1 $e2) (+ $e1 $e2))
    ((add $e1 $e2 $e3 ...) (+ $e1 (add $e2 $e3 ...))))

$ で始まる識別子はパターン変数です。 パターン変数には、マクロ呼び出し側で一致した式がそのまま代入されます。 …​ は、パターン変数やテンプレート断片の後ろに置くことで、残りの引数を可変長部分としてまとめて扱えます。

(add 1 2)         ; 3
(add 1 2 3 4 5)   ; 15

マクロは局所変数を導入する式も生成できます。 たとえば、一時変数を含むラムダ式は以下のように書けます。

(macro with_tmp
    ((_ $x) ((lambda (tmp) (+ tmp $x)) 1)))

(export test (tmp) (Pure (-> (Int) Int))
    (with_tmp tmp))

BLispのマクロは、テンプレートが導入する局所 binder に対して衛生的です。 lambda の引数、let の束縛、match のパターン変数は展開時に fresh な内部名へ自動的にリネームされるため、呼び出し側の同名変数を変数捕捉しません。 一方で、defun、export、data のようなトップレベル名は自動では改名されません。

18. 文字列と文字

chars はStringから(List Char)へ変換します。

; (Pure (-> (String) (List Char)))
(chars "Hello") ; '(`H` `e` `l` `l` `o`)

str は(List Char)からStringへ変換します。

; (Pure (-> ((List Char)) String))
(str '(`H` `e` `l` `l` `o`)) ; "Hello"

19. 外部関数呼び出し

blisp::embedded は、外部関数呼び出し用のマクロです。 このマクロを利用すると、Rustの関数をBLispから容易に呼び出せるようになります。

たとえば、はじめに、Rustの関数を以下のように定義します。

use blisp::embedded;
use num_bigint::{BigInt, ToBigInt};

#[embedded]
fn add_four_ints(a: BigInt, b: (BigInt, BigInt), c: Option<BigInt>) -> Result<BigInt, String> {
    let mut result = a + b.0 + b.1;
    if let Some(n) = c {
        result += n;
    }

    Ok(result)
}

blisp::embedded マクロは外部関数呼び出し用の型定義を生成します。 この関数は、以下のようにBLispから呼び出せます。

(export call_add_four_ints (n)
    (IO (-> ((Option Int)) (Result Int String)))
    (add_four_ints 1 [2 3] n))

外部関数を登録するためには、以下のように、 embedded によって生成される型定義のベクタを blisp::init に渡します。

// add_for_ints
let code = "(export call_add_four_ints (n)
    (IO (-> ((Option Int)) (Result Int String)))
    (add_four_ints 1 [2 3] n)
)";
let exprs = blisp::init(code, vec![Box::new(AddFourInts)]).unwrap();
let ctx = blisp::typing(exprs).unwrap();
let result = blisp::eval("(call_add_four_ints (Some 4))", &ctx).unwrap();

ここでは、関数名が add_four_ints のため、そのキャメルケースの AddFourInts を Box と Vec に包んで blisp::init に渡さなければなりません。

Rustの外部関数は以下に示される型のみ引数と返り値で利用可能です。 Vec<u64> のような他の型はサポート外ですが、 Vec<Option<bool>> のような型はOKです。 BLispとRustの間の型変換は embedded マクロが生成する関数によって自動的に行われます。

Table 1. Type Conversion between BLisp and Rust
BLisp Rust

Int

BigInt

Bool

bool

Char

char

String

String

'(T)

Vec<T>

[T0, T1]

(T0, T1)

(Option T)

Option<T>

(Result T E)

Result<T, E>

20. Coqへのトランスパイラ (実験的)

BLispは実験的にCoqへのトランスパイラを実装しています。 トランスパイラは、以下のように blisp::transpile を呼び出すことで実行されます。

let expr = "
(defun snoc (l y)
(Pure (-> (
    '(t) t)
'(t)))
(match l
    (nil (Cons y nil))
    ((Cons h b) (Cons h (snoc b y)))))

(defun rev (l)
(Pure (-> (
    '(t))
'(t)))
(match l
    (nil nil)
    ((Cons h t) (snoc (rev t) h))))
    ";
let exprs = blisp::init(expr, vec![]).unwrap();
let ctx = blisp::typing(exprs).unwrap();

println!("{}", blisp::transpile(&ctx));

これは以下のようなCoqのコードを出力します。 この出力には、BLispのプレリュードも含まれます。

Require Import ZArith.
Require Import Coq.Lists.List.

Inductive Option (t: Type): Type :=
| Some (x0: t)
| None.

Arguments Some{t}.
Arguments None{t}.

Inductive Result (t e: Type): Type :=
| Ok (x0: t)
| Err (x0: e).

Arguments Ok{t e}.
Arguments Err{t e}.

Definition car {t: Type} (x: list t): Option t :=
match x with
  | (cons n _) => (Some n)
  | _ => (None)
  end.

Definition cdr {t: Type} (x: list t): list t :=
match x with
  | (cons _ l) => l
  | _ => nil
  end.

Definition filter {t: Type} (f: t -> bool) (x: list t): list t :=
(reverse (filter' f x nil ) ).

Fixpoint filter' {t: Type} (f: t -> bool) (x l: list t): list t :=
match x with
  | (cons h a) => match (f h ) with
    | true => (filter' f a (cons h l) )
    | false => (filter' f a l )
    end
  | _ => l
  end.

Fixpoint fold {a b: Type} (f: a -> b -> b) (init: b) (x: list a): b :=
match x with
  | (cons h l) => (fold f (f h init ) l )
  | _ => init
  end.

Fixpoint map {a b: Type} (f: a -> b) (x: list a): list b :=
match x with
  | (cons h l) => (cons (f h ) (map f l ))
  | _ => nil
  end.

Fixpoint rev {t: Type} (l: list t): list t :=
match l with
  | nil => nil
  | (cons h t) => (snoc (rev t ) h )
  end.

Definition reverse {t: Type} (x: list t): list t :=
(reverse' x nil ).

Fixpoint reverse' {t: Type} (x l: list t): list t :=
match x with
  | (cons h a) => (reverse' a (cons h l) )
  | _ => l
  end.

Fixpoint snoc {t: Type} (l: list t) (y: t): list t :=
match l with
  | nil => (cons y nil)
  | (cons h b) => (cons h (snoc b y ))
  end.

このトランスパイラは実験的なものであることに注意してください。 よって、いくつかの出力はCoqが解釈できません。 その場合は、手動でソースコードを修正してください。 簡単にできるはずです。

21. 例

21.1. リバース

reverse は内部で定義されている関数です。この関数はリストを反転します。

(reverse '(1 2 3 4 5 6 7 8 9))

このコードの出力は以下の通りです。

'(9 8 7 6 5 4 3 2 1)

21.2. Filter

filter は内部で定義されている関数です。この関数はリストの中身をフィルターします。

(filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9))

このコードの出力は以下の通りです。

'(2 4 6 8)

filter' の型は以下の通りです。

(Pure (->
    ((Pure (-> (t) Bool)) ; 関数を引数にとる
     '(t))                ; リストを引数にとる
    '(t))) ; リストをリターン

21.3. 階乗

末尾呼び出し版の階乗関数は、以下のように実装できます。

(export factorial (n) (Pure (-> (Int) Int))
    (fact n 1))

(defun fact (n total) (Pure (-> (Int Int) Int))
    (if (<= n 0)
        total
        (fact (- n 1) (* n total))))

この関数は以下のように呼び出すことができます。

>> (factorial 10)
3628800
>>
>> (factorial 1000)
402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
>>
>> (factorial 100)
93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
>>
>> (factorial 500)
1220136825991110068701238785423046926253574342803192842192413588385845373153881997605496447502203281863013616477148203584163378722078177200480785205159329285477907571939330603772960859086270429174547882424912726344305670173270769461062802310452644218878789465754777149863494367781037644274033827365397471386477878495438489595537537990423241061271326984327745715546309977202781014561081188373709531016356324432987029563896628911658974769572087926928871281780070265174507768410719624390394322536422605234945850129918571501248706961568141625359056693423813008856249246891564126775654481886506593847951775360894005745238940335798476363944905313062323749066445048824665075946735862074637925184200459369692981022263971952597190945217823331756934581508552332820762820023402626907898342451712006207714640979456116127629145951237229913340169552363850942885592018727433795173014586357570828355780158735432768888680120399882384702151467605445407663535984174430480128938313896881639487469658817504506926365338175055478128640000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
================================================ FILE: embed_macro/Cargo.toml ================================================ [package] name = "blisp_embedded" version = "0.1.1" authors = ["Yuuki Takano ", "Fumiya Saito"] edition = "2021" description = "embedded macro for BLisp" repository = "https://github.com/ytakano/blisp" keywords = [ "no_std", "scripting", "scripting-engine", "scripting-language", "embedded", ] categories = ["no-std", "embedded"] license-file = "LICENSE" readme = "README.md" homepage = "https://ytakano.github.io/blisp/" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [lib] proc-macro = true [dependencies] syn = { version = "2.0", features = ["full"] } quote = "1.0" proc-macro2 = "1.0" convert_case = "0.7" ================================================ FILE: embed_macro/LICENSE ================================================ MIT License Copyright (c) 2020 Yuuki Takano , Fumiya Saito Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ================================================ FILE: embed_macro/README.md ================================================ # `embedded` macro for BLisp Please see [blisp-repl](https://github.com/ytakano/blisp-repl) to use BLisp, and [baremetalisp](https://github.com/ytakano/baremetalisp) which is a toy OS. **[Homepage](https://ytakano.github.io/blisp/) is here.** ================================================ FILE: embed_macro/src/lib.rs ================================================ extern crate proc_macro; use convert_case::{Case, Casing}; use proc_macro2::{Ident, TokenStream}; use quote::quote; use syn::{parse_macro_input, FnArg, GenericArgument, Item, PathArguments, Signature, Type}; #[proc_macro_attribute] pub fn embedded( _args: proc_macro::TokenStream, input: proc_macro::TokenStream, ) -> proc_macro::TokenStream { let mut out = input.clone(); let ty = parse_macro_input!(input as Item); let item_fn = match ty { Item::Fn(ref n) => n, _ => panic!("only function is allowed"), }; let fn_name = &item_fn.sig.ident.clone(); let fn_name_camel = { let mut temp = format!("{}", fn_name); temp = temp.to_case(Case::Pascal); Ident::new(&temp, Ident::span(fn_name)) }; // Generate BLisp. let fn_data = &item_fn.sig; let inputs_parse = inputs_type(fn_data); let output_ty = output_type(fn_data); let fn_body = format!("(extern {} (-> ({}) {}))", fn_name, inputs_parse, output_ty); // Generate FFI let fn_name_ffi = { let temp = format!("{fn_name}_ffi"); Ident::new(&temp, Ident::span(fn_name)) }; let fn_name_str = format!("{fn_name}"); let ffi_body = generate_ffi_body(fn_data, &fn_name, &fn_name_ffi); let expanded = quote! { struct #fn_name_camel; impl blisp::runtime::FFI for #fn_name_camel { fn blisp_extern(&self) -> &'static str { #fn_body } fn ffi(&self) -> fn(&mut blisp::runtime::Environment<'_>, &[blisp::runtime::RTData]) -> blisp::runtime::RTData { use blisp::runtime::{Environment, RTData, RTDataToRust, RustToRTData}; fn ffi_inner(env: &mut Environment<'_>, args: &[RTData]) ->RTData { #ffi_body } ffi_inner } fn name(&self) -> &'static str { #fn_name_str } } }; out.extend(proc_macro::TokenStream::from(expanded)); out } fn generate_ffi_body(data: &Signature, fn_name: &Ident, fn_name_ffi: &Ident) -> TokenStream { let mut body = quote! {}; for (i, arg) in data.inputs.iter().enumerate() { let arg_type = match arg { FnArg::Typed(pat) => &*pat.ty, _ => panic!("Need an explicitly typed input pattern "), }; let arg_dst = { let temp = format!("arg{i}"); Ident::new(&temp, Ident::span(fn_name_ffi)) }; let arg_src = { quote! { &args[#i] } }; let casting = typecast(arg_type, arg_dst, arg_src); body = quote! { #body #casting }; } let ffi_invoke = call_ffi(data.inputs.len(), fn_name); quote! { #body let result = #ffi_invoke; RustToRTData::from(env, result) } } fn call_ffi(len: usize, fn_name: &Ident) -> TokenStream { match len { 0 => quote! { #fn_name() }, 1 => quote! { #fn_name(arg0) }, 2 => quote! { #fn_name(arg0, arg1) }, 3 => quote! { #fn_name(arg0, arg1, arg2) }, 4 => quote! { #fn_name(arg0, arg1, arg2, arg3) }, 5 => quote! { #fn_name(arg0, arg1, arg2, arg3, arg4) }, 6 => quote! { #fn_name(arg0, arg1, arg2, arg3, arg4, arg5) }, 7 => quote! { #fn_name(arg0, arg1, arg2, arg3, arg4, arg5, arg6) }, 8 => quote! { #fn_name(arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7) }, 9 => quote! { #fn_name(arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) }, _ => panic!("too many arguments"), } } fn typecast(ty: &Type, arg_dst: Ident, arg_src: TokenStream) -> TokenStream { match ty { Type::Tuple(_tup) => { quote! { let #arg_dst: #ty = RTDataToRust::into(#arg_src); } } Type::Path(path) => match &path.path.segments.first().unwrap().arguments { PathArguments::None => { quote! { let #arg_dst: #ty = RTDataToRust::into(#arg_src); } } PathArguments::AngleBracketed(_ang) => { let type_name = &path.path.segments.first().unwrap().ident; let type_name_str = format!("{}", &type_name); match type_name_str.as_str() { "Vec" | "Option" | "Result" => quote! { let #arg_dst: #ty = RTDataToRust::into(#arg_src); }, _ => panic!("only Vec, Option, or Result generics types are allowed"), } } _ => panic!("no parentheses at PathArgument"), }, _ => panic!("parse type miss"), } } fn inputs_type(data: &Signature) -> String { let ret = data.inputs.iter().map(|arg| match arg { FnArg::Typed(pat) => parse_type(&*pat.ty), _ => panic!("Need an explicitly typed input pattern "), }); let mut statements = String::from(""); for (i, data) in ret.enumerate() { if i == 0 { statements = format!("{}{}", statements, data); } else { statements = format!("{} {}", statements, data); } } statements } fn output_type(data: &Signature) -> String { let ret = match &data.output { syn::ReturnType::Default => "[]".to_string(), syn::ReturnType::Type(_, ty) => parse_type(&*ty), }; ret } fn parse_type(ty: &Type) -> String { match ty { Type::Tuple(tup) => { let mut statements = String::from("["); for (i, data) in tup.elems.iter().enumerate() { if i == 0 { statements = format!("{}{}", statements, parse_type(data)); } else { statements = format!("{} {}", statements, parse_type(data)); } } format!("{}]", statements) } Type::Path(path) => { let mut args_str = String::from(""); match &path.path.segments.first().unwrap().arguments { // not generic type (eg BigInt) PathArguments::None => ex_type_check(&path.path.segments.first().unwrap().ident), // generic type (vec, option, result) PathArguments::AngleBracketed(ang) => { let args = ang.args.iter().map(|a| match a { GenericArgument::Type(gene_type) => parse_type(gene_type), _ => panic!("GenericArgument is only Type"), }); for (i, data) in args.enumerate() { if i == 0 { args_str = format!("{}{}", args_str, data); } else { args_str = format!("{} {}", args_str, data); } } let type_name = &path.path.segments.first().unwrap().ident; let type_name_str = format!("{}", &type_name); match type_name_str.as_str() { "Vec" => format!("'({})", args_str), "Option" => format!("(Option {})", args_str), "Result" => format!("(Result {})", args_str), _ => panic!("only Vec, Option, or Result generics types are allowed"), } } _ => panic!("no parentheses at PathArgument"), } } _ => panic!("parse type miss"), } } fn ex_type_check(id: &Ident) -> String { let id_str = format!("{}", &id); match &*id_str { "BigInt" => String::from("Int"), "char" => String::from("Char"), "String" => String::from("String"), "bool" => String::from("Bool"), _ => panic!("arguments must be BigInt, char, bool, or String"), } } ================================================ FILE: history.md ================================================ # Version History ## 0.4.7 - add `macro` to define macros ## 0.4.0 - add `embedded` macro for FFIs - add transpiler to Coq ## 0.3.9 - fix a bug on the garbage collector ## 0.3.8 - fix a bug on typing - check the number of arguments - (+ 10) was passed typing rule - add != and neq - (!= 10 10) - (neq (Some "Hello") 10) ## 0.3.7 - add bit shift operators - (<< 8 4) ; shift left - (>> 128 4) ; shift right - add Char type - add character literal - \`H\` - add chars and str functions - chars converts String to (List Char) - (chars "Hello, World!") - str converts (List Char) to String - (str '(\`H\` \`e\` \`l\` \`l\` \`o\`)) ## 0.3.6 - make <, >, <=, >= functions' type (Pure (-> (t t) Bool)) - perform comparison between 2 values whose types are same - (< "Hello" "World") - (>= (Some 5) (Some 19)) - add lt, gt, leq, geq functions - perform comparison between any 2 values - function type is (Pure (-> (t1 t2) Bool)) - (eq "Hello" 10) - (lt (Some 6) "Hello") ## 0.3.5 - add string type and literal - String - "Hello World!" - make equal function generics - it can be used for non-integer types - (= "Hello" "Hello") - (= (Some 1) (Some 2)) - fix a bug on typing - (= (Some 1) (Some 2)) could not be typed properly ## 0.3.4 - fix bugs on typing - bug 1: some locally defined functions are cannot be called - bug 2: empty list cannot be typed properly - add filter and reverse functions to prelude ## 0.3.3 - add hexadecimal, octal, and binary - 0xabcDEF - 0o777 - 0b1010 ## 0.3.2 - add pow to compute exponent - example: (pow 10 20) - type of pow: (Pure (-> (Int Int) (Option Int))) - if the exponent portion is greater or equal to 2^32, then return None - add sqrt - example: (sqrt 16) - type of sqrt: (Pure (-> (Int) (Option Int))) - if the value is less than 0, then return None - add bitwise operations - band, bor, bxor ## 0.3.1 - garbage collection is ready (mark and sweep) ================================================ FILE: specification/Makefile ================================================ all: typing.pdf typing.dvi: typing.tex platex typing.tex platex typing.tex typing.pdf: typing.dvi dvipdfmx -p letter typing.dvi clean: rm -f *.dvi *.log *.aux *.pdf ================================================ FILE: specification/language.md ================================================ # Syntax and Semantics of BLisp ## Literal - $LITERAL := $HEX | $OCT | $BIN | $DECIMAL | $BOOL | $STRING | $CHAR - $DECIMAL - decimal number - examples: 0, 100, 224, -130, 4457, 0007 - $HEX - hexadecimal number - examples: 0xabcd 0xABCD - $BIN - binary number - examples: 0b1100, 0b01011 - $BOOL := true | false - $STRING - string literal - example: "Hello, World!" - escape sequences - \r - \n - \t - \0 - \\\\ - \\" - $CHAR - character literal - example: \`H\` - escape sequences - \r - \n - \t - \0 - \\\\ - \\\` ## Identifier - $ID - a string whose first character is not capital (not 'A' to 'Z') - excludes "true" and "false" ## Type Identifier - $TID - a string whose first character is capital ('A' to 'Z') ## Type - $TYPE := Int | Bool | String | Char | $TYPE_LIST | $TYPE_TUPLE | $TYPE_FUN | $TYPE_DATA | $ID - $TYPE_LIST := '( $TYPE ) - $TYPE_TUPLE := \[ $TYPE* \] - $TYPE_DATA := $TID | ( $TID $TYPE* ) - $TYPE_FUN := ( $EFFECT $TYPE_ARROW ) - $TYPE_ARROW := ( -> $TYPES $TYPE ) - $TYPES := ( $TYPE* ) - $EFFECT := Pure | IO examples: ```common-lisp '(Int) [Int Bool] (Pure (-> (Int INT) Bool)) '('(Int Bool)) [Int Int '([Int Bool])] ``` ## Data Type - $DATA := ( data $DATA_NAME $MEMBER* ) - $DATA_NAME := $TID | ( $TID $ID* ) - $MEMBER := $TID | ( $TID $TYPE* ) examples: ```common-lisp (data Dim2 (Dim2 Int Int)) (data (Maybe t) (Just t) Nothing) (data (Tree t) (Node (Tree t) (Tree t)) Leaf) ``` ## Function Definition - $DEFUN := ( $HEAD_DEFUN $ID ( $ID* ) $TYPE_FUN $EXPR ) - $HEAD_DEFUN := export | defun example: ```common-lisp (defun add (x y) (Pure (-> (Int Int) Int)) (+ x y)) ``` ## External Function - $EXTERN := ( extern $ID $TYPE_ARROW ) ## Expression - $EXPR := $LITERAL | $ID | $TID | $LET | $IF | $LAMBDA | $MATCH | $LIST | $TUPLE | $GENDATA | $APPLY ### Let Expression - $LET := ( let ( $DEFVAR+ ) $EXPR ) - $DEFVAR := ( $LETPAT $EXPR ) - $LETPAT := $ID | [ $LETPAT+ ] | ($TID $LETPAT+ ) ### If Expression - $IF := ( if $EXPR $EXPR $EXPR ) ### List Expression - $LIST := '( $EXPR* ) ### Tuple Expression - $TUPLE := [ $EXPR* ] ### Match Expression - $MATCH := ( match $EXPR $CASE+ ) - $CASE := ( $PATTERN $EXPR ) - $PATTERN := $LITERAL | $ID | $TID | \[ $PATTERN+ \] | ( $TID $PATTERN* ) | '() ### Function Application - $APPLY := ( $EXPR+ ) ### Data Creataion - $GENDATA := ( $TID $EXPR* ) ### Lambda - $LAMBDA := (lambda ($ID*) $EXPR) ## Built-in Functions - +, -, *, /, %: (Pure (-> (Int Int) Int)) - band, bor, bxor: (Pure (-> (Int Int) Int)) - pow, <<, >>: (Pure (-> (Int Int) (Some Int))) - sqrt: (Pure (-> (Int) (Some Int))) - <, >, <=, >=, =: (Pure (-> (t t) Bool)) - lt, gt, leq, geq, eq: (Pure (-> (t1 t2) Bool)) - and, or, xor: (Pure (-> (Bool Bool) Bool)) - not: (Pure (-> (Bool) Bool)) - chars: (Pure (-> (String) (List Char))) - str: (Pure (-> ((List Char)) String)) ## Macro - $MACRO := ( macro $ID $MACRO_RULE+ ) - $MACRO_RULE := ( ( $EXPR* ) ( $EXPR* ) ) ```common-lisp (macro add ((add $e1 $e2) (+ $e1 $e2)) ((_ $e1 $e2 $e3 ...) (+ $e1 (add $e2 $e3 ...)))) ``` ================================================ FILE: specification/typing.tex ================================================ \documentclass{article} \usepackage{amsmath,amssymb} \usepackage[dvipdfmx]{hyperref,graphicx} \usepackage{listings} \lstset{% language={lisp}, basicstyle={\small\ttfamily},% identifierstyle={\small},% commentstyle={\small\itshape},% keywordstyle={\small\bfseries},% ndkeywordstyle={\small},% stringstyle={\small\ttfamily}, frame={tb}, keepspaces=true, breaklines=true, columns=[l]{fullflexible},% numbers=left,% xrightmargin=0zw,% xleftmargin=3zw,% numberstyle={\scriptsize},% stepnumber=1, numbersep=1zw,% lineskip=-0.5ex% } \title{Typing Rule of Baremetalisp} \author{Yuuki Takano\\ ytakano@wide.ad.jp} \begin{document} \maketitle \section{Introduction} In this paper, I will formally describe the typing rule of Baremetalisp, which is a well typed Lisp for trusted execution environment. \begin{table}[tb] \centering \caption{Notation} \label{tab:notation} \begin{tabular}{rl} $A \Rightarrow B$ & logical implication (if A then B)\\ $e$ & expression \\ $z$ & integer literal such as 10, -34, 112 \\ $x$ & variable \\ $t$ & type variable \\ $D$ & type name of user defined data \\ $L$ & label of user defined data \\ $E$ & effect \\ $E_\mathcal{T}: T \rightarrow E$ & effect of type \\ $\mathcal{T}$ & type \\ $C$ & type constraint \\ $io(C): C \rightarrow \mathtt{Bool}$ & does $C$ contain $\mathtt{IO}$ functions? \\ $\Gamma$ & context \\ $\mathcal{P}$ & pattern \\ $\mathcal{P}_{let}$ & pattern of let expression \\ $\mathcal{T}_1 \equiv_\alpha \mathcal{T}_2$ & $\mathcal{T}_1$ and $\mathcal{T}_2$ are $\alpha$-equivalent \\ $\mathcal{S} : t \rightarrow \mathcal{T}$ & substitution from type variable to type\\ $\mathcal{T} \cdot \mathcal{S}$ & apply $\mathcal{S}$ to $\mathcal{T}$ \\ $\mathcal{X}$ & set of $t$ \\ $FV_\mathcal{T} : \mathcal{T} \rightarrow \mathcal{X}$ & function from $\mathcal{T}$ to its free variables\\ $FV_\Gamma : \Gamma \rightarrow \mathcal{X}$ & function from $\Gamma$ to its free variables\\ $Size : L \rightarrow \mathtt{Int}$ & the number of labels $L$'s type has \\ $\Gamma \vdash e : \mathcal{T}\ |_\mathcal{X}\ C$ & $e$'s type is deduced as $\mathcal{T}$ from $\Gamma$ \\ & under constraint $C$ and type variables $\mathcal{X}$ \end{tabular} \end{table} \begin{figure}[tb] \centering \begin{tabular}{rrll} $\mathcal{C}$ & := & $\mathcal{T} = \mathcal{T}, \mathcal{C}$ & \bf{type constraint} \\ & $|$ & $\varnothing$ \\ \\ $\Gamma$ & := & & \bf{context} \\ & & $x: \mathcal{T}, \Gamma$ & type of variable \\ & $|$ & $L: \mathcal{T}, \Gamma$ & type of label \\ & $|$ & $L_{nth}: \mathcal{T}, \Gamma$ & n-th type of label's element \\ & $|$ & $\varnothing$ \\ \\ $E$ & := & $\mathtt{Pure}\ |\ \mathtt{IO}$ & \bf{effect} \\ \\ $\mathcal{T}$ & := & & \bf{type} \\ & & $\mathtt{Int}$ \\ & $|$ & $\mathtt{Bool}$ \\ & $|$ & $'(\mathcal{T})$ & list type \\ & $|$ & $[\mathcal{T}+]$ & tuple type \\ & $|$ & $D$ & user defined type \\ & $|$ & $(D\ \mathcal{T}+)$ & user defined type with type arguments \\ & $|$ & $(E\ (\rightarrow\ (\mathcal{T}*)\ \mathcal{T}))$ & function type \\ & $|$ & $t$ & type variable \\ \\ $\mathcal{P}$ & := & & \bf{pattern} \\ & & $x$ & variable \\ & $|$ & $L$ & label \\ & $|$ & $(L\ \mathcal{P}+)$ & label with patterns \\ & $|$ & $'()$ & empty list \\ & $|$ & $[\mathcal{P}+]$ & tuple \\ \\ $\mathcal{P}_{let}$ & := & & \bf{patten for let} \\ & & $x$ & variable \\ & $|$ & $(L\ \mathcal{P}_{let}+)$ & label with patterns \\ & $|$ & $[\mathcal{P}_{let}+]$ & tuple \\ \end{tabular} \caption{Syntax} \label{fig:syntax} \end{figure} \section{Notation and Syntax} Table~\ref{tab:notation} and Fig.~\ref{fig:syntax} shows notation used in this paper and syntax for the typing rule, respectively. \begin{lstlisting}[caption=Example of variable and type,label=src:vars] (defun add (a b) (Pure (-> (Int Int) Int)) (+ a b)) \end{lstlisting} $x$ is a variable. For example, $x \in \{a, b\}$ in Listing~\ref{src:vars}. $\mathcal{T}$ is a type. For example, $\mathcal{T} \in \{\mathtt{Int}, (\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int})\}$ in Listing~\ref{src:vars}. $(\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int})$ is a function type which takes 2 integer values and return 1 integer value. $\mathtt{Pure}$ in Listing~\ref{src:vars} denotes the effect of the function but I just ignore it now. Function effects will be described in Sec.~\ref{sec:effect}. $\mathcal{T}$ can be other forms as described in Fig.~\ref{fig:syntax} such as $\mathtt{Bool}$, $'(\mathtt{Int})$, $[\mathtt{Bool}\ \mathtt{Int}]$, $(\mathrm{List}\ a)$, $(\mathrm{List}\ \mathtt{Int})$. $C$ is a type constraint, which is a set of pairs of types. For example, $C = \{(\rightarrow\ (t_1\ t_2)\ t) = (\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int})\}$ deduced from Listing~\ref{src:vars} means $(\rightarrow\ (t_1\ t_2)\ t)$ and $(\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int})$ are semantically equal and every type variable in $C$, $t_1, t_2, t$, is thus $\mathtt{Int}$. $\Gamma$ is a map from variable and label to type. For example, $\Gamma = \{a : t_1, b : t_2, + : (\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int})\}$ in Listing~\ref{src:vars}. $\Gamma$ is called context generally, thus I call $\Gamma$ context in this paper. \begin{lstlisting}[caption=Example of user defined data type,label=src:cons] (data (List a) (Cons a (List a)) Nil) \end{lstlisting} $t$ is a type variable. For example, $t \in \{a\}$ in Listing~\ref{src:cons}. $L$ is a label for user defined type. For example, $L \in \{\mathrm{Cons}, \mathrm{Nil}\}$ in Listing~\ref{src:cons}. $D$ is user defined data. For example, $D \in \{\mathrm{List}\}$ in Listing~\ref{src:cons}. $\Gamma$ will hold mapping from labels in addition to variables. For example, $\Gamma = \{\mathrm{Cons} : (\mathrm{List}\ a), \mathrm{Nil} : (\mathrm{List}\ a), \mathrm{Cons}_{1st} : a, \mathrm{Cons}_{2nd} : (\mathrm{List}\ a)\}$ in Listing~\ref{src:cons}. $FV_\mathcal{T}$ and $FV_\Gamma$ are functions, which take $\mathcal{T}$ and $\Gamma$ and return free variables. For example, $FV_\mathcal{T}((\rightarrow\ (t_1\ t_2)\ t)) = \{t_1, t_2, t\}$ and \begin{equation*} \begin{aligned} &FV_\Gamma(\{a : t_1, b : t_1, + : (\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int})\}) \\ &=\{FV_\mathcal{T}(t_1), FV_\mathcal{T}(t_1), FV_\mathcal{T}((\rightarrow\ (\mathtt{Int}\ \mathtt{Int})\ \mathtt{Int}))\} \\ &=\{t_1, t_2\}. \end{aligned} \end{equation*} $\mathcal{T}_1 \equiv_\alpha \mathcal{T}_2$ denotes that $\mathcal{T}_1$ and $\mathcal{T}_2$ are $\alpha$-equivalent, which means $\mathcal{T}_1$ and $\mathcal{T}_2$ are semantically equal. For example, $(\rightarrow\ (t_1\ t_2)\ t) \equiv_\alpha (\rightarrow\ (t_{10}\ t_{11})\ t_{12})$. $\mathcal{S}$ is a substitution, which is a map from type variable to type, and it can be applied to $\mathcal{T}$ as $\mathcal{T} \cdot \mathcal{S}$. For example, if $\mathcal{S}(t_1) = [\mathtt{Bool}\ \mathtt{Int}], \mathcal{S}(t_2) = (\mathrm{List}\ t_3)$ then $(\rightarrow\ (t_1\ t_2)\ t) \cdot \mathcal{S} = (\rightarrow\ ([\mathtt{Bool}\ \mathtt{Int}]\ (\mathrm{List}\ t_3))\ t)$. \begin{lstlisting}[caption=Example of pattern matching,label=src:match] (data Dim2 (Dim2 Int Int)) (data (Maybe t) (Just t) Nothing) (defun match-let (a) (Pure (-> ((Maybe Dim2)) Int)) (match a ((Just val) (let (((Dim2 x y) val)) (+ x y))) (Nothing 0))) \end{lstlisting} $\mathcal{P}$ and $\mathcal{P}_{let}$ are pattern in match and let expressions. For example, in listings~\ref{src:match}, $(\mathrm{Just}\ val)$ and Nothing at line 9 and 12 are from $\mathcal{P}$ and $(\mathrm{Dim2}\ x\ y)$ at line 10 is from $\mathcal{P}_{let}$. $Size$ is a function which takes a label and return the number of labels the label's type has. For example, $Size(\mathrm{Just}) = Size(\mathrm{Nothing}) = 2$ because Maybe type has 2 labels and $Size(\mathrm{Dim2}) = 1$ because Dim2 type has 1 label in listings~\ref{src:match}. \begin{figure}[tb] \centering \begin{tabular}{rlrl} $\Gamma \vdash \mathtt{true} : \mathtt{Bool}\ |_\varnothing\ \varnothing$ & (T-True) & $\Gamma \vdash \mathtt{false} : \mathtt{Bool}\ |_\varnothing\ \varnothing$ & (T-False) \vspace{5mm} \\ $\dfrac{x : T \in \Gamma}{\Gamma \vdash x : T\ |_\varnothing\ \varnothing}$ & (T-Var) & $\Gamma \vdash z : \mathtt{Int}\ |_\varnothing\ \varnothing$ & (T-Num) \vspace{5mm} \\ $\dfrac{x : T' \in \Gamma \hspace{5mm} T' \cdot S \equiv_\alpha T}{\Gamma \vdash x : T\ |_{FV_\mathcal{T}(T)}\ \varnothing}$ & (T-VarPoly) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma_0 \vdash \mathcal{P}_{let} : \mathcal{T}_0\ |_{\mathcal{X}_0}\ C_0 \hspace{5mm} \Gamma \vdash e_1 : \mathcal{T}_1\ |_{\mathcal{X}_1}\ C_1 \hspace{5mm} \Gamma, \Gamma_0 \vdash e_2 : \mathcal{T}_2\ |_{\mathcal{X}_2}\ C_2\\ &\mathcal{X}_0 \cap \mathcal{X}_1 \cap \mathcal{X}_2 = \varnothing \hspace{5mm} C = C_0 \cup C_1 \cup C_2 \cup \{ \mathcal{T}_0 = \mathcal{T}_1 \} \end{aligned} }{ \Gamma \vdash (\mathtt{let1}\ \mathcal{P}_{let}\ e_1\ e_2) : \mathcal{T}_2\ |_{\mathcal{X}_0 \cup \mathcal{X}_1 \cup \mathcal{X}_2}\ C }$} & (T-Let1) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash e_1 : \mathcal{T}_1\ |_{\mathcal{X}_1}\ C_1 \hspace{5mm} \Gamma \vdash e_2 : \mathcal{T}_2\ |_{\mathcal{X}_2}\ C_2 \hspace{5mm} \Gamma \vdash e_3 : \mathcal{T}_3\ |_{\mathcal{X}_3}\ C_3 \\ &\mathcal{X}_1 \cap \mathcal{X}_2 \cap \mathcal{X}_3 = \varnothing \hspace{5mm} C = C_1 \cup C_2 \cup C_3 \cup \{ \mathcal{T}_1 = \mathtt{Bool}, \mathcal{T}_2 = T_3 \} \end{aligned} }{ \Gamma \vdash (\mathtt{if}\ e_1\ e_2\ e_3) : \mathcal{T}_2\ |_{\mathcal{X}_1 \cup \mathcal{X}_2 \cup \mathcal{X}_3}\ C }$} & (T-If) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash e_1 : \mathcal{T}_1\ |_{\mathcal{X}_1}\ C_1 \hspace{5mm} \Gamma \vdash e_2 : \mathcal{T}_2\ |_{\mathcal{X}_2}\ C_2 \land \cdots \land \Gamma \vdash e_n : \mathcal{T}_n\ |_{\mathcal{X}_n}\ C_n \\ &\{t\} \cap FV_\Gamma(\Gamma) = \varnothing \hspace{5mm} \{t\} \cap \mathcal{X}_1 \cap \cdots \cap \mathcal{X}_n = \varnothing\\ &\mathcal{X} = \{t\} \cup \mathcal{X}_1 \cup \cdots \cup \mathcal{X}_n \hspace{5mm} E = E_\mathcal{T}(\mathcal{T}_1) \\ &C = C_1 \cup \cdots \cup C_n \cup \{ \mathcal{T}_1 = (E\ (\rightarrow\ (\mathcal{T}_2\ \cdots\ \mathcal{T}_n)\ t)) \} \end{aligned} }{ \Gamma \vdash (e_1\ e_2\ \cdots\ e_n) : t\ |_\mathcal{X}\ C }$} & (T-App) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash e_0 : \mathcal{T}_0\ |_{\mathcal{X}_0}\ C_0 \\ &\Gamma, \Gamma_1 \vdash e_1 : \mathcal{T}_{e1}\ |_{\mathcal{X}_{e1}}\ C_{e1} \land \cdots \land \Gamma, \Gamma_n \vdash e_n : \mathcal{T}_{en}\ |_{\mathcal{X}_{en}}\ C_{en} \\ &\Gamma_1 \vdash \mathcal{P}_1 : \mathcal{T}_{p1}\ |_{\mathcal{X}_{p1}}\ C_{p1} \land \cdots \land \Gamma_n \vdash \mathcal{P}_{pn} : \mathcal{T}_{pn}\ |_{\mathcal{X}_{pn}}\ C_{pn} \\ &\mathcal{X}_0 \cap \mathcal{X}_{e1} \cap \cdots \cap \mathcal{X}_{en} \cap \mathcal{X}_{p1} \cap \cdots \cap \mathcal{X}_{pn} = \varnothing \\ &\mathcal{X} = \mathcal{X}_0 \cup \mathcal{X}_{e1} \cup \cdots \cup \mathcal{X}_{en} \cup \mathcal{X}_{p1} \cup \cdots \cup \mathcal{X}_{pn} \\ &\begin{aligned} C =\ &C_0 \cup C_{e1} \cup \cdots \cup C_{en} \cup C_{p1} \cup \cdots \cup C_{pn} \cup \\ &\{\mathcal{T}_0 = \mathcal{T}_{p1}, \cdots, \mathcal{T}_0 = \mathcal{T}_{pn}\} \cup \{\mathcal{T}_{e1} = \mathcal{T}_{e2}, \cdots, \mathcal{T}_{e1} = \mathcal{T}_{en}\} \end{aligned} \end{aligned} }{ \Gamma \vdash (\mathtt{match}\ e_0\ (\mathcal{P}_1\ e_1)\ \cdots\ (\mathcal{P}_n\ e_n)) : T_{e1}\ |_\mathcal{X}\ C }$} & (T-Match) \end{tabular} \caption{Typing rule (1/2)} \label{fig:typing1} \end{figure} \begin{figure}[tb] \centering \begin{tabular}{rlrl} $\Gamma \vdash\ '() :\ '(T)\ |_{\{T\}}\ \varnothing$ & (T-Nil) & $\dfrac{L : \mathcal{T}' \in \Gamma \hspace{5mm} \mathcal{T}' \cdot \mathcal{S} \equiv_\alpha \mathcal{T}}{\Gamma \vdash L : \mathcal{T}\ |_{FV_\mathcal{T}(\mathcal{T})}\ \varnothing}$ & (T-Label0) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash e_1 : T_1\ |_{\mathcal{X}_1}\ C_1 \land \cdots \land \Gamma \vdash e_n : T_n\ |_{\mathcal{X}_n}\ C_n \\ &\mathcal{X}_1 \cap \cdots \cap \mathcal{X}_n = \varnothing \hspace{5mm} \mathcal{X} = \mathcal{X}_1 \cup \cdots \cup \mathcal{X}_n \hspace{5mm} C = C_1 \cup \cdots \cup C_n \end{aligned} }{\Gamma \vdash [e_1\ \cdots\ e_n] : [T_1\ \cdots\ T_n]\ |_\mathcal{X}\ C}$ } & (T-Tuple) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash e_1 : T_1\ |_{\mathcal{X}_1}\ C_1 \land \cdots \land \Gamma \vdash e_n : T_n\ |_{\mathcal{X}_n}\ C_n \\ &\mathcal{X}_1 \cap \cdots \cap \mathcal{X}_n = \varnothing \hspace{5mm} \mathcal{X} = \mathcal{X}_1 \cup \cdots \cup \mathcal{X}_n \\ &C = C_1 \cup \cdots \cup C_n \cup \{T_1 = T_2, \cdots, T_1 = T_n \} \end{aligned} }{\Gamma \vdash\ '(e_1\ \cdots\ e_n) :\ '(T_1)\ |_\mathcal{X}\ C}$ } & (T-List) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash e_1 : \mathcal{T}_1\ |_{\mathcal{X}_1}\ C_1 \land \cdots \land \Gamma \vdash e_n : \mathcal{T}_n\ |_{\mathcal{X}_n}\ C_n \\ &L : \mathcal{T}_0' \in \Gamma \hspace{5mm} \mathcal{T}_0' \cdot \mathcal{S}\equiv_\alpha \mathcal{T}_0 \hspace{5mm} FV(\mathcal{T}_0) \cap \mathcal{X}_1 \cap \cdots \cap \mathcal{X}_n = \varnothing \\ &FV_\mathcal{T}(\mathcal{T}_0) \cap FV_\Gamma(\Gamma) = \varnothing \hspace{5mm} \mathcal{X} = FV(\mathcal{T}_0) \cup \mathcal{X}_1 \cup \cdots \cup \mathcal{X}_n \\ &L_{1st} : T_1' \in \Gamma \land \cdots \land L_{nth} : T_n' \in \Gamma \\ &C = C_1 \cup \cdots \cup C_n \cup \{T_1' \cdot \mathcal{S} = \mathcal{T}_1, \cdots, T_n' \cdot \mathcal{S} = \mathcal{T}_n\} \\ \end{aligned} }{ \Gamma \vdash (L\ e_1\ \cdots\ e_n) : \mathcal{T}_0\ |_{\mathcal{X}}\ C }$} & (T-Label) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma, x_1 : t_1, \cdots, x_n : t_n \vdash e : \mathcal{T}_0\ |_{\mathcal{X}}\ C_0 \hspace{5mm} \neg io(C)\\ &C = \{\mathcal{T} = (\mathtt{Pure}\ (\rightarrow\ (t_1\ \cdots\ t_n)\ \mathcal{T}_0))\} \cup C_0 \end{aligned} } { \Gamma \vdash (\mathtt{lambda}\ (x_1\ \cdots\ x_n)\ e) : \mathcal{T}\ |_\mathcal{X}\ C }$ } & (T-Lambda) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma, x_1 : t_1, \cdots, x_n : t_n \vdash e : \mathcal{T}_0\ |_{\mathcal{X}}\ C_0 \hspace{5mm}\\ &E = E_\mathcal{T}(\mathcal{T}) \hspace{5mm} (E = \mathtt{Pure}) \Rightarrow \neg io(C)\\ &C = C_0 \cup \{\mathcal{T} = (E\ (\rightarrow (\mathcal{T}_1\ \cdots\ \mathcal{T}_n)\ \mathcal{T}_0)) \} \end{aligned} }{ \Gamma \vdash (\mathtt{defun}\ \mathrm{name}\ (x_1\ \cdots\ x_n)\ \mathcal{T}\ e) : \mathcal{T}\ |_\mathcal{X}\ C }$ } & (T-Defun) \end{tabular} \caption{Typing rule (2/2)} \label{fig:typing2} \end{figure} \begin{figure}[tb] \centering \begin{tabular}{rlrl} $\Gamma \vdash \mathtt{true} : \mathtt{Bool}\ |_\varnothing\ \varnothing$ & (P-True) & $\Gamma \vdash \mathtt{false} : \mathtt{Bool}\ |_\varnothing\ \varnothing$ & (P-False) \vspace{5mm} \\ $\dfrac{x : T \in \Gamma}{\Gamma \vdash x : T\ |_\varnothing\ \varnothing}$ & (P-Var) & $\Gamma \vdash z : \mathtt{Int}\ |_\varnothing\ \varnothing$ & (P-Num) \vspace{5mm} \\ $\Gamma \vdash\ '() :\ '(T)\ |_{\{T\}}\ \varnothing$ & (P-Nil) & $\dfrac{L : \mathcal{T}' \in \Gamma \hspace{5mm} \mathcal{T}' \cdot \mathcal{S} \equiv_\alpha \mathcal{T}}{\Gamma \vdash L : \mathcal{T}\ |_{FV_\mathcal{T}(\mathcal{T})}\ \varnothing}$ & (P-Label0) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash \mathcal{P}_1 : \mathcal{T}_1\ |_{\mathcal{X}_1}\ C_1 \land \cdots \land \Gamma \vdash \mathcal{P}_n : \mathcal{T}_n\ |_{\mathcal{X}_n}\ C_n \\ &L : \mathcal{T}_0' \in \Gamma \hspace{5mm} \mathcal{T}_0' \cdot \mathcal{S}\equiv_\alpha \mathcal{T}_0 \hspace{5mm} FV(\mathcal{T}_0) \cap \mathcal{X}_1 \cap \cdots \cap \mathcal{X}_n = \varnothing \\ &FV_\mathcal{T}(\mathcal{T}_0) \cap FV_\Gamma(\Gamma) = \varnothing \hspace{5mm} \mathcal{X} = FV(\mathcal{T}_0) \cup \mathcal{X}_1 \cup \cdots \cup \mathcal{X}_n \\ &L_{1st} : T_1' \in \Gamma \land \cdots \land L_{nth} : T_n' \in \Gamma \\ &C = C_1 \cup \cdots \cup C_n \cup \{T_1' \cdot \mathcal{S} = \mathcal{T}_1, \cdots, T_n' \cdot \mathcal{S} = \mathcal{T}_n\} \\ &Size(L) = 1\ \mbox{for only}\ P_{let} \end{aligned} }{ \Gamma \vdash (L\ \mathcal{P}_1\ \cdots\ \mathcal{P}_n) : \mathcal{T}_0\ |_{\mathcal{X}}\ C }$} & (P-Label) \vspace{5mm} \\ \multicolumn{3}{r}{ $\dfrac{ \begin{aligned} &\Gamma \vdash \mathcal{P}_1 : \mathcal{T}_1\ |_{\mathcal{X}_1}\ C_1 \land \cdots \land \Gamma \vdash \mathcal{P}_n : \mathcal{T}_n\ |_{\mathcal{X}_n}\ C_n \\ &\mathcal{X}_1 \cap \cdots \cap \mathcal{X}_n = \varnothing \hspace{5mm} \mathcal{X} = \mathcal{X}_1 \cup \cdots \cup \mathcal{X}_n \hspace{5mm} C = C_1 \cup \cdots \cup C_n \end{aligned} }{ \Gamma \vdash [\mathcal{P}_1\ \cdots\ \mathcal{P}_n] : [\mathcal{T}_1 \cdots \mathcal{T}_n]\ |_{\mathcal{X}}\ C }$} & (P-Tuple) \\ \end{tabular} \caption{Typing rule of pattern} \end{figure} \section{Typing Rule} In this section, I will introduce the typing rule of Baremetalisp. Before describing the rule, I introduce an assumption that there is no variable shadowing to make it simple. This means that every variable should be properly $\alpha$-converted by using the De Bruijn index technique or variable shadowing should be handled when implementing the type inference algorithm. Fig.~\ref{fig:typing1} and \ref{fig:typing2} are the typing rule of expressions and function definitions. \section{Effect} \label{sec:effect} \end{document} ================================================ FILE: src/coq.rs ================================================ use super::semantics as S; use alloc::{ collections::LinkedList, format, string::{String, ToString}, vec::Vec, }; pub(crate) fn to_coq_type( expr: &S::TypeExpr, depth: usize, targs: &mut LinkedList, ) -> String { match expr { S::TypeExpr::Bool(_) => "bool".to_string(), S::TypeExpr::Int(_) => "Z".to_string(), S::TypeExpr::String(_) => "string".to_string(), S::TypeExpr::Char(_) => "ascii".to_string(), S::TypeExpr::Id(e) => { if let Some(c) = e.id.chars().next() { if c.is_ascii_lowercase() { let mut flag = false; for s in targs.iter() { if *s == e.id { flag = true; } } if !flag { targs.push_back(e.id.clone()); } } } e.id.clone() } S::TypeExpr::Tuple(e) => { if e.ty.is_empty() { return "unit".to_string(); } let mut i = 0; let mut s = "".to_string(); for t in e.ty.iter() { i += 1; if i == e.ty.len() { s = format!("{}{}", s, to_coq_type(t, depth + 1, targs)); } else { s = format!("{}{} * ", s, to_coq_type(t, depth + 1, targs)); } } if depth > 0 { format!("({})", s) } else { s } } S::TypeExpr::List(e) => { if depth == 0 { format!("list {}", to_coq_type(&e.ty, depth + 1, targs)) } else { format!("(list {})", to_coq_type(&e.ty, depth + 1, targs)) } } S::TypeExpr::Data(e) => { if e.type_args.is_empty() { e.id.id.clone() } else { let mut args = "".to_string(); for arg in e.type_args.iter() { args = format!("{}{}", args, to_coq_type(arg, depth + 1, targs)); } if depth == 0 { format!("{} {}", e.id.id, args) } else { format!("({} {})", e.id.id, args) } } } S::TypeExpr::Fun(e) => { let mut s = "".to_string(); // ここがおかしいかも for (i, arg) in e.args.iter().enumerate() { if i == 0 { s = to_coq_type(arg, depth + 1, targs); } else { //s = format!("{} -> {}", s, to_coq_type(arg, depth + 1, targs)); s = format!("{} -> {}", s, to_coq_type(arg, depth + 1, targs)); } } s = format!("{} -> {}", s, to_coq_type(&e.ret, depth + 1, targs)); if depth > 0 { format!("({})", s) } else { s } } } } pub(crate) fn import() -> &'static str { "Require Import ZArith. Require Import Coq.Lists.List." /*\n Inductive tuple5 (A, B, C, D, E:Type): Type := | tup5 (x0: A, x1: B, x2: C, x3: D, x4: E). Inductive tuple4 (A, B, C, D:Type): Type := | tup4 (x0: A, x1: B, x2: C, x3: D). Inductive tuple3 (A, B, C:Type): Type := | tup3 (x0: A, x1: B, x2: C). Inductive tuple2 (A, B:Type): Type := | tup2 (x0: A, x1: B). Inductive tuple1 (A:Type): Type := | tup1 (x0: A). Inductive tuple0 : Type := | tup0."*/ } pub(crate) fn to_coq_data(expr: &S::DataType) -> String { let mut mem = "".to_string(); let mut i = 0; for d in expr.members.iter() { i += 1; if i == expr.members.len() { mem = format!("{}{}.\n", mem, to_coq_data_mem(d)); } else { mem = format!("{}{}\n", mem, to_coq_data_mem(d)); } } if expr.members.is_empty() { format!("Inductive {}\n{}", to_coq_data_def(&expr.name), mem) } else { let extend = inductive_arguments(expr); format!( "Inductive {}\n{}{}\n", to_coq_data_def(&expr.name), mem, extend ) } } fn to_coq_data_def(expr: &S::DataTypeName) -> String { let mut args = "(".to_string(); let mut i = 0; for t in expr.type_args.iter() { i += 1; if expr.type_args.len() == i { args = format!("{}{}: Type)", args, t.id); } else { args = format!("{}{} ", args, t.id); } } if !expr.type_args.is_empty() { format!("{} {}: Type :=", expr.id.id, args) } else { format!("{}: Type :=", expr.id.id) } } fn to_coq_data_mem(expr: &S::DataTypeMem) -> String { let mut mem = "".to_string(); for (i, t) in expr.types.iter().enumerate() { let mut targs = LinkedList::new(); if expr.types.len() == i + 1 { mem = format!("{}(x{}: {})", mem, i, to_coq_type(t, 0, &mut targs)); } else { mem = format!("{}(x{}: {}) ", mem, i, to_coq_type(t, 0, &mut targs)); } } if !expr.types.is_empty() { format!("| {} {}", expr.id.id, mem) } else { format!("| {}", expr.id.id) } } fn to_args_type(args: &LinkedList, ty: &str) -> String { let mut s = "(".to_string(); let mut i = 0; for a in args { i += 1; if i == args.len() { s = format!("{}{}: {})", s, a, ty); } else { s = format!("{}{} ", s, a); } } s } fn inductive_arguments(expr: &S::DataType) -> String { let mut add_expr = "".to_string(); for t in &expr.members { let mut temp = "".to_string(); for (i, _id) in expr.name.type_args.iter().enumerate() { match i { 0 => temp = format!("{}{}", temp, _id.id), _ => temp = format!("{} {}", temp, _id.id), } } add_expr = format!("{}\nArguments {}{{{}}}.", add_expr, t.id.id, temp); } add_expr } pub(crate) fn to_coq_func(expr: &S::Defun) -> String { let head = if is_recursive(expr) { format!("Fixpoint {}", expr.id.id) } else { format!("Definition {}", expr.id.id) }; let fun_type = if let S::TypeExpr::Fun(e) = &expr.fun_type { e } else { return "".to_string(); }; // transpile arguments // arguments whose types are same are aggregated let mut args = "".to_string(); let mut targs = LinkedList::new(); let mut args_list = LinkedList::new(); let mut prev = "".to_string(); for (arg, t) in expr.args.iter().zip(fun_type.args.iter()) { let ta = to_coq_type(t, 0, &mut targs); if prev.is_empty() { prev = ta.clone(); } if prev != ta { let s = to_args_type(&args_list, &prev); args = format!("{} {}", args, s); args_list.clear(); args_list.push_back(arg.id.clone()); prev = ta; } else { args_list.push_back(arg.id.clone()); } } let s = to_args_type(&args_list, &prev); args = format!("{} {}", args, s); // transpile return type let ret = to_coq_type(&fun_type.ret, 0, &mut targs); //indent count let mut tab_count = 0; let tl_expr = func_analyze(&expr.expr, &mut tab_count); // if there is no type argument, then return if targs.is_empty() { return format!("{}{}: {} :=\n{}.\n", head, args, ret, tl_expr); } // transpile type arguments let mut s_targs = "{".to_string(); let mut i = 0; for targ in &targs { i += 1; if i == targs.len() { s_targs = format!("{}{}", s_targs, targ); } else { s_targs = format!("{}{} ", s_targs, targ); } } s_targs = format!("{}: Type}}", s_targs); format!("{} {}{}: {} :=\n{}.\n", head, s_targs, args, ret, tl_expr) } fn func_analyze(expr: &S::LangExpr, count: &mut i32) -> String { match expr { S::LangExpr::IfExpr(ex) => { let mut if_expr = "".to_string(); if_expr = format!( "{}match {} with\n", if_expr, func_analyze(&ex.cond_expr, count) ); *count += 2; let tab_expr = tabb(*count); if_expr = format!( "{}{}| true => {}\n", if_expr, tab_expr, func_analyze(&ex.then_expr, count) ); if_expr = format!( "{}{}| false => {}\n", if_expr, tab_expr, func_analyze(&ex.else_expr, count) ); *count -= 2; format!("{}{}end", if_expr, tabb(*count + 2)) } S::LangExpr::LetExpr(ex) => { let mut let_expr = "".to_string(); if ex.def_vars.is_empty() { return let_expr; } for t in &ex.def_vars { let_expr = format!( "{}let {} = {} in\n", let_expr, pattern_analyze(&t.pattern), func_analyze(&t.expr, count) ); } let_expr } S::LangExpr::LitStr(ex) => ex.str.to_string(), S::LangExpr::LitChar(ex) => ex.c.to_string(), S::LangExpr::LitNum(ex) => ex.num.to_string(), S::LangExpr::LitBool(ex) => ex.val.to_string(), S::LangExpr::IDExpr(ex) => ex.id.to_string(), S::LangExpr::DataExpr(ex) => { let mut data_expr = "".to_string(); let temp: &str = &ex.label.id; let temp1 = match temp { "Cons" => "cons".to_string(), _ => temp.to_string(), }; data_expr = format!("{}({}", data_expr, temp1); if !&ex.exprs.is_empty() { for t in &ex.exprs { data_expr = format!("{} {}", data_expr, func_analyze(t, count)); } } format!("{})", data_expr) } S::LangExpr::MatchExpr(ex) => { let mut match_expr = "match".to_string(); match_expr = format!("{} {} with", match_expr, func_analyze(&ex.expr, count)); *count += 2; let tab_expr = tabb(*count); let mut case_expr = "".to_string(); for t in &ex.cases { case_expr = format!( "{}\n{}| {} => {}", case_expr, tab_expr, pattern_analyze(&t.pattern), func_analyze(&t.expr, count) ); } *count -= 2; format!("{}{}\n{}end", match_expr, case_expr, tabb(*count + 2)) } S::LangExpr::ApplyExpr(ex) => { let mut apply_expr = "(".to_string(); let mut store: Option = None; for t in &ex.exprs { let temp = func_analyze(t, count); match apply_arith(temp.clone()) { Some(_) => { store = apply_arith(temp); } None => { match store { Some(y) => apply_expr = format!("{} {} {}", apply_expr, temp, y), None => apply_expr = format!("{}{} ", apply_expr, temp), } store = None; } } } format!("{})", apply_expr) } S::LangExpr::ListExpr(ex) => { if ex.exprs.is_empty() { return "nil".to_string(); } let mut list_expr = "".to_string(); let mut temp = "".to_string(); for (_i, t) in ex.exprs.iter().enumerate() { list_expr = format!("{}(cons {} ", list_expr, func_analyze(t, count)); temp = format!("{})", temp); } format!("{}nil{}", list_expr, temp) } S::LangExpr::TupleExpr(ex) => { let length = &ex.exprs.len(); let mut tupple_expr = format!("tup{}", &length); match length { 0 => tupple_expr, _ => { tupple_expr = format!("{} (", tupple_expr); for t in &ex.exprs { tupple_expr = format!("{} {}", tupple_expr, func_analyze(t, count)); } format!("{})", tupple_expr) } } } S::LangExpr::LambdaExpr(ex) => { let mut lambda_expr = "fun".to_string(); if ex.args.is_empty() { lambda_expr = format!("{} _", lambda_expr); } else { for t in &ex.args { lambda_expr = format!("{} {}", lambda_expr, t.id); } } format!("{} => {}", lambda_expr, func_analyze(&ex.expr, count)) } } } fn pattern_analyze(pattern: &S::Pattern) -> String { match pattern { S::Pattern::PatStr(ex) => ex.str.to_string(), S::Pattern::PatChar(ex) => ex.c.to_string(), S::Pattern::PatNum(ex) => ex.num.to_string(), S::Pattern::PatBool(ex) => ex.val.to_string(), S::Pattern::PatID(ex) => ex.id.to_string(), S::Pattern::PatTuple(ex) => { let mut pattern_expr = "".to_string(); let length = &ex.pattern.len(); if ex.pattern.is_empty() { return format!("{}tup{}", pattern_expr, length); } pattern_expr = format!("{}tup{} (", pattern_expr, length); for t in &ex.pattern { pattern_expr = format!("{} {}", pattern_expr, pattern_analyze(t)); } format!("{})", pattern_expr) } S::Pattern::PatData(ex) => { let mut pattern_expr = "".to_string(); let temp: &str = &ex.label.id; let temp = match temp { "Cons" => "cons".to_string(), _ => temp.to_string(), }; pattern_expr = format!("{}({}", pattern_expr, temp); for t in &ex.pattern { pattern_expr = format!("{} {}", pattern_expr, pattern_analyze(t)); } format!("{})", pattern_expr) } S::Pattern::PatNil(_) => "_".to_string(), } } fn apply_arith(expr: String) -> Option { let temp: Vec = expr.chars().collect(); match temp[0] { '+' => Some(String::from("+")), '-' => Some(String::from("-")), '*' => Some(String::from("*")), '/' => Some(String::from("/")), '%' => Some(String::from("%")), _ => None, } } fn tabb(count: i32) -> String { let mut tab_expr = "".to_string(); for _ in 1..=count { tab_expr = format!("{} ", tab_expr); } tab_expr } fn is_recursive(expr: &S::Defun) -> bool { is_recursive_expr(&expr.expr, &expr.id.id) } fn is_recursive_expr(expr: &S::LangExpr, id: &str) -> bool { match expr { S::LangExpr::IfExpr(e) => { is_recursive_expr(&e.cond_expr, id) || is_recursive_expr(&e.then_expr, id) || is_recursive_expr(&e.else_expr, id) } S::LangExpr::LetExpr(e) => is_recursive_expr(&e.expr, id), S::LangExpr::LitStr(_) => false, S::LangExpr::LitChar(_) => false, S::LangExpr::LitNum(_) => false, S::LangExpr::LitBool(_) => false, S::LangExpr::IDExpr(e) => e.id == *id, S::LangExpr::DataExpr(e) => is_recursive_exprs(&e.exprs, id), S::LangExpr::MatchExpr(e) => { if is_recursive_expr(&e.expr, id) { return true; } for c in e.cases.iter() { if is_recursive_expr(&c.expr, id) { return true; } } false } S::LangExpr::ApplyExpr(e) => is_recursive_exprs(&e.exprs, id), S::LangExpr::ListExpr(e) => is_recursive_exprs(&e.exprs, id), S::LangExpr::TupleExpr(e) => is_recursive_exprs(&e.exprs, id), S::LangExpr::LambdaExpr(e) => is_recursive_expr(&e.expr, id), } } fn is_recursive_exprs(exprs: &[S::LangExpr], id: &str) -> bool { for e in exprs.iter() { if is_recursive_expr(e, id) { return true; } } false } ================================================ FILE: src/lib.rs ================================================ //! # BLisp //! //! BLisp is a well typed Lisp like programming language which adopts effect //! system for no_std environments. //! BLisp supports higher order RPCs like higher order functions //! of functional programing languages. //! //! This repository provides only a library crate. //! Please see [blisp-repl](https://github.com/ytakano/blisp-repl) to use BLisp, //! or [baremetalisp](https://github.com/ytakano/baremetalisp) which is a toy OS. //! //! [Homepage](https://ytakano.github.io/blisp/) is here. //! //! ## Features //! //! - Algebraic data type //! - Generics //! - Hindley–Milner based type inference //! - Effect system to separate side effects from pure functions //! - Big integer //! - Supporting no_std environments //! //! ## Examples //! //! ### Simple Eval //! //! ``` //! let code = " //! (export factorial (n) (Pure (-> (Int) Int)) //! (factorial' n 1)) //! //! (defun factorial' (n total) (Pure (-> (Int Int) Int)) //! (if (<= n 0) //! total //! (factorial' (- n 1) (* n total))))"; //! //! let exprs = blisp::init(code, vec![]).unwrap(); //! let ctx = blisp::typing(exprs).unwrap(); //! let expr = "(factorial 10)"; //! for result in blisp::eval(expr, &ctx).unwrap() { //! println!("{}", result.unwrap()); //! } //! ``` //! //! ### Foreign Function Interface //! //! ``` //! use blisp::{self, embedded}; //! use num_bigint::BigInt; //! //! #[embedded] //! fn add_four_ints(a: BigInt, b: (BigInt, BigInt), c: Option) -> Result { //! let mut result = a + b.0 + b.1; //! if let Some(n) = c { //! result += n; //! } //! //! Ok(result) //! } //! //! let code = " //! (export call_add_four_ints (n) //! (IO (-> ((Option Int)) (Result Int String))) //! (add_four_ints 1 [2 3] n))"; // call `add_four_ints` in Rust here. //! //! let exprs = blisp::init(code, vec![Box::new(AddFourInts)]).unwrap(); // extern `add_four_ints` //! let ctx = blisp::typing(exprs).unwrap(); //! let result = blisp::eval("(call_add_four_ints (Some 4))", &ctx).unwrap(); //! //! let front = result.front().unwrap().as_ref().unwrap(); //! assert_eq!(front, "(Ok 10)"); //! ``` //! //! ### Expressions //! //! ```lisp //! "Hello, World!" ; string //! (+ 0x10 0x20) ; 48 //! (+ 0b111 0b101) ; 12 //! (+ 0o777 0o444) ; 803 //! (car '(1 2 3)) ; (Some 1) //! (cdr '(1 2 3)) ; '(2 3) //! (map (lambda (x) (* x 2)) '(8 9 10)) ; '(16 18 20) //! (fold + 0 '(1 2 3 4 5 6 7 8 9)) ; 45 //! (reverse '(1 2 3 4 5 6 7 8 9)) ; '(9 8 7 6 5 4 3 2 1) //! (filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9)) ; '(2 4 6 8) //! ``` #![cfg_attr(not(test), no_std)] extern crate alloc; use core::fmt::Display; use alloc::{ boxed::Box, collections::linked_list::LinkedList, format, string::{String, ToString}, vec::Vec, }; pub mod coq; pub mod r#macro; pub mod parser; pub mod runtime; pub mod semantics; pub use blisp_embedded::embedded; use r#macro::{process_macros, Macros}; use runtime::FFI; #[derive(Debug, Clone, Copy)] pub enum FileType { Prelude, User, Eval, Extern(u64), } /// indicate a position of file #[derive(Debug, Clone, Copy)] pub struct Pos { pub file_id: FileType, pub line: usize, // line number, 0 origin pub column: usize, // column number, 0 origin } impl Display for Pos { fn fmt(&self, f: &mut core::fmt::Formatter<'_>) -> core::fmt::Result { write!(f, "{:?}:{}:{}", self.file_id, self.line, self.column) } } /// error message #[derive(Debug)] pub struct LispErr { pub msg: String, pub pos: Pos, } impl LispErr { fn new(msg: String, pos: Pos) -> LispErr { LispErr { msg, pos } } } pub struct TypingContext { exprs: LinkedList, ext_funs: Vec>, macros: Macros, } /// initialize BLisp with code /// /// # Example /// /// ``` /// let code = "(export factorial (n) (Pure (-> (Int) Int)) /// (if (<= n 0) /// 1 /// (* n (factorial (- n 1)))))"; /// /// blisp::init(code, vec![]).unwrap(); /// ``` pub fn init(code: &str, ext_funs: Vec>) -> Result { let prelude = include_str!("prelude.lisp"); // let prelude = ""; let mut ps = parser::Parser::new(prelude, FileType::Prelude); let mut exprs = match ps.parse() { Ok(e) => e, Err(e) => { let msg = format!("Syntax Error: {}", e.msg); return Err(LispErr::new(msg, e.pos)); } }; for (i, fun) in ext_funs.iter().enumerate() { let mut ps = parser::Parser::new(fun.blisp_extern(), FileType::Extern(i as u64)); match ps.parse() { Ok(mut e) => { exprs.append(&mut e); } Err(e) => { let msg = format!("Syntax Error: {}", e.msg); return Err(LispErr::new(msg, e.pos)); } } } let mut ps = parser::Parser::new(code, FileType::User); match ps.parse() { Ok(mut e) => { exprs.append(&mut e); let macros = match process_macros(&mut exprs) { Ok(macros) => macros, Err(e) => { let msg = format!("Macro Error: {}", e.msg); return Err(LispErr::new(msg, e.pos)); } }; Ok(TypingContext { exprs, ext_funs, macros, }) } Err(e) => { let msg = format!("Syntax Error: {}", e.msg); Err(LispErr::new(msg, e.pos)) } } } /// perform type checking and inference /// /// # Example /// /// ``` /// let code = "(export factorial (n) (Pure (-> (Int) Int)) /// (if (<= n 0) /// 1 /// (* n (factorial (- n 1)))))"; /// /// let exprs = blisp::init(code, vec![]).unwrap(); /// blisp::typing(exprs).unwrap(); /// ``` pub fn typing(exprs: TypingContext) -> Result { match semantics::exprs2context(exprs) { Ok(c) => Ok(c), Err(e) => { let msg = format!("Typing Error: {}", e.msg); Err(LispErr::new(msg, e.pos)) } } } /// evaluate an expression /// /// # Example /// /// ``` /// let code = "(export factorial (n) (Pure (-> (Int) Int)) /// (if (<= n 0) /// 1 /// (* n (factorial (- n 1)))))"; /// /// let exprs = blisp::init(code, vec![]).unwrap(); /// let ctx = blisp::typing(exprs).unwrap(); /// let expr = "(factorial 30)"; /// for result in blisp::eval(expr, &ctx).unwrap() { /// println!("{}", result.unwrap()); /// } /// ``` pub fn eval( code: &str, ctx: &semantics::Context, ) -> Result>, LispErr> { runtime::eval(code, ctx) } pub fn transpile(ctx: &semantics::Context) -> String { let mut s = "".to_string(); for (_, d) in ctx.data.iter() { s = format!("{}{}\n", s, coq::to_coq_data(d)); } for (_, f) in ctx.funs.iter() { s = format!("{}{}\n", s, coq::to_coq_func(f)); } format!("{}\n\n{}", coq::import(), s) } #[cfg(test)] mod tests { use super::*; fn eval_first(code: &str, ctx: &semantics::Context) -> String { eval(code, ctx) .unwrap() .front() .unwrap() .as_ref() .unwrap() .clone() } #[test] fn test_macro() { let expr = " (macro add ((add $e1 $e2) (+ $e1 $e2)) ((add $e1 $e2 $e3 ...) (+ $e1 (add $e2 $e3 ...)))) (macro minus ((_ $e1 $e2) (- $e1 $e2)) ((_ $e1 $e2 $e3 ...) (- $e1 (minus $e2 $e3 ...)))) (macro tuple_to_list ((_ []) ((lambda (x) x) '())) ((_ [$e ...]) ((lambda (x) x) '($e ...)))) (macro none ((_ _) ([]))) (tuple_to_list []) (tuple_to_list [1 2 3]) (add 1 2 3 4 5) (defun test_add () (Pure (-> () Int)) (add 1 2 3 4 (minus 5 6 7) 8)) (add 1) (none 123) "; let typing_context = init(expr, vec![]).unwrap(); for expr in typing_context.exprs.iter() { println!("{expr}"); } } #[test] fn test_macro_hygiene_lambda() { let expr = " (macro with_tmp ((_ $x) ((lambda (tmp) (+ tmp $x)) 1))) (export test (tmp) (Pure (-> (Int) Int)) (with_tmp tmp)) "; let ctx = typing(init(expr, vec![]).unwrap()).unwrap(); assert_eq!(eval_first("(test 10)", &ctx), "11"); } #[test] fn test_macro_hygiene_let() { let expr = " (macro with_tmp ((_ $x) (let ((tmp 1)) (+ tmp $x)))) (export test (tmp) (Pure (-> (Int) Int)) (with_tmp tmp)) "; let ctx = typing(init(expr, vec![]).unwrap()).unwrap(); assert_eq!(eval_first("(test 10)", &ctx), "11"); } #[test] fn test_macro_hygiene_match() { let expr = " (macro match_some ((_ $x) (match (Some 1) ((Some v) (+ v $x)) (None 0)))) (export test (v) (Pure (-> (Int) Int)) (match_some v)) "; let ctx = typing(init(expr, vec![]).unwrap()).unwrap(); assert_eq!(eval_first("(test 10)", &ctx), "11"); } fn eval_result(code: &str, ctx: &semantics::Context) { for r in eval(code, ctx).unwrap() { println!("{} -> {}", code, r.unwrap()); } } #[test] fn ops() { let exprs = init("", vec![]).unwrap(); let ctx = typing(exprs).unwrap(); eval_result("(neq (Some \"Hello\") 10)", &ctx); eval_result("(chars \"Hello, World!\")", &ctx); eval_result("(str '(`H` `e` `l` `l` `o`))", &ctx); eval_result("`\\``", &ctx); eval_result("(= `h` `h`)", &ctx); eval_result("(<< 8 4)", &ctx); eval_result("(>> 128 4)", &ctx); eval_result("\"Hello, World!\"", &ctx); eval_result("(= \"Hello, World!\" \"Hello, World!\")", &ctx); eval_result("(= (Some 1) (Some 2))", &ctx); eval_result("(< (Some 1) (Some 2))", &ctx); eval_result("(> (Some 1) (Some 2))", &ctx); eval_result("(= \"Hello\" \"Hel\")", &ctx); eval_result("(eq \"Hello\" 10)", &ctx); eval_result("(lt \"Hello\" 10)", &ctx); eval_result("(lt 5 10)", &ctx); eval_result("(+ 0x10 0x20)", &ctx); eval_result("(+ 0b111 0b101)", &ctx); eval_result("(+ 0o777 0o444)", &ctx); eval_result("(+ 10 20)", &ctx); eval_result("(pow 10 20)", &ctx); eval_result("(band 1 0)", &ctx); eval_result("(band 1 1)", &ctx); eval_result("(bor 1 0)", &ctx); eval_result("(bor 1 1)", &ctx); eval_result("(bxor 1 0)", &ctx); eval_result("(bxor 1 1)", &ctx); eval_result("(sqrt 16)", &ctx); eval_result("(sqrt -1)", &ctx); } #[test] fn lambda() { let expr = "(export lambda-test (f) (Pure (-> ((Pure (-> (Int Int) Int))) Int)) (f 10 20)) "; let exprs = init(expr, vec![]).unwrap(); let ctx = typing(exprs).unwrap(); let e = "(lambda-test (lambda (x y) (* x y)))"; eval_result(e, &ctx); let e = "(lambda-test +)"; eval_result(e, &ctx); } #[test] fn list() { let expr = " (export head (x) (Pure (-> ('(Int)) (Option Int))) (match x ((Cons n _) (Some n)) (_ None))) (export tail (x) (Pure (-> ('(Int)) (Option Int))) ; match expression (match x (Nil None) ((Cons n Nil) (Some n)) ((Cons _ l) (tail l)))) "; let exprs = init(expr, vec![]).unwrap(); let ctx = typing(exprs).unwrap(); let e = "(head '(30 40 50))"; eval_result(e, &ctx); let e = "(tail '(30 40 50))"; eval_result(e, &ctx); } #[test] fn tuple() { let expr = "(export first (x) (Pure (-> ([Int Bool]) Int)) (match x ([n _] n))) "; let exprs = init(expr, vec![]).unwrap(); let ctx = typing(exprs).unwrap(); let e = "(first [10 false])"; eval_result(e, &ctx); } #[test] fn prelude() { let expr = " (export factorial (n) (Pure (-> (Int) Int)) (factorial' n 1)) (defun factorial' (n total) (Pure (-> (Int Int) Int)) (if (<= n 0) total (factorial' (- n 1) (* n total)))) "; let exprs = init(expr, vec![]).unwrap(); let ctx = typing(exprs).unwrap(); let e = "(Some 10)"; eval_result(e, &ctx); let e = "(car '(1 2 3))"; eval_result(e, &ctx); let e = "(cdr '(1 2 3))"; eval_result(e, &ctx); let e = "(map (lambda (x) (* x 2)) '(8 9 10))"; eval_result(e, &ctx); let e = "(fold + 0 '(1 2 3 4 5 6 7 8 9))"; eval_result(e, &ctx); let e = "(reverse '(1 2 3 4 5 6 7 8 9))"; eval_result(e, &ctx); let e = "(filter (lambda (x) (= (% x 2) 0)) '(1 2 3 4 5 6 7 8 9))"; eval_result(e, &ctx); let e = "(factorial 2000)"; eval_result(e, &ctx); } #[test] fn callback() { let expr = " (export callback (x y z) (IO (-> (Int Int Int) (Option Int))) (call-rust x y z))"; let exprs = init(expr, vec![]).unwrap(); let mut ctx = typing(exprs).unwrap(); use num_bigint::BigInt; use std::boxed::Box; let fun = |x: &BigInt, y: &BigInt, z: &BigInt| { let n = x * y * z; println!("n = {}", n); Some(n) }; ctx.set_callback(Box::new(fun)); let e = "(callback 100 2000 30000)"; eval_result(e, &ctx); } #[test] fn do_transpile() { let expr = " (defun snoc (l y) (Pure (-> ( '(t) t) '(t))) (match l (nil (Cons y nil)) ((Cons h b) (Cons h (snoc b y))))) (defun rev (l) (Pure (-> ( '(t)) '(t))) (match l (nil nil) ((Cons h t) (snoc (rev t) h)))) "; let exprs = init(expr, vec![]).unwrap(); let ctx = typing(exprs).unwrap(); println!("{}", transpile(&ctx)); } #[test] fn test_multibyte() { let expr = "あ"; let _exprs = init(expr, vec![]).unwrap(); let expr = ""; let exprs = init(expr, vec![]).unwrap(); let ctx = typing(exprs).unwrap(); let e = "\"あ\""; let r = eval(e, &ctx).unwrap(); println!("{r:?}"); let e = "`あ`"; let r = eval(e, &ctx).unwrap(); println!("{r:?}"); } } ================================================ FILE: src/macro.rs ================================================ use crate::{parser::Expr, Pos}; use alloc::{ collections::{btree_map::Entry, BTreeMap, LinkedList}, format, string::String, }; #[derive(Debug)] pub struct MacroErr { pub pos: Pos, pub msg: &'static str, } /// `e1` is a pattern and `e2` is an expression to be matched. pub fn match_pattern(e1: &Expr, e2: &Expr, ctx: &mut BTreeMap>) -> bool { match (e1, e2) { (Expr::ID(left, _), _) => { if let Some('$') = left.chars().next() { // If `e1` is `$id`, then a map from `$id` to `e1` is added to `ctx`. let entry = ctx.entry(left.clone()); match entry { Entry::Vacant(ent) => { let mut list = LinkedList::new(); list.push_back(e2.clone()); ent.insert(list); true } Entry::Occupied(ent) => { let exprs = ent.get(); if exprs.len() != 1 { false } else { eq_expr(exprs.front().unwrap(), e2) } } } } else if left == "_" { true } else { matches!(e2, Expr::ID(right, _) if left == right) } } (Expr::Bool(left, _), Expr::Bool(right, _)) => left == right, (Expr::Char(left, _), Expr::Char(right, _)) => left == right, (Expr::Num(left, _), Expr::Num(right, _)) => left == right, (Expr::Str(left, _), Expr::Str(right, _)) => left == right, (Expr::Tuple(left, _), Expr::Tuple(right, _)) => match_list(left, right, ctx), (Expr::Apply(left, _), Expr::Apply(right, _)) => match_list(left, right, ctx), (Expr::List(left, _), Expr::List(right, _)) => match_list(left, right, ctx), _ => false, } } pub fn match_list( left: &LinkedList, right: &LinkedList, ctx: &mut BTreeMap>, ) -> bool { let mut prev = None; let mut it_left = left.iter(); let mut it_right = right.iter(); loop { match (it_left.next(), it_right.next()) { (Some(e1), Some(e2)) => { if let Expr::ID(id, _) = e1 { if id == "..." { if let Some(key) = &prev { let Some(exprs) = ctx.get_mut(key) else { return false; }; exprs.push_back(e2.clone()); break; } } else { prev = Some(id.clone()); } } if !match_pattern(e1, e2, ctx) { return false; } } (Some(e1), None) => { if let Expr::ID(id, _) = e1 { return id == "..."; } else { return false; } } (None, Some(_)) => return false, _ => return true, } } let key = prev.unwrap(); let exprs = ctx.get_mut(&key).unwrap(); for expr in it_right { exprs.push_back(expr.clone()); } true } fn eq_expr(e1: &Expr, e2: &Expr) -> bool { match (e1, e2) { (Expr::ID(left, _), Expr::ID(right, _)) => left == right, (Expr::Bool(left, _), Expr::Bool(right, _)) => left == right, (Expr::Char(left, _), Expr::Char(right, _)) => left == right, (Expr::Num(left, _), Expr::Num(right, _)) => left == right, (Expr::Str(left, _), Expr::Str(right, _)) => left == right, (Expr::Tuple(left, _), Expr::Tuple(right, _)) => eq_exprs(left, right), (Expr::Apply(left, _), Expr::Apply(right, _)) => eq_exprs(left, right), (Expr::List(left, _), Expr::List(right, _)) => eq_exprs(left, right), _ => false, } } fn eq_exprs(es1: &LinkedList, es2: &LinkedList) -> bool { if es1.len() != es2.len() { return false; } es1.iter().zip(es2.iter()).all(|(e1, e2)| eq_expr(e1, e2)) } pub(crate) fn process_macros(exprs: &mut LinkedList) -> Result { let macros = parse_macros(exprs)?; let mut expander = MacroExpander::new(¯os); for expr in exprs.iter_mut() { expander.apply_macros(expr)?; } Ok(macros) } pub(crate) fn apply(expr: &mut Expr, macros: &Macros) -> Result<(), MacroErr> { MacroExpander::new(macros).apply_macros(expr) } struct MacroExpander<'a> { macros: &'a Macros, fresh_counter: u64, } impl<'a> MacroExpander<'a> { fn new(macros: &'a Macros) -> MacroExpander<'a> { MacroExpander { macros, fresh_counter: 0, } } fn apply_macros(&mut self, expr: &mut Expr) -> Result<(), MacroErr> { if let Expr::Apply(exprs, _) = expr { if let Some(Expr::ID(id, _)) = exprs.front() { if id == "macro" { return Ok(()); } } } self.apply_macros_recursively(expr, 0) } fn apply_macros_expr( &mut self, pos: Pos, expr: &Expr, count: u8, ) -> Result, MacroErr> { if count == 0xff { return Err(MacroErr { pos, msg: "too deep macro", }); } for (_, rules) in self.macros.iter() { for rule in rules.iter() { let mut ctx = BTreeMap::new(); if match_pattern(&rule.pattern, expr, &mut ctx) { let expr = self.expand(pos, &rule.template, &ctx).pop_front().unwrap(); if let Some(e) = self.apply_macros_expr(pos, &expr, count + 1)? { return Ok(Some(e)); } else { return Ok(Some(expr)); } } } } Ok(None) } fn apply_macros_recursively(&mut self, expr: &mut Expr, count: u8) -> Result<(), MacroErr> { if count == 0xff { panic!("{}: too deep macro", expr.get_pos()); } if let Some(e) = self.apply_macros_expr(expr.get_pos(), expr, count)? { *expr = e; } match expr { Expr::Apply(exprs, _) | Expr::List(exprs, _) | Expr::Tuple(exprs, _) => { for expr in exprs { self.apply_macros_recursively(expr, count + 1)?; } } _ => (), } Ok(()) } fn expand( &mut self, pos: Pos, template: &Expr, ctx: &BTreeMap>, ) -> LinkedList { let template = self.freshen_template(template); expand_expr(pos, &template, ctx) } fn freshen_template(&mut self, template: &Expr) -> Expr { let mut env = BTreeMap::new(); self.rename_expr(template, &mut env) } fn rename_expr(&mut self, expr: &Expr, env: &mut BTreeMap) -> Expr { match expr { Expr::ID(id, pos) => { if let Some(renamed) = env.get(id) { Expr::ID(renamed.clone(), *pos) } else { expr.clone() } } Expr::Bool(_, _) | Expr::Char(_, _) | Expr::Num(_, _) | Expr::Str(_, _) => expr.clone(), Expr::List(exprs, pos) => Expr::List(self.rename_exprs(exprs, env), *pos), Expr::Tuple(exprs, pos) => Expr::Tuple(self.rename_exprs(exprs, env), *pos), Expr::Apply(exprs, pos) => { let Some(head) = exprs.front() else { return expr.clone(); }; match head { Expr::ID(id, _) if id == "lambda" => self.rename_lambda(exprs, *pos, env), Expr::ID(id, _) if id == "let" => self.rename_let(exprs, *pos, env), Expr::ID(id, _) if id == "match" => self.rename_match(exprs, *pos, env), _ => Expr::Apply(self.rename_exprs(exprs, env), *pos), } } } } fn rename_exprs( &mut self, exprs: &LinkedList, env: &mut BTreeMap, ) -> LinkedList { let mut result = LinkedList::new(); for expr in exprs { result.push_back(self.rename_expr(expr, env)); } result } fn rename_lambda( &mut self, exprs: &LinkedList, pos: Pos, env: &mut BTreeMap, ) -> Expr { let mut result = LinkedList::new(); let mut iter = exprs.iter(); result.push_back(iter.next().unwrap().clone()); if let Some(args) = iter.next() { let mut local_env = env.clone(); result.push_back(self.rename_lambda_args(args, &mut local_env)); for expr in iter { result.push_back(self.rename_expr(expr, &mut local_env)); } } Expr::Apply(result, pos) } fn rename_lambda_args( &mut self, args: &Expr, env: &mut BTreeMap, ) -> Expr { match args { Expr::Apply(exprs, pos) => { let mut renamed = LinkedList::new(); for expr in exprs { renamed.push_back(self.rename_binder(expr, env)); } Expr::Apply(renamed, *pos) } _ => self.rename_expr(args, env), } } fn rename_let( &mut self, exprs: &LinkedList, pos: Pos, env: &mut BTreeMap, ) -> Expr { let mut result = LinkedList::new(); let mut iter = exprs.iter(); result.push_back(iter.next().unwrap().clone()); let mut body_env = env.clone(); if let Some(bindings) = iter.next() { result.push_back(self.rename_let_bindings(bindings, env, &mut body_env)); } for expr in iter { result.push_back(self.rename_expr(expr, &mut body_env)); } Expr::Apply(result, pos) } fn rename_let_bindings( &mut self, bindings: &Expr, env: &mut BTreeMap, body_env: &mut BTreeMap, ) -> Expr { match bindings { Expr::Apply(defs, pos) => { let mut renamed_defs = LinkedList::new(); for def in defs { match def { Expr::Apply(def_exprs, def_pos) if def_exprs.len() == 2 => { let mut def_iter = def_exprs.iter(); let pattern = def_iter.next().unwrap(); let value = def_iter.next().unwrap(); let value = self.rename_expr(value, env); let pattern = self.rename_pattern(pattern, body_env); let mut renamed_def = LinkedList::new(); renamed_def.push_back(pattern); renamed_def.push_back(value); renamed_defs.push_back(Expr::Apply(renamed_def, *def_pos)); } _ => renamed_defs.push_back(self.rename_expr(def, env)), } } Expr::Apply(renamed_defs, *pos) } _ => self.rename_expr(bindings, env), } } fn rename_match( &mut self, exprs: &LinkedList, pos: Pos, env: &mut BTreeMap, ) -> Expr { let mut result = LinkedList::new(); let mut iter = exprs.iter(); result.push_back(iter.next().unwrap().clone()); if let Some(cond) = iter.next() { result.push_back(self.rename_expr(cond, env)); } for case in iter { result.push_back(self.rename_match_case(case, env)); } Expr::Apply(result, pos) } fn rename_match_case(&mut self, case: &Expr, env: &mut BTreeMap) -> Expr { match case { Expr::Apply(case_exprs, pos) if case_exprs.len() == 2 => { let mut iter = case_exprs.iter(); let pattern = iter.next().unwrap(); let body = iter.next().unwrap(); let mut case_env = env.clone(); let pattern = self.rename_pattern(pattern, &mut case_env); let body = self.rename_expr(body, &mut case_env); let mut renamed_case = LinkedList::new(); renamed_case.push_back(pattern); renamed_case.push_back(body); Expr::Apply(renamed_case, *pos) } _ => self.rename_expr(case, env), } } fn rename_pattern(&mut self, pattern: &Expr, env: &mut BTreeMap) -> Expr { match pattern { Expr::ID(_, _) => self.rename_binder(pattern, env), Expr::Tuple(exprs, pos) => { let mut renamed = LinkedList::new(); for expr in exprs { renamed.push_back(self.rename_pattern(expr, env)); } Expr::Tuple(renamed, *pos) } Expr::Apply(exprs, pos) => { let mut renamed = LinkedList::new(); let mut iter = exprs.iter(); if let Some(head) = iter.next() { renamed.push_back(self.rename_expr(head, env)); } for expr in iter { renamed.push_back(self.rename_pattern(expr, env)); } Expr::Apply(renamed, *pos) } _ => pattern.clone(), } } fn rename_binder(&mut self, expr: &Expr, env: &mut BTreeMap) -> Expr { match expr { Expr::ID(id, pos) => { if id == "_" || is_pattern_var(id) { expr.clone() } else { let fresh = self.fresh_name(id); env.insert(id.clone(), fresh.clone()); Expr::ID(fresh, *pos) } } _ => self.rename_expr(expr, env), } } fn fresh_name(&mut self, id: &str) -> String { let fresh = format!("__blisp_macro_{}_{}", self.fresh_counter, id); self.fresh_counter += 1; fresh } } pub(crate) type Macros = BTreeMap>; #[derive(Debug)] pub(crate) struct MacroRule { pattern: Expr, template: Expr, } fn parse_macros(exprs: &LinkedList) -> Result { let mut result = BTreeMap::new(); for e in exprs.iter() { if let Expr::Apply(es, _) = e { let mut it = es.iter(); let Some(front) = it.next() else { continue; }; if let Expr::ID(id_macro, _) = front { if id_macro == "macro" { let id = it.next(); let Some(Expr::ID(id, _)) = id else { return Err(MacroErr { pos: e.get_pos(), msg: "invalid macro", }); }; let mut rules = LinkedList::new(); for rule in it { let Expr::Apply(rule_exprs, _) = rule else { return Err(MacroErr { pos: rule.get_pos(), msg: "invalid macro rule", }); }; if rule_exprs.len() != 2 { return Err(MacroErr { pos: rule.get_pos(), msg: "the number of arguments of a macro rule is not 2", }); } let mut rule_it = rule_exprs.iter(); let mut pattern = rule_it.next().unwrap().clone(); if let Expr::Apply(arguments, _) = &mut pattern { if let Some(Expr::ID(front, _)) = arguments.front_mut() { if front == "_" { *front = id.clone(); } else if front != id { return Err(MacroErr { pos: pattern.get_pos(), msg: "invalid macro pattern", }); } } let template = rule_it.next().unwrap().clone(); rules.push_back(MacroRule { pattern, template }); } else { return Err(MacroErr { pos: pattern.get_pos(), msg: "invalid macro pattern", }); }; } if let Entry::Vacant(entry) = result.entry(id.clone()) { entry.insert(rules); } else { return Err(MacroErr { pos: e.get_pos(), msg: "multiply defined", }); } } } } } Ok(result) } fn is_pattern_var(id: &str) -> bool { matches!(id.chars().next(), Some('$')) } fn expand_expr(pos: Pos, template: &Expr, ctx: &BTreeMap>) -> LinkedList { match template { Expr::ID(id, _) => { if let Some(exprs) = ctx.get(id) { let expr = exprs.front().unwrap(); let mut result = LinkedList::new(); result.push_back(expr.clone()); result } else { let mut result: LinkedList = LinkedList::new(); result.push_back(template.clone()); result } } Expr::Apply(templates, _) => { let exprs = expand_list(pos, templates, ctx); let mut result = LinkedList::new(); result.push_back(Expr::Apply(exprs, pos)); result } Expr::List(templates, _) => { let exprs = expand_list(pos, templates, ctx); let mut result = LinkedList::new(); result.push_back(Expr::List(exprs, pos)); result } Expr::Tuple(templates, _) => { let exprs = expand_list(pos, templates, ctx); let mut result = LinkedList::new(); result.push_back(Expr::Tuple(exprs, pos)); result } expr => { let mut result = LinkedList::new(); result.push_back(expr.clone()); result } } } fn expand_list( pos: Pos, templates: &LinkedList, ctx: &BTreeMap>, ) -> LinkedList { let mut result = LinkedList::new(); let mut prev = None; for template in templates { if let Expr::ID(id, _) = template { if id == "..." { if let Some(p) = &prev { if let Some(exprs) = ctx.get(p) { let mut it = exprs.iter(); let _ = it.next(); for expr in it { result.push_back(expr.clone()); } } else { prev = None; } } else { prev = None; } continue; } else { prev = Some(id.clone()); } } else { prev = None; } let mut exprs = expand_expr(pos, template, ctx); result.append(&mut exprs); } result } ================================================ FILE: src/parser.rs ================================================ /* * $NUM := [0-9]* * $HEX := 0x[0-9a-fA-F]* * $OCT := 0o[0-9a-fA-F]* * $BIN := 0b[01]* * $BOOL := true | false * $STR := " string literal " * $CHAR := ' character literal ' * $ESCC := character * $ID := string * $LIST := '( $EXPRS ) * $TUPLE := [ $EXPRS ] * $APPLY := ( $EXPRS ) * $EXP := $HEX | $OCT | $BIN | $NUM | $BOOL | $ID | $LIST | $TUPLE | $APPLY * $EXPRS := $EXP $EXPRS | ∅ */ use super::Pos; use crate::FileType; use alloc::{ collections::linked_list::LinkedList, string::{String, ToString}, }; use core::{fmt::Display, usize}; use num_bigint::BigInt; use num_traits::Zero; #[derive(Debug)] pub struct SyntaxErr { pub pos: Pos, pub msg: &'static str, } pub struct Parser<'a> { pos: Pos, remain: &'a str, } #[derive(Debug, Clone)] pub enum Expr { Str(String, Pos), Char(char, Pos), Num(BigInt, Pos), ID(String, Pos), Bool(bool, Pos), List(LinkedList, Pos), Tuple(LinkedList, Pos), Apply(LinkedList, Pos), } impl Display for Expr { fn fmt(&self, f: &mut core::fmt::Formatter<'_>) -> core::fmt::Result { fn fmt_exprs( f: &mut core::fmt::Formatter<'_>, exprs: &LinkedList, ) -> core::fmt::Result { for (n, expr) in exprs.iter().enumerate() { if n == 0 { write!(f, "{expr}")?; } else { write!(f, " {expr}")?; } } Ok(()) } match self { Expr::Bool(val, _) => { write!(f, "{val}") } Expr::Char(val, _) => { write!(f, "'{val}'") } Expr::Str(val, _) => { write!(f, "\"{val}\"") } Expr::Num(val, _) => { write!(f, "{val}") } Expr::ID(val, _) => { write!(f, "{val}") } Expr::Apply(exprs, _) => { write!(f, "(")?; fmt_exprs(f, exprs)?; write!(f, ")") } Expr::List(exprs, _) => { write!(f, "'(")?; fmt_exprs(f, exprs)?; write!(f, ")") } Expr::Tuple(exprs, _) => { write!(f, "[")?; fmt_exprs(f, exprs)?; write!(f, "]") } } } } impl Expr { pub fn get_pos(&self) -> Pos { match self { Expr::Char(_, pos) => *pos, Expr::Num(_, pos) => *pos, Expr::ID(_, pos) => *pos, Expr::Bool(_, pos) => *pos, Expr::List(_, pos) => *pos, Expr::Tuple(_, pos) => *pos, Expr::Apply(_, pos) => *pos, Expr::Str(_, pos) => *pos, } } } impl<'a> Parser<'a> { pub fn new(code: &'a str, file_id: FileType) -> Parser<'a> { Parser { pos: Pos { file_id, line: 0, column: 0, }, remain: code, } } pub fn parse(&mut self) -> Result, SyntaxErr> { let mut exprs = LinkedList::new(); loop { self.skip_spaces(); if self.remain.is_empty() { return Ok(exprs); } exprs.push_back(self.parse_expr()?); } } fn parse_id_bool(&mut self) -> Result { let mut i = 0; for s in self.remain.chars() { if is_paren(s) || is_space(s) || s == ';' { break; } i += s.to_string().len(); } if i == 0 { Err(SyntaxErr { pos: self.pos, msg: "unexpected EOF", }) } else { let c = self.remain[..i].to_string(); self.remain = &self.remain[i..]; let pos = self.pos; self.pos.column += i; if c == "true" { Ok(Expr::Bool(true, pos)) } else if c == "false" { Ok(Expr::Bool(false, pos)) } else { Ok(Expr::ID(c.to_string(), pos)) } } } fn parse_oct(&mut self) -> Result { let mut n = Zero::zero(); let mut i = 0; for c in self.remain.chars() { let m = if ('0'..='7').contains(&c) { c as u32 - '0' as u32 } else { break; }; n *= 8; n += m; i += 1; } if i == 0 { return Err(SyntaxErr { pos: self.pos, msg: "expect hexadecimal number", }); } let expr = Expr::Num(n, self.pos); self.pos.column += i; self.remain = &self.remain[i..]; self.check_eof(expr) } fn parse_hex(&mut self) -> Result { let mut n = Zero::zero(); let mut i = 0; for c in self.remain.chars() { let m = if c.is_ascii_digit() { c as u32 - '0' as u32 } else if ('a'..='f').contains(&c) { c as u32 - 'a' as u32 + 10 } else if ('A'..='F').contains(&c) { c as u32 - 'A' as u32 + 10 } else { break; }; n *= 16; n += m; i += 1; } if i == 0 { return Err(SyntaxErr { pos: self.pos, msg: "expect hexadecimal number", }); } let expr = Expr::Num(n, self.pos); self.pos.column += i; self.remain = &self.remain[i..]; self.check_eof(expr) } fn check_eof(&self, expr: Expr) -> Result { if self.remain.is_empty() { return Ok(expr); } match self.remain.chars().next() { Some(c0) => { if is_paren(c0) || is_space(c0) { Ok(expr) } else { Err(SyntaxErr { pos: self.pos, msg: "expected '(', ')', '[', ']' or space", }) } } None => Err(SyntaxErr { pos: self.pos, msg: "unexpected EOF", }), } } fn parse_binary(&mut self) -> Result { let mut n = Zero::zero(); let mut i = 0; for c in self.remain.chars() { let m = if c == '0' { 0 } else if c == '1' { 1 } else { break; }; n *= 2; n += m; i += 1; } if i == 0 { return Err(SyntaxErr { pos: self.pos, msg: "expect binary number", }); } let expr = Expr::Num(n, self.pos); self.pos.column += i; self.remain = &self.remain[i..]; self.check_eof(expr) } fn parse_num(&mut self) -> Result { let mut i = 0; let is_minus; let mut cs = self.remain.chars(); let c0 = cs.next(); let c1 = cs.next(); let c = match (c0, c1) { (Some('-'), _) => { is_minus = true; i += 1; &self.remain[1..] } (Some('0'), Some('x')) => { self.pos.column += 2; self.remain = &self.remain[2..]; return self.parse_hex(); } (Some('0'), Some('b')) => { self.pos.column += 2; self.remain = &self.remain[2..]; return self.parse_binary(); } (Some('0'), Some('o')) => { self.pos.column += 2; self.remain = &self.remain[2..]; return self.parse_oct(); } _ => { is_minus = false; self.remain } }; // parse decimal number let mut n = Zero::zero(); for a in c.chars() { if a.is_ascii_digit() { n *= 10; n += a as usize - '0' as usize; i += 1; } else { break; } } if is_minus { n *= -1; } let expr = Expr::Num(n, self.pos); self.pos.column += i; self.remain = &self.remain[i..]; self.check_eof(expr) } fn skip_spaces(&mut self) { let mut i = 0; let mut prev = ' '; let mut is_comment = false; for s in self.remain.chars() { if is_comment { if s == '\r' || s == '\n' { is_comment = false; } else { self.pos.column += 1; i += 1; prev = s; continue; } } if s == ';' { is_comment = true; self.pos.column += 1; } else if is_space(s) { if s == '\r' || (s == '\n' && prev != '\r') { self.pos.line += 1; self.pos.column = 0; } else { self.pos.column += 1; } } else { break; } i += 1; prev = s; } self.remain = &self.remain[i..] } fn parse_exprs(&mut self) -> Result, SyntaxErr> { let mut exprs = LinkedList::::new(); self.skip_spaces(); loop { self.skip_spaces(); let c0 = self.remain.chars().next(); if self.remain.is_empty() || c0 == Some(')') || c0 == Some(']') { break; } exprs.push_back(self.parse_expr()?); } Ok(exprs) } fn parse_expr(&mut self) -> Result { self.skip_spaces(); match self.remain.chars().next() { Some('(') => self.parse_apply(), Some('\'') => self.parse_list(), Some('[') => self.parse_tuple(), Some('"') => self.parse_string(), Some('`') => self.parse_char(), Some(a) => { if a == ')' { Err(SyntaxErr { pos: self.pos, msg: "invalid )", }) } else if a.is_ascii_digit() { self.parse_num() } else if a == '-' { match self.remain.chars().nth(1) { Some(b) => { if b.is_ascii_digit() { self.parse_num() } else { self.parse_id_bool() } } _ => self.parse_id_bool(), } } else { self.parse_id_bool() } } _ => Err(SyntaxErr { pos: self.pos, msg: "unexpected character", }), } } fn parse_char(&mut self) -> Result { self.remain = &self.remain[1..]; // skip '`' let pos = self.pos; self.pos.column += 1; if let Some(c) = self.remain.chars().next() { match c { '\\' => { if let Some(c1) = self.remain.chars().nth(1) { // TODO: // \x41 | 7-bit character code (exactly 2 digits, up to 0x7F) // \u{7FFF} | 24-bit Unicode character code (up to 6 digits) let esc = match c1 { 'r' => '\r', 'n' => '\n', 't' => '\t', '0' => '\0', '\\' => '\\', '`' => '`', _ => { return Err(SyntaxErr { pos: self.pos, msg: "invalid escape character", }); } }; if let Some('`') = self.remain.chars().nth(2) { self.remain = &self.remain[3..]; self.pos.column += 3; Ok(Expr::Char(esc, pos)) } else { self.pos.column += 1; Err(SyntaxErr { pos: self.pos, msg: "expected `", }) } } else { Err(SyntaxErr { pos: self.pos, msg: "expected escape character", }) } } '\r' | '\n' => Err(SyntaxErr { pos: self.pos, msg: "use \\r or \\n", }), c => { if let Some('`') = self.remain.chars().nth(1) { self.remain = &self.remain[c.to_string().len() + 1..]; self.pos.column += 2; Ok(Expr::Char(c, pos)) } else { self.pos.column += 1; Err(SyntaxErr { pos: self.pos, msg: "expected `", }) } } } } else { Err(SyntaxErr { pos: self.pos, msg: "expected character literal", }) } } fn parse_string(&mut self) -> Result { self.remain = &self.remain[1..]; // skip '"' let pos = self.pos; self.pos.column += 1; let mut prev = ' '; let mut str = "".to_string(); loop { if let Some(c) = self.remain.chars().next() { match c { '"' => { self.pos.column += 1; self.remain = &self.remain[1..]; break; } '\\' => { if let Some(c1) = self.remain.chars().nth(1) { // TODO: // \x41 | 7-bit character code (exactly 2 digits, up to 0x7F) // \u{7FFF} | 24-bit Unicode character code (up to 6 digits) let esc = match c1 { 'r' => '\r', 'n' => '\n', 't' => '\t', '0' => '\0', '\\' => '\\', '"' => '"', _ => { return Err(SyntaxErr { pos: self.pos, msg: "invalid escape character", }); } }; str.push(esc); self.remain = &self.remain[2..]; self.pos.column += 2; continue; } else { return Err(SyntaxErr { pos: self.pos, msg: "expected escape character", }); } } _ => { if c == '\r' || (c == '\n' && prev != '\r') { self.pos.line += 1; self.pos.column = 0; } else { self.pos.column += 1; } prev = c; str.push(c); self.remain = &self.remain[c.to_string().len()..]; } } } else { return Err(SyntaxErr { pos: self.pos, msg: "string is not ended", }); } } Ok(Expr::Str(str, pos)) } fn parse_apply(&mut self) -> Result { self.remain = &self.remain[1..]; // skip '(' let pos = self.pos; self.pos.column += 1; let exprs = self.parse_exprs()?; if self.remain.starts_with(')') { self.remain = &self.remain[1..]; self.pos.column += 1; Ok(Expr::Apply(exprs, pos)) } else { Err(SyntaxErr { pos: self.pos, msg: "expected ')'", }) } } fn parse_list(&mut self) -> Result { let c = &self.remain[1..]; // skip '\'' let pos = self.pos; self.pos.column += 1; match c.chars().next() { Some('(') => { self.remain = &c[1..]; let exprs = self.parse_exprs()?; if self.remain.starts_with(')') { self.remain = &self.remain[1..]; self.pos.column += 1; Ok(Expr::List(exprs, pos)) } else { Err(SyntaxErr { pos: self.pos, msg: "expected ')'", }) } } _ => Err(SyntaxErr { pos: self.pos, msg: "expected '('", }), } } fn parse_tuple(&mut self) -> Result { self.remain = &self.remain[1..]; // skip '[' let pos = self.pos; self.pos.column += 1; let exprs = self.parse_exprs()?; if self.remain.starts_with(']') { self.remain = &self.remain[1..]; self.pos.column += 1; Ok(Expr::Tuple(exprs, pos)) } else { Err(SyntaxErr { pos: self.pos, msg: "expected ']'", }) } } } fn is_space(c: char) -> bool { c == ' ' || c == '\r' || c == '\n' || c == '\t' } fn is_paren(c: char) -> bool { c == '(' || c == ')' || c == '[' || c == ']' } ================================================ FILE: src/prelude.lisp ================================================ (data (Option t) (Some t) None) (data (Result t e) (Ok t) (Err e)) (export car (x) (Pure (-> ('(t)) (Option t))) (match x ((Cons n _) (Some n)) (_ None))) (export cdr (x) (Pure (-> ('(t)) '(t))) (match x ((Cons _ l) l) (_ '()))) (export map (f x) (Pure (-> ((Pure (-> (a) b)) '(a)) '(b))) (match x ((Cons h l) (Cons (f h) (map f l))) (_ '()))) (export fold (f init x) (Pure (-> ((Pure (-> (a b) b)) b '(a)) b)) (match x ((Cons h l) (fold f (f h init) l)) (_ init))) (export filter (f x) (Pure (-> ((Pure (-> (t) Bool)) '(t)) '(t))) (reverse (filter' f x '()))) (defun filter' (f x l) (Pure (-> ( (Pure (-> (t) Bool)) '(t) '(t)) '(t))) (match x ((Cons h a) (if (f h) (filter' f a (Cons h l)) (filter' f a l) )) (_ l))) (export reverse (x) (Pure (-> ('(t)) '(t))) (reverse' x '())) (defun reverse' (x l) (Pure (-> ('(t) '(t)) '(t))) (match x ((Cons h a) (reverse' a (Cons h l))) (_ l))) ================================================ FILE: src/runtime.rs ================================================ use crate::r#macro; use super::{parser, semantics, LispErr, Pos}; use alloc::{ boxed::Box, collections::{btree_map::BTreeMap, linked_list::LinkedList, vec_deque::VecDeque}, format, string::{String, ToString}, vec, vec::Vec, }; use core::{ cmp::{Eq, Ord, Ordering, PartialEq, PartialOrd}, ops::{Shl, Shr}, pin::Pin, ptr::{read_volatile, write_volatile}, }; use num_bigint::BigInt; use num_traits::{ToPrimitive, Zero}; type Expr = semantics::LangExpr; type Pattern = semantics::Pattern; struct RuntimeErr { msg: String, pos: Pos, } #[derive(Debug, Clone, PartialEq, Eq, PartialOrd, Ord)] pub struct Variables { vars: VecDeque>, } impl Variables { fn new() -> Variables { let mut list = VecDeque::new(); list.push_back(BTreeMap::new()); Variables { vars: list } } fn push(&mut self) { self.vars.push_back(BTreeMap::new()); } fn pop(&mut self) { self.vars.pop_back(); } fn insert(&mut self, id: String, data: RTData) { let m = self.vars.back_mut().unwrap(); m.insert(id, data); } fn get(&mut self, id: &str) -> Option<&RTData> { for m in self.vars.iter().rev() { if let Some(val) = m.get(id) { return Some(val); } } None } } #[derive(Debug, Clone, PartialEq, Eq, PartialOrd, Ord)] pub enum TCall { Defun(String), Lambda(u64), } #[derive(Eq, Debug, Clone)] pub struct IntType(*mut (BigInt, bool)); impl IntType { fn get_int(&self) -> &BigInt { unsafe { &(*self.0).0 } } fn get_ref(&mut self) -> &mut bool { unsafe { &mut (*self.0).1 } } } impl Ord for IntType { fn cmp(&self, other: &Self) -> Ordering { let s1 = self.get_int(); let s2 = other.get_int(); s1.cmp(s2) } } impl PartialOrd for IntType { fn partial_cmp(&self, other: &Self) -> Option { let s1 = self.get_int(); let s2 = other.get_int(); Some(s1.cmp(s2)) } } impl PartialEq for IntType { fn eq(&self, other: &Self) -> bool { let s1 = self.get_int(); let s2 = other.get_int(); s1 == s2 } } #[derive(Eq, Debug, Clone)] pub struct StrType(*mut (String, bool)); impl StrType { fn get_string(&self) -> &String { unsafe { &(*self.0).0 } } fn get_ref(&mut self) -> &mut bool { unsafe { &mut (*self.0).1 } } } impl Ord for StrType { fn cmp(&self, other: &Self) -> Ordering { let s1 = self.get_string(); let s2 = other.get_string(); s1.cmp(s2) } } impl PartialOrd for StrType { fn partial_cmp(&self, other: &Self) -> Option { let s1 = self.get_string(); let s2 = other.get_string(); Some(s1.cmp(s2)) } } impl PartialEq for StrType { fn eq(&self, other: &Self) -> bool { let s1 = self.get_string(); let s2 = other.get_string(); s1 == s2 } } #[derive(Eq, Debug, Clone)] pub struct ClojureType(*mut (Clojure, bool)); impl ClojureType { fn get_clojure(&self) -> &Clojure { unsafe { &(*self.0).0 } } fn get_clojure_mut(&mut self) -> &mut Clojure { unsafe { &mut (*self.0).0 } } fn get_ref(&mut self) -> &mut bool { unsafe { &mut (*self.0).1 } } } impl Ord for ClojureType { fn cmp(&self, other: &Self) -> Ordering { let s1 = self.get_clojure(); let s2 = other.get_clojure(); s1.cmp(s2) } } impl PartialOrd for ClojureType { fn partial_cmp(&self, other: &Self) -> Option { let s1 = self.get_clojure(); let s2 = other.get_clojure(); Some(s1.cmp(s2)) } } impl PartialEq for ClojureType { fn eq(&self, other: &Self) -> bool { let s1 = self.get_clojure(); let s2 = other.get_clojure(); s1 == s2 } } #[derive(Eq, Debug, Clone)] pub struct LDataType(*mut (LabeledData, bool)); impl LDataType { fn get_ldata(&self) -> &LabeledData { unsafe { &(*self.0).0 } } fn get_ldata_mut(&mut self) -> &mut LabeledData { unsafe { &mut (*self.0).0 } } fn get_ref(&mut self) -> &mut bool { unsafe { &mut (*self.0).1 } } } impl Ord for LDataType { fn cmp(&self, other: &Self) -> Ordering { let s1 = self.get_ldata(); let s2 = other.get_ldata(); s1.cmp(s2) } } impl PartialOrd for LDataType { fn partial_cmp(&self, other: &Self) -> Option { let s1 = self.get_ldata(); let s2 = other.get_ldata(); Some(s1.cmp(s2)) } } impl PartialEq for LDataType { fn eq(&self, other: &Self) -> bool { let s1 = self.get_ldata(); let s2 = other.get_ldata(); s1 == s2 } } #[derive(Debug, Clone, Ord, PartialOrd, PartialEq, Eq)] pub enum RTData { Str(StrType), Char(char), Int(IntType), Bool(bool), Defun(String), Lambda(ClojureType), LData(LDataType), TailCall(TCall, Variables), } fn escape_char(c: char) -> String { match c { '\n' => "\\n".to_string(), '\r' => "\\r".to_string(), '\t' => "\\t".to_string(), '\0' => "\\0".to_string(), _ => c.to_string(), } } impl RTData { fn get_in_lisp(&self, list_head: bool) -> String { match self { RTData::Str(n) => { let mut str = "\"".to_string(); for s in n.get_string().chars() { if s == '"' { str.push_str("\\\""); } else { str.push_str(&escape_char(s)); } } str.push('"'); str } RTData::Char(c) => { if *c == '`' { "`\\``".to_string() } else { let s = escape_char(*c); format!("`{}`", s) } } RTData::Int(n) => { format!("{}", n.get_int()) } RTData::Bool(n) => n.to_string(), RTData::Defun(n) => n.to_string(), RTData::Lambda(n) => format!("(Lambda {})", n.get_clojure().ident), RTData::LData(n) => { let label = &n.get_ldata().label; if label == "Cons" { let e1; let e2; match n.get_ldata().data.as_ref() { Some(ld) => { e1 = ld[0].get_in_lisp(true); e2 = ld[1].get_in_lisp(false); } None => panic!("invalid list"), } if list_head { if e2.is_empty() { format!("'({})", e1) } else { format!("'({} {})", e1, e2) } } else if e2.is_empty() { e1 } else { format!("{} {}", e1, e2) } } else if label == "Nil" { if list_head { "'()".to_string() } else { "".to_string() } } else if label == "Tuple" { match n.get_ldata().data.as_ref() { Some(ld) => { let mut msg = "".to_string(); let len = (*ld).len(); let mut i = 1; for d in ld.iter() { if i == len { msg = format!("{}{}", msg, d.get_in_lisp(true)); } else { msg = format!("{}{} ", msg, d.get_in_lisp(true)); } i += 1; } format!("[{}]", msg) } None => "[]".to_string(), } } else { match n.get_ldata().data.as_ref() { Some(ld) => { let mut msg = format!("({}", label); for d in ld.iter() { msg = format!("{} {}", msg, d.get_in_lisp(true)); } format!("{})", msg) } None => label.to_string(), } } } RTData::TailCall(TCall::Defun(f), _) => format!("(TailCall (Defun {}))", f), RTData::TailCall(TCall::Lambda(f), _) => format!("(TailCall (Lambda {}))", f), } } } #[derive(Debug, PartialEq, Eq, PartialOrd, Ord)] struct LabeledData { label: String, data: Option>, } #[derive(Debug, PartialEq, Eq, PartialOrd, Ord)] struct Clojure { ident: u64, data: Option>, } const MIN_GC_NUM: usize = 1024; #[derive(Debug)] pub(crate) struct RootObject { objects: LinkedList>>, clojure: LinkedList>>, integers: LinkedList>>, strings: LinkedList>>, threshold: usize, } impl RootObject { fn new() -> RootObject { RootObject { objects: LinkedList::new(), clojure: LinkedList::new(), integers: LinkedList::new(), strings: LinkedList::new(), threshold: MIN_GC_NUM, } } fn len(&self) -> usize { self.objects.len() + self.clojure.len() + self.integers.len() + self.strings.len() } fn make_int(&mut self, n: BigInt) -> IntType { self.integers.push_back(Box::pin((n, false))); let ptr = self.integers.back_mut().unwrap(); IntType(unsafe { ptr.as_mut().get_unchecked_mut() as *mut (BigInt, bool) }) } fn make_str(&mut self, str: String) -> StrType { self.strings.push_back(Box::pin((str, false))); let ptr = self.strings.back_mut().unwrap(); StrType(unsafe { ptr.as_mut().get_unchecked_mut() as *mut (String, bool) }) } fn make_obj(&mut self, label: String, data: Option>) -> LDataType { let obj = LabeledData { label, data }; self.objects.push_back(Box::pin((obj, false))); let ptr = self.objects.back_mut().unwrap(); LDataType(unsafe { ptr.as_mut().get_unchecked_mut() as *mut (LabeledData, bool) }) } fn make_clojure(&mut self, ident: u64, data: Option>) -> ClojureType { let obj = Clojure { ident, data }; self.clojure.push_back(Box::pin((obj, false))); let ptr = self.clojure.back_mut().unwrap(); ClojureType(unsafe { ptr.as_mut().get_unchecked_mut() as *mut (Clojure, bool) }) } } pub struct Environment<'a> { pub(crate) ctx: &'a semantics::Context, pub(crate) lambda: &'a BTreeMap, pub(crate) root: &'a mut RootObject, pub(crate) vars: &'a mut VecDeque, } pub(crate) fn eval( code: &str, ctx: &semantics::Context, ) -> Result>, LispErr> { let mut ps = parser::Parser::new(code, crate::FileType::Eval); let mut exprs: LinkedList = match ps.parse() { Ok(e) => e, Err(e) => { let msg = format!("Syntax Error: {}", e.msg); return Err(LispErr { msg, pos: e.pos }); } }; if let Err(e) = r#macro::process_macros(&mut exprs) { let msg = format!("Macro Error: {}", e.msg); return Err(LispErr::new(msg, e.pos)); } for expr in exprs.iter_mut() { if let Err(e) = r#macro::apply(expr, &ctx.macros) { let msg: String = format!("Macro Error: {}", e.msg); return Err(LispErr { msg, pos: e.pos }); } } let mut typed_exprs = LinkedList::new(); for expr in &exprs { match semantics::typing_expr(expr, ctx) { Ok(e) => { typed_exprs.push_back(e); } Err(e) => { let msg = format!("Typing Error: {}", e.msg); return Err(LispErr { msg, pos: e.pos }); } } } let mut root = RootObject::new(); let mut result = LinkedList::new(); for (expr, lambda) in &typed_exprs { let mut vars = VecDeque::new(); vars.push_back(Variables::new()); let mut env = Environment { ctx, lambda, root: &mut root, vars: &mut vars, }; match eval_expr(expr, &mut env) { Ok(val) => { result.push_back(Ok(val.get_in_lisp(true))); } Err(e) => { let msg = format!( "(RuntimeErr [{} (Pos {} {})])", e.msg, e.pos.line, e.pos.column ); result.push_back(Err(msg)); return Ok(result); } } } Ok(result) } fn get_data_of_id(id: &str, vars: &mut VecDeque) -> RTData { match vars.back_mut().unwrap().get(id) { Some(data) => data.clone(), None => RTData::Defun(id.to_string()), } } fn eval_expr(expr: &Expr, env: &mut Environment<'_>) -> Result { match expr { Expr::LitStr(e) => Ok(RTData::Str(env.root.make_str(e.str.clone()))), Expr::LitNum(e) => Ok(RTData::Int(env.root.make_int(e.num.clone()))), Expr::LitChar(e) => Ok(RTData::Char(e.c)), Expr::LitBool(e) => Ok(RTData::Bool(e.val)), Expr::IfExpr(e) => eval_if(e, env), Expr::DataExpr(e) => eval_data(e, env), Expr::ListExpr(e) => eval_list(e, env), Expr::LetExpr(e) => eval_let(e, env), Expr::MatchExpr(e) => eval_match(e, env), Expr::IDExpr(e) => Ok(eval_id(e, env.vars)), Expr::ApplyExpr(e) => eval_apply(e, env), Expr::TupleExpr(e) => eval_tuple(e, env), Expr::LambdaExpr(e) => Ok(eval_lambda(e, env)), } } fn eval_lambda(expr: &semantics::Lambda, env: &mut Environment<'_>) -> RTData { let data = if !expr.vars.is_empty() { let mut m = BTreeMap::new(); for v in &expr.vars { m.insert(v.to_string(), get_data_of_id(v, env.vars)); } Some(m) } else { None }; let ptr = env.root.make_clojure(expr.ident, data); RTData::Lambda(ptr) } fn eval_tuple(expr: &semantics::Exprs, env: &mut Environment<'_>) -> Result { let mut v = Vec::new(); for e in expr.exprs.iter() { v.push(eval_expr(e, env)?); } let ptr = env.root.make_obj("Tuple".to_string(), Some(v)); Ok(RTData::LData(ptr)) } fn get_fun<'a>( ctx: &'a semantics::Context, fun_name: &str, expr: &Expr, ) -> Result<&'a semantics::Defun, RuntimeErr> { let fun = match ctx.funs.get(fun_name) { Some(f) => f, None => { let pos = expr.get_pos(); let msg = format!("{} is not defined", fun_name); return Err(RuntimeErr { msg, pos }); } }; Ok(fun) } fn get_lambda<'a>( ctx: &'a semantics::Context, lambda: &'a BTreeMap, id: u64, expr: &Expr, ) -> Result<&'a semantics::Lambda, RuntimeErr> { let fun; match ctx.lambda.get(&id) { Some(f) => { fun = f; } None => match lambda.get(&id) { Some(f) => { fun = f; } None => { let pos = expr.get_pos(); let msg = format!("could not find (Lambda {})", id); return Err(RuntimeErr { msg, pos }); } }, } Ok(fun) } fn call_lambda( expr: &semantics::Apply, env: &mut Environment<'_>, cloj: &Clojure, iter: core::slice::Iter, fun_expr: &semantics::LangExpr, ) -> Result { // look up lambda let ident = cloj.ident; let fun = get_lambda(env.ctx, env.lambda, ident, fun_expr)?; // set up arguments let mut vars_fun = Variables::new(); for (e, arg) in iter.zip(fun.args.iter()) { let data = eval_expr(e, env)?; vars_fun.insert(arg.id.to_string(), data); } // set up free variables match &cloj.data { Some(d) => { for (key, val) in d { vars_fun.insert(key.to_string(), val.clone()); } } None => (), } // tail call optimization if expr.is_tail { Ok(RTData::TailCall(TCall::Lambda(ident), vars_fun)) } else { env.vars.push_back(vars_fun); let result = eval_tail_call(&fun.expr, env); env.vars.pop_back(); result } } fn eval_apply(expr: &semantics::Apply, env: &mut Environment<'_>) -> Result { let mut iter = expr.exprs.iter(); let fun_expr = match iter.next() { Some(e) => e, None => { let pos = expr.pos; return Err(RuntimeErr { msg: "empty application".to_string(), pos, }); } }; match eval_expr(fun_expr, env)? { RTData::Defun(fun_name) => { // call built-in function if env.ctx.built_in.contains(&fun_name) { let mut v = Vec::new(); for e in iter { let data = eval_expr(e, env)?; v.push(data); } return eval_built_in(fun_name, &v, expr.pos, env); } if let Some(ffi) = env.ctx.ext_ffi.get(fun_name.as_str()) { let mut v = Vec::new(); for e in iter { let data = eval_expr(e, env)?; v.push(data); } return Ok(ffi(env, &v)); } // look up defun if let Ok(fun) = get_fun(env.ctx, &fun_name, fun_expr) { // set up arguments let mut vars_fun = Variables::new(); for (e, arg) in iter.zip(fun.args.iter()) { let data = eval_expr(e, env)?; vars_fun.insert(arg.id.to_string(), data); } // tail call optimization if expr.is_tail { Ok(RTData::TailCall(TCall::Defun(fun_name), vars_fun)) } else { env.vars.push_back(vars_fun); let result = eval_tail_call(&fun.expr, env)?; env.vars.pop_back(); Ok(result) } } else { // call clojure if let Some(RTData::Lambda(cloj)) = env.vars.back_mut().unwrap().get(&fun_name) { let c = cloj.clone(); return call_lambda(expr, env, c.get_clojure(), iter, fun_expr); } // could not find such function let pos = fun_expr.get_pos(); let msg = format!("{} is not defined", fun_name); Err(RuntimeErr { msg, pos }) } } RTData::Lambda(f) => { let f = f.get_clojure(); call_lambda(expr, env, f, iter, fun_expr) } _ => { let pos = fun_expr.get_pos(); Err(RuntimeErr { msg: "not function".to_string(), pos, }) } } } fn eval_tail_call<'a>( mut expr: &'a Expr, env: &'a mut Environment<'_>, ) -> Result { loop { match eval_expr(expr, env)? { RTData::TailCall(TCall::Defun(fun_name), vars_fun) => { let fun = get_fun(env.ctx, &fun_name, expr)?; expr = &fun.expr; env.vars.pop_back(); env.vars.push_back(vars_fun); collect_garbage(env.vars, env.root); // mark and sweep } RTData::TailCall(TCall::Lambda(id), vars_fun) => { let fun = get_lambda(env.ctx, env.lambda, id, expr)?; expr = &fun.expr; env.vars.pop_back(); env.vars.push_back(vars_fun); collect_garbage(env.vars, env.root); // mark and sweep } x => { return Ok(x); } } } } fn get_int(args: &[RTData], pos: Pos) -> Result<*const BigInt, RuntimeErr> { match &args[0] { RTData::Int(n) => Ok(n.get_int()), _ => Err(RuntimeErr { msg: "there must be exactly 2 integers".to_string(), pos, }), } } fn get_int_int(args: &[RTData], pos: Pos) -> Result<(*const BigInt, *const BigInt), RuntimeErr> { match (&args[0], &args[1]) { (RTData::Int(n1), RTData::Int(n2)) => Ok((n1.get_int(), n2.get_int())), _ => Err(RuntimeErr { msg: "there must be exactly 2 integers".to_string(), pos, }), } } fn get_int_int_int( args: &[RTData], pos: Pos, ) -> Result<(*const BigInt, *const BigInt, *const BigInt), RuntimeErr> { match (&args[0], &args[1], &args[2]) { (RTData::Int(n1), RTData::Int(n2), RTData::Int(n3)) => { Ok((n1.get_int(), n2.get_int(), n3.get_int())) } _ => Err(RuntimeErr { msg: "there must be exactly 3 integers".to_string(), pos, }), } } fn get_bool_bool(args: &[RTData], pos: Pos) -> Result<(bool, bool), RuntimeErr> { match (args[0].clone(), args[1].clone()) { (RTData::Bool(n1), RTData::Bool(n2)) => Ok((n1, n2)), _ => Err(RuntimeErr { msg: "there must be exactly 2 boolean values".to_string(), pos, }), } } fn get_bool(args: &[RTData], pos: Pos) -> Result { match args[0].clone() { RTData::Bool(n) => Ok(n), _ => Err(RuntimeErr { msg: "there must be exactly 1 boolean value".to_string(), pos, }), } } fn eval_built_in( fun_name: String, args: &[RTData], pos: Pos, env: &mut Environment<'_>, ) -> Result { match fun_name.as_str() { "+" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 + &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "-" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 - &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "*" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 * &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "/" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 / &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "%" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 % &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "=" | "eq" => Ok(RTData::Bool(args[0] == args[1])), "!=" | "neq" => Ok(RTData::Bool(args[0] != args[1])), "<=" | "leq" => Ok(RTData::Bool(args[0] <= args[1])), ">=" | "geq" => Ok(RTData::Bool(args[0] >= args[1])), ">" | "gt" => Ok(RTData::Bool(args[0] > args[1])), "<" | "lt" => Ok(RTData::Bool(args[0] < args[1])), "and" => { let (n1, n2) = get_bool_bool(args, pos)?; Ok(RTData::Bool(n1 && n2)) } "or" => { let (n1, n2) = get_bool_bool(args, pos)?; Ok(RTData::Bool(n1 || n2)) } "xor" => { let (n1, n2) = get_bool_bool(args, pos)?; Ok(RTData::Bool(n1 ^ n2)) } "not" => { let n = get_bool(args, pos)?; Ok(RTData::Bool(!n)) } "band" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 & &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "bor" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 | &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "bxor" => { let (n1, n2) = get_int_int(args, pos)?; let n = unsafe { &*n1 ^ &*n2 }; Ok(RTData::Int(env.root.make_int(n))) } "sqrt" => { let n = get_int(args, pos)?; if unsafe { (*n) >= Zero::zero() } { let n = unsafe { (*n).sqrt() }; let n = RTData::Int(env.root.make_int(n)); let ptr = env.root.make_obj("Some".to_string(), Some(vec![n])); Ok(RTData::LData(ptr)) } else { let ptr = env.root.make_obj("None".to_string(), None); Ok(RTData::LData(ptr)) } } "pow" => { let (n1, n2) = get_int_int(args, pos)?; if let Some(e) = unsafe { (*n2).to_u32() } { let n = unsafe { (*n1).pow(e) }; let n = RTData::Int(env.root.make_int(n)); let ptr = env.root.make_obj("Some".to_string(), Some(vec![n])); Ok(RTData::LData(ptr)) } else { let ptr = env.root.make_obj("None".to_string(), None); Ok(RTData::LData(ptr)) } } ">>" => { let (n1, n2) = get_int_int(args, pos)?; if let Some(e) = unsafe { (*n2).to_u64() } { let n = unsafe { (*n1).clone() }; let n = n.shr(e); let n = RTData::Int(env.root.make_int(n)); let ptr = env.root.make_obj("Some".to_string(), Some(vec![n])); Ok(RTData::LData(ptr)) } else { let ptr = env.root.make_obj("None".to_string(), None); Ok(RTData::LData(ptr)) } } "<<" => { let (n1, n2) = get_int_int(args, pos)?; if let Some(e) = unsafe { (*n2).to_u64() } { let n = unsafe { (*n1).clone() }; let n = n.shl(e); let n = RTData::Int(env.root.make_int(n)); let ptr = env.root.make_obj("Some".to_string(), Some(vec![n])); Ok(RTData::LData(ptr)) } else { let ptr = env.root.make_obj("None".to_string(), None); Ok(RTData::LData(ptr)) } } "chars" => { let mut tail = RTData::LData(env.root.make_obj("Nil".to_string(), None)); if let RTData::Str(st) = &args[0] { let s = st.get_string(); for c in s.chars().rev() { let c = RTData::Char(c); let cons = RTData::LData(env.root.make_obj("Cons".to_string(), Some(vec![c, tail]))); tail = cons; } } Ok(tail) } "str" => { let mut head = &args[0]; let mut s = "".to_string(); loop { if let RTData::LData(data) = head { if data.get_ldata().label == "Cons" { if let Some(d) = &data.get_ldata().data { if let RTData::Char(c) = &d[0] { s.push(*c); head = &d[1]; } else { return Err(RuntimeErr { msg: "not char".to_string(), pos, }); } } else { return Err(RuntimeErr { msg: "invalid cons".to_string(), pos, }); } } else if data.get_ldata().label == "Nil" { break; } else { return Err(RuntimeErr { msg: "not list".to_string(), pos, }); } } } let ptr = env.root.make_str(s); Ok(RTData::Str(ptr)) } "call-rust" => { let (n1, n2, n3) = get_int_int_int(args, pos)?; let n = unsafe { (env.ctx.callback)(&*n1, &*n2, &*n3) }; if let Some(n) = n { let n = RTData::Int(env.root.make_int(n)); let ptr = env.root.make_obj("Some".to_string(), Some(vec![n])); Ok(RTData::LData(ptr)) } else { let ptr = env.root.make_obj("None".to_string(), None); Ok(RTData::LData(ptr)) } } _ => Err(RuntimeErr { msg: "unknown built-in function".to_string(), pos, }), } } fn eval_match( expr: &semantics::MatchNode, env: &mut Environment<'_>, ) -> Result { let data = eval_expr(&expr.expr, env)?; for c in &expr.cases { env.vars.back_mut().unwrap().push(); if eval_pat(&c.pattern, data.clone(), env.vars) { let retval = eval_expr(&c.expr, env)?; env.vars.back_mut().unwrap().pop(); return Ok(retval); } env.vars.back_mut().unwrap().pop(); } let pos = expr.pos; Err(RuntimeErr { msg: "pattern-matching is not exhaustive".to_string(), pos, }) } fn eval_id(expr: &semantics::IDNode, vars: &mut VecDeque) -> RTData { let id = expr.id.to_string(); get_data_of_id(&id, vars) } fn eval_list(expr: &semantics::Exprs, env: &mut Environment<'_>) -> Result { let mut elm = env.root.make_obj("Nil".to_string(), None); for e in expr.exprs.iter().rev() { let val = eval_expr(e, env)?; elm = env .root .make_obj("Cons".to_string(), Some(vec![val, RTData::LData(elm)])); } Ok(RTData::LData(elm)) } fn eval_if(expr: &semantics::IfNode, env: &mut Environment<'_>) -> Result { let cond = eval_expr(&expr.cond_expr, env)?; let flag = match cond { RTData::Bool(e) => e, _ => { let pos = expr.cond_expr.get_pos(); return Err(RuntimeErr { msg: "type mismatched".to_string(), pos, }); } }; if flag { eval_expr(&expr.then_expr, env) } else { eval_expr(&expr.else_expr, env) } } fn eval_data(expr: &semantics::DataNode, env: &mut Environment<'_>) -> Result { let data = if expr.exprs.is_empty() { None } else { let mut v = Vec::new(); for e in &expr.exprs { v.push(eval_expr(e, env)?); } Some(v) }; let ptr = env.root.make_obj(expr.label.id.to_string(), data); Ok(RTData::LData(ptr)) } fn eval_let(expr: &semantics::LetNode, env: &mut Environment<'_>) -> Result { env.vars.back_mut().unwrap().push(); for def in &expr.def_vars { let data = eval_expr(&def.expr, env)?; if !eval_pat(&def.pattern, data, env.vars) { let pos = def.pattern.get_pos(); return Err(RuntimeErr { msg: "failed pattern matching".to_string(), pos, }); } } let result = eval_expr(&expr.expr, env)?; env.vars.back_mut().unwrap().pop(); Ok(result) } fn eval_pat(pat: &Pattern, data: RTData, vars: &mut VecDeque) -> bool { match pat { Pattern::PatID(p) => { vars.back_mut().unwrap().insert(p.id.to_string(), data); true } Pattern::PatStr(p) => match data { RTData::Str(n) => n.get_string() == &p.str, _ => false, }, Pattern::PatChar(p) => match data { RTData::Char(n) => n == p.c, _ => false, }, Pattern::PatNum(p) => match data { RTData::Int(n) => n.get_int() == &p.num, _ => false, }, Pattern::PatBool(p) => match data { RTData::Bool(n) => n == p.val, _ => false, }, Pattern::PatNil(_) => match data { RTData::LData(ptr) => ptr.get_ldata().label == "Nil", _ => false, }, Pattern::PatTuple(p) => match data { RTData::LData(ptr) => { if ptr.get_ldata().label != "Tuple" { return false; } match &ptr.get_ldata().data { Some(rds) => { for (pat2, rd) in p.pattern.iter().zip(rds.iter()) { if !eval_pat(pat2, rd.clone(), vars) { return false; } } true } None => true, } } _ => false, }, Pattern::PatData(p) => match data { RTData::LData(ptr) => { if ptr.get_ldata().label != p.label.id { return false; } match &ptr.get_ldata().data { Some(rds) => { for (pat2, rd) in p.pattern.iter().zip(rds.iter()) { if !eval_pat(pat2, rd.clone(), vars) { return false; } } true } None => true, } } _ => false, }, } } /// do garbage collection fn collect_garbage(vars: &mut VecDeque, root: &mut RootObject) { let n = root.len(); if n < root.threshold { return; } mark(vars); sweep(&mut root.clojure); sweep(&mut root.objects); sweep(&mut root.integers); sweep(&mut root.strings); let n = root.len(); root.threshold = n * 2; if root.threshold < (MIN_GC_NUM >> 1) { root.threshold = MIN_GC_NUM; } } /// mark reachable objects fn mark(vars: &mut VecDeque) { for v in vars.iter_mut() { for var in v.vars.iter_mut() { for (_, v) in var.iter_mut() { mark_obj(v); } } } } /// mark reachable objects recursively fn mark_obj(data: &mut RTData) { match data { RTData::Str(ptr) => unsafe { write_volatile(ptr.get_ref(), true); }, RTData::Int(ptr) => unsafe { write_volatile(ptr.get_ref(), true); }, RTData::Lambda(ptr) => unsafe { if !read_volatile(ptr.get_ref()) { write_volatile(ptr.get_ref(), true); if let Some(data) = &mut ptr.get_clojure_mut().data { for (_, v) in data.iter_mut() { mark_obj(v); } } } }, RTData::LData(ptr) => unsafe { if !read_volatile(ptr.get_ref()) { write_volatile(ptr.get_ref(), true); if let Some(data) = &mut ptr.get_ldata_mut().data { for v in data.iter_mut() { mark_obj(v); } } } }, _ => (), } } /// remove unreachable objects fn sweep(root: &mut LinkedList>>) { let mut tail = root.split_off(0); loop { if tail.is_empty() { break; } // take head let mut head; if tail.len() == 1 { head = tail.split_off(0); } else { let tmp = tail.split_off(1); head = tail; tail = tmp; }; // check the head is reachable or not let h = head.front_mut().unwrap(); let marked = unsafe { read_volatile(&h.as_ref().1) }; let flag = if marked { // the head is reachable let h = h.as_mut(); unsafe { h.get_unchecked_mut().1 = false; } true } else { // the head unreachable false }; // if reachable, append the head if flag { root.append(&mut head); } } } pub trait RTDataToRust { fn into(&self) -> T; } /// Get a BigInt value. impl RTDataToRust for RTData { fn into(&self) -> BigInt { if let RTData::Int(data) = self { data.get_int().clone() } else { panic!("data is not BigInt"); } } } /// Get a char value. impl RTDataToRust for RTData { fn into(&self) -> char { if let RTData::Char(data) = self { *data } else { panic!("data is not Char"); } } } /// Get a String value. impl RTDataToRust for RTData { fn into(&self) -> String { if let RTData::Str(data) = self { data.get_string().clone() } else { panic!("data is not String"); } } } /// Get a boolean value. impl RTDataToRust for RTData { fn into(&self) -> bool { if let RTData::Bool(data) = self { *data } else { panic!("data is not Bool"); } } } /// Convert a BLisp's List to a Rust's Vec. impl RTDataToRust> for RTData where RTData: RTDataToRust, { fn into(&self) -> Vec { if let RTData::LData(data) = self { let ldata = data.get_ldata(); let mut result = Vec::new(); list_to_vec(ldata, &mut result); return result; } panic!("data is not List"); } } /// Convert a BLisp's Option to a Rust's Option. impl RTDataToRust> for RTData where RTData: RTDataToRust, { fn into(&self) -> Option { if let RTData::LData(data) = self { let ldata = data.get_ldata(); match ldata.label.as_str() { "Some" => { if let Some(v) = &ldata.data { let e: T = RTDataToRust::into(&v[0]); Some(e) } else { panic!("invalid Some") } } "None" => None, _ => panic!("label is neither Some nor None"), } } else { panic!("data is not Option"); } } } /// Convert a BLisp's list to a Rust's Vec. fn list_to_vec(mut ldata: &LabeledData, result: &mut Vec) where RTData: RTDataToRust, { loop { match ldata.label.as_str() { "Cons" => { if let Some(v) = &ldata.data { let e: T = RTDataToRust::into(&v[0]); result.push(e); if let RTData::LData(data) = &v[1] { ldata = data.get_ldata(); } else { panic!("no next in Cons") } } else { panic!("invalid Cons"); } } "Nil" => break, _ => panic!("label is neither Cons nor Nil"), } } } /// Convert a BLisp's Result to a Rust's Result. impl RTDataToRust> for RTData where RTData: RTDataToRust + RTDataToRust, { fn into(&self) -> Result { if let RTData::LData(data) = self { let ldata = data.get_ldata(); match ldata.label.as_str() { "Ok" => { if let Some(v) = &ldata.data { let e: T = RTDataToRust::into(&v[0]); Ok(e) } else { panic!("invalid Ok") } } "Err" => { if let Some(v) = &ldata.data { let e: E = RTDataToRust::into(&v[0]); Err(e) } else { panic!("invalid Err") } } _ => panic!("label is neither Ok nor Err"), } } else { panic!("data is not Result"); } } } macro_rules! impl_rt_data_to_rust_tuple { ($($(#[$impl_attrs:meta])* [ $(($index:literal, $name_snake:ident, $name_pascal:ident)),+ $(,)? ]),+ $(,)?) => { $($(#[$impl_attrs])* impl<$($name_pascal),*> RTDataToRust<($($name_pascal),*)> for RTData where $(RTData: RTDataToRust<$name_pascal>),* { fn into(&self) -> ($($name_pascal),*) { if let RTData::LData(data) = self { let ldata = data.get_ldata(); if ldata.label.as_str() == "Tuple" { if let Some(v) = &ldata.data { $(let $name_snake: $name_pascal = RTDataToRust::into(&v[$index]);)* ($($name_snake),*) } else { panic!("invalid Tuple") } } else { panic!("label is not Tuple") } } else { panic!("data is not a Tuple") } } })* } } impl_rt_data_to_rust_tuple![ /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 2. [ (0, v0, T0), (1, v1, T1), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 3. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 4. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 5. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 6. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 7. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), (6, v6, T6), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 8. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), (6, v6, T6), (7, v7, T7), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 9. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), (6, v6, T6), (7, v7, T7), (8, v8, T8), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 10. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), (6, v6, T6), (7, v7, T7), (8, v8, T8), (9, v9, T9), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 11. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), (6, v6, T6), (7, v7, T7), (8, v8, T8), (9, v9, T9), (10, v10, T10), ], /// Convert a BLisp's Tuple to a Rust's Tuple /// where the length is 12. [ (0, v0, T0), (1, v1, T1), (2, v2, T2), (3, v3, T3), (4, v4, T4), (5, v5, T5), (6, v6, T6), (7, v7, T7), (8, v8, T8), (9, v9, T9), (10, v10, T10), (11, v11, T11), ], ]; pub trait RustToRTData { fn from(env: &mut Environment<'_>, value: T) -> Self; } impl RustToRTData for RTData { fn from(env: &mut Environment<'_>, value: BigInt) -> Self { RTData::Int(env.root.make_int(value)) } } impl RustToRTData for RTData { fn from(_env: &mut Environment<'_>, value: char) -> Self { RTData::Char(value) } } impl RustToRTData for RTData { fn from(_env: &mut Environment<'_>, value: bool) -> Self { RTData::Bool(value) } } impl RustToRTData for RTData { fn from(env: &mut Environment<'_>, value: String) -> Self { RTData::Str(env.root.make_str(value)) } } impl RustToRTData> for RTData where RTData: RustToRTData, { fn from(env: &mut Environment<'_>, value: Option) -> Self { if let Some(value) = value { let value = RustToRTData::from(env, value); RTData::LData(env.root.make_obj("Some".to_string(), Some(vec![value]))) } else { RTData::LData(env.root.make_obj("None".to_string(), None)) } } } impl RustToRTData> for RTData where RTData: RustToRTData + RustToRTData, { fn from(env: &mut Environment<'_>, value: Result) -> Self { match value { Ok(value) => { let value = RustToRTData::from(env, value); RTData::LData(env.root.make_obj("Ok".to_string(), Some(vec![value]))) } Err(value) => { let value = RustToRTData::from(env, value); RTData::LData(env.root.make_obj("Err".to_string(), Some(vec![value]))) } } } } impl RustToRTData<()> for RTData { fn from(env: &mut Environment<'_>, _: ()) -> Self { RTData::LData(env.root.make_obj("Tuple".to_string(), Some(vec![]))) } } macro_rules! impl_rust_to_rt_data_tuple { ($([ $(($name_snake:ident, $name_pascal:ident)),+ $(,)? ]),+ $(,)?) => { $(impl<$($name_pascal),*> RustToRTData<($($name_pascal),*)> for RTData where $(RTData: RustToRTData<$name_pascal>),* { fn from(env: &mut Environment<'_>, ($($name_snake),*): ($($name_pascal),*)) -> Self { $(let $name_snake = >::from(env, $name_snake);)* RTData::LData(env.root.make_obj("Tuple".to_string(), Some(vec![$($name_snake),*]))) } })* } } impl_rust_to_rt_data_tuple![ [(v0, V0), (v1, V1),], [(v0, V0), (v1, V1), (v2, V2),], [(v0, V0), (v1, V1), (v2, V2), (v3, V3),], [(v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4),], [(v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5),], [ (v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5), (v6, V6), ], [ (v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5), (v6, V6), (v7, V7), ], [ (v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5), (v6, V6), (v7, V7), (v8, V8), ], [ (v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5), (v6, V6), (v7, V7), (v8, V8), (v9, V9), ], [ (v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5), (v6, V6), (v7, V7), (v8, V8), (v9, V9), (v10, V10), ], [ (v0, V0), (v1, V1), (v2, V2), (v3, V3), (v4, V4), (v5, V5), (v6, V6), (v7, V7), (v8, V8), (v9, V9), (v10, V10), (v11, V11), ], ]; impl RustToRTData> for RTData where RTData: RustToRTData, { fn from(env: &mut Environment<'_>, vec: Vec) -> Self { Self::LData(collection_to_list(env, vec.into_iter())) } } impl RustToRTData<[T; N]> for RTData where RTData: RustToRTData, { fn from(env: &mut Environment<'_>, slice: [T; N]) -> Self { Self::LData(collection_to_list(env, slice.into_iter())) } } /// Convert a collection into a cons list. fn collection_to_list(env: &mut Environment<'_>, iter: I) -> LDataType where I: DoubleEndedIterator, RTData: RustToRTData, { let mut iter = iter .map(|item| { ( "Cons".to_string(), Some(vec![>::from(env, item)]), ) }) .chain([("Nil".to_string(), None)].into_iter()) .collect::>() .into_iter() .map(|(label, data)| env.root.make_obj(label, data)) .rev() .peekable(); let mut root_cons = None; while let Some(item) = iter.next() { match iter.peek_mut() { Some(next) => { next.get_ldata_mut() .data .as_mut() .expect("all items after a nil should contain a value") .push(RTData::LData(item)); } None => { root_cons = Some(item); } } } root_cons.expect("chaining a nil should ensure that the iterator always has a value") } pub trait FFI { /// Extern expression of BLisp fn blisp_extern(&self) -> &'static str; /// Return the corresponding FFI. fn ffi(&self) -> fn(env: &mut Environment<'_>, args: &[RTData]) -> RTData; /// The function name. fn name(&self) -> &'static str; } ================================================ FILE: src/semantics.rs ================================================ use super::{parser, Pos}; use crate::{ r#macro::Macros, runtime::{Environment, RTData}, TypingContext, }; use alloc::{ boxed::Box, collections::{ btree_map::{self, BTreeMap}, btree_set::BTreeSet, linked_list::LinkedList, }, fmt, format, string::{String, ToString}, vec, vec::Vec, }; use num_bigint::BigInt; type ID = u64; type Sbst = BTreeMap; #[derive(Clone, Debug)] enum Type { TCon(Tycon), TVar(ID), } #[derive(Clone, Debug)] struct Tycon { id: String, args: Option>, } impl fmt::Display for Type { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { match self { Type::TCon(t) => t.fmt(f), Type::TVar(id) => write!(f, "'t{}", id), } } } impl fmt::Display for Tycon { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { if let Some(args) = &self.args { if self.id == "->" { let mut iter = args.iter(); let e = format!("{}", iter.next().unwrap()); let args_str = format!("{}", iter.next().unwrap()); let ret = format!("{}", iter.next().unwrap()); write!(f, "({} (-> {} {}))", e, args_str, ret) } else { let mut s = "".to_string(); for it in args { s = format!("{} {}", s, it); } if self.id == "Arguments" { write!(f, "({})", &s[1..]) } else { write!(f, "({}{})", self.id, s) } } } else if self.id == "Arguments" { write!(f, "()") } else { write!(f, "{}", self.id) } } } fn ty_bool() -> Type { Type::TCon(Tycon { id: "Bool".to_string(), args: None, }) } fn ty_int() -> Type { Type::TCon(Tycon { id: "Int".to_string(), args: None, }) } fn ty_string() -> Type { Type::TCon(Tycon { id: "String".to_string(), args: None, }) } fn ty_char() -> Type { Type::TCon(Tycon { id: "Char".to_string(), args: None, }) } fn ty_var(n: ID) -> Type { Type::TVar(n) } fn ty_tuple(types: Vec) -> Type { Type::TCon(Tycon { id: "Tuple".to_string(), args: Some(types), }) } fn ty_list(ty: Type) -> Type { Type::TCon(Tycon { id: "List".to_string(), args: Some(vec![ty]), }) } fn ty_args(types: Vec) -> Type { if types.is_empty() { Type::TCon(Tycon { id: "Arguments".to_string(), args: None, }) } else { Type::TCon(Tycon { id: "Arguments".to_string(), args: Some(types), }) } } fn ty_fun(effect: &Effect, args: Vec, ret: Type) -> Type { let tuple = ty_args(args); let ty_effect = match effect { Effect::Pure => Type::TCon(Tycon { id: "Pure".to_string(), args: None, }), Effect::IO => Type::TCon(Tycon { id: "IO".to_string(), args: None, }), }; Type::TCon(Tycon { id: "->".to_string(), args: Some(vec![ty_effect, tuple, ret]), }) } fn ty_fun_gen_effect(n: ID, args: Vec, ret: Type) -> Type { let tuple = ty_args(args); let ty_effect = ty_var(n); Type::TCon(Tycon { id: "->".to_string(), args: Some(vec![ty_effect, tuple, ret]), }) } pub struct FunTypes { fun_types: BTreeMap>, } impl FunTypes { fn new() -> FunTypes { FunTypes { fun_types: BTreeMap::new(), } } fn insert(&mut self, key: &str, val: Type) { match self.fun_types.get_mut(key) { Some(list) => { list.push_back(val); } None => { let mut list = LinkedList::new(); list.push_back(val); self.fun_types.insert(key.to_string(), list); } } } fn contains(&self, key: &str, val: &Type) -> bool { match self.fun_types.get(key) { Some(list) => { for t in list { if unify(val, t).is_some() { return true; } } false } None => false, } } } struct VarType { var_stack: LinkedList>>, } impl VarType { fn new() -> VarType { let mut var_type = VarType { var_stack: LinkedList::new(), }; var_type.push(); var_type } fn push(&mut self) { self.var_stack.push_back(BTreeMap::new()); } fn pop(&mut self) { self.var_stack.pop_back(); } fn insert(&mut self, key: String, val: Type) { match self.var_stack.back_mut() { Some(m) => match m.get_mut(&key) { Some(v) => { v.push_back(val); } None => { let mut v = LinkedList::new(); v.push_back(val); m.insert(key, v); } }, None => { panic!("failed to insert"); } } } fn get(&self, key: &str) -> Option<&Type> { for m in self.var_stack.iter().rev() { if let Some(list) = m.get(key) { return list.back(); } } None } } #[derive(Debug)] pub struct TypingErr { pub msg: String, pub pos: Pos, } impl TypingErr { fn new(msg: &str, ast: &parser::Expr) -> TypingErr { TypingErr { msg: msg.to_string(), pos: ast.get_pos(), } } } #[derive(Clone, Debug)] pub(crate) enum LangExpr { IfExpr(Box), LetExpr(Box), LitStr(StrNode), LitChar(CharNode), LitNum(NumNode), LitBool(BoolNode), IDExpr(IDNode), DataExpr(DataNode), MatchExpr(Box), ApplyExpr(Apply), ListExpr(Exprs), TupleExpr(Exprs), LambdaExpr(Box), } impl LangExpr { pub(crate) fn get_pos(&self) -> Pos { match self { LangExpr::IfExpr(e) => e.pos, LangExpr::LetExpr(e) => e.pos, LangExpr::LitStr(e) => e.pos, LangExpr::LitChar(e) => e.pos, LangExpr::LitNum(e) => e.pos, LangExpr::LitBool(e) => e.pos, LangExpr::IDExpr(e) => e.pos, LangExpr::DataExpr(e) => e.pos, LangExpr::MatchExpr(e) => e.pos, LangExpr::ApplyExpr(e) => e.pos, LangExpr::ListExpr(e) => e.pos, LangExpr::TupleExpr(e) => e.pos, LangExpr::LambdaExpr(e) => e.pos, } } fn apply_sbst(&mut self, sbst: &Sbst) { let app = |opty: &Option| opty.as_ref().map(|t| t.apply_sbst(sbst)); match self { LangExpr::IfExpr(e) => { e.cond_expr.apply_sbst(sbst); e.then_expr.apply_sbst(sbst); e.else_expr.apply_sbst(sbst); e.ty = app(&e.ty); } LangExpr::LetExpr(e) => { for dv in e.def_vars.iter_mut() { dv.pattern.apply_sbst(sbst); dv.expr.apply_sbst(sbst); dv.ty = app(&dv.ty); } e.expr.apply_sbst(sbst); e.ty = app(&e.ty); } LangExpr::LitStr(_) | LangExpr::LitChar(_) | LangExpr::LitNum(_) | LangExpr::LitBool(_) => (), LangExpr::IDExpr(e) => { e.ty = app(&e.ty); } LangExpr::DataExpr(e) => { for it in e.exprs.iter_mut() { it.apply_sbst(sbst); } e.ty = app(&e.ty); } LangExpr::MatchExpr(e) => { e.ty = app(&e.ty); e.expr.apply_sbst(sbst); for cs in e.cases.iter_mut() { cs.pattern.apply_sbst(sbst); cs.expr.apply_sbst(sbst); cs.ty = app(&cs.ty); } } LangExpr::ApplyExpr(e) => { for it in e.exprs.iter_mut() { it.apply_sbst(sbst); } e.ty = app(&e.ty); } LangExpr::ListExpr(e) => { for it in e.exprs.iter_mut() { it.apply_sbst(sbst); } e.ty = app(&e.ty); } LangExpr::TupleExpr(e) => { for it in e.exprs.iter_mut() { it.apply_sbst(sbst); } e.ty = app(&e.ty); } LangExpr::LambdaExpr(e) => { for it in e.args.iter_mut() { it.ty = app(&it.ty); } e.expr.apply_sbst(sbst); e.ty = app(&e.ty); } } } } #[derive(Clone, Debug)] pub(crate) struct Lambda { pub(crate) args: Vec, pub(crate) expr: LangExpr, pub(crate) pos: Pos, pub(crate) vars: Vec, pub(crate) ident: u64, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct StrNode { pub(crate) str: String, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct CharNode { pub(crate) c: char, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct NumNode { pub(crate) num: BigInt, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct BoolNode { pub(crate) val: bool, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct IDNode { pub(crate) id: String, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct Extern { pub(crate) id: IDNode, pub(crate) fun_type: TypeExpr, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct IfNode { pub(crate) cond_expr: LangExpr, pub(crate) then_expr: LangExpr, pub(crate) else_expr: LangExpr, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct LetNode { pub(crate) def_vars: Vec, pub(crate) expr: LangExpr, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct DefVar { pub(crate) pattern: Pattern, pub(crate) expr: LangExpr, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct MatchNode { pub(crate) expr: LangExpr, pub(crate) cases: Vec, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct DataNode { pub(crate) label: TIDNode, pub(crate) exprs: Vec, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) enum Pattern { PatStr(StrNode), PatChar(CharNode), PatNum(NumNode), PatBool(BoolNode), PatID(IDNode), PatTuple(PatTupleNode), PatData(PatDataNode), PatNil(PatNilNode), } impl Pattern { pub(crate) fn get_pos(&self) -> Pos { match self { Pattern::PatStr(e) => e.pos, Pattern::PatChar(e) => e.pos, Pattern::PatNum(e) => e.pos, Pattern::PatBool(e) => e.pos, Pattern::PatID(e) => e.pos, Pattern::PatTuple(e) => e.pos, Pattern::PatData(e) => e.pos, Pattern::PatNil(e) => e.pos, } } fn get_type(&self) -> &Option { match self { Pattern::PatStr(e) => &e.ty, Pattern::PatChar(e) => &e.ty, Pattern::PatNum(e) => &e.ty, Pattern::PatBool(e) => &e.ty, Pattern::PatID(e) => &e.ty, Pattern::PatTuple(e) => &e.ty, Pattern::PatData(e) => &e.ty, Pattern::PatNil(e) => &e.ty, } } fn apply_sbst(&mut self, sbst: &Sbst) { let app = |opty: &Option| opty.as_ref().map(|t| t.apply_sbst(sbst)); match self { Pattern::PatID(e) => { e.ty = app(&e.ty); } Pattern::PatTuple(e) => { for pat in e.pattern.iter_mut() { pat.apply_sbst(sbst); } e.ty = app(&e.ty); } Pattern::PatData(e) => { for pat in e.pattern.iter_mut() { pat.apply_sbst(sbst); } e.ty = app(&e.ty); } Pattern::PatNil(e) => { e.ty = app(&e.ty); } _ => (), } } } #[derive(Clone, Debug)] pub(crate) struct PatTupleNode { pub(crate) pattern: Vec, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct PatDataNode { pub(crate) label: TIDNode, pub(crate) pattern: Vec, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct PatNilNode { pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct MatchCase { pub(crate) pattern: Pattern, pub(crate) expr: LangExpr, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct Apply { pub(crate) exprs: Vec, pub(crate) pos: Pos, pub(crate) is_tail: bool, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct Exprs { pub(crate) exprs: Vec, pub(crate) pos: Pos, ty: Option, } #[derive(Clone, Debug)] pub(crate) struct TIDNode { pub(crate) id: String, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) struct TEBoolNode; #[derive(Clone, Debug)] pub(crate) struct TEIntNode; #[derive(Clone, Debug)] pub(crate) struct TEStringNode; #[derive(Clone, Debug)] pub(crate) struct TECharNode; #[derive(Clone, Debug)] pub(crate) struct DataType { pub(crate) name: DataTypeName, pub(crate) members: Vec, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) struct DataTypeName { pub(crate) id: TIDNode, pub(crate) type_args: Vec, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) struct DataTypeMem { pub(crate) id: TIDNode, pub(crate) types: Vec, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) enum TypeExpr { Bool(TEBoolNode), Int(TEIntNode), String(TEStringNode), Char(TECharNode), List(TEListNode), Tuple(TETupleNode), Fun(TEFunNode), Data(TEDataNode), Id(IDNode), } #[derive(Clone, Debug)] pub(crate) struct TEListNode { pub(crate) ty: Box, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) struct TETupleNode { pub(crate) ty: Vec, pub(crate) pos: Pos, } #[derive(Clone, Debug)] enum Effect { IO, Pure, } #[derive(Clone, Debug)] pub(crate) struct TEFunNode { effect: Effect, pub(crate) args: Vec, pub(crate) ret: Box, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) struct TEDataNode { pub(crate) id: TIDNode, pub(crate) type_args: Vec, pub(crate) pos: Pos, } #[derive(Clone, Debug)] pub(crate) struct Defun { exported: bool, pub(crate) id: IDNode, pub(crate) args: Vec, pub(crate) fun_type: TypeExpr, effect: Effect, pub(crate) expr: LangExpr, pub(crate) pos: Pos, ty: Option, } trait TApp: Sized { fn apply(&self, ty: &BTreeMap) -> Result; } impl TApp for DataType { fn apply(&self, ty: &BTreeMap) -> Result { let mut mems = Vec::new(); for m in self.members.iter() { mems.push(m.apply(ty)?); } Ok(DataType { name: self.name.clone(), members: mems, pos: self.pos, }) } } impl TApp for DataTypeMem { fn apply(&self, ty: &BTreeMap) -> Result { let mut v = Vec::new(); for it in self.types.iter() { v.push(it.apply(ty)?); } Ok(DataTypeMem { id: self.id.clone(), types: v, pos: self.pos, }) } } impl TApp for TypeExpr { fn apply(&self, ty: &BTreeMap) -> Result { match self { TypeExpr::Data(data) => Ok(TypeExpr::Data(data.apply(ty)?)), TypeExpr::List(list) => Ok(TypeExpr::List(list.apply(ty)?)), TypeExpr::Tuple(tuple) => Ok(TypeExpr::Tuple(tuple.apply(ty)?)), TypeExpr::Fun(fun) => Ok(TypeExpr::Fun(fun.apply(ty)?)), TypeExpr::Id(id) => match ty.get(&id.id) { Some(t) => Ok(t.clone()), _ => Ok(TypeExpr::Id(id.clone())), }, _ => Ok(self.clone()), } } } impl TApp for TEListNode { fn apply(&self, ty: &BTreeMap) -> Result { Ok(TEListNode { ty: Box::new(self.ty.apply(ty)?), pos: self.pos, }) } } impl TApp for TETupleNode { fn apply(&self, ty: &BTreeMap) -> Result { let mut v = Vec::new(); for it in self.ty.iter() { v.push(it.apply(ty)?); } Ok(TETupleNode { ty: v, pos: self.pos, }) } } impl TApp for TEFunNode { fn apply(&self, ty: &BTreeMap) -> Result { let mut v = Vec::new(); for it in self.args.iter() { v.push(it.apply(ty)?); } Ok(TEFunNode { effect: self.effect.clone(), args: v, ret: Box::new(self.ret.apply(ty)?), pos: self.pos, }) } } impl TApp for TEDataNode { fn apply(&self, ty: &BTreeMap) -> Result { let mut v = Vec::new(); for it in self.type_args.iter() { v.push(it.apply(ty)?); } Ok(TEDataNode { id: self.id.clone(), type_args: v, pos: self.pos, }) } } pub type CallbackFn = Box Option + Send>; pub type FFIFn = BTreeMap<&'static str, fn(env: &mut Environment<'_>, args: &[RTData]) -> RTData>; pub struct Context { pub(crate) funs: BTreeMap, pub(crate) ext_funs: BTreeMap, pub(crate) ext_ffi: FFIFn, pub(crate) lambda: BTreeMap, pub(crate) lambda_ident: u64, pub(crate) data: BTreeMap, pub(crate) built_in: BTreeSet, label2data: BTreeMap, pub(crate) callback: CallbackFn, pub(crate) macros: Macros, } impl Context { fn new( funs: BTreeMap, ext_funs: BTreeMap, ext_ffi: FFIFn, data: BTreeMap, macros: Macros, ) -> Context { let mut built_in = BTreeSet::new(); built_in.insert("+".to_string()); built_in.insert("-".to_string()); built_in.insert("*".to_string()); built_in.insert("/".to_string()); built_in.insert(">>".to_string()); built_in.insert("<<".to_string()); built_in.insert("band".to_string()); built_in.insert("bor".to_string()); built_in.insert("bxor".to_string()); built_in.insert("pow".to_string()); built_in.insert("sqrt".to_string()); built_in.insert("chars".to_string()); built_in.insert("str".to_string()); built_in.insert("%".to_string()); built_in.insert("<".to_string()); built_in.insert(">".to_string()); built_in.insert("=".to_string()); built_in.insert("!=".to_string()); built_in.insert("<=".to_string()); built_in.insert(">=".to_string()); built_in.insert("lt".to_string()); built_in.insert("gt".to_string()); built_in.insert("eq".to_string()); built_in.insert("neq".to_string()); built_in.insert("leq".to_string()); built_in.insert("geq".to_string()); built_in.insert("and".to_string()); built_in.insert("or".to_string()); built_in.insert("xor".to_string()); built_in.insert("not".to_string()); built_in.insert("call-rust".to_string()); Context { funs, ext_funs, ext_ffi, data, built_in, label2data: BTreeMap::new(), lambda: BTreeMap::new(), lambda_ident: 0, callback: Box::new(|_, _, _| None), macros, } } pub fn set_callback(&mut self, func: CallbackFn) { self.callback = func; } fn typing(&mut self) -> Result<(), TypingErr> { self.check_data_def()?; self.check_label()?; self.check_data_rec()?; self.check_defun_type()?; self.typing_functions()?; self.check_defun_type_after_infer()?; self.check_match_exhaustive()?; self.find_tail_call(); self.get_free_var_in_lambda(); Ok(()) } fn check_match_exhaustive(&self) -> Result<(), TypingErr> { for fun in self.funs.values() { exhaustive_expr(&fun.expr, self)?; } Ok(()) } fn find_tail_call(&mut self) { for fun in self.funs.values_mut() { tail_call(&mut fun.expr); } for fun in self.lambda.values_mut() { tail_call(&mut fun.expr); } } fn check_label(&mut self) -> Result<(), TypingErr> { for dt in self.data.values() { for mem in &dt.members { if self.label2data.contains_key(&mem.id.id) { let msg = format!("{} is multiply defined", mem.id.id); return Err(TypingErr { msg, pos: mem.id.pos, }); } self.label2data .insert(mem.id.id.clone(), dt.name.id.id.clone()); } } Ok(()) } fn typing_functions(&mut self) -> Result<(), TypingErr> { let mut ext_funs = BTreeMap::new(); for (_, ext_fun) in self.ext_funs.iter() { let mut fun = ext_fun.clone(); self.typing_extern(&mut fun)?; ext_funs.insert(fun.id.id.to_string(), fun); } self.ext_funs = ext_funs; let mut funs = BTreeMap::new(); for (_, defun) in self.funs.iter() { let mut defun = defun.clone(); self.typing_defun(&mut defun)?; funs.insert(defun.id.id.to_string(), defun); } self.funs = funs; Ok(()) } fn typing_extern(&self, fun: &mut Extern) -> Result<(), TypingErr> { let mut num_tv = 0; let fun_type = self.to_type(&fun.fun_type, &mut num_tv).unwrap(); // defined type fun.ty = Some(fun_type); Ok(()) } fn typing_defun(&self, defun: &mut Defun) -> Result<(), TypingErr> { let mut var_type = VarType::new(); let mut num_tv = 0; let mut args_orig = Vec::new(); // initialize types of arguments for t in &defun.args { let tv = ty_var(num_tv); var_type.insert(t.id.to_string(), tv.clone()); args_orig.push(tv); num_tv += 1; } // infer type of the expression let sbst = Sbst::new(); let (ret, sbst) = self.typing_expr(&mut defun.expr, sbst, &mut var_type, &mut num_tv)?; let args = args_orig.iter().map(|x| x.apply_sbst(&sbst)).collect(); let fun_type1 = self.to_type(&defun.fun_type, &mut num_tv).unwrap(); // defined type let fun_type2 = ty_fun(&defun.effect, args, ret); // inferred type // check defined function types with inferred type let s1 = match unify(&fun_type1, &fun_type2) { None => { let msg = format!( "function type was mismatched\n inferred: {}\n defined: {}", fun_type2, fun_type1 ); return Err(TypingErr { msg, pos: defun.pos, }); } Some(s) => s, }; let sbst = compose(&s1, &sbst); // update function type defun.ty = Some(fun_type1.apply_sbst(&sbst)); // update types in the expression defun.expr.apply_sbst(&sbst); // update types of arguments for (arg, ty) in defun.args.iter_mut().zip(args_orig.iter()) { arg.ty = Some(ty.apply_sbst(&sbst)); } Ok(()) } fn typing_expr( &self, expr: &mut LangExpr, sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { match expr { LangExpr::LitStr(_) => Ok((ty_string(), sbst)), LangExpr::LitChar(_) => Ok((ty_char(), sbst)), LangExpr::LitBool(_) => Ok((ty_bool(), sbst)), LangExpr::LitNum(_) => Ok((ty_int(), sbst)), LangExpr::IfExpr(e) => self.typing_if(e, sbst, var_type, num_tv), LangExpr::IDExpr(e) => self.typing_var(e, sbst, var_type, num_tv), LangExpr::LetExpr(e) => self.typing_let(e, sbst, var_type, num_tv), LangExpr::MatchExpr(e) => self.typing_match(e, sbst, var_type, num_tv), LangExpr::TupleExpr(e) => self.typing_tuple(e, sbst, var_type, num_tv), LangExpr::ListExpr(e) => self.typing_list(e, sbst, var_type, num_tv), LangExpr::ApplyExpr(e) => self.typing_app(e, sbst, var_type, num_tv), LangExpr::DataExpr(e) => self.typing_data(e, sbst, var_type, num_tv), LangExpr::LambdaExpr(e) => self.typing_lambda(e, sbst, var_type, num_tv), } } fn typing_lambda( &self, expr: &mut Lambda, sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { var_type.push(); // generate new type variables for arguments for arg in &mut expr.args { let ty = ty_var(*num_tv); *num_tv += 1; arg.ty = Some(ty.clone()); if arg.id != "_" { var_type.insert(arg.id.to_string(), ty.clone()); } } // infer the type of the expression let (ret_ty, sbst) = self.typing_expr(&mut expr.expr, sbst, var_type, num_tv)?; var_type.pop(); // generate function type let mut v = Vec::new(); for arg in &mut expr.args { match &arg.ty { Some(t) => { let t2 = t.apply_sbst(&sbst); v.push(t2.clone()); arg.ty = Some(t2); } None => (), } } let ty = ty_fun(&Effect::Pure, v, ret_ty); expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_data( &self, expr: &mut DataNode, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { let data_type; let label_types; // get type of label and types of label's elements match self.get_type_of_label(&expr.label.id, num_tv) { Ok((t, m)) => { data_type = t; label_types = m; } Err(msg) => { return Err(TypingErr { msg, pos: expr.pos }); } } // check the number of elements if label_types.len() != expr.exprs.len() { let msg = format!( "{} requires exactly {} arguments but actually passed {}", expr.label.id, label_types.len(), expr.exprs.len() ); return Err(TypingErr { msg, pos: expr.pos }); } // check types of the elements and arguments for (e, ty) in expr.exprs.iter_mut().zip(label_types.iter()) { let r = self.typing_expr(e, sbst, var_type, num_tv)?; sbst = r.1; let t0 = ty.apply_sbst(&sbst); let t1 = r.0.apply_sbst(&sbst); let s1 = match unify(&t0, &t1) { Some(s) => s, None => { let msg = format!("mismatched type\n expected: {}\n actual: {}", t0, t1); return Err(TypingErr { msg, pos: e.get_pos(), }); } }; sbst = compose(&s1, &sbst); } let ty = data_type.apply_sbst(&sbst); expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_app( &self, expr: &mut Apply, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { let mut iter = expr.exprs.iter_mut(); // get function let e1 = match iter.next() { Some(e) => e, None => { return Err(TypingErr { msg: "require function".to_string(), pos: expr.pos, }); } }; // get function type let r = self.typing_expr(e1, sbst, var_type, num_tv)?; sbst = r.1; let t1 = r.0; // function type // get arguments let mut v = Vec::new(); for e in iter { let r = self.typing_expr(e, sbst, var_type, num_tv)?; sbst = r.1; v.push(r.0); } // get return type let ret = ty_var(*num_tv); *num_tv += 1; // get inferred function type let fun_ty = ty_fun_gen_effect(*num_tv, v, ret.clone()); *num_tv += 1; match unify(&t1, &fun_ty) { Some(s1) => { sbst = compose(&s1, &sbst); } None => { let msg = format!( "mismatched type\n expected: {}\n actual: {}", fun_ty, t1 ); return Err(TypingErr { msg, pos: expr.pos }); } } let t = ret.apply_sbst(&sbst); expr.ty = Some(t.clone()); Ok((t, sbst)) } fn typing_tuple( &self, expr: &mut Exprs, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { let mut v = Vec::new(); for e in expr.exprs.iter_mut() { let (t, s) = self.typing_expr(e, sbst, var_type, num_tv)?; sbst = s; v.push(t); } let ty = ty_tuple(v); expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_list( &self, expr: &mut Exprs, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { let mut ty = None; // type of the first element for e in expr.exprs.iter_mut() { let (t, s) = self.typing_expr(e, sbst, var_type, num_tv)?; sbst = s; match &ty { None => { ty = Some(t); } Some(t0) => { let t0 = t0.apply_sbst(&sbst); // check current element's type is same as the first element's type match unify(&t0, &t) { Some(s1) => { sbst = compose(&s1, &sbst); } None => { let msg = format!("mismatched type\n expected: {}\n actual: {}", t0, t); return Err(TypingErr { msg, pos: e.get_pos(), }); } } } } } match ty { Some(t0) => { let tyls = ty_list(t0.apply_sbst(&sbst)); expr.ty = Some(tyls.clone()); Ok((tyls, sbst)) } None => { // Nil let t = ty_var(*num_tv); let tyls = ty_list(t); *num_tv += 1; expr.ty = Some(tyls.clone()); Ok((tyls, sbst)) } } } fn typing_match( &self, expr: &mut MatchNode, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { // for (match e_0 (c_1 e_1) (c_2 e_2) ... (c_n e_n)) // get e_0's type let r = self.typing_expr(&mut expr.expr, sbst, var_type, num_tv)?; let mut type_head = r.0; sbst = r.1; let mut e_ty = None; for cs in expr.cases.iter_mut() { var_type.push(); // get c_n's type let (pat_ty, s) = self.typing_pat(&mut cs.pattern, sbst, var_type, num_tv)?; sbst = s; // check types of e_0 and c_n are same type_head = type_head.apply_sbst(&sbst); let s1 = match unify(&type_head, &pat_ty) { Some(s) => s, None => { let msg = format!( "mismatched type\n expected: {}\n actual: {}", type_head, pat_ty ); return Err(TypingErr { msg, pos: cs.pattern.get_pos(), }); } }; sbst = compose(&s1, &sbst); // get e_n's type let (ty, s) = self.typing_expr(&mut cs.expr, sbst, var_type, num_tv)?; sbst = s; // check types of e_{n-1} and e_n are same if let Some(t_prev) = e_ty { let s1 = match unify(&t_prev, &ty) { Some(s) => s, None => { let msg = format!( "mismatched type\n expected: {}\n actual: {}", t_prev, ty ); return Err(TypingErr { msg, pos: cs.pos }); } }; sbst = compose(&sbst, &s1); } let ty = ty.apply_sbst(&sbst); cs.ty = Some(ty.clone()); e_ty = Some(ty); var_type.pop(); } expr.ty = e_ty.clone(); Ok((e_ty.unwrap(), sbst)) } fn typing_var( &self, expr: &mut IDNode, sbst: Sbst, var_type: &VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { let ty = match var_type.get(&expr.id) { Some(t) => t.apply_sbst(&sbst), None => { // look up external function if let Some(fun) = self.ext_funs.get(&expr.id) { self.to_type(&fun.fun_type, num_tv).unwrap() } else { // look up function match self.funs.get(&expr.id) { Some(defun) => self.to_type(&defun.fun_type, num_tv).unwrap(), None => { match expr.id.as_ref() { // built-in functions "+" | "-" | "*" | "/" | "%" | "band" | "bor" | "bxor" => { ty_fun(&Effect::Pure, vec![ty_int(), ty_int()], ty_int()) } "=" | "<" | ">" | "<=" | ">=" | "!=" => { let tv = ty_var(*num_tv); *num_tv += 1; ty_fun(&Effect::Pure, vec![tv.clone(), tv], ty_bool()) } "eq" | "lt" | "gt" | "leq" | "geq" | "neq" => { let tv1 = ty_var(*num_tv); *num_tv += 1; let tv2 = ty_var(*num_tv); *num_tv += 1; ty_fun(&Effect::Pure, vec![tv1, tv2], ty_bool()) } "and" | "or" | "xor" => { ty_fun(&Effect::Pure, vec![ty_bool(), ty_bool()], ty_bool()) } "not" => ty_fun(&Effect::Pure, vec![ty_bool()], ty_bool()), "sqrt" => ty_fun( &Effect::Pure, vec![ty_int()], Type::TCon(Tycon { id: "Option".to_string(), args: Some(vec![ty_int()]), }), ), "pow" | "<<" | ">>" => { // (Pure (-> (Int Int) (Option Int))) ty_fun( &Effect::Pure, vec![ty_int(), ty_int()], Type::TCon(Tycon { id: "Option".to_string(), args: Some(vec![ty_int()]), }), ) } "chars" => { // (Pure (-> (String) (List Char))) ty_fun( &Effect::Pure, vec![ty_string()], Type::TCon(Tycon { id: "List".to_string(), args: Some(vec![ty_char()]), }), ) } "str" => { // (Pure (-> ((List Char)) String)) ty_fun( &Effect::Pure, vec![Type::TCon(Tycon { id: "List".to_string(), args: Some(vec![ty_char()]), })], ty_string(), ) } "call-rust" => { // (IO (-> (Int Int Int) (Option Int))) ty_fun( &Effect::IO, vec![ty_int(), ty_int(), ty_int()], Type::TCon(Tycon { id: "Option".to_string(), args: Some(vec![ty_int()]), }), ) } _ => { let msg = format!("{} is not defined 5", expr.id); return Err(TypingErr { msg, pos: expr.pos }); } } } } } } }; expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_if( &self, expr: &mut IfNode, sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { // condition let (ty_cond, sbst) = self.typing_expr(&mut expr.cond_expr, sbst, var_type, num_tv)?; // check the type of condition is Bool let s1 = match unify(&ty_bool(), &ty_cond) { Some(s) => s, None => { let msg = format!( "condition of if expression must be Bool, but found {}", ty_cond ); return Err(TypingErr { msg, pos: expr.cond_expr.get_pos(), }); } }; let sbst = compose(&s1, &sbst); // then and else expressions let (ty_then, sbst) = self.typing_expr(&mut expr.then_expr, sbst, var_type, num_tv)?; let (ty_else, sbst) = self.typing_expr(&mut expr.else_expr, sbst, var_type, num_tv)?; // check types of expressions are same let s1 = match unify(&ty_then, &ty_else) { Some(s) => s, None => { let msg = format!( "when (if c e1 e2), the types of e1 and e2 must be same\n e1: {}\n e2: {}", ty_then, ty_else ); return Err(TypingErr { msg, pos: expr.else_expr.get_pos(), }); } }; let sbst = compose(&s1, &sbst); let ty = ty_then.apply_sbst(&sbst); expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_let( &self, expr: &mut LetNode, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { var_type.push(); for dv in expr.def_vars.iter_mut() { let (t1, s) = self.typing_expr(&mut dv.expr, sbst, var_type, num_tv)?; let (t2, s) = self.typing_pat(&mut dv.pattern, s, var_type, num_tv)?; sbst = s; let s1 = match unify(&t1, &t2) { Some(s) => s, None => { let msg = format!("mismatched type\n left: {}\n right: {}", t2, t1); return Err(TypingErr { msg, pos: dv.pos }); } }; sbst = compose(&s1, &sbst); dv.ty = Some(t1.apply_sbst(&sbst)); } let r = self.typing_expr(&mut expr.expr, sbst, var_type, num_tv)?; var_type.pop(); expr.ty = Some(r.0.clone()); Ok(r) } fn typing_pat( &self, expr: &mut Pattern, sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { match expr { Pattern::PatStr(_) => Ok((ty_string(), sbst)), Pattern::PatChar(_) => Ok((ty_char(), sbst)), Pattern::PatBool(_) => Ok((ty_bool(), sbst)), Pattern::PatNum(_) => Ok((ty_int(), sbst)), Pattern::PatID(e) => Ok(self.typing_pat_id(e, sbst, var_type, num_tv)), Pattern::PatData(e) => self.typing_pat_data(e, sbst, var_type, num_tv), Pattern::PatTuple(e) => self.typing_pat_tuple(e, sbst, var_type, num_tv), Pattern::PatNil(e) => Ok(self.typing_pat_nil(e, sbst, num_tv)), } } fn typing_pat_tuple( &self, expr: &mut PatTupleNode, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { let mut v = Vec::new(); for pat in expr.pattern.iter_mut() { let (t, s) = self.typing_pat(pat, sbst, var_type, num_tv)?; sbst = s; v.push(t); } let ty = ty_tuple(v); expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_pat_id( &self, expr: &mut IDNode, sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> (Type, Sbst) { // generate new type variable (internal representation) let ty = ty_var(*num_tv); *num_tv += 1; expr.ty = Some(ty.clone()); if expr.id != "_" { var_type.insert(expr.id.to_string(), ty.clone()); } (ty, sbst) } fn typing_pat_data( &self, expr: &mut PatDataNode, mut sbst: Sbst, var_type: &mut VarType, num_tv: &mut ID, ) -> Result<(Type, Sbst), TypingErr> { // get the type of label and the types of label's elements let data_type; // type of label let label_types; // types of label's elements match self.get_type_of_label(&expr.label.id, num_tv) { Ok((t, m)) => { data_type = t; label_types = m; } Err(msg) => { return Err(TypingErr { msg, pos: expr.label.pos, }); } } // check the number of arguments if label_types.len() != expr.pattern.len() { let msg = format!( "{} requires exactly {} arguments but actually passed {}", expr.label.id, label_types.len(), expr.pattern.len() ); return Err(TypingErr { msg, pos: expr.label.pos, }); } // check type of each element for (pat, lt) in expr.pattern.iter_mut().zip(label_types.iter()) { let r = self.typing_pat(pat, sbst, var_type, num_tv)?; sbst = r.1; let lt = lt.apply_sbst(&sbst); let s1 = match unify(<, &r.0) { Some(s) => s, None => { let msg = format!("mismatched type\n expected: {}\n actual: {}", lt, r.0); return Err(TypingErr { msg, pos: pat.get_pos(), }); } }; sbst = compose(&s1, &sbst); } let ty = data_type.apply_sbst(&sbst); expr.ty = Some(ty.clone()); Ok((ty, sbst)) } fn typing_pat_nil(&self, expr: &mut PatNilNode, sbst: Sbst, num_tv: &mut ID) -> (Type, Sbst) { let tv = ty_var(*num_tv); *num_tv += 1; let ty = ty_list(tv); expr.ty = Some(ty.clone()); (ty, sbst) } fn to_type(&self, expr: &TypeExpr, num_tv: &mut ID) -> Result { let mut tv2type = BTreeMap::new(); get_tv2type_from_type_expr(expr, num_tv, &mut tv2type); apply_tv2type_to_type_expr(expr, &tv2type) } /// If /// ```lisp /// (data (Tree t) /// (Node (Tree t) (Tree t)) /// Leaf) /// ``` /// then get_type_of_label("Node", 2) /// returns Ok((Tree (TVar 2)), vec!((Tree (TVar 2)), ((Tree (TVar 2)))) fn get_type_of_label(&self, label: &str, num_tv: &mut ID) -> Result<(Type, Vec), String> { // find the name of data of the label let data_name; match self.label2data.get(label) { Some(n) => { data_name = n; } None => { match label { // built-in data type // (data (List a) // (Cons a (List a)) // Nil) "Cons" => { let tv = ty_var(*num_tv); let ty = ty_list(tv.clone()); *num_tv += 1; return Ok((ty.clone(), vec![tv, ty])); } "Nil" => { let tv = ty_var(*num_tv); let ty = ty_list(tv); *num_tv += 1; return Ok((ty, vec![])); } _ => { let msg = format!("{} is not defined", label); return Err(msg); } } } } // find corresponding data let data_node = match self.data.get(data_name) { Some(n) => n, None => { let msg = format!("could not find data of label {}", label); return Err(msg); } }; // get the type of the data let mut types = Vec::new(); for i in 0..data_node.name.type_args.len() { types.push(ty_var(i as ID + *num_tv)); } *num_tv += data_node.name.type_args.len() as u64; // generate a map from type variable to type let mut tv2type = BTreeMap::new(); for (k, v) in data_node.name.type_args.iter().zip(types.iter()) { tv2type.insert(k.id.clone(), v.clone()); } // find corresponding member let mut mem = None; for m in &data_node.members { if m.id.id == *label { mem = Some(m); break; } } // return type of label and label's type match mem { Some(mem) => { let mut label_types = Vec::new(); for t in &mem.types { label_types.push(apply_tv2type_to_type_expr(t, &tv2type)?); } // the type of the data let data_type = Type::TCon(Tycon { id: data_name.to_string(), args: if types.is_empty() { None } else { Some(types) }, }); Ok((data_type, label_types)) } None => { let msg = format!("could not find label {}", label); Err(msg) } } } fn check_data_def(&self) -> Result<(), TypingErr> { for (_, d) in self.data.iter() { self.check_data_def_data(d)?; } Ok(()) } fn check_data_def_data(&self, data: &DataType) -> Result<(), TypingErr> { let mut args = BTreeSet::new(); for arg in data.name.type_args.iter() { if args.contains(&arg.id) { let msg = format!("{} is multiply used", arg.id); return Err(TypingErr { msg, pos: arg.pos }); } args.insert(arg.id.clone()); } for mem in data.members.iter() { self.check_data_def_mem(mem, &args)?; } Ok(()) } fn check_data_def_mem( &self, mem: &DataTypeMem, args: &BTreeSet, ) -> Result<(), TypingErr> { for it in mem.types.iter() { self.check_def_type(it, Some(args))? } Ok(()) } fn check_def_type( &self, ty: &TypeExpr, args: Option<&BTreeSet>, ) -> Result<(), TypingErr> { match ty { TypeExpr::Id(id) => { if let Some(m) = args { if !m.contains(&id.id) { let msg = format!("{} is undefined", id.id); return Err(TypingErr { msg, pos: id.pos }); } } } TypeExpr::List(list) => { self.check_def_type(&list.ty, args)?; } TypeExpr::Tuple(tuple) => { for it in tuple.ty.iter() { self.check_def_type(it, args)?; } } TypeExpr::Data(data) => { match self.data.get(&data.id.id) { Some(dt) => { if dt.name.type_args.len() != data.type_args.len() { let msg = format!( "{} takes {} type arguments but actually passed {}", data.id.id, dt.name.type_args.len(), data.type_args.len() ); return Err(TypingErr { msg, pos: data.id.pos, }); } } None => { let msg = format!("{} is unkown type", data.id.id); return Err(TypingErr { msg, pos: data.id.pos, }); } } for it in data.type_args.iter() { self.check_def_type(it, args)?; } } TypeExpr::Fun(fun) => { for it in fun.args.iter() { self.check_def_type(it, args)? } self.check_def_type(&fun.ret, args)? } _ => {} } Ok(()) } /// check data definition is not infinite recursive fn check_data_rec(&self) -> Result<(), TypingErr> { let mut checked = LinkedList::new(); for (_, d) in self.data.iter() { let mut visited = BTreeSet::new(); let mut inst = LinkedList::new(); inst.push_back(d.pos); if self.check_data_rec_data(d, &mut visited, &mut checked, &mut inst)? { let msg = format!("{}'s definition is infinitely recursive", d.name.id.id); return Err(TypingErr { msg, pos: d.name.id.pos, }); } checked.push_back(d.clone()); } Ok(()) } /// Ok(true) if the type is inifinite recursive /// Ok(false) if the type is not recursive or limited recursive /// /// infinite recursive data /// ```lisp /// (data Num (Succ Num)) /// ``` /// /// limited recursive date /// ```lisp /// (data (Tree t) /// (Node (Tree t) (Tree t)) /// Leaf) /// /// (data Num /// (Succ Num) /// Zero) /// ``` fn check_data_rec_data( &self, data: &DataType, visited: &mut BTreeSet, checked: &mut LinkedList, inst: &mut LinkedList, ) -> Result { if visited.contains(&data.name.id.id) { return Ok(true); } let mut ret = true; visited.insert(data.name.id.id.clone()); for mem in data.members.iter() { inst.push_back(mem.pos); let result = self.check_data_rec_mem(mem, visited, checked, inst)?; ret = result && ret; inst.pop_back(); } Ok(ret) } fn check_data_rec_mem( &self, mem: &DataTypeMem, visited: &mut BTreeSet, checked: &mut LinkedList, inst: &mut LinkedList, ) -> Result { let mut ret = false; for ty in mem.types.iter() { if self.check_data_rec_ty(ty, visited, checked, inst)? { ret = true; } } Ok(ret) } fn check_data_rec_ty( &self, ty: &TypeExpr, visited: &mut BTreeSet, checked: &mut LinkedList, inst: &mut LinkedList, ) -> Result { match ty { TypeExpr::List(_list) => Ok(false), TypeExpr::Tuple(tuple) => { let mut ret = false; inst.push_back(tuple.pos); for it in tuple.ty.iter() { if self.check_data_rec_ty(it, visited, checked, inst)? { ret = true; } } inst.pop_back(); Ok(ret) } TypeExpr::Data(data) => { let dt = self.type_data_node2data_type(data)?; inst.push_back(data.pos); let ret = self.check_data_rec_data(&dt, visited, checked, inst); inst.pop_back(); ret } TypeExpr::Fun(_fun) => Ok(false), _ => Ok(false), } } fn type_data_node2data_type(&self, data: &TEDataNode) -> Result { let dt = match self.data.get(&data.id.id) { Some(t) => t, None => { return Err(TypingErr { msg: "no such type".to_string(), pos: data.id.pos, }); } }; if data.type_args.len() != dt.name.type_args.len() { let msg = format!( "{} takes {} type arguments but actually passed {}", data.id.id, dt.name.type_args.len(), data.type_args.len() ); return Err(TypingErr { msg, pos: data.pos }); } let mut map = BTreeMap::new(); for (k, v) in dt.name.type_args.iter().zip(data.type_args.iter()) { map.insert(k.id.clone(), v.clone()); } dt.apply(&map) } fn check_defun_type(&self) -> Result<(), TypingErr> { for (_, fun) in self.funs.iter() { self.check_def_type(&fun.fun_type, None)?; } Ok(()) } fn check_defun_type_after_infer(&mut self) -> Result<(), TypingErr> { let mut m = FunTypes::new(); for (_, fun) in self.funs.iter() { self.check_type_infer(fun, &mut m)?; } Ok(()) } /// check type inference has been correctly done? /// /// If an inferred type of defun has no type variables, /// then the types of the expression must not contain type variables. /// /// If an effect of a function is Pure, /// then the expression must not contain IO function. fn check_type_infer(&self, defun: &Defun, fun_types: &mut FunTypes) -> Result<(), TypingErr> { // check effect check_type_has_io(&defun.ty, &defun.pos, &Sbst::new(), &defun.effect)?; // if function type contains type variables, just return Ok match &defun.ty { Some(t) => { if has_tvar(t) { return Ok(()); } } None => { return Err(TypingErr { msg: "function type has not inferred yet".to_string(), pos: defun.pos, }); } } // get arguments let mut vars = VarType::new(); vars.push(); for arg in &defun.args { match &arg.ty { Some(t) => { vars.insert(arg.id.to_string(), t.clone()); } None => { return Err(TypingErr { msg: "argument type has not inferred yet".to_string(), pos: arg.pos, }); } } } self.check_expr_type( &defun.expr, fun_types, &mut vars, &Sbst::new(), &defun.effect, true, ) } fn check_expr_type( &self, expr: &LangExpr, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { match expr { LangExpr::IDExpr(e) => self.check_id_type(e, fun_types, vars, sbst, effect, chk_rec), LangExpr::IfExpr(e) => self.check_if_type(e, fun_types, vars, sbst, effect, chk_rec), LangExpr::LetExpr(e) => self.check_let_type(e, fun_types, vars, sbst, effect, chk_rec), LangExpr::MatchExpr(e) => { self.check_match_type(e, fun_types, vars, sbst, effect, chk_rec) } LangExpr::ApplyExpr(e) => { self.check_apply_type(e, fun_types, vars, sbst, effect, chk_rec) } LangExpr::ListExpr(e) => { self.check_exprs_type(e, fun_types, vars, sbst, effect, chk_rec) } LangExpr::TupleExpr(e) => { self.check_exprs_type(e, fun_types, vars, sbst, effect, chk_rec) } LangExpr::DataExpr(e) => { self.check_data_type(e, fun_types, vars, sbst, effect, chk_rec) } LangExpr::LambdaExpr(e) => self.check_lambda_type(e, fun_types, vars, sbst, chk_rec), _ => Ok(()), } } fn check_lambda_type( &self, expr: &Lambda, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, &Effect::Pure)?; vars.push(); for arg in &expr.args { vars.insert(arg.id.to_string(), arg.ty.as_ref().unwrap().clone()); } self.check_expr_type(&expr.expr, fun_types, vars, sbst, &Effect::Pure, chk_rec)?; vars.pop(); Ok(()) } fn check_data_type( &self, expr: &DataNode, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; for e in &expr.exprs { self.check_expr_type(e, fun_types, vars, sbst, effect, chk_rec)?; } Ok(()) } fn check_apply_type( &self, expr: &Apply, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; for e in &expr.exprs { self.check_expr_type(e, fun_types, vars, sbst, effect, chk_rec)?; } Ok(()) } fn check_exprs_type( &self, expr: &Exprs, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; for e in &expr.exprs { self.check_expr_type(e, fun_types, vars, sbst, effect, chk_rec)?; } Ok(()) } fn check_match_type( &self, expr: &MatchNode, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; self.check_expr_type(&expr.expr, fun_types, vars, sbst, effect, chk_rec)?; for c in &expr.cases { vars.push(); check_pat_type(&c.pattern, vars, sbst, effect)?; self.check_expr_type(&c.expr, fun_types, vars, sbst, effect, chk_rec)?; vars.pop(); } Ok(()) } fn check_id_type( &self, expr: &IDNode, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; match vars.get(&expr.id.to_string()) { Some(_) => (), None => { if self.ext_funs.get(&expr.id).is_some() { if !chk_rec { let msg = format!("{} is not defined", expr.id); return Err(TypingErr { msg, pos: expr.pos }); } } else { match self.funs.get(&expr.id) { Some(defun) => { if !chk_rec && !defun.exported { let msg = format!("{} is not defined 2", expr.id); return Err(TypingErr { msg, pos: expr.pos }); } let call_ty = expr.ty.as_ref().unwrap().apply_sbst(sbst); self.check_defun_type_recur(&call_ty, defun, fun_types, true)?; } None => { if self.built_in.contains(&expr.id) { if !chk_rec && expr.id == "call-rust" { let msg = format!("{} is not defined 3", expr.id); return Err(TypingErr { msg, pos: expr.pos }); } } else { let msg = format!("{} is not defined 4", expr.id); return Err(TypingErr { msg, pos: expr.pos }); } } } } } } Ok(()) } fn check_defun_type_recur( &self, call_ty: &Type, defun: &Defun, fun_types: &mut FunTypes, chk_rec: bool, ) -> Result<(), TypingErr> { // check only functions whose type has type variables let defun_ty = match &defun.ty { Some(t) => { if !has_tvar(t) { return Ok(()); } t } None => { return Err(TypingErr { msg: "function type has not inferred yet".to_string(), pos: defun.pos, }); } }; // already checked? let id = defun.id.id.to_string(); if fun_types.contains(&id, call_ty) { return Ok(()); } fun_types.insert(&id, call_ty.clone()); // check type with caller side let sbst = match unify(call_ty, defun_ty) { Some(s) => s, None => { let msg = format!( "mismatched type\n expected: {}\n actual: {}", call_ty, defun_ty ); return Err(TypingErr { msg, pos: defun.pos, }); } }; // check effect check_type_has_io(&defun.ty, &defun.pos, &sbst, &defun.effect)?; // get arguments let mut vars = VarType::new(); vars.push(); for arg in &defun.args { match &arg.ty { Some(t) => { vars.insert(arg.id.to_string(), t.apply_sbst(&sbst)); } None => { return Err(TypingErr { msg: "argument type has not inferred yet".to_string(), pos: arg.pos, }); } } } // check function type recursively self.check_expr_type( &defun.expr, fun_types, &mut vars, &sbst, &defun.effect, chk_rec, ) } fn check_if_type( &self, expr: &IfNode, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; self.check_expr_type(&expr.cond_expr, fun_types, vars, sbst, effect, chk_rec)?; self.check_expr_type(&expr.then_expr, fun_types, vars, sbst, effect, chk_rec)?; self.check_expr_type(&expr.else_expr, fun_types, vars, sbst, effect, chk_rec)?; Ok(()) } fn check_let_type( &self, expr: &LetNode, fun_types: &mut FunTypes, vars: &mut VarType, sbst: &Sbst, effect: &Effect, chk_rec: bool, ) -> Result<(), TypingErr> { check_type_has_no_tvars(&expr.ty, &expr.pos, sbst)?; check_type_has_io(&expr.ty, &expr.pos, sbst, effect)?; vars.push(); for def in &expr.def_vars { self.check_expr_type(&def.expr, fun_types, vars, sbst, effect, chk_rec)?; check_pat_type(&def.pattern, vars, sbst, effect)?; } self.check_expr_type(&expr.expr, fun_types, vars, sbst, effect, chk_rec)?; vars.pop(); Ok(()) } /// collect lambda expressions and /// free variables in the expressions fn get_free_var_in_lambda(&mut self) { let mut funs = BTreeSet::new(); for name in self.funs.keys() { funs.insert(name.to_string()); } for fun in self.funs.values_mut() { let mut local_vars = VarType::new(); for arg in &fun.args { local_vars.insert(arg.id.to_string(), arg.ty.clone().unwrap()); } get_free_var_expr( &mut fun.expr, &funs, &mut local_vars, &mut Vec::new(), &mut self.lambda_ident, &mut self.lambda, ); } } } fn get_tv2type_from_type_expr( expr: &TypeExpr, num_tv: &mut ID, tv2type: &mut BTreeMap, ) { match expr { TypeExpr::List(e) => { get_tv2type_from_type_expr(&e.ty, num_tv, tv2type); } TypeExpr::Tuple(e) => { for it in &e.ty { get_tv2type_from_type_expr(it, num_tv, tv2type); } } TypeExpr::Fun(e) => { for it in &e.args { get_tv2type_from_type_expr(it, num_tv, tv2type); } get_tv2type_from_type_expr(&e.ret, num_tv, tv2type); } TypeExpr::Data(e) => { for it in &e.type_args { get_tv2type_from_type_expr(it, num_tv, tv2type); } } TypeExpr::Id(e) => { tv2type.insert(e.id.clone(), ty_var(*num_tv)); *num_tv += 1; } _ => (), } } /// If /// ```lisp /// (data (Tree t) /// (Node (Tree t) (Tree t)) /// Leaf) /// ``` /// and tv2type = {t: Int} then /// apply_tv2type_to_type_expr((Tree t), tv2type) returns (Tree Int) fn apply_tv2type_to_type_expr( type_expr: &TypeExpr, tv2type: &BTreeMap, ) -> Result { match type_expr { TypeExpr::Char(_) => Ok(ty_char()), TypeExpr::String(_) => Ok(ty_string()), TypeExpr::Bool(_) => Ok(ty_bool()), TypeExpr::Int(_) => Ok(ty_int()), TypeExpr::List(list) => { let t = apply_tv2type_to_type_expr(&list.ty, tv2type)?; Ok(ty_list(t)) } TypeExpr::Tuple(tuple) => { let mut v = Vec::new(); for t in &tuple.ty { v.push(apply_tv2type_to_type_expr(t, tv2type)?); } Ok(ty_tuple(v)) } TypeExpr::Fun(fun) => { let mut args = Vec::new(); for a in &fun.args { args.push(apply_tv2type_to_type_expr(a, tv2type)?); } let r = apply_tv2type_to_type_expr(&fun.ret, tv2type)?; Ok(ty_fun(&fun.effect, args, r)) } TypeExpr::Data(data) => { let mut v = Vec::new(); for t in &data.type_args { v.push(apply_tv2type_to_type_expr(t, tv2type)?); } Ok(Type::TCon(Tycon { id: data.id.id.to_string(), args: if v.is_empty() { None } else { Some(v) }, })) } TypeExpr::Id(id) => match tv2type.get(&id.id) { Some(t) => Ok(t.clone()), None => { let msg = format!("type variable {} is undefined", id.id); Err(msg) } }, } } fn check_pat_type( expr: &Pattern, vars: &mut VarType, sbst: &Sbst, effect: &Effect, ) -> Result<(), TypingErr> { match expr { Pattern::PatID(e) => { check_type_has_no_tvars(&e.ty, &e.pos, sbst)?; check_type_has_io(&e.ty, &e.pos, sbst, effect)?; vars.insert(e.id.to_string(), e.ty.as_ref().unwrap().clone()); Ok(()) } Pattern::PatTuple(e) => { check_type_has_no_tvars(&e.ty, &e.pos, sbst)?; check_type_has_io(&e.ty, &e.pos, sbst, effect)?; for it in &e.pattern { check_pat_type(it, vars, sbst, effect)?; } Ok(()) } Pattern::PatData(e) => { check_type_has_no_tvars(&e.ty, &e.pos, sbst)?; check_type_has_io(&e.ty, &e.pos, sbst, effect)?; for it in &e.pattern { check_pat_type(it, vars, sbst, effect)?; } Ok(()) } _ => Ok(()), } } fn get_free_var_expr( expr: &mut LangExpr, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { match expr { LangExpr::IfExpr(e) => get_free_var_if(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::LetExpr(e) => get_free_var_let(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::IDExpr(e) => get_free_var_id(e, funs, local_vars, ext_vars), LangExpr::DataExpr(e) => get_free_var_data(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::MatchExpr(e) => get_free_var_match(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::ApplyExpr(e) => get_free_var_apply(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::ListExpr(e) => get_free_var_exprs(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::TupleExpr(e) => get_free_var_exprs(e, funs, local_vars, ext_vars, ident, lambda), LangExpr::LambdaExpr(e) => { get_free_var_lambda(e, funs, local_vars, ext_vars, ident, lambda) } _ => {} } } fn get_free_var_apply( exprs: &mut Apply, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { for e in &mut exprs.exprs { get_free_var_expr(e, funs, local_vars, ext_vars, ident, lambda); } } fn get_free_var_exprs( exprs: &mut Exprs, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { for e in &mut exprs.exprs { get_free_var_expr(e, funs, local_vars, ext_vars, ident, lambda); } } fn get_free_var_match( expr: &mut MatchNode, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { get_free_var_expr(&mut expr.expr, funs, local_vars, ext_vars, ident, lambda); for c in &mut expr.cases { local_vars.push(); get_free_var_pattern(&c.pattern, local_vars); get_free_var_expr(&mut c.expr, funs, local_vars, ext_vars, ident, lambda); local_vars.pop(); } } fn get_free_var_data( expr: &mut DataNode, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { for e in &mut expr.exprs { get_free_var_expr(e, funs, local_vars, ext_vars, ident, lambda); } } fn get_free_var_id( expr: &mut IDNode, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ) { let key = expr.id.to_string(); match local_vars.get(&key) { Some(_) => (), None => { if !funs.contains(&key) { ext_vars.push(expr.id.to_string()); } } } } fn get_free_var_let( expr: &mut LetNode, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { local_vars.push(); for dv in &mut expr.def_vars { get_free_var_expr(&mut dv.expr, funs, local_vars, ext_vars, ident, lambda); get_free_var_pattern(&dv.pattern, local_vars); } get_free_var_expr(&mut expr.expr, funs, local_vars, ext_vars, ident, lambda); local_vars.pop(); } fn get_free_var_if( expr: &mut IfNode, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { get_free_var_expr( &mut expr.cond_expr, funs, local_vars, ext_vars, ident, lambda, ); get_free_var_expr( &mut expr.then_expr, funs, local_vars, ext_vars, ident, lambda, ); get_free_var_expr( &mut expr.else_expr, funs, local_vars, ext_vars, ident, lambda, ); } fn get_free_var_lambda( expr: &mut Lambda, funs: &BTreeSet, local_vars: &mut VarType, ext_vars: &mut Vec, ident: &mut u64, lambda: &mut BTreeMap, ) { { let mut local_vars = VarType::new(); for arg in &expr.args { local_vars.insert(arg.id.to_string(), arg.ty.clone().unwrap()); } let mut ext_vars = Vec::new(); get_free_var_expr( &mut expr.expr, funs, &mut local_vars, &mut ext_vars, ident, lambda, ); expr.vars = ext_vars; } // if // (lambda (x) (lambda (y) z)) // then // (lambda (x) ...) contains a free variable "z" for var in &expr.vars { match local_vars.get(var) { Some(_) => (), None => { ext_vars.push(var.to_string()); } } } expr.ident = *ident; lambda.insert(*ident, expr.clone()); *ident += 1; } fn get_free_var_pattern(pat: &Pattern, local_vars: &mut VarType) { match pat { Pattern::PatID(id) => { if id.id != "_" { local_vars.insert(id.id.to_string(), id.ty.clone().unwrap()); } } Pattern::PatTuple(tuple) => { for it in &tuple.pattern { get_free_var_pattern(it, local_vars); } } Pattern::PatData(data) => { for it in &data.pattern { get_free_var_pattern(it, local_vars); } } Pattern::PatNum(_) | Pattern::PatBool(_) | Pattern::PatNil(_) | Pattern::PatStr(_) | Pattern::PatChar(_) => (), } } fn check_type_has_no_tvars(ty: &Option, pos: &Pos, sbst: &Sbst) -> Result<(), TypingErr> { match ty { Some(t) => { if has_tvar(&t.apply_sbst(sbst)) { let msg = format!("inferred type still contains type variables\n type: {}", t); return Err(TypingErr { msg, pos: *pos }); } } None => { return Err(TypingErr { msg: "type has not inferred yet".to_string(), pos: *pos, }); } } Ok(()) } fn check_type_has_io( ty: &Option, pos: &Pos, sbst: &Sbst, effect: &Effect, ) -> Result<(), TypingErr> { match ty { Some(t) => { if let Effect::Pure = effect { if has_io(&t.apply_sbst(sbst)) { let msg = format!("Pure function contains an IO function\n type: {}", t); return Err(TypingErr { msg, pos: *pos }); } } } None => { return Err(TypingErr { msg: "type has not inferred yet".to_string(), pos: *pos, }); } } Ok(()) } /// Does type contain IO? fn has_io(ty: &Type) -> bool { match ty { Type::TCon(t) => { if t.id == "IO" { return true; } if let Some(args) = &t.args { for arg in args { if has_io(arg) { return true; } } } false } Type::TVar(_) => false, } } /// Does type contain type variables? fn has_tvar(ty: &Type) -> bool { match ty { Type::TCon(t) => { if let Some(args) = &t.args { for arg in args { if has_tvar(arg) { return true; } } } false } Type::TVar(_) => true, } } pub(crate) fn typing_expr( expr: &parser::Expr, ctx: &Context, ) -> Result<(LangExpr, BTreeMap), TypingErr> { let mut expr = expr2typed_expr(expr)?; let mut num_tv = 0; let (_, sbst) = ctx.typing_expr(&mut expr, Sbst::new(), &mut VarType::new(), &mut num_tv)?; expr.apply_sbst(&sbst); // check call only exported functions ctx.check_expr_type( &expr, &mut FunTypes::new(), &mut VarType::new(), &Sbst::new(), &Effect::IO, false, )?; exhaustive_expr(&expr, ctx)?; // capture free variables // TODO: should be cached let mut funs = BTreeSet::new(); for name in ctx.funs.keys() { funs.insert(name.to_string()); } let mut ident = ctx.lambda_ident; let mut lambda = BTreeMap::new(); get_free_var_expr( &mut expr, &funs, &mut VarType::new(), &mut Vec::new(), &mut ident, &mut lambda, ); for (_, v) in lambda.iter_mut() { tail_call(&mut v.expr); } Ok((expr, lambda)) } pub fn exprs2context(typing_context: TypingContext) -> Result { let mut funs = BTreeMap::new(); let mut ext_funs = BTreeMap::new(); let mut ext_ffi = BTreeMap::new(); let mut data = BTreeMap::new(); let msg = "top expression must be data, defun, or export"; for e in typing_context.exprs.iter() { match e { parser::Expr::Apply(es, _) => { let mut iter = es.iter(); match iter.next() { Some(parser::Expr::ID(id, _)) => { if id == "defun" || id == "export" { let f = expr2defun(e)?; if ext_funs.contains_key(&f.id.id) { let msg = format!("{} is multiply defined", f.id.id); return Err(TypingErr { msg, pos: f.id.pos }); } if let btree_map::Entry::Vacant(entry) = funs.entry(f.id.id.to_string()) { entry.insert(f); } else { let msg = format!("{} is multiply defined", f.id.id); return Err(TypingErr { msg, pos: f.id.pos }); } } else if id == "extern" { let f = expr2extern(e)?; if funs.contains_key(&f.id.id) { let msg = format!("{} is multiply defined", f.id.id); return Err(TypingErr { msg, pos: f.id.pos }); } if let btree_map::Entry::Vacant(entry) = ext_funs.entry(f.id.id.to_string()) { entry.insert(f); } else { let msg = format!("{} is multiply defined", f.id.id); return Err(TypingErr { msg, pos: f.id.pos }); } } else if id == "data" { let d = expr2data(e)?; if data.contains_key(&d.name.id.id) { let msg = format!("data type {} is multiply defined", d.name.id.id); return Err(TypingErr { msg, pos: d.name.pos, }); } data.insert(d.name.id.id.clone(), d); } else if id == "macro" { // Do nothing. } else { return Err(TypingErr::new(msg, e)); } } _ => { return Err(TypingErr::new(msg, e)); } } } _ => { return Err(TypingErr::new(msg, e)); } } } for ffi in typing_context.ext_funs.iter() { ext_ffi.insert(ffi.name(), ffi.ffi()); } let mut ctx = Context::new(funs, ext_funs, ext_ffi, data, typing_context.macros); ctx.typing()?; Ok(ctx) } /// $DATA := ( data $DATA_NAME $MEMBER+ ) fn expr2data(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, pos) => { let mut iter = exprs.iter(); iter.next(); // must be "data" // $DATA_NAME let data_name = match iter.next() { Some(e) => expr2data_name(e)?, _ => return Err(TypingErr::new("require data name", expr)), }; // $MEMBER+ let mut mems = Vec::new(); for mem in iter { let data_mem = expr2data_mem(mem)?; mems.push(data_mem); } Ok(DataType { name: data_name, members: mems, pos: *pos, }) } _ => Err(TypingErr::new("syntax error on data definition", expr)), } } /// $DATA_NAME := $TID | ( $TID $ID* ) fn expr2data_name(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(_, pos) => { let tid = expr2type_id(expr)?; Ok(DataTypeName { id: tid, type_args: Vec::new(), pos: *pos, }) } parser::Expr::Apply(exprs, pos) => { let mut args = Vec::new(); let mut iter = exprs.iter(); let tid; match iter.next() { Some(e) => { tid = expr2type_id(e)?; } _ => { return Err(TypingErr::new( "must type identifier (with type arguments)", expr, )) } } for it in iter { let id = expr2id(it)?; args.push(id); } Ok(DataTypeName { id: tid, type_args: args, pos: *pos, }) } _ => Err(TypingErr::new( "must type identifier (with type arguments)", expr, )), } } fn expr2type_id(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(id, pos) => match id.chars().next() { Some(c) => { if c.is_ascii_uppercase() { Ok(TIDNode { id: id.to_string(), pos: *pos, }) } else { Err(TypingErr::new("the first character must be captal", expr)) } } _ => Err(TypingErr::new("error", expr)), }, _ => Err(TypingErr::new("must be type identifier", expr)), } } fn expr2id(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(id, pos) => match id.chars().next() { Some(c) => { if c.is_ascii_uppercase() { Err(TypingErr::new( "the first character must not be captal", expr, )) } else { Ok(IDNode { id: id.to_string(), pos: *pos, ty: None, }) } } _ => Err(TypingErr::new("error", expr)), }, _ => Err(TypingErr::new("must be identifier", expr)), } } /// $MEMBER := $TID | ( $TID $TYPE* ) fn expr2data_mem(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(_, pos) => { // $TID let tid = expr2type_id(expr)?; Ok(DataTypeMem { id: tid, types: Vec::new(), pos: *pos, }) } parser::Expr::Apply(exprs, pos) => { // ( $TID $TYPE* ) let mut iter = exprs.iter(); let tid = match iter.next() { Some(e) => expr2type_id(e)?, _ => return Err(TypingErr::new("must type identifier", expr)), }; let mut types = Vec::new(); for it in iter { let pt = expr2type(it)?; types.push(pt); } Ok(DataTypeMem { id: tid, types, pos: *pos, }) } _ => Err(TypingErr::new("must be type identifier (with types)", expr)), } } /// Convert `parser::Expr`, which is untyped to `Extern`, which is typed. /// /// $EXTERN := ( extern $ID $TYPE_ARROW ) fn expr2extern(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, _pos) => { let mut iter = exprs.iter(); // extern match iter.next() { Some(parser::Expr::ID(id, _)) => { if id != "extern" { return Err(TypingErr::new("require extern", expr)); } } _ => { return Err(TypingErr::new("require extern", expr)); } } // $ID let id = match iter.next() { Some(e) => expr2id(e)?, _ => { return Err(TypingErr::new("require function name", expr)); } }; // $TYPE_ARROW let pos_ty; let (args, ret) = match iter.next() { Some(e) => { pos_ty = e.get_pos(); expr2type_arrow(e)? } _ => { return Err(TypingErr::new("require function type", expr)); } }; Ok(Extern { id, fun_type: TypeExpr::Fun(TEFunNode { effect: Effect::IO, args, ret: Box::new(ret), pos: pos_ty, }), ty: None, }) } _ => Err(TypingErr::new("syntax error on extern", expr)), } } /// Convert `parser::Expr`, which is untyped to `Defun`, which is typed. /// /// $DEFUN := ( $HEAD_DEFUN $ID ( $ID* ) $TYPE_FUN $EXPR ) fn expr2defun(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, pos) => { let mut iter = exprs.iter(); // $HEAD_DEFUN := export | defun let exported = match iter.next() { Some(parser::Expr::ID(id, _)) => id == "export", _ => { return Err(TypingErr::new("require defun or export", expr)); } }; // $ID let id = match iter.next() { Some(e) => expr2id(e)?, _ => { return Err(TypingErr::new("require function name", expr)); } }; // ( $ID* ) let mut args = Vec::new(); match iter.next() { Some(parser::Expr::Apply(exprs, _)) => { for it in exprs.iter() { let arg = expr2id(it)?; args.push(arg); } } _ => { return Err(TypingErr::new("require arguments", expr)); } } // $TYPE_FUN let fun = match iter.next() { Some(e) => expr2type_fun(e)?, _ => { return Err(TypingErr::new("require function type", expr)); } }; // $EXPR let body = match iter.next() { Some(e) => expr2typed_expr(e)?, _ => { return Err(TypingErr::new("require expression", expr)); } }; let effect = match &fun { TypeExpr::Fun(e) => e.effect.clone(), _ => { panic!("failed to get effect"); } }; Ok(Defun { exported, id, args, fun_type: fun, effect, expr: body, pos: *pos, ty: None, }) } _ => Err(TypingErr::new("syntax error on function definition", expr)), } } /// $TYPE_ARROW = ( -> $TYPES $TYPE ) fn expr2type_arrow(expr: &parser::Expr) -> Result<(Vec, TypeExpr), TypingErr> { let args; let ret; match expr { parser::Expr::Apply(exprs2, _) => { let mut iter = exprs2.iter(); let e2 = iter.next(); match e2 { Some(parser::Expr::ID(arr, _)) => { if arr != "->" { return Err(TypingErr::new("must be \"->\"", e2.unwrap())); } } _ => { return Err(TypingErr::new("require \"->\"", expr)); } } // $TYPES match iter.next() { Some(t) => { args = expr2types(t)?; } _ => { return Err(TypingErr::new("require types for arguments", expr)); } } // $TYPE match iter.next() { Some(t) => { ret = expr2type(t)?; } _ => { return Err(TypingErr::new("require type for return value", expr)); } } } _ => { return Err(TypingErr::new("require function type", expr)); } } Ok((args, ret)) } /// $TYPE_FUN := ( $EFFECT $TYPE_ARROW ) fn expr2type_fun(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, _pos) => { let mut iter = exprs.iter(); // $EFFECT := Pure | IO let effect; let e = iter.next(); match e { Some(parser::Expr::ID(eff, _)) => { if eff == "IO" { effect = Effect::IO; } else if eff == "Pure" { effect = Effect::Pure; } else { return Err(TypingErr::new( "effect must be \"Pure\" or \"IO\"", e.unwrap(), )); } } _ => { return Err(TypingErr::new("invalid effect", expr)); } } // $TYPE_ARROW if let Some(e1) = iter.next() { let (args, ret) = expr2type_arrow(e1)?; Ok(TypeExpr::Fun(TEFunNode { effect, args, ret: Box::new(ret), pos: e1.get_pos(), })) } else { Err(TypingErr::new("require a function type", expr)) } } _ => Err(TypingErr::new("must be function type", expr)), } } /// $TYPES := ( $TYPE* ) fn expr2types(expr: &parser::Expr) -> Result, TypingErr> { match expr { parser::Expr::Apply(types, _) => { // ( $TYPES* ) Ok(list_types2vec_types(types)?) } _ => Err(TypingErr::new("require types of arguments", expr)), } } /// $TYPE := Int | Bool | String | Char | $TYPE_LIST | $TYPE_TUPLE | $TYPE_FUN | $TYPE_DATA | $ID fn expr2type(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(id, pos) => { // Int | Bool | String | $TID match id.as_ref() { "Int" => Ok(TypeExpr::Int(TEIntNode)), "Bool" => Ok(TypeExpr::Bool(TEBoolNode)), "String" => Ok(TypeExpr::String(TEStringNode)), "Char" => Ok(TypeExpr::Char(TECharNode)), _ => { let c = id.chars().next().unwrap(); if c.is_ascii_uppercase() { let tid = expr2type_id(expr)?; Ok(TypeExpr::Data(TEDataNode { id: tid, type_args: Vec::new(), pos: *pos, })) } else { Ok(TypeExpr::Id(expr2id(expr)?)) } } } } parser::Expr::List(list, _) => { // $TYPE_LIST := '( $TYPE ) if list.len() != 1 { return Err(TypingErr::new( "require exactly one type as a type argument for list type", expr, )); } match list.iter().next() { Some(e) => { let ty = Box::new(expr2type(e)?); Ok(TypeExpr::List(TEListNode { ty, pos: e.get_pos(), })) } _ => Err(TypingErr::new("require type", expr)), } } parser::Expr::Tuple(tuple, pos) => { // $TYPE_TUPLE := [ $TYPE* ] let mut types = Vec::new(); for it in tuple { types.push(expr2type(it)?); } Ok(TypeExpr::Tuple(TETupleNode { ty: types, pos: *pos, })) } parser::Expr::Apply(exprs, pos) => { // ( $TID $TYPE* ) let mut iter = exprs.iter(); // $TID let e = iter.next(); let tid = match e { Some(parser::Expr::ID(id, _)) => { // $TYPE_FUN if id == "Pure" || id == "IO" { let ty = expr2type_fun(expr)?; return Ok(ty); } expr2type_id(e.unwrap())? } _ => { return Err(TypingErr::new("require type", expr)); } }; // $TYPE* let mut args = Vec::new(); for it in iter { args.push(expr2type(it)?); } Ok(TypeExpr::Data(TEDataNode { id: tid, type_args: args, pos: *pos, })) } _ => Err(TypingErr::new("must be type", expr)), } } fn list_types2vec_types(exprs: &LinkedList) -> Result, TypingErr> { let mut v = Vec::new(); for e in exprs { v.push(expr2type(e)?); } Ok(v) } /// Convert `parser::Expr`, which is untyped to `LangExpr`, which is typed. /// /// $EXPR := $LITERAL | $ID | $TID | $LET | $IF | $LAMBDA | $MATCH | $LIST | $TUPLE | $GENDATA | $APPLY fn expr2typed_expr(expr: &parser::Expr) -> Result { match expr { parser::Expr::Char(c, pos) => Ok(LangExpr::LitChar(CharNode { c: *c, pos: *pos, ty: Some(ty_string()), })), parser::Expr::Str(str, pos) => Ok(LangExpr::LitStr(StrNode { str: str.clone(), pos: *pos, ty: Some(ty_string()), })), parser::Expr::Num(num, pos) => Ok(LangExpr::LitNum(NumNode { num: num.clone(), pos: *pos, ty: Some(ty_int()), })), parser::Expr::Bool(val, pos) => Ok(LangExpr::LitBool(BoolNode { val: *val, pos: *pos, ty: Some(ty_bool()), })), parser::Expr::ID(id, pos) => { let c = id.chars().next().unwrap(); if c.is_ascii_uppercase() { // $TID let tid = expr2type_id(expr)?; Ok(LangExpr::DataExpr(DataNode { label: tid, exprs: Vec::new(), pos: *pos, ty: None, })) } else { Ok(LangExpr::IDExpr(IDNode { id: id.to_string(), pos: *pos, ty: None, })) } } parser::Expr::List(list, pos) => { let mut elms = Vec::new(); for it in list { elms.push(expr2typed_expr(it)?); } Ok(LangExpr::ListExpr(Exprs { exprs: elms, pos: *pos, ty: None, })) } parser::Expr::Tuple(tuple, pos) => { let mut elms = Vec::new(); for it in tuple { elms.push(expr2typed_expr(it)?); } Ok(LangExpr::TupleExpr(Exprs { exprs: elms, pos: *pos, ty: None, })) } parser::Expr::Apply(exprs, pos) => { if exprs.is_empty() { return Err(TypingErr::new("empty expression", expr)); } let mut iter = exprs.iter(); match iter.next() { Some(parser::Expr::ID(id, _)) => { let c = id.chars().next().unwrap(); if c.is_ascii_uppercase() { // $TID return expr2data_expr(expr); } else if id == "if" { return expr2if(expr); } else if id == "let" { return expr2let(expr); } else if id == "match" { return expr2match(expr); } else if id == "lambda" { return expr2lambda(expr); } } Some(_) => (), None => { return Err(TypingErr::new("require function application", expr)); } } let mut elms = Vec::new(); for it in exprs { elms.push(expr2typed_expr(it)?); } Ok(LangExpr::ApplyExpr(Apply { exprs: elms, pos: *pos, is_tail: false, ty: None, })) } } } /// $GENDATA := ( $TID $EXPR* ) fn expr2data_expr(expr: &parser::Expr) -> Result { let exprs = match expr { parser::Expr::Apply(e, _) => e, _ => { return Err(TypingErr::new("not data expression", expr)); } }; let mut iter = exprs.iter(); let tid = expr2type_id(iter.next().unwrap())?; let mut v = Vec::new(); for e in iter { v.push(expr2typed_expr(e)?); } Ok(LangExpr::DataExpr(DataNode { label: tid, exprs: v, pos: expr.get_pos(), ty: None, })) } /// $IF := ( if $EXPR $EXPR $EXPR ) fn expr2if(expr: &parser::Expr) -> Result { let exprs = match expr { parser::Expr::Apply(e, _) => e, _ => { return Err(TypingErr::new("not if expression", expr)); } }; let mut iter = exprs.iter(); iter.next(); // must be "if" let f = |next, msg| match next { Some(e) => expr2typed_expr(e), _ => Err(TypingErr::new(msg, expr)), }; let cond = f(iter.next(), "if requires condition")?; let then = f(iter.next(), "if requires then expression")?; let else_expr = f(iter.next(), "if requires else expression")?; Ok(LangExpr::IfExpr(Box::new(IfNode { cond_expr: cond, then_expr: then, else_expr, pos: expr.get_pos(), ty: None, }))) } /// $LET := ( let ( $DEFVAR+ ) $EXPR ) fn expr2let(expr: &parser::Expr) -> Result { let exprs = match expr { parser::Expr::Apply(e, _) => e, _ => { return Err(TypingErr::new("not apply expression", expr)); } }; let mut iter = exprs.iter(); iter.next(); // must be "let" // ( $DEFVAR+ ) let mut def_vars = Vec::new(); let e = iter.next(); match e { Some(parser::Expr::Apply(dvs, _)) => { if dvs.is_empty() { return Err(TypingErr::new("require variable binding", e.unwrap())); } for it in dvs.iter() { def_vars.push(expr2def_vars(it)?); } } _ => { return Err(TypingErr::new("require variable binding", expr)); } } // $EXPR let e = iter.next(); let body = match e { Some(body_expr) => expr2typed_expr(body_expr)?, _ => { return Err(TypingErr::new("require body", expr)); } }; Ok(LangExpr::LetExpr(Box::new(LetNode { def_vars, expr: body, pos: expr.get_pos(), ty: None, }))) } /// $LETPAT := $ID | [ $LETPAT+ ] | ($TID $LETPAT+ ) fn expr2letpat(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(id, pos) => { // $ID let c = id.chars().next().unwrap(); if c.is_ascii_uppercase() { Err(TypingErr::new("invalid pattern", expr)) } else { Ok(Pattern::PatID(IDNode { id: id.to_string(), pos: *pos, ty: None, })) } } parser::Expr::Tuple(tuple, pos) => { // [ $LETPAT+ ] if tuple.is_empty() { return Err(TypingErr::new("require at least one pattern", expr)); } let mut pattern = Vec::new(); for it in tuple { pattern.push(expr2letpat(it)?); } Ok(Pattern::PatTuple(PatTupleNode { pattern, pos: *pos, ty: None, })) } parser::Expr::Apply(exprs, pos) => { // ($TID $LETPAT+ ) if exprs.len() < 2 { return Err(TypingErr::new( "require label and at least one pattern", expr, )); } let mut iter = exprs.iter(); let tid = expr2type_id(iter.next().unwrap())?; let mut v = Vec::new(); for it in iter { v.push(expr2letpat(it)?); } Ok(Pattern::PatData(PatDataNode { label: tid, pattern: v, pos: *pos, ty: None, })) } _ => Err(TypingErr::new("invalid pattern", expr)), } } /// $DEFVAR := ( $LETPAT $EXPR ) fn expr2def_vars(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, pos) => { if exprs.len() != 2 { return Err(TypingErr::new("invalid variable definition", expr)); } let mut iter = exprs.iter(); let pattern = expr2letpat(iter.next().unwrap())?; // $LETPAT let body = expr2typed_expr(iter.next().unwrap())?; // $EXPR Ok(DefVar { pattern, expr: body, pos: *pos, ty: None, }) } _ => Err(TypingErr::new("must be variable definition(s)", expr)), } } /// $PATTERN := $LITERAL | $ID | $TID | [ $PATTERN+ ] | ( $TID $PATTERN* ) | '() fn expr2mpat(expr: &parser::Expr) -> Result { match expr { parser::Expr::ID(id, pos) => { let c = id.chars().next().unwrap(); if c.is_ascii_uppercase() { // $TID let tid = expr2type_id(expr)?; Ok(Pattern::PatData(PatDataNode { label: tid, pattern: Vec::new(), pos: *pos, ty: None, })) } else { // $ID let id_node = expr2id(expr)?; Ok(Pattern::PatID(id_node)) } } parser::Expr::Char(c, pos) => { // $LITERAL Ok(Pattern::PatChar(CharNode { c: *c, pos: *pos, ty: Some(ty_string()), })) } parser::Expr::Str(str, pos) => { // $LITERAL Ok(Pattern::PatStr(StrNode { str: str.clone(), pos: *pos, ty: Some(ty_string()), })) } parser::Expr::Bool(val, pos) => { // $LITERAL Ok(Pattern::PatBool(BoolNode { val: *val, pos: *pos, ty: Some(ty_bool()), })) } parser::Expr::Num(num, pos) => { // $LITERAL Ok(Pattern::PatNum(NumNode { num: num.clone(), pos: *pos, ty: Some(ty_int()), })) } parser::Expr::Tuple(exprs, pos) => { // [ $PATTERN+ ] let mut pattern = Vec::new(); for it in exprs { pattern.push(expr2mpat(it)?); } Ok(Pattern::PatTuple(PatTupleNode { pattern, pos: *pos, ty: None, })) } parser::Expr::Apply(exprs, pos) => { // ( $TID $PATTERN* ) let mut iter = exprs.iter(); let first = iter.next(); let tid = match first { Some(e) => expr2type_id(e)?, _ => { return Err(TypingErr::new("invalid pattern", expr)); } }; let mut pattern = Vec::new(); for it in iter { pattern.push(expr2mpat(it)?); } Ok(Pattern::PatData(PatDataNode { label: tid, pattern, pos: *pos, ty: None, })) } parser::Expr::List(list, pos) => { if !list.is_empty() { return Err(TypingErr::new("list pattern is not supported", expr)); } Ok(Pattern::PatNil(PatNilNode { pos: *pos, ty: None, })) } } } /// $CASE := ( $PATTERN $EXPR ) fn expr2case(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, pos) => { if exprs.len() != 2 { return Err(TypingErr::new("case require exactly 2 expressions", expr)); } let mut iter = exprs.iter(); let pattern = expr2mpat(iter.next().unwrap())?; let body = expr2typed_expr(iter.next().unwrap())?; Ok(MatchCase { pattern, expr: body, pos: *pos, ty: None, }) } _ => Err(TypingErr::new("invalid case", expr)), } } /// $MATCH := ( match $EXPR $CASE+ ) fn expr2match(expr: &parser::Expr) -> Result { match expr { parser::Expr::Apply(exprs, pos) => { let mut iter = exprs.iter(); iter.next(); // must be "match" let cond = match iter.next() { Some(e) => expr2typed_expr(e)?, _ => { return Err(TypingErr::new("no condition", expr)); } }; let mut cases = Vec::new(); for it in iter { cases.push(expr2case(it)?); } if cases.is_empty() { return Err(TypingErr::new("require at least one case", expr)); } let node = MatchNode { expr: cond, cases, pos: *pos, ty: None, }; Ok(LangExpr::MatchExpr(Box::new(node))) } _ => Err(TypingErr::new("invalid match", expr)), } } /// $LAMBDA := (lambda ($ID*) $EXPR) fn expr2lambda(expr: &parser::Expr) -> Result { let exprs; let pos; match expr { parser::Expr::Apply(e, p) => { exprs = e; pos = p; } _ => { return Err(TypingErr::new("not lambda expression", expr)); } } let mut iter = exprs.iter(); iter.next(); // must be "lambda" // get arguments let args = match iter.next() { Some(parser::Expr::Apply(e, _)) => e, _ => { return Err(TypingErr::new("require arguments", expr)); } }; let mut v = Vec::new(); for a in args { v.push(expr2id(a)?); } // get expression let body = match iter.next() { Some(e) => expr2typed_expr(e)?, _ => { return Err(TypingErr::new("require arguments", expr)); } }; Ok(LangExpr::LambdaExpr(Box::new(Lambda { args: v, expr: body, pos: *pos, vars: Vec::new(), ident: 0, ty: None, }))) } impl Type { fn has_tvar(&self, id: ID) -> bool { match self { Type::TVar(n) => id == *n, Type::TCon(tc) => tc.has_tvar(id), } } fn apply_sbst(&self, sbst: &Sbst) -> Type { match self { Type::TVar(n) => match sbst.get(n) { Some(t) => t.clone(), None => self.clone(), }, Type::TCon(tc) => tc.apply_sbst(sbst), } } } impl Tycon { fn has_tvar(&self, id: ID) -> bool { if let Some(args) = &self.args { for t in args { if t.has_tvar(id) { return true; } } } false } fn apply_sbst(&self, sbst: &Sbst) -> Type { let mut v = Vec::new(); if let Some(args) = &self.args { for t in args { v.push(t.apply_sbst(sbst)); } } Type::TCon(Tycon { id: self.id.clone(), args: if v.is_empty() { None } else { Some(v) }, }) } } fn unify(lhs: &Type, rhs: &Type) -> Option { let mut sbst = Sbst::new(); match (lhs, rhs) { (Type::TVar(id1), Type::TVar(id2)) => { if id1 != id2 { sbst.insert(*id1, rhs.clone()); } Some(sbst) } (Type::TVar(id), _) => { if rhs.has_tvar(*id) { return None; } sbst.insert(*id, rhs.clone()); Some(sbst) } (_, Type::TVar(id)) => { if lhs.has_tvar(*id) { return None; } sbst.insert(*id, lhs.clone()); Some(sbst) } (Type::TCon(ty_lhs), Type::TCon(ty_rhs)) => { if ty_lhs.id != ty_rhs.id { return None; } match (&ty_lhs.args, &ty_rhs.args) { (None, Some(_)) => None, (Some(_), None) => None, (None, None) => Some(sbst), (Some(args1), Some(args2)) => { if args1.len() != args2.len() { return None; } for (t1, t2) in args1.iter().zip(args2.iter()) { let s = unify(&t1.apply_sbst(&sbst), &t2.apply_sbst(&sbst))?; sbst = compose(&s, &sbst); } Some(sbst) } } } } } /// - S: substitution /// - x: type variable /// - T: type /// /// S := x : T, S /// /// S1・S2 /// compose(S1, S2) = { /// x : T.apply_sbst(S1) if x : T in S2 /// x : T if x : T in S1 and x not in domain(S2) /// } fn compose(s1: &Sbst, s2: &Sbst) -> Sbst { let mut sbst = Sbst::new(); for (x, t) in s2.iter() { sbst.insert(*x, t.apply_sbst(s1)); } for (x, t) in s1.iter() { sbst.entry(*x).or_insert_with(|| t.clone()); } sbst } /// find tail call fn tail_call(expr: &mut LangExpr) { let l = tail_call_expr(expr); for e in l { if let LangExpr::ApplyExpr(app) = e { app.is_tail = true } } } fn tail_call_expr(expr: &mut LangExpr) -> LinkedList<&mut LangExpr> { match expr { LangExpr::ApplyExpr(_) => { let mut l = LinkedList::new(); l.push_back(expr); l } LangExpr::IfExpr(e) => { let mut l = tail_call_expr(&mut e.then_expr); l.append(&mut tail_call_expr(&mut e.else_expr)); l } LangExpr::MatchExpr(e) => { let mut l = LinkedList::new(); for c in e.cases.iter_mut() { l.append(&mut tail_call_expr(&mut c.expr)); } l } LangExpr::LetExpr(e) => tail_call_expr(&mut e.expr), LangExpr::LambdaExpr(e) => { tail_call(&mut e.expr); LinkedList::new() } _ => LinkedList::new(), } } fn exhaustive_expr(expr: &LangExpr, ctx: &Context) -> Result<(), TypingErr> { match expr { LangExpr::MatchExpr(e) => exhaustive_match(e, ctx), LangExpr::IfExpr(e) => exhaustive_if(e, ctx), LangExpr::LetExpr(e) => exhaustive_let(e, ctx), LangExpr::LambdaExpr(e) => exhaustive_expr(&e.expr, ctx), LangExpr::DataExpr(e) => exhaustive_exprs(&e.exprs, ctx), LangExpr::ApplyExpr(e) => exhaustive_exprs(&e.exprs, ctx), LangExpr::ListExpr(e) => exhaustive_exprs(&e.exprs, ctx), LangExpr::TupleExpr(e) => exhaustive_exprs(&e.exprs, ctx), _ => Ok(()), } } fn exhaustive_exprs(exprs: &[LangExpr], ctx: &Context) -> Result<(), TypingErr> { for e in exprs { exhaustive_expr(e, ctx)?; } Ok(()) } fn exhaustive_let(expr: &LetNode, ctx: &Context) -> Result<(), TypingErr> { for dv in &expr.def_vars { exhaustive_expr(&dv.expr, ctx)?; } exhaustive_expr(&expr.expr, ctx)?; Ok(()) } fn exhaustive_if(expr: &IfNode, ctx: &Context) -> Result<(), TypingErr> { exhaustive_expr(&expr.cond_expr, ctx)?; exhaustive_expr(&expr.then_expr, ctx)?; exhaustive_expr(&expr.else_expr, ctx)?; Ok(()) } fn exhaustive_match(expr: &MatchNode, ctx: &Context) -> Result<(), TypingErr> { exhaustive_expr(&expr.expr, ctx)?; let mut patterns = LinkedList::new(); for cs in &expr.cases { patterns.push_back(&cs.pattern); } check_pattern_exhaustive(&patterns, ctx, &expr.pos)?; for cs in &expr.cases { exhaustive_expr(&cs.expr, ctx)?; } Ok(()) } struct Patterns<'a> { pat: BTreeMap<(String, usize), LinkedList<&'a Pattern>>, } impl<'a> Patterns<'a> { fn new() -> Patterns<'a> { Patterns { pat: BTreeMap::new(), } } fn insert(&mut self, label: &str, idx: usize, p: &'a Pattern) { match self.pat.get_mut(&(label.to_string(), idx)) { Some(lst) => { lst.push_back(p); } None => { let mut lst = LinkedList::new(); lst.push_back(p); self.pat.insert((label.to_string(), idx), lst); } } } } fn check_pattern_exhaustive( patterns: &LinkedList<&Pattern>, ctx: &Context, pos: &Pos, ) -> Result<(), TypingErr> { if patterns.is_empty() { return Err(TypingErr { msg: "no pattern".to_string(), pos: *pos, }); } let Some(ty) = patterns.front().unwrap().get_type() else { return Ok(()); }; // list up labels of type // example: // if // (data (Maybe a) // (Just a) // Nothing) // then // pat = [Just, Nothing] let mut pat = BTreeSet::new(); match &ty { Type::TCon(tc) => { match tc.id.as_ref() { "Tuple" => { pat.insert("Tuple".to_string()); } "List" => { pat.insert("Cons".to_string()); pat.insert("Nil".to_string()); } "Bool" => { pat.insert("true".to_string()); pat.insert("false".to_string()); } "Int" => { // integer type must be matched by general pattern pat.insert("'dummy".to_string()); } "String" => { // string type must be matched by general pattern pat.insert("'dummy".to_string()); } "Char" => { // char type must be matched by general pattern pat.insert("'dummy".to_string()); } _ => match ctx.data.get(&tc.id) { Some(data) => { pat = BTreeSet::new(); for mem in &data.members { pat.insert(mem.id.id.clone()); } } None => { let msg = format!("could not found \"{}\" type", ty); return Err(TypingErr { msg, pos: *pos }); } }, } } _ => { return Ok(()); } } // remove labels specified in patterns // example 1: // if // pat = [Just, Nothing] // and // (match (Just 10) // ((Just x) x)) // then // pat = [Nothing] // // if variable pattern occurs then "is_all" becomes true // example 2: // if // (match (Just 10) // (x x)) // then // is_all = true let mut is_all = false; for p in patterns { match p { Pattern::PatID(_) => { is_all = true; } Pattern::PatData(p) => { // TODO: warning // if is_all then unreachable pat.remove(&p.label.id); } Pattern::PatBool(p) => { // TODO: warning // if is_all then unreachable if p.val { pat.remove("true"); } else { pat.remove("false"); } } Pattern::PatTuple(_) => { // TODO: warning // if is_all then unreachable pat.remove("Tuple"); } Pattern::PatNil(_) => { pat.remove("Nil"); } _ => {} } } if is_all { // success Ok(()) } else if pat.is_empty() { // success but need to check recursively let mut ps = Patterns::new(); for p in patterns { match p { Pattern::PatData(e) => { for (i, p2) in e.pattern.iter().enumerate() { ps.insert(&e.label.id, i, p2); } } Pattern::PatTuple(e) => { for (i, p2) in e.pattern.iter().enumerate() { ps.insert("Tuple", i, p2); } } _ => {} } } for plst in ps.pat.values() { check_pattern_exhaustive(plst, ctx, pos)?; } Ok(()) } else { // fail Err(TypingErr { msg: "pattern is not exhaustive".to_string(), pos: *pos, }) } } ================================================ FILE: tests/embedded.rs ================================================ use blisp::embedded; use num_bigint::{BigInt, ToBigInt}; #[embedded] fn test_fun( _z: BigInt, _a: Vec, _b: (BigInt, BigInt), _c: Option, _d: Result, ) -> Option { let temp = 5.to_bigint(); temp } #[embedded] fn add_four_ints(a: BigInt, b: (BigInt, BigInt), c: Option) -> Result { let mut result = a + b.0 + b.1; if let Some(n) = c { result += n; } Ok(result) } #[embedded] fn no_return() {} #[test] fn test_embedded() { // test_fun let code = "(export call_test_fun () (IO (-> () (Option Int))) (test_fun 1 '(2 3) [4 5] (Some 6) (Ok 7)) )"; let exprs = blisp::init(code, vec![Box::new(TestFun)]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let result = blisp::eval("(call_test_fun)", &ctx).unwrap(); let front = result.front().unwrap().as_ref().unwrap(); assert_eq!(front, "(Some 5)"); // add_for_ints let code = "(export call_add_four_ints (n) (IO (-> ((Option Int)) (Result Int String))) (add_four_ints 1 [2 3] n) )"; let exprs = blisp::init(code, vec![Box::new(AddFourInts)]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let result = blisp::eval("(call_add_four_ints (Some 4))", &ctx).unwrap(); let front = result.front().unwrap().as_ref().unwrap(); assert_eq!(front, "(Ok 10)"); // no_return let code = "(export call_no_return () (IO (-> () [])) (no_return) )"; let exprs = blisp::init(code, vec![Box::new(NoReturn)]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); let result = blisp::eval("(call_no_return)", &ctx).unwrap(); result.front().unwrap().as_ref().unwrap(); } ================================================ FILE: tests/transpile.rs ================================================ use blisp; #[test] fn test_transpile() { let expr = " (defun snoc (l y) (Pure (-> ( '(t) t) '(t))) (match l (nil (Cons y nil)) ((Cons h b) (Cons h (snoc b y))))) (defun rev (l) (Pure (-> ( '(t)) '(t))) (match l (nil nil) ((Cons h t) (snoc (rev t) h)))) "; let exprs = blisp::init(expr, vec![]).unwrap(); let ctx = blisp::typing(exprs).unwrap(); println!("{}", blisp::transpile(&ctx)); }