X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdeftype.lisp;h=370852556b1ad7f65a10e9aa1bfa360d63a4f3ae;hb=9c510b74eca61bbcc2014dc2b1d02049dff50508;hp=a0a992f838fde283d03295609bb75ffcdc4a4b88;hpb=aa1a5c6ea31c248587d78f62943ad749ea8fbe2f;p=sbcl.git diff --git a/src/compiler/deftype.lisp b/src/compiler/deftype.lisp index a0a992f..3708525 100644 --- a/src/compiler/deftype.lisp +++ b/src/compiler/deftype.lisp @@ -19,11 +19,12 @@ (defun %deftype (name) (setf (classoid-cell-pcl-class (find-classoid-cell name :create t)) nil)) -(def!macro sb!xc:deftype (name lambda-list &body body) +(def!macro sb!xc:deftype (&whole form name lambda-list &body body) #!+sb-doc "Define a new type, with syntax like DEFMACRO." (unless (symbolp name) - (error "type name not a symbol: ~S" name)) + (bad-type name 'symbol "Type name is not a symbol:~% ~S" + form)) (multiple-value-bind (expander-form doc source-location-form) (multiple-value-bind (forms decls doc) (parse-body body) ;; FIXME: We could use CONSTANTP here to deal with slightly more @@ -31,7 +32,7 @@ ;; is not availble early enough. (if (and (not lambda-list) (not decls) (not (cdr forms)) (or (member (car forms) '(t nil)) - (eq 'quote (caar forms)))) + (and (consp (car forms)) (eq 'quote (caar forms))))) (values `(constant-type-expander ,(car forms)) doc '(sb!c:source-location)) (with-unique-names (whole) (multiple-value-bind (macro-body local-decs doc) @@ -49,4 +50,5 @@ ,doc ,source-location-form)) (eval-when (:load-toplevel :execute) - (%deftype ',name))))) + (%deftype ',name)) + ',name)))