add OP_LAMBDA (lambda object creation)
This commit is contained in:
parent
19abedf746
commit
c593a46a62
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
1
src/gc.c
1
src/gc.c
|
@ -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);
|
||||
|
|
|
@ -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, "-");
|
||||
|
|
76
src/vm.c
76
src/vm.c
|
@ -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());
|
||||
|
|
Loading…
Reference in New Issue