Add new operator to extract the integrated variables from a set of
authorChris Hanson <org/chris-hanson/cph>
Fri, 8 May 1987 02:34:16 +0000 (02:34 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 8 May 1987 02:34:16 +0000 (02:34 +0000)
declarations.

v7/src/sf/pardec.scm

index 487ac5094e5f35b2d3d68b8978dc5b5e30a6b1fb..941a330d4de6e6a6729716a4631a9ba7b0967d0f 100644 (file)
@@ -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)))
 \f
 (declare (integrate-operator declarations/make declarations/original
                             declarations/before declarations/after))