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

[honu] rebind the result of parsing to the original pattern variable name

Browse Source
This commit is contained in:
Jon Rafkind 2011-11-10 21:06:50 -07:00
parent 786436b314
commit a4123ce536
2 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/honu/core/private/macro2.rkt
View File

@ -4,6 +4,7 @@
syntax/define syntax/define
syntax/parse syntax/parse
syntax/stx syntax/stx
racket/syntax
"literals.rkt" "literals.rkt"
"parse2.rkt" "parse2.rkt"
"debug.rkt" "debug.rkt"
@ -31,6 +32,17 @@
[(thing:pattern-type ...) [(thing:pattern-type ...)
#'(thing.result ...)])) #'(thing.result ...)]))
(define-for-syntax (find-pattern-variables original-pattern)
(define-splicing-syntax-class pattern-type
#:literal-sets (cruft)
[pattern (~seq name colon class)
#:with result (with-syntax ([name.result (format-id #'name "~a_result" #'name)])
#'(name name.result))]
[pattern x #:with result #f])
(syntax-parse original-pattern
[(thing:pattern-type ...)
(filter (lambda (x) x) (syntax->list #'(thing.result ...)))]))
(provide honu-macro) (provide honu-macro)
(define-honu-syntax honu-macro (define-honu-syntax honu-macro
(lambda (code context) (lambda (code context)
@ -41,21 +53,21 @@
(values (values
(with-syntax ([(syntax-parse-pattern ...) (with-syntax ([(syntax-parse-pattern ...)
(convert-pattern #'(pattern ...))] (convert-pattern #'(pattern ...))]
[((pattern-variable.name pattern-variable.result) ...)
(find-pattern-variables #'(pattern ...))]
[(code ...) (parse-all #'(action ...))]) [(code ...) (parse-all #'(action ...))])
#'(%racket (define-honu-syntax name #'(%racket (define-honu-syntax name
(lambda (stx context-name) (lambda (stx context-name)
(syntax-parse stx (syntax-parse stx
[(_ syntax-parse-pattern ... . more) [(_ syntax-parse-pattern ... . more)
(values (code ...) #'more #t) (values
#; ;; if the pattern is x:expression then x_result will
(values #'(%racket ;; hold the parsed version of x, so we rebind x to
(let-syntax ([do-parse (lambda (stx) ;; x_result so you can use just x in the template
(define what (parse-all (stx-cdr stx))) ;; instead of x_result. x_result is still there, too
(debug "Macro parse all ~a\n" what) (with-syntax ([pattern-variable.name #'pattern-variable.result]
what)]) ...)
(do-parse action ...))) (code ...)) #'more #t)])))))
#'more
#t)])))))
#'rest #'rest
#t)]))) #t)])))

6
collects/tests/honu/macros.rkt
View File

@ -1,6 +1,6 @@
#lang honu #lang honu
macro testx () {x:expression} {syntax(x_result + 1)} macro testx () {x:expression} {syntax(x + 1)}
testx 5 * 2 testx 5 * 2
@ -8,12 +8,12 @@ for z = 1 to testx 5 * 2 do
printf("z is ~a\n", z) printf("z is ~a\n", z)
macro testfor () {x:expression} { macro testfor () {x:expression} {
syntax(for z = 1 to x_result do syntax(for z = 1 to x do
printf("z is ~a\n" z)) printf("z is ~a\n" z))
} }
macro testfor2 () {x:expression}{ macro testfor2 () {x:expression}{
syntax(testfor x_result * 2) syntax(testfor x * 2)
} }
testfor2 1 + 2 testfor2 1 + 2