From bf113be05da29005bd05464374ac3742609e0f7c Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 22 Nov 1994 03:49:09 +0000
Subject: [PATCH] *** empty log message ***

---
 v8/src/compiler/midend/closconv.scm | 21 ++++++++++++++++-----
 v8/src/compiler/midend/cpsconv.scm  | 19 +++++++++++++------
 v8/src/compiler/midend/inlate.scm   |  9 ++++++---
 3 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/v8/src/compiler/midend/closconv.scm b/v8/src/compiler/midend/closconv.scm
index a263c2962..f99df33ce 100644
--- a/v8/src/compiler/midend/closconv.scm
+++ b/v8/src/compiler/midend/closconv.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: closconv.scm,v 1.1 1994/11/19 02:04:29 adams Exp $
+$Id: closconv.scm,v 1.2 1994/11/22 03:48:40 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -386,6 +386,18 @@ MIT in each case. |#
     (set-closconv/env/form! env* expr*)
     (values expr* env*)))
 
+(define (closconv/lambda** context env lam-expr)
+  ;; (values expr* env*)
+  (call-with-values
+   (lambda ()
+     (closconv/lambda* context
+		       env
+		       (lambda/formals lam-expr)
+		       (lambda/body lam-expr)))
+   (lambda (expr* env*)
+     (values (closconv/remember expr* lam-expr)
+	     env*))))
+
 (define (closconv/bindings env* env bindings)
   ;; ENV* is the environment to which the bindings are being added
   ;; ENV is the environment in which the form part of the binding is
@@ -401,10 +413,9 @@ MIT in each case. |#
 		 (closconv/expr env value)
 		 (call-with-values
 		  (lambda ()
-		    (closconv/lambda* 'DYNAMIC ; bindings are dynamic
-				      env
-				      (cadr value) ; lambda list
-				      (caddr value))) ; body
+		    (closconv/lambda** 'DYNAMIC ; bindings are dynamic
+				       env
+				       value))
 		  (lambda (value* env**)
 		    (let ((binding
 			   (or (closconv/binding/find (closconv/env/bound env*)
diff --git a/v8/src/compiler/midend/cpsconv.scm b/v8/src/compiler/midend/cpsconv.scm
index ce0d1e588..589893151 100644
--- a/v8/src/compiler/midend/cpsconv.scm
+++ b/v8/src/compiler/midend/cpsconv.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cpsconv.scm,v 1.1 1994/11/19 02:04:29 adams Exp $
+$Id: cpsconv.scm,v 1.2 1994/11/22 03:48:51 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -38,10 +38,12 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (define (cpsconv/top-level program)
-  (let ((name (new-continuation-variable)))
-    `(LET ((,name (CALL (QUOTE ,%fetch-continuation) (QUOTE #F))))
-       ,(cpsconv/expr (cpsconv/named-continuation name)
-		      program))))
+  (let* ((name (new-continuation-variable))
+	 (program*
+	  `(LET ((,name (CALL (QUOTE ,%fetch-continuation) (QUOTE #F))))
+	     ,(cpsconv/expr (cpsconv/named-continuation name)
+			    program))))
+    (cpsconv/remember program* program)))
 
 (define-macro (define-cps-converter keyword bindings . body)
   (let ((proc-name (symbol-append 'CPSCONV/ keyword)))
@@ -84,7 +86,7 @@ MIT in each case. |#
   `(LETREC ,(lmap (lambda (binding)
 		    (let ((value (cadr binding)))
 		      (list (car binding)
-			    (cpsconv/lambda* (cadr value) (caddr value)))))
+			    (cpsconv/lambda** value))))
 		  bindings)
      ,(cpsconv/expr cont body)))
 
@@ -92,6 +94,11 @@ MIT in each case. |#
   `(LAMBDA ,lambda-list
      ,(cpsconv/expr (cpsconv/named-continuation (car lambda-list))
 		    body)))
+
+(define (cpsconv/lambda** lam-expr)
+  (cpsconv/remember (cpsconv/lambda* (lambda/formals lam-expr)
+				     (lambda/body lam-expr))
+		    lam-expr))
 
 #|
 (define-cps-converter CALL (cont rator orig-cont #!rest rands)
diff --git a/v8/src/compiler/midend/inlate.scm b/v8/src/compiler/midend/inlate.scm
index 7b2b781d7..306b8f5d2 100644
--- a/v8/src/compiler/midend/inlate.scm
+++ b/v8/src/compiler/midend/inlate.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: inlate.scm,v 1.1 1994/11/19 02:04:29 adams Exp $
+$Id: inlate.scm,v 1.2 1994/11/22 03:49:09 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -100,8 +100,10 @@ MIT in each case. |#
 			 (list `(DECLARE ,@decls)
 			       body)))))))
 	(inlate/remember new
-			 (new-dbg-procedure/make form lambda-list))))))
-
+			 (new-dbg-procedure/make
+			  form
+			  (cons name lambda-list)))))))
+#|
 (define (inlate/lambda* name req opt rest aux decls sbody)
   name					; ignored
   `(LAMBDA ,(append (cons (new-continuation-variable) req)
@@ -120,6 +122,7 @@ MIT in each case. |#
 	    (beginnify
 	     (list `(DECLARE ,@decls)
 		   body))))))
+|#
 
 (define-inlator IN-PACKAGE (environment expression)
   `(IN-PACKAGE ,(inlate/scode environment)
-- 
2.25.1