864 lines
28 KiB
C++
864 lines
28 KiB
C++
/** @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<GlobalEnv> env,
|
|
log_level ll) :
|
|
object_mm_{mm},
|
|
toplevel_env_{env},
|
|
log_level_{ll}
|
|
{
|
|
}
|
|
|
|
// ----- VirtualSchematikaMachine -----
|
|
|
|
VirtualSchematikaMachine::VirtualSchematikaMachine(gc::IAlloc * mm,
|
|
gp<GlobalEnv> 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<gp<Object>,
|
|
SchematikaError>
|
|
VirtualSchematikaMachine::toplevel_eval(bp<Expression> expr)
|
|
{
|
|
return this->eval(expr, this->env_);
|
|
}
|
|
|
|
std::pair<gp<Object>,
|
|
SchematikaError>
|
|
VirtualSchematikaMachine::eval(bp<Expression> expr, gp<GlobalEnv> 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<ConstantInterface> 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
|
|
*
|
|
* generally conversion for a type Foo will appear in Foo.hpp
|
|
* see
|
|
* xo/object/Boolean.hpp
|
|
* xo/object/Integer.hpp
|
|
* xo/object/Float.hpp
|
|
* xo/object/String.hpp
|
|
*/
|
|
|
|
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<PrimitiveExprInterface> expr = PrimitiveExprInterface::from(expr_);
|
|
|
|
const gp<Object> * 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<DefineExpr> 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<Expression> -> gp<ExpressionBoxed> **/
|
|
gp<ExpressionBoxed> 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<AssignExpr> 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<Object> * slot = env_->lookup_slot(assign->lhs()->name());
|
|
|
|
if (slot) {
|
|
/** must promote rp<Expression> -> gp<ExpressionBoxed> **/
|
|
gp<ExpressionBoxed> 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<VsmStackFrame> sp0 = this->stack_;
|
|
|
|
bp<Variable> var = Variable::from(ExpressionBoxed::from((*sp0)[0])->contents());
|
|
|
|
assert(var.get());
|
|
|
|
gp<Object> * 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<Variable> var = Variable::from(expr_);
|
|
|
|
assert(var.get());
|
|
assert(env_.get());
|
|
|
|
const gp<Object> * 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<IfExpr> -> gp<ExpressionBoxed> **/
|
|
gp<ExpressionBoxed> ifexpr_boxed = ExpressionBoxed::make(mm, expr_);
|
|
bp<IfExpr> 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<Boolean> test_value = gp<Boolean>::from(value_);
|
|
|
|
if (test_value.get()) {
|
|
gp<VsmStackFrame> sp0 = this->stack_;
|
|
|
|
bp<IfExpr> 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<bool>::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<Sequence> -> gp<ExpressionBoxed> **/
|
|
gp<ExpressionBoxed> seq_boxed = ExpressionBoxed::make(mm, expr_);
|
|
bp<Sequence> 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<bool>::make(false);
|
|
} else {
|
|
this->expr_ = (*seq)[0];
|
|
}
|
|
|
|
if (seq->size() > 1) {
|
|
/* remainder */
|
|
|
|
gp<Integer> 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<VsmStackFrame> sp0 = this->stack_;
|
|
|
|
assert(sp0->size() == 2);
|
|
|
|
bp<Sequence> seq = Sequence::from(ExpressionBoxed::from((*sp0)[0])->contents());
|
|
gp<Integer> 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<Apply> -> gp<ExpressionBoxed> **/
|
|
gp<ExpressionBoxed> apply_boxed = ExpressionBoxed::make(mm, expr_);
|
|
bp<Apply> apply = Apply::from(expr_);
|
|
|
|
assert(apply.get());
|
|
|
|
size_t n = apply->n_arg() + 1;
|
|
|
|
/* reminder: argument 0 refers to the function being called */
|
|
gp<Integer> targetarg = Integer::make(mm, 0);
|
|
|
|
/* outer frame */
|
|
gp<VsmStackFrame> argstack = VsmStackFrame::make(mm, stack_, n, cont_);
|
|
|
|
/* scratch frame during call sequence.
|
|
* probably collect->cont_ will not be used?
|
|
*/
|
|
gp<VsmStackFrame> 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<VsmStackFrame> sp0 = this->stack_;
|
|
|
|
assert(sp0.get());
|
|
assert(sp0->size() == 2);
|
|
|
|
bp<Apply> apply = Apply::from(ExpressionBoxed::from((*sp0)[0])->contents());
|
|
assert(apply.get());
|
|
gp<Integer> 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<VsmStackFrame> 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<Expression> 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<VsmStackFrame> sp0 = stack_;
|
|
|
|
assert(sp0->size() > 0);
|
|
|
|
gp<Procedure> 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<Object> 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 */
|