From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 26 Jan 2018 05:52:16 +0000 (-0800)
Subject: Eliminate open-block-components and rename other procedures to include "scode".
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~303
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=205fbbac025e49fc74643401edca006c55da8051;p=mit-scheme.git

Eliminate open-block-components and rename other procedures to include "scode".
---

diff --git a/src/6001/nodefs.scm b/src/6001/nodefs.scm
index 910e1824d..27920542b 100644
--- a/src/6001/nodefs.scm
+++ b/src/6001/nodefs.scm
@@ -49,8 +49,10 @@ USA.
 
 (define (rewrite-scode expression context)
   (let ((expression
-	 (if (open-block? expression)
-	     (open-block-components expression unscan-defines)
+	 (if (scode-open-block? expression)
+	     (unscan-defines (scode-open-block-names expression)
+			     (scode-open-block-declarations expression)
+			     (scode-open-block-actions expression))
 	     expression)))
     (if (eq? context 'REPL-BUFFER)
 	(make-scode-sequence
diff --git a/src/compiler/base/toplev.scm b/src/compiler/base/toplev.scm
index 06f269d16..cf9a05b26 100644
--- a/src/compiler/base/toplev.scm
+++ b/src/compiler/base/toplev.scm
@@ -221,19 +221,19 @@ USA.
     (cond ((scode/constant? scode)
 	   scode)
 	  ((scode/open-block? scode)
-	   (scode/open-block-components
-	    scode
-	    (lambda (names declarations body)
-	      (if (null? names)
-		  (scan-defines
-		   body
-		   (lambda (names declarations* body)
-		     (make-open-block names
-				      (append declarations declarations*)
-				      body)))
-		  scode))))
+	   (let ((names (scode/open-block-names scode))
+		 (declarations (scode/open-block-declarations scode))
+		 (body (scode/open-block-actions scode)))
+	     (if (null? names)
+		 (scan-defines body
+			       (lambda (names declarations* body)
+				 (scode/make-open-block names
+							(append declarations
+								declarations*)
+							body)))
+		 scode)))
 	  (else
-	   (scan-defines scode make-open-block)))))
+	   (scan-defines scode make-scode-open-block)))))
 
 ;;;; Alternate Entry Points
 
diff --git a/src/compiler/fggen/canon.scm b/src/compiler/fggen/canon.scm
index a7ce9d0e5..e233b32ec 100644
--- a/src/compiler/fggen/canon.scm
+++ b/src/compiler/fggen/canon.scm
@@ -317,9 +317,9 @@ ARBITRARY:	The expression may be executed more than once.  It
 	 (scode/make-directive
 	  (if (null? *top-level-declarations*)
 	      (canout-expr canout)
-	      (make-open-block '()
-			       *top-level-declarations*
-			       (canout-expr canout)))
+	      (scode/make-open-block '()
+				     *top-level-declarations*
+				     (canout-expr canout)))
 	  '(COMPILE-PROCEDURE)
 	  expr)
 	 true
@@ -340,20 +340,20 @@ ARBITRARY:	The expression may be executed more than once.  It
 	 (error "canonicalize/sequence: open block in bad context"
 		expr context))
 	(else
-	 (scode/open-block-components
-	  expr
-	  (lambda (names decls body)
-	    (fluid-let ((*top-level-declarations*
-			 (append decls *top-level-declarations*)))
-	      (let ((body (unscan-defines names decls body)))
-		((if (and (eq? context 'TOP-LEVEL)
-			  compiler:compress-top-level?
-			  (> (length names) 1))
-		     canonicalize/compressing
-		     canonicalize/expression)
-		 body
-		 bound
-		 context))))))))
+	 (let ((names (scode/open-block-names expr))
+	       (decls (scode/open-block-declarations expr))
+	       (body (scode/open-block-actions expr)))
+	   (fluid-let ((*top-level-declarations*
+			(append decls *top-level-declarations*)))
+	     (let ((body (unscan-defines names decls body)))
+	       ((if (and (eq? context 'TOP-LEVEL)
+			 compiler:compress-top-level?
+			 (> (length names) 1))
+		    canonicalize/compressing
+		    canonicalize/expression)
+		body
+		bound
+		context)))))))
 
 (define (%single-definition name value)
   (scode/make-combination
diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm
index 4f4eccccb..60765cc8d 100644
--- a/src/compiler/fggen/fggen.scm
+++ b/src/compiler/fggen/fggen.scm
@@ -72,7 +72,9 @@ USA.
 				       declarations
 				       (unscan-defines names '() body)))))
 			(if (scode/open-block? scode)
-			    (scode/open-block-components scode collect)
+			    (collect (scode/open-block-names scode)
+				     (scode/open-block-declarations scode)
+				     (scode/open-block-actions scode))
 			    (scan-defines scode collect))))
 		  (lambda (variables declarations scode)
 		    (set-block-bound-variables! block variables)
@@ -816,13 +818,11 @@ USA.
 	     (cond ((scode/lambda? expression)
 		    (process (scode/lambda-name expression)))
 		   ((scode/open-block? expression)
-		    (scode/open-block-components
-		     expression
-		     (lambda (names decls body)
-		       decls		; ignored
-		       (if (and (null? names) (scode/lambda? body))
-			   (process (scode/lambda-name body))
-			   (fail)))))
+		    (let ((body (scode/open-block-actions expression)))
+		      (if (and (null? (scode/open-block-names expression))
+			       (scode/lambda? body))
+			  (process (scode/lambda-name body))
+			  (fail))))
 		   (else
 		    (fail)))))
 	  ((ENCLOSE)
diff --git a/src/compiler/machines/C/compiler.pkg b/src/compiler/machines/C/compiler.pkg
index 90b0a0fa9..dffae1e75 100644
--- a/src/compiler/machines/C/compiler.pkg
+++ b/src/compiler/machines/C/compiler.pkg
@@ -142,14 +142,16 @@ USA.
 	  (scode/make-delay make-scode-delay)
 	  (scode/make-disjunction make-scode-disjunction)
 	  (scode/make-lambda make-scode-lambda)
-	  (scode/make-open-block make-open-block)
+	  (scode/make-open-block make-scode-open-block)
 	  (scode/make-quotation make-scode-quotation)
 	  (scode/make-sequence make-scode-sequence)
 	  (scode/make-the-environment make-scode-the-environment)
 	  (scode/make-unassigned? make-scode-unassigned?)
 	  (scode/make-variable make-scode-variable)
-	  (scode/open-block-components open-block-components)
-	  (scode/open-block? open-block?)
+	  (scode/open-block-actions scode-open-block-actions)
+	  (scode/open-block-declarations scode-open-block-declarations)
+	  (scode/open-block-names scode-open-block-names)
+	  (scode/open-block? scode-open-block?)
 	  (scode/primitive-procedure? primitive-procedure?)
 	  (scode/procedure? procedure?)
 	  (scode/quotation-expression scode-quotation-expression)
diff --git a/src/compiler/machines/i386/compiler.pkg b/src/compiler/machines/i386/compiler.pkg
index 8dee49e3b..3745cb265 100644
--- a/src/compiler/machines/i386/compiler.pkg
+++ b/src/compiler/machines/i386/compiler.pkg
@@ -140,14 +140,16 @@ USA.
 	  (scode/make-delay make-scode-delay)
 	  (scode/make-disjunction make-scode-disjunction)
 	  (scode/make-lambda make-scode-lambda)
-	  (scode/make-open-block make-open-block)
+	  (scode/make-open-block make-scode-open-block)
 	  (scode/make-quotation make-scode-quotation)
 	  (scode/make-sequence make-scode-sequence)
 	  (scode/make-the-environment make-scode-the-environment)
 	  (scode/make-unassigned? make-scode-unassigned?)
 	  (scode/make-variable make-scode-variable)
-	  (scode/open-block-components open-block-components)
-	  (scode/open-block? open-block?)
+	  (scode/open-block-actions scode-open-block-actions)
+	  (scode/open-block-declarations scode-open-block-declarations)
+	  (scode/open-block-names scode-open-block-names)
+	  (scode/open-block? scode-open-block?)
 	  (scode/primitive-procedure? primitive-procedure?)
 	  (scode/procedure? procedure?)
 	  (scode/quotation-expression scode-quotation-expression)
diff --git a/src/compiler/machines/svm/compiler.pkg b/src/compiler/machines/svm/compiler.pkg
index c0bc3ab34..eec79f61b 100644
--- a/src/compiler/machines/svm/compiler.pkg
+++ b/src/compiler/machines/svm/compiler.pkg
@@ -143,14 +143,16 @@ USA.
 	  (scode/make-delay make-scode-delay)
 	  (scode/make-disjunction make-scode-disjunction)
 	  (scode/make-lambda make-scode-lambda)
-	  (scode/make-open-block make-open-block)
+	  (scode/make-open-block make-scode-open-block)
 	  (scode/make-quotation make-scode-quotation)
 	  (scode/make-sequence make-scode-sequence)
 	  (scode/make-the-environment make-scode-the-environment)
 	  (scode/make-unassigned? make-scode-unassigned?)
 	  (scode/make-variable make-scode-variable)
-	  (scode/open-block-components open-block-components)
-	  (scode/open-block? open-block?)
+	  (scode/open-block-actions scode-open-block-actions)
+	  (scode/open-block-declarations scode-open-block-declarations)
+	  (scode/open-block-names scode-open-block-names)
+	  (scode/open-block? scode-open-block?)
 	  (scode/primitive-procedure? primitive-procedure?)
 	  (scode/procedure? procedure?)
 	  (scode/quotation-expression scode-quotation-expression)
diff --git a/src/compiler/machines/x86-64/compiler.pkg b/src/compiler/machines/x86-64/compiler.pkg
index c9824f551..de99afe58 100644
--- a/src/compiler/machines/x86-64/compiler.pkg
+++ b/src/compiler/machines/x86-64/compiler.pkg
@@ -143,14 +143,16 @@ USA.
 	  (scode/make-delay make-scode-delay)
 	  (scode/make-disjunction make-scode-disjunction)
 	  (scode/make-lambda make-scode-lambda)
-	  (scode/make-open-block make-open-block)
+	  (scode/make-open-block make-scode-open-block)
 	  (scode/make-quotation make-scode-quotation)
 	  (scode/make-sequence make-scode-sequence)
 	  (scode/make-the-environment make-scode-the-environment)
 	  (scode/make-unassigned? make-scode-unassigned?)
 	  (scode/make-variable make-scode-variable)
-	  (scode/open-block-components open-block-components)
-	  (scode/open-block? open-block?)
+	  (scode/open-block-actions scode-open-block-actions)
+	  (scode/open-block-declarations scode-open-block-declarations)
+	  (scode/open-block-names scode-open-block-names)
+	  (scode/open-block? scode-open-block?)
 	  (scode/primitive-procedure? primitive-procedure?)
 	  (scode/procedure? procedure?)
 	  (scode/quotation-expression scode-quotation-expression)
diff --git a/src/edwin/xform.scm b/src/edwin/xform.scm
index 0f3ddb5f3..f849ee8dd 100644
--- a/src/edwin/xform.scm
+++ b/src/edwin/xform.scm
@@ -92,12 +92,12 @@ USA.
 					   body)))))
 
 (define (transform-open-block transforms open-block)
-  (open-block-components open-block
-    (lambda (names declarations body)
-      (make-open-block names declarations
-		       (transform-expression (remove-transforms transforms
-								names)
-					     body)))))
+  (let ((names (scode-open-block-names open-block)))
+    (make-scode-open-block
+     names
+     (scode-open-block-declarations open-block)
+     (transform-expression (remove-transforms transforms names)
+			   (scode-open-block-actions open-block)))))
 
 (define (transform-definition transforms definition)
   (let ((name (scode-definition-name definition))
diff --git a/src/runtime/codwlk.scm b/src/runtime/codwlk.scm
index fab46b05a..b0e5ff3d7 100644
--- a/src/runtime/codwlk.scm
+++ b/src/runtime/codwlk.scm
@@ -146,7 +146,7 @@ USA.
       (scode-walker/comment walker)))
 
 (define (walk/sequence walker expression)
-  (if (open-block? expression)
+  (if (scode-open-block? expression)
       (scode-walker/open-block walker)
       (scode-walker/sequence walker)))
 
diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm
index 4206daf99..610adc15b 100644
--- a/src/runtime/host-adapter.scm
+++ b/src/runtime/host-adapter.scm
@@ -100,6 +100,10 @@ USA.
 		lambda-body
 		lambda-name
 		lambda?
+		open-block-actions
+		open-block-declarations
+		open-block-names
+		open-block?
 		quotation-expression
 		quotation?
 		sequence-actions
@@ -122,6 +126,7 @@ USA.
 		delay
 		disjunction
 		lambda
+		open-block
 		quotation
 		sequence
 		the-environment
diff --git a/src/runtime/lambdx.scm b/src/runtime/lambdx.scm
index 7afb22e2f..76e445640 100644
--- a/src/runtime/lambdx.scm
+++ b/src/runtime/lambdx.scm
@@ -40,7 +40,7 @@ USA.
   (scode-lambda-components *lambda
     (lambda (name required optional rest auxiliary declarations body)
       (receiver name required optional rest
-		(make-open-block auxiliary declarations body)))))
+		(make-scode-open-block auxiliary declarations body)))))
 
 (define (lambda-components** *lambda receiver)
   (lambda-components* *lambda
diff --git a/src/runtime/predicate-tagging.scm b/src/runtime/predicate-tagging.scm
index 6fa109f26..ebf6e0ef7 100644
--- a/src/runtime/predicate-tagging.scm
+++ b/src/runtime/predicate-tagging.scm
@@ -187,7 +187,7 @@ USA.
 	     default-tag))))
 
    (define-primitive-predicate-method 'sequence
-     (simple-alternative scode-sequence? open-block?))
+     (simple-alternative scode-sequence? scode-open-block?))
 
    (define-primitive-predicate-method 'tagged-object
      %tagged-object-tag)))
\ No newline at end of file
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 747769c2b..f10a39505 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3991,13 +3991,12 @@ USA.
   (files "scan")
   (parent (runtime))
   (export ()
-	  make-open-block
-	  open-block-actions
-	  open-block-components
-	  open-block-declarations
-	  open-block-names
-	  open-block?
+	  make-scode-open-block
 	  scan-defines
+	  scode-open-block-actions
+	  scode-open-block-declarations
+	  scode-open-block-names
+	  scode-open-block?
 	  unscan-defines))
 
 (define-package (runtime scode-walker)
diff --git a/src/runtime/scan.scm b/src/runtime/scan.scm
index 3a5d7321b..9a8fc012d 100644
--- a/src/runtime/scan.scm
+++ b/src/runtime/scan.scm
@@ -39,11 +39,8 @@ USA.
 ;;; of those names, and a new sequence in which those definitions are
 ;;; replaced by assignments.  UNSCAN-DEFINES will invert that.
 
-;;; The Open Block abstraction can be used to store scanned
-;;; definitions in code, which is extremely useful for code analysis
-;;; and transformation.  The supplied procedures, MAKE-OPEN-BLOCK and
-;;; OPEN-BLOCK-COMPONENTS, will connect directly to SCAN-DEFINES and
-;;; UNSCAN-DEFINES, respectively.
+;;; The Open Block abstraction can be used to store scanned definitions in code,
+;;; which is extremely useful for code analysis and transformation.
 
 (define-integrable sequence-type
   (ucode-type sequence))
@@ -67,7 +64,7 @@ USA.
   ((scan-loop expression receiver) '() '() null-sequence))
 
 (define (scan-loop expression receiver)
-  (cond ((open-block? expression)      ; must come before SCODE-SEQUENCE? clause
+  (cond ((scode-open-block? expression)      ; must come before SCODE-SEQUENCE? clause
 	 (scan-loop
 	  (%open-block-actions expression)
 	  (lambda (names declarations body)
@@ -151,7 +148,7 @@ USA.
 
 ;;;; Open Block
 
-(define (make-open-block names declarations actions)
+(define (make-scode-open-block names declarations actions)
   (if (and (null? names)
 	   (null? declarations))
       actions
@@ -163,7 +160,7 @@ USA.
 (define (%make-open-block-definition name)
   (make-scode-definition name (make-unassigned-reference-trap)))
 
-(define (open-block? object)
+(define (scode-open-block? object)
   (and (scode-sequence? object)
        (let ((actions (scode-sequence-actions object)))
 	 (and (open-block-descriptor? (car actions))
@@ -172,31 +169,25 @@ USA.
 		     (every %open-block-definition-named?
 			    names
 			    (cdr actions))))))))
-(register-predicate! open-block? 'open-block '<= scode-sequence?)
+(register-predicate! scode-open-block? 'open-block '<= scode-sequence?)
 
 (define (%open-block-definition-named? name expr)
   (and (scode-definition? expr)
        (eq? name (scode-definition-name expr))
        (unassigned-reference-trap? (scode-definition-value expr))))
 
-(define (open-block-names open-block)
-  (guarantee open-block? open-block 'open-block-names)
+(define (scode-open-block-names open-block)
+  (guarantee scode-open-block? open-block 'scode-open-block-names)
   (%open-block-names open-block))
 
-(define (open-block-declarations open-block)
-  (guarantee open-block? open-block 'open-block-declarations)
+(define (scode-open-block-declarations open-block)
+  (guarantee scode-open-block? open-block 'scode-open-block-declarations)
   (%open-block-declarations open-block))
 
-(define (open-block-actions open-block)
-  (guarantee open-block? open-block 'open-block-actions)
+(define (scode-open-block-actions open-block)
+  (guarantee scode-open-block? open-block 'scode-open-block-actions)
   (%open-block-actions open-block))
 
-(define (open-block-components open-block receiver)
-  (guarantee open-block? open-block 'open-block-components)
-  (receiver (%open-block-names open-block)
-	    (%open-block-declarations open-block)
-	    (%open-block-actions open-block)))
-
 (define (%open-block-descriptor open-block)
   (car (scode-sequence-actions open-block)))
 
diff --git a/src/runtime/syntax-output.scm b/src/runtime/syntax-output.scm
index fdb91cd19..5c175af00 100644
--- a/src/runtime/syntax-output.scm
+++ b/src/runtime/syntax-output.scm
@@ -105,8 +105,8 @@ USA.
 		   names
 		   temps)))
 	    (list
-	     (let ((body (scan-defines body make-open-block)))
-	       (if (open-block? body)
+	     (let ((body (scan-defines body make-scode-open-block)))
+	       (if (scode-open-block? body)
 		   (output/let '() '() body)
 		   body))))))))
 
@@ -117,25 +117,26 @@ USA.
 		       (list (make-block-declaration declarations)
 			     body))
 		      body))
-		make-open-block))
+		make-scode-open-block))
 
 (define (output/definition name value)
   (make-scode-definition name value))
 
 (define (output/top-level-sequence declarations expressions)
   (let ((declarations (apply append declarations))
-	(make-open-block
+	(make-scode-open-block
 	 (lambda (expressions)
-	   (scan-defines (make-scode-sequence expressions) make-open-block))))
+	   (scan-defines (make-scode-sequence expressions)
+			 make-scode-open-block))))
     (if (pair? declarations)
-	(make-open-block
+	(make-scode-open-block
 	 (cons (make-block-declaration declarations)
 	       (if (pair? expressions)
 		   expressions
 		   (list (output/unspecific)))))
 	(if (pair? expressions)
 	    (if (pair? (cdr expressions))
-		(make-open-block expressions)
+		(make-scode-open-block expressions)
 		(car expressions))
 	    (output/unspecific)))))
 
@@ -238,12 +239,11 @@ USA.
 	   (declare (ignore pattern))
 	   (mark-local-bindings bound body mark-safe!)))))
 
-   (define-cs-handler open-block?
+   (define-cs-handler scode-open-block?
      (lambda (expression mark-safe!)
-       (open-block-components expression
-	 (lambda (bound declarations body)
-	   (declare (ignore declarations))
-	   (mark-local-bindings bound body mark-safe!)))))
+       (mark-local-bindings (scode-open-block-names expression)
+			    (scode-open-block-actions expression)
+			    mark-safe!)))
 
    (define-cs-handler scode-access?
      (simple-subexpression scode-access-environment))
@@ -347,16 +347,14 @@ USA.
 			  (map substitution bound)
 			  (alpha-substitute substitution body))))))
 
-   (define-as-handler open-block?
+   (define-as-handler scode-open-block?
      (lambda (substitution expression)
-       (open-block-components expression
-	 (lambda (bound declarations body)
-	   (make-open-block (map substitution bound)
-			    (map (lambda (declaration)
-				   (map-declaration-identifiers substitution
-								declaration))
-				 declarations)
-			    (alpha-substitute substitution body))))))
+       (make-scode-open-block
+	(map substitution (scode-open-block-names expression))
+	(map (lambda (declaration)
+	       (map-declaration-identifiers substitution declaration))
+	     (scode-open-block-declarations expression))
+	(alpha-substitute substitution (scode-open-block-actions expression)))))
 
    (define-as-handler scode-declaration?
      (lambda (substitution expression)
diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm
index 0590d2139..58b78ba03 100644
--- a/src/runtime/unsyn.scm
+++ b/src/runtime/unsyn.scm
@@ -237,12 +237,13 @@ USA.
 	      (loop (cdr actions)))
 	'())))
 
-(define (unsyntax-OPEN-BLOCK-object environment open-block)
+(define (unsyntax-open-block-object environment open-block)
   (if (eq? #t unsyntaxer:macroize?)
-      (open-block-components open-block
-	(lambda (auxiliary declarations expression)
-	  (unsyntax-object environment
-			   (unscan-defines auxiliary declarations expression))))
+      (unsyntax-object
+       environment
+       (unscan-defines (scode-open-block-names open-block)
+		       (scode-open-block-declarations open-block)
+		       (scode-open-block-actions open-block)))
       (unsyntax-SEQUENCE-object environment open-block)))
 
 (define (unsyntax-DELAY-object environment object)
@@ -387,11 +388,12 @@ USA.
       (make-lambda-list required optional rest '()))))
 
 (define (unsyntax-lambda-body environment body)
-  (if (open-block? body)
-      (open-block-components body
-	(lambda (names declarations open-block-body)
-	  (unsyntax-lambda-body-sequence environment
-	   (unscan-defines names declarations open-block-body))))
+  (if (scode-open-block? body)
+      (unsyntax-lambda-body-sequence
+       environment
+       (unscan-defines (scode-open-block-names body)
+		       (scode-open-block-declarations body)
+		       (scode-open-block-actions body)))
       (unsyntax-lambda-body-sequence environment body)))
 
 (define (unsyntax-lambda-body-sequence environment body)
diff --git a/src/runtime/xeval.scm b/src/runtime/xeval.scm
index 691258238..9c6f3113c 100644
--- a/src/runtime/xeval.scm
+++ b/src/runtime/xeval.scm
@@ -46,11 +46,8 @@ USA.
 	      (cond ((null? bound-names)
 		     expression)
 		    ((or (scode-definition? expression)
-			 (and (open-block? expression)
-			      (open-block-components expression
-				(lambda (names declarations body)
-				  declarations body
-				  (pair? names)))))
+			 (and (scode-open-block? expression)
+			      (pair? (scode-open-block-names expression))))
 		     (error
 		      "Can't perform definition in compiled-code environment:"
 		      (unsyntax expression)))
diff --git a/src/sf/cgen.scm b/src/sf/cgen.scm
index 35555e9ac..ac1edbdf5 100644
--- a/src/sf/cgen.scm
+++ b/src/sf/cgen.scm
@@ -186,14 +186,14 @@ USA.
 			(body  (procedure/body procedure)))
 		    (if (open-block? body)
 			(cgen-open-block body)
-			(make-open-block
+			(make-scode-open-block
 			 '()
 			 (maybe-flush-declarations (block/declarations block))
 			 (cgen/expression (list block) body)))))))
 
 (define (cgen-open-block expression)
   (let ((block (open-block/block expression)))
-    (make-open-block
+    (make-scode-open-block
      (map variable/name (open-block/variables expression))
      (maybe-flush-declarations (block/declarations block))
      (make-scode-sequence
@@ -205,7 +205,8 @@ USA.
 	      ((null? actions) (error "Extraneous auxiliaries"))
 	      ((eq? (car actions) open-block/value-marker)
 	       (cons (make-scode-assignment (variable/name (car variables))
-					    (cgen/expression (list block) (car values)))
+					    (cgen/expression (list block)
+							     (car values)))
 		     (loop (cdr variables) (cdr values) (cdr actions))))
 	      (else
 	       (cons (cgen/expression (list block) (car actions))
diff --git a/src/sf/gimprt.scm b/src/sf/gimprt.scm
deleted file mode 100644
index d6944ccde..000000000
--- a/src/sf/gimprt.scm
+++ /dev/null
@@ -1,32 +0,0 @@
-#| -*-Scheme-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-    2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; SCode Optimizer: Global Imports
-;;; package: (scode-optimizer global-imports)
-
-(declare (usual-integrations))
-
-(define scode-open-block? open-block?)
\ No newline at end of file
diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg
index 01dd5fa9d..4ecb418ee 100644
--- a/src/sf/sf.pkg
+++ b/src/sf/sf.pkg
@@ -42,12 +42,6 @@ USA.
   (import (runtime microcode-tables)
 	  microcode-type/code->name))
 
-(define-package (scode-optimizer global-imports)
-  (files "gimprt")
-  (parent ())
-  (export (scode-optimizer)
-          scode-open-block?))
-
 (define-package (scode-optimizer top-level)
   (files "toplev")
   (parent (scode-optimizer))
diff --git a/src/sf/xform.scm b/src/sf/xform.scm
index 3dfa2da8e..3e794bd63 100644
--- a/src/sf/xform.scm
+++ b/src/sf/xform.scm
@@ -57,17 +57,15 @@ USA.
 	  (begin
 	    (if (not top-level?)
 		(error "Open blocks allowed only at top level:" expression))
-	    (call-with-values
-		(lambda () (open-block-components expression values))
-	      (lambda (auxiliary declarations body)
-		(if (not (assq 'USUAL-INTEGRATIONS declarations))
-		    (ui-warning))
-		(transform/open-block* expression
-				       block
-				       environment
-				       auxiliary
-				       declarations
-				       body))))
+	    (let ((declarations (scode-open-block-declarations expression)))
+	      (if (not (assq 'USUAL-INTEGRATIONS declarations))
+		  (ui-warning))
+	      (transform/open-block* expression
+				     block
+				     environment
+				     (scode-open-block-names expression)
+				     declarations
+				     (scode-open-block-actions expression))))
 	  (transform/expression block environment expression)))))
 
 (define (ui-warning)
@@ -109,14 +107,12 @@ USA.
 	variables))
 
 (define (transform/open-block block environment expression)
-  (call-with-values (lambda () (open-block-components expression values))
-    (lambda (auxiliary declarations body)
-      (transform/open-block* expression
-			     (block/make block true '())
-			     environment
-			     auxiliary
-			     declarations
-			     body))))
+  (transform/open-block* expression
+			 (block/make block true '())
+			 environment
+			 (scode-open-block-names expression)
+			 (scode-open-block-declarations expression)
+			 (scode-open-block-actions expression)))
 
 (define (transform/open-block* expression block environment auxiliary
 			       declarations body)
@@ -222,14 +218,16 @@ USA.
 
 (define (transform/procedure-body block environment expression)
   (if (scode-open-block? expression)
-      (open-block-components expression
-	(lambda (auxiliary declarations body)
-	  (if (null? auxiliary)
-	      (begin (set-block/declarations!
-		      block
-		      (declarations/parse block declarations))
-		     (transform/expression block environment body))
-	      (transform/open-block block environment expression))))
+      (if (null? (scode-open-block-names expression))
+	  (begin
+	    (set-block/declarations!
+	     block
+	     (declarations/parse block
+				 (scode-open-block-declarations expression)))
+	    (transform/expression block
+				  environment
+				  (scode-open-block-actions expression)))
+	  (transform/open-block block environment expression))
       (transform/expression block environment expression)))
 
 (define (transform/definition block environment expression)