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
lisp/kernel.gl
+96 -7
View File
@@ -1,5 +1,6 @@
;; -*- mode: lisp-data -*-
;; Defining macros and functions
(fset 'defmacro (cons 'macro
(lambda (name lambda-list &rest body)
"Define NAME to be a macro."
@@ -18,11 +19,99 @@
(list 'declare (list 'name name))
body)))
(defun princln (datum &optional print-char-fun)
"`princ' DATUM to PRINT-CHAR-FUN. Then print a newline."
(princ datum print-char-fun)
(funcall (or print-char-fun 'write-byte) ?\n))
;; List indicies
(defun first (list)
"Return the first element of LIST."
(car list))
(defun second (list)
"Return the second element of LIST."
(car (cdr list)))
(defun third (list)
"Return the third element of LIST."
(car (cdr (cdr list))))
(defun fourth (list)
"Return the fourth element of LIST."
(car (cdr (cdr (cdr list)))))
(defun fifth (list)
"Return the fifth element of LIST."
(car (cdr (cdr (cdr (cdr list))))))
(defun sixth (list)
"Return the sixth element of LIST."
(car (cdr (cdr (cdr (cdr (cdr list)))))))
(defun seventh (list)
"Return the seventh element of LIST."
(car (cdr (cdr (cdr (cdr (cdr (cdr list))))))))
(defun eighth (list)
"Return the eighth element of LIST."
(car (cdr (cdr (cdr (cdr (cdr (cdr (cdr list)))))))))
(defun ninth (list)
"Return the ninth element of LIST."
(car (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr list))))))))))
(defun tenth (list)
"Return the tenth element of LIST."
(car (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr list)))))))))))
(let ((a [0]))
(aset a 1 'a)
(princln a))
;; Utility macros
(defmacro when (cond &rest body)
"Evaluate BODY if COND evaluates to non-nil."
(list 'if cond
(cons 'progn body)))
(defmacro unless (cond &rest body)
"Evaluate BODY if COND evaluates to nil."
(list* 'if cond
nil
body))
(defmacro dolist (spec &rest body)
"Evaluate BODY for each element of a list.
Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
(unless (and (or (length= spec 2) (length= spec 3))
(symbolp (car spec)))
(signal 'error (list spec)))
(let ((list-var (make-symbol "--dolist-list--"))
(cur-var (make-symbol "--dolist-cur--")))
(list 'let (list (list list-var (second spec))
cur-var)
(list 'while list-var
(list 'setq cur-var (list 'car list-var))
(list* 'let (list (list (first spec) cur-var))
body)
(list 'setq list-var (list 'cdr list-var)))
(when (third spec)
(list 'let (list (list (first spec) cur-var))
(third spec))))))
;; List functions
(defun mapcar (function list)
"Apply FUNCTION to each element of LIST and return a list of the results."
(let (start end)
(dolist (elt list)
(let ((res (funcall function elt)))
(if (null start)
(progn
(setq start (list res)
end start))
(rplacd end (list res))
(setq end (cdr end)))))
start))
(defun mapc (function list)
"Apply FUNCTION to each element of LIST, then return LIST."
(dolist (elt list list)
(funcall function elt)))
;; Some other functions
(defun terpri (&optional print-char-fun)
"Print a newline to PRINT-CHAR-FUN, then flush it."
(let ((fun (or print-char-fun #'write-byte)))
(funcall fun ?\n)
(funcall fun nil)))
(defun princln (datum &optional print-char-fun)
"`princ' DATUM to PRINT-CHAR-FUN, then do a `terpri'."
(princ datum print-char-fun)
(terpri print-char-fun))
(princln (mapc (lambda (x) (+ x 1))
'(1 2 3)))
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;
}