This document describes the implementation of KILO LISP 22, a small, yet quite capable interpreter for purely symbolic LISP. This part of the LISP system is bootstrapped in LISP.
; Kilo LISP derived operators ; Nils M Holm, 2019, 2020 ; In the public domain
With variadic functions LIST is easily implemented.
(setq list (lambda x x))
NULL and NOT are really the same thing — extensionally at least.
(setq null (lambda (x) (eq x nil))) (setq not null)
CAAR and friends. Nothing special to see here.
(setq caar (lambda (x) (car (car x)))) (setq cadr (lambda (x) (car (cdr x)))) (setq cdar (lambda (x) (cdr (car x)))) (setq cddr (lambda (x) (cdr (cdr x)))) (setq caaar (lambda (x) (car (car (car x))))) (setq caadr (lambda (x) (car (car (cdr x))))) (setq cadar (lambda (x) (car (cdr (car x))))) (setq caddr (lambda (x) (car (cdr (cdr x))))) (setq cdaar (lambda (x) (cdr (car (car x))))) (setq cdadr (lambda (x) (cdr (car (cdr x))))) (setq cddar (lambda (x) (cdr (cdr (car x))))) (setq cdddr (lambda (x) (cdr (cdr (cdr x)))))
REVAPPEND reverses the list A and appends it to B. It falls out naturally when implementing the tail-recursive algorithm for REVERSE.
(setq revappend
(lambda (a b)
(if (null a)
b
(revappend (cdr a)
(cons (car a) b)))))
Once REVAPPEND is there, REVERSE is simple.
(setq reverse
(lambda (a)
(revappend a nil)))
APPEND is also easily built on top of REVAPPEND. Why not implement a variadic APPEND immediately? Note that this implementation is not tail-recursive, though! This will be done later.
(setq append
(lambda a
(if (null a)
nil
(revappend (reverse (car a))
(apply append (cdr a))))))
The COND special form expands as follows (PRED is a predicate, EXPR is an expression):
(COND) --> NIL
(COND (pred) clause ...) --> (IFNOT pred
(COND clause ...))
(COND (pred expr ...) clause ...) --> (IF pred
(PROGN expr ...)
(COND clause ...))
(COND (T expr ...)) --> (PROGN expr ...)
There is no QUASIQUOTE yet, but the above expanded forms are easily constructed using LIST, CONS, and QUOTE.
(setq cond
(macro
(lambda cs
(if (null cs)
nil
(if (null (cdar cs))
(list 'ifnot (caar cs)
(cons 'cond (cdr cs)))
(if (eq 't (caar cs))
(cons 'progn (cdar cs))
(list 'if (caar cs)
(cons 'progn (cdar cs))
(cons 'cond (cdr cs)))))))))
The expansions of the AND special form are also easy to construct:
(AND) --> T (AND expr) --> expr (AND expr1 expr2 ...) --> (IF expr1 (AND expr2 ...) NIL)
(setq and
(macro
(lambda xs
(cond ((null xs))
((null (cdr xs)) (car xs))
(t (list 'if (car xs)
(cons 'and (cdr xs))
nil))))))
COND and AND are all new special forms that are needed to create QUASIQUOTE. It expands as follows:
@expr --> (QUOTE expr)
@,expr --> expr
@(,expr1 expr2 ...) --> (CONS expr1 @(expr2 ...))
@(,@expr1 expr2 ...) --> (APPEND expr1 @(expr2 ...))
@(expr1 expr2 ...) --> (CONS @expr1 @(@expr2 ...))
(setq quasiquote
(macro
(lambda (x)
(cond ((atom x)
(list 'quote x))
((eq 'unquote (car x))
(cadr x))
((and (not (atom (car x)))
(eq 'unquote (caar x)))
(list 'cons (cadar x)
(list 'quasiquote (cdr x))))
((and (not (atom (car x)))
(eq 'unquote-splice (caar x)))
(list 'append (cadar x)
(list 'quasiquote (cdr x))))
(t (list 'cons (list 'quasiquote (car x))
(list 'quasiquote (cdr x))))))))
Using QUASIQUOTE, some nicer syntax for defining functions and macros can be added:
(DEFUN name args expr ...) --> (SETQ name
(LAMBDA args
expr ...))
(DEFMACRO name args expr ...) --> (SETQ name
(MACRO
(LAMBDA args
expr ...)))
If you really want to appreciate QUASIQUOTE, try to define these superficially simple macros without it! (spoiler)
(setq defun
(macro
(lambda (n v b . bs)
@(setq ,n (lambda ,v ,b . ,bs)))))
(setq defmacro
(macro
(lambda (n v b . bs)
@(setq ,n (macro (lambda ,v ,b . ,bs))))))
Here is DEFMACRO in action. Together with QUASIQUOTE it provides a pretty readable definition of OR, which expands as follows:
(OR) --> NIL (OR expr) --> expr (OR expr1 expr2 ...) --> (IFNOT expr1 (OR expr2 ...))
(defmacro or xs
(cond ((null xs) nil)
((null (cdr xs)) (car xs))
(t @(ifnot ,(car xs)
(or . ,(cdr xs))))))
It would be nice to have LABELS when creating LET, but it would also be nice to have LET when creating LABELS. LET is simpler, so it comes first. Its internal LABEL, which creates the local function S ("split"), is defined in this way:
((LAMBDA (S) ) (SETQ S ...) NIL)
The S function splits the binding part BS of LET into variables (VS) and arguments (AS) and returns them as a list (VS AS). APPLY is then used to destructure the list and bind their elements to AS and VS again. LET eventually expands like this:
(LET ((v1 a1) ...) expr ...) --> ((LAMBDA (v1 ...)
expr ...)
a1 ...)
(defmacro let (bs x . xs)
((lambda (s)
(setq s
(lambda (bs vs as)
(if (null bs)
(list vs as)
(s (cdr bs)
(cons (caar bs) vs)
(cons (cadar bs) as)))))
(apply (lambda (vs as)
@((lambda ,vs ,x . ,xs) . ,as))
(s bs nil nil)))
nil))
It would also be nice to have LABELS when creating MAPCAR, but without MAPCAR LABELS would be a mess. At least LET can be used to create the local recursive functions M1 and M2, which is slightly more readable than the version using LAMBDA:
(LET ((m1 nil)) (SETQ m1 ...) ...)
Note that this version of MAPCAR is not tail-recursive! A better one will follow later, when LABELS and a few other functions are in place.
Also note that MAPCAR is limited to one or two list arguments in KILO LISP!
(defun mapcar (f a . b)
(if (null b)
(let ((m1 nil))
(setq m1
(lambda (a)
(if (null a)
nil
(cons (f (car a))
(m1 (cdr a))))))
(m1 a))
(let ((m2 nil))
(setq m2
(lambda (a b)
(if (null a)
nil
(cons (f (car a) (car b))
(m2 (cdr a) (cdr b))))))
(m2 a (car b)))))
When using LET and MAPCAR, the definition of the LABELS special form is not that complicated. LABELS expands as follows:
(LABELS ((name1 args1 expr1 ...) --> (LET ((name1 NIL)
...) ...)
expr ...) (SETQ name1
(LAMBDA args1
expr1 ...))
...
expr ...)
MAPCAR is used to split the binding part (BS) of the form as well as to create the initial bindings to NIL (NS) and the initialization expressions (IS) using SETQ. QUASIQUOTE is finally used to stitch it all together.
(defmacro labels (bs x . xs)
(let ((vs (mapcar car bs))
(as (mapcar cdr bs)))
(let ((ns (mapcar (lambda (v)
(list v nil))
vs))
(is (mapcar (lambda (v a)
@(setq ,v (lambda . ,a)))
vs as)))
@(let ,ns ,@is ,x . ,xs))))
LETN (nested LET, otherwise known as LET*) is also nice to have. It is easily created on top of LET and expands as follows:
(LETN () expr ..) --> (LET () expr ...)
(LETN ((v1 a1) (v2 a2) ...) expr ..) --> (LET ((v1 a1))
(LETN ((v2 a2) ...)
expr))
(defmacro letn (bs x . xs)
(if (null bs)
@(let () ,x . ,xs)
@(let (,(car bs))
(letn ,(cdr bs) ,x . ,xs))))
NRECONC is the destructive variant of REVAPPPEND,
NREVERSE is the destructive variant of REVERSE, and
NCONC is the destructive variant of APPEND.
NRECONC, on which the other two are based, profits from the existence of LET, so its definitions was postponed to this point.
(defun nreconc (a b)
(if (null a)
b
(let ((h (cdr a)))
(rplacd a b)
(nreconc h a))))
(defun nreverse (a)
(nreconc a nil))
(defun nconc a
(if (null a)
nil
(nreconc (nreverse (car a))
(apply nconc (cdr a)))))
With NREVERSE and LABELS a more efficient and more readable MAPCAR can be defined. However, MAPCAR and MAPLIST really only differ very slightly, so why not define a higher order MAP function that creates both of them?
(defun map (g)
(lambda (f a . b)
(labels ((m1 (a r)
(cond ((null a) (nreverse r))
(t (m1 (cdr a)
(cons (f (g a)) r)))))
(m2 (a b r)
(cond ((null a) (nreverse r))
((null b) (nreverse r))
(t (m2 (cdr a)
(cdr b)
(cons (f (g a) (g b)) r))))))
(if (null b)
(m1 a nil)
(m2 a (car b) nil)))))
With MAP, MAPCAR is the MAP of CAR and MAPLIST is the MAP of the identity function. Once MAPCAR and MAPLIST have been created, MAP can be recycled.
(setq mapcar (map car)) (setq maplist (map (lambda (x) x))) (setq map nil)
REMOVE-IF-NOT is the Common LISP name of FILTER, but "filter" seems more intuitive than the double negation of "remove if not".
(defun filter (p a)
(labels ((f (a r)
(cond ((null a) (nreverse r))
((p (car a)) (f (cdr a)
(cons (car a) r)))
(t (f (cdr a) r)))))
(f a nil)))
(setq remove-if-not filter)
EQUAL is simple when there are only lists and atoms.
(defun equal (a b)
(or (eq a b)
(and (not (atom a))
(not (atom b))
(equal (car a) (car b))
(equal (cdr a) (cdr b)))))
Nothing special about MEMBER and ASSOC.
(defun member (x a)
(cond ((null a) nil)
((equal x (car a)) a)
(t (member x (cdr a)))))
(defun assoc (x a)
(cond ((null a) nil)
((equal x (caar a)) (car a))
(t (assoc x (cdr a)))))
FLATTEN cannot be tail-recursive, because it traverses a tree, but at least it can be linear-recursive. This version flattens the cdr part of its argument first and then conses the elements of the flattened car part to it.
(defun flatten (x)
(labels
((f (x r)
(cond ((null x) r)
((atom x) (cons x r))
(t (f (car x)
(f (cdr x) r))))))
(f x nil)))
The LOOP special form is like Scheme's "named LET". It expands as follows:
(loop name ((v1 a1) ...) --> ((LABELS ((name (v1 ...) expr))
expr ...) name)
a1 ...)
(defmacro loop (a bs x . xs)
(let ((vs (mapcar car bs))
(as (mapcar cadr bs)))
@((labels ((,a ,vs ,x . ,xs))
,a) . ,as)))
Using LOOP, tail-recursive versions of APPEND and NCONC are straight-forward.
(defun append ls
(loop next ((ls (reverse ls)) (r nil))
(cond ((null ls) r)
(t (next (cdr ls)
(revappend (reverse (car ls))
r))))))
(defun nconc ls
(loop next ((ls (reverse ls)) (r nil))
(cond ((null ls) r)
(t (next (cdr ls)
(nreconc (nreverse (car ls))
r))))))
PRIN and TERPRI are simple. Note that TERPRI prints a blank before its line feed, but nothing can be done about this — at least not in a portable way. For instance,
(defun terpri () (prin1 '/ ))
would work on Unix, but probably not on DOS, because the slash would escape the CR character of the CR,LF sequence delimiting a line. Of course TERPRI could be implemented as a built-in function, but this does not seem to be worth the trouble.
(defun prin (x) (prin1 x) (prin1 '/ ) x) (defun terpri () (print '/ ))
MACROEXPAND-1 is only so simple because KILO LISP is a true LISP-1, where even macros are in the same namespace as functions and variables. The value of a macro is
(macro *closure*)
where *CLOSURE* is the function expanding the associated special form. Therefore, the macro expanding function can be extracted from the binding of a derived syntax keyword and then applied to the arguments of the special form in which the keyword appears. E.g., given the form
X = (let ((a 1)) a)
the expression
(apply (cadar (binding (car X))) (cdr X))
will expand the special form X. MACROEXPAND-1 automates this process and also checks if car(X) really is a macro. If not, it just returns X.
(defun macroexpand-1 (x)
(let ((m (and (atom (car x))
(car (binding (car x))))))
(if (eq 'macro (car m))
(apply (cadr m) (cdr x))
x)))