Re: syntax-locally-bound-identifiers, local-eval

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 2358 bytes --]

Hi Andy,

> There's another thing that really should be fixed, for the sake of
> preserving our ability to change the implementation `local-eval' in the
> future.
>
> Since (the-environment) can be included in code compiled to disk, the
> lexical environment objects that it returns are effectively now part of
> our ABI.  As it is now, if we want to change the representation, we'll
> be in for a lot of headaches to support lexical environments produced by
> older code.
>
> The fix is simple: Simply change the representation of the lexical
> environment object to contain only a single field: a procedure that
> takes an expression (and optional keyword arguments) and does the
> equivalent of `local-eval' or `local-compile'.  (The keyword arguments
> should specify whether or not to compile, and the compile options).
>
> Then, `local-eval' and `local-compile', when applied to a lexical
> environment object, should simply call the embedded procedure.

To help facilitate this change, I've attached a small patch to change my
variant of `local-eval' to use this simple future-proof representation.
As you can see, the changes are simple and nicely localized.  I'll leave
it to you to adapt these changes to your implementation.

Also, see below for an improved "the-environment within a macro" test
that now checks that the proper module was stored in the lexical
environment.  Please verify that this works properly with your patch.

     Thanks!
       Mark


  (pass-if "the-environment within a macro"
    (let ((module-a-name '(test module the-environment a))
          (module-b-name '(test module the-environment b)))
      (let ((module-a (resolve-module module-a-name))
            (module-b (resolve-module module-b-name)))
        (module-use! module-a (resolve-interface '(guile)))
        (module-use! module-a (resolve-interface '(ice-9 local-eval)))
        (eval '(begin
                 (define z 3)
                 (define-syntax-rule (test)
                   (let ((x 1) (y 2))
                     (the-environment))))
              module-a)
        (module-use! module-b (resolve-interface '(guile)))
        (let ((env (eval `(let ((x 111) (y 222))
                            ((@@ ,module-a-name test)))
                         module-b)))
          (equal? (local-eval '(list x y z) env)
                  '(1 2 3))))))



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Switch to universal lexical environment representation --]
[-- Type: text/x-patch, Size: 4017 bytes --]

diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
index ece1313..fb6752c 100644
--- a/module/ice-9/local-eval.scm
+++ b/module/ice-9/local-eval.scm
@@ -24,34 +24,20 @@
   #:export (local-eval local-compile))
 
 (define-record-type lexical-environment-type
-  (make-lexical-environment module wrapper boxes pattern-bindings
-                            var-names pattern-var-names unsupported-names)
+  (make-lexical-environment version evaluator)
   lexical-environment?
-  (module            lexenv-module)
-  (wrapper           lexenv-wrapper)
-  (boxes             lexenv-boxes)
-  (pattern-bindings  lexenv-pattern-bindings)
-  (var-names         lexenv-var-names)
-  (pattern-var-names lexenv-pattern-var-names)
-  (unsupported-names lexenv-unsupported-names))
+  (version           lexenv-version)
+  (evaluator         lexenv-evaluator))
 
 (set-record-type-printer!
  lexical-environment-type
  (lambda (e port)
-   (format port "#<lexical-environment ~S ~S ~S ~S>"
-           (module-name (lexenv-module e))
-           (reverse (map (lambda (name box) (list name (box)))
-                         (lexenv-var-names e) (lexenv-boxes e)))
-           (reverse (lexenv-pattern-var-names e))
-           (reverse (lexenv-unsupported-names e)))))
+   (format port "#<lexical-environment>")))
 
 (define (local-eval x e)
   "Evaluate the expression @var{x} within the lexical environment @var{e}."
   (cond ((lexical-environment? e)
-         (apply (eval ((lexenv-wrapper e) x)
-                      (lexenv-module e))
-                (append (lexenv-boxes e)
-                        (lexenv-pattern-bindings e))))
+         ((lexenv-evaluator e) x #f))
         ((module? e)
          ;; Here we evaluate the expression within `lambda', and then
          ;; call the resulting procedure outside of the dynamic extent
@@ -64,11 +50,7 @@
 (define* (local-compile x e #:key (opts '()))
   "Compile and evaluate the expression @var{x} within the lexical environment @var{e}."
   (cond ((lexical-environment? e)
-         (apply (compile ((lexenv-wrapper e) x)
-                         #:env (lexenv-module e)
-                         #:from 'scheme #:opts opts)
-                (append (lexenv-boxes e)
-                        (lexenv-pattern-bindings e))))
+         ((lexenv-evaluator e) x opts))
         ((module? e)
          ;; Here we compile the expression within `lambda', and then
          ;; call the resulting procedure outside of the dynamic extent
@@ -109,18 +91,21 @@
            (((nested-pvar ...)
              (map within-nested-ellipses #'(pvar ...) #'(pvar-lvl ...))))
          #'(make-lexical-environment
-            module
-            (lambda (expression) #`(box-lambda*
-                                    #,'(v ...)
-                                    #,'(pvar ...)
-                                    #,'(pvar-lvl ...)
-                                    #,'(unsupported ...)
-                                    #,expression))
-            (list box ...)
-            (list #'nested-pvar ...)
-            '(v ...)
-            '(pvar ...)
-            '(unsupported ...)))))))
+            1  ; version number
+            (let ((mod module)
+                  (args (list box ... #'nested-pvar ...)))
+              (lambda (expression opts)
+                (let* ((wrapped-expr #`(box-lambda*
+                                        #,'(v ...)
+                                        #,'(pvar ...)
+                                        #,'(pvar-lvl ...)
+                                        #,'(unsupported ...)
+                                        #,expression))
+                       (proc (if opts
+                                 (compile wrapped-expr #:env mod
+                                          #:from 'scheme #:opts opts)
+                                 (eval wrapped-expr mod))))
+                  (apply proc args))))))))))
 
 (define-syntax-rule (identifier-syntax-from-box box)
   (make-transformer-from-box