Fix some bugs

lisp/kernel.gl

@@ -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)))