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

restructure

Browse source
This commit is contained in:
Lobo 2026-01-13 20:51:00 -03:00
parent 2e7d05f783
commit ce9489b5d2
17 changed files with 16 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

177
src/core/prim.c Normal file
View file

@ -0,0 +1,177 @@
#include <prim.h>
#include <stdlib.h>
#include <wolflisp.h>
#define BOOL(x) ((x) ? in->t : NIL)
O prim_make(In *in, const char *name, O (*fn)(In *, O *, int, O), int min_args,
int max_args) {
Pr *pr = malloc(sizeof(Pr));
pr->name = name;
pr->fn = fn;
pr->min_args = min_args;
pr->max_args = max_args;
O sym = BOX(TAG(intern(&in->symtab, name, 0), TAG_SYM));
O prim = BOX(TAG(pr, TAG_PRIM));
return pair_make(in, sym, prim);
}
O prim_cons(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 2)
error_throw(in, "cons: expected 2 arguments, got %d", argc);
return pair_make(in, args[0], args[1]);
}
O prim_list(In *in, O *args, int argc, O env) {
(void)env;
O result = NIL;
I mark = gc_rootmark(&in->gc);
gc_addroot(&in->gc, &result);
for (int i = argc - 1; i >= 0; i--) {
result = pair_make(in, args[i], result);
}
gc_rootreset(&in->gc, mark);
return result;
}
O prim_head(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 1)
error_throw(in, "head: expected 1 argument, got %d", argc);
return pair_unwrap(in, args[0])->head;
}
O prim_tail(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 1)
error_throw(in, "tail: expected 1 argument, got %d", argc);
return pair_unwrap(in, args[0])->tail;
}
O prim_print(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 1)
error_throw(in, "print: expected 1 argument, got %d", argc);
print(args[0]);
return NIL;
}
O prim_println(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 1)
error_throw(in, "println: expected 1 argument, got %d", argc);
println(args[0]);
return NIL;
}
O prim_write(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 1)
error_throw(in, "write: expected 1 argument, got %d", argc);
if (type(args[0]) != TYPE_STR)
error_throw(in, "write: expected string argument, got %s", typename(type(args[0])));
Ss *s = (Ss *)(UNBOX(args[0]) + 1);
printf("%.*s", (int)s->len, s->data);
return NIL;
}
O prim_add(In *in, O *args, int argc, O env) {
(void)env;
I result = 0;
for (int i = 0; i < argc; i++) {
if (!IMM(args[i]))
error_throw(in, "+: non numeric argument at position %d", i);
result += ORD(args[i]);
}
return NUM(result);
}
O prim_sub(In *in, O *args, int argc, O env) {
(void)env;
if (argc == 0)
return NUM(0);
if (!IMM(args[0]))
error_throw(in, "-: non numeric argument at position 0");
I result = ORD(args[0]);
if (argc == 1)
return NUM(-result);
for (int i = 1; i < argc; i++) {
if (!IMM(args[i]))
error_throw(in, "-: non numeric argument at position %d", i);
result -= ORD(args[i]);
}
return NUM(result);
}
O prim_mul(In *in, O *args, int argc, O env) {
(void)env;
I result = 1;
for (int i = 0; i < argc; i++) {
if (!IMM(args[i]))
error_throw(in, "*: non numeric argument at position %d", i);
result *= ORD(args[i]);
}
return NUM(result);
}
O prim_div(In *in, O *args, int argc, O env) {
(void)env;
if (argc == 0)
return NUM(1);
if (!IMM(args[0]))
error_throw(in, "/: non numeric argument at position 0");
I result = ORD(args[0]);
for (int i = 1; i < argc; i++) {
if (!IMM(args[i]))
error_throw(in, "/: non numeric argument at position %d", i);
if (ORD(args[i]) == 0)
error_throw(in, "/: division by zero at position %d", i);
result /= ORD(args[i]);
}
return NUM(result);
}
O prim_equal(In *in, O *args, int argc, O env) {
(void)env;
if (argc < 2)
return in->t;
O first = args[0];
for (int i = 1; i < argc; i++) {
if (first != args[i])
return NIL;
}
return in->t;
}
O prim_lt(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 2)
error_throw(in, "<: expected 2 arguments, got %d", argc);
if (IMM(args[0]) && IMM(args[1])) {
return BOOL(ORD(args[0]) < ORD(args[1]));
} else {
error_throw(in, "<: expected numeric arguments");
return NIL;
}
}
O prim_gt(In *in, O *args, int argc, O env) {
(void)env;
if (argc != 2)
error_throw(in, ">: expected 2 arguments, got %d", argc);
if (IMM(args[0]) && IMM(args[1])) {
return BOOL(ORD(args[0]) > ORD(args[1]));
} else {
error_throw(in, ">: expected numeric arguments");
return NIL;
}
}
O prim_gc(In *in, O *args, int argc, O env) {
(void)args;
(void)argc;
(void)env;
gc_collect(&in->gc);
return NIL;
}