0.pre7.129:
[sbcl.git] / src / compiler / ir1-translators.lisp
index f615c1b..50efcc3 100644 (file)
@@ -37,7 +37,7 @@
                        :alternative else-block)))
     (setf (continuation-dest pred) node)
     (ir1-convert start pred test)
-    (prev-link node pred)
+    (link-node-to-previous-continuation node pred)
     (use-continuation node dummy-cont)
 
     (let ((start-block (continuation-block pred)))
@@ -75,7 +75,7 @@
                                :mess-up entry)))
     (push entry (lambda-entries (lexenv-lambda *lexenv*)))
     (setf (entry-cleanup entry) cleanup)
-    (prev-link entry start)
+    (link-node-to-previous-continuation entry start)
     (use-continuation entry dummy)
     
     (let* ((env-entry (list entry cont))
     (push exit (entry-exits entry))
     (setf (continuation-dest value-cont) exit)
     (ir1-convert start value-cont value)
-    (prev-link exit value-cont)
+    (link-node-to-previous-continuation exit value-cont)
     (let ((home-lambda (continuation-home-lambda-or-null start)))
       (when home-lambda
        (push entry (lambda-calls-or-closes home-lambda))))
                                :mess-up entry)))
     (push entry (lambda-entries (lexenv-lambda *lexenv*)))
     (setf (entry-cleanup entry) cleanup)
-    (prev-link entry start)
+    (link-node-to-previous-continuation entry start)
     (use-continuation entry dummy)
 
     (collect ((tags)
         (entry (first found))
         (exit (make-exit :entry entry)))
     (push exit (entry-exits entry))
-    (prev-link exit start)
+    (link-node-to-previous-continuation exit start)
     (let ((home-lambda (continuation-home-lambda-or-null start)))
       (when home-lambda
        (push entry (lambda-calls-or-closes home-lambda))))
   (declare (type list definitions))
   (unless (= (length definitions)
              (length (remove-duplicates definitions :key #'first)))
-    (compiler-style-warning "duplicate definitions in ~S" definitions))
+    (compiler-style-warn "duplicate definitions in ~S" definitions))
   (let* ((processed-definitions (mapcar definitionize-fun definitions))
          (*lexenv* (make-lexenv definitionize-keyword processed-definitions)))
     (funcall fun)))
   #!+sb-doc
   "FUNCTION Name
   Return the lexically apparent definition of the function Name. Name may also
-  be a lambda."
+  be a lambda expression."
   (if (consp thing)
       (case (car thing)
        ((lambda)
                                             :debug-name (debug-namify
                                                          "#'~S" thing))))
        ((setf)
-        (let ((var (find-lexically-apparent-function
+        (let ((var (find-lexically-apparent-fun
                     thing "as the argument to FUNCTION")))
           (reference-leaf start cont var)))
        ((instance-lambda)
           (reference-leaf start cont res)))
        (t
         (compiler-error "~S is not a legal function name." thing)))
-      (let ((var (find-lexically-apparent-function
+      (let ((var (find-lexically-apparent-fun
                  thing "as the argument to FUNCTION")))
        (reference-leaf start cont var))))
 
     (when (and (not intersects)
               (not (policy *lexenv*
                            (= inhibit-warnings 3)))) ;FIXME: really OK to suppress?
-      (compiler-warning
-       "The type ~S in ~S declaration conflicts with an enclosing assertion:~%   ~S"
+      (compiler-warn
+       "The type ~S in ~S declaration conflicts with an ~
+        enclosing assertion:~%   ~S"
        (type-specifier ctype)
        name
        (type-specifier old-type)))
               (when (lambda-var-ignorep leaf)
                 ;; ANSI's definition of "Declaration IGNORE, IGNORABLE"
                 ;; requires that this be a STYLE-WARNING, not a full warning.
-                (compiler-style-warning
+                (compiler-style-warn
                  "~S is being set even though it was declared to be ignored."
                  name)))
             (set-variable start cont leaf (second things)))
       (setf (continuation-dest dest) res)
       (setf (leaf-ever-used var) t)
       (push res (basic-var-sets var))
-      (prev-link res dest)
+      (link-node-to-previous-continuation res dest)
       (use-continuation res cont))))
 \f
 ;;;; CATCH, THROW and UNWIND-PROTECT
 ;;;
 ;;; Note that environment analysis replaces references to escape
 ;;; functions with references to the corresponding NLX-INFO structure.
-(def-ir1-translator %escape-function ((tag) start cont)
+(def-ir1-translator %escape-fun ((tag) start cont)
   (let ((fun (ir1-convert-lambda
              `(lambda ()
                 (return-from ,tag (%unknown-values)))
 ;;; Yet another special special form. This one looks up a local
 ;;; function and smashes it to a :CLEANUP function, as well as
 ;;; referencing it.
-(def-ir1-translator %cleanup-function ((name) start cont)
+(def-ir1-translator %cleanup-fun ((name) start cont)
   (let ((fun (lexenv-find name functions)))
     (aver (lambda-p fun))
     (setf (functional-kind fun) :cleanup)
      `(block ,exit-block
        (%within-cleanup
            :catch
-           (%catch (%escape-function ,exit-block) ,tag)
+           (%catch (%escape-fun ,exit-block) ,tag)
          ,@body)))))
 
 ;;; UNWIND-PROTECT is similar to CATCH, but hairier. We make the
 ;;; cleanup forms into a local function so that they can be referenced
 ;;; both in the case where we are unwound and in any local exits. We
-;;; use %CLEANUP-FUNCTION on this to indicate that reference by
+;;; use %CLEANUP-FUN on this to indicate that reference by
 ;;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of
 ;;; an XEP.
 (def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
      `(flet ((,cleanup-fun () ,@cleanup nil))
        ;; FIXME: If we ever get DYNAMIC-EXTENT working, then
        ;; ,CLEANUP-FUN should probably be declared DYNAMIC-EXTENT,
-       ;; and something can be done to make %ESCAPE-FUNCTION have
+       ;; and something can be done to make %ESCAPE-FUN have
        ;; dynamic extent too.
        (block ,drop-thru-tag
          (multiple-value-bind (,next ,start ,count)
              (block ,exit-tag
                (%within-cleanup
                    :unwind-protect
-                   (%unwind-protect (%escape-function ,exit-tag)
-                                    (%cleanup-function ,cleanup-fun))
+                   (%unwind-protect (%escape-fun ,exit-tag)
+                                    (%cleanup-fun ,cleanup-fun))
                  (return-from ,drop-thru-tag ,protected)))
            (,cleanup-fun)
            (%continue-unwind ,next ,start ,count)))))))
            (ir1-convert this-start this-cont arg)
            (setq this-start this-cont)
            (arg-conts this-cont)))
-       (prev-link node this-start)
+       (link-node-to-previous-continuation node this-start)
        (use-continuation node cont)
        (setf (basic-combination-args node) (arg-conts))))))
 
     (ecase (info :function :kind name)
       ((nil))
       (:function
-       (remhash name *free-functions*)
+       (remhash name *free-funs*)
        (undefine-fun-name name)
-       (compiler-warning
+       (compiler-warn
        "~S is being redefined as a macro when it was ~
          previously ~(~A~) to be a function."
        name