converted the last remaining defspecials to Builtin (b815a7f9) · Commits · lisp / lis.pl

Builtin.pm

+22 −8

Original line number	Diff line number	Diff line
		@@ -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

+0 −67

Original line number	Diff line number	Diff line
		@@ -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

+1 −1

Original line number	Diff line number	Diff line
		@@ -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

+4 −4

Original line number	Diff line number	Diff line
		@@ -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)