X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=c5e1a7a938f7fc47095444c7e088edf45e7fee48;hb=bef0d9c1274819ee3fb886401209662bace136ce;hp=4aefaff6a814a4495f70909ea1f812c900e5cbe6;hpb=5fc1ec5b716d89f5018bc159a88f82cb2077b7e6;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 4aefaff..c5e1a7a 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -789,13 +789,17 @@
   new-value)
 #!-sb-fluid
 (progn
+  ;; Not all xc hosts are happy about SETF compiler macros: CMUCL 19
+  ;; does not accept them at all, and older SBCLs give a full warning.
+  ;; So the easy thing is to hide this optimization from all xc hosts.
   #-sb-xc-host
   (define-compiler-macro (setf info) (&whole whole
                                              new-value
                                              class
                                              type
                                              name
-                                             &optional (env-list nil env-list-p))
+                                             &optional (env-list nil
+                                                                 env-list-p))
     ;; Constant CLASS and TYPE is an overwhelmingly common special case,
     ;; and we can resolve it much more efficiently than the general
     ;; case.
@@ -932,7 +936,7 @@
   :default
   #+sb-xc-host (specifier-type 'function)
   #-sb-xc-host (if (fboundp name)
-                   (extract-fun-type (fdefinition name))
+                   (specifier-type (sb!impl::%fun-type (fdefinition name)))
                    (specifier-type 'function)))
 
 ;;; the ASSUMED-TYPE for this function, if we have to infer the type