defconstant uses eval-when

[jscl.git] / src / boot.lisp

diff --git a/src/boot.lisp b/src/boot.lisp
index 856879f..edfc576 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -24,13 +24,13 @@
 
 (/debug "loading boot.lisp!")
 
-(eval-when-compile
+(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
@@ -38,7 +38,7 @@
     (%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)
@@ -485,12 +485,14 @@
     `(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)
@@ -498,7 +500,8 @@
                                     (array 'arrayp)
                                     (string 'stringp)
                                     (atom 'atom)
-                                    (null 'null))
+                                    (null 'null)
+                                    (package 'packagep))
                              ,value)
                            ,@(or (rest c)
                                  (list nil)))))