X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=lispstrack.lisp;h=bd51e288a4ff1d72ae77e798c1edd840cde11f42;hb=405e505cf5a764e58f00911950623ad652b874ef;hp=79b9b6b064db762ac78e94489ad4f48acab03cc1;hpb=8eb087275657563dad1e433cd3c85b7c487380ab;p=jscl.git

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 79b9b6b..bd51e28 100644
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -35,7 +35,7 @@
         (%compile-defvar ',name))
       (setq ,name ,value)))
 
-  (defmacro defvar (name value)
+  (defmacro defvar (name &optional value)
     `(%defvar ,name ,value))
 
  (defmacro %defun (name args &rest body)
@@ -66,22 +66,7 @@
  (defun find-symbol (name)
    (get *package* name))
 
- (defmacro when (condition &rest body)
-   `(if ,condition (progn ,@body) nil))
-
- (defmacro unless (condition &rest body)
-   `(if ,condition nil (progn ,@body)))
-
- (defmacro dolist (iter &rest body)
-   (let ((var (first iter))
-         (g!list (make-symbol "LIST")))
-     `(let ((,g!list ,(second iter))
-            (,var nil))
-        (while ,g!list
-          (setq ,var (car ,g!list))
-          ,@body
-          (setq ,g!list (cdr ,g!list))))))
-
+ ;; Basic functions
  (defun = (x y) (= x y))
  (defun + (x y) (+ x y))
  (defun - (x y) (- x y))
@@ -90,16 +75,16 @@
  (defun 1+ (x) (+ x 1))
  (defun 1- (x) (- x 1))
  (defun zerop (x) (= x 0))
- (defun not (x) (if x nil t))
-
  (defun truncate (x y) (floor (/ x y)))
 
+ (defun eql (x y) (eq x y))
+
+ (defun not (x) (if x nil t))
+
  (defun cons (x y ) (cons x y))
  (defun consp (x) (consp x))
-
  (defun car (x) (car x))
  (defun cdr (x) (cdr x))
-
  (defun caar (x) (car (car x)))
  (defun cadr (x) (car (cdr x)))
  (defun cdar (x) (cdr (car x)))
@@ -107,18 +92,99 @@
  (defun caddr (x) (car (cdr (cdr x))))
  (defun cdddr (x) (cdr (cdr (cdr x))))
  (defun cadddr (x) (car (cdr (cdr (cdr x)))))
-
  (defun first (x) (car x))
  (defun second (x) (cadr x))
  (defun third (x) (caddr x))
  (defun fourth (x) (cadddr x))
 
- (defun list (&rest args)
-   args)
-
+ (defun list (&rest args) args)
  (defun atom (x)
-   (not (consp x))))
+   (not (consp x)))
+
+ ;; Basic macros
+
+  (defmacro incf (x &optional (delta 1))
+    `(setq ,x (+ ,x ,delta)))
+
+  (defmacro decf (x &optional (delta 1))
+    `(setq ,x (- ,x ,delta)))
+
+ (defmacro push (x place)
+   `(setq ,place (cons ,x ,place)))
+
+ (defmacro when (condition &rest body)
+   `(if ,condition (progn ,@body) nil))
+
+ (defmacro unless (condition &rest body)
+   `(if ,condition nil (progn ,@body)))
+
+ (defmacro dolist (iter &rest body)
+   (let ((var (first iter))
+         (g!list (make-symbol "LIST")))
+     `(let ((,g!list ,(second iter))
+            (,var nil))
+        (while ,g!list
+          (setq ,var (car ,g!list))
+          ,@body
+          (setq ,g!list (cdr ,g!list))))))
+
+ (defmacro cond (&rest clausules)
+   (if (null clausules)
+       nil
+       (if (eq (caar clausules) t)
+           `(progn ,@(cdar clausules))
+           `(if ,(caar clausules)
+                (progn ,@(cdar clausules))
+                (cond ,@(cdr clausules))))))
+
+ (defmacro case (form &rest clausules)
+   (let ((!form (make-symbol "FORM")))
+     `(let ((,!form ,form))
+        (cond
+          ,@(mapcar (lambda (clausule)
+                      (if (eq (car clausule) t)
+                          clausule
+                          `((eql ,!form ,(car clausule))
+                            ,@(cdr clausule))))
+                    clausules)))))
+
+  (defmacro ecase (form &rest clausules)
+    `(case ,form
+       ,@(append
+          clausules
+          `((t
+             (error "ECASE expression failed."))))))
+
+  (defmacro and (&rest forms)
+    (cond
+      ((null forms)
+       t)
+      ((null (cdr forms))
+       (car forms))
+      (t
+       `(if ,(car forms)
+            (and ,@(cdr forms))
+            nil))))
+
+  (defmacro or (&rest forms)
+    (cond
+      ((null forms)
+       nil)
+      ((null (cdr forms))
+       (car forms))
+      (t
+       (let ((g (make-symbol "VAR")))
+         `(let ((,g ,(car forms)))
+            (if ,g ,g (or ,@(cdr forms))))))))
+
+    (defmacro prog1 (form &rest body)
+      (let ((value (make-symbol "VALUE")))
+        `(let ((,value ,form))
+           ,@body
+           ,value))))
 
+;;; This couple of helper functions will be defined in both Common
+;;; Lisp and in Lispstrack.
 (defun ensure-list (x)
   (if (listp x)
       x
@@ -131,6 +197,9 @@
                (cdr list)
                (funcall func initial (car list)))))
 
+;;; Go on growing the Lisp language in Lispstrack, with more high
+;;; level utilities as well as correct versions of other
+;;; constructions.
 #+lispstrack
 (progn
   (defmacro defun (name args &rest body)
@@ -138,7 +207,7 @@
        (%defun ,name ,args ,@body)
        ',name))
 
-  (defmacro defvar (name value)
+  (defmacro defvar (name &optional value)
     `(progn
        (%defvar ,name ,value)
        ',name))
@@ -160,12 +229,6 @@
   (defun reverse (list)
     (reverse-aux list '()))
 
-  (defmacro incf (x)
-    `(setq ,x (1+ ,x)))
-
-  (defmacro decf (x)
-    `(setq ,x (1- ,x)))
-
   (defun list-length (list)
     (let ((l 0))
       (while (not (null list))
@@ -187,71 +250,16 @@
         (cons (funcall func (car list))
               (mapcar func (cdr list)))))
 
-  (defmacro push (x place)
-    `(setq ,place (cons ,x ,place)))
-
-  (defmacro cond (&rest clausules)
-    (if (null clausules)
-        nil
-        (if (eq (caar clausules) t)
-            `(progn ,@(cdar clausules))
-            `(if ,(caar clausules)
-                 (progn ,@(cdar clausules))
-                 (cond ,@(cdr clausules))))))
-
-  (defmacro case (form &rest clausules)
-    (let ((!form (make-symbol "FORM")))
-      `(let ((,!form ,form))
-         (cond
-           ,@(mapcar (lambda (clausule)
-                       (if (eq (car clausule) t)
-                           clausule
-                           `((eql ,!form ,(car clausule))
-                             ,@(cdr clausule))))
-                     clausules)))))
-
-  (defmacro ecase (form &rest clausules)
-    `(case ,form
-       ,@(append
-          clausules
-          `((t
-             (error "ECASE expression failed."))))))
-
   (defun code-char (x) x)
   (defun char-code (x) x)
   (defun char= (x y) (= x y))
 
-  (defmacro and (&rest forms)
-    (cond
-      ((null forms)
-       t)
-      ((null (cdr forms))
-       (car forms))
-      (t
-       `(if ,(car forms)
-            (and ,@(cdr forms))
-            nil))))
-
-  (defmacro or (&rest forms)
-    (cond
-      ((null forms)
-       nil)
-      ((null (cdr forms))
-       (car forms))
-      (t
-       (let ((g (make-symbol "VAR")))
-         `(let ((,g ,(car forms)))
-            (if ,g ,g (or ,@(cdr forms))))))))
-
-  (defmacro prog1 (form &rest body)
-    (let ((value (make-symbol "VALUE")))
-      `(let ((,value ,form))
-         ,@body
-         ,value)))
-
   (defun <= (x y) (or (< x y) (= x y)))
   (defun >= (x y) (not (< x y)))
 
+  (defun integerp (x)
+    (and (numberp x) (= (floor x) x)))
+
   (defun plusp (x) (< 0 x))
   (defun minusp (x) (< x 0))
 
@@ -264,9 +272,6 @@
       ((zerop n) (car list))
       (t (nth (1- n) (cdr list)))))
 
-  (defun integerp (x)
-    (and (numberp x) (= (floor x) x)))
-
   (defun last (x)
     (if (null (cdr x))
         x
@@ -338,9 +343,6 @@
         (incf index))
       ret))
 
-  (defun eql (x y)
-    (eq x y))
-
   (defun assoc (x alist)
     (cond
       ((null alist)