add @ prefix for splicing
This commit is contained in:
parent
f312677216
commit
c985805703
|
@ -230,13 +230,13 @@
|
|||
[$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
|
||||
;; move 'hide-or-splice property into function because name is datum-ized
|
||||
(with-syntax ([(translated-pattern ...) translated-patterns]
|
||||
[(translated-action ...) translated-actions])
|
||||
#`[(translated-pattern ...)
|
||||
(rule-components->syntax '#,rule-name/false translated-action ...
|
||||
#: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))
|
||||
|
||||
|
||||
(define splice-signal '@)
|
||||
;; 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.
|
||||
;; 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)
|
||||
(if (and (pair? cs) (syntax-property (car cs) 'splice))
|
||||
(list (list (syntax-case (car cs) ()
|
||||
[(rule-name c ...)
|
||||
#'(c ...)])))
|
||||
(list cs))) componentss)])
|
||||
(cond
|
||||
[(and (pair? cs) (equal? (syntax-property (car cs) 'hide-or-splice) "hide"))
|
||||
(list (list (syntax-case (car cs) ()
|
||||
[(rule-name c ...)
|
||||
#'(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
|
||||
(datum->syntax #f
|
||||
(cons
|
||||
|
@ -176,4 +178,4 @@ This would be the place to check a syntax property for hiding.
|
|||
(apply append spliced-componentss))
|
||||
srcloc
|
||||
stx-with-original?-property)
|
||||
'splice splice)))
|
||||
'hide-or-splice hide-or-splice)))
|
|
@ -13,4 +13,4 @@ array: "[" [json ("," json)*] "]"
|
|||
|
||||
object: !"{" [kvpair ("," kvpair)*] !"}"
|
||||
|
||||
!kvpair : !ID ":" !json
|
||||
@kvpair : !ID ":" !json
|
||||
|
|
|
@ -63,6 +63,8 @@
|
|||
(token-RULE_HEAD lexeme)]
|
||||
[(:: "!" id (:* whitespace) ":")
|
||||
(token-RULE_HEAD_HIDDEN lexeme)]
|
||||
[(:: "@" id (:* whitespace) ":")
|
||||
(token-RULE_HEAD_SPLICED lexeme)]
|
||||
[id
|
||||
(token-ID lexeme)]
|
||||
|
||||
|
|
|
@ -18,6 +18,7 @@
|
|||
token-REPEAT
|
||||
token-RULE_HEAD
|
||||
token-RULE_HEAD_HIDDEN
|
||||
token-RULE_HEAD_SPLICED
|
||||
token-ID
|
||||
token-LIT
|
||||
token-EOF
|
||||
|
@ -47,6 +48,7 @@
|
|||
REPEAT
|
||||
RULE_HEAD
|
||||
RULE_HEAD_HIDDEN
|
||||
RULE_HEAD_SPLICED
|
||||
ID
|
||||
LIT
|
||||
EOF))
|
||||
|
@ -88,7 +90,7 @@
|
|||
#f)
|
||||
$2))]
|
||||
|
||||
;; bang indicates hiding. set hide value to #t
|
||||
;; bang indicates hiding. set hide value to "hide"
|
||||
[(RULE_HEAD_HIDDEN pattern)
|
||||
(begin
|
||||
(define trimmed (cadr (regexp-match #px"!(\\S+)\\s*:$" $1)))
|
||||
|
@ -100,7 +102,22 @@
|
|||
(position-line $1-start-pos)
|
||||
(position-col $1-start-pos))
|
||||
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))]]
|
||||
|
||||
[pattern
|
||||
|
|
|
@ -33,7 +33,7 @@
|
|||
(- (pos-offset (lhs-id-end (rule-lhs a-rule)))
|
||||
(pos-offset (lhs-id-start (rule-lhs a-rule))))
|
||||
#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 line (pos-line (rule-start a-rule)))
|
||||
(define column (pos-col (rule-start a-rule)))
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
":"
|
||||
(token 'STRING "'hello world'")
|
||||
"}")))
|
||||
'(json (object (":"))))
|
||||
'(json (object ":")))
|
||||
|
||||
|
||||
(check-equal?
|
||||
|
|
Loading…
Reference in New Issue
Block a user