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

Work on functions

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-29 00:00:05 -08:00
parent 22ffac9321
commit 5029405a70
12 changed files with 292 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
src/lisp.c
View File

@ -10,6 +10,7 @@ static void construct_manual_symbols(void) {
// IMPORTANT: the symbols listed here need to also be set as special in
// gen-init-globals.awk
Qnil = Fmake_symbol(LISP_LITSTR("nil"));
((LispSymbol *) Qnil)->value = Qnil;
((LispSymbol *) Qnil)->function = Qnil;
((LispSymbol *) Qnil)->plist = Qnil;
lisp_gc_register_static_object(Qnil);
@ -18,7 +19,7 @@ static void construct_manual_symbols(void) {
lisp_gc_register_static_object(Qt);
Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
((LispSymbol *) Qunbound)->value = Qunbound;
((LispSymbol *) Qnil)->value = Qunbound;
((LispSymbol *) Qunbound)->value = Qunbound;
lisp_gc_register_static_object(Qunbound);
Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
@ -41,6 +42,13 @@ static void register_manual_symbols(void) {
void lisp_init(void) {
construct_manual_symbols();
obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
// Needed to register functions
REGISTER_GLOBAL_SYMBOL(and_allow_other_keys);
REGISTER_GLOBAL_SYMBOL(and_optional);
REGISTER_GLOBAL_SYMBOL(and_key);
REGISTER_GLOBAL_SYMBOL(and_rest);
// these call Fintern, so they need to have obarray constructed
((LispSymbol *) Qhash_string)->function = BUILTIN_FUNCTION_OBJ(hash_string);
((LispSymbol *) Qstrings_equal)->function =
@ -107,6 +115,32 @@ DEFUN(eval, "eval", (LispVal * form, LispVal *lexenv),
}
}
DEFSPECIAL(progn, "progn", (LispVal * forms), "(&rest forms)", "") {
LispVal *rval = Qnil;
DOLIST(form, forms) {
rval = Feval(form, TOP_LEXENV());
}
return rval;
}
DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body),
"(bindings &rest body)", "") {
CHECK_LISTP(bindings);
copy_parent_lexenv();
DOLIST(binding, bindings) {
if (SYMBOLP(binding)) {
new_lexical_variable(binding, Qnil);
} else if (CONSP(binding) && list_length_eq(binding, 2)) {
new_lexical_variable(FIRST(binding),
Feval(SECOND(binding), TOP_LEXENV()));
} else {
// TODO better error
abort();
}
}
return Fprogn(body);
}
void debug_print(FILE *file, LispVal *obj) {
switch (TYPE_OF(obj)) {
case TYPE_FIXNUM:
@ -133,7 +167,14 @@ void debug_print(FILE *file, LispVal *obj) {
break;
}
case TYPE_FUNCTION: {
fprintf(file, "<function at 0x%jx>", (uintmax_t) obj);
LispFunction *fobj = obj;
if (NILP(fobj->name)) {
fprintf(file, "<lambda at 0x%jx>", (uintmax_t) obj);
} else {
fprintf(file, "<function ");
debug_print(file, fobj->name);
fprintf(file, " at 0x%jx>", (uintmax_t) obj);
}
break;
}
case TYPE_CONS: {
@ -169,32 +210,6 @@ void debug_print(FILE *file, LispVal *obj) {
}
}
DEFSPECIAL(progn, "progn", (LispVal * forms), "(&rest forms)", "") {
LispVal *rval = Qnil;
DOLIST(form, forms) {
rval = Feval(form, TOP_LEXENV());
}
return rval;
}
DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body),
"(bindings &rest body)", "") {
CHECK_LISTP(bindings);
copy_parent_lexenv();
DOLIST(binding, bindings) {
if (SYMBOLP(binding)) {
new_lexical_variable(binding, Qnil);
} else if (CONSP(binding) && list_length_eq(binding, 2)) {
new_lexical_variable(FIRST(binding),
Feval(SECOND(binding), TOP_LEXENV()));
} else {
// TODO better error
abort();
}
}
return Fprogn(body);
}
void debug_obj_info(FILE *file, LispVal *obj) {
fprintf(file, "%s -> ", LISP_TYPE_NAMES[TYPE_OF(obj)]);
debug_print(file, obj);