From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sat, 29 Apr 1995 22:26:36 +0000 (+0000)
Subject: Fixed bug when a coerced call site has been transformed into a binder
X-Git-Tag: 20090517-FFI~6370
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2bb36f6ff4ab701e35645b30391c57c8991299a5;p=mit-scheme.git

Fixed bug when a coerced call site has been transformed into a binder
for another coerced procedure.
---

diff --git a/v8/src/compiler/midend/coerce.scm b/v8/src/compiler/midend/coerce.scm
index 8314d6e91..4fd8e634a 100644
--- a/v8/src/compiler/midend/coerce.scm
+++ b/v8/src/compiler/midend/coerce.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: coerce.scm,v 1.3 1995/03/25 16:02:55 adams Exp $
+$Id: coerce.scm,v 1.4 1995/04/29 22:26:36 adams Exp $
 
 Copyright (c) 1995 Massachusetts Institute of Technology
 
@@ -107,7 +107,7 @@ wins by about 10%.
 			arity-map)
 		      (binding-loop (cdr bindings)))
 		    (let* ((ref  (car refs))
-			   (text (coerce/reference/form ref))
+			   (text (coerce/reference/form/call ref))
 			   (len  (length (call/operands text)))
 			   (arity.refs (assv len arity-map)))
 		      (cond (arity.refs
@@ -176,7 +176,7 @@ wins by about 10%.
 		    (cond ((within? (coerce/reference/env ref)
 				    coercion-env)
 			   (coerce/rewrite-call!
-			    (coerce/reference/form ref)
+			    (coerce/reference/form/call ref)
 			    arity name*)
 			   (loop (cdr refs) (+ replaced 1) kept))
 			  (else
@@ -197,8 +197,6 @@ wins by about 10%.
 	   (CALL ',coerce-to-compiled '#F (LOOKUP ,name) ',len)))))
 
 (define (coerce/rewrite-call! call arity coerced-operator)
-  ;;(form/rewrite! (call/operator call) 
-  ;;  `(LOOKUP ,coerced-operator))
   (form/rewrite! call
     `(CALL ',%internal-apply-unchecked
 	   ,(call/continuation call)
@@ -206,6 +204,7 @@ wins by about 10%.
 	   (LOOKUP ,coerced-operator)
 	   ,@(call/operands call))))
 
+
 (define-coercer LET (bindings body)
   (let* ((names   (map car bindings))
 	 (values  (map cadr bindings))
@@ -314,6 +313,27 @@ wins by about 10%.
 (define (coerce/reference/form ref) (car ref))
 (define (coerce/reference/env ref) (cdr ref))
 
+(define (coerce/reference/form/call ref)
+  ;; One complexity is that a call site may already have been rewritten to
+  ;; be a binding for some inner coerced procedure.  This happens at
+  ;; the call site for F in the following example:
+  ;;   (lambda (f)
+  ;;     (lambda (g)
+  ;;	   (f (lambda (x) (g (+ x 1))))))
+  ;; By the time we get to rewrite the call to F it looks like this:
+  ;;   ((lambda (g*) (f (lambda (x) (g* (+ x 1))))) <coerce-g>)
+  ;; So this code `dereferences' to the original call site
+  (define (bad)
+    (internal-error "Bad call site reference" ref))
+  (let loop ((form (coerce/reference/form ref)))
+    (cond ((not (CALL/? form))
+	   (bad))
+	  ((LOOKUP/? (call/operator form))
+	   form)
+	  ((LAMBDA/? (call/operator form))
+	   (loop (lambda/body (call/operator form))))
+	  (else (bad)))))
+
 (define-structure
     (coerce/binding
      (conc-name coerce/binding/)