make hider/splicer tests

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

@ -247,7 +247,8 @@
(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))])
#`(positions->srcloc $1-start-pos $n-end-pos))))
;; move 'splice property into function because name is datum-ized
(with-syntax ([(translated-pattern ...) translated-patterns]
[(translated-action ...) translated-actions])
#`[(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.
;; 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)
(let ([componentss (append-map (λ(cs)
(let ([spliced-componentss (append-map (λ(cs)
(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)])
(syntax-property
(datum->syntax #f
(cons
(datum->syntax #f rule-name/false srcloc stx-with-original?-property)
(apply append componentss))
(apply append spliced-componentss))
srcloc
stx-with-original?-property)
'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
;; Simple baby example of JSON structure
json: number
| string
json: number | string
| array
| object
@ -14,4 +13,4 @@ array: "[" [json ("," json)*] "]"
object: <"{"> [kvpair ("," kvpair)*] <"}">
<kvpair> : <ID> ":" <json>
<kvpair>: <ID> ":" <json>

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