X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fltn.lisp;h=bbdb87aa7638330f6a4b7c937acfd79b5f14feb4;hb=fdc38abbd1ef5b211c9db03c72e1730284c6edbb;hp=b38fa17b7ddaee3d65932e08220d4a9ff2df7585;hpb=61c18727668ff0c3263a3d363e609d4522d545cc;p=sbcl.git

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index b38fa17..bbdb87a 100644
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -159,7 +159,8 @@
 ;;; can bail out to here.
 (defun ltn-default-call (call)
   (declare (type combination call))
-  (let ((kind (basic-combination-kind call)))
+  (let ((kind (basic-combination-kind call))
+	(info (basic-combination-fun-info call)))
     (annotate-fun-lvar (basic-combination-fun call))
 
     (dolist (arg (basic-combination-args call))
@@ -169,8 +170,9 @@
       (annotate-1-value-lvar arg))
 
     (cond
-      ((and (fun-info-p kind)
-            (fun-info-ir2-convert kind))
+      ((and (eq kind :known)
+	    (fun-info-p info)
+            (fun-info-ir2-convert info))
        (setf (basic-combination-info call) :funny)
        (setf (node-tail-p call) nil))
       (t
@@ -311,8 +313,7 @@
 	   (setf (node-tail-p call) nil))
 	  (t
 	   (setf (basic-combination-info call) :full)
-	   (annotate-fun-lvar (basic-combination-fun call)
-				      nil)
+	   (annotate-fun-lvar (basic-combination-fun call) nil)
 	   (dolist (arg (reverse args))
 	     (annotate-unknown-values-lvar arg))
 	   (flush-full-call-tail-transfer call))))
@@ -432,6 +433,7 @@
 (defun template-args-ok (template call safe-p)
   (declare (type template template)
 	   (type combination call))
+  (declare (ignore safe-p))
   (let ((mtype (template-more-args-type template)))
     (do ((args (basic-combination-args call) (cdr args))
 	 (types (template-arg-types template) (cdr types)))
@@ -566,7 +568,7 @@
   (declare (type combination call)
 	   (type ltn-policy ltn-policy))
   (let ((safe-p (ltn-policy-safe-p ltn-policy))
-	(current (fun-info-templates (basic-combination-kind call)))
+	(current (fun-info-templates (basic-combination-fun-info call)))
 	(fallback nil)
 	(rejected nil))
     (loop
@@ -670,7 +672,7 @@
 			(or template
 			    (template-or-lose 'call-named)))
 		       *efficiency-note-cost-threshold*)))
-      (dolist (try (fun-info-templates (basic-combination-kind call)))
+      (dolist (try (fun-info-templates (basic-combination-fun-info call)))
 	(when (> (template-cost try) max-cost) (return)) ; FIXME: UNLESS'd be cleaner.
 	(let ((guard (template-guard try)))
 	  (when (and (or (not guard) (funcall guard))
@@ -693,13 +695,13 @@
 
     (when (losers)
       (collect ((messages)
-		(count 0 +))
+		(notes 0 +))
 	(flet ((lose1 (string &rest stuff)
 		 (messages string)
 		 (messages stuff)))
 	  (dolist (loser (losers))
 	    (when (and *efficiency-note-limit*
-		       (>= (count) *efficiency-note-limit*))
+		       (>= (notes) *efficiency-note-limit*))
 	      (lose1 "etc.")
 	      (return))
 	    (let* ((type (template-type loser))
@@ -718,7 +720,7 @@
 	       (t
 		(aver (ltn-policy-safe-p ltn-policy))
 		(lose1 "can't trust output type assertion under safe policy")))
-	      (count 1))))
+	      (notes 1))))
 
 	(let ((*compiler-error-context* call))
 	  (compiler-notify "~{~?~^~&~6T~}"
@@ -740,7 +742,7 @@
 (defun ltn-analyze-known-call (call)
   (declare (type combination call))
   (let ((ltn-policy (node-ltn-policy call))
-        (method (fun-info-ltn-annotate (basic-combination-kind call)))
+        (method (fun-info-ltn-annotate (basic-combination-fun-info call)))
 	(args (basic-combination-args call)))
     (when method
       (funcall method call ltn-policy)
@@ -768,7 +770,7 @@
 		(and (leaf-has-source-name-p funleaf)
 		     (eq (lvar-fun-name (combination-fun call))
 			 (leaf-source-name funleaf))
-		     (let ((info (basic-combination-kind call)))
+		     (let ((info (basic-combination-fun-info call)))
 		       (not (or (fun-info-ir2-convert info)
 				(ir1-attributep (fun-info-attributes info)
 						recursive))))))
@@ -847,10 +849,10 @@
     (etypecase node
       (ref)
       (combination
-       (case (basic-combination-kind node)
+       (ecase (basic-combination-kind node)
 	 (:local (ltn-analyze-local-call node))
 	 ((:full :error) (ltn-default-call node))
-	 (t
+	 (:known
 	  (ltn-analyze-known-call node))))
       (cif (ltn-analyze-if node))
       (creturn (ltn-analyze-return node))