(&whole whole class type name &optional (env-list nil env-list-p))
;; Constant CLASS and TYPE is an overwhelmingly common special case,
;; and we can implement it much more efficiently than the general case.
- (if (and (constantp class) (constantp type))
+ (if (and (keywordp class) (keywordp type))
(let ((info (type-info-or-lose class type)))
(with-unique-names (value foundp)
`(multiple-value-bind (,value ,foundp)
(declare (type ,(type-info-type info) ,value))
(values ,value ,foundp))))
whole))
+
(defun (setf info) (new-value
class
type
tin
new-value)))
new-value)
-;;; FIXME: We'd like to do this, but Python doesn't support
-;;; compiler macros and it's hard to change it so that it does.
-;;; It might make more sense to just convert INFO :FOO :BAR into
-;;; an ordinary function, so that instead of calling INFO :FOO :BAR
-;;; you call e.g. INFO%FOO%BAR. Then dynamic linking could be handled
-;;; by the ordinary Lisp mechanisms and we wouldn't have to maintain
-;;; all this cruft..
-#|
#!-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))
- ;; Constant CLASS and TYPE is an overwhelmingly common special case, and we
- ;; can resolve it much more efficiently than the general case.
- (if (and (constantp class) (constantp type))
+ new-value
+ class
+ type
+ name
+ &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.
+ (if (and (keywordp class) (keywordp type))
(let* ((info (type-info-or-lose class type))
(tin (type-info-number info)))
(if env-list-p
(get-write-info-env ,env-list))
`(set-info-value ,name
,tin
- ,new-value)))
- whole)))
-|#
+ ,new-value))))
+ whole))
;;; the maximum density of the hashtable in a volatile env (in
;;; names/bucket)
: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