Commit b815a7f9 authored by Juergen Nickelsen's avatar Juergen Nickelsen

converted the last remaining defspecials to Builtin

parent 9f815fd9
......@@ -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 {
......
......@@ -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))
......
......@@ -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
);
}
......
......@@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment