Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add eval

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-20 01:23:52 -08:00
parent 243a012d3e
commit 4c04e71078
11 changed files with 145 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
src/base.c
View File

@ -22,13 +22,13 @@ void *lisp_alloc_object(size_t size, LispValType type) {
LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size);
obj->type = type;
obj->gc.mark = false;
obj->gc.local_ref_count = 0;
obj->gc.has_local_ref = false;
// TODO set the below
obj->gc.entry = NULL;
return obj;
}
void signal_type_error(LispVal *obj, size_t count,
void internal_CHECK_TYPE_signal_type_error(LispVal *obj, size_t count,
const LispValType types[count]) {
// TODO actually throw an error
fprintf(stderr, "Type error! Got: %s | Expected: (or ",
@ -40,15 +40,19 @@ void signal_type_error(LispVal *obj, size_t count,
abort();
}
noreturn void signal_type_error(LispVal *obj, LispVal *typespec) {
// TODO actually throw an error
fprintf(stderr,
"Type error! Got: %s | Expected: ", LISP_TYPE_NAMES[TYPE_OF(obj)]);
debug_print(stderr, typespec);
fputc('\n', stderr);
abort();
}
DEFINE_SYMBOL(nil, "nil");
DEFINE_SYMBOL(t, "t");
DEFINE_SYMBOL(unbound, "unbound");
DEFINE_SYMBOL(quote, "quote");
DEFINE_SYMBOL(backquote, "`");
DEFINE_SYMBOL(comma, ",");
DEFINE_SYMBOL(comma_at, ",@");
DEFUN(id, "id", (LispVal * obj), "(id)", "") {
// TODO not all values are handled here
return MAKE_FIXNUM((uintptr_t) obj);
@ -58,6 +62,10 @@ DEFUN(eq, "eq", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") {
return obj1 == obj2 ? Qt : Qnil;
}
DEFSPECIAL(quote, "quote", (LispVal * form), "(form)", "") {
return form;
}
// ################
// # Constructors #
// ################
@ -109,3 +117,7 @@ DEFUN(symbol_function, "symbol-function", (LispVal * sym, LispVal *resolve),
}
return sym;
}
DEFINE_SYMBOL(backquote, "`");
DEFINE_SYMBOL(comma, ",");
DEFINE_SYMBOL(comma_at, ",@");

32
src/base.h
View File

@ -111,6 +111,17 @@ static ALWAYS_INLINE bool OBJECT_MARKED_P(LispVal *val) {
return ((LispObject *) val)->gc.mark;
}
static ALWAYS_INLINE void SET_OBJECT_HAS_LOCAL_REFERENCE(LispVal *val,
bool has_local_ref) {
assert(OBJECTP(val));
((LispObject *) val)->gc.has_local_ref = has_local_ref;
}
static ALWAYS_INLINE bool OBJECT_HAS_LOCAL_REFERENCE_P(LispVal *val) {
assert(OBJECTP(val));
return ((LispObject *) val)->gc.has_local_ref;
}
static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) {
if (FIXNUMP(val)) {
return TYPE_FIXNUM;
@ -131,7 +142,8 @@ static ALWAYS_INLINE bool LISP_TYPEP(LispVal *val, LispValType type) {
}
}
noreturn void signal_type_error(LispVal *obj, size_t count,
noreturn void
internal_CHECK_TYPE_signal_type_error(LispVal *obj, size_t count,
const LispValType types[count]);
static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count,
LispValType v1, LispValType v2,
@ -144,7 +156,7 @@ static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count,
}
}
// Failed
signal_type_error(obj, count, types);
internal_CHECK_TYPE_signal_type_error(obj, count, types);
}
#define internal_CHECK_TYPE1(obj, type) internal_CHECK_TYPE(obj, v1, )
#define internal_CHECK_TYPE_SUB(obj, count, a1, a2, a3, a4, a5, a6, ...) \
@ -154,6 +166,8 @@ static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count,
TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM, \
TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM)
noreturn void signal_type_error(LispVal *obj, LispVal *typespec);
#define DEFOBJTYPE(Name, NAME, NAME_P, body) \
typedef struct { \
LispObject header; \
@ -218,6 +232,8 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
const size_t internal_F##cname##_docstr_len = sizeof(doc) - 1; \
LispVal *Q##cname; \
LispVal *F##cname cargs
#define DEFSPECIAL(cname, lisp_name, cargs, lisp_args, doc) \
DEFUN(cname, lisp_name, cargs, lisp_args, doc)
#define REGISTER_GLOBAL_SYMBOL(cname) \
{ \
@ -231,6 +247,14 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \
}
#define REGISTER_GLOBAL_SPECIAL(cname) \
{ \
REGISTER_GLOBAL_SYMBOL(cname); \
((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \
((LispFunction *) ((LispSymbol *) Q##cname)->function) \
->flags.no_eval_args = true; \
}
DECLARE_SYMBOL(nil);
DECLARE_SYMBOL(t);
DECLARE_SYMBOL(unbound);
@ -242,6 +266,7 @@ static ALWAYS_INLINE bool NILP(LispVal *val) {
// Some core functions
DECLARE_FUNCTION(id, (LispVal * obj));
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
DECLARE_FUNCTION(quote, (LispVal * form));
// TODO probably move these to another file
LispVal *make_vector(LispVal **data, size_t length, bool take);
@ -249,8 +274,7 @@ DECLARE_FUNCTION(make_symbol, (LispVal * name));
DECLARE_FUNCTION(intern, (LispVal * name));
DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve));
// TODO these are actually special-forms
DECLARE_SYMBOL(quote);
// Defined in lisp code (eventually) but used in read.c
DECLARE_SYMBOL(backquote);
DECLARE_SYMBOL(comma);
DECLARE_SYMBOL(comma_at);

33
src/function.c
View File

@ -226,37 +226,44 @@ call_simple_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
fprintf(stderr, "Wrong arg count!!\n");
abort();
}
LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS];
size_t acount = 0;
FOREACH(args, arg) {
add_local_reference(arg);
if (fobj->flags.no_eval_args) {
arg_arr[acount] = arg;
} else {
arg_arr[acount] = Feval(arg);
}
add_local_reference(arg_arr[acount++]);
}
LispVal *retval;
switch (fobj->args.n_req) {
switch (acount) {
case 0:
retval = fobj->impl.native.zero();
break;
case 1:
retval = fobj->impl.native.one(FIRST(args));
retval = fobj->impl.native.one(arg_arr[0]);
break;
case 2:
retval = fobj->impl.native.two(FIRST(args), SECOND(args));
retval = fobj->impl.native.two(arg_arr[0], arg_arr[1]);
break;
case 3:
retval =
fobj->impl.native.three(FIRST(args), SECOND(args), THIRD(args));
retval = fobj->impl.native.three(arg_arr[0], arg_arr[1], arg_arr[2]);
break;
case 4:
retval = fobj->impl.native.four(FIRST(args), SECOND(args), THIRD(args),
FOURTH(args));
retval = fobj->impl.native.four(arg_arr[0], arg_arr[1], arg_arr[2],
arg_arr[3]);
break;
case 5:
retval = fobj->impl.native.five(FIRST(args), SECOND(args), THIRD(args),
FOURTH(args), FIFTH(args));
retval = fobj->impl.native.five(arg_arr[0], arg_arr[1], arg_arr[2],
arg_arr[3], arg_arr[4]);
break;
default:
abort();
}
the_stack.nogc_retval = retval;
pop_stack_frame();
add_local_reference(the_stack.nogc_retval);
return retval;
}
@ -351,9 +358,10 @@ call_complex_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
for (intptr_t i = 0; i < count; ++i) {
if (!arg_arr[i]) {
arg_arr[i] = Qnil;
} else {
add_local_reference(arg_arr[i]);
} else if (!fobj->flags.no_eval_args) {
arg_arr[i] = Feval(arg_arr[i]);
}
add_local_reference(arg_arr[i]);
}
LispVal *retval;
switch (count) {
@ -382,6 +390,7 @@ call_complex_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
}
the_stack.nogc_retval = retval;
pop_stack_frame();
add_local_reference(the_stack.nogc_retval);
return retval;
}

2
src/gc.h
View File

@ -11,7 +11,7 @@ typedef struct GCEntry {
typedef struct {
unsigned int mark : 1;
unsigned int local_ref_count : 7;
unsigned int has_local_ref : 1;
GCEntry *entry;
} ObjectGCInfo;

5
src/gen-init-globals.awk
View File

@ -76,6 +76,11 @@ function maybe_emit_next_symbol(entity) {
maybe_emit_next_symbol("FUNCTION")
}
/DEFSPECIAL\(/ {
maybe_print_file_header()
maybe_emit_next_symbol("SPECIAL")
}
/DEFINE_SYMBOL\(/ {
maybe_print_file_header()
maybe_emit_next_symbol("SYMBOL")

43
src/lisp.c
View File

@ -49,6 +49,49 @@ void lisp_init() {
void lisp_shutdown() {}
DEFUN(eval, "eval", (LispVal * form), "(form)", "") {
if (!OBJECTP(form)) {
// fixnum or float
return form;
}
switch (((LispObject *) form)->type) {
case TYPE_HASH_TABLE:
case TYPE_FUNCTION:
case TYPE_STRING:
return form;
case TYPE_VECTOR: {
LispVector *vec = form;
LispVal **out_data = lisp_malloc(sizeof(LispVal *) * vec->length);
LispVector *newvec = make_vector(out_data, vec->length, true);
for (size_t i = 0; i < vec->length; ++i) {
out_data[i] = Qnil;
}
for (size_t i = 0; i < vec->length; ++i) {
out_data[i] = Feval(vec->data[i]);
}
return newvec;
}
case TYPE_SYMBOL: {
// TODO local bindings
LispSymbol *sym = form;
if (sym->value == Qunbound) {
printf("Unbound symbol: ");
debug_print(stdout, form);
fputc('\n', stdout);
abort();
}
return sym->value;
}
case TYPE_CONS: {
return Ffuncall(XCAR(form), XCDR(form));
}
case TYPE_FIXNUM:
case TYPE_FLOAT:
default:
abort();
}
}
void debug_print(FILE *file, LispVal *obj) {
switch (TYPE_OF(obj)) {
case TYPE_FIXNUM:

2
src/lisp.h
View File

@ -16,6 +16,8 @@ void lisp_init(void);
void lisp_shutdown(void);
DECLARE_FUNCTION(eval, (LispVal * form));
void debug_print(FILE *file, LispVal *obj);
void debug_obj_info(FILE *file, LispVal *obj);

9
src/list.c
View File

@ -17,7 +17,6 @@ intptr_t list_length(LispVal *list) {
}
bool list_length_eq(LispVal *list, intptr_t size) {
assert(LISTP(list));
while (size && CONSP(list)) {
list = XCDR(list);
--size;
@ -52,3 +51,11 @@ DEFUN(nreverse, "nreverse", (LispVal * list), "(list)", "") {
}
return rev;
}
DEFUN(listp, "listp", (LispVal * obj), "(obj)", "") {
return LISTP(obj) ? Qt : Qnil;
}
DEFUN(list, "list", (LispVal * args), "(&rest args)", "") {
return args;
}

7
src/list.h
View File

@ -112,5 +112,12 @@ DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr));
DECLARE_FUNCTION(length, (LispVal * list));
DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length));
DECLARE_FUNCTION(nreverse, (LispVal * list));
DECLARE_FUNCTION(listp, (LispVal * obj));
DECLARE_FUNCTION(list, (LispVal * args));
static ALWAYS_INLINE void CHECK_LISTP(LispVal *obj) {
if (!LISTP(obj)) {
signal_type_error(obj, LIST(Qlist));
}
}
#endif

2
src/main.c
View File

@ -17,7 +17,7 @@ int main(int argc, const char **argv) {
REGISTER_GLOBAL_FUNCTION(cool_func);
push_stack_frame(Qnil, Qnil, Qnil);
ReadStream s;
const char BUF[] = "()";
const char BUF[] = "(1 'a)";
read_stream_init(&s, BUF, sizeof(BUF) - 1);
LispVal *l = read(&s);
Ffuncall(Qcool_func, l);

13
src/stack.c
View File

@ -45,13 +45,15 @@ static void reset_local_refs(struct LocalReferences *refs) {
for (size_t i = 0; i < num_full_blocks; ++i) {
for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) {
assert(OBJECTP(refs->blocks[i]->refs[j]));
--((LispObject *) refs->blocks[i]->refs[j])->gc.local_ref_count;
// TODO recurse into object
SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[i]->refs[j], false);
}
}
for (size_t i = 0; i < last_block_size; ++i) {
assert(OBJECTP(refs->blocks[num_full_blocks]->refs[i]));
--((LispObject *) refs->blocks[num_full_blocks]->refs[i])
->gc.local_ref_count;
// TODO recurse into object
SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[num_full_blocks]->refs[i],
false);
}
}
@ -84,10 +86,11 @@ static bool store_local_reference_in_frame(struct StackFrame *frame,
void add_local_reference(LispVal *obj) {
assert(the_stack.depth > 0);
if (OBJECTP(obj)) {
if (OBJECTP(obj) && OBJECT_HAS_LOCAL_REFERENCE_P(obj)) {
if (store_local_reference_in_frame(LISP_STACK_TOP(), obj)) {
the_stack.first_clear_local_refs = the_stack.depth;
}
++((LispObject *) obj)->gc.local_ref_count;
// TODO recurse into object
SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true);
}
}