;; on me (e.g. by using me as *CURRENT-COMPONENT*, or by pushing
;; LAMBDAs onto my NEW-FUNCTIONALS, as in sbcl-0.pre7.115).
(info :no-ir2-yet :type (or ir2-component (member :no-ir2-yet :dead)))
- ;; the SOURCE-INFO structure describing where this component was
- ;; compiled from
- (source-info *source-info* :type source-info)
;; count of the number of inline expansions we have done while
;; compiling this component, to detect infinite or exponential
;; blowups
:read-only t)
;; the type which values of this leaf must have
(type *universal-type* :type ctype)
+ ;; the type which values of this leaf have last been defined to have
+ ;; (but maybe won't have in future, in case of redefinition)
+ (defined-type *universal-type* :type ctype)
;; where the TYPE information came from:
;; :DECLARED, from a declaration.
;; :ASSUMED, from uses of the object.
;; true if there was ever a REF or SET node for this leaf. This may
;; be true when REFS and SETS are null, since code can be deleted.
(ever-used nil :type boolean)
- ;; is it declared dynamic-extent?
- (dynamic-extent nil :type boolean)
+ ;; is it declared dynamic-extent, or truly-dynamic-extent?
+ (dynamic-extent nil :type (member nil t :truly))
;; some kind of info used by the back end
(info nil))
;; it looks as though it's never interesting to get debug names
;; from them, so it's moot. -- WHN)
(leaf-source-name leaf)))
+(defun leaf-%debug-name (leaf)
+ (when (functional-p leaf)
+ (functional-%debug-name leaf)))
;;; The CONSTANT structure is used to represent known constant values.
-;;; If NAME is not null, then it is the name of the named constant
-;;; which this leaf corresponds to, otherwise this is an anonymous
-;;; constant.
-(def!struct (constant (:include leaf))
+;;; Since the same constant leaf may be shared between named and anonymous
+;;; constants, %SOURCE-NAME is never used.
+(def!struct (constant (:constructor make-constant (value
+ &aux
+ (type (ctype-of value))
+ (%source-name '.anonymous.)
+ (where-from :defined)))
+ (:include leaf))
;; the value of the constant
- (value nil :type t))
+ (value (missing-arg) :type t))
(defprinter (constant :identity t)
- (%source-name :test %source-name)
value)
;;; The BASIC-VAR structure represents information common to all
(plist () :type list)
;; xref information for this functional (only used for functions with an
;; XEP)
- (xref () :type list))
+ (xref () :type list)
+ ;; True if this functional was created from an inline expansion
+ (inline-expanded nil :type boolean))
(defprinter (functional :identity t)
%source-name
%debug-name
(call-lexenv nil :type (or lexenv null))
;; list of embedded lambdas
(children nil :type list)
- (parent nil :type (or clambda null)))
+ (parent nil :type (or clambda null))
+ (allow-instrumenting *allow-instrumenting* :type boolean))
(defprinter (clambda :conc-name lambda- :identity t)
%source-name
%debug-name
;; propagation. This is left null by the lambda pre-pass if it
;; determine that this is a set closure variable, and is thus not a
;; good subject for flow analysis.
- (constraints nil :type (or sset null))
+ (constraints nil :type (or null t #| FIXME: conset |#))
+ ;; Initial type of a LET variable as last seen by PROPAGATE-FROM-SETS.
+ (last-initial-type *universal-type* :type ctype)
;; The FOP handle of the lexical variable represented by LAMBDA-VAR
;; in the fopcompiler.
(fop-value nil))
(def!struct (ref (:include valued-node (reoptimize nil))
(:constructor make-ref
(leaf
+ &optional (%source-name '.anonymous.)
&aux (leaf-type (leaf-type leaf))
(derived-type
(make-single-value-type leaf-type))))
(:copier nil))
;; The leaf referenced.
- (leaf nil :type leaf))
+ (leaf nil :type leaf)
+ ;; CONSTANT nodes are always anonymous, since we wish to coalesce named and
+ ;; unnamed constants that are equivalent, we need to keep track of the
+ ;; reference name for XREF.
+ (%source-name (missing-arg) :type symbol :read-only t))
(defprinter (ref :identity t)
#!+sb-show id
+ %source-name
leaf)
;;; Naturally, the IF node always appears at the end of a block.
;; the blocks that we execute next in true and false case,
;; respectively (may be the same)
(consequent (missing-arg) :type cblock)
- (consequent-constraints nil :type (or null sset))
+ (consequent-constraints nil :type (or null t #| FIXME: conset |#))
(alternative (missing-arg) :type cblock)
- (alternative-constraints nil :type (or null sset)))
+ (alternative-constraints nil :type (or null t #| FIXME: conset |#)))
(defprinter (cif :conc-name if- :identity t)
(test :prin1 (lvar-uses test))
consequent