From 2f3974e6fc01e28bbc5f4416bb76adf5d079c987 Mon Sep 17 00:00:00 2001
From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Tue, 13 Jul 2010 11:40:35 -0700
Subject: [PATCH] Add block to access so we can integrate accesses in argument
 position.

---
 src/sf/copy.scm   | 1 +
 src/sf/object.scm | 3 ++-
 src/sf/subst.scm  | 8 ++++++--
 src/sf/xform.scm  | 1 +
 4 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/sf/copy.scm b/src/sf/copy.scm
index 5f778f8b7..20162f9b5 100644
--- a/src/sf/copy.scm
+++ b/src/sf/copy.scm
@@ -172,6 +172,7 @@ USA.
 (define-method/copy 'ACCESS
   (lambda (block environment expression)
     (access/make (access/scode expression)
+		 (access/block expression)
 		 (copy/expression block
 				  environment
 				  (access/environment expression))
diff --git a/src/sf/object.scm b/src/sf/object.scm
index 0d15dfe43..140020c58 100644
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -201,7 +201,7 @@ USA.
 (define-guarantee variable "variable")
 
 ;;; Expressions
-(define-simple-type access          #f                 (environment name))
+(define-simple-type access          #f                 (block environment name))
 (define-simple-type assignment      #f                 (block variable value))
 (define-simple-type combination     combination/%make  (block operator operands))
 (define-simple-type conditional     conditional/%make  (predicate consequent alternative))
@@ -327,6 +327,7 @@ USA.
 
 (define-integrable (global-ref/make name)
   (access/make #f
+	       #f
 	       (constant/make #f system-global-environment)
 	       name))
 
diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 0c99e01d3..7216c5ee0 100644
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -105,7 +105,9 @@ USA.
 	  (name (access/name expression)))
 
       (define (dont-integrate)
-	(access/make (access/scode expression) environment* name))
+	(access/make (access/scode expression)
+		     (access/block expression)
+		     environment* name))
 
       (if (not (constant/system-global-environment? environment*))
 	  (dont-integrate)
@@ -815,7 +817,9 @@ USA.
     (define (dont-integrate)
       (combination/make
        expression block
-       (access/make (access/scode operator) environment* name) operands))
+       (access/make (access/scode operator)
+		    (access/block operator)
+		    environment* name) operands))
 
     (if (not (constant/system-global-environment? environment*))
 	(dont-integrate)
diff --git a/src/sf/xform.scm b/src/sf/xform.scm
index ffcac1f84..e635507fc 100644
--- a/src/sf/xform.scm
+++ b/src/sf/xform.scm
@@ -241,6 +241,7 @@ USA.
   (access-components expression
     (lambda (environment* name)
       (access/make expression
+		   block
 		   (transform/expression block environment environment*)
 		   name))))
 
-- 
2.25.1