make hider/splicer tests

pull/2/head
Matthew Butterick 9 years ago
parent 992fccdb1d
commit 07350988e7

@ -247,7 +247,8 @@
(with-syntax ([$1-start-pos (datum->syntax (first translated-patterns) '$1-start-pos)] (with-syntax ([$1-start-pos (datum->syntax (first translated-patterns) '$1-start-pos)]
[$n-end-pos (format-id (last translated-patterns) "$~a-end-pos" (length translated-patterns))]) [$n-end-pos (format-id (last translated-patterns) "$~a-end-pos" (length translated-patterns))])
#`(positions->srcloc $1-start-pos $n-end-pos)))) #`(positions->srcloc $1-start-pos $n-end-pos))))
;; move 'splice property into function because name is datum-ized
(with-syntax ([(translated-pattern ...) translated-patterns] (with-syntax ([(translated-pattern ...) translated-patterns]
[(translated-action ...) translated-actions]) [(translated-action ...) translated-actions])
#`[(translated-pattern ...) #`[(translated-pattern ...)

@ -163,15 +163,15 @@ This would be the place to check a syntax property for hiding.
;; Creates an stx out of the rule name and its components. ;; Creates an stx out of the rule name and its components.
;; The location information of the rule spans that of its components. ;; The location information of the rule spans that of its components.
(define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:splice? [splice #f] . componentss) (define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:splice? [splice #f] . componentss)
(let ([componentss (append-map (λ(cs) (let ([spliced-componentss (append-map (λ(cs)
(if (and (pair? cs) (syntax-property (car cs) 'splice)) (if (and (pair? cs) (syntax-property (car cs) 'splice))
(list (cdr (syntax->list (car cs)))) (list (cdr (syntax->list (car cs)))) ; pop off the rule name and splice its components into this rule
(list cs))) componentss)]) (list cs))) componentss)])
(syntax-property (syntax-property
(datum->syntax #f (datum->syntax #f
(cons (cons
(datum->syntax #f rule-name/false srcloc stx-with-original?-property) (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
(apply append componentss)) (apply append spliced-componentss))
srcloc srcloc
stx-with-original?-property) stx-with-original?-property)
'splice splice))) 'splice splice)))

@ -1,4 +0,0 @@
#lang brag
thing : foo
foo : <"bar">

@ -1,9 +0,0 @@
#lang br
(require "json-elider-toy.rkt"
brag/support
rackunit)
(check-equal?
(syntax->datum
(parse (list "bar")))
'(thing))

@ -1,8 +1,7 @@
#lang brag #lang brag
;; Simple baby example of JSON structure ;; Simple baby example of JSON structure
json: number json: number | string
| string
| array | array
| object | object
@ -14,4 +13,4 @@ array: "[" [json ("," json)*] "]"
object: <"{"> [kvpair ("," kvpair)*] <"}"> object: <"{"> [kvpair ("," kvpair)*] <"}">
<kvpair> : <ID> ":" <json> <kvpair>: <ID> ":" <json>

@ -1,5 +1,5 @@
#lang br #lang racket/base
(require "json-elider.rkt" (require brag/examples/baby-json-hider
brag/support brag/support
rackunit) rackunit)
Loading…
Cancel
Save