diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/psyntax-pp.scm | 8 | ||||
-rw-r--r-- | module/ice-9/psyntax.scm | 7 |
2 files changed, 9 insertions, 6 deletions
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)))) |