From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 8 May 1987 02:34:16 +0000 (+0000)
Subject: Add new operator to extract the integrated variables from a set of
X-Git-Tag: 20090517-FFI~13540
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f8f341af23b02fd6f74c8e4c02147eeab6ff3e10;p=mit-scheme.git

Add new operator to extract the integrated variables from a set of
declarations.
---

diff --git a/v7/src/sf/pardec.scm b/v7/src/sf/pardec.scm
index 487ac5094..941a330d4 100644
--- a/v7/src/sf/pardec.scm
+++ b/v7/src/sf/pardec.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/pardec.scm,v 3.3 1987/03/19 17:19:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/pardec.scm,v 3.4 1987/05/08 02:34:16 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -128,11 +128,8 @@ MIT in each case. |#
 	  (for-each procedure (binding/names binding))))))
 
 (define (declarations/for-each-binding declarations procedure)
-  (let ((procedure
-	 (lambda (bindings)
-	   (for-each procedure bindings))))
-    (procedure (declarations/before declarations))
-    (procedure (declarations/after declarations))))
+  (for-each procedure (declarations/before declarations))
+  (for-each procedure (declarations/after declarations)))
 
 (define (declarations/map declarations per-name per-value)
   (declarations/map-binding declarations
@@ -145,16 +142,21 @@ MIT in each case. |#
 		      (binding/export? binding)
 		      (if global? names (map per-name names))
 		      (if (eq? values 'NO-VALUES)
-			  values
+			  'NO-VALUES
 			  (map per-value values)))))))
 
 (define (declarations/map-binding declarations procedure)
-  (let ((procedure
-	 (lambda (bindings)
-	   (map procedure bindings))))
-    (declarations/make (declarations/original declarations)
-		       (procedure (declarations/before declarations))
-		       (procedure (declarations/after declarations)))))
+  (declarations/make (declarations/original declarations)
+		     (map procedure (declarations/before declarations))
+		     (map procedure (declarations/after declarations))))
+
+(define (declarations/integrated-variables declarations)
+  (mapcan (lambda (binding)
+	    (if (and (eq? 'INTEGRATE (binding/operation binding))
+		     (eq? 'NO-VALUES (binding/values binding)))
+		(list-copy (binding/names binding))
+		'()))
+	  (declarations/after declarations)))
 
 (declare (integrate-operator declarations/make declarations/original
 			     declarations/before declarations/after))