Re: local-eval on syntax-local-binding, bound-identifiers

[Mark H Weaver]

Hi Andy,

Thanks very much for heeding my call for `local-eval' in 2.0.4, and
for putting so much time into this.

For the record, I still think it's better for `the-environment' to be
implemented within psyntax as a core form.  It's a fundamental syntactic
construct with clean semantics, and it belongs in psyntax with its
brethren.  Your desire to remove it from psyntax has caused you to add
far less elegant interfaces that have been hastily designed, and that
may not even be sufficient for a full implementation of
`the-environment' that captures mutually-recursive local macros.

That said, there's a lot to like in your implementation, and it has some
notable improvements over mine.  It also has some problems, not all of
which are trivial.

Please see below, where I have inserted specific questions and comments
into your patch.

  Thanks again,
      Mark


[... skipped the first patch, which looks very well implemented, though
     I'm still not sure that we should be exposing this in our API ...]

> From 2c3da44320019453115811af386febaa7eb241c3 Mon Sep 17 00:00:00 2001
> From: Andy Wingo <address@hidden>
> Date: Sun, 15 Jan 2012 18:39:44 +0100
> Subject: [PATCH 2/3] add bound-identifiers
>
> * module/ice-9/boot-9.scm (bound-identifiers): Declare variable.
> * module/ice-9/psyntax.scm: Add all-bound-identifiers helper, and define
>   bound-identifiers.  The identifiers are anti-marked so that syntax
>   transformers can introduce them, as-is.
> ---
>  module/ice-9/boot-9.scm  |    1 +
>  module/ice-9/psyntax.scm |   49 
> ++++++++++++++++++++++++++++++++++++++++++++++
>  2 files changed, 50 insertions(+), 0 deletions(-)
>
> diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
> index 9cdd8d1..b8aa842 100644
> --- a/module/ice-9/boot-9.scm
> +++ b/module/ice-9/boot-9.scm
> @@ -389,6 +389,7 @@ If there is no handler at all, Guile prints an error and 
> then exits."
>  (define generate-temporaries #f)
>  (define bound-identifier=? #f)
>  (define free-identifier=? #f)
> +(define bound-identifiers #f)
>  (define syntax-local-binding #f)
>  
>  ;; $sc-dispatch is an implementation detail of psyntax. It is used by
> diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
> index 30685bc..25543e0 100644
> --- a/module/ice-9/psyntax.scm
> +++ b/module/ice-9/psyntax.scm
> @@ -786,6 +786,48 @@
>                        id))))))
>           (else (syntax-violation 'id-var-name "invalid id" id)))))
>  
> +    ;;
> +    ;; all-bound-identifiers returns a list of all lexically bound
> +    ;; identifiers, as syntax objects.  They are in order from outer to
> +    ;; inner.
> +    ;;
> +    (define all-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))

***** Why are you adding anti-marks here?

> +                                 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))

***** Ditto.

> +                                   mod)
> +                             results)))))))
> +        (scan (wrap-subst w) '())))
> +
>      (define transformer-environment
>        (make-fluid
>         (lambda (k)
> @@ -2470,6 +2512,13 @@
>                           (else (error "unpossible!" b)))
>                         (values 'displaced-lexical #f))))))))
>  
> +    (set! bound-identifiers
> +          (lambda (x)
> +            (arg-check nonsymbol-id? x 'bound-identifiers)
> +            (reverse
> +             (all-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
>
>
>
> From ddea51310227155e3771c3e6acbbecf24dc74c42 Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <address@hidden>
> Date: Tue, 3 Jan 2012 04:02:08 -0500
> Subject: [PATCH 3/3] Implement `local-eval', `local-compile', and
>  `the-environment'

***** In general, when you make substantial changes to one of my
patches, please remove my name as the principal author.  Instead, please
say something like "Based on a patch by Mark H Weaver <address@hidden>"
in the log entry.

>
> * 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.
> ---
>  doc/ref/api-evaluation.texi             |   38 ++++++++
>  libguile/debug.c                        |   13 +++-
>  libguile/debug.h                        |    4 +-
>  module/Makefile.am                      |    5 +-
>  module/ice-9/local-eval.scm             |  150 
> +++++++++++++++++++++++++++++++
>  test-suite/standalone/test-loose-ends.c |   16 +++-
>  test-suite/tests/eval.test              |   79 ++++++++++++++++-
>  7 files changed, 298 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..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.

***** I guess this last sentence should now be removed.  Also, remember
that if pattern variables aren't reimplemented, this limitation needs to
be documented.

> +
> +
>  @c Local Variables:
>  @c TeX-master: "guile.texi"
>  @c End:

[... skipped some files here ...]

> diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
> new file mode 100644
> index 0000000..cb74881
> --- /dev/null
> +++ b/module/ice-9/local-eval.scm
> @@ -0,0 +1,150 @@
> +;;; -*- 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 wrapper boxes)
> +  lexical-environment?
> +  (module            lexenv-module)
> +  (wrapper           lexenv-wrapper)
> +  (boxes             lexenv-boxes))
> +
> +(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)))))
> +
> +(define-syntax-rule (make-box v)
> +  (case-lambda
> +   (() v)
> +   ((x) (set! v x))))
> +
> +(define-syntax let*-syntax
> +  (syntax-rules ()
> +    ((_ () e e* ...)
> +     (begin e e* ...))
> +    ((_ ((id trans) (id* trans*) ...) e e* ...)
> +     (let-syntax ((id trans))
> +       (let*-syntax ((id* trans*) ...)
> +         e e* ...)))))
> +
> +(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 (partition-identifiers ids)
> +  (let lp ((ids ids) (lexical '()) (other '()))
> +    (if (null? ids)
> +        (values lexical other)
> +        (call-with-values (lambda () (syntax-local-binding (car ids)))
> +          (lambda (type val)
> +            (cond
> +             ((eq? type 'lexical)
> +               (lp (cdr ids)
> +                   (acons (car ids) (datum->syntax #'here (gensym))
> +                          lexical)
> +                   other))
> +             ((and (eq? type 'local-macro)
> +                   (procedure-property val 'identifier-syntax-box))
> +              => (lambda (id)
> +                   (lp (cdr ids)
> +                       (acons (car ids) id lexical)

***** You are putting inconsistent things in the cdr of each alist
entry.  In the `lexical' case above, you make a gensym, and here you're
putting the id of the box variable.  However, in the code below, you are
not using this box, but rather just using these identifiers for
temporaries.

> +                       other)))
> +             (else
> +              (lp (cdr ids) lexical (cons (car ids) other)))))))))
> +
> +(define-syntax the-environment
> +  (lambda (x)
> +    (syntax-case x ()
> +      ((the-environment)
> +       #'(the-environment the-environment))
> +      ((the-environment scope)

***** This is nice.

> +       (call-with-values (lambda ()
> +                           (partition-identifiers (bound-identifiers 
> #'scope)))
> +         (lambda (lexical other)
> +           (with-syntax ((module (datum->syntax #'here (module-name 
> (current-module))))

***** This is wrong.  You want the module from the `scope'
syntax-object, not the (current-module).

> +                         (((v . t) ...) lexical)
> +                         ((u ...) other))
> +             #'(make-lexical-environment
> +                (resolve-module 'module)
> +                (lambda (exp)
> +                  (with-syntax ((exp (datum->syntax #'scope exp)))
> +                    #'(lambda (t ...)
> +                        (let*-syntax ((v (identifier-syntax-from-box t))
> +                                      ...
> +                                      (u (unsupported-binding 'u))
> +                                      ...)
> +                          #f ; force expression context
> +                          exp))))
> +                (list (make-box v) ...)))))))))

***** Here you are always making new boxes, even for previously-captured
variables that have already been boxed.  Therefore boxes become nested
and cost O(n) to access, where N is the nesting depth.

More importantly: I notice that you are not stripping the psyntax wrap
from identifiers placed within the wrapper procedure above.  There are
certainly benefits to that, but remember that the wrapper procedure will
in general be serialized to disk and evaluated in a different Guile
session, where the gensym counters have been reset.

This raises a couple of issues that I intentionally sidestepped by
stripping the wraps:

First of all, whereas previously gensyms and psyntax labels only needed
to be unique within a single session, now they must be universally
unique.  This needs to be fixed in order to make your patch robust.

Secondly, you are now serializing a psyntax internal data structure to
disk (the wraps), and thus this now effectively becomes part of the ABI.
This is not necessarily a bad thing, but we must consider what will
happen when a new version of Guile with an enhanced psyntax calls
`local-eval' on a lexical environment generated with code compiled by an
older version of Guile.  We might need to add some kind of versioning
scheme.  It's a bit of a thorny issue, which was much of my motivation
for stripping the wraps in this 2.0.4 version of `local-eval' (though I
admit that a future implementation that supports local syntax
transformers won't be able to avoid this issue).

> +
> +(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))
> +                (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)))

***** This was my mistake, but since I'm already marking up the code:
the `lambda' wrap above needs a `#f' before `e' to force expression
context.

> +        (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)
> +                (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))))

[... skipped the rest ...]