diff options
-rw-r--r-- | doc/ref/api-macros.texi | 10 | ||||
-rw-r--r-- | module/ice-9/psyntax-pp.scm | 8 | ||||
-rw-r--r-- | module/ice-9/psyntax.scm | 7 | ||||
-rw-r--r-- | 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 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))) |