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

[honu] add xml example

Browse Source
This commit is contained in:
Jon Rafkind 2012-10-08 14:43:17 -06:00
parent 20ec2356cb
commit a3e2c2fae6
3 changed files with 75 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/honu/core/api.rkt
View File

@ -10,4 +10,5 @@
define-literal
(for-syntax racket-syntax
honu-expression
honu-body
parse-all))

15
collects/tests/honu/xml.honu Normal file
View File

@ -0,0 +1,15 @@
#lang honu
require "xml.rkt";
// var x = xml <foo>hello world!!</foo>
// var x = xml <foo> </foo>
var x = xml <foo> tuna {var z = 9; 1 + z} </foo>
var y = xml <foo> <bar> {1 + 1} </bar> </foo>
xml_to_string(x)
xml_to_string(y)
xml_to_string(xml <html><body> hello world! <b>foo</b> <b>bar</b> </body></html>)
xml_to_string(xml <what>{"{hi}"}</what>)

59
collects/tests/honu/xml.rkt Normal file
View File

@ -0,0 +1,59 @@
#lang racket/base
(require honu/core/api
racket/match
(only-in honu [/ honu-/])
(for-syntax syntax/parse
racket/base))
(provide xml
xml->string
< >)
(define-literal < >)
(struct xml:object (tag elements))
(begin-for-syntax
(define (debug . x)
(void)
#;
(apply printf x)))
(define (xml->string xml)
(match xml
[(struct xml:object (tag elements))
(format "<~a>~a</~a>"
tag
(apply string-append (map xml->string elements))
tag)]
[else (format "~a" xml)]))
(define (make-xml name . stuff)
(xml:object name stuff))
(define-honu-syntax xml
(lambda (code)
(define-literal-set xml-literals (< > honu-/))
(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 x #:with q #'0 #:when (begin (debug "not an xml id ~a\n" #'x) #f)]
)
(define-splicing-syntax-class node
#:literal-sets (xml-literals)
[pattern x #:with result #'0 #:when (begin (debug "xml node ~a\n" #'x) #f)]
[pattern (~seq < start:id > more:node ... < honu-/ end:id >)
#:with result (racket-syntax (make-xml 'start more.result ...))]
[pattern body:honu-body #:with result #'body.result]
[pattern (~seq plain:non-xml-id plain*:non-xml-id ...) #:with result #''(plain plain* ...)]
[pattern x #:with result #'0 #:when (begin (debug "xml2 node ~a\n" #'x) #f)]
)
(debug "Parse xml ~a\n" code)
(syntax-parse code
[(_ node:node . rest)
(define out #'node.result)
(debug "Result ~a\n" out)
(values out #'rest #f)])))