X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fltn.lisp;h=438102b160f780ab65be366065976c0ed6d187a0;hb=39ecf3129db04ecf861c08459b6f5353bfc266c9;hp=9a2570a5ae92bb14f90c7486f67c476a2c492a50;hpb=cfb9e3640e34706acdfccd26236024de259f3b4f;p=sbcl.git

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index 9a2570a..438102b 100644
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -473,7 +473,7 @@
 (defoptimizer (%unwind-protect ltn-annotate) ((escape cleanup)
 					      node
 					      ltn-policy)
-  (declare (ignore ltn-policy))
+  ltn-policy ; a hack to effectively (DECLARE (IGNORE LTN-POLICY))
   (setf (basic-combination-info node) :funny)
   (setf (node-tail-p node) nil))
 
@@ -888,9 +888,11 @@
       (when (and rejected
 		 (policy call (> speed inhibit-warnings)))
 	(note-rejected-templates call ltn-policy template))
-      ;; If we are forced to do a full call, we check to see whether the
-      ;; function called is the same as the current function. If so, we
-      ;; give a warning, as this is probably a botched interpreter stub.
+      ;; If we are forced to do a full call, we check to see whether
+      ;; the function called is the same as the current function. If
+      ;; so, we give a warning, as this is probably a botched attempt
+      ;; to implement an out-of-line version in terms of inline
+      ;; transforms or VOPs or whatever.
       (unless template
 	(when (and (eq (continuation-function-name (combination-fun call))
 		       (leaf-name
@@ -901,7 +903,13 @@
 			      (ir1-attributep (function-info-attributes info)
 					      recursive)))))
 	  (let ((*compiler-error-context* call))
-	    (compiler-warning "recursive known function definition")))
+	    (compiler-warning "recursion in known function definition~2I ~
+                               ~_policy=~S ~_arg types=~S"
+			      (lexenv-policy (node-lexenv call))
+			      (mapcar (lambda (arg)
+					(type-specifier (continuation-type
+							 arg)))
+				      args))))
 	(ltn-default-call call ltn-policy)
 	(return-from ltn-analyze-known-call (values)))
       (setf (basic-combination-info call) template)