Re: [PATCH] Implement local-eval, local-compile, and the-environment

[Mark H Weaver]

Hi Andy,

Andy Wingo <address@hidden> 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


>From 424dbe256ef460a0da0a8e9f28e92e06426a0f50 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2009, 2010, 2011
address@hidden 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
 
 
address@hidden Local Evaluation
address@hidden Local Evaluation
+
address@hidden syntax the-environment
+Captures and returns a lexical environment for use with
address@hidden or @code{local-compile}.
address@hidden deffn
+
address@hidden {Scheme Procedure} local-eval exp env
address@hidden {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
address@hidden(the-environment)}, with the resulting procedure called by
address@hidden  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}.
address@hidden deffn
+
address@hidden {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
address@hidden  @var{opts} specifies the compilation options.
address@hidden 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
address@hidden 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
 
 
 
+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