X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdefstruct.lisp;h=89a4edc56b902830a1d22558808bd897f2ca9bb7;hb=d76c81b0ca4dcfc99f0cd805f5c20493fa80b2b6;hp=6822ef22ea3d987b5fd0a9fb4d1aba8eb59c33d5;hpb=2d3cb6dba6461e98744eca2a1df4f770cea468ca;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 6822ef2..89a4edc 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -52,7 +52,7 @@
 	   (sb!c::compiler-note
 	    "implementation limitation: ~
              Non-toplevel DEFSTRUCT constructors are slow.")
-	   (let ((layout (gensym "LAYOUT")))
+	   (with-unique-names (layout)
 	     `(let ((,layout (info :type :compiler-layout ',name)))
 		(unless (typep (layout-info ,layout) 'defstruct-description)
 		  (error "Class is not a structure class: ~S" ',name))
@@ -207,11 +207,14 @@
 
 ;;; Return the name of a defstruct slot as a symbol. We store it as a
 ;;; string to avoid creating lots of worthless symbols at load time.
+;;;
+;;; FIXME: This has horrible package issues.  In many ways, it would
+;;; be very nice to treat the names of structure slots as strings, but
+;;; unfortunately PCL requires slot names to be interned symbols.
+;;; Maybe we want to resurrect something like the old
+;;; SB-SLOT-ACCESSOR-NAME package?
 (defun dsd-name (dsd)
-  (intern (string (dsd-%name dsd))
-	  (if (dsd-accessor-name dsd)
-	      (symbol-package (dsd-accessor-name dsd))
-	      (sane-package))))
+  (intern (dsd-%name dsd)))
 
 ;;;; typed (non-class) structures
 
@@ -223,7 +226,7 @@
 
 ;;;; shared machinery for inline and out-of-line slot accessor functions
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
 
   ;; information about how a slot of a given DSD-RAW-TYPE is to be accessed
   (defstruct raw-slot-data
@@ -1049,16 +1052,16 @@
     (collect ((moved)
 	      (retyped))
       (dolist (name (intersection onames nnames))
-	(let ((os (find name oslots :key #'dsd-name))
-	      (ns (find name nslots :key #'dsd-name)))
-	  (unless (subtypep (dsd-type ns) (dsd-type os))
+	(let ((os (find name oslots :key #'dsd-name :test #'string=))
+	      (ns (find name nslots :key #'dsd-name :test #'string=)))
+	  (unless (sb!xc:subtypep (dsd-type ns) (dsd-type os))
 	    (retyped name))
 	  (unless (and (= (dsd-index os) (dsd-index ns))
 		       (eq (dsd-raw-type os) (dsd-raw-type ns)))
 	    (moved name))))
       (values (moved)
 	      (retyped)
-	      (set-difference onames nnames)))))
+	      (set-difference onames nnames :test #'string=)))))
 
 ;;; If we are redefining a structure with different slots than in the
 ;;; currently loaded version, give a warning and return true.