[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] local-eval, local-compile, and the-environment (v3)
|
From: |
Mark H Weaver |
|
Subject: |
[PATCH] local-eval, local-compile, and the-environment (v3) |
|
Date: |
Sun, 15 Jan 2012 01:27:54 -0500 |
Hello all,
Here's the third version of my simple `local-eval' patch.
Notable changes from last time:
* Pattern variables are now captured properly.
* `the-environment' now works as advertised within macro definitions.
* Added doc strings for `local-eval' and `local-compile'.
I am open to reimplementing this in a different way for 2.0.5, along the
lines suggested by Andy. I'd like to capture all bindings, not just the
ones reachable by symbols. I'd like to support _all_ lexical bindings,
including local syntax transformers. I'm also warming to the idea of
standardizing on variable objects as a way to represent mutable
lexicals. However, there's no time to do this for 2.0.4. That job
depends on other big jobs, notably a major overhaul of the evaluator.
Nonetheless, I think it is very important to include this simple
implementation in 2.0.4. This is a BUG FIX, the bug being that
`local-eval' was removed from underneath Lilypond's feet. A partial
implementation (that almost certainly does everything they need) is
_far_ better than none at all. Lilypond can only depend on `local-eval'
if installations of Guile without it are quite rare. If we can get this
in 2.0.4, there's hope that we can make Guile 2.0.[0-3] rare.
Please consider it. This implementation is quite robust.
Thanks,
Mark
>From 215758081534a641df9bc9d8452f4fc35769e8cc 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 | 38 +
libguile/debug.c | 13 +-
libguile/debug.h | 4 +-
module/Makefile.am | 5 +-
module/ice-9/local-eval.scm | 151 +
module/ice-9/psyntax-pp.scm |15387 +++++++++++++++++--------------
module/ice-9/psyntax.scm | 124 +
test-suite/standalone/test-loose-ends.c | 16 +-
test-suite/tests/eval.test | 87 +-
9 files changed, 8846 insertions(+), 6979 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 2e48dcb..72dd4df 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
@@ -954,6 +955,43 @@ 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. Any attempt to reference such captured
+syntactic keywords via @code{local-eval} or @code{local-compile}
+produces an error. Also, @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..7df94e1
--- /dev/null
+++ b/module/ice-9/local-eval.scm
@@ -0,0 +1,151 @@
+;;; -*- 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 pattern-bindings
+ var-names pattern-var-names unsupported-names)
+ lexical-environment?
+ (module lexenv-module)
+ (wrapper lexenv-wrapper)
+ (boxes lexenv-boxes)
+ (pattern-bindings lexenv-pattern-bindings)
+ (var-names lexenv-var-names)
+ (pattern-var-names lexenv-pattern-var-names)
+ (unsupported-names lexenv-unsupported-names))
+
+(set-record-type-printer!
+ lexical-environment-type
+ (lambda (e port)
+ (format port "#<lexical-environment ~S ~S ~S ~S>"
+ (module-name (lexenv-module e))
+ (reverse (map (lambda (name box) (list name (box)))
+ (lexenv-var-names e) (lexenv-boxes e)))
+ (reverse (lexenv-pattern-var-names e))
+ (reverse (lexenv-unsupported-names e)))))
+
+(define (local-eval x e)
+ "Evaluate the expression @var{x} within the lexical environment @var{e}."
+ (cond ((lexical-environment? e)
+ (apply (eval ((lexenv-wrapper e) x)
+ (lexenv-module e))
+ (append (lexenv-boxes e)
+ (lexenv-pattern-bindings e))))
+ ((module? e)
+ ;; Here we evaluate the expression within `lambda', and then
+ ;; call the resulting procedure outside of the dynamic extent
+ ;; of `eval'. We do this because `eval' sets (current-module)
+ ;; within its dynamic extent, and we don't want that. Also,
+ ;; doing it this way makes this a proper tail call.
+ ((eval #`(lambda () #,x) e)))
+ (else (error "local-eval: invalid lexical environment" e))))
+
+(define* (local-compile x e #:key (opts '()))
+ "Compile and evaluate the expression @var{x} within the lexical environment
@var{e}."
+ (cond ((lexical-environment? e)
+ (apply (compile ((lexenv-wrapper e) x)
+ #:env (lexenv-module e)
+ #:from 'scheme #:opts opts)
+ (append (lexenv-boxes e)
+ (lexenv-pattern-bindings e))))
+ ((module? e)
+ ;; Here we compile the expression within `lambda', and then
+ ;; call the resulting procedure outside of the dynamic extent
+ ;; of `compile'. We do this because `compile' sets
+ ;; (current-module) during evaluation, and we don't want that.
+ ((compile #`(lambda () #,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 box-lambda*
+ (lambda (x)
+ (syntax-case x ()
+ ((_ (v ...) (pvar ...) (pvar-lvl ...) (unsupported ...) e)
+ (with-syntax
+ (((nested-pvar ...)
+ (map within-nested-ellipses #'(pvar ...) #'(pvar-lvl ...))))
+ #'(lambda (v ... pvar ...)
+ (let-syntax
+ ((v (identifier-syntax-from-box v))
+ ...
+ (unsupported (unsupported-binding 'unsupported))
+ ...)
+ (with-syntax
+ ((nested-pvar pvar) ...)
+ #f ; force expression context
+ e))))))))
+
+(define-syntax capture-environment
+ (lambda (x)
+ (syntax-case x ()
+ ((_ module (box ...) (v ...) (pvar ...) (pvar-lvl ...) (unsupported ...))
+ (with-syntax
+ (((nested-pvar ...)
+ (map within-nested-ellipses #'(pvar ...) #'(pvar-lvl ...))))
+ #'(make-lexical-environment
+ module
+ (lambda (expression) #`(box-lambda*
+ #,'(v ...)
+ #,'(pvar ...)
+ #,'(pvar-lvl ...)
+ #,'(unsupported ...)
+ #,expression))
+ (list box ...)
+ (list #'nested-pvar ...)
+ '(v ...)
+ '(pvar ...)
+ '(unsupported ...)))))))
+
+(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 (within-nested-ellipses s lvl)
+ (let loop ((s s) (n (syntax->datum lvl)))
+ (if (zero? n) s (loop #`(#,s (... ...))
+ (- n 1)))))
+
+(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 1bf3c32..66e4583 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -786,6 +786,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.
@@ -1803,6 +1852,81 @@
(_ (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))))
+ (call-with-values
+ (lambda ()
+ (syntax-case e ()
+ ((x) (let ((id (wrap #'x w mod)))
+ (values (syntax-object-wrap id)
+ (syntax-object-module id))))
+ (_ (syntax-violation 'the-environment "bad syntax"
+ (source-wrap e w s mod)))))
+ (lambda (w mod)
+ (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))
+ (categories (map (lambda (id b)
+ (case (binding-type b)
+ ((lexical) 'lexical)
+ ((syntax) 'pattern-var)
+ ((macro) (if
(procedure-property
+
(binding-value b)
+
'identifier-syntax-box)
+
'already-boxed
+ ;; TODO:
support macros
+ #f))
+ (else #f)))
+ ids bindings))
+ (maybe-boxes (map (lambda (id b c)
+ (case c
+ ((lexical) #`(make-box
#,id))
+ ((already-boxed)
(procedure-property
+
(binding-value b)
+
'identifier-syntax-box))
+ (else #f)))
+ ids bindings categories))
+ (maybe-pattern-bindings (map (lambda (b c)
+ (case c
+
((pattern-var) (binding-value b))
+ (else #f)))
+ bindings
categories)))
+ (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)))
+ (pattern-var-ids (filter identity
+ (map (lambda
(maybe-pattern-binding id)
+ (and
maybe-pattern-binding id))
+
maybe-pattern-bindings ids)))
+ (pattern-var-lvls (filter identity
+ (map (lambda
(maybe-pattern-binding)
+ (and
maybe-pattern-binding
+ (cdr
maybe-pattern-binding)))
+
maybe-pattern-bindings)))
+ (unsupported-ids (filter identity
+ (map (lambda
(category id)
+ (and (not
category) id))
+ categories
ids))))
+ (expand #`(capture-environment
+ module boxes var-ids
+ pattern-var-ids pattern-var-lvls
+ unsupported-ids)
+ r empty-wrap 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..6848c5e 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,86 @@
(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 "the-environment within a macro"
+
+ (let ()
+ (define-syntax-rule (test)
+ (let ((x 1) (y 2))
+ (the-environment)))
+ (let ((env (let ((x 111) (y 222))
+ (test))))
+ (equal? (local-eval '(list x y) env)
+ '(1 2)))))
+
+ (pass-if "capture pattern variables"
+
+ (let ((env (syntax-case #'(((a 1) (b 2) (c 3))
+ ((d 4) (e 5) (f 6))) ()
+ ((((k v) ...) ...) (the-environment)))))
+ (equal? (syntax->datum (local-eval '#'((k ... v ...) ...) env))
+ '((a b c 1 2 3) (d e f 4 5 6)))))
+
+ (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
- [PATCH] local-eval, local-compile, and the-environment (v3),
Mark H Weaver <=
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), David Kastrup, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), Mark H Weaver, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), David Kastrup, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), Mark H Weaver, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), David Kastrup, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), Mark H Weaver, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), David Kastrup, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), Mark H Weaver, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), David Kastrup, 2012/01/15
- Re: [PATCH] local-eval, local-compile, and the-environment (v3), David Kastrup, 2012/01/15