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

@@ -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
 

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.

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)