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 .

1
src/compile.c
View file

@ -34,6 +34,7 @@ struct {
{"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}},
{"curry", {OP_CURRY, 0}},
{"?", {OP_CHOOSE, 0}}, {"?", {OP_CHOOSE, 0}},
{"+", {OP_ADD, 0}}, {"+", {OP_ADD, 0}},
{"-", {OP_SUB, 0}}, {"-", {OP_SUB, 0}},

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: