X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=6641386ef35fb72cd367e6402dfb0cbaeed223b1;hb=74cfbf6d0572b7df1b3492563408a7cb3ae103cf;hp=b9ea816dfc2cc59cd72b8b5720d9d36695da6229;hpb=5d4cadcc92642f2a23743a5458a23aa9dc544db2;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index b9ea816..6641386 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -429,7 +429,7 @@
     (lvar-dynamic-extent it)))
 
 (defun flushable-combination-p (call)
-  (declare (combination call))
+  (declare (type combination call))
   (let ((kind (combination-kind call))
         (info (combination-fun-info call)))
     (when (and (eq kind :known) (fun-info-p info))
@@ -1961,12 +1961,13 @@ is :ANY, the function name is not checked."
         (name1 uses)
         (mapcar #'name1 uses)))))
 
-;;; Return the source name of a combination. (This is an idiom
-;;; which was used in CMU CL. I gather it always works. -- WHN)
+;;; Return the source name of a combination -- or signals an error
+;;; if the function leaf is anonymous.
 (defun combination-fun-source-name (combination &optional (errorp t))
   (let ((leaf (ref-leaf (lvar-uses (combination-fun combination)))))
-    (when (or errorp (leaf-has-source-name-p leaf))
-      (leaf-source-name leaf))))
+    (if (or errorp (leaf-has-source-name-p leaf))
+        (values (leaf-source-name leaf) t)
+        (values nil nil))))
 
 ;;; Return the COMBINATION node that is the call to the LET FUN.
 (defun let-combination (fun)
@@ -2189,11 +2190,15 @@ is :ANY, the function name is not checked."
                 (not (null (member (leaf-source-name leaf) names
                                    :test #'equal))))))))
 
+;;; Return true if LVAR's only use is a call to one of the named functions
+;;; (or any function if none are specified) with the specified number of
+;;; of arguments (or any number if number is not specified)
 (defun lvar-matches (lvar &key fun-names arg-count)
-  (let ((use (lvar-use lvar)))
+  (let ((use (lvar-uses lvar)))
     (and (combination-p use)
          (or (not fun-names)
-             (member (combination-fun-source-name use)
-                     fun-names :test #'eq))
+             (multiple-value-bind (name ok)
+                 (combination-fun-source-name use nil)
+               (and ok (member name fun-names :test #'eq))))
          (or (not arg-count)
              (= arg-count (length (combination-args use)))))))