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) (parse-an-expr parse)
(... scheme:...) (... scheme:...)
(honu-body:class body)
(honu-syntax syntax) (honu-syntax syntax)
(honu-+ +) (honu-+ +)
(honu-scheme scheme2) (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-<<= 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 ...) [(_ 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) (define-for-syntax (fix-template stx)
@ -402,14 +411,16 @@
. rest) . rest)
#:with result #:with result
(list (list
(syntax/loc stx (with-syntax ([(fixed ...) (fix-template #'(template ...))])
(define-honu-syntax name (syntax/loc stx
(lambda (stx ctx) (define-honu-syntax name
(syntax-parse stx #:literals (literals ...) (lambda (stx ctx)
[(template ... rrest (... ...)) (syntax-parse stx #:literals (literals ...)
(values [(fixed ... rrest (... ...))
(honu-unparsed-begin code ...) (values
#'(rrest (... ...)))])))) (let ([result (honu-unparsed-begin code ...)])
(lambda () result))
#'(rrest (... ...)))])))))
#; #;
(with-syntax ([parsed (let-values ([(out rest*) (with-syntax ([parsed (let-values ([(out rest*)
(parse-block-one/2 #'(code ...) (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)] [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-block-one/2 stx context)
(define (parse-one stx context) (define (parse-one stx context)