From f549f273139bda9591194766157bb771a67d9563 Mon Sep 17 00:00:00 2001 From: Andy Wingo 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