0.pre7.124:

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

diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp
index 6f0dad4..3986bf6 100644 (file)
--- a/src/compiler/checkgen.lisp
+++ b/src/compiler/checkgen.lisp
@@ -113,10 +113,10 @@
 (defun no-function-values-types (type)
   (declare (type ctype type))
   (multiple-value-bind (res count) (values-types type)
-    (values (mapcar #'(lambda (type)
-                       (if (fun-type-p type)
-                           (specifier-type 'function)
-                           type))
+    (values (mapcar (lambda (type)
+                     (if (fun-type-p type)
+                         (specifier-type 'function)
+                         type))
                    res)
            count)))
 
@@ -150,18 +150,18 @@
        (if (and (every #'type-check-template types) (not force-hairy))
            (values :simple types)
            (values :hairy
-                   (mapcar #'(lambda (x)
-                               (list nil (maybe-weaken-check x cont) x))
+                   (mapcar (lambda (x)
+                             (list nil (maybe-weaken-check x cont) x))
                            types)))
-       (let ((res (mapcar #'(lambda (p c)
-                              (let ((diff (type-difference p c))
-                                    (weak (maybe-weaken-check c cont)))
-                                (if (and diff
-                                         (< (type-test-cost diff)
-                                            (type-test-cost weak))
-                                         *complement-type-checks*)
-                                    (list t diff c)
-                                    (list nil weak c))))
+       (let ((res (mapcar (lambda (p c)
+                            (let ((diff (type-difference p c))
+                                  (weak (maybe-weaken-check c cont)))
+                              (if (and diff
+                                       (< (type-test-cost diff)
+                                          (type-test-cost weak))
+                                       *complement-type-checks*)
+                                  (list t diff c)
+                                  (list nil weak c))))
                           ptypes types)))
          (cond ((or force-hairy (find-if #'first res))
                 (values :hairy res))
@@ -263,7 +263,8 @@
   (declare (type continuation cont))
   (let ((dest (continuation-dest cont)))
     (cond ((eq (continuation-type-check cont) :error)
-          (if (and (combination-p dest) (eq (combination-kind dest) :error))
+          (if (and (combination-p dest)
+                   (eq (combination-kind dest) :error))
               nil
               t))
          ((or (not dest)
@@ -299,15 +300,15 @@
 (defun make-type-check-form (types)
   (let ((temps (make-gensym-list (length types))))
     `(multiple-value-bind ,temps 'dummy
-       ,@(mapcar #'(lambda (temp type)
-                    (let* ((spec
-                            (let ((*unparse-fun-type-simplify* t))
-                              (type-specifier (second type))))
-                           (test (if (first type) `(not ,spec) spec)))
-                      `(unless (typep ,temp ',test)
-                         (%type-check-error
-                          ,temp
-                          ',(type-specifier (third type))))))
+       ,@(mapcar (lambda (temp type)
+                  (let* ((spec
+                          (let ((*unparse-fun-type-simplify* t))
+                            (type-specifier (second type))))
+                         (test (if (first type) `(not ,spec) spec)))
+                    `(unless (typep ,temp ',test)
+                       (%type-check-error
+                        ,temp
+                        ',(type-specifier (third type))))))
                 temps
                 types)
        (values ,@temps))))
@@ -318,7 +319,7 @@
 ;;; passes them on to CONT.
 (defun convert-type-check (cont types)
   (declare (type continuation cont) (type list types))
-  (with-ir1-environment (continuation-dest cont)
+  (with-ir1-environment-from-node (continuation-dest cont)
 
     ;; Ensuring that CONT starts a block lets us freely manipulate its uses.
     (ensure-block-start cont)
@@ -359,7 +360,7 @@
        ;; said that somewhere in here we
        ;;   Set the new block's start and end cleanups to the *start*
        ;;   cleanup of PREV's block. This overrides the incorrect
-       ;;   default from WITH-IR1-ENVIRONMENT.
+       ;;   default from WITH-BELATED-IR1-ENVIRONMENT.
        ;; Unfortunately I can't find any code which corresponds to this.
        ;; Perhaps it was a stale comment? Or perhaps I just don't
        ;; understand.. -- WHN 19990521
@@ -393,7 +394,7 @@
        (substitute-continuation new-start victim)))
 
     ;; Invoking local call analysis converts this call to a LET.
-    (local-call-analyze *current-component*))
+    (locall-analyze-component *current-component*))
 
   (values))
 
@@ -416,7 +417,8 @@
                   (format nil "~:[A possible~;The~] binding of ~S"
                           (and (continuation-use cont)
                                (eq (functional-kind lambda) :let))
-                          (leaf-name (elt (lambda-vars lambda) pos)))))))
+                          (leaf-source-name (elt (lambda-vars lambda)
+                                                 pos)))))))
     (cond ((eq dtype *empty-type*))
          ((and (ref-p node) (constant-p (ref-leaf node)))
           (compiler-warning "~:[This~;~:*~A~] is not a ~<~%~9T~:;~S:~>~%  ~S"