mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Preserve keyword identifier in 'syntax-rules' and 'define-syntax-rule'

Browse source 
* module/ice-9/psyntax-pp.scm (syntax-rule, define-syntax-rule):
  Preserve the keyword identifier.

* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Mark H Weaver 2012-10-08 14:08:43 -04:00
parent 75a5de18a0
commit 3e3d32dd9b
2 changed files with 16 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

24
module/ice-9/psyntax-pp.scm
View file

@ -2551,12 +2551,13 @@
(cons '#(syntax-object syntax-case ((top)) (hygiene guile)) (cons '#(syntax-object syntax-case ((top)) (hygiene guile))
(cons '#(syntax-object x ((top)) (hygiene guile)) (cons '#(syntax-object x ((top)) (hygiene guile))
(cons k (cons k
(map (lambda (tmp-1 tmp) (map (lambda (tmp-2 tmp-1 tmp)
(list (cons '#(syntax-object dummy ((top)) (hygiene guile)) tmp) (list (cons tmp tmp-1)
(list '#(syntax-object syntax ((top)) (hygiene guile)) (list '#(syntax-object syntax ((top)) (hygiene guile))
tmp-1))) tmp-2)))
template template
pattern)))))) pattern
keyword))))))
tmp) tmp)
(let ((tmp ($sc-dispatch tmp-1 '(_ each-any any . #(each ((any . any) any)))))) (let ((tmp ($sc-dispatch tmp-1 '(_ each-any any . #(each ((any . any) any))))))
(if (if tmp (if (if tmp
@ -2576,12 +2577,13 @@
(cons '#(syntax-object syntax-case ((top)) (hygiene guile)) (cons '#(syntax-object syntax-case ((top)) (hygiene guile))
(cons '#(syntax-object x ((top)) (hygiene guile)) (cons '#(syntax-object x ((top)) (hygiene guile))
(cons k (cons k
(map (lambda (tmp-1 tmp) (map (lambda (tmp-2 tmp-1 tmp)
(list (cons '#(syntax-object dummy ((top)) (hygiene guile)) tmp) (list (cons tmp tmp-1)
(list '#(syntax-object syntax ((top)) (hygiene guile)) (list '#(syntax-object syntax ((top)) (hygiene guile))
tmp-1))) tmp-2)))
template template
pattern)))))) pattern
keyword))))))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -2601,8 +2603,7 @@
name name
(list '#(syntax-object syntax-rules ((top)) (hygiene guile)) (list '#(syntax-object syntax-rules ((top)) (hygiene guile))
'() '()
(list (cons '#(syntax-object _ ((top)) (hygiene guile)) pattern) (list (cons name pattern) template))))
template))))
tmp) tmp)
(let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any any)))) (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any any))))
(if (if tmp (if (if tmp
@ -2616,8 +2617,7 @@
(list '#(syntax-object syntax-rules ((top)) (hygiene guile)) (list '#(syntax-object syntax-rules ((top)) (hygiene guile))
'() '()
docstring docstring
(list (cons '#(syntax-object _ ((top)) (hygiene guile)) pattern) (list (cons name pattern) template))))
template))))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f

8
module/ice-9/psyntax.scm
View file

@ -2789,7 +2789,7 @@
#((macro-type . syntax-rules) #((macro-type . syntax-rules)
(patterns pattern ...)) (patterns pattern ...))
(syntax-case x (k ...) (syntax-case x (k ...)
((dummy . pattern) #'template) ((keyword . pattern) #'template)
...))) ...)))
((_ (k ...) docstring ((keyword . pattern) template) ...) ((_ (k ...) docstring ((keyword . pattern) template) ...)
(string? (syntax->datum #'docstring)) (string? (syntax->datum #'docstring))
@ -2799,7 +2799,7 @@
#((macro-type . syntax-rules) #((macro-type . syntax-rules)
(patterns pattern ...)) (patterns pattern ...))
(syntax-case x (k ...) (syntax-case x (k ...)
((dummy . pattern) #'template) ((keyword . pattern) #'template)
...)))))) ...))))))
(define-syntax define-syntax-rule (define-syntax define-syntax-rule
@ -2808,13 +2808,13 @@
((_ (name . pattern) template) ((_ (name . pattern) template)
#'(define-syntax name #'(define-syntax name
(syntax-rules () (syntax-rules ()
((_ . pattern) template)))) ((name . pattern) template))))
((_ (name . pattern) docstring template) ((_ (name . pattern) docstring template)
(string? (syntax->datum #'docstring)) (string? (syntax->datum #'docstring))
#'(define-syntax name #'(define-syntax name
(syntax-rules () (syntax-rules ()
docstring docstring
((_ . pattern) template))))))) ((name . pattern) template)))))))
(define-syntax let* (define-syntax let*
(lambda (x) (lambda (x)