From 5d33836d11b21a797594d4b004a999a13755b761 Mon Sep 17 00:00:00 2001 From: myfreess Date: Tue, 3 Dec 2024 14:09:03 +0800 Subject: [PATCH] G-Machine Part1 --- next/sources/gmachine/.gitignore | 2 + next/sources/gmachine/LICENSE | 202 ++++++++ next/sources/gmachine/README.md | 1 + next/sources/gmachine/moon.mod.json | 10 + next/sources/gmachine/src/part1/ast.mbt | 90 ++++ next/sources/gmachine/src/part1/compile.mbt | 56 +++ .../gmachine/src/part1/instruction.mbt | 11 + next/sources/gmachine/src/part1/lazy.mbt | 25 + next/sources/gmachine/src/part1/moon.pkg.json | 1 + next/sources/gmachine/src/part1/programs.mbt | 41 ++ next/sources/gmachine/src/part1/syntax.mbt | 332 ++++++++++++++ next/sources/gmachine/src/part1/top.mbt | 37 ++ next/sources/gmachine/src/part1/vm.mbt | 236 ++++++++++ next/tutorial/example/gmachine/gmachine-1.md | 434 +++--------------- 14 files changed, 1120 insertions(+), 358 deletions(-) create mode 100644 next/sources/gmachine/.gitignore create mode 100644 next/sources/gmachine/LICENSE create mode 100644 next/sources/gmachine/README.md create mode 100644 next/sources/gmachine/moon.mod.json create mode 100644 next/sources/gmachine/src/part1/ast.mbt create mode 100644 next/sources/gmachine/src/part1/compile.mbt create mode 100644 next/sources/gmachine/src/part1/instruction.mbt create mode 100644 next/sources/gmachine/src/part1/lazy.mbt create mode 100644 next/sources/gmachine/src/part1/moon.pkg.json create mode 100644 next/sources/gmachine/src/part1/programs.mbt create mode 100644 next/sources/gmachine/src/part1/syntax.mbt create mode 100644 next/sources/gmachine/src/part1/top.mbt create mode 100644 next/sources/gmachine/src/part1/vm.mbt diff --git a/next/sources/gmachine/.gitignore b/next/sources/gmachine/.gitignore new file mode 100644 index 00000000..b1283a74 --- /dev/null +++ b/next/sources/gmachine/.gitignore @@ -0,0 +1,2 @@ +target/ +.mooncakes/ diff --git a/next/sources/gmachine/LICENSE b/next/sources/gmachine/LICENSE new file mode 100644 index 00000000..d6456956 --- /dev/null +++ b/next/sources/gmachine/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/next/sources/gmachine/README.md b/next/sources/gmachine/README.md new file mode 100644 index 00000000..ddd9c89a --- /dev/null +++ b/next/sources/gmachine/README.md @@ -0,0 +1 @@ +# G-Machine \ No newline at end of file diff --git a/next/sources/gmachine/moon.mod.json b/next/sources/gmachine/moon.mod.json new file mode 100644 index 00000000..c11eb2b7 --- /dev/null +++ b/next/sources/gmachine/moon.mod.json @@ -0,0 +1,10 @@ +{ + "name": "moonbit-community/gmachine", + "version": "0.1.0", + "readme": "README.md", + "repository": "", + "license": "Apache-2.0", + "keywords": [], + "description": "", + "source": "src" +} \ No newline at end of file diff --git a/next/sources/gmachine/src/part1/ast.mbt b/next/sources/gmachine/src/part1/ast.mbt new file mode 100644 index 00000000..532e3495 --- /dev/null +++ b/next/sources/gmachine/src/part1/ast.mbt @@ -0,0 +1,90 @@ +typealias List[E] = @immut/list.T[E] + +// start expr_and_scdef definition +enum RawExpr[T] { + Var(T) + Num(Int) + Constructor(tag~:Int, arity~:Int) // tag, arity + App(RawExpr[T], RawExpr[T]) + Let(Bool, List[(T, RawExpr[T])], RawExpr[T]) // isRec, Defs, Body + Case(RawExpr[T], List[(Int, List[T], RawExpr[T])]) +} derive(Show) + +struct ScDef[T] { + name : String + args : List[T] + body : RawExpr[T] +} derive(Show) +// end expr_and_scdef definition + +fn is_atom[T](self : RawExpr[T]) -> Bool { + match self { + Var(_) => true + Num(_) => true + _ => false + } +} + +fn binders_of[L, R](l : List[(L, R)]) -> List[L] { + fn fst(pair) { + let (l, _) = pair + return l + } + + l.map(fst) +} + +fn rhss_of[L, R](l : List[(L, R)]) -> List[R] { + fn snd(pair) { + let (_, r) = pair + return r + } + + l.map(snd) +} + +fn ScDef::new[T]( + name : String, + args : List[T], + body : RawExpr[T] +) -> ScDef[T] { + { name : name, args : args, body : body } +} + +// start prelude_defs definition +let prelude_defs : List[ScDef[String]] = { + let args : (FixedArray[String]) -> List[String] = List::of + let id = ScDef::new("I", args(["x"]), Var("x")) // id x = x + let k = + ScDef::new( + "K", + args(["x", "y"]), + Var("x") + ) // K x y = x + let k1 = + ScDef::new( + "K1", + args(["x", "y"]), + Var("y") + ) // K1 x y = y + let s = + ScDef::new( + "S", + args(["f", "g", "x"]), + App(App(Var("f"), Var("x")), App(Var("g"), Var("x"))) + ) // S f g x = f x (g x) + let compose = + ScDef::new( + "compose", + args(["f", "g", "x"]), + App(Var("f"), App(Var("g"), Var("x"))) + ) // compose f g x = f (g x) + let twice = + ScDef::new( + "twice", + args(["f"]), + App(App(Var("compose"), Var("f")), Var("f")) + ) // twice f = compose f f + List::of([id, k, k1, s, compose, twice]) +} +// end prelude_defs definition \ No newline at end of file diff --git a/next/sources/gmachine/src/part1/compile.mbt b/next/sources/gmachine/src/part1/compile.mbt new file mode 100644 index 00000000..b00ab4f6 --- /dev/null +++ b/next/sources/gmachine/src/part1/compile.mbt @@ -0,0 +1,56 @@ +// start compile_sc definition +fn compileSC(self : ScDef[String]) -> (String, Int, List[Instruction]) { + let name = self.name + let body = self.body + let mut arity = 0 + fn gen_env(i : Int, args : List[String]) -> List[(String, Int)] { + match args { + Nil => { + arity = i + return Nil + } + Cons(s, ss) => Cons((s, i), gen_env(i + 1, ss)) + } + } + + let env = gen_env(0, self.args) + (name, arity, compileR(body, env, arity)) +} +// end compile_sc definition + +// start compile_r definition +fn compileR( + self : RawExpr[String], + env : List[(String, Int)], + arity : Int +) -> List[Instruction] { + if arity == 0 { + compileC(self, env) + List::of([Update(arity), Unwind]) + } else { + compileC(self, env) + List::of([Update(arity), Pop(arity), Unwind]) + } +} +// end compile_r definition + +// start compile_c definition +fn compileC( + self : RawExpr[String], + env : List[(String, Int)] +) -> List[Instruction] { + match self { + Var(s) => + match env.lookup(s) { + None => List::of([PushGlobal(s)]) + Some(n) => List::of([PushArg(n)]) + } + Num(n) => List::of([PushInt(n)]) + App(e1, e2) => + compileC(e2, env) + compileC(e1, argOffset(1, env)) + List::of([MkApp]) + _ => abort("not support yet") + } +} +// end compile_c definition + +fn argOffset(n : Int, env : List[(String, Int)]) -> List[(String, Int)] { + env.map(fn { (name, offset) => (name, offset + n) }) +} diff --git a/next/sources/gmachine/src/part1/instruction.mbt b/next/sources/gmachine/src/part1/instruction.mbt new file mode 100644 index 00000000..c7af2059 --- /dev/null +++ b/next/sources/gmachine/src/part1/instruction.mbt @@ -0,0 +1,11 @@ +// start instr definition +enum Instruction { + Unwind + PushGlobal(String) + PushInt(Int) + PushArg(Int) + MkApp + Update(Int) + Pop(Int) +} derive (Eq, Show) +// end instr definition \ No newline at end of file diff --git a/next/sources/gmachine/src/part1/lazy.mbt b/next/sources/gmachine/src/part1/lazy.mbt new file mode 100644 index 00000000..5d490062 --- /dev/null +++ b/next/sources/gmachine/src/part1/lazy.mbt @@ -0,0 +1,25 @@ +// start lazy definition +enum LazyData[T] { + Waiting(() -> T) + Done(T) +} + +struct LazyRef[T] { + mut data : LazyData[T] +} + +fn extract[T](self : LazyRef[T]) -> T { + match self.data { + Waiting(thunk) => { + let value = thunk() + self.data = Done(value) // in-place update + value + } + Done(value) => value + } +} + +fn square(x : LazyRef[Int]) -> Int { + x.extract() * x.extract() +} +// end lazy definition \ No newline at end of file diff --git a/next/sources/gmachine/src/part1/moon.pkg.json b/next/sources/gmachine/src/part1/moon.pkg.json new file mode 100644 index 00000000..9e26dfee --- /dev/null +++ b/next/sources/gmachine/src/part1/moon.pkg.json @@ -0,0 +1 @@ +{} \ No newline at end of file diff --git a/next/sources/gmachine/src/part1/programs.mbt b/next/sources/gmachine/src/part1/programs.mbt new file mode 100644 index 00000000..bb6b38b3 --- /dev/null +++ b/next/sources/gmachine/src/part1/programs.mbt @@ -0,0 +1,41 @@ +let programs : @hashmap.T[String, String] = { + let programs = @hashmap.new(capacity=40) + programs["square"] = + #| (defn square[x] (mul x x)) + programs["fix"] = + #| (defn fix[f] (letrec ([x (f x)]) x)) + programs["isNil"] = + #| (defn isNil[x] + #| (case x [(Nil) 1] [(Cons n m) 0])) + programs["tail"] = + #| (defn tail[l] (case l [(Cons x xs) xs])) + programs["fibs"] = + // fibs = 0 : 1 : zipWith (+) fibs (tail fibs) + #| (defn fibs[] (Cons 0 (Cons 1 (zipWith add fibs (tail fibs))))) + programs["take"] = + #| (defn take[n l] + #| (case l + #| [(Nil) Nil] + #| [(Cons x xs) + #| (if (le n 0) Nil (Cons x (take (sub n 1) xs)))])) + programs["zipWith"] = + #| (defn zipWith[op l1 l2] + #| (case l1 + #| [(Nil) Nil] + #| [(Cons x xs) + #| (case l2 + #| [(Nil) Nil] + #| [(Cons y ys) (Cons (op x y) (zipWith op xs ys))])])) + programs["factorial"] = + #| (defn factorial[n] + #| (if (eq n 0) 1 (mul n (factorial (sub n 1))))) + programs["abs"] = + #| (defn abs[n] + #| (if (lt n 0) (negate n) n)) + programs["length"] = + #| (defn length[l] + #| (case l + #| [(Nil) 0] + #| [(Cons x xs) (add 1 (length xs))])) + programs +} diff --git a/next/sources/gmachine/src/part1/syntax.mbt b/next/sources/gmachine/src/part1/syntax.mbt new file mode 100644 index 00000000..3a59bf26 --- /dev/null +++ b/next/sources/gmachine/src/part1/syntax.mbt @@ -0,0 +1,332 @@ +enum Token { + DefFn + Let + NIL + CONS + Case + Letrec + Open(Char) // { [ ( + Close(Char) // } ] ) + Id(String) + Number(Int) + EOF +} derive(Eq, Show) + +fn between(this : Char, lw : Char, up : Char) -> Bool { + this >= lw && this <= up +} + +fn isDigit(this : Char) -> Bool { + between(this, '0', '9') +} + +fn isAlpha(this : Char) -> Bool { + between(this, 'A', 'Z') || between(this, 'a', 'z') +} + +fn isIdChar(this : Char) -> Bool { + isAlpha(this) || isDigit(this) || this == '_' || this == '-' +} + +fn isWhiteSpace(this : Char) -> Bool { + this == ' ' || this == '\t' || this == '\n' +} + +fn to_number(this : Char) -> Int { + this.to_int() - 48 +} + +fn isOpen(this : Char) -> Bool { + this == '(' || this == '[' || this == '{' +} + +fn isClose(this : Char) -> Bool { + this == ')' || this == ']' || this == '}' +} + +struct Tokens { + tokens : Array[Token] + mut current : Int +} derive(Show) + +fn Tokens::new(tokens : Array[Token]) -> Tokens { + Tokens::{ tokens, current: 0 } +} + +fn peek(self : Tokens) -> Token { + if self.current < self.tokens.length() { + return self.tokens[self.current] + } else { + return EOF + } +} + +type! ParseError String + +fn next(self : Tokens, loc~ : SourceLoc = _) -> Unit { + self.current = self.current + 1 + if self.current > self.tokens.length() { + abort("Tokens::next(): \{loc}") + } +} + +fn eat(self : Tokens, tok : Token, loc~ : SourceLoc = _) -> Unit!ParseError { + let __tok = self.peek() + // assert tok_ != EOF + if __tok != tok { + raise ParseError("\{loc} - Tokens::eat(): expect \{tok} but got \{__tok}") + } else { + self.next() + } +} + +fn tokenize(source : String) -> Tokens { + let tokens : Array[Token] = Array::new(capacity=source.length() / 2) + let mut current = 0 + let source = source.to_array() + fn peek() -> Char { + source[current] + } + + fn next() -> Unit { + current = current + 1 + } + + while current < source.length() { + let ch = peek() + if isWhiteSpace(ch) { + next() + continue + } else if isDigit(ch) { + let mut num = to_number(ch) + next() + while current < source.length() && isDigit(peek()) { + num = num * 10 + to_number(peek()) + next() + } + tokens.push(Number(num)) + continue + } else if isOpen(ch) { + next() + tokens.push(Open(ch)) + continue + } else if isClose(ch) { + next() + tokens.push(Close(ch)) + continue + } else if isAlpha(ch) { + let identifier = @buffer.new(size_hint=42) + identifier.write_char(ch) + next() + while current < source.length() && isIdChar(peek()) { + identifier.write_char(peek()) + next() + } + let identifier = identifier.to_unchecked_string() + match identifier { + "let" => tokens.push(Let) + "letrec" => tokens.push(Letrec) + "Nil" => tokens.push(NIL) + "Cons" => tokens.push(CONS) + "case" => tokens.push(Case) + "defn" => tokens.push(DefFn) + _ => tokens.push(Id(identifier)) + } + } else { + abort("error : invalid Character '\{ch}' in [\{current}]") + } + } else { + return Tokens::new(tokens) + } +} + +test "tokenize" { + inspect!(tokenize("").tokens, content="[]") + inspect!(tokenize("12345678").tokens, content="[Number(12345678)]") + inspect!(tokenize("1234 5678").tokens, content="[Number(1234), Number(5678)]") + inspect!( + tokenize("a0 a_0 a-0").tokens, + content= + #|[Id("a0"), Id("a_0"), Id("a-0")] + , + ) + inspect!( + tokenize("(Cons 0 (Cons 1 Nil))").tokens, + content="[Open('('), CONS, Number(0), Open('('), CONS, Number(1), NIL, Close(')'), Close(')')]", + ) +} + +fn parse_num(self : Tokens) -> Int!ParseError { + match self.peek() { + Number(n) => { + self.next() + return n + } + other => raise ParseError("parse_num(): expect a number but got \{other}") + } +} + +fn parse_var(self : Tokens) -> String!ParseError { + match self.peek() { + Id(s) => { + self.next() + return s + } + other => raise ParseError("parse_var(): expect a variable but got \{other}") + } +} + +fn parse_cons(self : Tokens) -> RawExpr[String]!ParseError { + match self.peek() { + CONS => { + self.next() + let x = self.parse_expr!() + let xs = self.parse_expr!() + return App(App(Constructor(tag=1, arity=2), x), xs) + } + other => raise ParseError("parse_cons(): expect Cons but got \{other}") + } +} + +fn parse_let(self : Tokens) -> RawExpr[String]!ParseError { + self.eat!(Let) + self.eat!(Open('(')) + let defs = self.parse_defs!() + self.eat!(Close(')')) + let exp = self.parse_expr!() + Let(false, defs, exp) +} + +fn parse_letrec(self : Tokens) -> RawExpr[String]!ParseError { + self.eat!(Letrec) + self.eat!(Open('(')) + let defs = self.parse_defs!() + self.eat!(Close(')')) + let exp = self.parse_expr!() + Let(true, defs, exp) +} + +fn parse_case(self : Tokens) -> RawExpr[String]!ParseError { + self.eat!(Case) + let exp = self.parse_expr!() + let alts = self.parse_alts!() + Case(exp, alts) +} + +fn parse_alts( + self : Tokens +) -> List[(Int, List[String], RawExpr[String])]!ParseError { + let acc : List[(Int, List[String], RawExpr[String])] = Nil + loop self.peek(), acc { + Open('['), acc => { + self.next() + self.eat!(Open('(')) + let (tag, variables) = match self.peek() { + NIL => { + self.next() + (0, List::Nil) + } + CONS => { + self.next() + let x = self.parse_var!() + let xs = self.parse_var!() + (1, List::of([x, xs])) + } + other => + raise ParseError("parse_alts(): expect NIL or CONS but got \{other}") + } + self.eat!(Close(')')) + let exp = self.parse_expr!() + let alt = (tag, variables, exp) + self.eat!(Close(']')) + continue self.peek(), Cons(alt, acc) + } + _, acc => acc.rev() + } +} + +fn parse_defs(self : Tokens) -> List[(String, RawExpr[String])]!ParseError { + let acc : List[(String, RawExpr[String])] = Nil + loop self.peek(), acc { + Open('['), acc => { + self.next() + let var = self.parse_var!() + let value = self.parse_expr!() + self.eat!(Close(']')) + continue self.peek(), Cons((var, value), acc) + } + _, acc => acc.rev() + } +} + +fn parse_apply(self : Tokens) -> RawExpr[String]!ParseError { + let mut res = self.parse_expr!() + while self.peek() != Close(')') { + res = App(res, self.parse_expr!()) + } + return res +} + +fn parse_expr(self : Tokens) -> RawExpr[String]!ParseError { + match self.peek() { + EOF => + raise ParseError( + "parse_expr() : expect a token but got a empty token stream", + ) + Number(n) => { + self.next() + Num(n) + } + Id(s) => { + self.next() + Var(s) + } + NIL => { + self.next() + Constructor(tag=0, arity=0) + } + Open('(') => { + self.next() + let exp = match self.peek() { + Let => self.parse_let!() + Letrec => self.parse_letrec!() + Case => self.parse_case!() + CONS => self.parse_cons!() + Id(_) | Open('(') => self.parse_apply!() + other => + raise ParseError("parse_expr(): cant parse \{other} behind a '('") + } + self.eat!(Close(')')) + return exp + } + other => raise ParseError("parse_expr(): cant parse \{other}") + } +} + +fn parse_sc(self : Tokens) -> ScDef[String]!ParseError { + self.eat!(Open('(')) + self.eat!(DefFn) + let fn_name = self.parse_var!() + self.eat!(Open('[')) + let args = loop self.peek(), List::Nil { + tok, acc => + if tok != Close(']') { + let var = self.parse_var!() + continue self.peek(), Cons(var, acc) + } else { + acc.rev() + } + } + self.eat!(Close(']')) + let body = self.parse_expr!() + self.eat!(Close(')')) + ScDef::{ name: fn_name, args, body } +} + +test "parse scdef" { + let test_ = fn!(s) { ignore(tokenize(s).parse_sc!()) } + for p in programs { + let (_, p) = p + test_!(p) + } +} diff --git a/next/sources/gmachine/src/part1/top.mbt b/next/sources/gmachine/src/part1/top.mbt new file mode 100644 index 00000000..cb8242e0 --- /dev/null +++ b/next/sources/gmachine/src/part1/top.mbt @@ -0,0 +1,37 @@ +// start run definition +fn run(codes : List[String]) -> Node { + fn parse_then_compile(code : String) -> (String, Int, List[Instruction]) { + let tokens = tokenize(code) + let code = + try { + tokens.parse_sc!() + } catch { + ParseError(s) => abort(s) + } else { + expr => expr + } + let code = compileSC(code) + return code + } + let codes = codes.map(parse_then_compile) + prelude_defs.map(compileSC) + let (heap, globals) = build_initial_heap(codes) + let initialState : GState = { + heap : heap, + stack : Nil, + code : List::of([PushGlobal("main"), Unwind]), + globals : globals, + stats : 0 + } + initialState.reify() +} +// end run definition + +test "basic eval" { + // S K K x => ((K x (K x)) => x + let main = "(defn main[] (S K K 3))" + inspect!(run(List::of([main])), content = "NNum(3)") + let main = "(defn main[] (K 0 1))" + inspect!(run(List::of([main])), content = "NNum(0)") + let main = "(defn main[] (K1 0 1))" + inspect!(run(List::of([main])), content = "NNum(1)") +} \ No newline at end of file diff --git a/next/sources/gmachine/src/part1/vm.mbt b/next/sources/gmachine/src/part1/vm.mbt new file mode 100644 index 00000000..4b63938b --- /dev/null +++ b/next/sources/gmachine/src/part1/vm.mbt @@ -0,0 +1,236 @@ +// start heap definition +// Use the 'type' keyword to encapsulate an address type. +type Addr Int derive(Eq, Show) + +// Describe graph nodes with an enumeration type. +enum Node { + NNum(Int) + // The application node + NApp(Addr, Addr) + // To store the number of parameters and + // the corresponding sequence of instructions for a super combinator + NGlobal(String, Int, List[Instruction]) + // The Indirection node，The key component of implementing lazy evaluation + NInd(Addr) +} derive(Eq, Show) + +struct GHeap { + // The heap uses an array, + // and the space with None content in the array is available as free memory. + mut object_count : Int + memory : Array[Node?] +} + +// Allocate heap space for nodes. +fn alloc(self : GHeap, node : Node) -> Addr { + let heap = self + fn next(n : Int) -> Int { + (n + 1) % heap.memory.length() + } + + fn free(i : Int) -> Bool { + match heap.memory[i] { + None => true + _ => false + } + } + + let mut i = heap.object_count + while not(free(i)) { + i = next(i) + } + heap.memory[i] = Some(node) + heap.object_count = heap.object_count + 1 + return Addr(i) +} +// end heap definition + +fn op_get(self : GHeap, key : Addr) -> Node { + let Addr(i) = key + match self.memory[i] { + Some(node) => node + None => abort("GHeap::get(): index \{i} was empty") + } +} + +fn op_set(self : GHeap, key : Addr, val : Node) -> Unit { + self.memory[key._] = Some(val) +} + +// start state definition +struct GState { + mut stack : List[Addr] + heap : GHeap + globals : @hashmap.T[String, Addr] + mut code : List[Instruction] + mut stats : GStats +} + +type GStats Int + +fn stat_incr(self : GState) -> Unit { + self.stats = self.stats._ + 1 +} + +fn put_stack(self : GState, addr : Addr) -> Unit { + self.stack = Cons(addr, self.stack) +} + +fn put_code(self : GState, instrs : List[Instruction]) -> Unit { + self.code = instrs + self.code +} + +fn pop1(self : GState) -> Addr { + match self.stack { + Cons(addr, reststack) => { + self.stack = reststack + addr + } + Nil => abort("pop1(): stack size smaller than 1") + } +} + +// e1 e2 ..... -> (e1, e2) ...... +fn pop2(self : GState) -> (Addr, Addr) { + match self.stack { + Cons(addr1, Cons(addr2, reststack)) => { + self.stack = reststack + (addr1, addr2) + } + _ => abort("pop2(): stack size smaller than 2") + } +} +// end state definition + +// start push_int definition +fn push_int(self : GState, num : Int) -> Unit { + let addr = self.heap.alloc(NNum(num)) + self.put_stack(addr) +} +// end push_int definition + +// start push_global definition +fn push_global(self : GState, name : String) -> Unit { + let sc = self.globals[name] + match sc { + None => abort("push_global(): cant find supercombinator \{name}") + Some(addr) => self.put_stack(addr) + } +} +// end push_global definition + +// start push_arg definition +fn push_arg(self : GState, offset : Int) -> Unit { + // Push(n) a0 : . . . : an : s + // => an : a0 : . . . : an : s + let appaddr = self.stack.nth(offset + 1).unwrap() + let arg = match self.heap[appaddr] { + NApp(_, arg) => arg + otherwise => + abort( + "pusharg: stack offset \{offset} address \{appaddr} node \{otherwise}", + ) + } + self.put_stack(arg) +} +// end push_arg definition + +// start mk_apply definition +fn mk_apply(self : GState) -> Unit { + let (a1, a2) = self.pop2() + let appaddr = self.heap.alloc(NApp(a1, a2)) + self.put_stack(appaddr) +} +// end mk_apply definition + +// start update definition +fn update(self : GState, n : Int) -> Unit { + let addr = self.pop1() + let dst = self.stack.nth(n).unwrap() + self.heap[dst] = NInd(addr) +} +// end update definition + +// start unwind definition +fn unwind(self : GState) -> Unit { + let addr = self.pop1() + match self.heap[addr] { + NNum(_) => self.put_stack(addr) + NApp(a1, _) => { + self.put_stack(addr) + self.put_stack(a1) + self.put_code(Cons(Unwind, Nil)) + } + NGlobal(_, n, c) => + if self.stack.length() < n { + abort("Unwinding with too few arguments") + } else { + self.put_stack(addr) + self.put_code(c) + } + NInd(a) => { + self.put_stack(a) + self.put_code(Cons(Unwind, Nil)) + } + otherwise => + abort("unwind() : wrong kind of node \{otherwise}, address \{addr}") + } +} +// end unwind definition + +// start build_ih definition +fn build_initial_heap( + scdefs : List[(String, Int, List[Instruction])] +) -> (GHeap, @hashmap.T[String, Addr]) { + let heap = { object_count: 0, memory: Array::make(10000, None) } + let globals = @hashmap.new(capacity=50) + loop scdefs { + Nil => () + Cons((name, arity, instrs), rest) => { + let addr = heap.alloc(NGlobal(name, arity, instrs)) + globals[name] = addr + continue rest + } + } + return (heap, globals) +} +// end build_ih definition + +// start step definition +fn step(self : GState) -> Bool { + match self.code { + Nil => return false + Cons(i, is) => { + self.code = is + self.stat_incr() + match i { + PushGlobal(f) => self.push_global(f) + PushInt(n) => self.push_int(n) + PushArg(n) => self.push_arg(n) + MkApp => self.mk_apply() + Unwind => self.unwind() + Update(n) => self.update(n) + Pop(n) => self.stack = self.stack.drop(n) + } + return true + } + } +} +// end step definition + +// start reify definition +fn reify(self : GState) -> Node { + if self.step() { + self.reify() + } else { + let stack = self.stack + match stack { + Cons(addr, Nil) => { + let res = self.heap[addr] + return res + } + _ => abort("wrong stack \{stack}") + } + } +} +// end reify definition diff --git a/next/tutorial/example/gmachine/gmachine-1.md b/next/tutorial/example/gmachine/gmachine-1.md index f19fa4e8..29497b11 100644 --- a/next/tutorial/example/gmachine/gmachine-1.md +++ b/next/tutorial/example/gmachine/gmachine-1.md @@ -103,47 +103,18 @@ coreF excludes anonymous functions because anonymous functions introduce extra f Super combinators will eventually be parsed into `ScDef[String]`, but writing a parser is a tedious task. I will provide it along with the final code. -```moonbit -enum RawExpr[T] { - Var(T) - Num(Int) - Constructor(Int, Int) // tag, arity - App(RawExpr[T], RawExpr[T]) - Let(Bool, List[(T, RawExpr[T])], RawExpr[T]) // isRec, Defs, Body - Case(RawExpr[T], List[(Int, List[T], RawExpr[T])]) -} derive(Show) - -struct ScDef[T] { - name : String - args : List[T] - body : RawExpr[T] -} derive(Show) +```{literalinclude} /sources/gmachine/src/part1/ast.mbt +:language: moonbit +:start-after: start expr_and_scdef definition +:end-before: end expr_and_scdef definition ``` Additionally, some predefined coreF programs are required. -```moonbit -let preludeDefs : List[ScDef[String]] = { - let id = ScDef::new("I", List::of(["x"]), Var("x")) // id x = x - let k = ScDef::new("K", List::of(["x", "y"]), Var("x")) // K x y = x - let k1 = ScDef::new("K1", List::of(["x", "y"]), Var("y")) // K1 x y = y - let s = ScDef::new( - "S", - List::of(["f", "g", "x"]), - App(App(Var("f"), Var("x")), App(Var("g"), Var("x"))), - ) // S f g x = f x (g x) - let compose = ScDef::new( - "compose", - List::of(["f", "g", "x"]), - App(Var("f"), App(Var("g"), Var("x"))), - ) // compose f g x = f (g x) - let twice = ScDef::new( - "twice", - List::of(["f"]), - App(App(Var("compose"), Var("f")), Var("f")), - ) // twice f = compose f f - Cons(id, Cons(k, Cons(k1, Cons(s, Cons(compose, Cons(twice, Nil)))))) -} +```{literalinclude} /sources/gmachine/src/part1/ast.mbt +:language: moonbit +:start-after: start prelude_defs definition +:end-before: end prelude_defs definition ``` ## Why Graph @@ -175,30 +146,10 @@ fn square(thunk : () -> Int) -> Int { To represent the program using a graph is to facilitate sharing of computation results and avoid redundant calculations. To achieve this purpose, it's crucial to implement an in-place update algorithm when reducing the graph. Regarding in-place update, let's simulate it using MoonBit code: -```moonbit -enum LazyData[T] { - Waiting(() -> T) - Done(T) -} - -struct LazyRef[T] { - mut data : LazyData[T] -} - -fn extract[T](self : LazyRef[T]) -> T { - match self.data { - Waiting(thunk) => { - let value = thunk() - self.data = Done(value) // in-place update - value - } - Done(value) => value - } -} - -fn square(x : LazyRef[Int]) -> Int { - x.extract() * x.extract() -} +```{literalinclude} /sources/gmachine/src/part1/lazy.mbt +:language: moonbit +:start-after: start lazy definition +:end-before: end lazy definition ``` Regardless of which side executes the `extract` method first, it will update the referenced mutable field and replace its content with the computed result. Therefore, there's no need to recompute it during the second execution of the `extract` method. @@ -311,44 +262,10 @@ In this simple version of the G-Machine, the state includes: - Heap: This is where the expression graph and the sequences of instructions corresponding to super combinators are stored. -```moonbit -// Use the 'type' keyword to encapsulate an address type. -type Addr Int derive(Eq, Show) - -// Describe graph nodes with an enumeration type. -enum Node { - NNum(Int) - // The application node - NApp(Addr, Addr) - // To store the number of parameters and - // the corresponding sequence of instructions for a super combinator. - NGlobal(String, Int, List[Instruction]) - // The Indirection node，The key component of implementing lazy evaluation - NInd(Addr) -} derive (Eq, Show) - -struct GHeap { // The heap uses an array, and the space with None content in the array is available as free memory. - mut objectCount : Int - memory : Array[Option[Node]] -} - -// Allocate heap space for nodes. -fn alloc(self : GHeap, node : Node) -> Addr { - let heap = self - // Assuming there is still available space in the heap. - fn next(n : Int) -> Int { - (n + 1) % heap.memory.length() - } - fn free(i : Int) -> Bool { - heap.memory[i].is_empty() - } - let mut i = heap.objectCount - while not(free(i)) { - i = next(i) - } - heap.memory[i] = Some(node) - return Addr(i) -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start heap definition +:end-before: end heap definition ``` - Stack: The stack only holds addresses pointing to the heap. A simple implementation can use `List[Addr]`. @@ -356,66 +273,12 @@ fn alloc(self : GHeap, node : Node) -> Addr { - Current code sequence to be executed. - Execution status statistics: A simple implementation involves calculating how many instructions have been executed. -```moonbit -type GStats Int - -let statInitial : GStats = GStats(0) - -fn statInc(self : GStats) -> GStats { - let GStats(n) = self - GStats(n + 1) -} - -fn statGet(self : GStats) -> Int { - let GStats(n) = self - return n -} -``` - The entire state is represented using the type `GState`. -```moonbit -struct GState { - mut stack : List[Addr] - heap : GHeap - globals : RHTable[String, Addr] - mut code : List[Instruction] - stats : GStats -} - -fn putStack(self : GState, addr : Addr) -> Unit { - self.stack = Cons(addr, self.stack) -} - -fn putCode(self : GState, is : List[Instruction]) -> Unit { - self.code = append(is, self.code) -} - -fn pop1(self : GState) -> Addr { - match self.stack { - Cons(addr, reststack) => { - self.stack = reststack - addr - } - Nil => { - abort("pop1: stack size smaller than 1") - } - } -} - -fn pop2(self : GState) -> (Addr, Addr) { - // Pop 2 pops the top two elements from the stack. - // Returns (the first, the second). - match self.stack { - Cons(addr1, Cons(addr2, reststack)) => { - self.stack = reststack - (addr1, addr2) - } - otherwise => { - abort("pop2: stack size smaller than 2") - } - } -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start state definition +:end-before: end state definition ``` Now, we can map each step of the graph reduction algorithm we deduced on paper to this abstract machine: @@ -436,77 +299,50 @@ All of these tasks have corresponding instruction implementations. The highly simplified G-Machine currently consists of 7 instructions. -```moonbit -enum Instruction { - Unwind - PushGlobal(String) - PushInt(Int) - PushArg(Int) - MkApp - Update(Int) - Pop(Int) -} derive(Eq, Show) +```{literalinclude} /sources/gmachine/src/part1/instruction.mbt +:language: moonbit +:start-after: start instr definition +:end-before: end instr definition ``` The `PushInt` instruction is the simplest. It allocates an `NNum` node on the heap and pushes its address onto the stack. -```moonbit -fn push_int(self : GState, num : Int) -> Unit { - let addr = self.heap.alloc(NNum(num)) - self.putStack(addr) -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start push_int definition +:end-before: end push_int definition ``` The `PushGlobal` instruction retrieves the address of the specified super combinator from the global table and then pushes the address onto the stack. -```moonbit -fn push_global(self : GState, name : String) -> Unit { - let sc = self.globals[name] - match sc { - None => abort("push_global(): cant find super combinator \{name}") - Some(addr) => { - self.putStack(addr) - } - } -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start push_global definition +:end-before: end push_global definition ``` The `PushArg` instruction is a bit more complex. It has specific requirements regarding the layout of addresses on the stack: the first address should point to the super combinator node, followed by n addresses pointing to N `NApp` nodes. `PushArg` retrieves the Nth parameter, starting from the `offset + 1`. -```moonbit -fn push_arg(self : GState, offset : Int) -> Unit { - // Skip the first super combinator node. - // Access the (offset + 1)th NApp node - let appaddr = @immut/list.unsafe_nth(self.stack, offset + 1) - let arg = match self.heap[appaddr] { - NApp(_, arg) => arg - otherwise => - abort( - "push_arg: stack offset \{offset} address \{appaddr} node \{otherwise}, not a applicative node" - ) - } - self.putStack(arg) -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start push_arg definition +:end-before: end push_arg definition ``` The `MkApp` instruction takes two addresses from the top of the stack, constructs an `NApp` node, and pushes its address onto the stack. -```moonbit -fn mkapp(self : GState) -> Unit { - let (a1, a2) = self.pop2() - let appaddr = self.heap.alloc(NApp(a1, a2)) - self.putStack(appaddr) -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start mk_apply definition +:end-before: end mk_apply definition ``` The `Update` instruction assumes that the first address on the stack points to the current redex's evaluation result. It skips the addresses of the immediately following super combinator nodes and replaces the Nth `NApp` node with an indirect node pointing to the evaluation result. If the current redex is a CAF, it directly replaces its corresponding `NGlobal` node on the heap. From this, we can see why in lazy functional languages, there is not much distinction between functions without parameters and ordinary variables. -```moonbit -fn update(self : GState, n : Int) -> Unit { - let addr = self.pop1() - let dst = @immut/list.unsafe_nth(self.stack, n) - self.heap[dst] = NInd(addr) -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start update definition +:end-before: end update definition ``` The `Unwind` instruction in the G-Machine is akin to an evaluation loop. It has several branching conditions based on the type of node corresponding to the address at the top of the stack: @@ -516,32 +352,10 @@ The `Unwind` instruction in the G-Machine is akin to an evaluation loop. It has - For `NGlobal` nodes: If there are enough parameters on the stack, load this super combinator into the current code. - For `NInd` nodes: Push the address contained within this indirect node onto the stack and Unwind again. -```moonbit -fn unwind(self : GState) -> Unit { - let addr = self.pop1() - match self.heap[addr] { - NNum(_) => self.putStack(addr) - NApp(a1, _) => { - self.putStack(addr) - self.putStack(a1) - self.putCode(Cons(Unwind, Nil)) - } - NGlobal(_, n, c) => { - if self.stack.length() < n { - abort("Unwinding with too few arguments") - } else { - self.putStack(addr) - self.putCode(c) - } - } - NInd(a) => { - self.putStack(a) - self.putCode(Cons(Unwind, Nil)) - } - otherwise => - abort("unwind() : wrong kind of node \{otherwise}, address \{addr}") - } -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start unwind definition +:end-before: end unwind definition ``` The `Pop` instruction pops N addresses, eliminating the need for a separate function implementation. @@ -559,23 +373,10 @@ When compiling a super combinator, we need to maintain an environment that allow > Here, "parameters" refer to addresses pointing to App nodes on the heap, and the actual parameter addresses can be accessed through the pusharg instruction. -```moonbit -fn compileSC(self : ScDef[String]) -> (String, Int, List[Instruction]) { - let name = self.name - let body = self.body - let mut arity = 0 - fn gen_env(i : Int, args : List[String]) -> List[(String, Int)] { - match args { - Nil => { - arity = i - return Nil - } - Cons(s, ss) => Cons((s, i), gen_env(i + 1, ss)) - } - } - let env = gen_env(0, self.args) - (name, arity, compileR(body, env, arity)) -} +```{literalinclude} /sources/gmachine/src/part1/compile.mbt +:language: moonbit +:start-after: start compile_sc definition +:end-before: end compile_sc definition ``` The `compileR` function generates code for instantiating super combinators by calling the `compileC` function, and then appends three instructions: @@ -584,135 +385,52 @@ The `compileR` function generates code for instantiating super combinators by ca - `Pop(N)`: Clears the stack of redundant addresses. - `Unwind`: Searches for the next redex to start the next reduction. -```moonbit -fn compileR( - self : RawExpr[String], - env : List[(String, Int)], - arity : Int -) -> List[Instruction] { - if arity == 0 { - // The Pop 0 instruction does nothing in practice, - // so it is not generated when the arity is 0. - compileC(self, env).concat(@immut/list.of([Update(arity), Unwind])) - } else { - compileC(self, env).concat( - @immut/list.of([Update(arity), Pop(arity), Unwind]), - ) - } -} +```{literalinclude} /sources/gmachine/src/part1/compile.mbt +:language: moonbit +:start-after: start compile_r definition +:end-before: end compile_r definition ``` When compiling the definition of super combinators, a rather crude approach is used: if a variable is not a parameter, it is treated as another super combinator (writing it incorrectly will result in a runtime error). For function application, the right-hand expression is compiled first, then all offsets corresponding to parameters in the environment are incremented (because an extra address pointing to the instantiated right-hand expression is added to the top of the stack), then the left-hand expression is compiled, and finally the `MkApp` instruction is added. -```moonbit -fn compileC( - self : RawExpr[String], - env : List[(String, Int)] -) -> List[Instruction] { - match self { - Var(s) => - match lookupENV(env, s) { - None => @immut/list.of([PushGlobal(s)]) - Some(n) => @immut/list.of([PushArg(n)]) - } - Num(n) => @immut/list.of([PushInt(n)]) - App(e1, e2) => - compileC(e2, env) - .concat(compileC(e1, argOffset(1, env))) - .concat(@immut/list.of([MkApp])) - _ => abort("not support yet") - } -} +```{literalinclude} /sources/gmachine/src/part1/compile.mbt +:language: moonbit +:start-after: start compile_c definition +:end-before: end compile_c definition ``` ## Running the G-Machine Once the super combinators are compiled, they need to be placed on the heap (along with adding their addresses to the global table). This can be done recursively. -```moonbit -fn buildInitialHeap(scdefs : List[(String, Int, List[Instruction])]) -> (GHeap, RHTable[String, Addr]) { - let heap = { objectCount : 0, memory : Array::make(10000, None) } - let globals = RHTable::new(50) - fn go(lst : List[(String, Int, List[Instruction])]) { - match lst { - Nil => () - Cons((name, arity, instrs), rest) => { - let addr = heap.alloc(NGlobal(name, arity, instrs)) - globals[name] = addr - go(rest) - } - } - } - go(scdefs) - return (heap, globals) -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start build_ih definition +:end-before: end build_ih definition ``` Define a function "step" that updates the state of the G-Machine by one step, returning false if the final state has been reached. -```moonbit -fn step(self : GState) -> Bool { - match self.code { - Nil => return false - Cons(i, is) => { - self.code = is - self.statInc() - match i { - PushGlobal(f) => self.push_global(f) - PushInt(n) => self.push_int(n) - PushArg(n) => self.push_arg(n) - MkApp => self.mkapp() - Unwind => self.unwind() - Update(n) => self.update(n) - Pop(n) => self.stack = self.stack.drop(n) - } // without the need for additional functions - return true - } - } -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start step definition +:end-before: end step definition ``` Additionally, define a function "reify" that continuously executes the "step" function until the final state is reached. -```moonbit -fn reify(self : GState) -> Unit { - if self.step() { - self.reify() - } else { - let stack = self.stack - match stack { - Cons(addr, Nil) => { - let res = self.heap[addr] - println("\{res}") - } - _ => abort("wrong stack \{stack}") - } - } -} +```{literalinclude} /sources/gmachine/src/part1/vm.mbt +:language: moonbit +:start-after: start reify definition +:end-before: end reify definition ``` Combine the above components. -```moonbit -fn run(codes : List[String]) -> Unit { - fn parse_then_compile(code : String) -> (String, Int, List[Instruction]) { - let code = TokenStream::new(code) - let code = parseSC(code) - let code = compileSC(code) - return code - } - - let codes = codes.map(parse_then_compile).concat(preludeDefs.map(compileSC)) - let (heap, globals) = buildInitialHeap(codes) - let initialState : GState = { - heap, - stack: Nil, - code: initialCode, - globals, - stats: initialStat, - } - initialState.reify() -} +```{literalinclude} /sources/gmachine/src/part1/top.mbt +:language: moonbit +:start-after: start run definition +:end-before: end run definition ``` ## Conclusion