converted the last remaining defspecials to Builtin

Builtin.pm

@@ -20,6 +20,24 @@ use Interp;
 # Builtins get their arguments directly as a Lisp list, have names
 # beginning with 'B', and are defined here (except for, well, exceptions)
 
+sub Bwhen {
+        my ($cond, $bodyforms) = checkargs($_[0], 'er');
+        my $result = $Nil;
+        unless (is_nil(Eval($cond))) {
+                $result = eval_forms($bodyforms);
+        }
+        return $result;
+}
+
+sub Bunless {
+        my ($cond, $bodyforms) = checkargs($_[0], 'er');
+        my $result = $Nil;
+        if (is_nil(Eval($cond))) {
+                $result = eval_forms($bodyforms);
+        }
+        return $result;
+}
+
 sub Bpush {
         my ($item, $var) = checkargs($_[0], 'ey');
         my $list = Eval($var);
@@ -632,11 +650,6 @@ sub make_named_function {
         return $name;
 }
 
-sub Bdefspecial {
-        my ($name, $params, $body) = checkargs($_[0], 'ylr');
-        return make_named_function($name, $params, $body, 1);
-}
-
 sub Bdefun {
         my ($name, $params, $body) = checkargs($_[0], 'ylr');
         return make_named_function($name, $params, $body, 0);
@@ -1019,9 +1032,6 @@ my @builtins =                          # [name, func, is_special, doc]
      ["function", \&Bfunction, 1, "return the argument as a function"],
      ["quote", \&Bquote, 1, "return the argument without evaluating it"],
      ["defun", \&Bdefun, 1, "define function with NAME, ARGS, and clauses"],
-     ["defspecial", \&Bdefspecial, 1,
-      "define special form with NAME, ARGS, and clauses"],
-     ["defun", \&Bdefun, 1, "define function with NAME, ARGS, and clauses"],
      ["car", \&Bcar, 0, "return the car of PAIR"],
      ["cdr", \&Bcdr, 0, "return the cdr of PAIR"],
      ["intern", \&Bintern, 0, "return symbol with name STRING"],
@@ -1142,6 +1152,10 @@ my @builtins =                          # [name, func, is_special, doc]
       "prepend ITEM to the list in VAR and store the result in VAR"],
      ["pop", \&Bpop, 1,
       "remove the first item of list in VAR, store changed VAR, return item"],
+     ["when", \&Bwhen, 1,
+      "if COND yields true, eval BODYFORMS and return the result of the last"],
+     ["unless", \&Bunless, 1,
+      "if COND yields nil, eval BODYFORMS and return the result of the last"],
     );
 
 sub init {

Fundamental.lisp

@@ -145,41 +145,6 @@
 (fset 'not #'null)
 (fset 'string-concat #'concat)
 
-;; (defspecial defvar (sym &optional init-value)
-;;   (set sym (eval init-value)))
-
-;; (defspecial while (cond &rest body)
-;;   "while COND is true, eval &rest BODY"
-;;   (format t "TRC (while %s %s)\n" cond body)
-;;   (if (eval cond)
-;;       (progn (eval-list body)
-;;              (apply #'while (cons cond body)))
-;;     nil))
-
-;; deeply unhygienic, alas
-;; (defspecial push (pusharg-elem pusharg-var)
-;;   "prepend ELEM to the list stored in VAR, store result in VAR, and return it"
-;;   (set pusharg-var (cons (eval pusharg-elem) (eval pusharg-var))))
-
-;; (defspecial pop (poparg-var)
-;;   "pop the first item off the list in VAR, store result, and return the item"
-;;   (let* ((poparg-l (eval poparg-var))
-;;          (poparg-item (car poparg-l)))
-;;     (set poparg-var (cdr poparg-l))
-;;     poparg-item))
-
-;; (defspecial dolist (formargs &rest body)
-;;   "(dolist (loopvar listform [resultform [start [end]]]) . body)"
-;;   (let* ((dolist-loopvar (car formargs))
-;;          (dolist-start (or (eval (cadddr formargs)) 0))
-;;          (dolist-end (eval (car (cddddr formargs))))
-;;          (dolist-list (sublist (eval (cadr formargs)) dolist-start dolist-end))
-;;          (dolist-resultform (caddr formargs)))
-;;     ;; (format t "dolist-list %s\n" dolist-list)
-;;     (while (set dolist-loopvar (pop dolist-list))
-;;       (eval-list body))
-;;     (eval dolist-resultform)))
-
 (defun sequencep (object)
   "return t if OBJECT is a sequence (list or string), nil else"
   (or (listp object) (stringp object)))
@@ -440,10 +405,6 @@
 (defun 1- (n) (- n 1))
 (defun 2+ (n) (+ n 2))
 (defun 2- (n) (- n 2))
-;; (defspecial incf (var &optional incr)
-;;     (set var (eval (list '+ var (or incr 1)))))
-;; (defspecial decf (var &optional decr)
-;;     (set var (eval (list '- var (or decr 1)))))
 
 (defun fib (n)
   (if (< n 2)
@@ -520,34 +481,6 @@
                     (helper (1- n) (* n acc))))))
     (helper n 1)))
 
-(defun eval-list (l)
-  (if (null l)
-      nil
-    (let ((firstval (eval (car l)))
-          (rest (cdr l)))
-      (if (null rest)
-          firstval
-        (eval-list rest)))))
-
-(defspecial unless (cond &rest bodyforms)
-  "if COND yields nil, eval &rest BODYFORMS and return the result of the last"
-  (if (not (eval cond))
-      (eval-list bodyforms)))
-
-(defspecial when (cond &rest bodyforms)
-  "if COND yields true, eval &rest BODYFORMS and return the result of the last"
-  (if (eval cond)
-      (eval-list bodyforms)))
-
-;; (defspecial cond (&rest clauses)
-;;   "eval the car of each of CLAUSES until true, then the rest of this clause"
-;;   (if (null clauses)
-;;       nil
-;;     (let ((clause (car clauses)))
-;;       (if (eval (car clause))
-;;           (eval (cons 'progn (cdr clause)))
-;;         (apply 'cond (cdr clauses))))))
-
 (defun progn (&rest body)
   (last body))
 

Util.pm

@@ -17,7 +17,7 @@ use Exporter ();
 BEGIN {
         @ISA = qw(Exporter);
         @EXPORT = qw( is_def is_sym is_list tornil array2list list2array
-                      checkargs eval_forms
+                      checkargs
                     );
 }
 

tests/038-scope.lisp

@@ -2,7 +2,7 @@
                     (let ((f (lambda () (print a))))
                       (let ((a 'dynamic))
                         (funcall f))))
-         'dynamic)
+         'lexical)
 
 (defun make-counter (&optional init)
   (let ((counter (or init 0)))
@@ -17,8 +17,8 @@
 (testcmp "counter a 0" '(a) 0)
 (testcmp "counter a 1" '(a) 1)
 (testcmp "counter a 2" '(a) 2)
-(testcmp "counter b 0" '(a) 119)
-(testcmp "counter b 1" '(a) 120)
+(testcmp "counter b 0" '(b) 119)
+(testcmp "counter b 1" '(b) 120)
 (testcmp "counter a 3" '(a) 3)
-(testcmp "counter b 2" '(a) 121)
+(testcmp "counter b 2" '(b) 121)