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

expose syntax-parse classes

Browse Source
This commit is contained in:
Jon Rafkind 2010-05-16 17:23:42 -06:00
parent 721c815d89
commit d5357f6dca
4 changed files with 26 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/honu/main.rkt
View File

@ -51,6 +51,7 @@
)
(parse-an-expr parse)
(... scheme:...)
(honu-body:class body)
(honu-syntax syntax)
(honu-+ +)
(honu-scheme scheme2)

2
collects/honu/private/literals.rkt
View File

@ -16,4 +16,4 @@
honu-= honu-+= honu--= honu-*= honu-/= honu-%=
honu-&= honu-^= honu-\|= honu-<<= honu->>= honu->>>=
honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->=
honu-? honu-: honu-comma honu-. #%braces #%parens)
honu-? honu-: honu-comma honu-. #%braces #%parens colon)

29
collects/honu/private/macro.rkt
View File

@ -63,7 +63,16 @@
[(_ x ...)
|#
(define-for-syntax (fix-template stx) stx)
(define-for-syntax (fix-template stx)
(syntax-parse stx #:literals (honu-:)
[(variable:id honu-: class:id rest ...)
(with-syntax ([(rest* ...) (fix-template #'(rest ...))])
#'((~var variable class) rest* ...))]
[(one rest ...)
(with-syntax ([one* (fix-template #'one)]
[(rest* ...) (fix-template #'(rest ...))])
#'(one* rest* ...))]
[else stx]))
#|
(define-for-syntax (fix-template stx)
@ -402,14 +411,16 @@
. rest)
#:with result
(list
(syntax/loc stx
(define-honu-syntax name
(lambda (stx ctx)
(syntax-parse stx #:literals (literals ...)
[(template ... rrest (... ...))
(values
(honu-unparsed-begin code ...)
#'(rrest (... ...)))]))))
(with-syntax ([(fixed ...) (fix-template #'(template ...))])
(syntax/loc stx
(define-honu-syntax name
(lambda (stx ctx)
(syntax-parse stx #:literals (literals ...)
[(fixed ... rrest (... ...))
(values
(let ([result (honu-unparsed-begin code ...)])
(lambda () result))
#'(rrest (... ...)))])))))
#;
(with-syntax ([parsed (let-values ([(out rest*)
(parse-block-one/2 #'(code ...)

4
collects/honu/private/parse.rkt
View File

@ -352,6 +352,10 @@
[else (raise-syntax-error 'parse-an-expr "cant parse" stx)]
))
(define-splicing-syntax-class honu-body:class
#:literals (#%braces)
[pattern (~seq (#%braces code ...))])
(define (parse-block-one/2 stx context)
(define (parse-one stx context)