/** @file VirtualSchematikaMachine.cpp **/ #include "VirtualSchematikaMachine.hpp" #include "VsmInstr.hpp" #include "BuiltinPrimitives.hpp" #include "ExpressionBoxed.hpp" #include "xo/expression/Constant.hpp" #include "xo/expression/PrimitiveExprInterface.hpp" #include "xo/expression/DefineExpr.hpp" #include "xo/expression/AssignExpr.hpp" #include "xo/expression/Variable.hpp" #include "xo/expression/IfExpr.hpp" #include "xo/expression/Sequence.hpp" #include "xo/expression/Apply.hpp" #include "xo/object/Procedure.hpp" #include "xo/object/Primitive.hpp" #include "xo/object/Integer.hpp" #include "xo/object/Boolean.hpp" #include "xo/alloc/GC.hpp" /** continue after completing a VSM instruction; * achieve by jumping to continuation. **/ #define VSM_CONTINUE() this->pc_ = this->cont_; return; /** report error and terminate VSM execution **/ #define VSM_ERROR(msg) report_error(msg); return; namespace xo { using xo::gc::GC; using xo::obj::Procedure; using xo::obj::Integer; using xo::obj::Boolean; namespace scm { struct VsmOps { /** halt virtual scheme machine. * This will cause innermost run() to return to its caller **/ static VsmInstr halt_op; /** evaluate an expression. * - opcode is Opcode::eval * - expression in register @ref expr_ **/ static VsmInstr eval_op; /** assign variable after evaluating rhs of a define-expression or assign-expression * - opcode is Opcode::complete_assign * - top stack frame contains {lhs, cont} **/ static VsmInstr complete_assign_op; /** choose branch of if-expr after evaluating test condition. * - opcode is Opcode::complete_ifexpr * - top stack frame contains {ifexpr, cont} **/ static VsmInstr complete_ifexpr_op; /** proceed to next element of sequence-expr. * - opcode is Opcode::complete_sequence * - top stack frame contains {seq, next, cont} */ static VsmInstr complete_sequence_op; /** proceed to next argument in apply-expr * - opcode is Opcode::eval_collect_args * - top stack frame contains {apply, targetarg, cont} */ static VsmInstr complete_evalargs_op; /** call a procedure, where evaluated arguments (including target function) * are in top stack frame. * - opcode is Opcode::apply * - top stack frame contains evaluated arguments. **/ static VsmInstr apply_op; }; VsmInstr VsmOps::halt_op{VsmInstr::Opcode::halt, "halt"}; VsmInstr VsmOps::eval_op{VsmInstr::Opcode::eval, "eval"}; VsmInstr VsmOps::complete_assign_op{VsmInstr::Opcode::complete_assign, "complete-assign"}; VsmInstr VsmOps::complete_ifexpr_op{VsmInstr::Opcode::complete_ifexpr, "complete-ifexpr"}; VsmInstr VsmOps::complete_sequence_op{VsmInstr::Opcode::complete_sequence, "complete-sequence"}; VsmInstr VsmOps::complete_evalargs_op{VsmInstr::Opcode::complete_evalargs, "complete-evalargs"}; VsmInstr VsmOps::apply_op{VsmInstr::Opcode::apply, "apply"}; // ----- VirtualSchematikaMachineFlyweight ----- VirtualSchematikaMachineFlyweight::VirtualSchematikaMachineFlyweight(gc::IAlloc * mm, gp env, log_level ll) : object_mm_{mm}, toplevel_env_{env}, log_level_{ll} { BuiltinPrimitives::install_interpreter_conversions(&object_converter_); } // ----- VirtualSchematikaMachine ----- VirtualSchematikaMachine::VirtualSchematikaMachine(gc::IAlloc * mm, gp env, log_level ll) : flyweight_{mm, env, ll} { scope log(XO_DEBUG(true), xtag("env", env), xtag("symtab", env->symtab())); this->env_ = env; // gc roots gc::GC * gc = GC::from(mm); if (gc) { assert((gc->gc_in_progress() == false) && "cannot add roots while GC running"); gc->add_gc_root_dwim(&env_); gc->add_gc_root_dwim(&value_); } else { // Want to support VSM with arena-allocator-only; // if only for unit testing. } // TODO: install builtin primitives here } VirtualSchematikaMachine::~VirtualSchematikaMachine() { gc::GC * gc = GC::from(flyweight_.object_mm_); if (gc) { assert((gc->gc_in_progress() == false) && "cannot remove roots while GC running"); gc->remove_gc_root_dwim(&env_); gc->remove_gc_root_dwim(&value_); } else { // nothing to do in arena-only mode } } std::pair, SchematikaError> VirtualSchematikaMachine::toplevel_eval(bp expr) { return this->eval(expr, this->env_); } std::pair, SchematikaError> VirtualSchematikaMachine::eval(bp expr, gp env) { scope log(XO_DEBUG(true), xtag("env", env), xtag("symtab", env->symtab())); this->pc_ = &VsmOps::eval_op; this->expr_ = expr.promote(); this->env_ = env; this->stack_ = nullptr; this->value_ = nullptr; this->error_ = SchematikaError(); this->cont_ = &VsmOps::halt_op; this->run(); return std::make_pair(this->value_, this->error_); } void VirtualSchematikaMachine::run() { while(pc_) this->execute_one(); } void VirtualSchematikaMachine::execute_one() { scope log(XO_DEBUG(true)); log && log("stack", stack_); using Opcode = VsmInstr::Opcode; switch (pc_->opcode()) { case Opcode::halt: { this->pc_ = nullptr; this->cont_ = nullptr; break; } case Opcode::eval: { log && log("Opcode::eval"); /* generally speaking: opcode will be 1:1 with extypes */ switch (expr_->extype()) { case exprtype::constant: log && log("eval -> constant"); this->eval_constant_op(); break; case exprtype::primitive: log && log("eval -> primitive"); this->eval_primitive_op(); break; case exprtype::define: log && log("eval -> define"); this->eval_define_op(); break; case exprtype::assign: log && log("eval -> assign"); this->eval_assign_op(); break; case exprtype::variable: log && log("eval -> variable"); this->eval_variable_op(); break; case exprtype::ifexpr: log && log("eval -> ifexpr"); this->eval_ifexpr_op(); break; case exprtype::sequence: log && log("eval -> sequence"); this->eval_sequence_op(); break; case exprtype::apply: log && log("eval -> apply"); this->eval_apply_op(); break; case exprtype::invalid: case exprtype::lambda: case exprtype::convert: case exprtype::n_expr: this->pc_ = nullptr; this->value_ = nullptr; this->error_ = SchematikaError(tostr("execute_vsm: not implemented", xtag("extype", expr_->extype()))); this->cont_ = nullptr; break; } } break; case Opcode::complete_assign: this->do_complete_assign_op(); break; case Opcode::complete_ifexpr: this->do_complete_ifexpr_op(); break; case Opcode::complete_sequence: this->do_complete_sequence_op(); break; case Opcode::complete_evalargs: this->do_complete_evalargs_op(); break; case Opcode::apply: this->apply_op(); break; case Opcode::N_Opcode: assert(false); break; } } void VirtualSchematikaMachine::report_error(const std::string & err) { /* error short-circuits vsm operation */ this->pc_ = nullptr; this->value_ = nullptr; this->error_ = SchematikaError(err); this->cont_ = nullptr; } void VirtualSchematikaMachine::eval_constant_op() { using xo::scm::ConstantInterface; scope log(XO_DEBUG(true)); bp expr = ConstantInterface::from(expr_); assert(expr); this->value_ = flyweight_.object_converter_.tp_to_object(flyweight_.object_mm_, expr->value_tp(), false); if (this->value_.ptr()) { log && log("got object: ", xtag("value", value_)); VSM_CONTINUE(); } else { /* see ObjectConverter::ctor to add more builtin types */ VSM_ERROR(tostr("constant_op: unable to convert native value to object", xtag("id", expr->value_tp().td()->id()), xtag("short_name", expr->value_tp().td()->short_name()))); } } void VirtualSchematikaMachine::eval_primitive_op() { using xo::obj::Primitive; using xo::reflect::TaggedPtr; scope log(XO_DEBUG(true)); bp expr = PrimitiveExprInterface::from(expr_); const gp * slot = env_->lookup_slot(expr->name()); if (slot) { this->value_ = *slot; this->pc_ = cont_; } else { std::string err = tostr("no binding for primitive", xtag("name", expr->name())); this->value_ = nullptr; this->error_ = SchematikaError(err); /* note: poor man's exception */ this->pc_ = nullptr; this->cont_ = nullptr; } } void VirtualSchematikaMachine::eval_define_op() { using xo::scm::DefineExpr; scope log(XO_DEBUG(true)); auto mm = flyweight_.object_mm_; bp expr = DefineExpr::from(expr_); assert(expr); assert(env_.get()); // note: expecting nested define to have expanded iteself into // applying a lambda // note: establish lhs_var first, to allow for recursion, for example: // def fact(n: i64) { if (n == 0) then 1; else n * fact(n-1); } /** remembers promised variable type **/ this->env_->establish_var(expr->lhs_variable()); /** must promote rp -> gp **/ gp lhs_0 = ExpressionBoxed::make(mm, expr->lhs_variable()); this->pc_ = &VsmOps::eval_op; this->expr_ = expr->rhs(); /* when control arrives at .cont_, will have: * .value_ -> result of evaluating expr->rhs() */ this->stack_ = VsmStackFrame::push1(mm, this->stack_, lhs_0, cont_); /* .stack_: * frame * [0] = lhs_0 (boxed lhs Variable) * .. */ this->cont_ = &VsmOps::complete_assign_op; } void VirtualSchematikaMachine::eval_assign_op() { using xo::scm::AssignExpr; scope log(XO_DEBUG(true)); auto mm = flyweight_.object_mm_; bp assign = AssignExpr::from(expr_); assert(assign.get()); assert(env_.get()); assert(assign->lhs().get()); assert(assign->rhs().get()); /* verify slot exists, before we evaluate rhs */ gp * slot = env_->lookup_slot(assign->lhs()->name()); if (slot) { /** must promote rp -> gp **/ gp lhs = ExpressionBoxed::make(mm, assign->lhs()); this->pc_ = &VsmOps::eval_op; this->expr_ = assign->rhs(); /* when control arrives at .cont_, will have: * .value_ -> result of evaluating assign->rhs() */ this->stack_ = VsmStackFrame::push1(mm, this->stack_, lhs, cont_); /* .stack_: * frame * [0] = lhs (boxed lhs Variable) * .. */ this->cont_ = &VsmOps::complete_assign_op; } else { std::string err = tostr("no binding for lhs of assignment", xtag("name", assign->lhs()->name())); this->value_ = nullptr; this->error_ = SchematikaError(err); /* note: poor man's exception */ this->pc_ = nullptr; this->cont_ = nullptr; } } void VirtualSchematikaMachine::do_complete_assign_op() { scope log(XO_DEBUG(true)); /* * - value: contains result of evaluating rhs of define * - stack: top frame has 1 slot, holds variable to receive assignment */ assert(value_.get()); assert(stack_.get()); assert(env_.get()); gp sp0 = this->stack_; bp var = Variable::from(ExpressionBoxed::from((*sp0)[0])->contents()); assert(var.get()); gp * slot = this->env_->establish_var(var); assert(slot); *slot = this->value_; //this->value_ = this->value_; // preserve value from rhs of defexpr this->stack_ = sp0->parent(); this->pc_ = this->cont_ = sp0->continuation(); } void VirtualSchematikaMachine::eval_variable_op() { using xo::scm::Variable; scope log(XO_DEBUG(true)); bp var = Variable::from(expr_); assert(var.get()); assert(env_.get()); const gp * slot = env_->lookup_slot(var->name()); if (slot) { this->value_ = *slot; this->pc_ = cont_; } else { /* Unknown variable error will often be recognized in expression parser, * in such cases this path won't be used. * * In interactive environment will need some kind of support for modifying * code (e.g. replacing top-level functions/variables), and in particular, * replacements may have different type signature. * It's possible that allowing for such replacements winds up giving up * typesafety guarantees. In that case this path may get activated after * all. */ std::string err = tostr("no binding for variable", xtag("name", var->name())); this->value_ = nullptr; this->error_ = SchematikaError(err); /* note: poor man's exception */ this->pc_ = nullptr; this->cont_ = nullptr; } } void VirtualSchematikaMachine::eval_ifexpr_op() { using xo::scm::IfExpr; scope log(XO_DEBUG(true)); gc::IAlloc * mm = flyweight_.object_mm_; /** must promote bp -> gp **/ gp ifexpr_boxed = ExpressionBoxed::make(mm, expr_); bp ifexpr = IfExpr::from(expr_); assert(ifexpr.get()); assert(env_.get()); this->pc_ = &VsmOps::eval_op; this->expr_ = ifexpr->test(); /* when control arrives at .cont_ will have: * .value_ -> result of evaluating ifexpr->test() */ this->stack_ = VsmStackFrame::push1(mm, this->stack_, ifexpr_boxed, cont_); /* .stack_: * frame * [0] = ifexpr (boxed expression) */ this->cont_ = &VsmOps::complete_ifexpr_op; } void VirtualSchematikaMachine::do_complete_ifexpr_op() { using xo::scm::IfExpr; scope log(XO_DEBUG(true)); /* * - value: contains result of evaluating test condition of if-expr * - stack: top frame has 1 slot, holds (boxed) if-expr itself */ assert(value_.get()); assert(stack_.get()); assert(env_.get()); gp test_value = gp::from(value_); if (test_value.get()) { gp sp0 = this->stack_; bp ifexpr = IfExpr::from(ExpressionBoxed::from((*sp0)[0])->contents()); assert(ifexpr.get()); this->pc_ = &VsmOps::eval_op; if (test_value->value()) { this->expr_ = ifexpr->when_true(); } else { if (ifexpr->when_false()) { this->expr_ = ifexpr->when_false(); } else { /* 1-sided if-expr; evaluate to false */ this->expr_ = Constant::make(false); } } this->stack_ = sp0->parent(); this->cont_ = sp0->continuation(); } else { std::string err = tostr("expect boolean value for result of if-expr test", xtag("value", test_value)); this->value_ = nullptr; this->error_ = SchematikaError(err); /* note: poor man's exception */ this->pc_ = nullptr; this->cont_ = nullptr; } } void VirtualSchematikaMachine::eval_sequence_op() { using xo::scm::Sequence; scope log(XO_DEBUG(true)); gc::IAlloc * mm = flyweight_.object_mm_; /** must promote bp -> gp **/ gp seq_boxed = ExpressionBoxed::make(mm, expr_); bp seq = Sequence::from(expr_); assert(seq.get()); assert(env_.get()); this->pc_ = &VsmOps::eval_op; if (seq->size() == 0) { /* for 0-size sequence, invent an expression */ this->expr_ = Constant::make(false); } else { this->expr_ = (*seq)[0]; } if (seq->size() > 1) { /* remainder */ gp next = Integer::make(mm, 1); /* when control arrives at .cont_ will have: * .value_ -> result of evaluating last expr in seq */ this->stack_ = VsmStackFrame::push2(mm, stack_, seq_boxed, next, cont_); /* .stack_: * frame * [0] = seq (boxed sequence) * [1] = next (index of next seq member to evaluate) * .. */ this->cont_ = &VsmOps::complete_sequence_op; } else { /* sequence completes when expr_ evaluated * -> proceed with o.g. cont_ */ } } void VirtualSchematikaMachine::do_complete_sequence_op() { using xo::scm::Sequence; scope log(XO_DEBUG(true)); /* - stack: top frame has 2 slots: * [0] : seq (boxed Sequence) * [1] : next (index of next seq element to eval */ assert(value_.get()); assert(stack_.get()); gp sp0 = this->stack_; assert(sp0->size() == 2); bp seq = Sequence::from(ExpressionBoxed::from((*sp0)[0])->contents()); gp next_obj = Integer::from((*sp0)[1]); size_t i_next = next_obj->value(); assert(i_next < seq->size()); this->pc_ = &VsmOps::eval_op; this->expr_ = (*seq)[i_next]; if (i_next + 1 == seq->size()) { /* last member of sequence -> tail call optimization */ this->stack_ = sp0->parent(); this->cont_ = sp0->continuation(); } else { /* we can modify next_obj in place, * since it's unique to frame sp0 */ next_obj->assign_value(i_next + 1); this->cont_ = &VsmOps::complete_sequence_op; } } void VirtualSchematikaMachine::eval_apply_op() { /* strategy: * 1. calling sequence will involve two stack frames. * 1a. the outer frame will hold 'final evaluated arguments' * to the called function. When control transfers to that * function, this frame will be at the top of stack_ * 1b. innert frame will be used by eval_apply_op() and * helper do_eval_collect_args() to evaluate function * arguments, and populate the outer frame. */ using xo::scm::Apply; scope log(XO_DEBUG(true)); gc::IAlloc * mm = flyweight_.object_mm_; /** must promote bp -> gp **/ gp apply_boxed = ExpressionBoxed::make(mm, expr_); bp apply = Apply::from(expr_); assert(apply.get()); size_t n = apply->n_arg() + 1; /* reminder: argument 0 refers to the function being called */ gp targetarg = Integer::make(mm, 0); /* outer frame */ gp argstack = VsmStackFrame::make(mm, stack_, n, cont_); /* scratch frame during call sequence. * probably collect->cont_ will not be used? */ gp collect = VsmStackFrame::push2(mm, argstack, apply_boxed, targetarg, &VsmOps::complete_evalargs_op); this->pc_ = &VsmOps::eval_op; this->expr_ = apply->fn(); this->stack_ = collect; this->cont_ = &VsmOps::complete_evalargs_op; } void VirtualSchematikaMachine::do_complete_evalargs_op() { using xo::scm::Apply; scope log(XO_DEBUG(true)); /* - stack: top frame has 2 slots * [0] : apply (boxed Apply) * [1] : targetarg index of next evaluated argument to deliver. * (to corresponding slot in 2nd frame) * - 2nd frame has n slots, where n = #of arguments at this site * [0] : actual #0 * .. * [targetarg-1] : actual #{targetarg-1} */ assert(value_.get()); assert(stack_.get()); gp sp0 = this->stack_; assert(sp0.get()); assert(sp0->size() == 2); bp apply = Apply::from(ExpressionBoxed::from((*sp0)[0])->contents()); assert(apply.get()); gp targetarg_obj = Integer::from((*stack_)[1]); size_t targetarg = targetarg_obj->value(); /* note: apply->n_arg() doesn't count function itself */ assert(targetarg < apply->n_arg() + 1); gp argstack = sp0->parent(); assert(argstack.get()); /* storing actual parameter in its correct position in call stackframe */ (*argstack)[targetarg] = value_; ++targetarg; if (targetarg < apply->n_arg() + 1) { /* * arguments 0 .. #targetarg-1 already present in argstack * arguments #targetarg .. #n still need to be evaluated */ /* ok to update in place, since Integer in sp0 is unique */ targetarg_obj->assign_value(targetarg); rp targetexpr = apply->lookup_arg(targetarg - 1); this->pc_ = &VsmOps::eval_op; this->expr_ = targetexpr; assert(this->stack_.get() == sp0.get()); this->cont_ = &VsmOps::complete_evalargs_op; } else { /* all args evaluated: proceed to invoke evaluated function */ this->pc_ = &VsmOps::apply_op; this->expr_ = nullptr; this->stack_ = argstack; /* unnecessary - will actually be set by apply_op() */ this->cont_ = argstack->continuation(); } } void VirtualSchematikaMachine::apply_op() { scope log(XO_DEBUG(true)); auto mm = flyweight_.object_mm_; // NOTE: Closures will have special handling. // Could alternatively forward the whole problem // (along with VSM state) to procedure implementation /* stack: top frame has n slots for procedure with n canonical args */ gp sp0 = stack_; assert(sp0->size() > 0); gp fn = Procedure::from((*sp0)[0]); if (fn->n_args() + 1 != sp0->size()) { throw std::runtime_error(tostr("VirtualSchematikaMachine::apply_op:" " argument mismatch in apply" ": k arguments supplied where n expected", xtag("k", sp0->size() - 1), xtag("n", fn->n_args()))); } /* todo: * check function signature? * should have been guaranteed by expression parser, * but complications in interactive session when variables redefined. */ gp retval = fn->apply_nocheck(mm, sp0->argv()); this->pc_ = this->cont_; this->stack_ = sp0->parent(); this->value_ = retval; } } /*namespace scm*/ } /*namespace xo*/ /* end VirtualSchematikaMachine.cpp */