X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=f27b60d37ae9164be4b89dd55c42b3c8a7373aa4;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=1e0d6eda5c600c1d1e016ed989d908d70aeee7f1;hpb=b3c5951a9d24468a2a471fd6769d0e6b687c08f3;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 1e0d6ed..f27b60d 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -803,7 +803,8 @@
                          (handled-conditions (lexenv-handled-conditions default))
                          (disabled-package-locks
                           (lexenv-disabled-package-locks default))
-                         (policy (lexenv-policy default)))
+                         (policy (lexenv-policy default))
+                         (user-data (lexenv-user-data default)))
   (macrolet ((frob (var slot)
                `(let ((old (,slot default)))
                   (if ,var
@@ -815,8 +816,10 @@
      (frob blocks lexenv-blocks)
      (frob tags lexenv-tags)
      (frob type-restrictions lexenv-type-restrictions)
-     lambda cleanup handled-conditions
-     disabled-package-locks policy)))
+     lambda
+     cleanup handled-conditions disabled-package-locks
+     policy
+     user-data)))
 
 ;;; Makes a LEXENV, suitable for using in a MACROLET introduced
 ;;; macroexpander
@@ -850,7 +853,8 @@
      nil
      (lexenv-handled-conditions lexenv)
      (lexenv-disabled-package-locks lexenv)
-     (lexenv-policy lexenv))))
+     (lexenv-policy lexenv)
+     (lexenv-user-data lexenv))))
 
 ;;;; flow/DFO/component hackery
 
@@ -1957,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,7 +2194,8 @@ is :ANY, the function name is not checked."
   (let ((use (lvar-use 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)))))))