---------- Forwarded message ---------- From: Joe Marshall <[email protected]> Date: Sun, Sep 6, 2009 at 12:51 PM Subject: Found it. To: [email protected]
SF wasn't recognizing SYSTEM-GLOBAL-ENVIRONMENT, so it didn't optimize forms like ((access %record-ref system-global-environment) foo 0) If someone OKs the diff, I'll push the change. diff --git a/src/sf/subst.scm b/src/sf/subst.scm index 5744467..6fa6ac5 100644 --- a/src/sf/subst.scm +++ b/src/sf/subst.scm @@ -436,7 +436,7 @@ you ask for. block operator operands)) ((and (access? operator) (constant/system-global-environment? - (access/environment operator))) + (integrate/expression operations environment (access/environment operator)))) (integrate/access-operator expression operations environment block operator operands)) ((and (constant? operator) @@ -614,19 +614,16 @@ you ask for. (define-method/integrate 'ACCESS (lambda (operations environment expression) - (let ((environment* (access/environment expression)) + (let ((environment* (integrate/expression operations environment + (access/environment expression))) (name (access/name expression))) - (if (constant/system-global-environment? environment*) - (let ((entry (assq name usual-integrations/constant-alist))) - (if entry - (constant/make (access/scode expression) - (constant/value (cdr entry))) - (access/make (access/scode expression) - environment* name))) - (access/make (access/scode expression) - (integrate/expression operations environment - environment*) - name))))) + (cond ((and (constant/system-global-environment? environment*) + (assq name usual-integrations/constant-alist)) + => (lambda (entry) + (constant/make (access/scode expression) + (constant/value (cdr entry))))) + (else (access/make (access/scode expression) + environment* name)))))) (define (constant/system-global-environment? expression) (and (constant? expression) @@ -654,8 +651,11 @@ you ask for. (let ((name (access/name operator)) (dont-integrate (lambda () - (combination/make (and expression (object/scode expression)) - block operator operands)))) + (combination/make + (and expression (object/scode expression)) + block + (integrate/expression operations environment operator) + (integrate/expressions operations environment operands))))) (cond ((and (eq? name 'APPLY) (integrate/hack-apply? operands)) => (lambda (operands*) -- ~jrm -- ~jrm
_______________________________________________ MIT-Scheme-devel mailing list [email protected] http://lists.gnu.org/mailman/listinfo/mit-scheme-devel
