return b;
}
-block gen_op_call(opcode op, block arglist) {
- assert(op == CALL_1_1);
- assert(opcode_describe(op)->flags & OP_HAS_VARIABLE_LENGTH_ARGLIST);
- inst* i = inst_new(op);
- i->arglist = arglist;
- return block_join(inst_block(i), inst_block(inst_new(CALLSEQ_END)));
-}
-
static void inst_join(inst* a, inst* b) {
assert(a && b);
assert(!a->next);
return b;
}
+block gen_lambda(block body) {
+ return gen_function("@lambda", body);
+}
+
+block gen_call(const char* name, block args) {
+ inst* i = inst_new(CALL_1_1);
+ i->arglist = BLOCK(gen_op_block_unbound(CLOSURE_REF, name), args);
+ return BLOCK(inst_block(i), inst_block(inst_new(CALLSEQ_END)));
+}
+
+
block gen_subexp(block a) {
return BLOCK(gen_op_simple(DUP), a, gen_op_simple(SWAP));
// Expands call instructions into a calling sequence
// Checking for argument count compatibility happens later
-static block expand_call_arglist(struct bytecode* bc, block b) {
+static block expand_call_arglist(block b) {
block ret = gen_noop();
for (inst* curr; (curr = block_take(&b));) {
if (opcode_describe(curr->op)->flags & OP_HAS_VARIABLE_LENGTH_ARGLIST) {
curr->arglist = gen_noop();
assert(arglist.first && "zeroth argument (function to call) must be present");
inst* function = arglist.first->bound_by;
- assert(function);
+ assert(function); // FIXME better errors
switch (function->op) {
default: assert(0 && "Unknown parameter type"); break;
break;
}
- case CLOSURE_CREATE_C:
+ case CLOSURE_CREATE_C: {
// Arguments to C functions not yet supported
- assert(block_is_single(arglist));
- assert(arglist.first->op == CLOSURE_REF);
+ inst* cfunction_ref = block_take(&arglist);
+ block prelude = gen_noop();
+ int nargs = 0;
+ for (inst* i; (i = block_take(&arglist)); ) {
+ assert(i->op == CLOSURE_CREATE); // FIXME
+ block body = i->subfn;
+ i->subfn = gen_noop();
+ inst_free(i);
+ prelude = BLOCK(prelude, gen_subexp(expand_call_arglist(body)));
+ nargs++;
+ }
+ assert(curr->op == CALL_1_1);
curr->imm.intval = 1;
- ret = BLOCK(ret, inst_block(curr), arglist, inst_block(seq_end));
+ ret = BLOCK(ret, prelude, inst_block(curr), inst_block(cfunction_ref), inst_block(seq_end));
break;
}
+ }
} else {
ret = BLOCK(ret, inst_block(curr));
}
}
- if (bc->parent) {
- // functions should end in a return
- return BLOCK(ret, gen_op_simple(RET));
- } else {
- // the toplevel should YIELD;BACKTRACK; when it finds an answer
- return BLOCK(ret, gen_op_simple(YIELD), gen_op_simple(BACKTRACK));
- }
+ return ret;
}
static int compile(struct locfile* locations, struct bytecode* bc, block b) {
int var_frame_idx = 0;
bc->nsubfunctions = 0;
bc->nclosures = 0;
- b = expand_call_arglist(bc, b);
+ b = expand_call_arglist(b);
+ if (bc->parent) {
+ // functions should end in a return
+ b = BLOCK(b, gen_op_simple(RET));
+ } else {
+ // the toplevel should YIELD;BACKTRACK; when it finds an answer
+ b = BLOCK(b, gen_op_simple(YIELD), gen_op_simple(BACKTRACK));
+ }
for (inst* curr = b.first; curr; curr = curr->next) {
if (!curr->next) assert(curr == b.last);
pos += opcode_length(curr->op);
subfn->globals = bc->globals;
subfn->parent = bc;
errors += compile(locations, subfn, curr->subfn);
+ curr->subfn = gen_noop();
}
} else {
bc->subfunctions = 0;
if (opflags & OP_HAS_VARIABLE_LENGTH_ARGLIST) {
assert(curr->op == CALL_1_1);
int nargs = curr->imm.intval;
- assert(nargs > 0);
+ assert(nargs > 0 && nargs < 100); //FIXME
code[pos++] = (uint16_t)nargs;
int desired_params = 0;
}
bc->constants = constant_pool;
bc->nlocals = maxvar + 2; // FIXME: frames of size zero?
+ block_free(b);
return errors;
}
block gen_op_var_unbound(opcode op, const char* name);
block gen_op_var_bound(opcode op, block binder);
block gen_op_block_unbound(opcode op, const char* name);
-block gen_op_call(opcode op, block arglist);
block gen_op_symbol(opcode op, const char* name);
block gen_function(const char* name, block body);
+block gen_lambda(block body);
+block gen_call(const char* name, block body);
block gen_subexp(block a);
block gen_both(block a, block b);
block gen_collect(block expr);
}
assert(funcname);
- return BLOCK(gen_subexp(a), gen_subexp(b),
- gen_op_call(CALL_1_1, gen_op_block_unbound(CLOSURE_REF, funcname)));
+ return gen_call(funcname, BLOCK(gen_lambda(a), gen_lambda(b)));
}
static block gen_format(block a) {
- return BLOCK(a, gen_op_call(CALL_1_1, gen_op_block_unbound(CLOSURE_REF, "tostring")));
+ return BLOCK(a, gen_call("tostring", gen_noop()));
}
static block gen_update(block a, block op, int optype) {
jv_free($2);
} |
IDENT {
- $$ = gen_location(@$, gen_op_call(CALL_1_1, gen_op_block_unbound(CLOSURE_REF, jv_string_value($1))));
+ $$ = gen_location(@$, gen_call(jv_string_value($1), gen_noop()));
jv_free($1);
} |
IDENT '(' Exp ')' {
- $$ = gen_op_call(CALL_1_1,
- block_join(gen_op_block_unbound(CLOSURE_REF, jv_string_value($1)),
- block_bind(gen_function("@lambda", $3),
- gen_noop(), OP_IS_CALL_PSEUDO)));
+ $$ = gen_call(jv_string_value($1), gen_lambda($3));
$$ = gen_location(@1, $$);
jv_free($1);
} |