0.pre7.14.flaky4.11:

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

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 8bccb59..a3c62d9 100644 (file)
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -70,9 +70,9 @@
   ;;   A continuation that is the CONT of some node in BLOCK.
   (kind :unused :type (member :unused :deleted :inside-block :block-start
                              :deleted-block-start))
-  ;; The node which receives this value, if any. In a deleted continuation,
-  ;; this is null even though the node that receives this continuation may not
-  ;; yet be deleted.
+  ;; The node which receives this value, if any. In a deleted
+  ;; continuation, this is null even though the node that receives
+  ;; this continuation may not yet be deleted.
   (dest nil :type (or node null))
   ;; If this is a NODE, then it is the node which is to be evaluated
   ;; next. This is always null in :DELETED and :UNUSED continuations,
@@ -173,7 +173,7 @@
   ;; Following the introduced forms is a representation of the
   ;; location of the enclosing original source form. This transition
   ;; is indicated by the magic ORIGINAL-SOURCE-START marker. The first
-  ;; element of the orignal source is the "form number", which is the
+  ;; element of the original source is the "form number", which is the
   ;; ordinal number of this form in a depth-first, left-to-right walk
   ;; of the truly top-level form in which this appears.
   ;;
@@ -183,7 +183,7 @@
   ;;
   ;; The last element in the list is the top-level form number, which
   ;; is the ordinal number (in this call to the compiler) of the truly
-  ;; top-level form containing the orignal source.
+  ;; top-level form containing the original source.
   (source-path *current-path* :type list)
   ;; If this node is in a tail-recursive position, then this is set to
   ;; T. At the end of IR1 (in environment analysis) this is computed
@@ -514,7 +514,10 @@
   ;;  :DECLARED, from a declaration.
   ;;  :ASSUMED, from uses of the object.
   ;;  :DEFINED, from examination of the definition.
-  ;; FIXME: This should be a named type. (LEAF-WHERE-FROM?)
+  ;; FIXME: This should be a named type. (LEAF-WHERE-FROM? Or
+  ;; perhaps just WHERE-FROM, since it's not just used in LEAF,
+  ;; but also in various DEFINE-INFO-TYPEs in globaldb.lisp,
+  ;; and very likely elsewhere too.)
   (where-from :assumed :type (member :declared :assumed :defined))
   ;; list of the REF nodes for this leaf
   (refs () :type list)
@@ -573,7 +576,7 @@
 ;;; defined in the same compilation block, or that have inline
 ;;; expansions, or have a non-NIL INLINEP value. Whenever we change
 ;;; the INLINEP state (i.e. an inline proclamation) we copy the
-;;; structure so that former inlinep values are preserved.
+;;; structure so that former INLINEP values are preserved.
 (def!struct (defined-function (:include global-var
                                        (where-from :defined)
                                        (kind :global-function)))
@@ -1070,6 +1073,22 @@
   ;; *UNDEFINED-WARNING-LIMIT* calls.
   (warnings () :type list))
 \f
+;;; a helper for the POLICY macro, defined late here so that the
+;;; various type tests can be inlined
+(declaim (ftype (function ((or list lexenv node functional)) list)
+               %coerce-to-policy))
+(defun %coerce-to-policy (thing)
+  (let ((result (etypecase thing
+                 (list thing)
+                 (lexenv (lexenv-policy thing))
+                 (node (lexenv-policy (node-lexenv thing)))
+                 (functional (lexenv-policy (functional-lexenv thing))))))
+    ;; Test the first element of the list as a rudimentary sanity
+    ;; that it really does look like a valid policy.
+    (aver (or (null result) (policy-quality-name-p (caar result))))
+    ;; Voila.
+    result))
+\f
 ;;;; Freeze some structure types to speed type testing.
 
 #!-sb-fluid