(%compile-defvar ',name))
(setq ,name ,value)))
- (defmacro defvar (name value)
+ (defmacro defvar (name &optional value)
`(%defvar ,name ,value))
(defmacro %defun (name args &rest body)
(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))
(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)))
(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
(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)
(%defun ,name ,args ,@body)
',name))
- (defmacro defvar (name value)
+ (defmacro defvar (name &optional value)
`(progn
(%defvar ,name ,value)
',name))
(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))
(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))
((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
(incf index))
ret))
- (defun eql (x y)
- (eq x y))
-
(defun assoc (x alist)
(cond
((null alist)
projects / jscl.git / blobdiff