From 3b25de7d815bc9774fecd1defd0faf640263334e Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Mon, 11 Jun 1990 16:34:51 +0000
Subject: [PATCH] Fix transform/definition to allow non-scanned top-level
 definitions. The arise due to in-package.

---
 v7/src/sf/xform.scm | 27 +++++++++++++++++++++++++--
 1 file changed, 25 insertions(+), 2 deletions(-)

diff --git a/v7/src/sf/xform.scm b/v7/src/sf/xform.scm
index 0b27a7258..9994deb42 100644
--- a/v7/src/sf/xform.scm
+++ b/v7/src/sf/xform.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/xform.scm,v 4.2 1988/10/29 00:07:15 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/xform.scm,v 4.3 1990/06/11 16:34:51 jinx Rel $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -205,6 +205,9 @@ MIT in each case. |#
 		     (transform/expression block environment body))
 	      (transform/open-block block environment expression))))
       (transform/expression block environment expression)))
+
+#|
+;; In-package no longer scans the body, so definitions at top-level are legal.
 
 (define (transform/definition block environment expression)
   block environment ; ignored
@@ -212,6 +215,26 @@ MIT in each case. |#
     (lambda (name value)
       value ; ignored
       (error "Unscanned definition encountered.  Unable to proceed." name))))
+|#
+
+(define (transform/definition block environment expression)
+  (definition-components expression
+    (lambda (name value)
+      (if (not (top-level-block? block))
+	  (error "Unscanned definition encountered.  Unable to proceed." name)
+	  (transform/combination
+	   block environment
+	   (make-combination
+	    (make-primitive-procedure 'local-assignment)
+	    (list (make-the-environment)
+		  name
+		  value)))))))
+
+;; Kludge!
+
+(define (top-level-block? block)
+  (let ((parent (block/parent block)))
+    (and parent (eq? parent global-block))))
 
 (define (transform/access block environment expression)
   (access-components expression
-- 
2.25.1