X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=391aae10f0ef8c0490cd2acc5ebce6a8eb28df94;hb=835768a81dad03b7eb94c2058e234413ba066396;hp=ae83f975482072eb4a07fd3be14fc46efc27756b;hpb=942e5de3f3e27e1cc6ae4aae69c040fa1dc7db00;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index ae83f97..391aae1 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -49,7 +49,7 @@
 	   ;; slow, so if anyone cares about performance of
 	   ;; non-toplevel DEFSTRUCTs, it should be rewritten to be
 	   ;; cleverer. -- WHN 2002-10-23
-	   (sb!c::compiler-note
+	   (sb!c:compiler-notify
 	    "implementation limitation: ~
              Non-toplevel DEFSTRUCT constructors are slow.")
 	   (with-unique-names (layout)
@@ -455,7 +455,7 @@
 	  (let ((inherited (accessor-inherited-data name defstruct)))
 	    (cond
 	      ((not inherited)
-	       (stuff `(proclaim '(inline ,name (setf ,name))))
+	       (stuff `(declaim (inline ,name (setf ,name))))
 	       ;; FIXME: The arguments in the next two DEFUNs should
 	       ;; be gensyms. (Otherwise e.g. if NEW-VALUE happened to
 	       ;; be the name of a special variable, things could get
@@ -805,9 +805,16 @@
 			   (dsd-index included-slot))
 		     (dd-inherited-accessor-alist dd)
 		     :test #'eq :key #'car))
-	  (parse-1-dsd dd
-		       modified
-		       (copy-structure included-slot)))))))
+	  (let ((new-slot (parse-1-dsd dd
+                                       modified
+                                       (copy-structure included-slot))))
+            (when (and (neq (dsd-type new-slot) (dsd-type included-slot))
+                       (not (subtypep (dsd-type included-slot)
+                                      (dsd-type new-slot)))
+                       (dsd-safe-p included-slot))
+              (setf (dsd-safe-p new-slot) nil)
+              ;; XXX: notify?
+              )))))))
 
 ;;;; various helper functions for setting up DEFSTRUCTs
 
@@ -986,7 +993,7 @@
 
     (let ((predicate-name (dd-predicate-name dd)))
       (when predicate-name
-	(sb!xc:proclaim `(ftype (sfunction (t) t) ,predicate-name))
+	(sb!xc:proclaim `(ftype (sfunction (t) boolean) ,predicate-name))
 	;; Provide inline expansion (or not).
 	(ecase (dd-type dd)
 	  ((structure funcallable-structure)