unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Implement local-eval, local-compile, and the-environment
@ 2012-01-03 10:52 Mark H Weaver
  2012-01-03 11:55 ` David Kastrup
                   ` (2 more replies)
  0 siblings, 3 replies; 16+ messages in thread
From: Mark H Weaver @ 2012-01-03 10:52 UTC (permalink / raw)
  To: guile-devel

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

Hello all,

I have now produced two very different implementations of
`the-environment' and `local-eval' that support compilation.

Included below is a simple patch that I believe is ready for commit to
the stable-2.0 branch, and I very much hope it can be included in 2.0.4.

However, before I tell you about this nice simple patch, I'll briefly
mention the other more complex (and more efficient) compiler
implementation.

* * * * *

A few days ago I finished a working implementation that is fully
integrated into all passes of the compiler, and with a completely
separate evaluator implementation (which I've already posted).  I wrote
it in such a way that other languages could easily implement similar
functionality, by separating the lexical environment object into two
layers: one layer for tree-il that would be appropriate for any language
that compiles to tree-il, and one layer for scheme (macro expansion).

It was also implemented with efficiency in mind: `local-eval', when
applied to a lexical environment produced by compiled code, produces a
closure with free variables attached, so the only performance loss is
due to the fact that all reachable lexicals must be boxed.

Also, it was implemented such that `local-eval' for compiled lexical
environments simply does this: (compile x #:env e).  This involved
changing the representation of compile environments to support
structures other than simple modules, which is arguably a good idea
independently of the needs of `local-eval', before the assumption that
(compiler environments == modules) becomes too deeply entrenched.

However, in the end, I felt that this implementation was more complex
than I'd prefer, and too spread out.  Future work on the compiler would
always need to keep `the-environment' in mind, and it could easily
become broken in subtle ways if future implementers weren't careful.
I may work on it again in the future, but for now I've decided to use a
different approach.

* * * * *

The patch attached below implements `the-environment' and `local-eval'
in a much simpler way, though not quite as efficiently.  It is
implemented entirely in psyntax and in a new module (ice-9 local-eval).
No changes were needed to the compiler, and no new tree-il forms are
needed.

The idea is similar to the general dispatcher that I proposed earlier,
except that here the dispatcher is not a mere trick to fool the
compiler; it really is the mechanism used by local-eval to access the
captured variables.  Also, instead of making a single dispatcher for all
variables, I give each variable its own dispatcher, which I call a `box'
(though that name is not present in any public interfaces or
documentation).

  (define-syntax-rule (box v)
    (case-lambda
     (() v)
     ((x) (set! v x))))

Then I have something called `box-lambda' that is like `lambda' except
that the resulting procedure accepts these boxes as arguments, and uses
variable transformers to simulate normal variable bindings within:

  (define-syntax-rule (box-lambda (v ...) e)
    (lambda (v ...)
      (let-syntax
          ((v (identifier-syntax-from-box v))
           ...)
        (if #t e))))

  (define-syntax-rule (identifier-syntax-from-box b)
    (let ((trans (identifier-syntax
                  (id          (b))
                  ((set! id x) (b x)))))
      (set-procedure-property! trans
                               'identifier-syntax-box
                               (syntax-object-of b))
      trans))

The captured lexical environment includes a "wrapper" procedure that
takes an expression (or syntax-object) and wraps it within box-lambda*
(a slightly more complex variant of box-lambda).  `local-eval' simply
calls the wrapper, evaluates or compiles the wrapped expression, and
then applies the resulting procedure to the boxes.

This of course means that these variable references are transformed into
procedure calls, so there's an added cost.  A naive implementation would
cost O(n) where N is the box-lambda* nesting depth, but I added an
optimization so that we never nest boxes.  The first box is always
reused, so the cost is O(1).

Note that this approach means that we no longer need to capture or
serialize the internal psyntax data structures.  Unfortunately, in the
current patch, local syntax transformers are not supported, but I have a
plan for how to do that, at least for `syntax-rules' macros, which are
specially marked using procedure meta-data.

The idea is to attach the source code for `syntax-rules' macros to the
resulting transformer procedure using procedure properties.  Then
`the-environment' can create a more complex wrapping procedure that
creates a set of nested `let-syntax' and `letrec-syntax' forms,
replacing the single `let-syntax' created by `box-lambda*'.

In practice, the vast majority of procedural macros could be handled
this way as well, though unfortunately the emulation would not be
perfect in all cases, e.g. if the transformer includes local state.

In the current patch, only lexical _variables_ are captured, though the
list of unsupported lexical bindings is saved, and `box-lambda*'
arranges to throw an error at compile time if they are referenced.

I also added a new interface called `local-compile' that compiles the
local expression instead of using `eval'.

Anyway, here's the patch.  As before, I cut out the psyntax-pp.scm
patch, since it's so huge.  Regenerate it with:

  make -C module ice-9/psyntax-pp.scm.gen

Comments and suggestions solicited.

    Best,
     Mark


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Implement `local-eval', `local-compile', and `the-environment' --]
[-- Type: text/x-patch, Size: 20430 bytes --]

From 8017c7b688ce65c12e125ead6be271b6e7d3c88e Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 3 Jan 2012 04:02:08 -0500
Subject: [PATCH] Implement `local-eval', `local-compile', and
 `the-environment'

* module/ice-9/local-eval.scm: New module (ice-9 local-eval) which
  exports `local-eval' and `local-compile'.  This module also contains
  (non-exported) syntax transformers used internally by psyntax to
  implement `the-environment'.

* module/ice-9/psyntax.scm: New core syntax form `the-environment'.
  New internal procedure `reachable-sym+labels' generates the list
  of lexical bindings reachable using normal symbols (as opposed to
  syntax objects which could reach a larger set of bindings).

* libguile/debug.c (scm_local_eval): New C function that calls the
  Scheme implementation of `local-eval' in (ice-9 local-eval).

* libguile/debug.h (scm_local_eval): Add prototype.

* doc/ref/api-evaluation.texi (Local Evaluation): Add documentation.

* test-suite/tests/eval.test (local evaluation): Add tests.

* test-suite/standalone/test-loose-ends.c (test_scm_local_eval):
  Add test.

* module/Makefile.am: Add ice-9/local-eval.scm.

* module/ice-9/psyntax-pp.scm: Regenerate from psyntax.scm.
---
 doc/ref/api-evaluation.texi             |   41 +
 libguile/debug.c                        |   11 +
 libguile/debug.h                        |    2 +
 module/Makefile.am                      |    3 +-
 module/ice-9/local-eval.scm             |  110 +
 module/ice-9/psyntax-pp.scm             |13902 ++++++++++++++++---------------
 module/ice-9/psyntax.scm                |  114 +
 test-suite/standalone/test-loose-ends.c |   14 +
 test-suite/tests/eval.test              |   66 +-
 9 files changed, 7487 insertions(+), 6776 deletions(-)
 create mode 100644 module/ice-9/local-eval.scm

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 6a09bef..5eb6669 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -19,6 +19,7 @@ loading, evaluating, and compiling Scheme code at run time.
 * Loading::                     Loading Scheme code from file.
 * Character Encoding of Source Files:: Loading non-ASCII Scheme code from file.
 * Delayed Evaluation::          Postponing evaluation until it is needed.
+* Local Evaluation::            Evaluation in a local lexical environment.
 @end menu
 
 
@@ -952,6 +953,46 @@ value.
 @end deffn
 
 
+@node Local Evaluation
+@subsection Local Evaluation
+
+@deffn syntax the-environment
+Captures and returns a lexical environment object for use with
+@code{local-eval} or @code{local-compile}.
+@end deffn
+
+@deffn {Scheme Procedure} local-eval exp env
+@deffnx {C Function} scm_local_eval (exp, env)
+Evaluate the expression @var{exp} in the lexical environment @var{env}.
+This mostly behaves as if @var{exp} had been wrapped in a lambda
+expression @code{(lambda () @var{exp})} and put in place of
+@code{(the-environment)}, with the resulting procedure called by
+@code{local-eval}.  In other words, @var{exp} is evaluated within the
+lexical environment of @code{(the-environment)}, but within the dynamic
+environment of @code{local-eval}.
+@end deffn
+
+@deffn {Scheme Procedure} local-compile exp env [to=value] [opts=()]
+Compile the expression @var{exp} in the lexical environment @var{env}.
+If @var{exp} is a procedure, the result will be a compiled procedure;
+otherwise @code{local-compile} is mostly equivalent to
+@code{local-eval}.  @var{to} and @var{opts} specify the target language
+and compilation options.  @xref{Compiling to the Virtual Machine}, for
+more information.
+@end deffn
+
+Note that the current implementation of @code{(the-environment)} has
+some limitations.  It does not capture local syntax transformers bound
+by @code{let-syntax}, @code{letrec-syntax} or non-top-level
+@code{define-syntax} forms.  It also does not capture pattern variables
+bound by @code{syntax-case}.  Any attempt to reference such captured
+bindings via @code{local-eval} or @code{local-compile} produces an
+error.  Finally, @code{(the-environment)} does not capture lexical
+variables that are shadowed by inner bindings with the same name, nor
+hidden lexical bindings produced by macro expansion, even though such
+variables might be accessible using syntax objects.
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/libguile/debug.c b/libguile/debug.c
index 88a01d6..97b5bef 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -208,6 +208,17 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 #undef FUNC_NAME
 #endif
 
+SCM
+scm_local_eval (SCM exp, SCM env)
+{
+  static SCM local_eval_var = SCM_BOOL_F;
+
+  if (scm_is_false (local_eval_var))
+    local_eval_var = scm_c_module_lookup
+      (scm_c_resolve_module ("ice-9 local-eval"), "local-eval");
+  return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
+}
+
 static void
 init_stack_limit (void)
 {
diff --git a/libguile/debug.h b/libguile/debug.h
index d862aba..8bbf88f 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -41,6 +41,8 @@ typedef union scm_t_debug_info
 
 \f
 
+SCM_API SCM scm_local_eval (SCM exp, SCM env);
+
 SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
 SCM_API SCM scm_procedure_source (SCM proc);
 SCM_API SCM scm_procedure_name (SCM proc);
diff --git a/module/Makefile.am b/module/Makefile.am
index 56fa48d..d25842d 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -243,7 +243,8 @@ ICE_9_SOURCES = \
   ice-9/weak-vector.scm \
   ice-9/list.scm \
   ice-9/serialize.scm \
-  ice-9/vlist.scm
+  ice-9/vlist.scm \
+  ice-9/local-eval.scm
 
 SRFI_SOURCES = \
   srfi/srfi-1.scm \
diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
new file mode 100644
index 0000000..749c095
--- /dev/null
+++ b/module/ice-9/local-eval.scm
@@ -0,0 +1,110 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 local-eval)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (system base compile)
+  #:export (local-eval local-compile))
+
+(define-record-type lexical-environment-type
+  (make-lexical-environment wrapper names boxes others module-name)
+  lexical-environment?
+  (wrapper     lexenv-wrapper)
+  (names       lexenv-names)
+  (boxes       lexenv-boxes)
+  (others      lexenv-others)
+  (module-name lexenv-module-name))
+
+(set-record-type-printer!
+ lexical-environment-type
+ (lambda (e port)
+   (format port "#<lexical-environment ~S ~S ~S>"
+	   (lexenv-module-name e)
+	   (map (lambda (name box) (list name (box)))
+		(lexenv-names e) (lexenv-boxes e))
+	   (lexenv-others e))))
+
+(define (local-eval x e)
+  (cond ((lexical-environment? e)
+	 (apply (eval ((lexenv-wrapper e) x)
+		      (resolve-module (lexenv-module-name e)))
+		(lexenv-boxes e)))
+	((module? e) (eval x e))
+	(else (error "local-eval: invalid lexical environment" e))))
+
+(define* (local-compile x e #:key (to 'value) (opts '()))
+  (cond ((lexical-environment? e)
+	 (apply (compile ((lexenv-wrapper e) x)
+			 #:env (resolve-module (lexenv-module-name e))
+			 #:from 'scheme #:to to #:opts opts)
+		(lexenv-boxes e)))
+	((module? e) (compile x #:env e #:from 'scheme #:to to #:opts opts))
+	(else (error "local-compile: invalid lexical environment" e))))
+
+(define-syntax-rule (box v)
+  (case-lambda
+   (() v)
+   ((x) (set! v x))))
+
+(define-syntax-rule (box-lambda* (v ...) (other ...) e)
+  (lambda (v ...)
+    (let-syntax
+	((v (identifier-syntax-from-box v))
+	 ...
+	 (other (unsupported-binding 'other))
+	 ...)
+      (if #t e))))
+
+(define-syntax-rule (capture-environment
+		     module-name (v ...) (b ...) (other ...))
+  (make-lexical-environment
+   (lambda (expression)
+     #`(box-lambda*
+	#,'(v ...)
+	#,'(other ...)
+	#,expression))
+   '(v ...)
+   (list b ...)
+   '(other ...)
+   'module-name))
+
+(define-syntax-rule (identifier-syntax-from-box b)
+  (let ((trans (identifier-syntax
+		(id          (b))
+		((set! id x) (b x)))))
+    (set-procedure-property! trans
+			     'identifier-syntax-box
+			     (syntax-object-of b))
+    trans))
+
+;; XXX The returned syntax object includes an anti-mark
+;;     Is there a good way to avoid this?
+(define-syntax syntax-object-of
+  (lambda (form)
+    (syntax-case form ()
+      ((_ x) #`(quote #,(datum->syntax #'x #'x))))))
+
+(define (unsupported-binding name)
+  (make-variable-transformer
+   (lambda (x)
+     (syntax-violation
+      name
+      "unsupported binding captured by (the-environment)"
+      x))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 4fec917..9393e2c 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -784,6 +784,55 @@
                       id))))))
          (else (syntax-violation 'id-var-name "invalid id" id)))))
 
+    ;;
+    ;; reachable-sym+labels returns an alist containing one entry
+    ;; (sym . label) for each binding that is accessible using normal
+    ;; symbols.
+    ;;
+    ;; This implementation was derived from that of id-var-name (above),
+    ;; and closely mirrors its structure.
+    ;;
+    (define reachable-sym+labels
+      (lambda (w)
+        (define scan
+          (lambda (subst marks results)
+            (if (null? subst)
+                results
+                (let ((fst (car subst)))
+                  (if (eq? fst 'shift)
+                      (scan (cdr subst) (cdr marks) results)
+                      (let ((symnames (ribcage-symnames fst)))
+                        (if (vector? symnames)
+                            (scan-vector-rib subst marks symnames fst results)
+                            (scan-list-rib subst marks symnames fst results))))))))
+        (define scan-list-rib
+          (lambda (subst marks symnames ribcage results)
+            (let f ((symnames symnames) (i 0) (results results))
+              (cond
+               ((null? symnames) (scan (cdr subst) marks results))
+               ((and (not (assq (car symnames) results))
+                     (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+                (f (cdr symnames)
+                   (fx+ i 1)
+                   (cons (cons (car symnames)
+                               (list-ref (ribcage-labels ribcage) i))
+                         results)))
+               (else (f (cdr symnames) (fx+ i 1) results))))))
+        (define scan-vector-rib
+          (lambda (subst marks symnames ribcage results)
+            (let ((n (vector-length symnames)))
+              (let f ((i 0) (results results))
+                (cond
+                 ((fx= i n) (scan (cdr subst) marks results))
+                 ((and (not (assq (vector-ref symnames i) results))
+                       (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+                  (f (fx+ i 1)
+                     (cons (cons (vector-ref symnames i)
+                                 (vector-ref (ribcage-labels ribcage) i))
+                           results)))
+                 (else (f (fx+ i 1) results)))))))
+        (scan (wrap-subst w) (wrap-marks w) '())))
+
     ;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
     ;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
 
@@ -1791,6 +1840,71 @@
                        (_ (syntax-violation 'quote "bad syntax"
                                             (source-wrap e w s mod))))))
 
+    (global-extend 'core 'the-environment
+                   (lambda (e r w s mod)
+                     (define local-eval-wrap
+                       (lambda (sym)
+                         (wrap sym top-wrap '(private ice-9 local-eval))))
+                     (define remove-anti-mark
+                       (lambda (id)
+                         (let ((w (syntax-object-wrap id)))
+                           (if (eq? the-anti-mark (car (wrap-marks w)))
+                               (make-syntax-object
+                                (syntax-object-expression id)
+                                (make-wrap (cdr (wrap-marks w))
+                                           (cdr (wrap-subst w)))
+                                (syntax-object-module id))
+                               id))))
+                     (define gen-capture-params
+                       (lambda ()
+                         (let loop ((sym+labels (reachable-sym+labels w))
+                                    (vars '()) (boxes '()) (others '()))
+                           (if (null? sym+labels)
+                               (values vars boxes others)
+                               (let* ((id   (wrap   (caar sym+labels) w mod))
+                                      (b    (lookup (cdar sym+labels) r mod))
+                                      (type (binding-type b)))
+                                   (cond
+                                    ((eq? type 'lexical)
+                                     (loop (cdr sym+labels)
+                                           (cons id vars)
+                                           (cons `(,(local-eval-wrap 'box) ,id)
+                                                 boxes)
+                                           others))
+                                    ((and (eq? type 'macro)
+                                          (procedure-property (binding-value b)
+                                                              'identifier-syntax-box))
+                                     => (lambda (box)
+                                          (loop (cdr sym+labels)
+                                                (cons id vars)
+                                                (cons (remove-anti-mark box) boxes)
+                                                others)))
+                                    ;;
+                                    ;; ENHANCE-ME: Handle more types of local macros.
+                                    ;; At the very least, it should be possible to handle
+                                    ;; local syntax-rules macros, by saving the macro body
+                                    ;; in a procedure-property of the transformer, and
+                                    ;; then wrapping the locally-evaluated expression
+                                    ;; with an equivalent set of nested let-syntax forms
+                                    ;; (replacing the current flat let-syntax generated
+                                    ;; by box-lambda*).  In practice, most syntax-case
+                                    ;; macros could be handled this way too, although
+                                    ;; the emulation would not be perfect, e.g. in cases
+                                    ;; when the transformer contains local state.
+                                    ;;
+                                    (else (loop (cdr sym+labels)
+                                                vars boxes (cons id others)))))))))
+                     (syntax-case e ()
+                       ((_)
+                        (call-with-values
+                            (lambda () (gen-capture-params))
+                          (lambda (vars boxes others)
+                            (expand `(,(local-eval-wrap 'capture-environment)
+                                      ,(cdr mod) ,vars ,boxes ,others)
+                                    r empty-wrap mod))))
+                       (_ (syntax-violation 'the-environment "bad syntax"
+                                            (source-wrap e w s mod))))))
+
     (global-extend 'core 'syntax
                    (let ()
                      (define gen-syntax
diff --git a/test-suite/standalone/test-loose-ends.c b/test-suite/standalone/test-loose-ends.c
index 2fdbe7d..02da9a2 100644
--- a/test-suite/standalone/test-loose-ends.c
+++ b/test-suite/standalone/test-loose-ends.c
@@ -43,9 +43,23 @@ test_scm_from_locale_keywordn ()
 }
 
 static void
+test_scm_local_eval ()
+{
+  SCM result = scm_local_eval
+    (scm_list_3 (scm_from_latin1_symbol ("+"),
+		 scm_from_latin1_symbol ("x"),
+		 scm_from_latin1_symbol ("y")),
+     scm_c_eval_string ("(let ((x 1) (y 2)) (the-environment))"));
+     
+  assert (scm_is_true (scm_equal_p (result,
+				    scm_from_signed_integer (3))));
+}
+
+static void
 tests (void *data, int argc, char **argv)
 {
   test_scm_from_locale_keywordn ();
+  test_scm_local_eval ();
 }
 
 int
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index a128cd7..91589f0 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -19,7 +19,8 @@
   :use-module (test-suite lib)
   :use-module ((srfi srfi-1) :select (unfold count))
   :use-module ((system vm vm) :select (make-vm call-with-vm))
-  :use-module (ice-9 documentation))
+  :use-module (ice-9 documentation)
+  :use-module (ice-9 local-eval))
 
 
 (define exception:bad-expression
@@ -422,4 +423,67 @@
           (thunk (let loop () (cons 's (loop)))))
       (call-with-vm vm thunk))))
 
+;;;
+;;; local-eval
+;;;
+
+(with-test-prefix "local evaluation"
+
+  (pass-if "local-eval"
+
+    (let* ((env1 (let ((x 1) (y 2) (z 3))
+                   (define-syntax-rule (foo x) (quote x))
+                   (the-environment)))
+           (env2 (local-eval '(let ((x 111) (a 'a))
+                                (define-syntax-rule (bar x) (quote x))
+                                (the-environment))
+                           env1)))
+      (local-eval '(set! x 11) env1)
+      (local-eval '(set! y 22) env1)
+      (local-eval '(set! z 33) env2)
+      (and (equal? (local-eval '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-eval '(list x y z a) env2)
+                   '(111 22 33 a)))))
+
+  (pass-if "local-compile"
+
+    (let* ((env1 (let ((x 1) (y 2) (z 3))
+                   (define-syntax-rule (foo x) (quote x))
+                   (the-environment)))
+           (env2 (local-compile '(let ((x 111) (a 'a))
+                                   (define-syntax-rule (bar x) (quote x))
+                                   (the-environment))
+                                env1)))
+      (local-compile '(set! x 11) env1)
+      (local-compile '(set! y 22) env1)
+      (local-compile '(set! z 33) env2)
+      (and (equal? (local-compile '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-compile '(list x y z a) env2)
+                   '(111 22 33 a)))))
+
+  (pass-if "mixed primitive-eval, local-eval and local-compile"
+
+    (let* ((env1 (primitive-eval '(let ((x 1) (y 2) (z 3))
+                                    (define-syntax-rule (foo x) (quote x))
+                                    (the-environment))))
+           (env2 (local-eval '(let ((x 111) (a 'a))
+                                (define-syntax-rule (bar x) (quote x))
+                                (the-environment))
+                             env1))
+           (env3 (local-compile '(let ((y 222) (b 'b))
+                                   (the-environment))
+                                env2)))
+      (local-eval    '(set! x 11) env1)
+      (local-compile '(set! y 22) env2)
+      (local-eval    '(set! z 33) env2)
+      (local-compile '(set! a (* y 2)) env3)
+      (and (equal? (local-compile '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-eval '(list x y z a) env2)
+                   '(111 22 33 444))
+           (equal? (local-eval '(list x y z a b) env3)
+                   '(111 222 33 444 b))))))
+
 ;;; eval.test ends here
-- 
1.7.5.4


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-03 10:52 [PATCH] Implement local-eval, local-compile, and the-environment Mark H Weaver
@ 2012-01-03 11:55 ` David Kastrup
  2012-01-03 18:45   ` Mark H Weaver
  2012-01-04  0:06 ` Mark H Weaver
  2012-01-07 17:55 ` Andy Wingo
  2 siblings, 1 reply; 16+ messages in thread
From: David Kastrup @ 2012-01-03 11:55 UTC (permalink / raw)
  To: guile-devel

Mark H Weaver <mhw@netris.org> writes:

> Hello all,
>
> I have now produced two very different implementations of
> `the-environment' and `local-eval' that support compilation.
>
> Included below is a simple patch that I believe is ready for commit to
> the stable-2.0 branch, and I very much hope it can be included in 2.0.4.
>
> However, before I tell you about this nice simple patch, I'll briefly
> mention the other more complex (and more efficient) compiler
> implementation.

How will either fare with:

(let ((env
  (let ((x 1))
    (the-environment))))
  (local-eval '(set! x 4) env))

? It sounds to me like the more complex variant might have a better
chance of working "as intended" (TM).

-- 
David Kastrup




^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-03 11:55 ` David Kastrup
@ 2012-01-03 18:45   ` Mark H Weaver
  2012-01-05 16:36     ` David Kastrup
  0 siblings, 1 reply; 16+ messages in thread
From: Mark H Weaver @ 2012-01-03 18:45 UTC (permalink / raw)
  To: David Kastrup; +Cc: guile-devel

David Kastrup <dak@gnu.org> writes:

> How will either fare with:
>
> (let ((env
>   (let ((x 1))
>     (the-environment))))
>   (local-eval '(set! x 4) env))

This example (or more complex ones based on the same idea) present no
difficulties for either patch.

  scheme@(guile-user)> (use-modules (ice-9 local-eval))
  scheme@(guile-user)> (let ((env (let ((x 1))
                                    (the-environment))))
                         (local-eval '(set! x 4) env)
                         env)
  $1 = #<lexical-environment (guile-user) ((x 4)) ()>

They work even if you replace the outer `let' with `letrec', so that
(the-environment) captures its own binding (though attempts to print
such an environment cause an infinite recursion :)

  scheme@(guile-user)> (letrec ((env (let ((x 1))
                                    (the-environment))))
                         (local-eval '(set! x 4) env)
                         env)
  $3 = #<lexical-environment (guile-user) ice-9/format.scm:42:2: In procedure format:
  ice-9/format.scm:42:2: Throw to key `vm-error' with args `(vm-run "VM: Stack overflow" ())'.
  
  Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
  scheme@(guile-user) [1]> ,q
  scheme@(guile-user)> (local-eval 'x $3)
  $4 = 4
  scheme@(guile-user)> 

     Best,
      Mark



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-03 10:52 [PATCH] Implement local-eval, local-compile, and the-environment Mark H Weaver
  2012-01-03 11:55 ` David Kastrup
@ 2012-01-04  0:06 ` Mark H Weaver
  2012-01-07 17:57   ` Andy Wingo
  2012-01-07 17:55 ` Andy Wingo
  2 siblings, 1 reply; 16+ messages in thread
From: Mark H Weaver @ 2012-01-04  0:06 UTC (permalink / raw)
  To: guile-devel

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

Here's an improved version of the patch.  Most notably, I removed the
`#:to' parameter to `local-compile', since I realized it couldn't be
implemented properly anyway.  I also updated the copyright notices to
2012 in all changed files, and made some other simplifications and
cleanups.

    Best,
     Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Implement local-eval, local-compile, and the-environment --]
[-- Type: text/x-patch, Size: 22232 bytes --]

From a8b587cd9c25d4e1a999e870190edf472561f8f2 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 3 Jan 2012 04:02:08 -0500
Subject: [PATCH] Implement `local-eval', `local-compile', and
 `the-environment'

* module/ice-9/local-eval.scm: New module (ice-9 local-eval) which
  exports `local-eval' and `local-compile'.  This module also contains
  (non-exported) syntax transformers used internally by psyntax to
  implement `the-environment'.

* module/ice-9/psyntax.scm: New core syntax form `the-environment'.
  New internal procedure `reachable-bindings' generates the list
  of lexical bindings reachable using normal symbols (as opposed to
  syntax objects which could reach a larger set of bindings).

* libguile/debug.c (scm_local_eval): New C function that calls the
  Scheme implementation of `local-eval' in (ice-9 local-eval).

* libguile/debug.h (scm_local_eval): Add prototype.

* doc/ref/api-evaluation.texi (Local Evaluation): Add documentation.

* test-suite/tests/eval.test (local evaluation): Add tests.

* test-suite/standalone/test-loose-ends.c (test_scm_local_eval):
  Add test.

* module/Makefile.am: Add ice-9/local-eval.scm.

* module/ice-9/psyntax-pp.scm: Regenerate from psyntax.scm.
---
 doc/ref/api-evaluation.texi             |   41 +-
 libguile/debug.c                        |   13 +-
 libguile/debug.h                        |    4 +-
 module/Makefile.am                      |    5 +-
 module/ice-9/local-eval.scm             |  108 +
 module/ice-9/psyntax-pp.scm             |23191 ++++++++++++++++---------------
 module/ice-9/psyntax.scm                |  107 +-
 test-suite/standalone/test-loose-ends.c |   16 +-
 test-suite/tests/eval.test              |   68 +-
 9 files changed, 12126 insertions(+), 11427 deletions(-)
 create mode 100644 module/ice-9/local-eval.scm

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 6a09bef..bd2f5c1 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2012
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -19,6 +19,7 @@ loading, evaluating, and compiling Scheme code at run time.
 * Loading::                     Loading Scheme code from file.
 * Character Encoding of Source Files:: Loading non-ASCII Scheme code from file.
 * Delayed Evaluation::          Postponing evaluation until it is needed.
+* Local Evaluation::            Evaluation in a local lexical environment.
 @end menu
 
 
@@ -952,6 +953,44 @@ value.
 @end deffn
 
 
+@node Local Evaluation
+@subsection Local Evaluation
+
+@deffn syntax the-environment
+Captures and returns a lexical environment for use with
+@code{local-eval} or @code{local-compile}.
+@end deffn
+
+@deffn {Scheme Procedure} local-eval exp env
+@deffnx {C Function} scm_local_eval (exp, env)
+Evaluate the expression @var{exp} in the lexical environment @var{env}.
+This mostly behaves as if @var{exp} had been wrapped in a lambda
+expression @code{`(lambda () ,@var{exp})} and put in place of
+@code{(the-environment)}, with the resulting procedure called by
+@code{local-eval}.  In other words, @var{exp} is evaluated within the
+lexical environment of @code{(the-environment)}, but within the dynamic
+environment of the call to @code{local-eval}.
+@end deffn
+
+@deffn {Scheme Procedure} local-compile exp env [opts=()]
+Compile the expression @var{exp} in the lexical environment @var{env}.
+If @var{exp} is a procedure, the result will be a compiled procedure;
+otherwise @code{local-compile} is mostly equivalent to
+@code{local-eval}.  @var{opts} specifies the compilation options.
+@end deffn
+
+Note that the current implementation of @code{(the-environment)} has
+some limitations.  It does not capture local syntax transformers bound
+by @code{let-syntax}, @code{letrec-syntax} or non-top-level
+@code{define-syntax} forms.  It also does not capture pattern variables
+bound by @code{syntax-case}.  Any attempt to reference such captured
+bindings via @code{local-eval} or @code{local-compile} produces an
+error.  Finally, @code{(the-environment)} does not capture lexical
+bindings that are shadowed by inner bindings with the same name, nor
+hidden lexical bindings produced by macro expansion, even though such
+bindings might be accessible using syntax objects.
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/libguile/debug.c b/libguile/debug.c
index 88a01d6..d41acc4 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,5 +1,5 @@
 /* Debugging extensions for Guile
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation
+ * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -208,6 +208,17 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 #undef FUNC_NAME
 #endif
 
+SCM
+scm_local_eval (SCM exp, SCM env)
+{
+  static SCM local_eval_var = SCM_BOOL_F;
+
+  if (scm_is_false (local_eval_var))
+    local_eval_var = scm_c_module_lookup
+      (scm_c_resolve_module ("ice-9 local-eval"), "local-eval");
+  return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
+}
+
 static void
 init_stack_limit (void)
 {
diff --git a/libguile/debug.h b/libguile/debug.h
index d862aba..4155d19 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -3,7 +3,7 @@
 #ifndef SCM_DEBUG_H
 #define SCM_DEBUG_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2012
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -41,6 +41,8 @@ typedef union scm_t_debug_info
 
 \f
 
+SCM_API SCM scm_local_eval (SCM exp, SCM env);
+
 SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
 SCM_API SCM scm_procedure_source (SCM proc);
 SCM_API SCM scm_procedure_name (SCM proc);
diff --git a/module/Makefile.am b/module/Makefile.am
index 56fa48d..9c9d8ed 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,6 +1,6 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-##  	Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+##  	Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -243,7 +243,8 @@ ICE_9_SOURCES = \
   ice-9/weak-vector.scm \
   ice-9/list.scm \
   ice-9/serialize.scm \
-  ice-9/vlist.scm
+  ice-9/vlist.scm \
+  ice-9/local-eval.scm
 
 SRFI_SOURCES = \
   srfi/srfi-1.scm \
diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
new file mode 100644
index 0000000..c028443
--- /dev/null
+++ b/module/ice-9/local-eval.scm
@@ -0,0 +1,108 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 local-eval)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (system base compile)
+  #:export (local-eval local-compile))
+
+(define-record-type lexical-environment-type
+  (make-lexical-environment wrapper names boxes others module-name)
+  lexical-environment?
+  (wrapper     lexenv-wrapper)
+  (names       lexenv-names)
+  (boxes       lexenv-boxes)
+  (others      lexenv-others)
+  (module-name lexenv-module-name))
+
+(set-record-type-printer!
+ lexical-environment-type
+ (lambda (e port)
+   (format port "#<lexical-environment ~S ~S ~S>"
+	   (lexenv-module-name e)
+	   (map (lambda (name box) (list name (box)))
+		(lexenv-names e) (lexenv-boxes e))
+	   (lexenv-others e))))
+
+(define (local-eval x e)
+  (cond ((lexical-environment? e)
+	 (apply (eval ((lexenv-wrapper e) x)
+		      (resolve-module (lexenv-module-name e)))
+		(lexenv-boxes e)))
+	((module? e) (eval x e))
+	(else (error "local-eval: invalid lexical environment" e))))
+
+(define* (local-compile x e #:key (opts '()))
+  (cond ((lexical-environment? e)
+	 (apply (compile ((lexenv-wrapper e) x)
+			 #:env (resolve-module (lexenv-module-name e))
+			 #:from 'scheme #:opts opts)
+		(lexenv-boxes e)))
+	((module? e) (compile x #:env e #:from 'scheme #:opts opts))
+	(else (error "local-compile: invalid lexical environment" e))))
+
+(define-syntax-rule (box v)
+  (case-lambda
+   (() v)
+   ((x) (set! v x))))
+
+(define-syntax-rule (box-lambda* (v ...) (other ...) e)
+  (lambda (v ...)
+    (let-syntax
+	((v (identifier-syntax-from-box v))
+	 ...
+	 (other (unsupported-binding 'other))
+	 ...)
+      (if #t e))))
+
+(define-syntax-rule (capture-environment
+		     module-name (v ...) (b ...) (other ...))
+  (make-lexical-environment
+   (lambda (expression) #`(box-lambda*
+			   #,'(v ...)
+			   #,'(other ...)
+			   #,expression))
+   '(v ...)
+   (list b ...)
+   '(other ...)
+   'module-name))
+
+(define-syntax-rule (identifier-syntax-from-box b)
+  (make-transformer-from-box
+   (syntax-object-of b)
+   (identifier-syntax (id          (b))
+		      ((set! id x) (b x)))))
+
+(define-syntax syntax-object-of
+  (lambda (form)
+    (syntax-case form ()
+      ((_ x) #`(quote #,(datum->syntax #'x #'x))))))
+
+(define (make-transformer-from-box id trans)
+  (set-procedure-property! trans 'identifier-syntax-box id)
+  trans)
+
+(define (unsupported-binding name)
+  (make-variable-transformer
+   (lambda (x)
+     (syntax-violation
+      name
+      "unsupported binding captured by (the-environment)"
+      x))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 4fec917..0f92144 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,6 +1,6 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;; 	Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -784,6 +784,55 @@
                       id))))))
          (else (syntax-violation 'id-var-name "invalid id" id)))))
 
+    ;;
+    ;; reachable-bindings returns an alist containing one entry
+    ;; (sym . label) for each binding that is accessible using normal
+    ;; symbols.
+    ;;
+    ;; This implementation was derived from that of id-var-name (above),
+    ;; and closely mirrors its structure.
+    ;;
+    (define reachable-bindings
+      (lambda (w)
+        (define scan
+          (lambda (subst marks results)
+            (if (null? subst)
+                results
+                (let ((fst (car subst)))
+                  (if (eq? fst 'shift)
+                      (scan (cdr subst) (cdr marks) results)
+                      (let ((symnames (ribcage-symnames fst)))
+                        (if (vector? symnames)
+                            (scan-vector-rib subst marks symnames fst results)
+                            (scan-list-rib subst marks symnames fst results))))))))
+        (define scan-list-rib
+          (lambda (subst marks symnames ribcage results)
+            (let f ((symnames symnames) (i 0) (results results))
+              (cond
+               ((null? symnames) (scan (cdr subst) marks results))
+               ((and (not (assq (car symnames) results))
+                     (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+                (f (cdr symnames)
+                   (fx+ i 1)
+                   (cons (cons (car symnames)
+                               (list-ref (ribcage-labels ribcage) i))
+                         results)))
+               (else (f (cdr symnames) (fx+ i 1) results))))))
+        (define scan-vector-rib
+          (lambda (subst marks symnames ribcage results)
+            (let ((n (vector-length symnames)))
+              (let f ((i 0) (results results))
+                (cond
+                 ((fx= i n) (scan (cdr subst) marks results))
+                 ((and (not (assq (vector-ref symnames i) results))
+                       (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+                  (f (fx+ i 1)
+                     (cons (cons (vector-ref symnames i)
+                                 (vector-ref (ribcage-labels ribcage) i))
+                           results)))
+                 (else (f (fx+ i 1) results)))))))
+        (scan (wrap-subst w) (wrap-marks w) '())))
+
     ;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
     ;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
 
@@ -1791,6 +1840,62 @@
                        (_ (syntax-violation 'quote "bad syntax"
                                             (source-wrap e w s mod))))))
 
+    (global-extend 'core 'the-environment
+                   (lambda (e r w s mod)
+                     (define ice-9-local-eval
+                       (lambda (sym)
+                         (wrap sym top-wrap '(private ice-9 local-eval))))
+                     (define gen-capture-params
+                       (lambda ()
+                         (let loop ((sym+labels (reachable-bindings w))
+                                    (vars '()) (boxes '()) (others '()))
+                           (if (null? sym+labels)
+                               (values vars boxes others)
+                               (let* ((id   (wrap   (caar sym+labels) w mod))
+                                      (b    (lookup (cdar sym+labels) r mod))
+                                      (type (binding-type b)))
+                                   (cond
+                                    ((eq? type 'lexical)
+                                     (loop (cdr sym+labels)
+                                           (cons id vars)
+                                           (cons `(,(ice-9-local-eval 'box) ,id)
+                                                 boxes)
+                                           others))
+                                    ((and (eq? type 'macro)
+                                          (procedure-property (binding-value b)
+                                                              'identifier-syntax-box))
+                                     => (lambda (box)
+                                          (loop (cdr sym+labels)
+                                                (cons id vars)
+                                                (cons box boxes)
+                                                others)))
+                                    ;;
+                                    ;; ENHANCE-ME: Handle more types of local macros.  At
+                                    ;; the very least, it should be possible to handle
+                                    ;; local syntax-rules macros, by saving the macro body
+                                    ;; in a procedure-property of the transformer, and
+                                    ;; then wrapping the local expression within an
+                                    ;; equivalent set of nested let-syntax and
+                                    ;; letrec-syntax forms (replacing the current flat
+                                    ;; let-syntax generated by box-lambda*).  In practice,
+                                    ;; most syntax-case macros could be handled this way
+                                    ;; too, although the emulation would not be perfect,
+                                    ;; e.g. in cases when the transformer contains local
+                                    ;; state.
+                                    ;;
+                                    (else (loop (cdr sym+labels)
+                                                vars boxes (cons id others)))))))))
+                     (syntax-case e ()
+                       ((_)
+                        (call-with-values
+                            (lambda () (gen-capture-params))
+                          (lambda (vars boxes others)
+                            (expand `(,(ice-9-local-eval 'capture-environment)
+                                      ,(cdr mod) ,vars ,boxes ,others)
+                                    r empty-wrap mod))))
+                       (_ (syntax-violation 'the-environment "bad syntax"
+                                            (source-wrap e w s mod))))))
+
     (global-extend 'core 'syntax
                    (let ()
                      (define gen-syntax
diff --git a/test-suite/standalone/test-loose-ends.c b/test-suite/standalone/test-loose-ends.c
index 2fdbe7d..52f524b 100644
--- a/test-suite/standalone/test-loose-ends.c
+++ b/test-suite/standalone/test-loose-ends.c
@@ -3,7 +3,7 @@
  * Test items of the Guile C API that aren't covered by any other tests.
  */
 
-/* Copyright (C) 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -43,9 +43,23 @@ test_scm_from_locale_keywordn ()
 }
 
 static void
+test_scm_local_eval ()
+{
+  SCM result = scm_local_eval
+    (scm_list_3 (scm_from_latin1_symbol ("+"),
+		 scm_from_latin1_symbol ("x"),
+		 scm_from_latin1_symbol ("y")),
+     scm_c_eval_string ("(let ((x 1) (y 2)) (the-environment))"));
+     
+  assert (scm_is_true (scm_equal_p (result,
+				    scm_from_signed_integer (3))));
+}
+
+static void
 tests (void *data, int argc, char **argv)
 {
   test_scm_from_locale_keywordn ();
+  test_scm_local_eval ();
 }
 
 int
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index a128cd7..8b3319a 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -1,5 +1,5 @@
 ;;;; eval.test --- tests guile's evaluator     -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,7 +19,8 @@
   :use-module (test-suite lib)
   :use-module ((srfi srfi-1) :select (unfold count))
   :use-module ((system vm vm) :select (make-vm call-with-vm))
-  :use-module (ice-9 documentation))
+  :use-module (ice-9 documentation)
+  :use-module (ice-9 local-eval))
 
 
 (define exception:bad-expression
@@ -422,4 +423,67 @@
           (thunk (let loop () (cons 's (loop)))))
       (call-with-vm vm thunk))))
 
+;;;
+;;; local-eval
+;;;
+
+(with-test-prefix "local evaluation"
+
+  (pass-if "local-eval"
+
+    (let* ((env1 (let ((x 1) (y 2) (z 3))
+                   (define-syntax-rule (foo x) (quote x))
+                   (the-environment)))
+           (env2 (local-eval '(let ((x 111) (a 'a))
+                                (define-syntax-rule (bar x) (quote x))
+                                (the-environment))
+                           env1)))
+      (local-eval '(set! x 11) env1)
+      (local-eval '(set! y 22) env1)
+      (local-eval '(set! z 33) env2)
+      (and (equal? (local-eval '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-eval '(list x y z a) env2)
+                   '(111 22 33 a)))))
+
+  (pass-if "local-compile"
+
+    (let* ((env1 (let ((x 1) (y 2) (z 3))
+                   (define-syntax-rule (foo x) (quote x))
+                   (the-environment)))
+           (env2 (local-compile '(let ((x 111) (a 'a))
+                                   (define-syntax-rule (bar x) (quote x))
+                                   (the-environment))
+                                env1)))
+      (local-compile '(set! x 11) env1)
+      (local-compile '(set! y 22) env1)
+      (local-compile '(set! z 33) env2)
+      (and (equal? (local-compile '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-compile '(list x y z a) env2)
+                   '(111 22 33 a)))))
+
+  (pass-if "mixed primitive-eval, local-eval and local-compile"
+
+    (let* ((env1 (primitive-eval '(let ((x 1) (y 2) (z 3))
+                                    (define-syntax-rule (foo x) (quote x))
+                                    (the-environment))))
+           (env2 (local-eval '(let ((x 111) (a 'a))
+                                (define-syntax-rule (bar x) (quote x))
+                                (the-environment))
+                             env1))
+           (env3 (local-compile '(let ((y 222) (b 'b))
+                                   (the-environment))
+                                env2)))
+      (local-eval    '(set! x 11) env1)
+      (local-compile '(set! y 22) env2)
+      (local-eval    '(set! z 33) env2)
+      (local-compile '(set! a (* y 2)) env3)
+      (and (equal? (local-compile '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-eval '(list x y z a) env2)
+                   '(111 22 33 444))
+           (equal? (local-eval '(list x y z a b) env3)
+                   '(111 222 33 444 b))))))
+
 ;;; eval.test ends here
-- 
1.7.5.4


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-03 18:45   ` Mark H Weaver
@ 2012-01-05 16:36     ` David Kastrup
  2012-01-05 19:14       ` Mark H Weaver
  2012-01-05 19:34       ` Mark H Weaver
  0 siblings, 2 replies; 16+ messages in thread
From: David Kastrup @ 2012-01-05 16:36 UTC (permalink / raw)
  To: guile-devel

Mark H Weaver <mhw@netris.org> writes:

> David Kastrup <dak@gnu.org> writes:
>
>> How will either fare with:
>>
>> (let ((env
>>   (let ((x 1))
>>     (the-environment))))
>>   (local-eval '(set! x 4) env))
>
> This example (or more complex ones based on the same idea) present no
> difficulties for either patch.

Ah, I see that set! has made it explicitly into the patterns.  What
about

(define foo (make-procedure-with-setter vector-ref vector-set!))

(let ((env
    (let ((x (make-vector 2 #f)))
       (the-environment))))
   (local-eval '(set! (foo x 1) 3) env))
       

-- 
David Kastrup




^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-05 16:36     ` David Kastrup
@ 2012-01-05 19:14       ` Mark H Weaver
  2012-01-05 19:34       ` Mark H Weaver
  1 sibling, 0 replies; 16+ messages in thread
From: Mark H Weaver @ 2012-01-05 19:14 UTC (permalink / raw)
  To: David Kastrup; +Cc: guile-devel

David Kastrup <dak@gnu.org> writes:
> Ah, I see that set! has made it explicitly into the patterns.  What
> about
>
> (define foo (make-procedure-with-setter vector-ref vector-set!))
>
> (let ((env
>     (let ((x (make-vector 2 #f)))
>        (the-environment))))
>    (local-eval '(set! (foo x 1) 3) env))

Both patches handle this correctly.

      Mark



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-05 16:36     ` David Kastrup
  2012-01-05 19:14       ` Mark H Weaver
@ 2012-01-05 19:34       ` Mark H Weaver
  1 sibling, 0 replies; 16+ messages in thread
From: Mark H Weaver @ 2012-01-05 19:34 UTC (permalink / raw)
  To: David Kastrup; +Cc: guile-devel

David Kastrup <dak@gnu.org> writes:
> Ah, I see that set! has made it explicitly into the patterns.  What
> about
>
> (define foo (make-procedure-with-setter vector-ref vector-set!))
>
> (let ((env
>     (let ((x (make-vector 2 #f)))
>        (the-environment))))
>    (local-eval '(set! (foo x 1) 3) env))

Although the example above works, the more interesting question is
whether this works:

  (let ((env (let ((foo (make-procedure-with-setter vector-ref vector-set!))
		   (x   (make-vector 2 #f)))
	       (the-environment))))
    (local-eval '(set! (foo x 1) 3) env))

and indeed, it does work.

     Mark



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-03 10:52 [PATCH] Implement local-eval, local-compile, and the-environment Mark H Weaver
  2012-01-03 11:55 ` David Kastrup
  2012-01-04  0:06 ` Mark H Weaver
@ 2012-01-07 17:55 ` Andy Wingo
  2012-01-07 20:20   ` Mark H Weaver
  2 siblings, 1 reply; 16+ messages in thread
From: Andy Wingo @ 2012-01-07 17:55 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

On Tue 03 Jan 2012 11:52, Mark H Weaver <mhw@netris.org> writes:

> +(define-record-type lexical-environment-type
> +  (make-lexical-environment wrapper names boxes others module-name)
> +  lexical-environment?
> +  (wrapper     lexenv-wrapper)
> +  (names       lexenv-names)
> +  (boxes       lexenv-boxes)
> +  (others      lexenv-others)
> +  (module-name lexenv-module-name))

Why a module-name and not a module?

> +(define-syntax-rule (box v)
> +  (case-lambda
> +   (() v)
> +   ((x) (set! v x))))

This is nice.

If you want to make a hack, you can get at the variable object here,
using program-free-variables.  It is fairly well guaranteed to work.
Dunno if it is needed, though.

> +(define-syntax-rule (box-lambda* (v ...) (other ...) e)
> +  (lambda (v ...)
> +    (let-syntax
> +	((v (identifier-syntax-from-box v))
> +	 ...
> +	 (other (unsupported-binding 'other))
> +	 ...)
> +      (if #t e))))

I would fix the indentation here.  What's the purpose of the (if #t e) ?

> +(define-syntax-rule (capture-environment
> +		     module-name (v ...) (b ...) (other ...))
> +  (make-lexical-environment
> +   (lambda (expression)
> +     #`(box-lambda*
> +	#,'(v ...)

Why not just (v ...) ?

> +	#,'(other ...)

Likewise.  And again, the indentation :)

> +(define-syntax-rule (identifier-syntax-from-box b)
> +  (let ((trans (identifier-syntax
> +		(id          (b))
> +		((set! id x) (b x)))))
> +    (set-procedure-property! trans
> +			     'identifier-syntax-box
> +			     (syntax-object-of b))
> +    trans))

Ew, identifier-syntax as a value :)  But OK.

> +;; XXX The returned syntax object includes an anti-mark
> +;;     Is there a good way to avoid this?
> +(define-syntax syntax-object-of
> +  (lambda (form)
> +    (syntax-case form ()
> +      ((_ x) #`(quote #,(datum->syntax #'x #'x))))))

This has a bad smell.  Anything that is outside psyntax should not have
to think about marks.  Perhaps syntax-local-value could serve your
purpose?

> +    (global-extend 'core 'the-environment

This one is really nasty, and I'd like to avoid it if possible.  Are
there some short primitives that psyntax could export that would make it
possible to implement `the-environment' in a module?

It seems to me that some primitive to return a list of all syntax
objects visible at a given point of a program, together with a primitive
to retrieve the module that corresponds to a syntax object, could be
sufficient.

WDYT?

>  static void
> +test_scm_local_eval ()

Thanks for going all the way with documentation and test cases.  This is
great.

Cheers,

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-04  0:06 ` Mark H Weaver
@ 2012-01-07 17:57   ` Andy Wingo
  0 siblings, 0 replies; 16+ messages in thread
From: Andy Wingo @ 2012-01-07 17:57 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

On Wed 04 Jan 2012 01:06, Mark H Weaver <mhw@netris.org> writes:

> Here's an improved version of the patch.  Most notably, I removed the
> `#:to' parameter to `local-compile', since I realized it couldn't be
> implemented properly anyway.  I also updated the copyright notices to
> 2012 in all changed files, and made some other simplifications and
> cleanups.

I replied to the earlier patch, sorry about that.  Most of the comments
still seem to apply though.  Thanks for the simplifications in psyntax.

Regards,

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-07 17:55 ` Andy Wingo
@ 2012-01-07 20:20   ` Mark H Weaver
  2012-01-07 21:23     ` Andy Wingo
  0 siblings, 1 reply; 16+ messages in thread
From: Mark H Weaver @ 2012-01-07 20:20 UTC (permalink / raw)
  To: Andy Wingo; +Cc: guile-devel

Hi Andy, thanks for the code review! :)

Andy Wingo <wingo@pobox.com> writes:
> On Tue 03 Jan 2012 11:52, Mark H Weaver <mhw@netris.org> writes:
>
>> +(define-record-type lexical-environment-type
>> +  (make-lexical-environment wrapper names boxes others module-name)
>> +  lexical-environment?
>> +  (wrapper     lexenv-wrapper)
>> +  (names       lexenv-names)
>> +  (boxes       lexenv-boxes)
>> +  (others      lexenv-others)
>> +  (module-name lexenv-module-name))
>
> Why a module-name and not a module?

I guess this could go either way, but the module-name is what gets
embedded into the compiled code for (the-environment), since the module
itself is not serializable.  If we want to put the module itself in the
lexical environment, then (the-environment) would need to generate a
call to `resolve-module' within its compiled code.

>> +(define-syntax-rule (box v)
>> +  (case-lambda
>> +   (() v)
>> +   ((x) (set! v x))))
>
> This is nice.
>
> If you want to make a hack, you can get at the variable object here,
> using program-free-variables.  It is fairly well guaranteed to work.
> Dunno if it is needed, though.

The problem is that primitive-eval does not represent lexical variables
as variable objects.  We could change that, but I'm reluctant to make
the evaluator any slower than it already is.

More importantly, is there any guarantee that mutable lexicals will
continue to be represented as variable objects in future native code
compilers?  Do we want to commit to supporting this uniform
representation in all future compilers?

The nice thing about this strategy is that it places no constraints
whatsoever on how lexical variables are represented.  It allows us to
use primitive-eval to evaluate a local expression within a lexical
environment created by compiled code, or vice versa.

In the more complex patch, the local expression must use the same
execution method as the code that created the lexical environment.

>> +(define-syntax-rule (box-lambda* (v ...) (other ...) e)
>> +  (lambda (v ...)
>> +    (let-syntax
>> +	((v (identifier-syntax-from-box v))
>> +	 ...
>> +	 (other (unsupported-binding 'other))
>> +	 ...)
>> +      (if #t e))))
>
> I would fix the indentation here.

Sorry, until a couple of days ago I had `indent-tabs-mode' set to `t'
(the default) in Emacs.  I finally fixed that.  The indentation actually
looks correct outside of a patch, but because it contains tabs, the "+"
and "> " prefixes mess it up.  I'll make sure to untabify my code before
committing.

> What's the purpose of the (if #t e) ?

That's to force expression context.  There's no proper way to add new
definitions to an existing local environment anyway.  (the-environment)
is treated like an expression, thus terminating definition context.
Therefore, the form passed to `local-eval' should be constrained to be
an expression.

BTW, I think I want to change (if #t e) to: #f e.  That should require a
less complicated analyzer to optimize away.

Is there a better way to force expression context?

>> +(define-syntax-rule (capture-environment
>> +		     module-name (v ...) (b ...) (other ...))
>> +  (make-lexical-environment
>> +   (lambda (expression)
>> +     #`(box-lambda*
>> +	#,'(v ...)
>
> Why not just (v ...) ?
>
>> +	#,'(other ...)
>
> Likewise.

This is the definition of the wrapper procedure, that wraps
`box-lambda*' around the local expression.  Therefore, I need the list
of source names, not the gensyms.

#,#'(v ...) may be equivalent is (v ...), but #,'(v ...) is quite
different.  '(v ...) strips the wrap from the variable names, resulting
in the source names.

>> +(define-syntax-rule (identifier-syntax-from-box b)
>> +  (let ((trans (identifier-syntax
>> +		(id          (b))
>> +		((set! id x) (b x)))))
>> +    (set-procedure-property! trans
>> +			     'identifier-syntax-box
>> +			     (syntax-object-of b))
>> +    trans))
>
> Ew, identifier-syntax as a value :)  But OK.

This code is based on `make-variable-transformer' in psyntax.scm, which
does something very similar.  Both set a procedure-property on the
transformer.  In the case of `make-variable-transformer', the property
indicates that the associated syntactic keyword can be used as the first
operand to `set!'.

In this case, we need a way to detect that a given syntactic keyword
represents a simulated variable bound by `box-lambda*'.  Furthermore, we
need to find the associated box so that we can reuse it.  This allows us
to avoid nested boxes, and thus allows us to achieve O(1) overhead for
simulated variable references, as opposed to O(n) where N is the nesting
depth.

>> +;; XXX The returned syntax object includes an anti-mark
>> +;;     Is there a good way to avoid this?
>> +(define-syntax syntax-object-of
>> +  (lambda (form)
>> +    (syntax-case form ()
>> +      ((_ x) #`(quote #,(datum->syntax #'x #'x))))))
>
> This has a bad smell.  Anything that is outside psyntax should not have
> to think about marks.  Perhaps syntax-local-value could serve your
> purpose?

The anti-mark turned out to be harmless so I removed that scary comment,
as well as the `remove-anti-mark' stuff from psyntax.  BTW, the purpose
of this is to store the identifier of the box corresponding to a
simulated variable, so that it can be captured by `the-environment'
without creating a nested box.

>> +    (global-extend 'core 'the-environment
>
> This one is really nasty, and I'd like to avoid it if possible.  Are
> there some short primitives that psyntax could export that would make it
> possible to implement `the-environment' in a module?

I don't see how it could be made much simpler.  At the very least, it
needs to generate the following things:

* The module name
* The list of ordinary variables (these need to be boxed)
* The list of simulated variables (we need to reuse the original box)
* The list of others, i.e. unsupported lexical bindings

And that's what most of that code is for.

More importantly, if I'm going to support capturing locally-bound
syntactic keywords or pattern variables, I'll need to generate more
complex `wrapper' procedures.  At that point, simple lists of variables
will no longer do the job; in general I will need to wrap the local
expression (passed to `local-eval') within multiple levels of binding
constructs.

I don't know of a good way to break this apart into lower-level
primitives.

I could, however, write the code in a more elegant (though less
efficient) way.  For example, instead of the complicated loop that
generates three lists at once, I could instead use `map' and `filter' to
produce each list separately.  I'll take a look.

Though again, this will unfortunately become quite a bit more
complicated if we wish to support capturing local syntax.  The
alternative is to simply capture the psyntax environment structures
directly, but that has its own problems: it would require embedding
references to transformer procedures within compiled code.

BTW, I should note that the question of which strategy to use for
capturing the expander environment (capturing the internal psyntax
structures vs creating wrapper procedures) is orthogonal to the question
of how to implement boxes (using procedures and identifier-syntax, or
using variable objects as is done in my more complex patch).

   Thanks,
     Mark



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-07 20:20   ` Mark H Weaver
@ 2012-01-07 21:23     ` Andy Wingo
  2012-01-08 20:39       ` Mark H Weaver
  0 siblings, 1 reply; 16+ messages in thread
From: Andy Wingo @ 2012-01-07 21:23 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Hi Mark,

On Sat 07 Jan 2012 21:20, Mark H Weaver <mhw@netris.org> writes:

> The problem is that primitive-eval does not represent lexical variables
> as variable objects.

True.

> We could change that, but I'm reluctant to make the evaluator any
> slower than it already is.

Using variable objects has the possibility to make the evaluator faster,
actually, if at the same time we make closures capture only the set of
free variables that they need, instead of the whole environment.  That
way free variable lookup would be something like (vector-ref
free-variables k) instead of cdring down the whole environment chain.

> More importantly, is there any guarantee that mutable lexicals will
> continue to be represented as variable objects in future native code
> compilers?  Do we want to commit to supporting this uniform
> representation in all future compilers?

I don't know that we should commit to it externally, but internally it's
OK.  If we did have to commit to it externally even that would be OK, as
I don't think it will change.

> The nice thing about this strategy is that it places no constraints
> whatsoever on how lexical variables are represented.  It allows us to
> use primitive-eval to evaluate a local expression within a lexical
> environment created by compiled code, or vice versa.

This is a very nice property.  I just wanted to mention that this hack
is available to you, if you want.

>> What's the purpose of the (if #t e) ?
>
> That's to force expression context.  There's no proper way to add new
> definitions to an existing local environment anyway.  (the-environment)
> is treated like an expression, thus terminating definition context.
> Therefore, the form passed to `local-eval' should be constrained to be
> an expression.
>
> BTW, I think I want to change (if #t e) to: #f e.  That should require a
> less complicated analyzer to optimize away.
>
> Is there a better way to force expression context?

I guess it's not clear to me why you would want to force expression
context.  This expression would be an error either way:

  (let ()
    (local-eval '(define x 10) (the-environment)))

and this one:

  (let ()
    (local-eval '(begin (define x 10) x) (the-environment)))

is equivalent to

  (let ()
    (local-eval '(letrec* ((x 10)) x) (the-environment)))

so there is no ambiguity.

>>> +    (global-extend 'core 'the-environment
>>
>> This one is really nasty, and I'd like to avoid it if possible.  Are
>> there some short primitives that psyntax could export that would make it
>> possible to implement `the-environment' in a module?
>
> I don't see how it could be made much simpler.  At the very least, it
> needs to generate the following things:
>
> * The module name

How about using another procedure for this.  Racket calls it
"syntax-source-module", but we could probably call it "syntax-module" as
our phasing story isn't as complicated.

  http://docs.racket-lang.org/reference/stxops.html#(def._((quote._~23~25kernel)._syntax-source-module))

> * The list of ordinary variables (these need to be boxed)
> * The list of simulated variables (we need to reuse the original box)

A special form to get all visible variables, and syntax-local-value plus
a weak hash to do the optimization?

> * The list of others, i.e. unsupported lexical bindings

In what case do you get unsupported lexical bindings?

There were a few points in your mail that I didn't comment on, because
they made sense to me.  What do you think about the psyntax comments,
though?

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-07 21:23     ` Andy Wingo
@ 2012-01-08 20:39       ` Mark H Weaver
  2012-01-14 15:28         ` Variables and the evaluator (Was: [PATCH] Implement local-eval, local-compile, and the-environment) Andy Wingo
                           ` (2 more replies)
  0 siblings, 3 replies; 16+ messages in thread
From: Mark H Weaver @ 2012-01-08 20:39 UTC (permalink / raw)
  To: Andy Wingo; +Cc: guile-devel

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

Hi Andy,

Andy Wingo <wingo@pobox.com> writes:
>> We could change that, but I'm reluctant to make the evaluator any
>> slower than it already is.
>
> Using variable objects has the possibility to make the evaluator faster,
> actually, if at the same time we make closures capture only the set of
> free variables that they need, instead of the whole environment.  That
> way free variable lookup would be something like (vector-ref
> free-variables k) instead of cdring down the whole environment chain.

True, but wouldn't this require an analysis pass similar to
`analyze-lexicals'?  Do we want to make our evaluator that complex?

>> More importantly, is there any guarantee that mutable lexicals will
>> continue to be represented as variable objects in future native code
>> compilers?  Do we want to commit to supporting this uniform
>> representation in all future compilers?
>
> I don't know that we should commit to it externally, but internally it's
> OK.  If we did have to commit to it externally even that would be OK, as
> I don't think it will change.

You may be right, but committing to a uniform representation makes me
very uncomfortable.  I can imagine several clever ways to represent
mutable free variables in a native compiler that don't involve separate
variable objects for each variable.

The desire to support a uniform representation has already lead to a
proposal to make the evaluator far more complex, in order to work more
like our current compiler.  I take that as a warning that this strategy
is too tightly coupled to a particular implementation.

>>> What's the purpose of the (if #t e) ?
>>
>> That's to force expression context.  There's no proper way to add new
>> definitions to an existing local environment anyway.  (the-environment)
>> is treated like an expression, thus terminating definition context.
>> Therefore, the form passed to `local-eval' should be constrained to be
>> an expression.
>>
>> BTW, I think I want to change (if #t e) to: #f e.  That should require a
>> less complicated analyzer to optimize away.
>>
>> Is there a better way to force expression context?
>
> I guess it's not clear to me why you would want to force expression
> context.

If we allow definitions, then your nice equivalence

  <form> == (local-eval '<form> (the-environment))

no longer holds.  Also, the user cannot use the simple mental model of
imagining that <form> had been put in place of (the-environment).

For example:

  (let ((x 1))
    (define (get-x) x)
    (begin
      (define x 2)
      (get-x)))
  => 2

is _not_ equivalent to:

  (let ((x 1))
    (define (get-x) x)
    (local-eval '(begin
                   (define x 2)
                   (get-x))
                (the-environment)))
  => 1

The only way I see to achieve your equivalence is to constrain <form> to
be an expression.

>>>> +    (global-extend 'core 'the-environment
>>>
>>> This one is really nasty, and I'd like to avoid it if possible.  Are
>>> there some short primitives that psyntax could export that would make it
>>> possible to implement `the-environment' in a module?

I dunno.  I still don't think it's possible to make this code much
simpler, although I _did_ try to make the code easier to read (though
less efficient) in the revised patch below.

I suspect the best that can be hoped for is to move some more of this
code from psyntax to an external module.  I'm not sure why that's
inherently desirable, but more importantly, that strategy carries with
it a significant price: it means exposing other far less elegant
primitives that are specific to our current implementation strategy.

I would proceed very cautiously here.  Even if we don't advertise a
primitive as stable, users are bound to make use of it, and then they'll
put pressure on us to keep supporting it.

`the-environment' and `local-eval' have simple and clean semantics, and
present an abstract interface that could be reimplemented later in many
different ways.  I'm comfortable exposing them.  I cannot say the same
about the other lower-level primitives under discussion.

>> * The list of ordinary variables (these need to be boxed)
>> * The list of simulated variables (we need to reuse the original box)
>
> A special form to get all visible variables, and syntax-local-value plus
> a weak hash to do the optimization?

We could do it that way, but that strategy would not extend nicely to a
more complete implementation, where local syntactic keywords are
captured.

>> * The list of others, i.e. unsupported lexical bindings
>
> In what case do you get unsupported lexical bindings?

Currently, this category includes pattern variables bound by
syntax-case, and locally-bound syntactic keywords, other than the
specially-marked ones bound by restore-environment (formerly called
box-lambda*).

I have attached a revised patch with the following changes:

* tabs => spaces

* Completely reworked the implementation of `the-environment' in
  psyntax, to hopefully be easier to read and understand, at the cost of
  some efficiency.

* The lexical environment now includes the module (not the module-name).

* Renamed several identifiers for improved readability, and several
  other stylistic changes.

   Many thanks,
      Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Implement local-eval, local-compile, and the-environment (v3) --]
[-- Type: text/x-patch, Size: 21985 bytes --]

From 424dbe256ef460a0da0a8e9f28e92e06426a0f50 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 3 Jan 2012 04:02:08 -0500
Subject: [PATCH] Implement `local-eval', `local-compile', and
 `the-environment'

* module/ice-9/local-eval.scm: New module (ice-9 local-eval) which
  exports `local-eval' and `local-compile'.  This module also contains
  (non-exported) syntax transformers used internally by psyntax to
  implement `the-environment'.

* module/ice-9/psyntax.scm: New core syntax form `the-environment'.
  New internal procedure `reachable-bindings' generates the list
  of lexical bindings reachable using normal symbols (as opposed to
  syntax objects which could reach a larger set of bindings).

* libguile/debug.c (scm_local_eval): New C function that calls the
  Scheme implementation of `local-eval' in (ice-9 local-eval).

* libguile/debug.h (scm_local_eval): Add prototype.

* doc/ref/api-evaluation.texi (Local Evaluation): Add documentation.

* test-suite/tests/eval.test (local evaluation): Add tests.

* test-suite/standalone/test-loose-ends.c (test_scm_local_eval):
  Add test.

* module/Makefile.am: Add ice-9/local-eval.scm.

* module/ice-9/psyntax-pp.scm: Regenerate from psyntax.scm.
---
 doc/ref/api-evaluation.texi             |   41 +-
 libguile/debug.c                        |   13 +-
 libguile/debug.h                        |    4 +-
 module/Makefile.am                      |    5 +-
 module/ice-9/local-eval.scm             |  107 +
 module/ice-9/psyntax-pp.scm             |14860 +++++++++++++++++--------------
 module/ice-9/psyntax.scm                |   94 +-
 test-suite/standalone/test-loose-ends.c |   16 +-
 test-suite/tests/eval.test              |   68 +-
 9 files changed, 8422 insertions(+), 6786 deletions(-)
 create mode 100644 module/ice-9/local-eval.scm

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 6a09bef..bd2f5c1 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2012
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -19,6 +19,7 @@ loading, evaluating, and compiling Scheme code at run time.
 * Loading::                     Loading Scheme code from file.
 * Character Encoding of Source Files:: Loading non-ASCII Scheme code from file.
 * Delayed Evaluation::          Postponing evaluation until it is needed.
+* Local Evaluation::            Evaluation in a local lexical environment.
 @end menu
 
 
@@ -952,6 +953,44 @@ value.
 @end deffn
 
 
+@node Local Evaluation
+@subsection Local Evaluation
+
+@deffn syntax the-environment
+Captures and returns a lexical environment for use with
+@code{local-eval} or @code{local-compile}.
+@end deffn
+
+@deffn {Scheme Procedure} local-eval exp env
+@deffnx {C Function} scm_local_eval (exp, env)
+Evaluate the expression @var{exp} in the lexical environment @var{env}.
+This mostly behaves as if @var{exp} had been wrapped in a lambda
+expression @code{`(lambda () ,@var{exp})} and put in place of
+@code{(the-environment)}, with the resulting procedure called by
+@code{local-eval}.  In other words, @var{exp} is evaluated within the
+lexical environment of @code{(the-environment)}, but within the dynamic
+environment of the call to @code{local-eval}.
+@end deffn
+
+@deffn {Scheme Procedure} local-compile exp env [opts=()]
+Compile the expression @var{exp} in the lexical environment @var{env}.
+If @var{exp} is a procedure, the result will be a compiled procedure;
+otherwise @code{local-compile} is mostly equivalent to
+@code{local-eval}.  @var{opts} specifies the compilation options.
+@end deffn
+
+Note that the current implementation of @code{(the-environment)} has
+some limitations.  It does not capture local syntax transformers bound
+by @code{let-syntax}, @code{letrec-syntax} or non-top-level
+@code{define-syntax} forms.  It also does not capture pattern variables
+bound by @code{syntax-case}.  Any attempt to reference such captured
+bindings via @code{local-eval} or @code{local-compile} produces an
+error.  Finally, @code{(the-environment)} does not capture lexical
+bindings that are shadowed by inner bindings with the same name, nor
+hidden lexical bindings produced by macro expansion, even though such
+bindings might be accessible using syntax objects.
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/libguile/debug.c b/libguile/debug.c
index 88a01d6..d41acc4 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,5 +1,5 @@
 /* Debugging extensions for Guile
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation
+ * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -208,6 +208,17 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 #undef FUNC_NAME
 #endif
 
+SCM
+scm_local_eval (SCM exp, SCM env)
+{
+  static SCM local_eval_var = SCM_BOOL_F;
+
+  if (scm_is_false (local_eval_var))
+    local_eval_var = scm_c_module_lookup
+      (scm_c_resolve_module ("ice-9 local-eval"), "local-eval");
+  return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
+}
+
 static void
 init_stack_limit (void)
 {
diff --git a/libguile/debug.h b/libguile/debug.h
index d862aba..4155d19 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -3,7 +3,7 @@
 #ifndef SCM_DEBUG_H
 #define SCM_DEBUG_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2012
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -41,6 +41,8 @@ typedef union scm_t_debug_info
 
 \f
 
+SCM_API SCM scm_local_eval (SCM exp, SCM env);
+
 SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
 SCM_API SCM scm_procedure_source (SCM proc);
 SCM_API SCM scm_procedure_name (SCM proc);
diff --git a/module/Makefile.am b/module/Makefile.am
index 56fa48d..9c9d8ed 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,6 +1,6 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-##  	Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+##  	Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -243,7 +243,8 @@ ICE_9_SOURCES = \
   ice-9/weak-vector.scm \
   ice-9/list.scm \
   ice-9/serialize.scm \
-  ice-9/vlist.scm
+  ice-9/vlist.scm \
+  ice-9/local-eval.scm
 
 SRFI_SOURCES = \
   srfi/srfi-1.scm \
diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
new file mode 100644
index 0000000..fd18f80
--- /dev/null
+++ b/module/ice-9/local-eval.scm
@@ -0,0 +1,107 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 local-eval)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (system base compile)
+  #:export (local-eval local-compile))
+
+(define-record-type lexical-environment-type
+  (make-lexical-environment module wrapper boxes var-names unsupported-names)
+  lexical-environment?
+  (module            lexenv-module)
+  (wrapper           lexenv-wrapper)
+  (boxes             lexenv-boxes)
+  (var-names         lexenv-var-names)
+  (unsupported-names lexenv-unsupported-names))
+
+(set-record-type-printer!
+ lexical-environment-type
+ (lambda (e port)
+   (format port "#<lexical-environment ~S ~S ~S>"
+           (module-name (lexenv-module e))
+           (reverse (map (lambda (name box) (list name (box)))
+                         (lexenv-var-names e) (lexenv-boxes e)))
+           (lexenv-unsupported-names e))))
+
+(define (local-eval x e)
+  (cond ((lexical-environment? e)
+         (apply (eval ((lexenv-wrapper e) x)
+                      (lexenv-module e))
+                (lexenv-boxes e)))
+        ((module? e) (eval x e))
+        (else (error "local-eval: invalid lexical environment" e))))
+
+(define* (local-compile x e #:key (opts '()))
+  (cond ((lexical-environment? e)
+         (apply (compile ((lexenv-wrapper e) x)
+                         #:env (lexenv-module e)
+                         #:from 'scheme #:opts opts)
+                (lexenv-boxes e)))
+        ((module? e) (compile x #:env e #:from 'scheme #:opts opts))
+        (else (error "local-compile: invalid lexical environment" e))))
+
+(define-syntax-rule (make-box v)
+  (case-lambda
+   (() v)
+   ((x) (set! v x))))
+
+(define-syntax-rule (restore-environment (v ...) (unsupported ...) e)
+  (lambda (v ...)
+    (let-syntax
+        ((v (identifier-syntax-from-box v))
+         ...
+         (unsupported (unsupported-binding 'unsupported))
+         ...)
+      #f      ; force expression context
+      e)))
+
+(define-syntax-rule (capture-environment
+                     module (box ...) (v ...) (unsupported ...))
+  (make-lexical-environment
+   module
+   (lambda (expression) #`(restore-environment
+                           #,'(v ...) #,'(unsupported ...) #,expression))
+   (list box ...)
+   '(v ...)
+   '(unsupported ...)))
+
+(define-syntax-rule (identifier-syntax-from-box box)
+  (make-transformer-from-box
+   (syntax-object-of box)
+   (identifier-syntax (id          (box))
+                      ((set! id x) (box x)))))
+
+(define-syntax syntax-object-of
+  (lambda (form)
+    (syntax-case form ()
+      ((_ x) #`(quote #,(datum->syntax #'x #'x))))))
+
+(define (make-transformer-from-box id trans)
+  (set-procedure-property! trans 'identifier-syntax-box id)
+  trans)
+
+(define (unsupported-binding name)
+  (make-variable-transformer
+   (lambda (x)
+     (syntax-violation
+      name
+      "unsupported binding captured by (the-environment)"
+      x))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 4fec917..62eb607 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,6 +1,6 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;; 	Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -784,6 +784,55 @@
                       id))))))
          (else (syntax-violation 'id-var-name "invalid id" id)))))
 
+    ;;
+    ;; reachable-bindings returns an alist containing one entry
+    ;; (sym . label) for each binding that is accessible using normal
+    ;; symbols.
+    ;;
+    ;; This implementation was derived from that of id-var-name (above),
+    ;; and closely mirrors its structure.
+    ;;
+    (define reachable-bindings
+      (lambda (w)
+        (define scan
+          (lambda (subst marks results)
+            (if (null? subst)
+                results
+                (let ((fst (car subst)))
+                  (if (eq? fst 'shift)
+                      (scan (cdr subst) (cdr marks) results)
+                      (let ((symnames (ribcage-symnames fst)))
+                        (if (vector? symnames)
+                            (scan-vector-rib subst marks symnames fst results)
+                            (scan-list-rib subst marks symnames fst results))))))))
+        (define scan-list-rib
+          (lambda (subst marks symnames ribcage results)
+            (let f ((symnames symnames) (i 0) (results results))
+              (cond
+               ((null? symnames) (scan (cdr subst) marks results))
+               ((and (not (assq (car symnames) results))
+                     (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+                (f (cdr symnames)
+                   (fx+ i 1)
+                   (cons (cons (car symnames)
+                               (list-ref (ribcage-labels ribcage) i))
+                         results)))
+               (else (f (cdr symnames) (fx+ i 1) results))))))
+        (define scan-vector-rib
+          (lambda (subst marks symnames ribcage results)
+            (let ((n (vector-length symnames)))
+              (let f ((i 0) (results results))
+                (cond
+                 ((fx= i n) (scan (cdr subst) marks results))
+                 ((and (not (assq (vector-ref symnames i) results))
+                       (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+                  (f (fx+ i 1)
+                     (cons (cons (vector-ref symnames i)
+                                 (vector-ref (ribcage-labels ribcage) i))
+                           results)))
+                 (else (f (fx+ i 1) results)))))))
+        (scan (wrap-subst w) (wrap-marks w) '())))
+
     ;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
     ;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
 
@@ -1791,6 +1840,49 @@
                        (_ (syntax-violation 'quote "bad syntax"
                                             (source-wrap e w s mod))))))
 
+    (global-extend 'core 'the-environment
+                   (lambda (e r w s mod)
+                     (define ice-9/local-eval
+                       (lambda (sym)
+                         (wrap sym top-wrap '(private ice-9 local-eval))))
+                     (with-syntax
+                         ((make-box (ice-9/local-eval 'make-box))
+                          (module-name (cdr mod)))
+                       (let* ((sym+labels  (reachable-bindings w))
+                              (ids         (map (lambda (sym+label)
+                                                  (wrap (car sym+label) w mod))
+                                                sym+labels))
+                              (bindings    (map (lambda (sym+label)
+                                                  (lookup (cdr sym+label) r mod))
+                                                sym+labels))
+                              (maybe-boxes (map (lambda (id b)
+                                                  (case (binding-type b)
+                                                    ((lexical) #`(make-box #,id))
+                                                    ((macro) (or (procedure-property
+                                                                  (binding-value b)
+                                                                  'identifier-syntax-box)
+                                                                 ;; TODO: support macros
+                                                                 #f))
+                                                    (else #f)))
+                                                ids bindings)))
+                         (with-syntax
+                             ((capture-environment (ice-9/local-eval 'capture-environment))
+                              (module  #'(resolve-module 'module-name))
+                              (boxes   (filter identity maybe-boxes))
+                              (var-ids (filter identity (map (lambda (maybe-box id)
+                                                               (and maybe-box id))
+                                                             maybe-boxes ids)))
+                              (unsupported-ids (filter identity
+                                                       (map (lambda (maybe-box id)
+                                                              (and (not maybe-box) id))
+                                                            maybe-boxes ids))))
+                           (syntax-case e ()
+                             ((_) (expand #`(capture-environment
+                                             module boxes var-ids unsupported-ids)
+                                          r empty-wrap mod))
+                             (_ (syntax-violation 'the-environment "bad syntax"
+                                                  (source-wrap e w s mod)))))))))
+
     (global-extend 'core 'syntax
                    (let ()
                      (define gen-syntax
diff --git a/test-suite/standalone/test-loose-ends.c b/test-suite/standalone/test-loose-ends.c
index 2fdbe7d..f815ae2 100644
--- a/test-suite/standalone/test-loose-ends.c
+++ b/test-suite/standalone/test-loose-ends.c
@@ -3,7 +3,7 @@
  * Test items of the Guile C API that aren't covered by any other tests.
  */
 
-/* Copyright (C) 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -43,9 +43,23 @@ test_scm_from_locale_keywordn ()
 }
 
 static void
+test_scm_local_eval ()
+{
+  SCM result = scm_local_eval
+    (scm_list_3 (scm_from_latin1_symbol ("+"),
+                 scm_from_latin1_symbol ("x"),
+                 scm_from_latin1_symbol ("y")),
+     scm_c_eval_string ("(let ((x 1) (y 2)) (the-environment))"));
+     
+  assert (scm_is_true (scm_equal_p (result,
+                                    scm_from_signed_integer (3))));
+}
+
+static void
 tests (void *data, int argc, char **argv)
 {
   test_scm_from_locale_keywordn ();
+  test_scm_local_eval ();
 }
 
 int
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index a128cd7..8b3319a 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -1,5 +1,5 @@
 ;;;; eval.test --- tests guile's evaluator     -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,7 +19,8 @@
   :use-module (test-suite lib)
   :use-module ((srfi srfi-1) :select (unfold count))
   :use-module ((system vm vm) :select (make-vm call-with-vm))
-  :use-module (ice-9 documentation))
+  :use-module (ice-9 documentation)
+  :use-module (ice-9 local-eval))
 
 
 (define exception:bad-expression
@@ -422,4 +423,67 @@
           (thunk (let loop () (cons 's (loop)))))
       (call-with-vm vm thunk))))
 
+;;;
+;;; local-eval
+;;;
+
+(with-test-prefix "local evaluation"
+
+  (pass-if "local-eval"
+
+    (let* ((env1 (let ((x 1) (y 2) (z 3))
+                   (define-syntax-rule (foo x) (quote x))
+                   (the-environment)))
+           (env2 (local-eval '(let ((x 111) (a 'a))
+                                (define-syntax-rule (bar x) (quote x))
+                                (the-environment))
+                           env1)))
+      (local-eval '(set! x 11) env1)
+      (local-eval '(set! y 22) env1)
+      (local-eval '(set! z 33) env2)
+      (and (equal? (local-eval '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-eval '(list x y z a) env2)
+                   '(111 22 33 a)))))
+
+  (pass-if "local-compile"
+
+    (let* ((env1 (let ((x 1) (y 2) (z 3))
+                   (define-syntax-rule (foo x) (quote x))
+                   (the-environment)))
+           (env2 (local-compile '(let ((x 111) (a 'a))
+                                   (define-syntax-rule (bar x) (quote x))
+                                   (the-environment))
+                                env1)))
+      (local-compile '(set! x 11) env1)
+      (local-compile '(set! y 22) env1)
+      (local-compile '(set! z 33) env2)
+      (and (equal? (local-compile '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-compile '(list x y z a) env2)
+                   '(111 22 33 a)))))
+
+  (pass-if "mixed primitive-eval, local-eval and local-compile"
+
+    (let* ((env1 (primitive-eval '(let ((x 1) (y 2) (z 3))
+                                    (define-syntax-rule (foo x) (quote x))
+                                    (the-environment))))
+           (env2 (local-eval '(let ((x 111) (a 'a))
+                                (define-syntax-rule (bar x) (quote x))
+                                (the-environment))
+                             env1))
+           (env3 (local-compile '(let ((y 222) (b 'b))
+                                   (the-environment))
+                                env2)))
+      (local-eval    '(set! x 11) env1)
+      (local-compile '(set! y 22) env2)
+      (local-eval    '(set! z 33) env2)
+      (local-compile '(set! a (* y 2)) env3)
+      (and (equal? (local-compile '(list x y z) env1)
+                   '(11 22 33))
+           (equal? (local-eval '(list x y z a) env2)
+                   '(111 22 33 444))
+           (equal? (local-eval '(list x y z a b) env3)
+                   '(111 222 33 444 b))))))
+
 ;;; eval.test ends here
-- 
1.7.5.4


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* Variables and the evaluator (Was: [PATCH] Implement local-eval, local-compile, and the-environment)
  2012-01-08 20:39       ` Mark H Weaver
@ 2012-01-14 15:28         ` Andy Wingo
  2012-01-14 15:37           ` Variables and the evaluator Andy Wingo
  2012-01-14 15:58         ` [PATCH] Implement local-eval, local-compile, and the-environment Andy Wingo
  2012-01-14 16:34         ` Andy Wingo
  2 siblings, 1 reply; 16+ messages in thread
From: Andy Wingo @ 2012-01-14 15:28 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Hi Mark,

On Sun 08 Jan 2012 21:39, Mark H Weaver <mhw@netris.org> writes:

> Andy Wingo <wingo@pobox.com> writes:
>>> We could change that, but I'm reluctant to make the evaluator any
>>> slower than it already is.
>>
>> Using variable objects has the possibility to make the evaluator faster,
>> actually, if at the same time we make closures capture only the set of
>> free variables that they need, instead of the whole environment.  That
>> way free variable lookup would be something like (vector-ref
>> free-variables k) instead of cdring down the whole environment chain.
>
> True, but wouldn't this require an analysis pass similar to
> `analyze-lexicals'?  Do we want to make our evaluator that complex?

I think that yes, yes we do.  It's sooooo slow now.  Running a
pre-analysis on the form is not that much more complex than the current
"memoization" pass.  Chez Scheme, in their evaluator, actually runs the
equivalent of peval on its input.  I don't think that's appropriate for
us, for bootstraping purposes, but still, something has to be done to
make free variable lookup faster.

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Variables and the evaluator
  2012-01-14 15:28         ` Variables and the evaluator (Was: [PATCH] Implement local-eval, local-compile, and the-environment) Andy Wingo
@ 2012-01-14 15:37           ` Andy Wingo
  0 siblings, 0 replies; 16+ messages in thread
From: Andy Wingo @ 2012-01-14 15:37 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Hi,

Sorry, forgot to respond to another bit on this subtopic:

On Sat 14 Jan 2012 16:28, Andy Wingo <wingo@pobox.com> writes:

> On Sun 08 Jan 2012 21:39, Mark H Weaver <mhw@netris.org> writes:
>
> >> More importantly, is there any guarantee that mutable lexicals will
> >> continue to be represented as variable objects in future native code
> >> compilers?  Do we want to commit to supporting this uniform
> >> representation in all future compilers?
> >
> > I don't know that we should commit to it externally, but internally it's
> > OK.  If we did have to commit to it externally even that would be OK, as
> > I don't think it will change.
>
> You may be right, but committing to a uniform representation makes me
> very uncomfortable.  I can imagine several clever ways to represent
> mutable free variables in a native compiler that don't involve separate
> variable objects for each variable.

In general, they all involve a storage location that is a word wide.
Variables are tagged storage locations, nothing more.  They are a good
choice for mutable values.  They are like Chez Scheme's or Racket's
boxes.

I have no qualms about variables here.

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-08 20:39       ` Mark H Weaver
  2012-01-14 15:28         ` Variables and the evaluator (Was: [PATCH] Implement local-eval, local-compile, and the-environment) Andy Wingo
@ 2012-01-14 15:58         ` Andy Wingo
  2012-01-14 16:34         ` Andy Wingo
  2 siblings, 0 replies; 16+ messages in thread
From: Andy Wingo @ 2012-01-14 15:58 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Hi Mark,

On Sun 08 Jan 2012 21:39, Mark H Weaver <mhw@netris.org> writes:

> Andy Wingo <wingo@pobox.com> writes:
>> I guess it's not clear to me why you would want to force expression
>> context.
>
> If we allow definitions, then your nice equivalence
>
>   <form> == (local-eval '<form> (the-environment))
>
> no longer holds.  Also, the user cannot use the simple mental model of
> imagining that <form> had been put in place of (the-environment).
>
> For example:
>
>   (let ((x 1))
>     (define (get-x) x)
>     (begin
>       (define x 2)
>       (get-x)))
>   => 2
>
> is _not_ equivalent to:
>
>   (let ((x 1))
>     (define (get-x) x)
>     (local-eval '(begin
>                    (define x 2)
>                    (get-x))
>                 (the-environment)))
>   => 1
>
> The only way I see to achieve your equivalence is to constrain <form> to
> be an expression.

Ahh, yes indeed.  Thanks for the example.

Another (less clear) way to say this would be to note that it's not
possibly to incrementally build up a set of recursive bindings.

Or, another try: local-eval cannot be allowed to affect the resolution
of variables already in the environment.  Therefore it does not capture
an open set of mutually recursive bindings.

I'm not doing very well at describing it, but your example was very
good.

What about the-environment outside of a lexical contour, though?  Does
that permit definitions?  Should it?

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [PATCH] Implement local-eval, local-compile, and the-environment
  2012-01-08 20:39       ` Mark H Weaver
  2012-01-14 15:28         ` Variables and the evaluator (Was: [PATCH] Implement local-eval, local-compile, and the-environment) Andy Wingo
  2012-01-14 15:58         ` [PATCH] Implement local-eval, local-compile, and the-environment Andy Wingo
@ 2012-01-14 16:34         ` Andy Wingo
  2 siblings, 0 replies; 16+ messages in thread
From: Andy Wingo @ 2012-01-14 16:34 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Hi Mark,

On Sun 08 Jan 2012 21:39, Mark H Weaver <mhw@netris.org> writes:

>>>> Are there some short primitives that psyntax could export that
>>>> would make it possible to implement `the-environment' in a module?
>
>>> * The list of ordinary variables (these need to be boxed)
>>> * The list of simulated variables (we need to reuse the original box)
>>
>> A special form to get all visible variables, and syntax-local-value plus
>> a weak hash to do the optimization?
>
> We could do it that way, but that strategy would not extend nicely to a
> more complete implementation, where local syntactic keywords are
> captured.

Why not?  Syntax-local-value can provide the macro transformer.

It still seems to me that this is an attractive option, especially if we
are to introduce syntax-local-value anyway.

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 16+ messages in thread

end of thread, other threads:[~2012-01-14 16:34 UTC | newest]

Thread overview: 16+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-01-03 10:52 [PATCH] Implement local-eval, local-compile, and the-environment Mark H Weaver
2012-01-03 11:55 ` David Kastrup
2012-01-03 18:45   ` Mark H Weaver
2012-01-05 16:36     ` David Kastrup
2012-01-05 19:14       ` Mark H Weaver
2012-01-05 19:34       ` Mark H Weaver
2012-01-04  0:06 ` Mark H Weaver
2012-01-07 17:57   ` Andy Wingo
2012-01-07 17:55 ` Andy Wingo
2012-01-07 20:20   ` Mark H Weaver
2012-01-07 21:23     ` Andy Wingo
2012-01-08 20:39       ` Mark H Weaver
2012-01-14 15:28         ` Variables and the evaluator (Was: [PATCH] Implement local-eval, local-compile, and the-environment) Andy Wingo
2012-01-14 15:37           ` Variables and the evaluator Andy Wingo
2012-01-14 15:58         ` [PATCH] Implement local-eval, local-compile, and the-environment Andy Wingo
2012-01-14 16:34         ` Andy Wingo

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).