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

[honu] xml example doesnt need its own < and > literals

Browse Source
This commit is contained in:
Jon Rafkind 2012-10-08 15:32:51 -06:00
parent a3e2c2fae6
commit 8b627ed8fd
1 changed files with 7 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/honu/xml.rkt
View File

@ -2,15 +2,14 @@
(require honu/core/api (require honu/core/api
racket/match racket/match
(only-in honu [/ honu-/]) (only-in honu [/ honu-/]
[< honu-<]
[> honu->])
(for-syntax syntax/parse (for-syntax syntax/parse
racket/base)) racket/base))
(provide xml (provide xml
xml->string xml->string)
< >)
(define-literal < >)
(struct xml:object (tag elements)) (struct xml:object (tag elements))
@ -34,17 +33,17 @@
(define-honu-syntax xml (define-honu-syntax xml
(lambda (code) (lambda (code)
(define-literal-set xml-literals (< > honu-/)) (define-literal-set xml-literals (honu-< honu-> honu-/))
(define-splicing-syntax-class non-xml-id #:literal-sets (xml-literals) (define-splicing-syntax-class non-xml-id #:literal-sets (xml-literals)
[pattern (~and (~not <) x:id) #:with q (begin (debug "non xml id ~a\n" #'x) #'x)] [pattern (~and (~not honu-<) x:id) #:with q (begin (debug "non xml id ~a\n" #'x) #'x)]
[pattern x #:with q #'0 #:when (begin (debug "not an xml id ~a\n" #'x) #f)] [pattern x #:with q #'0 #:when (begin (debug "not an xml id ~a\n" #'x) #f)]
) )
(define-splicing-syntax-class node (define-splicing-syntax-class node
#:literal-sets (xml-literals) #:literal-sets (xml-literals)
[pattern x #:with result #'0 #:when (begin (debug "xml node ~a\n" #'x) #f)] [pattern x #:with result #'0 #:when (begin (debug "xml node ~a\n" #'x) #f)]
[pattern (~seq < start:id > more:node ... < honu-/ end:id >) [pattern (~seq honu-< start:id honu-> more:node ... honu-< honu-/ end:id honu->)
#:with result (racket-syntax (make-xml 'start more.result ...))] #:with result (racket-syntax (make-xml 'start more.result ...))]
[pattern body:honu-body #:with result #'body.result] [pattern body:honu-body #:with result #'body.result]
[pattern (~seq plain:non-xml-id plain*:non-xml-id ...) #:with result #''(plain plain* ...)] [pattern (~seq plain:non-xml-id plain*:non-xml-id ...) #:with result #''(plain plain* ...)]