diff --git a/src/vm.c b/src/vm.c index 5c06b30f..448a76d2 100644 --- a/src/vm.c +++ b/src/vm.c @@ -6,6 +6,8 @@ enum pic_instruction { OP_PUSHNIL, OP_PUSHI, OP_PUSHUNDEF, + OP_GREF, + OP_GSET, OP_CONS, OP_ADD, OP_STOP @@ -15,6 +17,7 @@ struct pic_code { enum pic_instruction insn; union { int i; + struct pic_pair *gvar; } u; }; @@ -23,24 +26,94 @@ struct pic_irep { size_t clen, ccapa; }; +static pic_value +pic_assq(pic_state *pic, pic_value key, pic_value assoc) +{ + pic_value cell; + + enter: + + if (pic_nil_p(assoc)) + return assoc; + + cell = pic_car(pic, assoc); + if (pic_eq_p(pic, key, pic_car(pic, cell))) + return cell; + + assoc = pic_cdr(pic, assoc); + goto enter; +} + +static struct pic_pair * +pic_env_lookup(pic_state *pic, pic_value sym, struct pic_env *env) +{ + pic_value v; + + enter: + + v = pic_assq(pic, sym, env->assoc); + if (! pic_nil_p(v)) { + return pic_pair_ptr(v); + } + if (env->parent) { + env = env->parent; + goto enter; + } + + return NULL; +} + +static struct pic_pair * +pic_env_define(pic_state *pic, pic_value sym, struct pic_env *env) +{ + pic_value cell; + + cell = pic_cons(pic, sym, pic_undef_value()); + env->assoc = pic_cons(pic, cell, env->assoc); + + return pic_pair_ptr(cell); +} + static void pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env) { - pic_value sCONS, sADD; + pic_value sDEFINE, sCONS, sADD; + sDEFINE = pic_intern_cstr(pic, "define"); sCONS = pic_intern_cstr(pic, "cons"); sADD = pic_intern_cstr(pic, "add"); switch (pic_type(obj)) { case PIC_TT_SYMBOL: { - /* not implemented */ + struct pic_pair *gvar; + + gvar = pic_env_lookup(pic, obj, env); + if (! gvar) { + pic_raise(pic, "unbound variable"); + } + irep->code[irep->clen].insn = OP_GREF; + irep->code[irep->clen].u.gvar = gvar; + irep->clen++; break; } case PIC_TT_PAIR: { pic_value proc; proc = pic_car(pic, obj); - if (pic_eq_p(pic, proc, sCONS)) { + if (pic_eq_p(pic, proc, sDEFINE)) { + struct pic_pair *gvar; + + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); + + gvar = pic_env_define(pic, pic_car(pic, pic_cdr(pic, obj)), env); + irep->code[irep->clen].insn = OP_GSET; + irep->code[irep->clen].u.gvar = gvar; + irep->clen++; + irep->code[irep->clen].insn = OP_PUSHUNDEF; + irep->clen++; + break; + } + else if (pic_eq_p(pic, proc, sCONS)) { /* generate args in reverse order*/ pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); @@ -119,6 +192,14 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) *++sp = pic_undef_value(); break; } + case OP_GREF: { + *++sp = pc->u.gvar->cdr; + break; + } + case OP_GSET: { + pc->u.gvar->cdr = *sp--; + break; + } case OP_CONS: { pic_value a, b; a = *sp--;