summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/api-macros.texi10
-rw-r--r--module/ice-9/psyntax-pp.scm8
-rw-r--r--module/ice-9/psyntax.scm7
-rw-r--r--test-suite/tests/syncase.test27
4 files changed, 43 insertions, 9 deletions
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 347d02589..b08c1035a 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.
-@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011, 2012
+@c 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
-@deffn {Scheme Procedure} syntax-local-binding id
+@deffn {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.
+@item syntax-parameter
+A syntax parameter (@pxref{Syntax Parameters}). By default,
+@code{syntax-local-binding} 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 e330423b5..ada930755 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 79f2fd41f..90c76d550 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 0e81f6506..3b44ba016 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)))