* syntax-locally-bound-identifiers, local-eval
@ 2012-01-20 12:33 Andy Wingo
2012-01-20 12:42 ` Andy Wingo
2012-01-22 0:28 ` Ludovic Courtès
0 siblings, 2 replies; 8+ messages in thread
From: Andy Wingo @ 2012-01-20 12:33 UTC (permalink / raw)
To: guile-devel
Hello,
Here are a couple of patches. The first implements a new helper,
syntax-locally-bound-identifiers, documented thusly:
-- Scheme Procedure: syntax-locally-bound-identifiers id
Return a list of identifiers that were visible lexically when the
identifier ID was created, in order from outermost to innermost.
This procedure is intended to be used in specialized procedural
macros, to provide a macro with the set of bound identifiers that
the macro can reference.
As a technical implementation detail, the identifiers returned by
`syntax-locally-bound-identifiers' will be anti-marked, like the
syntax object that is given as input to a macro. This is to
signal to the macro expander that these bindings were present in
the original source, and do not need to be hygienically renamed,
as would be the case with other introduced identifiers. See the
discussion of hygiene in section 12.1 of the R6RS, for more
information on marks.
(define-syntax lexicals
(lambda (x)
(syntax-case x ()
((lexicals) #'(lexicals lexicals))
((lexicals scope)
(with-syntax (((id ...)
(filter (lambda (x)
(eq? (syntax-local-binding x) 'lexical))
(syntax-locally-bound-identifiers #'scope))))
#'(list (cons 'id id) ...))))))
(let* ((x 10) (x 20)) (lexicals))
=> ((x . 10) (x . 20))
The second implements local-eval, in a separate module.
There are a couple of notable changes in this version: firstly, it
correctly preserves the scope resolution order of scopes between normal
lexicals, macros, and pattern variables. It includes all of the
original marks of all identifiers. It also wraps pattern variables
now, and doesn't re-box normal lexicals.
Thoughts? I will commit them tomorrow if there are no objections to the
semantics.
Thanks very much to Mark for his great work on the patches that inspired
these ones, even though he might wish to disavow this particular
implementation strategy :-)
Regards,
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-20 12:33 syntax-locally-bound-identifiers, local-eval Andy Wingo
@ 2012-01-20 12:42 ` Andy Wingo
2012-01-20 19:04 ` Mark H Weaver
2012-01-20 20:00 ` Mark H Weaver
2012-01-22 0:28 ` Ludovic Courtès
1 sibling, 2 replies; 8+ messages in thread
From: Andy Wingo @ 2012-01-20 12:42 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 119 bytes --]
On Fri 20 Jan 2012 13:33, Andy Wingo <wingo@pobox.com> writes:
> Here are a couple of patches.
Aaaand, the patches:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-add-syntax-locally-bound-identifiers.patch --]
[-- Type: text/x-diff, Size: 6441 bytes --]
From f549f273139bda9591194766157bb771a67d9563 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 15 Jan 2012 18:39:44 +0100
Subject: [PATCH 1/2] add syntax-locally-bound-identifiers
* module/ice-9/boot-9.scm (syntax-locally-bound-identifiers): Declare
variable.
* module/ice-9/psyntax.scm: Add locally-bound-identifiers helper, and
define syntax-locally-bound-identifiers.
* doc/ref/api-macros.texi: Document the new procedure.
---
doc/ref/api-macros.texi | 37 ++++++++++++++++++++++++++++++-
module/ice-9/boot-9.scm | 1 +
module/ice-9/psyntax.scm | 55 ++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 92 insertions(+), 1 deletions(-)
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 4702d2f..02b5d5c 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -744,7 +744,7 @@ information with macros:
(define-syntax-rule (with-aux aux value)
(let ((trans value))
(set! (aux-property trans) aux)
- trans)))
+ trans))
(define-syntax retrieve-aux
(lambda (x)
(syntax-case x ()
@@ -768,6 +768,41 @@ information with macros:
a syntax transformer; to call it otherwise will signal an error.
@end deffn
+@deffn {Scheme Procedure} syntax-locally-bound-identifiers id
+Return a list of identifiers that were visible lexically when the
+identifier @var{id} was created, in order from outermost to innermost.
+
+This procedure is intended to be used in specialized procedural macros,
+to provide a macro with the set of bound identifiers that the macro can
+reference.
+
+As a technical implementation detail, the identifiers returned by
+@code{syntax-locally-bound-identifiers} will be anti-marked, like the
+syntax object that is given as input to a macro. This is to signal to
+the macro expander that these bindings were present in the original
+source, and do not need to be hygienically renamed, as would be the case
+with other introduced identifiers. See the discussion of hygiene in
+section 12.1 of the R6RS, for more information on marks.
+
+@example
+(define (local-lexicals id)
+ (filter (lambda (x)
+ (eq? (syntax-local-binding x) 'lexical))
+ (syntax-locally-bound-identifiers id)))
+(define-syntax lexicals
+ (lambda (x)
+ (syntax-case x ()
+ ((lexicals) #'(lexicals lexicals))
+ ((lexicals scope)
+ (with-syntax (((id ...) (local-lexicals #'scope)))
+ #'(list (cons 'id id) ...))))))
+
+(let* ((x 10) (x 20)) (lexicals))
+@result{} ((x . 10) (x . 20))
+@end example
+@end deffn
+
+
@node Defmacros
@subsection Lisp-style Macro Definitions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index d006d47..8d28c87 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -390,6 +390,7 @@ If there is no handler at all, Guile prints an error and then exits."
(define bound-identifier=? #f)
(define free-identifier=? #f)
(define syntax-local-binding #f)
+(define syntax-locally-bound-identifiers #f)
;; $sc-dispatch is an implementation detail of psyntax. It is used by
;; expanded macros, to dispatch an input against a set of patterns.
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index fd33e98..422347d 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -791,6 +791,55 @@
id))))))
(else (syntax-violation 'id-var-name "invalid id" id)))))
+ ;; A helper procedure for syntax-locally-bound-identifiers, which
+ ;; itself is a helper for transformer procedures.
+ ;; `locally-bound-identifiers' returns a list of all bindings
+ ;; visible to a syntax object with the given wrap. They are in
+ ;; order from outer to inner.
+ ;;
+ ;; The purpose of this procedure is to give a transformer procedure
+ ;; references on bound identifiers, that the transformer can then
+ ;; introduce some of them in its output. As such, the identifiers
+ ;; are anti-marked, so that rebuild-macro-output doesn't apply new
+ ;; marks to them.
+ ;;
+ (define locally-bound-identifiers
+ (lambda (w mod)
+ (define scan
+ (lambda (subst results)
+ (if (null? subst)
+ results
+ (let ((fst (car subst)))
+ (if (eq? fst 'shift)
+ (scan (cdr subst) results)
+ (let ((symnames (ribcage-symnames fst))
+ (marks (ribcage-marks fst)))
+ (if (vector? symnames)
+ (scan-vector-rib subst symnames marks results)
+ (scan-list-rib subst symnames marks results))))))))
+ (define scan-list-rib
+ (lambda (subst symnames marks results)
+ (let f ((symnames symnames) (marks marks) (results results))
+ (if (null? symnames)
+ (scan (cdr subst) results)
+ (f (cdr symnames) (cdr marks)
+ (cons (wrap (car symnames)
+ (anti-mark (make-wrap (car marks) subst))
+ mod)
+ results))))))
+ (define scan-vector-rib
+ (lambda (subst symnames marks results)
+ (let ((n (vector-length symnames)))
+ (let f ((i 0) (results results))
+ (if (fx= i n)
+ (scan (cdr subst) results)
+ (f (fx+ i 1)
+ (cons (wrap (vector-ref symnames i)
+ (anti-mark (make-wrap (vector-ref marks i) subst))
+ mod)
+ results)))))))
+ (scan (wrap-subst w) '())))
+
;; Returns three values: binding type, binding value, the module (for
;; resolving toplevel vars).
(define (resolve-identifier id w r mod)
@@ -2503,6 +2552,12 @@
((global) (values 'global (cons value mod)))
(else (values 'other #f)))))))))
+ (set! syntax-locally-bound-identifiers
+ (lambda (x)
+ (arg-check nonsymbol-id? x 'syntax-locally-bound-identifiers)
+ (locally-bound-identifiers (syntax-object-wrap x)
+ (syntax-object-module x))))
+
(set! generate-temporaries
(lambda (ls)
(arg-check list? ls 'generate-temporaries)
--
1.7.8.3
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Implement-local-eval-local-compile-and-the-environme.patch --]
[-- Type: text/x-diff, Size: 22051 bytes --]
From c0d46cdfe3c789d9847933643f22ba72fe1684e5 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 3 Jan 2012 04:02:08 -0500
Subject: [PATCH 2/2] Implement `local-eval', `local-compile', and
`the-environment'
* module/ice-9/local-eval.scm: New module (ice-9 local-eval) which
exports `the-environment', `local-eval', and `local-compile'.
* 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.
Based on a patch by Mark H Weaver <mhw@netris.org>.
---
doc/ref/api-evaluation.texi | 34 ++++
libguile/debug.c | 13 ++-
libguile/debug.h | 4 +-
module/Makefile.am | 5 +-
module/ice-9/local-eval.scm | 255 +++++++++++++++++++++++++++++++
test-suite/standalone/test-loose-ends.c | 16 ++-
test-suite/tests/eval.test | 86 ++++++++++-
7 files changed, 406 insertions(+), 7 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..9c7214d 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,39 @@ 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)} does
+not capture local syntax transformers bound by @code{let-syntax},
+@code{letrec-syntax} or non-top-level @code{define-syntax} forms. Any
+attempt to reference such captured syntactic keywords via
+@code{local-eval} or @code{local-compile} produces an error.
+
+
@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..caeff4f
--- /dev/null
+++ b/module/ice-9/local-eval.scm
@@ -0,0 +1,255 @@
+;;; -*- 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 (the-environment local-eval local-compile))
+
+(define-record-type lexical-environment-type
+ (make-lexical-environment module scope wrapper boxes patterns)
+ lexical-environment?
+ (module lexenv-module)
+ (scope lexenv-scope)
+ (wrapper lexenv-wrapper)
+ (boxes lexenv-boxes)
+ (patterns lexenv-patterns))
+
+(set-record-type-printer!
+ lexical-environment-type
+ (lambda (e port)
+ (format port "#<lexical-environment ~S (~S bindings)>"
+ (module-name (lexenv-module e))
+ (+ (length (lexenv-boxes e)) (length (lexenv-patterns e))))))
+
+(define-syntax-rule (make-box v)
+ (case-lambda
+ (() v)
+ ((x) (set! v x))))
+
+(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
+ 'local-eval
+ "unsupported binding captured by (the-environment)"
+ x))))
+
+(define (within-nested-ellipses id lvl)
+ (let loop ((s id) (n lvl))
+ (if (zero? n)
+ s
+ (loop #`(#,s (... ...)) (- n 1)))))
+
+;; Analyze the set of bound identifiers IDS. Return four values:
+;;
+;; capture: A list of forms that will be emitted in the expansion of
+;; `the-environment' to capture lexical variables.
+;;
+;; formals: Corresponding formal parameters for use in the lambda that
+;; re-introduces those variables. These are temporary identifiers, and
+;; as such if we have a nested `the-environment', there is no need to
+;; capture them. (See the notes on nested `the-environment' and
+;; proxies, below.)
+;;
+;; wrappers: A list of procedures of type SYNTAX -> SYNTAX, used to wrap
+;; the expression to be evaluated in forms that re-introduce the
+;; variable. The forms will be nested so that the variable shadowing
+;; semantics of the original form are maintained.
+;;
+;; patterns: A terrible hack. The issue is that for pattern variables,
+;; we can't emit lexically nested with-syntax forms, like:
+;;
+;; (with-syntax ((foo 1)) (the-environment))
+;; => (with-syntax ((foo 1))
+;; ... #'(with-syntax ((foo ...)) ... exp) ...)
+;;
+;; The reason is that the outer "foo" substitutes into the inner "foo",
+;; yielding something like:
+;;
+;; (with-syntax ((foo 1))
+;; ... (with-syntax ((1 ...)) ...)
+;;
+;; Which ain't what we want. So we hide the information needed to
+;; re-make the inner pattern binding form in the lexical environment
+;; object, and then introduce those identifiers via another with-syntax.
+;;
+;;
+;; There are four different kinds of lexical bindings: normal lexicals,
+;; macros, displaced lexicals, and pattern variables. See the
+;; documentation of syntax-local-binding for more info on these.
+;;
+;; We capture normal lexicals via `make-box', which creates a
+;; case-lambda that can reference or set a variable. These get
+;; re-introduced with an identifier-syntax.
+;;
+;; We can't capture macros currently. However we do recognize our own
+;; macros that are actually proxying lexicals, so that nested
+;; `the-environment' forms are possible. In that case we drill down to
+;; the identifier for the already-existing box, and just capture that
+;; box.
+;;
+;; And that's it: we skip displaced lexicals, and the pattern variables
+;; are discussed above.
+;;
+(define (analyze-identifiers ids)
+ (define (mktmp)
+ (datum->syntax #'here (gensym "t ")))
+ (let lp ((ids ids) (capture '()) (formals '()) (wrappers '()) (patterns '()))
+ (cond
+ ((null? ids)
+ (values capture formals wrappers patterns))
+ (else
+ (let ((id (car ids)) (ids (cdr ids)))
+ (call-with-values (lambda () (syntax-local-binding id))
+ (lambda (type val)
+ (case type
+ ((lexical)
+ (if (or-map (lambda (x) (bound-identifier=? x id)) formals)
+ (lp ids capture formals wrappers patterns)
+ (let ((t (mktmp)))
+ (lp ids
+ (cons #`(make-box #,id) capture)
+ (cons t formals)
+ (cons (lambda (x)
+ #`(let-syntax ((#,id (identifier-syntax-from-box #,t)))
+ #,x))
+ wrappers)
+ patterns))))
+ ((displaced-lexical)
+ (lp ids capture formals wrappers patterns))
+ ((macro)
+ (let ((b (procedure-property val 'identifier-syntax-box)))
+ (if b
+ (lp ids (cons b capture) (cons b formals)
+ (cons (lambda (x)
+ #`(let-syntax ((#,id (identifier-syntax-from-box #,b)))
+ #,x))
+ wrappers)
+ patterns)
+ (lp ids capture formals
+ (cons (lambda (x)
+ #`(let-syntax ((#,id (unsupported-binding '#,id)))
+ #,x))
+ wrappers)
+ patterns))))
+ ((pattern-variable)
+ (let ((t (datum->syntax id (gensym "p ")))
+ (nested (within-nested-ellipses id (cdr val))))
+ (lp ids capture formals
+ (cons (lambda (x)
+ #`(with-syntax ((#,t '#,nested))
+ #,x))
+ wrappers)
+ ;; This dance is to hide these pattern variables
+ ;; from the expander.
+ (cons (list (datum->syntax #'here (syntax->datum id))
+ (cdr val)
+ t)
+ patterns))))
+ (else
+ (error "what" type val))))))))))
+
+(define-syntax the-environment
+ (lambda (x)
+ (syntax-case x ()
+ ((the-environment)
+ #'(the-environment the-environment))
+ ((the-environment scope)
+ (call-with-values (lambda ()
+ (analyze-identifiers
+ (syntax-locally-bound-identifiers #'scope)))
+ (lambda (capture formals wrappers patterns)
+ (define (wrap-expression x)
+ (let lp ((x x) (wrappers wrappers))
+ (if (null? wrappers)
+ x
+ (lp ((car wrappers) x) (cdr wrappers)))))
+ (with-syntax ((module (datum->syntax #'here (module-name (current-module))))
+ ((f ...) formals)
+ ((c ...) capture)
+ (((pname plvl pformal) ...) patterns)
+ (wrapped (wrap-expression #'(begin #f exp))))
+ #'(make-lexical-environment
+ (resolve-module 'module)
+ (syntax-object-of scope)
+ (lambda (exp pformal ...)
+ (with-syntax ((exp exp)
+ (pformal pformal)
+ ...)
+ #'(lambda (f ...)
+ wrapped)))
+ (list c ...)
+ (list (list 'pname plvl #'pformal) ...)))))))))
+
+(define (local-expand x e)
+ (apply (lexenv-wrapper e)
+ (datum->syntax (lexenv-scope e) x)
+ (map (lambda (l)
+ (let ((name (car l))
+ (lvl (cadr l))
+ (scope (caddr l)))
+ (within-nested-ellipses (datum->syntax scope name) lvl)))
+ (lexenv-patterns e))))
+
+(define (local-eval x e)
+ "Evaluate the expression @var{x} within the lexical environment @var{e}."
+ (cond ((lexical-environment? e)
+ (apply (eval (local-expand x e) (lexenv-module e))
+ (lexenv-boxes 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 (local-expand x e)
+ #:env (lexenv-module e)
+ #:from 'scheme #:opts opts)
+ (lexenv-boxes 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))))
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..9e6fbf6 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,85 @@
(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.8.3
[-- Attachment #4: Type: text/plain, Size: 26 bytes --]
--
http://wingolog.org/
^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-20 12:42 ` Andy Wingo
@ 2012-01-20 19:04 ` Mark H Weaver
2012-01-20 20:00 ` Mark H Weaver
1 sibling, 0 replies; 8+ messages in thread
From: Mark H Weaver @ 2012-01-20 19:04 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
Hi Andy. Thanks for following through on this. As you probably
noticed, my motivation to work on `local-eval' has largely dissipated,
so it's great that you finished this up in time for 2.0.4.
I haven't yet had time to fully review these patches, but for now, a
quick scan reveals a few remaining problems. See below:
Andy Wingo <wingo@pobox.com> writes:
> +(define-syntax the-environment
> + (lambda (x)
> + (syntax-case x ()
> + ((the-environment)
> + #'(the-environment the-environment))
> + ((the-environment scope)
> + (call-with-values (lambda ()
> + (analyze-identifiers
> + (syntax-locally-bound-identifiers #'scope)))
> + (lambda (capture formals wrappers patterns)
> + (define (wrap-expression x)
> + (let lp ((x x) (wrappers wrappers))
> + (if (null? wrappers)
> + x
> + (lp ((car wrappers) x) (cdr wrappers)))))
> + (with-syntax ((module (datum->syntax #'here (module-name (current-module))))
***** Again, the module must be the one embedded in `scope', not the
(current-module). I guess this is a reminder that I need to add a more
thorough set of regression tests for `local-eval'.
> +(define (local-eval x e)
> + "Evaluate the expression @var{x} within the lexical environment @var{e}."
> + (cond ((lexical-environment? e)
> + (apply (eval (local-expand x e) (lexenv-module e))
> + (lexenv-boxes 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)))
***** Again, there should be an `#f' before `#,x' here, to force
expression context (my mistake).
> + (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 (local-expand x e)
> + #:env (lexenv-module e)
> + #:from 'scheme #:opts opts)
> + (lexenv-boxes 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)
***** Ditto.
> + #:env e #:from 'scheme #:opts opts)))
> + (else (error "local-compile: invalid lexical environment" e))))
I'll try to do a more thorough review later.
Thanks,
Mark
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-20 12:42 ` Andy Wingo
2012-01-20 19:04 ` Mark H Weaver
@ 2012-01-20 20:00 ` Mark H Weaver
2012-01-22 7:01 ` Mark H Weaver
1 sibling, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2012-01-20 20:00 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
There's another thing that really should be fixed, for the sake of
preserving our ability to change the implementation `local-eval' in the
future.
Since (the-environment) can be included in code compiled to disk, the
lexical environment objects that it returns are effectively now part of
our ABI. As it is now, if we want to change the representation, we'll
be in for a lot of headaches to support lexical environments produced by
older code.
The fix is simple: Simply change the representation of the lexical
environment object to contain only a single field: a procedure that
takes an expression (and optional keyword arguments) and does the
equivalent of `local-eval' or `local-compile'. (The keyword arguments
should specify whether or not to compile, and the compile options).
Then, `local-eval' and `local-compile', when applied to a lexical
environment object, should simply call the embedded procedure.
Thanks,
Mark
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-20 12:33 syntax-locally-bound-identifiers, local-eval Andy Wingo
2012-01-20 12:42 ` Andy Wingo
@ 2012-01-22 0:28 ` Ludovic Courtès
1 sibling, 0 replies; 8+ messages in thread
From: Ludovic Courtès @ 2012-01-22 0:28 UTC (permalink / raw)
To: guile-devel
Andy Wingo <wingo@pobox.com> skribis:
> (define-syntax lexicals
> (lambda (x)
> (syntax-case x ()
> ((lexicals) #'(lexicals lexicals))
> ((lexicals scope)
> (with-syntax (((id ...)
> (filter (lambda (x)
> (eq? (syntax-local-binding x) 'lexical))
> (syntax-locally-bound-identifiers #'scope))))
> #'(list (cons 'id id) ...))))))
>
> (let* ((x 10) (x 20)) (lexicals))
> => ((x . 10) (x . 20))
Ooooh, I’m starting to find it fun! :-)
Ludo’.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-20 20:00 ` Mark H Weaver
@ 2012-01-22 7:01 ` Mark H Weaver
2012-01-23 12:52 ` Andy Wingo
0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2012-01-22 7:01 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
[-- Attachment #1: Type: text/plain, Size: 2358 bytes --]
Hi Andy,
> There's another thing that really should be fixed, for the sake of
> preserving our ability to change the implementation `local-eval' in the
> future.
>
> Since (the-environment) can be included in code compiled to disk, the
> lexical environment objects that it returns are effectively now part of
> our ABI. As it is now, if we want to change the representation, we'll
> be in for a lot of headaches to support lexical environments produced by
> older code.
>
> The fix is simple: Simply change the representation of the lexical
> environment object to contain only a single field: a procedure that
> takes an expression (and optional keyword arguments) and does the
> equivalent of `local-eval' or `local-compile'. (The keyword arguments
> should specify whether or not to compile, and the compile options).
>
> Then, `local-eval' and `local-compile', when applied to a lexical
> environment object, should simply call the embedded procedure.
To help facilitate this change, I've attached a small patch to change my
variant of `local-eval' to use this simple future-proof representation.
As you can see, the changes are simple and nicely localized. I'll leave
it to you to adapt these changes to your implementation.
Also, see below for an improved "the-environment within a macro" test
that now checks that the proper module was stored in the lexical
environment. Please verify that this works properly with your patch.
Thanks!
Mark
(pass-if "the-environment within a macro"
(let ((module-a-name '(test module the-environment a))
(module-b-name '(test module the-environment b)))
(let ((module-a (resolve-module module-a-name))
(module-b (resolve-module module-b-name)))
(module-use! module-a (resolve-interface '(guile)))
(module-use! module-a (resolve-interface '(ice-9 local-eval)))
(eval '(begin
(define z 3)
(define-syntax-rule (test)
(let ((x 1) (y 2))
(the-environment))))
module-a)
(module-use! module-b (resolve-interface '(guile)))
(let ((env (eval `(let ((x 111) (y 222))
((@@ ,module-a-name test)))
module-b)))
(equal? (local-eval '(list x y z) env)
'(1 2 3))))))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Switch to universal lexical environment representation --]
[-- Type: text/x-patch, Size: 4017 bytes --]
diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
index ece1313..fb6752c 100644
--- a/module/ice-9/local-eval.scm
+++ b/module/ice-9/local-eval.scm
@@ -24,34 +24,20 @@
#:export (local-eval local-compile))
(define-record-type lexical-environment-type
- (make-lexical-environment module wrapper boxes pattern-bindings
- var-names pattern-var-names unsupported-names)
+ (make-lexical-environment version evaluator)
lexical-environment?
- (module lexenv-module)
- (wrapper lexenv-wrapper)
- (boxes lexenv-boxes)
- (pattern-bindings lexenv-pattern-bindings)
- (var-names lexenv-var-names)
- (pattern-var-names lexenv-pattern-var-names)
- (unsupported-names lexenv-unsupported-names))
+ (version lexenv-version)
+ (evaluator lexenv-evaluator))
(set-record-type-printer!
lexical-environment-type
(lambda (e port)
- (format port "#<lexical-environment ~S ~S ~S ~S>"
- (module-name (lexenv-module e))
- (reverse (map (lambda (name box) (list name (box)))
- (lexenv-var-names e) (lexenv-boxes e)))
- (reverse (lexenv-pattern-var-names e))
- (reverse (lexenv-unsupported-names e)))))
+ (format port "#<lexical-environment>")))
(define (local-eval x e)
"Evaluate the expression @var{x} within the lexical environment @var{e}."
(cond ((lexical-environment? e)
- (apply (eval ((lexenv-wrapper e) x)
- (lexenv-module e))
- (append (lexenv-boxes e)
- (lexenv-pattern-bindings e))))
+ ((lexenv-evaluator e) x #f))
((module? e)
;; Here we evaluate the expression within `lambda', and then
;; call the resulting procedure outside of the dynamic extent
@@ -64,11 +50,7 @@
(define* (local-compile x e #:key (opts '()))
"Compile and evaluate the expression @var{x} within the lexical environment @var{e}."
(cond ((lexical-environment? e)
- (apply (compile ((lexenv-wrapper e) x)
- #:env (lexenv-module e)
- #:from 'scheme #:opts opts)
- (append (lexenv-boxes e)
- (lexenv-pattern-bindings e))))
+ ((lexenv-evaluator e) x opts))
((module? e)
;; Here we compile the expression within `lambda', and then
;; call the resulting procedure outside of the dynamic extent
@@ -109,18 +91,21 @@
(((nested-pvar ...)
(map within-nested-ellipses #'(pvar ...) #'(pvar-lvl ...))))
#'(make-lexical-environment
- module
- (lambda (expression) #`(box-lambda*
- #,'(v ...)
- #,'(pvar ...)
- #,'(pvar-lvl ...)
- #,'(unsupported ...)
- #,expression))
- (list box ...)
- (list #'nested-pvar ...)
- '(v ...)
- '(pvar ...)
- '(unsupported ...)))))))
+ 1 ; version number
+ (let ((mod module)
+ (args (list box ... #'nested-pvar ...)))
+ (lambda (expression opts)
+ (let* ((wrapped-expr #`(box-lambda*
+ #,'(v ...)
+ #,'(pvar ...)
+ #,'(pvar-lvl ...)
+ #,'(unsupported ...)
+ #,expression))
+ (proc (if opts
+ (compile wrapped-expr #:env mod
+ #:from 'scheme #:opts opts)
+ (eval wrapped-expr mod))))
+ (apply proc args))))))))))
(define-syntax-rule (identifier-syntax-from-box box)
(make-transformer-from-box
^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-22 7:01 ` Mark H Weaver
@ 2012-01-23 12:52 ` Andy Wingo
2012-01-25 23:44 ` Andy Wingo
0 siblings, 1 reply; 8+ messages in thread
From: Andy Wingo @ 2012-01-23 12:52 UTC (permalink / raw)
To: Mark H Weaver; +Cc: guile-devel
[-- Attachment #1: Type: text/plain, Size: 998 bytes --]
Hi Mark!
Thanks for your review of my patches. I would like to say, "our
patches", as they are not really mine, but I understand if you don't
want to claim parentage in this case :)
I fixed the module-related scope issues by adding a new accessor for
syntax objects, `syntax-module'. It is like Racket's
`syntax-source-module'. I added your expanded test to eval.test, and it
works fine.
You mention versioning, but I believe that this is a non-issue. If we
want to change the format of <lexical-environment>, we have two more
compelling options. One would be to make a compatible change, but
that's not always possible. The second would be to define another
<lexical-environment-2> or something; new expansions of
`the-environment' would embed references to this new vtable. Record
type predicates could distinguish them for the purposes of
local-eval/local-compile.
Here are the current patches. I've manually removed the parts that
patch psyntax-pp.scm, to not hurt our eyeballs :)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-add-syntax-locally-bound-identifiers.patch --]
[-- Type: text/x-diff, Size: 7109 bytes --]
From 68673f7507736f9a39d2d1eac9ef2a9ad1fd80dc Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 15 Jan 2012 18:39:44 +0100
Subject: [PATCH 1/3] add syntax-locally-bound-identifiers
* module/ice-9/boot-9.scm (syntax-locally-bound-identifiers): Declare
variable.
* module/ice-9/psyntax.scm: Add locally-bound-identifiers helper, and
define syntax-locally-bound-identifiers.
* module/ice-9/psyntax-pp.scm: Regenerated.
* doc/ref/api-macros.texi: Document the new procedure.
---
doc/ref/api-macros.texi | 37 +-
module/ice-9/boot-9.scm | 1 +
module/ice-9/psyntax-pp.scm |24438 +++++++++++++++++++++++--------------------
module/ice-9/psyntax.scm | 59 +-
4 files changed, 13078 insertions(+), 11457 deletions(-)
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 4702d2f..02b5d5c 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -744,7 +744,7 @@ information with macros:
(define-syntax-rule (with-aux aux value)
(let ((trans value))
(set! (aux-property trans) aux)
- trans)))
+ trans))
(define-syntax retrieve-aux
(lambda (x)
(syntax-case x ()
@@ -768,6 +768,41 @@ information with macros:
a syntax transformer; to call it otherwise will signal an error.
@end deffn
+@deffn {Scheme Procedure} syntax-locally-bound-identifiers id
+Return a list of identifiers that were visible lexically when the
+identifier @var{id} was created, in order from outermost to innermost.
+
+This procedure is intended to be used in specialized procedural macros,
+to provide a macro with the set of bound identifiers that the macro can
+reference.
+
+As a technical implementation detail, the identifiers returned by
+@code{syntax-locally-bound-identifiers} will be anti-marked, like the
+syntax object that is given as input to a macro. This is to signal to
+the macro expander that these bindings were present in the original
+source, and do not need to be hygienically renamed, as would be the case
+with other introduced identifiers. See the discussion of hygiene in
+section 12.1 of the R6RS, for more information on marks.
+
+@example
+(define (local-lexicals id)
+ (filter (lambda (x)
+ (eq? (syntax-local-binding x) 'lexical))
+ (syntax-locally-bound-identifiers id)))
+(define-syntax lexicals
+ (lambda (x)
+ (syntax-case x ()
+ ((lexicals) #'(lexicals lexicals))
+ ((lexicals scope)
+ (with-syntax (((id ...) (local-lexicals #'scope)))
+ #'(list (cons 'id id) ...))))))
+
+(let* ((x 10) (x 20)) (lexicals))
+@result{} ((x . 10) (x . 20))
+@end example
+@end deffn
+
+
@node Defmacros
@subsection Lisp-style Macro Definitions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 2c87d13..cd55203 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -390,6 +390,7 @@ If there is no handler at all, Guile prints an error and then exits."
(define bound-identifier=? #f)
(define free-identifier=? #f)
(define syntax-local-binding #f)
+(define syntax-locally-bound-identifiers #f)
;; $sc-dispatch is an implementation detail of psyntax. It is used by
;; expanded macros, to dispatch an input against a set of patterns.
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index fd33e98..024bb85 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -791,6 +791,55 @@
id))))))
(else (syntax-violation 'id-var-name "invalid id" id)))))
+ ;; A helper procedure for syntax-locally-bound-identifiers, which
+ ;; itself is a helper for transformer procedures.
+ ;; `locally-bound-identifiers' returns a list of all bindings
+ ;; visible to a syntax object with the given wrap. They are in
+ ;; order from outer to inner.
+ ;;
+ ;; The purpose of this procedure is to give a transformer procedure
+ ;; references on bound identifiers, that the transformer can then
+ ;; introduce some of them in its output. As such, the identifiers
+ ;; are anti-marked, so that rebuild-macro-output doesn't apply new
+ ;; marks to them.
+ ;;
+ (define locally-bound-identifiers
+ (lambda (w mod)
+ (define scan
+ (lambda (subst results)
+ (if (null? subst)
+ results
+ (let ((fst (car subst)))
+ (if (eq? fst 'shift)
+ (scan (cdr subst) results)
+ (let ((symnames (ribcage-symnames fst))
+ (marks (ribcage-marks fst)))
+ (if (vector? symnames)
+ (scan-vector-rib subst symnames marks results)
+ (scan-list-rib subst symnames marks results))))))))
+ (define scan-list-rib
+ (lambda (subst symnames marks results)
+ (let f ((symnames symnames) (marks marks) (results results))
+ (if (null? symnames)
+ (scan (cdr subst) results)
+ (f (cdr symnames) (cdr marks)
+ (cons (wrap (car symnames)
+ (anti-mark (make-wrap (car marks) subst))
+ mod)
+ results))))))
+ (define scan-vector-rib
+ (lambda (subst symnames marks results)
+ (let ((n (vector-length symnames)))
+ (let f ((i 0) (results results))
+ (if (fx= i n)
+ (scan (cdr subst) results)
+ (f (fx+ i 1)
+ (cons (wrap (vector-ref symnames i)
+ (anti-mark (make-wrap (vector-ref marks i) subst))
+ mod)
+ results)))))))
+ (scan (wrap-subst w) '())))
+
;; Returns three values: binding type, binding value, the module (for
;; resolving toplevel vars).
(define (resolve-identifier id w r mod)
@@ -2478,7 +2527,7 @@
(set! syntax-local-binding
(lambda (id)
- (arg-check nonsymbol-id? id 'syntax-local-value)
+ (arg-check nonsymbol-id? id 'syntax-local-binding)
(with-transformer-environment
(lambda (e r w s rib mod)
(define (strip-anti-mark w)
@@ -2500,9 +2549,15 @@
((macro) (values 'macro value))
((syntax) (values 'pattern-variable value))
((displaced-lexical) (values 'displaced-lexical #f))
- ((global) (values 'global (cons value mod)))
+ ((global) (values 'global (cons value (cdr mod))))
(else (values 'other #f)))))))))
+ (set! syntax-locally-bound-identifiers
+ (lambda (x)
+ (arg-check nonsymbol-id? x 'syntax-locally-bound-identifiers)
+ (locally-bound-identifiers (syntax-object-wrap x)
+ (syntax-object-module x))))
+
(set! generate-temporaries
(lambda (ls)
(arg-check list? ls 'generate-temporaries)
--
1.7.8.3
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-add-syntax-module.patch --]
[-- Type: text/x-diff, Size: 2275 bytes --]
From 4a8740595df89ae29fe3eef0f133e78787665b9a Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 23 Jan 2012 12:31:33 +0100
Subject: [PATCH 2/3] add syntax-module
* module/ice-9/psyntax.scm (syntax-module): New accessor for syntax
objects.
* module/ice-9/psyntax-pp.scm: Regenerate.
* module/ice-9/boot-9.scm: Declare syntax-module.
* doc/ref/api-macros.texi: Document it.
---
doc/ref/api-macros.texi | 5 +
module/ice-9/boot-9.scm | 1 +
module/ice-9/psyntax-pp.scm |14124 ++++++++++++++++++++++---------------------
module/ice-9/psyntax.scm | 5 +
4 files changed, 7082 insertions(+), 7053 deletions(-)
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 02b5d5c..2b6f15a 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -706,6 +706,11 @@ Return the source properties that correspond to the syntax object
@var{x}. @xref{Source Properties}, for more information.
@end deffn
+@deffn {Scheme Procedure} syntax-module id
+Return the name of the module whose source contains the identifier
+@var{id}.
+@end deffn
+
@deffn {Scheme Procedure} syntax-local-binding id
Resolve the identifer @var{id}, a syntax object, within the current
lexical environment, and return two values, the binding type and a
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index cd55203..3914ff3 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -385,6 +385,7 @@ If there is no handler at all, Guile prints an error and then exits."
(define datum->syntax #f)
(define syntax->datum #f)
(define syntax-source #f)
+(define syntax-module #f)
(define identifier? #f)
(define generate-temporaries #f)
(define bound-identifier=? #f)
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 024bb85..00cb549 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2525,6 +2525,11 @@
(set! syntax-source
(lambda (x) (source-annotation x)))
+ (set! syntax-module
+ (lambda (id)
+ (arg-check nonsymbol-id? id 'syntax-module)
+ (cdr (syntax-object-module id))))
+
(set! syntax-local-binding
(lambda (id)
(arg-check nonsymbol-id? id 'syntax-local-binding)
--
1.7.8.3
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Implement-local-eval-local-compile-and-the-environme.patch --]
[-- Type: text/x-diff, Size: 21862 bytes --]
From 93358db7885046ad878c9abdd05428811c4ef384 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 3 Jan 2012 04:02:08 -0500
Subject: [PATCH 3/3] Implement `local-eval', `local-compile', and
`the-environment'
* module/ice-9/local-eval.scm: New module (ice-9 local-eval) which
exports `the-environment', `local-eval', and `local-compile'.
* 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.
Based on a patch by Mark H Weaver <mhw@netris.org>.
---
doc/ref/api-evaluation.texi | 34 ++++
libguile/debug.c | 13 ++-
libguile/debug.h | 4 +-
module/Makefile.am | 5 +-
module/ice-9/local-eval.scm | 250 +++++++++++++++++++++++++++++++
test-suite/standalone/test-loose-ends.c | 16 ++-
test-suite/tests/eval.test | 95 ++++++++++++-
7 files changed, 410 insertions(+), 7 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 ef3e602..cc62270 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -20,6 +20,7 @@ loading, evaluating, and compiling Scheme code at run time.
* Load Paths:: Where Guile looks for code.
* 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
@@ -980,6 +981,39 @@ 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)} does
+not capture local syntax transformers bound by @code{let-syntax},
+@code{letrec-syntax} or non-top-level @code{define-syntax} forms. Any
+attempt to reference such captured syntactic keywords via
+@code{local-eval} or @code{local-compile} produces an error.
+
+
@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..e771d1c
--- /dev/null
+++ b/module/ice-9/local-eval.scm
@@ -0,0 +1,250 @@
+;;; -*- 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 (the-environment local-eval local-compile))
+
+(define-record-type lexical-environment-type
+ (make-lexical-environment scope wrapper boxes patterns)
+ lexical-environment?
+ (scope lexenv-scope)
+ (wrapper lexenv-wrapper)
+ (boxes lexenv-boxes)
+ (patterns lexenv-patterns))
+
+(set-record-type-printer!
+ lexical-environment-type
+ (lambda (e port)
+ (format port "#<lexical-environment ~S (~S bindings)>"
+ (syntax-module (lexenv-scope e))
+ (+ (length (lexenv-boxes e)) (length (lexenv-patterns e))))))
+
+(define-syntax syntax-object-of
+ (lambda (form)
+ (syntax-case form ()
+ ((_ x) #`(quote #,(datum->syntax #'x #'x))))))
+
+(define-syntax-rule (make-box v)
+ (case-lambda
+ (() v)
+ ((x) (set! v x))))
+
+(define (make-transformer-from-box id trans)
+ (set-procedure-property! trans 'identifier-syntax-box id)
+ trans)
+
+(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 (unsupported-binding name)
+ (make-variable-transformer
+ (lambda (x)
+ (syntax-violation
+ 'local-eval
+ "unsupported binding captured by (the-environment)"
+ x))))
+
+(define (within-nested-ellipses id lvl)
+ (let loop ((s id) (n lvl))
+ (if (zero? n)
+ s
+ (loop #`(#,s (... ...)) (- n 1)))))
+
+;; Analyze the set of bound identifiers IDS. Return four values:
+;;
+;; capture: A list of forms that will be emitted in the expansion of
+;; `the-environment' to capture lexical variables.
+;;
+;; formals: Corresponding formal parameters for use in the lambda that
+;; re-introduces those variables. These are temporary identifiers, and
+;; as such if we have a nested `the-environment', there is no need to
+;; capture them. (See the notes on nested `the-environment' and
+;; proxies, below.)
+;;
+;; wrappers: A list of procedures of type SYNTAX -> SYNTAX, used to wrap
+;; the expression to be evaluated in forms that re-introduce the
+;; variable. The forms will be nested so that the variable shadowing
+;; semantics of the original form are maintained.
+;;
+;; patterns: A terrible hack. The issue is that for pattern variables,
+;; we can't emit lexically nested with-syntax forms, like:
+;;
+;; (with-syntax ((foo 1)) (the-environment))
+;; => (with-syntax ((foo 1))
+;; ... #'(with-syntax ((foo ...)) ... exp) ...)
+;;
+;; The reason is that the outer "foo" substitutes into the inner "foo",
+;; yielding something like:
+;;
+;; (with-syntax ((foo 1))
+;; ... (with-syntax ((1 ...)) ...)
+;;
+;; Which ain't what we want. So we hide the information needed to
+;; re-make the inner pattern binding form in the lexical environment
+;; object, and then introduce those identifiers via another with-syntax.
+;;
+;;
+;; There are four different kinds of lexical bindings: normal lexicals,
+;; macros, displaced lexicals, and pattern variables. See the
+;; documentation of syntax-local-binding for more info on these.
+;;
+;; We capture normal lexicals via `make-box', which creates a
+;; case-lambda that can reference or set a variable. These get
+;; re-introduced with an identifier-syntax.
+;;
+;; We can't capture macros currently. However we do recognize our own
+;; macros that are actually proxying lexicals, so that nested
+;; `the-environment' forms are possible. In that case we drill down to
+;; the identifier for the already-existing box, and just capture that
+;; box.
+;;
+;; And that's it: we skip displaced lexicals, and the pattern variables
+;; are discussed above.
+;;
+(define (analyze-identifiers ids)
+ (define (mktmp)
+ (datum->syntax #'here (gensym "t ")))
+ (let lp ((ids ids) (capture '()) (formals '()) (wrappers '()) (patterns '()))
+ (cond
+ ((null? ids)
+ (values capture formals wrappers patterns))
+ (else
+ (let ((id (car ids)) (ids (cdr ids)))
+ (call-with-values (lambda () (syntax-local-binding id))
+ (lambda (type val)
+ (case type
+ ((lexical)
+ (if (or-map (lambda (x) (bound-identifier=? x id)) formals)
+ (lp ids capture formals wrappers patterns)
+ (let ((t (mktmp)))
+ (lp ids
+ (cons #`(make-box #,id) capture)
+ (cons t formals)
+ (cons (lambda (x)
+ #`(let-syntax ((#,id (identifier-syntax-from-box #,t)))
+ #,x))
+ wrappers)
+ patterns))))
+ ((displaced-lexical)
+ (lp ids capture formals wrappers patterns))
+ ((macro)
+ (let ((b (procedure-property val 'identifier-syntax-box)))
+ (if b
+ (lp ids (cons b capture) (cons b formals)
+ (cons (lambda (x)
+ #`(let-syntax ((#,id (identifier-syntax-from-box #,b)))
+ #,x))
+ wrappers)
+ patterns)
+ (lp ids capture formals
+ (cons (lambda (x)
+ #`(let-syntax ((#,id (unsupported-binding '#,id)))
+ #,x))
+ wrappers)
+ patterns))))
+ ((pattern-variable)
+ (let ((t (datum->syntax id (gensym "p ")))
+ (nested (within-nested-ellipses id (cdr val))))
+ (lp ids capture formals
+ (cons (lambda (x)
+ #`(with-syntax ((#,t '#,nested))
+ #,x))
+ wrappers)
+ ;; This dance is to hide these pattern variables
+ ;; from the expander.
+ (cons (list (datum->syntax #'here (syntax->datum id))
+ (cdr val)
+ t)
+ patterns))))
+ (else
+ (error "what" type val))))))))))
+
+(define-syntax the-environment
+ (lambda (x)
+ (syntax-case x ()
+ ((the-environment)
+ #'(the-environment the-environment))
+ ((the-environment scope)
+ (call-with-values (lambda ()
+ (analyze-identifiers
+ (syntax-locally-bound-identifiers #'scope)))
+ (lambda (capture formals wrappers patterns)
+ (define (wrap-expression x)
+ (let lp ((x x) (wrappers wrappers))
+ (if (null? wrappers)
+ x
+ (lp ((car wrappers) x) (cdr wrappers)))))
+ (with-syntax (((f ...) formals)
+ ((c ...) capture)
+ (((pname plvl pformal) ...) patterns)
+ (wrapped (wrap-expression #'(begin #f exp))))
+ #'(make-lexical-environment
+ #'scope
+ (lambda (exp pformal ...)
+ (with-syntax ((exp exp)
+ (pformal pformal)
+ ...)
+ #'(lambda (f ...)
+ wrapped)))
+ (list c ...)
+ (list (list 'pname plvl #'pformal) ...)))))))))
+
+(define (env-module e)
+ (cond
+ ((lexical-environment? e) (resolve-module (syntax-module (lexenv-scope e))))
+ ((module? e) e)
+ (else (error "invalid lexical environment" e))))
+
+(define (env-boxes e)
+ (cond
+ ((lexical-environment? e) (lexenv-boxes e))
+ ((module? e) '())
+ (else (error "invalid lexical environment" e))))
+
+(define (local-wrap x e)
+ (cond
+ ((lexical-environment? e)
+ (apply (lexenv-wrapper e)
+ (datum->syntax (lexenv-scope e) x)
+ (map (lambda (l)
+ (let ((name (car l))
+ (lvl (cadr l))
+ (scope (caddr l)))
+ (within-nested-ellipses (datum->syntax scope name) lvl)))
+ (lexenv-patterns e))))
+ ((module? e) `(lambda () #f ,exp))
+ (else (error "invalid lexical environment" e))))
+
+(define (local-eval x e)
+ "Evaluate the expression @var{x} within the lexical environment @var{e}."
+ (apply (eval (local-wrap x e) (env-module e))
+ (env-boxes e)))
+
+(define* (local-compile x e #:key (opts '()))
+ "Compile and evaluate the expression @var{x} within the lexical
+environment @var{e}."
+ (apply (compile (local-wrap x e) #:env (env-module e)
+ #:from 'scheme #:opts opts)
+ (env-boxes e)))
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..f532059 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,94 @@
(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 ((module-a-name '(test module the-environment a))
+ (module-b-name '(test module the-environment b)))
+ (let ((module-a (resolve-module module-a-name))
+ (module-b (resolve-module module-b-name)))
+ (module-use! module-a (resolve-interface '(guile)))
+ (module-use! module-a (resolve-interface '(ice-9 local-eval)))
+ (eval '(begin
+ (define z 3)
+ (define-syntax-rule (test)
+ (let ((x 1) (y 2))
+ (the-environment))))
+ module-a)
+ (module-use! module-b (resolve-interface '(guile)))
+ (let ((env (eval `(let ((x 111) (y 222))
+ ((@@ ,module-a-name test)))
+ module-b)))
+ (equal? (local-eval '(list x y z) env)
+ '(1 2 3))))))
+
+ (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.8.3
[-- Attachment #5: Type: text/plain, Size: 31 bytes --]
Andy
--
http://wingolog.org/
^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: syntax-locally-bound-identifiers, local-eval
2012-01-23 12:52 ` Andy Wingo
@ 2012-01-25 23:44 ` Andy Wingo
0 siblings, 0 replies; 8+ messages in thread
From: Andy Wingo @ 2012-01-25 23:44 UTC (permalink / raw)
To: guile-devel
Hi,
I'd like to clarify one point here.
On Mon 23 Jan 2012 13:52, Andy Wingo <wingo@pobox.com> writes:
> If we want to change the format of <lexical-environment>, we have two
> more compelling options. One would be to make a compatible change,
> but that's not always possible.
An example of a compatible change would be adding a field to the record.
The embedded make-struct calls from the expansion would result in a
record with the new number of fields, but with #f for the new fields.
This is actually a quite powerful capability. For example if we wanted
to add a field to list the names of the bound identifiers, for the
record printer, we could. If at some point we decided that was a bad
idea, we change the record printer, and ignore those new fields.
That's the other thing: we are free to change the runtime, within the
local-eval module, to do what we like. You won't ever get an old
runtime with a new expansion, so the problem is easier than it would
otherwise be. The suggested approach of using an all-in-one wrapper
procedure still has the runtime compatibility problem, but it's just as
tricky (if not more) to manage, because you have to remember what free
identifiers the expanded procedures could have referenced.
> The second would be to define another <lexical-environment-2> or
> something; new expansions of `the-environment' would embed references
> to this new vtable. Record type predicates could distinguish them for
> the purposes of local-eval/local-compile.
The patches that I attached to this message use an abstraction to deal
with the "env" that is passed to local-eval / local-compile being a
module or a <lexical-environment>. In the unlikely case that a
<lexical-environment-2> is needed, it would be trivial to extend this
with a third case. But there are a number of compatible changes to go
through before reaching this state.
In summary, I think we have the compatibility needs covered here
adequately. I don't look expect radical changes in this area, but even
if they do make sense (quite possible), I don't see the drawbacks of
this approach.
Regards,
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2012-01-25 23:44 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-01-20 12:33 syntax-locally-bound-identifiers, local-eval Andy Wingo
2012-01-20 12:42 ` Andy Wingo
2012-01-20 19:04 ` Mark H Weaver
2012-01-20 20:00 ` Mark H Weaver
2012-01-22 7:01 ` Mark H Weaver
2012-01-23 12:52 ` Andy Wingo
2012-01-25 23:44 ` Andy Wingo
2012-01-22 0:28 ` Ludovic Courtès
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).