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

Fix some bugs

Browse Source
This commit is contained in:
Zander671
2026-09-08 08:54:50 -07:00
parent 7d538647f4
commit e197e4b1dc
7 changed files with 176 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/function.c
+24 -2
View File
@@ -245,6 +245,7 @@ enum ProcessArgsResult {
PROCESS_ARGS_TOO_MANY,
PROCESS_ARGS_NO_KEY_VALUE,
PROCESS_ARGS_BAD_KEY,
PROCESS_ARGS_DOTTED,
PROCESS_ARGS_N_ERRORS,
};
@@ -255,6 +256,7 @@ static const char *process_args_strerror(enum ProcessArgsResult status) {
[PROCESS_ARGS_TOO_MANY] = "Too many arguments",
[PROCESS_ARGS_NO_KEY_VALUE] = "Key without a value",
[PROCESS_ARGS_BAD_KEY] = "Unknown key",
[PROCESS_ARGS_DOTTED] = "Dotted argument list",
};
return MSGS[status];
}
@@ -276,6 +278,8 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
while (rem_req--) {
if (NILP(args)) {
return PROCESS_ARGS_TOO_FEW;
} else if (!CONSP(args)) {
return PROCESS_ARGS_DOTTED;
}
out[idx++] = XCAR(args);
args = XCDR(args);
@@ -283,6 +287,8 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
while (rem_opt--) {
if (NILP(args)) {
return PROCESS_ARGS_OK;
} else if (!CONSP(args)) {
return PROCESS_ARGS_DOTTED;
}
out[idx++] = XCAR(args);
args = XCDR(args);
@@ -291,6 +297,9 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
return PROCESS_ARGS_TOO_MANY;
}
if (!NILP(fobj->args.rest)) {
if (!LISTP(args) || !NILP(Fdotted_list_p(args))) {
return PROCESS_ARGS_DOTTED;
}
*rest_idx = idx;
out[idx++] = args;
} else {
@@ -300,7 +309,9 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
return PROCESS_ARGS_OK;
}
while (!NILP(args)) {
if (NILP(XCDR(args))) {
if (!CONSP(args)) {
return PROCESS_ARGS_DOTTED;
} else if (NILP(XCDR(args))) {
return PROCESS_ARGS_NO_KEY_VALUE;
}
LispVal *entry = Fgethash(fobj->args.kw, XCAR(args), Qnil);
@@ -390,12 +401,17 @@ push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
while (!NILP(rem_req)) {
if (NILP(args)) {
return PROCESS_ARGS_TOO_FEW;
} else if (!CONSP(args)) {
return PROCESS_ARGS_DOTTED;
}
new_lexical_variable(XCAR(rem_req), XCAR(args));
args = XCDR(args);
rem_req = XCDR(rem_req);
}
while (!NILP(rem_opt) && !NILP(args)) {
if (!CONSP(args)) {
return PROCESS_ARGS_DOTTED;
}
push_optional_argument_to_lexenv(XCAR(rem_opt), XCAR(args));
args = XCDR(args);
rem_opt = XCDR(rem_opt);
@@ -405,6 +421,9 @@ push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
rem_opt = XCDR(rem_opt);
}
if (!NILP(fobj->args.rest)) {
if (!LISTP(args) || !NILP(Fdotted_list_p(args))) {
return PROCESS_ARGS_DOTTED;
}
new_lexical_variable(fobj->args.rest, args);
}
if (NILP(fobj->args.kw)) {
@@ -413,6 +432,9 @@ push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
}
LispVal *seen_kw = make_hash_table_no_gc(Qnil, Qnil);
while (!NILP(args)) {
if (!CONSP(args)) {
return PROCESS_ARGS_DOTTED;
}
if (NILP(XCDR(args))) {
release_hash_table_no_gc(seen_kw);
return PROCESS_ARGS_NO_KEY_VALUE;
@@ -494,7 +516,7 @@ DEFUN(apply, "apply", (LispVal * func, LispVal *args), "(func &rest args)",
if (NILP(args)) {
return CALL0(func);
}
if (NILP(Fproper_list_p(XCDR(Flast(args))))) {
if (NILP(Fproper_list_p(XCAR(Flast(args))))) {
signal_type_error(args, Qlist);
}
return Ffuncall(func, Flist_star(XCAR(args), XCDR(args)));
src/interp.c
+33 -7
View File
@@ -105,8 +105,7 @@ DEFSPECIAL(setq, "setq", (LispVal * bindings), "(&rest bindings)", "") {
LIST(LISP_LITSTR("Wrong number of arguments.")));
}
LispVal *value = Qnil;
for (LispVal *rest = bindings; !NILP(bindings);
bindings = XCDR(XCDR(bindings))) {
for (LispVal *rest = bindings; !NILP(rest); rest = XCDR(XCDR(rest))) {
LispVal *name = FIRST(rest);
value = eval(SECOND(rest));
set_lexical_variable(name, value);
@@ -118,14 +117,16 @@ DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body),
"(bindings &rest body)", "") {
CHECK_LISTP(bindings);
StackFrame *stack_ref = LISP_STACK_REF();
DOLIST(binding, bindings) {
bindings = Fcopy_list(bindings);
DOTAILS(rest, bindings) {
LispVal *binding = XCAR(rest);
if (CONSP(binding) && list_length_eq(binding, 2)) {
if (!SYMBOLP(XCAR(binding))) {
signal_type_error(XCAR(binding), LIST(Qsymbol));
}
CHECK_TYPE(XCAR(binding), TYPE_SYMBOL);
binding = Fcopy_list(binding);
RPLACA(rest, binding);
RPLACA(XCDR(binding), eval(SECOND(binding)));
} else if (!SYMBOLP(binding)) {
signal_type_error(binding, LIST(Qsymbol));
signal_type_error(binding, LIST(Qsymbol, Qlist));
}
}
push_copy_lexenv();
@@ -140,6 +141,23 @@ DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body),
return UNWIND_AND_RETURN(stack_ref, Fprogn(body));
}
DEFSPECIAL(let_star, "let*", (LispVal * bindings, LispVal *body),
"(bindings &rest body)", "") {
CHECK_LISTP(bindings);
StackFrame *stack_ref = LISP_STACK_REF();
DOLIST(binding, bindings) {
if (CONSP(binding) && list_length_eq(binding, 2)) {
CHECK_TYPE(XCAR(binding), TYPE_SYMBOL);
new_lexical_variable(FIRST(binding), eval(SECOND(binding)));
} else if (SYMBOLP(binding)) {
new_lexical_variable(binding, Qnil);
} else {
signal_type_error(binding, LIST(Qsymbol, Qlist));
}
}
return UNWIND_AND_RETURN(stack_ref, Fprogn(body));
}
DEFSPECIAL(if, "if", (LispVal * cond, LispVal *then, LispVal *otherwise),
"(cond then &rest else)", "") {
StackFrame *stack_ref = LISP_STACK_REF();
@@ -180,6 +198,14 @@ DEFUN(not, "not", (LispVal * datum), "(datum)", "") {
return NILP(datum) ? Qt : Qnil;
}
DEFSPECIAL(while, "while", (LispVal * cond, LispVal *body), "(cond &rest body)",
"") {
while (!NILP(eval(cond))) {
Fprogn(body);
}
return Qnil;
}
DEFSPECIAL(block, "block", (LispVal * name, LispVal *body), "(name &rest body)",
"") {
CHECK_TYPE(name, TYPE_SYMBOL);
src/interp.h
+2
View File
@@ -8,11 +8,13 @@ DECLARE_FUNCTION(eval, (LispVal * form, LispVal *lexenv));
DECLARE_FUNCTION(progn, (LispVal * forms));
DECLARE_FUNCTION(setq, (LispVal * bindings));
DECLARE_FUNCTION(let, (LispVal * bindings, LispVal *body));
DECLARE_FUNCTION(let_star, (LispVal * bindings, LispVal *body));
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *then, LispVal *otherwise));
DECLARE_FUNCTION(and, (LispVal * forms));
DECLARE_FUNCTION(or, (LispVal * forms));
DECLARE_FUNCTION(null, (LispVal * datum));
DECLARE_FUNCTION(not, (LispVal * datum));
DECLARE_FUNCTION(while, (LispVal * cond, LispVal *body));
DECLARE_FUNCTION(block, (LispVal * name, LispVal *body));
DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
src/list.c
+14
View File
@@ -53,6 +53,20 @@ DEFUN(cdr, "cdr", (LispVal * list), "(list)", "") {
return NILP(list) ? Qnil : XCDR(list);
}
DEFUN(rplaca, "rplaca", (LispVal * cons, LispVal *newcar), "(cons newcar)",
"") {
CHECK_TYPE(cons, TYPE_CONS);
RPLACA(cons, newcar);
return newcar;
}
DEFUN(rplacd, "rplacd", (LispVal * cons, LispVal *newcdr), "(cons newcdr)",
"") {
CHECK_TYPE(cons, TYPE_CONS);
RPLACD(cons, newcdr);
return newcdr;
}
DEFUN(length_eq, "length=", (LispVal * list, LispVal *length), "(list length)",
"Return non-nil if LIST's length is LENGTH.") {
CHECK_LISTP(list);
src/list.h
+2
View File
@@ -125,6 +125,8 @@ DECLARE_FUNCTION(atom, (LispVal * val));
DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr));
DECLARE_FUNCTION(car, (LispVal * list));
DECLARE_FUNCTION(cdr, (LispVal * list));
DECLARE_FUNCTION(rplaca, (LispVal * cons, LispVal *newcar));
DECLARE_FUNCTION(rplacd, (LispVal * cons, LispVal *newcdr));
DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length));
DECLARE_FUNCTION(nreverse, (LispVal * list));
DECLARE_FUNCTION(last, (LispVal * list));
src/macro.c
+5 -2
View File
@@ -52,6 +52,9 @@ DEFUN(macroexpand_toplevel, "macroexpand-toplevel",
}
LispVal *macroexpand_list(LispVal *list, LispVal *lexical_macros) {
if (!CONSP(list)) {
return list;
}
LispVal *start = Qnil;
LispVal *end = NULL;
DOTAILS(rest, list) {
@@ -103,7 +106,7 @@ static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
return macroexpand_lambda_form(form, lexical_macros);
} else if (IS(quote) || IS(function)) {
return form;
} else if (IS(progn) || IS(if) || IS(and) || IS(or)) {
} else if (IS(progn) || IS(if) || IS(and) || IS(or) || IS(while)) {
if (LISTP(XCDR(form))) {
return CONS(XCAR(form),
macroexpand_list(XCDR(form), lexical_macros));
@@ -119,7 +122,7 @@ static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
expand = !expand;
}
return CONS(XCAR(form), args);
} else if (IS(let)) {
} else if (IS(let) || IS(let_star)) {
if (!CONSP(XCDR(form))) {
return form;
}