Fix make-array transforms.

[sbcl.git] / src / compiler / node.lisp

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 5300228..2e5fd52 100644 (file)
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -173,17 +173,17 @@
 (!def-boolean-attribute block
   reoptimize flush-p type-check delete-p type-asserted test-modified)
 
-;;; FIXME: Tweak so that definitions of e.g. BLOCK-DELETE-P is
-;;; findable by grep for 'def.*block-delete-p'.
-(macrolet ((frob (slot)
-             `(defmacro ,(symbolicate "BLOCK-" slot) (block)
-                `(block-attributep (block-flags ,block) ,',slot))))
-  (frob reoptimize)
-  (frob flush-p)
-  (frob type-check)
-  (frob delete-p)
-  (frob type-asserted)
-  (frob test-modified))
+(macrolet ((defattr (block-slot)
+             `(defmacro ,block-slot (block)
+                `(block-attributep
+                  (block-flags ,block)
+                  ,(symbolicate (subseq (string ',block-slot) 6))))))
+  (defattr block-reoptimize)
+  (defattr block-flush-p)
+  (defattr block-type-check)
+  (defattr block-delete-p)
+  (defattr block-type-asserted)
+  (defattr block-test-modified))
 
 ;;; The CBLOCK structure represents a basic block. We include
 ;;; SSET-ELEMENT so that we can have sets of blocks. Initially the
@@ -632,10 +632,15 @@
   ;; be true when REFS and SETS are null, since code can be deleted.
   (ever-used nil :type boolean)
   ;; is it declared dynamic-extent, or truly-dynamic-extent?
-  (dynamic-extent nil :type (member nil t :truly))
+  (extent nil :type (member nil :maybe-dynamic :always-dynamic :indefinite))
   ;; some kind of info used by the back end
   (info nil))
 
+(defun leaf-dynamic-extent (leaf)
+  (let ((extent (leaf-extent leaf)))
+    (unless (member extent '(nil :indefinite))
+      extent)))
+
 ;;; LEAF name operations
 ;;;
 ;;; KLUDGE: wants CLOS..
@@ -671,7 +676,9 @@
                                                    (where-from :defined)))
                       (:include leaf))
   ;; the value of the constant
-  (value (missing-arg) :type t))
+  (value (missing-arg) :type t)
+  ;; Boxed TN for this constant, if any.
+  (boxed-tn nil :type (or null tn)))
 (defprinter (constant :identity t)
   value)
 
@@ -1073,6 +1080,9 @@
   ;; the default for a keyword or optional, represented as the
   ;; original Lisp code. This is set to NIL in &KEY arguments that are
   ;; defaulted using the SUPPLIED-P arg.
+  ;;
+  ;; For &REST arguments this may contain information about more context
+  ;; the rest list comes from.
   (default nil :type t)
   ;; the actual key for a &KEY argument. Note that in ANSI CL this is
   ;; not necessarily a keyword: (DEFUN FOO (&KEY ((BAR BAR))) ...).
@@ -1104,6 +1114,12 @@
   ;; true if the last reference has been deleted (and new references
   ;; should not be made)
   deleted
+  ;; This is set by physical environment analysis if, should it be an
+  ;; indirect lambda-var, an actual value cell object must be
+  ;; allocated for this variable because one or more of the closures
+  ;; that refer to it are not dynamic-extent.  Note that both
+  ;; attributes must be set for the value-cell object to be created.
+  explicit-value-cell
   )
 
 (def!struct (lambda-var (:include basic-var))
@@ -1126,6 +1142,14 @@
   ;; determine that this is a set closure variable, and is thus not a
   ;; good subject for flow analysis.
   (constraints nil :type (or null t #| FIXME: conset |#))
+  ;; Content-addressed indices for the CONSTRAINTs on this variable.
+  ;; These are solely used by FIND-CONSTRAINT
+  (ctype-constraints nil :type (or null hash-table))
+  (eq-constraints    nil :type (or null hash-table))
+  ;; sorted sets of constraints we like to iterate over
+  (eql-var-constraints     nil :type (or null (array t 1)))
+  (inheritable-constraints nil :type (or null (array t 1)))
+  (private-constraints     nil :type (or null (array t 1)))
   ;; 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
@@ -1147,6 +1171,8 @@
   `(lambda-var-attributep (lambda-var-flags ,var) indirect))
 (defmacro lambda-var-deleted (var)
   `(lambda-var-attributep (lambda-var-flags ,var) deleted))
+(defmacro lambda-var-explicit-value-cell (var)
+  `(lambda-var-attributep (lambda-var-flags ,var) explicit-value-cell))
 \f
 ;;;; basic node types