lobo/growl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add curry

Browse source
This commit is contained in:
Lobo 2026-01-23 15:14:49 -03:00
parent cfc45d763a
commit 58c1f24161
4 changed files with 88 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

6
examples/compose.grr
View file

@ -1 +1,5 @@
5 [1 +] [2 *] compose call . 5 [1 +] [2 *] compose
call .
10 5 [+] curry
call .

71
src/compile.c
View file

@ -19,41 +19,42 @@ struct {
const char *name; const char *name;
U8 opcode[8]; U8 opcode[8];
} primitives[] = { } primitives[] = {
{"nil", {OP_NIL, 0}}, {"nil", {OP_NIL, 0}},
{"dup", {OP_DUP, 0}}, {"dup", {OP_DUP, 0}},
{"drop", {OP_DROP, 0}}, {"drop", {OP_DROP, 0}},
{"swap", {OP_SWAP, 0}}, {"swap", {OP_SWAP, 0}},
{"over", {OP_OVER, 0}}, {"over", {OP_OVER, 0}},
{"nip", {OP_NIP, 0}}, {"nip", {OP_NIP, 0}},
{"bury", {OP_BURY, 0}}, {"bury", {OP_BURY, 0}},
{"dig", {OP_DIG, 0}}, {"dig", {OP_DIG, 0}},
{">r", {OP_TOR, 0}}, {">r", {OP_TOR, 0}},
{"r>", {OP_FROMR, 0}}, {"r>", {OP_FROMR, 0}},
{"dip", {OP_SWAP, OP_TOR, OP_CALL, OP_FROMR, 0}}, {"dip", {OP_SWAP, OP_TOR, OP_CALL, OP_FROMR, 0}},
{"keep", {OP_OVER, OP_TOR, OP_CALL, OP_FROMR, 0}}, {"keep", {OP_OVER, OP_TOR, OP_CALL, OP_FROMR, 0}},
{"if", {OP_CHOOSE, OP_CALL, 0}}, {"if", {OP_CHOOSE, OP_CALL, 0}},
{"call", {OP_CALL, 0}}, {"call", {OP_CALL, 0}},
{"compose",{OP_COMPOSE, 0}}, {"compose", {OP_COMPOSE, 0}},
{"?", {OP_CHOOSE, 0}}, {"curry", {OP_CURRY, 0}},
{"+", {OP_ADD, 0}}, {"?", {OP_CHOOSE, 0}},
{"-", {OP_SUB, 0}}, {"+", {OP_ADD, 0}},
{"*", {OP_MUL, 0}}, {"-", {OP_SUB, 0}},
{"/", {OP_DIV, 0}}, {"*", {OP_MUL, 0}},
{"%", {OP_MOD, 0}}, {"/", {OP_DIV, 0}},
{"logand", {OP_LOGAND, 0}}, {"%", {OP_MOD, 0}},
{"logor", {OP_LOGOR, 0}}, {"logand", {OP_LOGAND, 0}},
{"logxor", {OP_LOGXOR, 0}}, {"logor", {OP_LOGOR, 0}},
{"lognot", {OP_LOGNOT, 0}}, {"logxor", {OP_LOGXOR, 0}},
{"=", {OP_EQ, 0}}, {"lognot", {OP_LOGNOT, 0}},
{"<>", {OP_NEQ, 0}}, {"=", {OP_EQ, 0}},
{"<", {OP_LT, 0}}, {"<>", {OP_NEQ, 0}},
{">", {OP_GT, 0}}, {"<", {OP_LT, 0}},
{"<=", {OP_LTE, 0}}, {">", {OP_GT, 0}},
{">=", {OP_GTE, 0}}, {"<=", {OP_LTE, 0}},
{"and", {OP_AND, 0}}, {">=", {OP_GTE, 0}},
{"or", {OP_OR, 0}}, {"and", {OP_AND, 0}},
{"^", {OP_CONCAT, 0}}, {"or", {OP_OR, 0}},
{NULL, {0}}, {"^", {OP_CONCAT, 0}},
{NULL, {0}},
}; };
// clang-format on // clang-format on

13
src/gc.c
View file

@ -101,7 +101,6 @@ V gc_collect(Vm *vm) {
} }
Hd *hdr = (Hd *)scan; Hd *hdr = (Hd *)scan;
switch (hdr->type) { switch (hdr->type) {
// TODO: the rest of the owl
case OBJ_STR: case OBJ_STR:
break; break;
case OBJ_QUOT: { case OBJ_QUOT: {
@ -111,6 +110,18 @@ V gc_collect(Vm *vm) {
chunk->constants.items[i] = forward(gc, chunk->constants.items[i]); chunk->constants.items[i] = forward(gc, chunk->constants.items[i]);
break; break;
} }
case OBJ_COMPOSE: {
Qo *comp = (Qo *)(hdr + 1);
comp->first = forward(gc, comp->first);
comp->second = forward(gc, comp->second);
break;
};
case OBJ_CURRY: {
Qc *curry = (Qc *)(hdr + 1);
curry->value = forward(gc, curry->value);
curry->callable = forward(gc, curry->callable);
break;
};
case OBJ_USERDATA: case OBJ_USERDATA:
break; break;
case OBJ_FWD: case OBJ_FWD:

42
src/vm.c
View file

@ -272,6 +272,13 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
quot = comp->first; quot = comp->first;
goto do_call; goto do_call;
} }
case TYPE_CURRY: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
goto do_call;
break;
}
default: default:
vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object"); vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object");
} }
@ -304,6 +311,13 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
quot = comp->first; quot = comp->first;
goto do_tail_call; goto do_tail_call;
} }
case TYPE_CURRY: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
goto do_tail_call;
break;
}
default: default:
vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object"); vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object");
} }
@ -319,22 +333,36 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
} }
case OP_COMPOSE: { case OP_COMPOSE: {
I mark = gc_mark(&vm->gc); I mark = gc_mark(&vm->gc);
O q2 = vm_pop(vm); O c1 = vm_pop(vm);
O q1 = vm_pop(vm); O c2 = vm_pop(vm);
gc_addroot(&vm->gc, &q1); gc_addroot(&vm->gc, &c2);
gc_addroot(&vm->gc, &q2); gc_addroot(&vm->gc, &c1);
if (!callable(q1) || !callable(q2)) if (!callable(c2) || !callable(c1))
vm_error(vm, VM_ERR_TYPE, "non-callable arguments to compose"); vm_error(vm, VM_ERR_TYPE, "non-callable arguments to compose");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qo)); Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qo));
hd->type = OBJ_COMPOSE; hd->type = OBJ_COMPOSE;
Qo *comp = (Qo *)(hd + 1); Qo *comp = (Qo *)(hd + 1);
comp->first = q1; comp->first = c2;
comp->second = q2; comp->second = c1;
vm_push(vm, BOX(hd)); vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark); gc_reset(&vm->gc, mark);
break; break;
} }
case OP_CURRY: { case OP_CURRY: {
I mark = gc_mark(&vm->gc);
O cble = vm_pop(vm);
O value = vm_pop(vm);
gc_addroot(&vm->gc, &cble);
gc_addroot(&vm->gc, &value);
if (!callable(cble))
vm_error(vm, VM_ERR_TYPE, "non-callable argument to curry");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qc));
hd->type = OBJ_CURRY;
Qc *curry = (Qc *)(hd + 1);
curry->value = value;
curry->callable = cble;
vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark);
break; break;
} }
case OP_RETURN: case OP_RETURN: