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))])
|
[$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…
Reference in New Issue
Block a user