[Guile-commits] GNU Guile branch, master, updated. v2.1.0-181-g8ae26af

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8ae26afefee947c71314733c419519fb616bf36d

The branch, master has been updated
       via  8ae26afefee947c71314733c419519fb616bf36d (commit)
      from  9b977c836bf147d386944c401113aba32776fa68 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 8ae26afefee947c71314733c419519fb616bf36d
Author: Andy Wingo <address@hidden>
Date:   Wed Mar 13 11:41:01 2013 +0100

    add #:resolve-syntax-parameters? kwarg to syntax-local-binding
    
    * doc/ref/api-macros.texi (Syntax Transformer Helpers): Document.
    
    * module/ice-9/psyntax.scm (syntax-local-binding): Add
      #:resolve-syntax-parameters? kwarg.  Fixes bug 10991.
    * module/ice-9/psyntax-pp.scm: Regenerate.
    
    * test-suite/tests/syncase.test ("syntax-local-binding"): Add test.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-macros.texi       |   10 ++++++++--
 module/ice-9/psyntax-pp.scm   |    8 ++++++--
 module/ice-9/psyntax.scm      |    7 +++----
 test-suite/tests/syncase.test |   27 ++++++++++++++++++++++++++-
 4 files changed, 43 insertions(+), 9 deletions(-)

diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 347d025..b08c103 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 
2010, 2011, 2012
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 
2010, 2011, 2012, 2013
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -725,7 +725,7 @@ Return the name of the module whose source contains the 
identifier
 @var{id}.
 @end deffn
 
address@hidden {Scheme Procedure} syntax-local-binding id
address@hidden {Scheme Procedure} syntax-local-binding id 
[#:resolve-syntax-parameters?=#t]
 Resolve the identifer @var{id}, a syntax object, within the current
 lexical environment, and return two values, the binding type and a
 binding value.  The binding type is a symbol, which may be one of the
@@ -738,6 +738,12 @@ of @code{eq?}) identifying this binding.
 @item macro
 A syntax transformer, either local or global.  The value is the
 transformer procedure.
address@hidden syntax-parameter
+A syntax parameter (@pxref{Syntax Parameters}).  By default,
address@hidden will resolve syntax parameters, so that this
+value will not be returned.  Pass @code{#:resolve-syntax-parameters? #f}
+to indicate that you are interested in syntax parameters.  The value is
+the default transformer procedure, as in @code{macro}.
 @item pattern-variable
 A pattern variable, bound via syntax-case.  The value is an opaque
 object, internal to the expander.
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index e330423..ada9307 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -2345,7 +2345,9 @@
              (syntax-violation 'syntax-module "invalid argument" x)))
          (cdr (syntax-object-module id))))
      (syntax-local-binding
-       (lambda (id)
+       (lambda* (id
+                 #:key
+                 (resolve-syntax-parameters? #t #:resolve-syntax-parameters?))
          (let ((x id))
            (if (not (nonsymbol-id? x))
              (syntax-violation 'syntax-local-binding "invalid argument" x)))
@@ -2365,11 +2367,13 @@
                      (strip-anti-mark (syntax-object-wrap id))
                      r
                      (syntax-object-module id)
-                     #t))
+                     resolve-syntax-parameters?))
                  (lambda (type value mod)
                    (let ((key type))
                      (cond ((memv key '(lexical)) (values 'lexical value))
                            ((memv key '(macro)) (values 'macro value))
+                           ((memv key '(syntax-parameter))
+                            (values 'syntax-parameter (car value)))
                            ((memv key '(syntax)) (values 'pattern-variable 
value))
                            ((memv key '(displaced-lexical)) (values 
'displaced-lexical #f))
                            ((memv key '(global)) (values 'global (cons value 
(cdr mod))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 79f2fd4..90c76d5 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2648,7 +2648,7 @@
         (arg-check nonsymbol-id? id 'syntax-module)
         (cdr (syntax-object-module id)))
 
-      (define (syntax-local-binding id)
+      (define* (syntax-local-binding id #:key (resolve-syntax-parameters? #t))
         (arg-check nonsymbol-id? id 'syntax-local-binding)
         (with-transformer-environment
          (lambda (e r w s rib mod)
@@ -2665,13 +2665,12 @@
                                 (strip-anti-mark (syntax-object-wrap id))
                                 r
                                 (syntax-object-module id)
-                                ;; FIXME: come up with a better policy for
-                                ;; resolve-syntax-parameters
-                                #t))
+                                resolve-syntax-parameters?))
              (lambda (type value mod)
                (case type
                  ((lexical) (values 'lexical value))
                  ((macro) (values 'macro value))
+                 ((syntax-parameter) (values 'syntax-parameter (car value)))
                  ((syntax) (values 'pattern-variable value))
                  ((displaced-lexical) (values 'displaced-lexical #f))
                  ((global) (values 'global (cons value (cdr mod))))
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index 0e81f65..3b44ba0 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -1,6 +1,6 @@
 ;;;; syncase.test --- test suite for (ice-9 syncase)            -*- scheme -*-
 ;;;;
-;;;;   Copyright (C) 2001, 2006, 2009, 2010, 2011 Free Software Foundation, 
Inc.
+;;;;   Copyright (C) 2001, 2006, 2009, 2010, 2011, 2013 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
@@ -239,3 +239,28 @@
                  ((odd? x) (not (even? x)))))
              (even? 10))
           (current-module))))
+
+(use-modules (system syntax))
+
+(with-test-prefix "syntax-local-binding"
+  (define-syntax syntax-type
+    (lambda (x)
+      (syntax-case x ()
+        ((_ id resolve?)
+         (call-with-values
+             (lambda ()
+               (syntax-local-binding
+                #'id
+                #:resolve-syntax-parameters? (syntax->datum #'resolve?)))
+           (lambda (type value)
+             (with-syntax ((type (datum->syntax #'id type)))
+               #''type)))))))
+
+  (define-syntax-parameter foo
+    (syntax-rules ()))
+
+  (pass-if "syntax-parameters (resolved)"
+    (equal? (syntax-type foo #t) 'macro))
+
+  (pass-if "syntax-parameters (unresolved)"
+    (equal? (syntax-type foo #f) 'syntax-parameter)))


hooks/post-receive
-- 
GNU Guile