;;; Lisp world from scratch. This code has to define enough language
;;; to the compiler to be able to run.
-(eval-when-compile
+(/debug "loading boot.lisp!")
+
+(eval-when (:compile-toplevel)
(let ((defmacro-macroexpander
'#'(lambda (form)
(destructuring-bind (name args &body body)
form
(let ((whole (gensym)))
- `(eval-when-compile
+ `(eval-when (:compile-toplevel :execute)
(%compile-defmacro ',name
'#'(lambda (,whole)
(destructuring-bind ,args ,whole
(%compile-defmacro 'defmacro defmacro-macroexpander)))
(defmacro declaim (&rest decls)
- `(eval-when-compile
+ `(eval-when (:compile-toplevel :execute)
,@(mapcar (lambda (decl) `(!proclaim ',decl)) decls)))
(defmacro defconstant (name value &optional docstring)
(write-line (lambda-code (fdefinition function)))
nil)
-(defun documentation (x type)
- "Return the documentation of X. TYPE must be the symbol VARIABLE or FUNCTION."
- (ecase type
- (function
- (let ((func (fdefinition x)))
- (oget func "docstring")))
- (variable
- (unless (symbolp x)
- (error "The type of documentation `~S' is not a symbol." type))
- (oget x "vardoc"))))
-
(defmacro multiple-value-bind (variables value-from &body body)
`(multiple-value-call (lambda (&optional ,@variables &rest ,(gensym))
,@body)
((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))
`(let ((,value ,x))
(cond
,@(mapcar (lambda (c)
- (if (eq (car c) t)
+ (if (find (car c) '(t otherwise))
`(t ,@(rest c))
`((,(ecase (car c)
(integer 'integerp)
(cons 'consp)
+ (list 'listp)
+ (vector 'vectorp)
+ (character 'characterp)
+ (sequence 'sequencep)
(symbol 'symbolp)
(function 'functionp)
(float 'floatp)
(array 'arrayp)
(string 'stringp)
(atom 'atom)
- (null 'null))
+ (null 'null)
+ (package 'packagep))
,value)
,@(or (rest c)
(list nil)))))
`(let ((,g!x ,x))
(typecase ,g!x
,@clausules
- (t (error "~X fell through etypecase expression." ,g!x))))))
+ (t (error "~S fell through etypecase expression." ,g!x))))))
(defun notany (fn seq)
(not (some fn seq)))
(defun error (fmt &rest args)
(%throw (apply #'format nil fmt args)))
+
+(defmacro nth-value (n form)
+ `(multiple-value-call (lambda (&rest values)
+ (nth ,n values))
+ ,form))