0.pre7.127:

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

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index bab067f..ce0522d 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -159,9 +159,9 @@
                     (eq int *empty-type*)
                     (not (eq rtype *empty-type*)))
            (let ((*compiler-error-context* node))
-             (compiler-warning
+             (compiler-warn
               "New inferred type ~S conflicts with old type:~
-               ~%  ~S~%*** Bug?"
+               ~%  ~S~%*** possible internal error? Please report this."
               (type-specifier rtype) (type-specifier node-type))))
          (setf (node-derived-type node) int)
          (reoptimize-continuation (node-cont node))))))
@@ -880,8 +880,8 @@
                             ;; FIXME: Actually, I think we could
                             ;; issue a full WARNING if the call
                             ;; violates a DECLAIM FTYPE.
-                            :error-function #'compiler-style-warning
-                            :warning-function #'compiler-note)
+                            :lossage-fun #'compiler-style-warn
+                            :unwinnage-fun #'compiler-note)
         (assert-call-type call type)
         (maybe-terminate-block call ir1-converting-not-optimizing-p)
         (recognize-known-call call ir1-converting-not-optimizing-p))
@@ -999,7 +999,7 @@
               (:aborted
                (setf (combination-kind node) :error)
                (when args
-                 (apply #'compiler-warning args))
+                 (apply #'compiler-warn args))
                (remhash node table)
                nil)
               (:failure
@@ -1129,7 +1129,7 @@
           call
           `(lambda ,dummies
              (declare (ignore ,@dummies))
-             (values ,@(mapcar #'(lambda (x) `',x) values))))))))
+             (values ,@(mapcar (lambda (x) `',x) values))))))))
 
   (values))
 \f
@@ -1289,12 +1289,12 @@
                (propagate-to-refs var (continuation-type arg))
                (let ((use-component (node-component use)))
                  (substitute-leaf-if
-                  #'(lambda (ref)
-                      (cond ((eq (node-component ref) use-component)
-                             t)
-                            (t
-                             (aver (lambda-toplevelish-p (lambda-home fun)))
-                             nil)))
+                  (lambda (ref)
+                    (cond ((eq (node-component ref) use-component)
+                           t)
+                          (t
+                           (aver (lambda-toplevelish-p (lambda-home fun)))
+                           nil)))
                   leaf var))
                t)))))
        ((and (null (rest (leaf-refs var)))
@@ -1325,11 +1325,11 @@
   (unless (or (functional-entry-fun fun)
              (lambda-optional-dispatch fun))
     (let* ((vars (lambda-vars fun))
-          (union (mapcar #'(lambda (arg var)
-                             (when (and arg
-                                        (continuation-reoptimize arg)
-                                        (null (basic-var-sets var)))
-                               (continuation-type arg)))
+          (union (mapcar (lambda (arg var)
+                           (when (and arg
+                                      (continuation-reoptimize arg)
+                                      (null (basic-var-sets var)))
+                             (continuation-type arg)))
                          (basic-combination-args call)
                          vars))
           (this-ref (continuation-use (basic-combination-fun call))))
@@ -1342,16 +1342,16 @@
        (let ((dest (continuation-dest (node-cont ref))))
          (unless (or (eq ref this-ref) (not dest))
            (setq union
-                 (mapcar #'(lambda (this-arg old)
-                             (when old
-                               (setf (continuation-reoptimize this-arg) nil)
-                               (type-union (continuation-type this-arg) old)))
+                 (mapcar (lambda (this-arg old)
+                           (when old
+                             (setf (continuation-reoptimize this-arg) nil)
+                             (type-union (continuation-type this-arg) old)))
                          (basic-combination-args dest)
                          union)))))
 
-      (mapc #'(lambda (var type)
-               (when type
-                 (propagate-to-refs var type)))
+      (mapc (lambda (var type)
+             (when type
+               (propagate-to-refs var type)))
            vars union)))
 
   (values))
@@ -1413,11 +1413,11 @@
     (multiple-value-bind (types nvals)
        (values-types (continuation-derived-type arg))
       (unless (eq nvals :unknown)
-       (mapc #'(lambda (var type)
-                 (if (basic-var-sets var)
-                     (propagate-from-sets var type)
-                     (propagate-to-refs var type)))
-               vars
+       (mapc (lambda (var type)
+               (if (basic-var-sets var)
+                   (propagate-from-sets var type)
+                   (propagate-to-refs var type)))
+             vars
                (append types
                        (make-list (max (- (length vars) nvals) 0)
                                   :initial-element (specifier-type 'null))))))
@@ -1471,14 +1471,14 @@
 
        (when total-nvals
          (when (and min (< total-nvals min))
-           (compiler-warning
+           (compiler-warn
             "MULTIPLE-VALUE-CALL with ~R values when the function expects ~
             at least ~R."
             total-nvals min)
            (setf (basic-combination-kind node) :error)
            (return-from ir1-optimize-mv-call))
          (when (and max (> total-nvals max))
-           (compiler-warning
+           (compiler-warn
             "MULTIPLE-VALUE-CALL with ~R values when the function expects ~
             at most ~R."
             total-nvals max)