Implement enough of function call support to make "factorial" function

example.vli

@@ -1,12 +1,14 @@
-;; Check that lambdas can be passed as arguments
+;;((fn (f y) (f y))
+ ;;(fn (x) (* x x))
+ ;;2)
 
-((fn (f y) (f y))
+;;(((fn (x)
- (fn (x) (* x x))
+    ;;(fn () (* x x 2)))
- 2)
+  ;;2))
 
-(((fn (x)
+(fn fact (n)
-    (fn () (* x x 2)))
+    (if (<= n 0)
-  2))
+        1
+        (* n (fact (- n 1)))))
 
-
+(fact 12)
-(fn foo (x y) (* x y))

src/arena.cpp

@@ -83,6 +83,8 @@ Result<PodObject*> Arena::gc_pod(PodObject* obj) {
       return gc_opcode((PodOpcode*)obj);
     case Tag::Function:
       return gc_function((PodFunction*)obj);
+    case Tag::Module:
+      return gc_module((PodModule*)obj);
     case Tag::Stack:
       return gc_stack((PodStack*)obj);
   }
@@ -208,6 +210,16 @@ Result<PodObject*> Arena::gc_function(PodFunction* obj) {
   return nobj;
 }
 
+Result<PodObject*> Arena::gc_module(PodModule* obj) {
+  auto nobj = TRY(alloc<PodModule>());
+  nobj->header.tag = Tag::Function;
+  nobj->name = TRY(gc_pod(obj->name.get()));
+  nobj->globals = TRY(gc_pod(obj->globals.get()));
+  nobj->fun = TRY(gc_pod(obj->fun.get()));
+
+  return nobj;
+}
+
 Result<PodObject*> Arena::gc_stack(PodStack* obj) {
   auto nobj = TRY(alloc<PodStack>(sizeof(OffPtr<PodObject>) * obj->size));
   nobj->header.tag = Tag::Stack;

src/arena.hpp

@@ -156,6 +156,7 @@ class Arena {
   Result<PodObject*> gc_dict(PodDict* obj);
   Result<PodObject*> gc_opcode(PodOpcode* obj);
   Result<PodObject*> gc_function(PodFunction* obj);
+  Result<PodObject*> gc_module(PodModule* obj);
   Result<PodObject*> gc_stack(PodStack* obj);
 
   void add_root(GcRootList* node) { _gcroot.insert(node); }

src/common.cpp

@@ -40,6 +40,8 @@ Result<Value> Value::create(PodObject* obj) {
       return Value(TRY(Opcode::create((PodOpcode*)obj)));
     case Tag::Function:
       return Value(TRY(Function::create((PodFunction*)obj)));
+    case Tag::Module:
+      return Value(TRY(Module::create((PodModule*)obj)));
     case Tag::Stack:
       return Value(TRY(Stack::create((PodStack*)obj)));
   };
@@ -160,6 +162,28 @@ Result<short> Function::cmp(const Function& rhs) const {
   return res;
 }
 
+Result<Value> Module::copy_value() const {
+  return Value(Module(TRY(_value.copy())));
+}
+Result<Module> Module::copy() const { return Module(TRY(_value.copy())); }
+
+Result<short> Module::cmp(const Module& rhs) const {
+  auto lhs_name = TRY(name());
+  auto rhs_name = TRY(rhs.name());
+  short res = TRY(lhs_name.cmp(rhs_name));
+  if (res != 0) return res;
+
+  auto lhs_fun = TRY(fun());
+  auto rhs_fun = TRY(rhs.fun());
+  res = TRY(lhs_fun.cmp(rhs_fun));
+  if (res != 0) return res;
+
+  auto lhs_globals = TRY(globals());
+  auto rhs_globals = TRY(rhs.globals());
+  res = TRY(lhs_globals.cmp(rhs_globals));
+  return res;
+}
+
 Result<Value> Stack::copy_value() const {
   return Value(Stack(TRY(_value.copy())));
 }
@@ -252,6 +276,27 @@ Result<Array> Function::closure() const {
   return Array::create((PodArray*)_value->closure.get());
 }
 
+Result<Module> Module::create(const Value& name, const Function& fun,
+                              const Dict& globals) {
+  auto pod = TRY(arena_alloc<PodModule>());
+  pod->header.tag = Tag::Module;
+  pod->name = name.pod();
+  pod->fun = fun.pod();
+  pod->globals = globals.pod();
+
+  return Module(TRY(MkGcRoot(pod)));
+}
+
+Result<Value> Module::name() const { return Value::create(_value->name.get()); }
+
+Result<Function> Module::fun() const {
+  return Function::create((PodFunction*)_value->fun.get());
+}
+
+Result<Dict> Module::globals() const {
+  return Dict::create((PodDict*)_value->globals.get());
+}
+
 Result<Value> reverse(Value& val) {
   if (val.is<Nil>()) return Value(TRY(Nil::create()));
   if (!val.is<Pair>()) return ERROR(TypeMismatch);

src/common.hpp

@@ -29,6 +29,7 @@ class Writer;
 class Opcode;
 class Stack;
 class Function;
+class Module;
 
 short cmp_tag(Tag lhs, Tag rhs);
 
@@ -77,6 +78,9 @@ class Object {
   virtual Result<short> cmp(const Function& rhs) const {
     return cmp_tag(tag(), Tag::Function);
   }
+  virtual Result<short> cmp(const Module& rhs) const {
+    return cmp_tag(tag(), Tag::Module);
+  }
   virtual Result<short> cmp(const char* rhs) const {
     return ERROR(NotImplemented);
   }
@@ -888,6 +892,44 @@ class Function : public Object {
   GcRoot<PodFunction> _value;
 };
 
+class Module : public Object {
+ public:
+  Module() {}
+  Module(Module&& rhs) : _value(std::move(rhs._value)) {}
+  Module(GcRoot<PodModule>&& val) : _value(std::move(val)) {}
+
+  Module& operator=(Module&& rhs) {
+    _value = std::move(rhs._value);
+    return *this;
+  }
+
+  virtual Tag tag() const final { return Tag::Module; }
+  virtual PodObject* pod() const final { return _value.get(); }
+  virtual Result<short> cmp(const Object& rhs) const final {
+    return -TRY(rhs.cmp(*this));
+  }
+  virtual Result<short> cmp(const Module& rhs) const final;
+
+  virtual void move(Object* obj) final { new (obj) Module(std::move(_value)); }
+
+  static Result<Module> create(PodModule* obj) {
+    return Module(TRY(MkGcRoot(obj)));
+  }
+
+  static Result<Module> create(const Value& name, const Function& fun,
+                               const Dict& globals);
+
+  Result<Value> name() const;
+  Result<Function> fun() const;
+  Result<Dict> globals() const;
+
+  virtual Result<Value> copy_value() const final;
+  Result<Module> copy() const;
+
+ private:
+  GcRoot<PodModule> _value;
+};
+
 class Stack : public Object {
  public:
   Stack() {}

src/compiler.cpp

@@ -7,15 +7,17 @@ struct Context {
 
   Context(Value&& env, Array&& constants, Dict&& constants_dict,
           Dict&& variables_dict, Array&& closures, Dict&& closures_dict,
-          Context* parent, bool toplevel)
+          Dict&& globals_dict, Context* parent, bool toplevel)
       : env(std::move(env)),
         constants(std::move(constants)),
         constants_dict(std::move(constants_dict)),
         variables_dict(std::move(variables_dict)),
         closures(std::move(closures)),
         closures_dict(std::move(closures_dict)),
+        globals_dict(std::move(globals_dict)),
         maxreg(0),
-        parent(parent) {}
+        parent(parent),
+        toplevel(toplevel) {}
 
   static Result<Context> create() {
     auto env = TRY(Nil::create());
@@ -24,10 +26,12 @@ struct Context {
     auto variables_dict = TRY(Dict::create());
     auto closures = TRY(Array::create());
     auto closures_dict = TRY(Dict::create());
+    auto globals_dict = TRY(Dict::create());
 
     return Context(std::move(env), std::move(constants),
                    std::move(constants_dict), std::move(variables_dict),
-                   std::move(closures), std::move(closures_dict), 0, true);
+                   std::move(closures), std::move(closures_dict),
+                   std::move(globals_dict), 0, true);
   }
 
   static Result<Context> create(Context& parent) {
@@ -37,11 +41,12 @@ struct Context {
     auto variables_dict = TRY(Dict::create());
     auto closures = TRY(Array::create());
     auto closures_dict = TRY(Dict::create());
+    auto globals_dict = TRY(Dict::create());
 
     return Context(std::move(env), std::move(constants),
                    std::move(constants_dict), std::move(variables_dict),
-                   std::move(closures), std::move(closures_dict), &parent,
+                   std::move(closures), std::move(closures_dict),
-                   false);
+                   std::move(globals_dict), &parent, false);
   }
 
   uint64_t alloc_reg() {
@@ -112,12 +117,18 @@ struct Context {
     return i;
   }
 
+  Result<void> add_global(const Value& name, const Value& value) {
+    globals_dict = TRY(globals_dict.insert(name, value));
+    return Result<void>();
+  }
+
   Value env;
   Array constants;
   Dict constants_dict;
   Dict variables_dict;
   Array closures;
   Dict closures_dict;
+  Dict globals_dict;
   uint64_t maxreg;
   Context* parent;
   bool toplevel;
@@ -161,7 +172,10 @@ Result<Value> Compiler::compile(Value& expr) {
 
   auto fun = TRY(Function::create(name, 0, context.constants, ex.code,
                                   TRY(Array::create())));
-  return Value(std::move(fun));
+
+  auto mod = TRY(Module::create(name, fun, context.globals_dict));
+
+  return Value(std::move(mod));
 }
 
 Result<Expression> Compiler::compile_expr(Context& context, Value& expr) {
@@ -183,6 +197,7 @@ Result<Expression> Compiler::compile_expr(Context& context, Value& expr) {
     case Tag::Dict:
     case Tag::Opcode:
     case Tag::Function:
+    case Tag::Module:
     case Tag::Stack:
       return ERROR(TypeMismatch);
   }
@@ -462,11 +477,16 @@ Result<Expression> Compiler::compile_fn(Context& context, Symbol& op,
 
   // std::cout << "--------------- LAMBDA " << arity << "\n";
   // TRY(debug_print(TRY(expr.copy_value())));
+  // TRY(debug_print(TRY(ctx.constants.copy())));
   // TRY(debug_print(TRY(ex.code.copy())));
 
   Expression ex_res = TRY(Expression::create());
 
   if (ctx.closures.size() == 0) {
+    if (context.toplevel && !name.is<Nil>()) {
+      context.add_global(name, TRY(fun.copy_value()));
+    }
+
     int64_t c = TRY(context.add_const(TRY(fun.copy_value())));
 
     uint64_t reg = context.alloc_reg();
@@ -615,10 +635,7 @@ Result<Expression> Compiler::compile_symbol(Context& context, Symbol& value) {
 
   auto maybe_closure = context.get_closure(TRY(value.copy_value()));
 
-  if (maybe_closure.has_error()) {
+  if (!maybe_closure.has_error()) {
-    return ERROR(CompilationError);
-  }
-
     auto var_closure = maybe_closure.value();
 
     uint64_t reg = context.alloc_reg();
@@ -629,6 +646,18 @@ Result<Expression> Compiler::compile_symbol(Context& context, Symbol& value) {
     return std::move(ex);
   }
 
+  // Otherwise treat unknown symbol as a global and try to load it from the
+  // global scope
+
+  int64_t c = TRY(context.add_const(TRY(value.copy_value())));
+
+  uint64_t reg = context.alloc_reg();
+  TRY(ex.add_opcode(Oc::GlobalLoad, {0, (int64_t)reg}, {1, (int64_t)c}));
+
+  ex.reg = reg;
+  return std::move(ex);
+}
+
 Result<Expression> Compiler::compile_bool(Context& context, Bool& value) {
   Expression ex = TRY(Expression::create());
   uint64_t reg = context.alloc_reg();

src/opcode.cpp

@@ -75,10 +75,9 @@ op_t get_op(Oc op) {
       return op_t{"make-dict", OpcodeType::Reg1};
     case Oc::SetJump:
       return op_t{"setjump", OpcodeType::Reg1I};
-    case Oc::SetGlobal:
       return op_t{"setglobal", OpcodeType::Reg2};
-    case Oc::GetGlobal:
+    case Oc::GlobalLoad:
-      return op_t{"getglobal", OpcodeType::Reg2};
+      return op_t{"global-load", OpcodeType::Reg2};
     case Oc::MakeClosure:
       return op_t{"make-closure", OpcodeType::Reg2};
     case Oc::ClosureLoad:

src/opcode.hpp

@@ -59,8 +59,7 @@ enum class Oc : uint8_t {
   MakeDict,
   SetJump,
   // Globals
-  SetGlobal,
+  GlobalLoad,
-  GetGlobal,
   // Closures
   MakeClosure,
   ClosureLoad,

src/pod.hpp

@@ -20,6 +20,7 @@ enum class Tag : uint8_t {
   Dict,
   Opcode,
   Function,
+  Module,
   Stack,
 };
 
@@ -168,6 +169,15 @@ class PodFunction final : public PodObject {
   OffPtr<PodObject> closure;
 };
 
+class PodModule final : public PodObject {
+ public:
+  PodModule() : PodObject(Tag::Module) {};
+
+  OffPtr<PodObject> name;
+  OffPtr<PodObject> fun;
+  OffPtr<PodObject> globals;
+};
+
 class PodStack final : public PodObject {
  public:
   PodStack() : PodObject(Tag::Stack) {};

src/vli.cpp

@@ -34,14 +34,13 @@ Result<void> run(int argc, const char* argv[]) {
   TRY(debug_print(code_str_written));
 
   auto compiled = TRY(compile(parsed));
-  Function& fun = *compiled.to<Function>();
+  Module& mod = *compiled.to<Module>();
 
-  TRY(debug_print(TRY(fun.constants())));
+  TRY(debug_print(TRY(mod.globals())));
-  TRY(debug_print(TRY(fun.code())));
 
   auto vm = TRY(VM::create());
 
-  auto res = TRY(vm.run(fun));
+  auto res = TRY(vm.run(mod));
 
   TRY(debug_print(res));
 

src/vm.cpp

@@ -1,5 +1,7 @@
 #include "vm.hpp"
 
+#include "common.hpp"
+
 Result<Value> VM::getreg(uint64_t idx) { return _stack.get(_base + idx); }
 
 Result<void> VM::setreg(uint64_t idx, const Value& value) {
@@ -124,7 +126,7 @@ Result<void> VM::vm_call(Opcode& oc) {
   _closure = TRY(fun.closure());
   _fun = std::move(fun);
   _pc = 0;
-  _base = reg_start;
+  _base = _base + reg_start;
 
   return Result<void>();
 }
@@ -190,6 +192,15 @@ Result<void> VM::vm_closure_load(Opcode& oc) {
   return Result<void>();
 }
 
+Result<void> VM::vm_global_load(Opcode& oc) {
+  uint64_t acc = (uint64_t)oc.arg1().arg;
+  Value sym = TRY(get(oc.arg2().is_const, (uint64_t)oc.arg2().arg));
+  Value val = TRY(_globals.get(sym));
+  setreg(acc, val);
+  _pc++;
+  return Result<void>();
+}
+
 Result<void> VM::step() {
   auto opcode = TRY(_code.get(_pc));
   if (!opcode.is<Opcode>()) return ERROR(TypeMismatch);
@@ -237,6 +248,9 @@ Result<void> VM::step() {
     case Oc::ClosureLoad:
       TRY(vm_closure_load(oc));
       break;
+    case Oc::GlobalLoad:
+      TRY(vm_global_load(oc));
+      break;
     default:
       return ERROR(NotImplemented);
   }
@@ -246,13 +260,14 @@ Result<void> VM::step() {
 
 // Result<Value> Int64::copy() const { return Value(Int64(TRY(_value.copy())));
 // }
-Result<Value> VM::run(const Function& fun) {
+Result<Value> VM::run(const Module& mod) {
-  _fun = TRY(fun.copy());
+  _fun = TRY(mod.fun());
   _pc = 0;
   _base = 0;
-  _code = TRY(fun.code());
+  _code = TRY(_fun.code());
-  _constants = TRY(fun.constants());
+  _constants = TRY(_fun.constants());
-  _closure = TRY(fun.closure());
+  _closure = TRY(_fun.closure());
+  _globals = TRY(mod.globals());
 
   while (true) {
     auto rc = step();

src/vm.hpp

@@ -17,7 +17,7 @@ class VM {
     return VM(std::move(stack), std::move(callstack));
   }
 
-  Result<Value> run(const Function& fun);
+  Result<Value> run(const Module& mod);
 
   Result<void> step();
   Result<void> vm_mov(Opcode& oc);
@@ -36,6 +36,8 @@ class VM {
   Result<void> vm_make_closure(Opcode& oc);
   Result<void> vm_closure_load(Opcode& oc);
 
+  Result<void> vm_global_load(Opcode& oc);
+
   Result<Value> get(bool is_const, uint64_t idx);
   Result<Value> getconst(uint64_t idx);
   Result<Value> getreg(uint64_t idx);
@@ -48,6 +50,7 @@ class VM {
   Array _code;
   Array _constants;
   Array _closure;
+  Dict _globals;
   uint64_t _pc;
   uint64_t _base;
   Value _res;

src/writer.cpp

@@ -31,6 +31,8 @@ Result<String> Writer::write_one(const Value& obj) {
       return write_opcode(*obj.to<Opcode>());
     case Tag::Function:
       return write_function(*obj.to<Function>());
+    case Tag::Module:
+      return write_module(*obj.to<Module>());
     case Tag::Stack:
       return write_stack(*obj.to<Stack>());
   };
@@ -64,7 +66,7 @@ Result<String> Writer::write_multiple(const Value& val) {
 
 Result<String> Writer::write_int64(const Int64& val) {
   char tmp[32];
-  sprintf(tmp, "%lu", val.value());
+  sprintf(tmp, "%ld", val.value());
   size_t len = strlen(tmp);
 
   return String::create(tmp);
@@ -318,6 +320,21 @@ Result<String> Writer::write_function(const Function& val) {
   return res;
 }
 
+Result<String> Writer::write_module(const Module& val) {
+  auto name = TRY(val.name());
+  if (name.is<Nil>()) {
+    return TRY(String::create("#<module>"));
+  }
+
+  if (!name.is<Symbol>()) return ERROR(TypeMismatch);
+  String name_str = TRY(write_symbol(*name.to<Symbol>()));
+
+  String res = TRY(String::create("#<module "));
+  res = TRY(res.concat(name_str));
+  res = TRY(res.concat(">"));
+  return res;
+}
+
 Result<String> Writer::write_stack(const Stack& val) {
   return TRY(String::create("#<stack>"));
 }

src/writer.hpp

@@ -24,6 +24,7 @@ class Writer {
   Result<String> write_syntax(const Syntax& val);
   Result<String> write_opcode(const Opcode& val);
   Result<String> write_function(const Function& val);
+  Result<String> write_module(const Module& val);
   Result<String> write_stack(const Stack& val);
 };