add OP_LAMBDA (lambda object creation)

This commit is contained in:
Yuichi Nishiwaki 2013-10-16 11:32:30 +09:00
parent 19abedf746
commit c593a46a62
5 changed files with 77 additions and 8 deletions

View File

@ -16,10 +16,10 @@ typedef struct {
pic_value *sp;
pic_value *stbase, *stend;
pic_value sDEFINE, sCONS;
pic_callinfo *ci;
pic_callinfo *cibase, *ciend;
pic_value sDEFINE, sLAMBDA, sCONS;
pic_value sADD, sSUB, sMUL, sDIV;
struct pic_env *global_env;

View File

@ -8,6 +8,8 @@ enum pic_instruction {
OP_GREF,
OP_GSET,
OP_CALL,
OP_RET,
OP_LAMBDA,
OP_CONS,
OP_ADD,
OP_SUB,
@ -28,6 +30,9 @@ struct pic_code {
struct pic_irep {
struct pic_code *code;
size_t clen, ccapa;
struct pic_irep **proto;
size_t plen, pcapa;
};
#endif

View File

@ -193,6 +193,7 @@ gc_mark_phase(pic_state *pic)
} while ((env = env->parent) != NULL);
gc_mark(pic, pic->sDEFINE);
gc_mark(pic, pic->sLAMBDA);
gc_mark(pic, pic->sCONS);
gc_mark(pic, pic->sADD);
gc_mark(pic, pic->sSUB);

View File

@ -41,6 +41,7 @@ pic_open()
pic->arena_idx = 0;
pic->sDEFINE = pic_intern_cstr(pic, "define");
pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
pic->sCONS = pic_intern_cstr(pic, "cons");
pic->sADD = pic_intern_cstr(pic, "+");
pic->sSUB = pic_intern_cstr(pic, "-");

View File

@ -125,6 +125,12 @@ print_irep(pic_state *pic, struct pic_irep *irep)
case OP_CALL:
printf("OP_CALL\t%d\n", irep->code[i].u.i);
break;
case OP_RET:
puts("OP_RET");
break;
case OP_LAMBDA:
printf("OP_LAMBDA\t%d\n", irep->code[i].u.i);
break;
case OP_CONS:
puts("OP_CONS");
break;
@ -150,14 +156,31 @@ print_irep(pic_state *pic, struct pic_irep *irep)
}
}
static struct pic_irep *
new_irep(pic_state *pic)
{
struct pic_irep *irep;
irep = (struct pic_irep *)pic_alloc(pic, sizeof(struct pic_irep));
irep->code = (struct pic_code *)pic_alloc(pic, sizeof(struct pic_code) * 1024);
irep->clen = 0;
irep->ccapa = 1024;
irep->proto = NULL;
irep->plen = irep->pcapa = 0;
return irep;
}
static void pic_gen_call(pic_state *, struct pic_irep *, pic_value, struct pic_env *);
static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_env *);
static void
pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env)
{
pic_value sDEFINE, sCONS, sADD, sSUB, sMUL, sDIV;
pic_value sDEFINE, sLAMBDA, sCONS, sADD, sSUB, sMUL, sDIV;
sDEFINE = pic->sDEFINE;
sLAMBDA = pic->sLAMBDA;
sCONS = pic->sCONS;
sADD = pic->sADD;
sSUB = pic->sSUB;
@ -194,6 +217,22 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sLAMBDA)) {
if (irep->proto == NULL) {
irep->proto = (struct pic_irep **)pic_alloc(pic, sizeof(struct pic_irep **) * 5);
irep->pcapa = 5;
}
if (irep->plen >= irep->pcapa) {
irep->proto = (struct pic_irep **)pic_realloc(pic, irep->proto, irep->pcapa * 2);
irep->pcapa *= 2;
}
irep->code[irep->clen].insn = OP_LAMBDA;
irep->code[irep->clen].u.i = irep->plen;
irep->clen++;
irep->proto[irep->plen++] = pic_gen_lambda(pic, obj, env);
break;
}
else if (pic_eq_p(pic, proc, sCONS)) {
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);
@ -280,20 +319,33 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_en
irep->clen++;
}
static struct pic_irep *
pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env)
{
pic_value body, v;
struct pic_irep *irep;
irep = new_irep(pic);
body = pic_cdr(pic, pic_cdr(pic, obj));
for (v = body; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_gen(pic, irep, pic_car(pic, v), env);
}
irep->code[irep->clen].insn = OP_RET;
irep->clen++;
return irep;
}
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 = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->cfunc_p = false;
proc->u.irep = irep = (struct pic_irep *)pic_alloc(pic, sizeof(struct pic_irep));
irep->code = code = (struct pic_code *)pic_alloc(pic, sizeof(struct pic_code) * 1024);
irep->clen = 0;
irep->ccapa = 1024;
proc->u.irep = irep = new_irep(pic);
pic_gen(pic, irep, obj, env);
irep->code[irep->clen].insn = OP_STOP;
@ -373,6 +425,16 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_gc_arena_restore(pic, ai);
NEXT;
}
CASE(OP_LAMBDA) {
struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc *), PIC_TT_PROC);
proc->cfunc_p = false;
proc->u.irep = ci->proc->u.irep->proto[pc->u.i];
PUSH(pic_obj_value(proc));
pic_gc_arena_restore(pic, ai);
NEXT;
}
CASE(OP_CONS) {
pic_value a, b;
pic_gc_protect(pic, a = POP());