Hello all, I'd like to be able to do things like this:
--8<---------------cut here---------------start------------->8--- (define-syntax alt-environment (syntax-rules () ((alt-environment) (the-environment alt-environment)))) --8<---------------cut here---------------end--------------->8--- and have it actually capture the lexical environment of the macro use. Unfortunately, this doesn't work because the definitions of 'syntax-rules' and 'define-syntax-rule' discard the identifier of the keyword. Another possible use of the keyword identifier would be to pass it to 'datum->syntax' or 'syntax-locally-bound-identifiers'. This patch fixes these problems. Comments and suggestions solicited. Thanks, Mark
>From 3e3d32dd9b2d71ffb0703dedc4d47387e981c9b5 Mon Sep 17 00:00:00 2001 From: Mark H Weaver <m...@netris.org> Date: Mon, 8 Oct 2012 14:08:43 -0400 Subject: [PATCH] Preserve keyword identifier in 'syntax-rules' and 'define-syntax-rule' * module/ice-9/psyntax-pp.scm (syntax-rule, define-syntax-rule): Preserve the keyword identifier. * module/ice-9/psyntax-pp.scm: Regenerate. --- module/ice-9/psyntax-pp.scm | 24 ++++++++++++------------ module/ice-9/psyntax.scm | 8 ++++---- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 68d1bf6..b148c9a 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -2551,12 +2551,13 @@ (cons '#(syntax-object syntax-case ((top)) (hygiene guile)) (cons '#(syntax-object x ((top)) (hygiene guile)) (cons k - (map (lambda (tmp-1 tmp) - (list (cons '#(syntax-object dummy ((top)) (hygiene guile)) tmp) + (map (lambda (tmp-2 tmp-1 tmp) + (list (cons tmp tmp-1) (list '#(syntax-object syntax ((top)) (hygiene guile)) - tmp-1))) + tmp-2))) template - pattern)))))) + pattern + keyword)))))) tmp) (let ((tmp ($sc-dispatch tmp-1 '(_ each-any any . #(each ((any . any) any)))))) (if (if tmp @@ -2576,12 +2577,13 @@ (cons '#(syntax-object syntax-case ((top)) (hygiene guile)) (cons '#(syntax-object x ((top)) (hygiene guile)) (cons k - (map (lambda (tmp-1 tmp) - (list (cons '#(syntax-object dummy ((top)) (hygiene guile)) tmp) + (map (lambda (tmp-2 tmp-1 tmp) + (list (cons tmp tmp-1) (list '#(syntax-object syntax ((top)) (hygiene guile)) - tmp-1))) + tmp-2))) template - pattern)))))) + pattern + keyword)))))) tmp) (syntax-violation #f @@ -2601,8 +2603,7 @@ name (list '#(syntax-object syntax-rules ((top)) (hygiene guile)) '() - (list (cons '#(syntax-object _ ((top)) (hygiene guile)) pattern) - template)))) + (list (cons name pattern) template)))) tmp) (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any any)))) (if (if tmp @@ -2616,8 +2617,7 @@ (list '#(syntax-object syntax-rules ((top)) (hygiene guile)) '() docstring - (list (cons '#(syntax-object _ ((top)) (hygiene guile)) pattern) - template)))) + (list (cons name pattern) template)))) tmp) (syntax-violation #f diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 6c264a6..dc32f5a 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -2789,7 +2789,7 @@ #((macro-type . syntax-rules) (patterns pattern ...)) (syntax-case x (k ...) - ((dummy . pattern) #'template) + ((keyword . pattern) #'template) ...))) ((_ (k ...) docstring ((keyword . pattern) template) ...) (string? (syntax->datum #'docstring)) @@ -2799,7 +2799,7 @@ #((macro-type . syntax-rules) (patterns pattern ...)) (syntax-case x (k ...) - ((dummy . pattern) #'template) + ((keyword . pattern) #'template) ...)))))) (define-syntax define-syntax-rule @@ -2808,13 +2808,13 @@ ((_ (name . pattern) template) #'(define-syntax name (syntax-rules () - ((_ . pattern) template)))) + ((name . pattern) template)))) ((_ (name . pattern) docstring template) (string? (syntax->datum #'docstring)) #'(define-syntax name (syntax-rules () docstring - ((_ . pattern) template))))))) + ((name . pattern) template))))))) (define-syntax let* (lambda (x) -- 1.7.10.4