From da515437e614c7d5162544f2df1ff4c1f02fc564 Mon Sep 17 00:00:00 2001
From: Danila Fedorin <danila.fedorin@gmail.com>
Date: Tue, 11 Jun 2019 17:24:28 -0700
Subject: [PATCH] Get basic G-machine compilation working.

---
 CMakeLists.txt   |   2 +-
 src/ast.cpp      |  52 +++++++++++++++++++
 src/ast.hpp      |  19 ++++---
 src/binop.hpp    |  20 ++++++++
 src/compiler.cpp |  30 +++++++++++
 src/compiler.hpp |  32 ++++++++++++
 src/gmachine.cpp |  89 ++++++++++++++++++++++++++++++++
 src/gmachine.hpp | 131 +++++++++++++++++++++++++++++++++++++++++++++++
 src/main.cpp     |  20 +++++---
 src/parser.cpp   |  52 +++++++++++++++++--
 src/parser.hpp   |   2 +
 11 files changed, 430 insertions(+), 19 deletions(-)
 create mode 100644 src/binop.hpp
 create mode 100644 src/compiler.cpp
 create mode 100644 src/compiler.hpp
 create mode 100644 src/gmachine.cpp
 create mode 100644 src/gmachine.hpp

diff --git a/CMakeLists.txt b/CMakeLists.txt
index 97b1d8b..cf59148 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -2,5 +2,5 @@ cmake_minimum_required(VERSION 3.0)
 project(lily)
 
 set(CMAKE_CXX_STANDARD 14)
-add_executable(lily src/main.cpp src/parser.cpp src/parser.c src/type.cpp src/type_manager.cpp src/ast.cpp src/type_checker.cpp src/pattern.cpp)
+add_executable(lily src/main.cpp src/parser.cpp src/parser.c src/type.cpp src/type_manager.cpp src/ast.cpp src/type_checker.cpp src/pattern.cpp src/gmachine.cpp src/compiler.cpp)
 target_include_directories(lily PUBLIC src)
diff --git a/src/ast.cpp b/src/ast.cpp
index 3caa55c..9c7efd7 100644
--- a/src/ast.cpp
+++ b/src/ast.cpp
@@ -93,4 +93,56 @@ namespace lily {
 
         return branch_type;
     }
+
+    void ast_num::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        into.push_back(mgr.add_instruction<instruction_push_int>(3));
+    }
+
+    void ast_var::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        if(env->is_variable(name)) {
+            into.push_back(mgr.add_instruction<instruction_push>(env->get_offset(name)));
+        } else {
+            into.push_back(mgr.add_instruction<instruction_push_global>(name));
+        }
+    }
+
+    void ast_app::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        auto new_env = std::make_shared<compile_env_offset>(1);
+        new_env->set_parent(env);
+        right->compile(mgr, into, env);
+        left->compile(mgr, into, new_env);
+        into.push_back(mgr.add_instruction<instruction_mkapp>());
+    }
+
+    void ast_op::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        auto new_env = std::make_shared<compile_env_offset>(1);
+        new_env->set_parent(env);
+        right->compile(mgr, into, env);
+        left->compile(mgr, into, new_env);
+        into.push_back(mgr.add_instruction<instruction_push_global>(op_supercombinator(op)));
+        into.push_back(mgr.add_instruction<instruction_mkapp>());
+        into.push_back(mgr.add_instruction<instruction_mkapp>());
+    }
+
+    void ast_let::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        expr->compile(mgr, into, env);
+        auto new_env = std::make_shared<compile_env_var>(name);
+        new_env->set_parent(env);
+        in->compile(mgr, into, new_env);
+        into.push_back(mgr.add_instruction<instruction_slide>(1));
+    }
+
+    void ast_letrec::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        into.push_back(mgr.add_instruction<instruction_alloc>(1));
+        auto new_env = std::make_shared<compile_env_var>(name);
+        new_env->set_parent(env);
+        expr->compile(mgr, into, new_env);
+        into.push_back(mgr.add_instruction<instruction_update>(0));
+        in->compile(mgr, into, new_env);
+        into.push_back(mgr.add_instruction<instruction_slide>(1));
+    }
+
+    void ast_case::compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) {
+        throw error("case expressions unimplemented");
+    }
 }
diff --git a/src/ast.hpp b/src/ast.hpp
index 0604aac..60646f5 100644
--- a/src/ast.hpp
+++ b/src/ast.hpp
@@ -4,6 +4,8 @@
 #include "pattern.hpp"
 #include "type.hpp"
 #include "type_manager.hpp"
+#include "compiler.hpp"
+#include "binop.hpp"
 
 namespace lily {
     class type_env;
@@ -11,6 +13,7 @@ namespace lily {
     struct ast {
         virtual ~ast() = default;
         virtual type* check(type_manager& mgr, std::shared_ptr<type_env> env) = 0;
+        virtual void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env) = 0;
     };
 
     typedef std::unique_ptr<ast> ast_ptr;
@@ -21,6 +24,7 @@ namespace lily {
         ast_num(int i) : num(i) {}
         ~ast_num() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 
     struct ast_var : ast {
@@ -30,6 +34,7 @@ namespace lily {
             name(std::move(n)) {}
         ~ast_var() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 
     struct ast_app : ast {
@@ -40,22 +45,19 @@ namespace lily {
             left(std::move(l)), right(std::move(r)) {}
         ~ast_app() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 
     struct ast_op : ast {
-        enum class op {
-            add,
-            subtract,
-            times,
-            divide
-        } op;
+        binop op;
         std::unique_ptr<ast> left;
         std::unique_ptr<ast> right;
 
-        ast_op(enum op o, ast_ptr l, ast_ptr r) :
+        ast_op(binop o, ast_ptr l, ast_ptr r) :
             op(o), left(std::move(l)), right(std::move(r)) {}
         ~ast_op() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 
     struct ast_let : ast {
@@ -67,6 +69,7 @@ namespace lily {
             name(std::move(n)), expr(std::move(e)), in(std::move(i)) {}
         ~ast_let() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 
     struct ast_letrec : ast_let {
@@ -74,6 +77,7 @@ namespace lily {
             ast_let(std::move(n), std::move(e), std::move(i)) {}
         ~ast_letrec() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 
     struct ast_case : ast {
@@ -87,5 +91,6 @@ namespace lily {
 
         ~ast_case() = default;
         type* check(type_manager& mgr, std::shared_ptr<type_env> env);
+        void compile(instruction_manager& mgr, std::vector<instruction*>& into, std::shared_ptr<compile_env> env);
     };
 }
diff --git a/src/binop.hpp b/src/binop.hpp
new file mode 100644
index 0000000..130b02c
--- /dev/null
+++ b/src/binop.hpp
@@ -0,0 +1,20 @@
+#pragma once
+#include <string>
+
+namespace lily {
+    enum class binop {
+        add,
+        subtract,
+        times,
+        divide
+    };
+
+    static std::string op_supercombinator(binop op) {
+        switch(op) {
+            case binop::add: return "+";
+            case binop::subtract: return "-";
+            case binop::times: return "*";
+            case binop::divide: return "/";
+        }
+    }
+};
diff --git a/src/compiler.cpp b/src/compiler.cpp
new file mode 100644
index 0000000..5b5ec3f
--- /dev/null
+++ b/src/compiler.cpp
@@ -0,0 +1,30 @@
+#include "compiler.hpp"
+#include "error.hpp"
+
+namespace lily {
+    void compile_env::set_parent(std::shared_ptr<compile_env> p) {
+        parent = p;
+    }
+
+    int compile_env_var::get_offset(const std::string& name) {
+        if(this->var == name) return 0;
+        if(parent) return parent->get_offset(name) + 1;
+        throw error("unknown variable name");
+    }
+
+    bool compile_env_var::is_variable(const std::string& name) {
+        if(this->var == name) return true;
+        if(parent) return parent->is_variable(name);
+        return false;
+    }
+
+    int compile_env_offset::get_offset(const std::string& name) {
+        if(parent) return parent->get_offset(name) + offset;
+        throw error("unknown variable name");
+    }
+
+    bool compile_env_offset::is_variable(const std::string& name) {
+        if(parent) return parent->is_variable(name);
+        return false;
+    }
+}
diff --git a/src/compiler.hpp b/src/compiler.hpp
new file mode 100644
index 0000000..7a8c89f
--- /dev/null
+++ b/src/compiler.hpp
@@ -0,0 +1,32 @@
+#pragma once
+#include <map>
+#include "gmachine.hpp"
+
+namespace lily {
+    class compile_env {
+        protected:
+            std::shared_ptr<compile_env> parent = nullptr;
+        public:
+            virtual int get_offset(const std::string& name) = 0;
+            virtual bool is_variable(const std::string& name) = 0;
+            void set_parent(std::shared_ptr<compile_env> p);
+    };
+
+    class compile_env_var : public compile_env {
+        private:
+            std::string var;
+        public:
+            compile_env_var(std::string v) : var(std::move(v)), compile_env() {}
+            int get_offset(const std::string& name);
+            bool is_variable(const std::string& name);
+    };
+
+    class compile_env_offset : public compile_env {
+        private:
+            int offset;
+        public:
+            compile_env_offset(int o) : offset(o), compile_env() {}
+            int get_offset(const std::string& name);
+            bool is_variable(const std::string& name);
+    };
+};
diff --git a/src/gmachine.cpp b/src/gmachine.cpp
new file mode 100644
index 0000000..1650522
--- /dev/null
+++ b/src/gmachine.cpp
@@ -0,0 +1,89 @@
+#include "gmachine.hpp"
+#include <iostream>
+
+namespace lily {
+    std::ostream& operator<<(std::ostream& os, instruction& inst) {
+        inst.to_stream(os);
+        return os;
+    }
+
+    std::ostream& instruction_slide::to_stream(std::ostream& os) {
+        os << "slide(" << amount << ")";
+        return os;
+    }
+
+    std::ostream& instruction_alloc::to_stream(std::ostream& os) {
+        os << "alloc(" << amount << ")";
+        return os;
+    }
+
+    std::ostream& instruction_pop::to_stream(std::ostream& os) {
+        os << "pop(" << amount << ")";
+        return os;
+    }
+
+    std::ostream& instruction_unwind::to_stream(std::ostream& os) {
+        os << "unwind";
+        return os;
+    }
+
+    std::ostream& instruction_push_global::to_stream(std::ostream& os) {
+        os << "pushglobal(" << name << ")";
+        return os;
+    }
+
+    std::ostream& instruction_push_int::to_stream(std::ostream& os) {
+        os << "pushint(" << value << ")";
+        return os;
+    }
+
+    std::ostream& instruction_push_str::to_stream(std::ostream& os) {
+        os << "pushstr(" << str << ")";
+        return os;
+    }
+
+    std::ostream& instruction_push::to_stream(std::ostream& os) {
+        os << "push(" << offset << ")";
+        return os;
+    }
+
+    std::ostream& instruction_mkapp::to_stream(std::ostream& os) {
+        os << "mkapp";
+        return os;
+    }
+
+    std::ostream& instruction_eval::to_stream(std::ostream& os) {
+        os << "eval";
+        return os;
+    }
+
+    std::ostream& instruction_op::to_stream(std::ostream& os) {
+        os << "op(" << op_supercombinator(op) << ")";
+        return os;
+    }
+
+    std::ostream& instruction_cond::to_stream(std::ostream& os) {
+        os << "cond";
+        return os;
+    }
+
+    std::ostream& instruction_update::to_stream(std::ostream& os) {
+        os << "update(" << offset << ")";
+        return os;
+    }
+
+    std::ostream& instruction_pack::to_stream(std::ostream& os) {
+        os << "pack(" << constructor << ", " << arity << ")";
+        return os;
+    }
+
+    std::ostream& instruction_split::to_stream(std::ostream& os) {
+        os << "split(" << arity << ")";
+        return os;
+    }
+
+    std::ostream& instruction_jump::to_stream(std::ostream& os) {
+        os << "jump";
+        return os;
+    }
+}
diff --git a/src/gmachine.hpp b/src/gmachine.hpp
new file mode 100644
index 0000000..bc5466d
--- /dev/null
+++ b/src/gmachine.hpp
@@ -0,0 +1,131 @@
+#pragma once
+#include <string>
+#include <vector>
+#include "binop.hpp"
+
+namespace lily {
+    struct instruction {
+        virtual std::ostream& to_stream(std::ostream& os) = 0;
+        virtual ~instruction() = default;
+    };
+
+    std::ostream& operator<<(std::ostream& os, instruction& inst);
+
+    struct instruction_slide : instruction {
+        int amount;
+        
+        instruction_slide(int a) : amount(a) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+    
+    struct instruction_alloc : instruction {
+        int amount;
+
+        instruction_alloc(int a) : amount(a) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_pop : instruction {
+        int amount;
+
+        instruction_pop(int a) : amount(a) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_unwind : instruction {
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_push_global : instruction {
+        std::string name;
+        
+        instruction_push_global(std::string n) : name(std::move(n)) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_push_int : instruction {
+        int value;
+
+        instruction_push_int(int v) : value(v) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_push_str : instruction {
+        std::string str;
+
+        instruction_push_str(std::string s) : str(std::move(s)) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_push : instruction {
+        int offset;
+
+        instruction_push(int o) : offset(o) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_mkapp : instruction {
+
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_eval : instruction {
+
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_op : instruction {
+        binop op;
+
+        instruction_op(binop o) : op(o) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_cond : instruction {
+        std::vector<instruction*> true_branch;
+        std::vector<instruction*> false_branch;
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_update : instruction {
+        int offset;
+
+        instruction_update(int o) : offset(o) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_pack : instruction {
+        int constructor;
+        int arity;
+
+        instruction_pack(int c, int a) :
+            constructor(c), arity(a) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_split : instruction {
+        int arity;
+
+        instruction_split(int a) : arity(a) {}
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    struct instruction_jump : instruction {
+        std::vector<std::vector<instruction*>> instructions;
+        std::ostream& to_stream(std::ostream& os);
+    };
+
+    class instruction_manager {
+        private:
+            std::vector<std::unique_ptr<instruction>> instructions;
+        public:
+            template <typename T, typename ... Ts>
+            T* add_instruction(Ts ... ts) {
+                auto new_inst = std::make_unique<T>(ts...);
+                T* raw = new_inst.get();
+                instructions.push_back(std::move(new_inst));
+                return raw;
+            }
+    };
+
+}
diff --git a/src/main.cpp b/src/main.cpp
index e6267a9..d9f8868 100644
--- a/src/main.cpp
+++ b/src/main.cpp
@@ -1,17 +1,23 @@
 #include "ast.hpp"
 #include "pattern.hpp"
 #include "parser.hpp"
+#include "gmachine.hpp"
 
 int main() {
     try {
-        lily::parse(
-                "data Bool = { True, False }\n"
-                "data Color = { Red, Black }\n"
-                "data IntList = { Nil, Cons(Int, IntList) }\n"
+        lily::program_ptr prog = lily::parse(
                 "defn other x y = { 3 }\n"
-                "defn add x y = { x + y }\n"
-                "defn ones = { Cons 1 ones }\n"
-                "defn len l = { case l of { Nil -> { 0 } Cons(x, xs) -> { 1 + len xs } } }");
+                "defn otherr x y = { let sum = { x + y } in { sum + sum } }\n"
+                );
+        std::map<std::string, std::vector<lily::instruction*>> into;
+        lily::instruction_manager mgr;
+        prog->compile(mgr, into);
+        for(auto& pair : into) {
+            std::cout << pair.first << std::endl;
+            for(auto& op : pair.second) {
+                std::cout << "  " << *op << std::endl;
+            }
+        }
     } catch(lily::error& e) {
         std::cout << e.message << std::endl;
     }
diff --git a/src/parser.cpp b/src/parser.cpp
index 8cbe3f2..d885b76 100644
--- a/src/parser.cpp
+++ b/src/parser.cpp
@@ -51,8 +51,8 @@ namespace lily {
             pgs_tree* right = PGS_TREE_NT_CHILD(*mul, 2);
             pgs_tree* op = PGS_TREE_NT_CHILD(*mul, 1);
 
-            enum ast_op::op o =
-                source[PGS_TREE_T_FROM(*op)] == '*' ? ast_op::op::times : ast_op::op::divide;
+            enum binop o =
+                source[PGS_TREE_T_FROM(*op)] == '*' ? binop::times : binop::divide;
             ast_ptr aleft = expr_mul(left, source);
             ast_ptr aright = expr_app(right, source);
             return ast_ptr(new ast_op(o, std::move(aleft), std::move(aright)));
@@ -67,8 +67,8 @@ namespace lily {
             pgs_tree* right = PGS_TREE_NT_CHILD(*add, 2);
             pgs_tree* op = PGS_TREE_NT_CHILD(*add, 1);
 
-            enum ast_op::op o =
-                source[PGS_TREE_T_FROM(*op)] == '+' ? ast_op::op::add : ast_op::op::subtract;
+            enum binop o =
+                source[PGS_TREE_T_FROM(*op)] == '+' ? binop::add : binop::subtract;
             ast_ptr aleft = expr_add(left, source);
             ast_ptr aright = expr_mul(right, source);
             return ast_ptr(new ast_op(o, std::move(aleft), std::move(aright)));
@@ -290,4 +290,48 @@ namespace lily {
                 throw error("unable to unify function type");
         }
     }
+
+    template <binop o>
+    static void generate_binop(instruction_manager& mgr, std::map<std::string, std::vector<instruction*>>& into) {
+        std::vector<instruction*> dest;
+        dest.push_back(mgr.add_instruction<instruction_push>(1));
+        dest.push_back(mgr.add_instruction<instruction_eval>());
+        dest.push_back(mgr.add_instruction<instruction_push>(1));
+        dest.push_back(mgr.add_instruction<instruction_eval>());
+        dest.push_back(mgr.add_instruction<instruction_op>(o));
+        dest.push_back(mgr.add_instruction<instruction_update>(2));
+        dest.push_back(mgr.add_instruction<instruction_pop>(2));
+        dest.push_back(mgr.add_instruction<instruction_unwind>());
+        into[op_supercombinator(o)] = std::move(dest);
+    }
+
+    static void register_internal(instruction_manager& mgr, std::map<std::string, std::vector<instruction*>>& into) {
+        generate_binop<binop::add>(mgr, into);
+        generate_binop<binop::subtract>(mgr, into);
+        generate_binop<binop::times>(mgr, into);
+        generate_binop<binop::divide>(mgr, into);
+    }
+
+    void program::compile(instruction_manager& mgr, std::map<std::string, std::vector<instruction*>>& into) {
+        register_internal(mgr, into);
+        for(auto& pair : functions) {
+            std::shared_ptr<compile_env> fresh_env = std::make_shared<compile_env_offset>(0);
+            size_t count = pair.second.params.size();
+            for(size_t i = 0; i < count; i++) {
+                auto new_env = std::make_shared<compile_env_var>(pair.second.params[count - i - 1]);
+                new_env->set_parent(fresh_env);
+                fresh_env = new_env;
+            }
+            auto new_env = std::make_shared<compile_env_offset>(1);
+            new_env->set_parent(fresh_env);
+            fresh_env = new_env;
+
+            std::vector<instruction*> destination;
+            pair.second.body->compile(mgr, destination, fresh_env);
+            destination.push_back(mgr.add_instruction<instruction_update>(count));
+            destination.push_back(mgr.add_instruction<instruction_pop>(count));
+            destination.push_back(mgr.add_instruction<instruction_unwind>());
+            into[pair.first] = std::move(destination);
+        }
+    }
 }
diff --git a/src/parser.hpp b/src/parser.hpp
index 23cd90a..b84422f 100644
--- a/src/parser.hpp
+++ b/src/parser.hpp
@@ -6,6 +6,7 @@
 #include "function.hpp"
 #include "type.hpp"
 #include "type_manager.hpp"
+#include "gmachine.hpp"
 
 namespace lily {
     struct program {
@@ -13,6 +14,7 @@ namespace lily {
         std::map<std::string, function> functions;
 
         void check();
+        void compile(instruction_manager& mgr, std::map<std::string, std::vector<instruction*>>& into);
     };
 
     typedef std::unique_ptr<program> program_ptr;