0.6.9.11:
[sbcl.git] / src / compiler / ir1tran.lisp
index 692712b..b1b9a97 100644 (file)
                             type
                             (type-intersection old-type type))))
               (cond ((eq int *empty-type*)
-                     (unless (policy nil (= brevity 3))
+                     (unless (policy nil (= inhibit-warnings 3))
                        (compiler-warning
                         "The type declarations ~S and ~S for ~S conflict."
                         (type-specifier old-type) (type-specifier type)
                    name "in an inline or notinline declaration")))
              (etypecase found
                (functional
-                (when (policy nil (>= speed brevity))
+                (when (policy nil (>= speed inhibit-warnings))
                   (compiler-note "ignoring ~A declaration not at ~
                                   definition of local function:~%  ~S"
                                  sense name)))
     (special (process-special-declaration spec res vars))
     (ftype
      (unless (cdr spec)
-       (compiler-error "No type specified in FTYPE declaration: ~S." spec))
+       (compiler-error "No type specified in FTYPE declaration: ~S" spec))
      (process-ftype-declaration (second spec) res (cddr spec) fvars))
     (function
      ;; Handle old style FUNCTION declaration, which is an abbreviation for
     (optimize
      (make-lexenv
       :default res
-      :cookie (process-optimize-declaration spec (lexenv-cookie res))))
+      :policy (process-optimize-declaration spec (lexenv-policy res))))
     (optimize-interface
      (make-lexenv
       :default res
-      :interface-cookie (process-optimize-declaration
+      :interface-policy (process-optimize-declaration
                         spec
-                        (lexenv-interface-cookie res))))
+                        (lexenv-interface-policy res))))
     (type
      (process-type-declaration (cdr spec) res vars))
     (sb!pcl::class
                             `(values ,@types))
                         cont res 'values))))
     (dynamic-extent
-     (when (policy nil (> speed brevity))
+     (when (policy nil (> speed inhibit-warnings))
        (compiler-note
        "The DYNAMIC-EXTENT declaration is not implemented (ignored)."))
      res)
              (compiler-warning "unrecognized declaration ~S" spec)
              res))))))
 
-;;; Use a list of DECLARE forms to annotate the lists of LAMBDA-VAR and
-;;; Functional structures which are being bound. In addition to filling in
-;;; slots in the leaf structures, we return a new LEXENV which reflects
-;;; pervasive special and function type declarations, (NOT)INLINE declarations
-;;; and OPTIMIZE declarations. CONT is the continuation affected by VALUES
-;;; declarations.
+;;; Use a list of DECLARE forms to annotate the lists of LAMBDA-VAR
+;;; and FUNCTIONAL structures which are being bound. In addition to
+;;; filling in slots in the leaf structures, we return a new LEXENV
+;;; which reflects pervasive special and function type declarations,
+;;; (NOT)INLINE declarations and OPTIMIZE declarations. CONT is the
+;;; continuation affected by VALUES declarations.
 ;;;
-;;; This is also called in main.lisp when PROCESS-FORM handles a use of
-;;; LOCALLY.
+;;; This is also called in main.lisp when PROCESS-FORM handles a use
+;;; of LOCALLY.
 (defun process-decls (decls vars fvars cont &optional (env *lexenv*))
   (declare (list decls vars fvars) (type continuation cont))
   (dolist (decl decls)
 
        (values (vars) keyp allowp (aux-vars) (aux-vals))))))
 
-;;; Similar to IR1-Convert-Progn-Body except that we sequentially bind each
-;;; Aux-Var to the corresponding Aux-Val before converting the body. If there
-;;; are no bindings, just convert the body, otherwise do one binding and
-;;; recurse on the rest.
+;;; This is similar to IR1-CONVERT-PROGN-BODY except that we
+;;; sequentially bind each AUX-VAR to the corresponding AUX-VAL before
+;;; converting the body. If there are no bindings, just convert the
+;;; body, otherwise do one binding and recurse on the rest.
 ;;;
-;;;    If Interface is true, then we convert bindings with the interface
-;;; policy. For real &aux bindings, and implicit aux bindings introduced by
-;;; keyword bindings, this is always true. It is only false when LET* directly
-;;; calls this function.
+;;; If INTERFACE is true, then we convert bindings with the interface
+;;; policy. For real &AUX bindings, and implicit aux bindings
+;;; introduced by keyword bindings, this is always true. It is only
+;;; false when LET* directly calls this function.
 (defun ir1-convert-aux-bindings (start cont body aux-vars aux-vals interface)
   (declare (type continuation start cont) (list body aux-vars aux-vals))
   (if (null aux-vars)
        (reference-leaf start fun-cont fun)
        (let ((*lexenv* (if interface
                            (make-lexenv
-                            :cookie (make-interface-cookie *lexenv*))
+                            :policy (make-interface-policy *lexenv*))
                            *lexenv*)))
          (ir1-convert-combination-args fun-cont cont
                                        (list (first aux-vals))))))
   (values))
 
-;;; Similar to IR1-Convert-Progn-Body except that code to bind the Specvar
-;;; for each Svar to the value of the variable is wrapped around the body. If
-;;; there are no special bindings, we just convert the body, otherwise we do
-;;; one special binding and recurse on the rest.
+;;; This is similar to IR1-CONVERT-PROGN-BODY except that code to bind
+;;; the SPECVAR for each SVAR to the value of the variable is wrapped
+;;; around the body. If there are no special bindings, we just convert
+;;; the body, otherwise we do one special binding and recurse on the
+;;; rest.
 ;;;
-;;; We make a cleanup and introduce it into the lexical environment. If
-;;; there are multiple special bindings, the cleanup for the blocks will end up
-;;; being the innermost one. We force Cont to start a block outside of this
-;;; cleanup, causing cleanup code to be emitted when the scope is exited.
+;;; We make a cleanup and introduce it into the lexical environment.
+;;; If there are multiple special bindings, the cleanup for the blocks
+;;; will end up being the innermost one. We force CONT to start a
+;;; block outside of this cleanup, causing cleanup code to be emitted
+;;; when the scope is exited.
 (defun ir1-convert-special-bindings (start cont body aux-vars aux-vals
                                           interface svars)
   (declare (type continuation start cont)
     lambda))
 
 ;;; Create the actual entry-point function for an optional entry
-;;; point. The lambda binds copies of each of the Vars, then calls Fun
-;;; with the argument Vals and the Defaults. Presumably the Vals refer
-;;; to the Vars by name. The Vals are passed in in reverse order.
+;;; point. The lambda binds copies of each of the VARS, then calls FUN
+;;; with the argument VALS and the DEFAULTS. Presumably the VALS refer
+;;; to the VARS by name. The VALS are passed in in reverse order.
 ;;;
 ;;; If any of the copies of the vars are referenced more than once,
-;;; then we mark the corresponding var as Ever-Used to inhibit
+;;; then we mark the corresponding var as EVER-USED to inhibit
 ;;; "defined but not read" warnings for arguments that are only used
 ;;; by default forms.
 ;;;
                              :where-from (leaf-where-from var)
                              :specvar (lambda-var-specvar var)))
                           fvars))
-        (*lexenv* (make-lexenv :cookie (make-interface-cookie *lexenv*)))
+        (*lexenv* (make-lexenv :policy (make-interface-policy *lexenv*)))
         (fun
          (ir1-convert-lambda-body
           `((%funcall ,fun ,@(reverse vals) ,@defaults))
 
 ;;; This function deals with supplied-p vars in optional arguments. If
 ;;; the there is no supplied-p arg, then we just call
-;;; IR1-Convert-Hairy-Args on the remaining arguments, and generate a
+;;; IR1-CONVERT-HAIRY-ARGS on the remaining arguments, and generate a
 ;;; optional entry that calls the result. If there is a supplied-p
 ;;; var, then we add it into the default vars and throw a T into the
 ;;; entry values. The resulting entry point function is returned.
           (n-count (gensym "N-COUNT-"))
           (count-temp (make-lambda-var :name n-count
                                        :type (specifier-type 'index)))
-          (*lexenv* (make-lexenv :cookie (make-interface-cookie *lexenv*))))
+          (*lexenv* (make-lexenv :policy (make-interface-policy *lexenv*))))
 
       (arg-vars context-temp count-temp)
 
       ;; host. When we go from the cross-compiler (where we bound
       ;; SB!EVAL::*ALREADY-EVALED-THIS*) to the host compiler (which
       ;; has a separate SB-EVAL::*ALREADY-EVALED-THIS* variable), EVAL
-      ;; would go and executes nested EVAL-WHENs even when they're not
+      ;; would go and execute nested EVAL-WHENs even when they're not
       ;; toplevel forms. Using EVAL-WHEN instead of bare EVAL causes
       ;; the cross-compilation host to bind its own
       ;; *ALREADY-EVALED-THIS* variable, so that the problem is
       ;; conditional on #+CMU.)
       #+(and sb-xc-host (or sbcl cmu))
       (let (#+sbcl (sb-eval::*already-evaled-this* t)
-           #+cmu (stub:probably similar but has not been tested))
+           #+cmu (common-lisp::*already-evaled-this* t))
        (eval `(eval-when (:compile-toplevel :load-toplevel :execute)
                 ,@body))))
 
 \f
 ;;;; THE
 
-;;; Do stuff to recognize a THE or VALUES declaration. Cont is the
-;;; continuation that the assertion applies to, Type is the type
-;;; specifier and Lexenv is the current lexical environment. Name is
+;;; Do stuff to recognize a THE or VALUES declaration. CONT is the
+;;; continuation that the assertion applies to, TYPE is the type
+;;; specifier and Lexenv is the current lexical environment. NAME is
 ;;; the name of the declaration we are doing, for use in error
 ;;; messages.
 ;;;
 ;;; we union) and nested ones (which we intersect).
 ;;;
 ;;; We represent the scoping by throwing our innermost (intersected)
-;;; assertion on Cont into the TYPE-RESTRICTIONS. As we go down, we
-;;; intersect our assertions together. If Cont has no uses yet, we
+;;; assertion on CONT into the TYPE-RESTRICTIONS. As we go down, we
+;;; intersect our assertions together. If CONT has no uses yet, we
 ;;; have not yet bottomed out on the first COND branch; in this case
 ;;; we optimistically assume that this type will be the one we end up
 ;;; with, and set the ASSERTED-TYPE to it. We can never get better
     (when (null (find-uses cont))
       (setf (continuation-asserted-type cont) new))
     (when (and (not intersects)
-              (not (policy nil (= brevity 3)))) ;FIXME: really OK to suppress?
+              (not (policy nil (= inhibit-warnings 3)))) ;FIXME: really OK to suppress?
       (compiler-warning
        "The type ~S in ~S declaration conflicts with an enclosing assertion:~%   ~S"
        (type-specifier ctype)
     (make-lexenv :type-restrictions `((,cont . ,new))
                 :default lexenv)))
 
+;;; Assert that FORM evaluates to the specified type (which may be a
+;;; VALUES type).
+;;;
 ;;; FIXME: In a version of CMU CL that I used at Cadabra ca. 20000101,
 ;;; this didn't seem to expand into an assertion, at least for ALIEN
 ;;; values. Check that SBCL doesn't have this problem.
 (def-ir1-translator the ((type value) start cont)
-  #!+sb-doc
-  "THE Type Form
-  Assert that Form evaluates to the specified type (which may be a VALUES
-  type.)"
   (let ((*lexenv* (do-the-stuff type cont *lexenv* 'the)))
     (ir1-convert start cont value)))
 
+;;; This is like the THE special form, except that it believes
+;;; whatever you tell it. It will never generate a type check, but
+;;; will cause a warning if the compiler can prove the assertion is
+;;; wrong.
+;;;
 ;;; Since the CONTINUATION-DERIVED-TYPE is computed as the union of
 ;;; its uses's types, setting it won't work. Instead we must intersect
 ;;; the type with the uses's DERIVED-TYPE.
 (def-ir1-translator truly-the ((type value) start cont)
   #!+sb-doc
-  "Truly-The Type Value
-  Like the THE special form, except that it believes whatever you tell it. It
-  will never generate a type check, but will cause a warning if the compiler
-  can prove the assertion is wrong."
   (declare (inline member))
   (let ((type (values-specifier-type type))
        (old (find-uses cont)))
 ;;; otherwise look at the global information. If the name is for a
 ;;; constant, then error out.
 (def-ir1-translator setq ((&whole source &rest things) start cont)
-  #!+sb-doc
-  "SETQ {Var Value}*
-  Set the variables to the values. If more than one pair is supplied, the
-  assignments are done sequentially. If Var names a symbol macro, SETF the
-  expansion."
   (let ((len (length things)))
     (when (oddp len)
       (compiler-error "odd number of args to SETQ: ~S" source))
               (ir1-convert-progn-body start cont (sets)))
            (sets `(setq ,(first thing) ,(second thing))))))))
 
-;;; Kind of like Reference-Leaf, but we generate a Set node. This
-;;; should only need to be called in Setq.
+;;; This is kind of like REFERENCE-LEAF, but we generate a SET node.
+;;; This should only need to be called in SETQ.
 (defun set-variable (start cont var value)
   (declare (type continuation start cont) (type basic-var var))
   (let ((dest (make-continuation)))
                                 `(,(car x) .
                                   (macro . ,(coerce (cdr x) 'function))))
                             macros)
-                    :cookie (lexenv-cookie *lexenv*)
-                    :interface-cookie (lexenv-interface-cookie *lexenv*))))
+                    :policy (lexenv-policy *lexenv*)
+                    :interface-policy (lexenv-interface-policy *lexenv*))))
       (ir1-convert-lambda `(lambda ,@body) name))))
 
 ;;; Return a lambda that has been "closed" with respect to ENV,