diff --git a/include/picrin.h b/include/picrin.h index 7f9015e4..be785106 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -11,6 +11,12 @@ struct pic_env { struct pic_env *parent; }; +struct pic_proc { + union { + struct pic_irep *irep; + } u; +}; + typedef struct { pic_value *sp; pic_value *stbase, *stend; @@ -36,6 +42,8 @@ pic_value pic_intern_cstr(pic_state *, const char *); pic_value pic_parse(pic_state *, const char *); pic_value pic_eval(pic_state *, pic_value, struct pic_env *); +pic_value pic_run(pic_state *, struct pic_proc *, pic_value); +struct pic_proc *pic_codegen(pic_state *, pic_value, struct pic_env*); void pic_debug(pic_state *, pic_value); diff --git a/src/vm.c b/src/vm.c index 2617e686..51dabcc9 100644 --- a/src/vm.c +++ b/src/vm.c @@ -3,7 +3,9 @@ #include "picrin.h" enum pic_instruction { + OP_PUSHNIL, OP_PUSHI, + OP_CONS, OP_ADD, OP_STOP }; @@ -15,10 +17,9 @@ struct pic_code { } u; }; -struct pic_proc { - union { - struct pic_code *code; - } u; +struct pic_irep { + struct pic_code *code; + size_t clen, ccapa; }; pic_value @@ -27,15 +28,26 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) struct pic_code *pc; pic_value *sp; - pc = proc->u.code; + pc = proc->u.irep->code; sp = pic->sp; while (1) { switch (pc->insn) { + case OP_PUSHNIL: { + *++sp = pic_nil_value(); + break; + } case OP_PUSHI: { *++sp = pic_int_value(pc->u.i); break; } + case OP_CONS: { + pic_value a, b; + a = *sp--; + b = *sp--; + *++sp = pic_cons(pic, a, b); + break; + } case OP_ADD: { pic_value a, b; a = *sp--; @@ -53,6 +65,79 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) return *sp; } +void +pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env) +{ + pic_value sCONS, sADD; + + sCONS = pic_intern_cstr(pic, "cons"); + sADD = pic_intern_cstr(pic, "add"); + + switch (pic_type(obj)) { + case PIC_TT_SYMBOL: { + /* not implemented */ + break; + } + case PIC_TT_PAIR: { + pic_value proc; + + proc = pic_car(pic, obj); + 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); + irep->code[irep->clen].insn = OP_CONS; + irep->clen++; + break; + } + else if (pic_eq_p(pic, proc, sADD)) { + /* 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); + irep->code[irep->clen].insn = OP_ADD; + irep->clen++; + break; + } + else { + /* not implemented */ + break; + } + } + case PIC_TT_INT: { + irep->code[irep->clen].insn = OP_PUSHI; + irep->code[irep->clen].u.i = pic_int(obj); + irep->clen++; + break; + } + case PIC_TT_NIL: { + irep->code[irep->clen].insn = OP_PUSHNIL; + irep->clen++; + break; + } + } +} + +struct pic_proc * +pic_codegen(pic_state *pic, pic_value obj, struct pic_env *env) +{ + struct pic_proc *proc; + struct pic_irep *irep; + struct pic_code *code; + + proc = pic_alloc(pic, sizeof(struct pic_proc)); + + proc->u.irep = irep = (struct pic_irep *)malloc(sizeof(struct pic_irep)); + irep->code = code = (struct pic_code *)malloc(sizeof(struct pic_code) * 1024); + irep->clen = 0; + irep->ccapa = 1024; + + pic_gen(pic, irep, obj, env); + irep->code[irep->clen].insn = OP_STOP; + irep->clen++; + + return proc; +} + int main() {