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

13
src/gc.c
View file

@ -101,7 +101,6 @@ V gc_collect(Vm *vm) {
}
Hd *hdr = (Hd *)scan;
switch (hdr->type) {
// TODO: the rest of the owl
case OBJ_STR:
break;
case OBJ_QUOT: {
@ -111,6 +110,18 @@ V gc_collect(Vm *vm) {
chunk->constants.items[i] = forward(gc, chunk->constants.items[i]);
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:
break;
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;
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:
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;
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:
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: {
I mark = gc_mark(&vm->gc);
O q2 = vm_pop(vm);
O q1 = vm_pop(vm);
gc_addroot(&vm->gc, &q1);
gc_addroot(&vm->gc, &q2);
if (!callable(q1) || !callable(q2))
O c1 = vm_pop(vm);
O c2 = vm_pop(vm);
gc_addroot(&vm->gc, &c2);
gc_addroot(&vm->gc, &c1);
if (!callable(c2) || !callable(c1))
vm_error(vm, VM_ERR_TYPE, "non-callable arguments to compose");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qo));
hd->type = OBJ_COMPOSE;
Qo *comp = (Qo *)(hd + 1);
comp->first = q1;
comp->second = q2;
comp->first = c2;
comp->second = c1;
vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark);
break;
}
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;
}
case OP_RETURN: