add @ prefix for splicing

pull/2/head
Matthew Butterick 9 years ago
parent f312677216
commit c985805703

@ -230,13 +230,13 @@
[$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 ;; move 'hide-or-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 ...)
(rule-components->syntax '#,rule-name/false translated-action ... (rule-components->syntax '#,rule-name/false translated-action ...
#:srcloc #,whole-rule-loc #:srcloc #,whole-rule-loc
#:splice? #,(syntax-property rule-name/false 'splice))])) #:hide-or-splice? #,(syntax-property rule-name/false 'hide-or-splice))]))

@ -158,17 +158,19 @@ This would be the place to check a syntax property for hiding.
(datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property)) (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property))
(define splice-signal '@)
;; rule-components->syntax: (U symbol false) (listof stx) ... #:srcloc (U #f (list src line column offset span)) -> stx ;; rule-components->syntax: (U symbol false) (listof stx) ... #:srcloc (U #f (list src line column offset span)) -> stx
;; 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] #:hide-or-splice? [hide-or-splice #f] . componentss)
(let ([spliced-componentss (append-map (λ(cs) (let ([spliced-componentss (append-map (λ(cs)
(if (and (pair? cs) (syntax-property (car cs) 'splice)) (cond
(list (list (syntax-case (car cs) () [(and (pair? cs) (equal? (syntax-property (car cs) 'hide-or-splice) "hide"))
[(rule-name c ...) (list (list (syntax-case (car cs) ()
#'(c ...)]))) [(rule-name c ...)
(list cs))) componentss)]) #'(c ...)])))]
[(and (pair? cs) (equal? (syntax-property (car cs) 'hide-or-splice) "splice"))
(list (cdr (syntax->list (car cs))))]
[else (list cs)])) componentss)])
(syntax-property (syntax-property
(datum->syntax #f (datum->syntax #f
(cons (cons
@ -176,4 +178,4 @@ This would be the place to check a syntax property for hiding.
(apply append spliced-componentss)) (apply append spliced-componentss))
srcloc srcloc
stx-with-original?-property) stx-with-original?-property)
'splice splice))) 'hide-or-splice hide-or-splice)))

@ -13,4 +13,4 @@ array: "[" [json ("," json)*] "]"
object: !"{" [kvpair ("," kvpair)*] !"}" object: !"{" [kvpair ("," kvpair)*] !"}"
!kvpair : !ID ":" !json @kvpair : !ID ":" !json

@ -63,6 +63,8 @@
(token-RULE_HEAD lexeme)] (token-RULE_HEAD lexeme)]
[(:: "!" id (:* whitespace) ":") [(:: "!" id (:* whitespace) ":")
(token-RULE_HEAD_HIDDEN lexeme)] (token-RULE_HEAD_HIDDEN lexeme)]
[(:: "@" id (:* whitespace) ":")
(token-RULE_HEAD_SPLICED lexeme)]
[id [id
(token-ID lexeme)] (token-ID lexeme)]

@ -18,6 +18,7 @@
token-REPEAT token-REPEAT
token-RULE_HEAD token-RULE_HEAD
token-RULE_HEAD_HIDDEN token-RULE_HEAD_HIDDEN
token-RULE_HEAD_SPLICED
token-ID token-ID
token-LIT token-LIT
token-EOF token-EOF
@ -47,6 +48,7 @@
REPEAT REPEAT
RULE_HEAD RULE_HEAD
RULE_HEAD_HIDDEN RULE_HEAD_HIDDEN
RULE_HEAD_SPLICED
ID ID
LIT LIT
EOF)) EOF))
@ -88,7 +90,7 @@
#f) #f)
$2))] $2))]
;; bang indicates hiding. set hide value to #t ;; bang indicates hiding. set hide value to "hide"
[(RULE_HEAD_HIDDEN pattern) [(RULE_HEAD_HIDDEN pattern)
(begin (begin
(define trimmed (cadr (regexp-match #px"!(\\S+)\\s*:$" $1))) (define trimmed (cadr (regexp-match #px"!(\\S+)\\s*:$" $1)))
@ -100,7 +102,22 @@
(position-line $1-start-pos) (position-line $1-start-pos)
(position-col $1-start-pos)) (position-col $1-start-pos))
trimmed trimmed
#t) "hide") ; symbols won't work for these signals
$2))]
;; atsign indicates splicing. set hide value to "splice"
[(RULE_HEAD_SPLICED pattern)
(begin
(define trimmed (cadr (regexp-match #px"@(\\S+)\\s*:$" $1)))
(rule (position->pos $1-start-pos)
(position->pos $2-end-pos)
(lhs-id (position->pos $1-start-pos)
(pos (+ (position-offset $1-start-pos)
(string-length trimmed))
(position-line $1-start-pos)
(position-col $1-start-pos))
trimmed
"splice")
$2))]] $2))]]
[pattern [pattern

@ -33,7 +33,7 @@
(- (pos-offset (lhs-id-end (rule-lhs a-rule))) (- (pos-offset (lhs-id-end (rule-lhs a-rule)))
(pos-offset (lhs-id-start (rule-lhs a-rule)))) (pos-offset (lhs-id-start (rule-lhs a-rule))))
#f))) #f)))
'splice (lhs-id-splice (rule-lhs a-rule)))) 'hide-or-splice (lhs-id-splice (rule-lhs a-rule))))
(define pattern-stx (pattern->stx source (rule-pattern a-rule))) (define pattern-stx (pattern->stx source (rule-pattern a-rule)))
(define line (pos-line (rule-start a-rule))) (define line (pos-line (rule-start a-rule)))
(define column (pos-col (rule-start a-rule))) (define column (pos-col (rule-start a-rule)))

@ -10,7 +10,7 @@
":" ":"
(token 'STRING "'hello world'") (token 'STRING "'hello world'")
"}"))) "}")))
'(json (object (":")))) '(json (object ":")))
(check-equal? (check-equal?

Loading…
Cancel
Save