X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fearly-low.lisp;h=b69c59266749e569157436444ba8437cd3a8b4fd;hb=d25e3478acccec70402ff32554669a982be8e281;hp=7fca8d34d80e7f5ba34bf2eb96154f3e15f50bb7;hpb=c70ef5922e4e5290fab52b90c3614be83c0b8f8b;p=sbcl.git diff --git a/src/pcl/early-low.lisp b/src/pcl/early-low.lisp index 7fca8d3..b69c592 100644 --- a/src/pcl/early-low.lisp +++ b/src/pcl/early-low.lisp @@ -44,6 +44,12 @@ ;;; and use that to replace all three variables.) (defvar *pcl-package* (find-package "SB-PCL")) +(declaim (inline defstruct-classoid-p)) +(defun defstruct-classoid-p (classoid) + ;; It is non-obvious to me why STRUCTURE-CLASSOID-P doesn't + ;; work instead of this. -- NS 2008-03-14 + (typep (layout-info (classoid-layout classoid)) 'defstruct-description)) + ;;; This excludes structure types created with the :TYPE option to ;;; DEFSTRUCT. It also doesn't try to deal with types created by ;;; hairy DEFTYPEs, e.g. @@ -53,12 +59,10 @@ ;;; it needs a more mnemonic name. -- WHN 19991204 (defun structure-type-p (type) (and (symbolp type) - (not (condition-type-p type)) (let ((classoid (find-classoid type nil))) (and classoid - (typep (layout-info - (classoid-layout classoid)) - 'defstruct-description))))) + (not (condition-classoid-p classoid)) + (defstruct-classoid-p classoid))))) ;;; Symbol contruction utilities (defun format-symbol (package format-string &rest format-arguments)