suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[honu] dont confuse identifiers with $. use = in with-syntax

Browse Source
This commit is contained in:
Jon Rafkind 2012-04-19 16:34:16 -06:00
parent bb57412242
commit 79b6e5611e
2 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/honu/core/private/compile.rkt
View File

@ -121,12 +121,17 @@
(provide compress-dollars)
(define (compress-dollars stx)
(define-literal-set local-literals (honu-$ repeat$))
(define-splicing-syntax-class not-dollar
#:literal-sets (local-literals)
[pattern x #:when (and (identifier? #'x)
(not (free-identifier=? #'honu-$ #'x)))
#:with out #'x])
(syntax-parse stx #:literal-sets (local-literals)
[(honu-$ x ... honu-$ rest ...)
[(honu-$ x:not-dollar ... honu-$ rest ...)
(with-syntax ([(rest* ...) (compress-dollars #'(rest ...))])
(datum->syntax stx (syntax->list #'((repeat$ x ...) rest* ...))
(datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...))
stx stx))]
[(x rest ...)
[(x:not-dollar rest ...)
(with-syntax ([x* (compress-dollars #'x)]
[(rest* ...) (compress-dollars #'(rest ...))])
(datum->syntax stx

16
collects/honu/core/private/honu2.rkt
View File

@ -341,12 +341,20 @@
(provide (rename-out [honu-with-syntax withSyntax]))
(define-honu-syntax honu-with-syntax
(lambda (code context)
(define-splicing-syntax-class clause
#:literal-sets (cruft)
#:literals [(ellipses ...) honu-equal]
[pattern (~seq name:id honu-equal data:honu-expression)
#:with out #'(name data.result)]
[pattern (~seq (#%parens name:id ellipses) honu-equal data:honu-expression)
#:with out #'((name ellipses) data.result)])
(syntax-parse code #:literal-sets (cruft)
#:literals (honu-->)
[(_ (~seq name:id honu--> data:honu-expression (~optional honu-comma)) ...
#:literals (honu-equal)
[(_ (~seq all:clause (~optional honu-comma)) ...
(#%braces code ...) . rest)
(define out (racket-syntax (with-syntax ([name data.result] ...)
(parse-body code ...))))
(define out (racket-syntax
(with-syntax (all.out ...)
(parse-body code ...))))
(values out #'rest #t)])))
(provide true false)