;;; Lisp world from scratch. This code has to define enough language
;;; to the compiler to be able to run.
+(/debug "loading boot.lisp!")
+
(eval-when-compile
(let ((defmacro-macroexpander
'#'(lambda (form)
(declaim (special ,name))
(declaim (constant ,name))
(setq ,name ,value)
- ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+ ,@(when (stringp docstring) `((oset ,docstring ',name "vardoc")))
',name))
(defconstant t 't)
`(progn
(declaim (special ,name))
,@(when value-p `((unless (boundp ',name) (setq ,name ,value))))
- ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+ ,@(when (stringp docstring) `((oset ,docstring ',name "vardoc")))
',name))
(defmacro defparameter (name value &optional docstring)
`(progn
(setq ,name ,value)
- ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+ ,@(when (stringp docstring) `((oset ,docstring ',name "vardoc")))
',name))
(defmacro defun (name args &rest body)
(defvar *gensym-counter* 0)
(defun gensym (&optional (prefix "G"))
(setq *gensym-counter* (+ *gensym-counter* 1))
- (make-symbol (concat-two prefix (integer-to-string *gensym-counter*))))
+ (make-symbol (concat prefix (integer-to-string *gensym-counter*))))
(defun boundp (x)
(boundp x))
(defmacro do (varlist endlist &body body)
`(block nil
- (let ,(mapcar (lambda (x) (list (first x) (second x))) varlist)
+ (let ,(mapcar (lambda (x) (if (symbolp x)
+ (list x nil)
+ (list (first x) (second x)))) varlist)
(while t
(when ,(car endlist)
(return (progn ,@(cdr endlist))))
(psetq
,@(apply #'append
(mapcar (lambda (v)
- (and (consp (cddr v))
+ (and (listp v)
+ (consp (cddr v))
(list (first v) (third v))))
varlist)))))))
(defmacro do* (varlist endlist &body body)
`(block nil
- (let* ,(mapcar (lambda (x) (list (first x) (second x))) varlist)
+ (let* ,(mapcar (lambda (x1) (if (symbolp x1)
+ (list x1 nil)
+ (list (first x1) (second x1)))) varlist)
(while t
(when ,(car endlist)
(return (progn ,@(cdr endlist))))
(setq
,@(apply #'append
(mapcar (lambda (v)
- (and (consp (cddr v))
+ (and (listp v)
+ (consp (cddr v))
(list (first v) (third v))))
varlist)))))))
((listp seq)
(list-length seq))))
-(defun concat-two (s1 s2)
- (concat-two s1 s2))
-
(defmacro with-collect (&body body)
(let ((head (gensym))
(tail (gensym)))
((null (cddr pairs))
(let ((place (!macroexpand-1 (first pairs)))
(value (second pairs)))
- (multiple-value-bind (vars vals store-vars writer-form)
+ (multiple-value-bind (vars vals store-vars writer-form reader-form)
(get-setf-expansion place)
;; TODO: Optimize the expansion a little bit to avoid let*
;; or multiple-value-bind when unnecesary.
`(let* ,(mapcar #'list vars vals)
(multiple-value-bind ,store-vars
,value
- ,writer-form)))))
+ ,writer-form
+ ,reader-form)))))
(t
`(progn
,@(do ((pairs pairs (cddr pairs))
(cond
,@(mapcar (lambda (c)
(if (eq (car c) t)
- `((t ,@(rest c)))
+ `(t ,@(rest c))
`((,(ecase (car c)
(integer 'integerp)
(cons 'consp)
(symbol 'symbolp)
+ (function 'functionp)
+ (float 'floatp)
(array 'arrayp)
(string 'stringp)
(atom 'atom)
`(let ((,g!x ,x))
(typecase ,g!x
,@clausules
- (t (error "~X fell through etypeacase expression." ,g!x))))))
+ (t (error "~X fell through etypecase expression." ,g!x))))))
(defun notany (fn seq)
(not (some fn seq)))