elider brackets work like sequence parens ; tests pass
This commit is contained in:
parent
e4a3255f6c
commit
12a04bbc6a
|
@ -260,7 +260,7 @@
|
|||
(let loop ([a-pattern a-pattern]
|
||||
[implicit implicit]
|
||||
[explicit explicit])
|
||||
(syntax-case a-pattern (id lit token choice elide repeat maybe seq)
|
||||
(syntax-case a-pattern (id lit token choice repeat maybe seq elide)
|
||||
[(id val)
|
||||
(values implicit explicit)]
|
||||
[(lit val)
|
||||
|
@ -275,16 +275,16 @@
|
|||
[explicit explicit])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v implicit explicit))]
|
||||
[(elide vals ...)
|
||||
(for/fold ([implicit implicit]
|
||||
[explicit explicit])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v implicit explicit))]
|
||||
[(repeat min val)
|
||||
(loop #'val implicit explicit)]
|
||||
[(maybe val)
|
||||
(loop #'val implicit explicit)]
|
||||
[(seq vals ...)
|
||||
(for/fold ([implicit implicit]
|
||||
[explicit explicit])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v implicit explicit))]
|
||||
[(elide vals ...)
|
||||
(for/fold ([implicit implicit]
|
||||
[explicit explicit])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
|
@ -347,7 +347,7 @@
|
|||
(define (pattern-collect-used-ids a-pattern acc)
|
||||
(let loop ([a-pattern a-pattern]
|
||||
[acc acc])
|
||||
(syntax-case a-pattern (id lit token choice elide repeat maybe seq)
|
||||
(syntax-case a-pattern (id lit token choice repeat maybe seq elide)
|
||||
[(id val)
|
||||
(cons #'val acc)]
|
||||
[(lit val)
|
||||
|
@ -358,15 +358,15 @@
|
|||
(for/fold ([acc acc])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v acc))]
|
||||
[(elide vals ...)
|
||||
(for/fold ([acc acc])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v acc))]
|
||||
[(repeat min val)
|
||||
(loop #'val acc)]
|
||||
[(maybe val)
|
||||
(loop #'val acc)]
|
||||
[(seq vals ...)
|
||||
(for/fold ([acc acc])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v acc))]
|
||||
[(elide vals ...)
|
||||
(for/fold ([acc acc])
|
||||
([v (in-list (syntax->list #'(vals ...)))])
|
||||
(loop v acc))])))
|
||||
|
@ -394,7 +394,7 @@
|
|||
a-leaf)
|
||||
|
||||
(define (process-pattern a-pattern)
|
||||
(syntax-case a-pattern (id lit token choice elide repeat maybe seq)
|
||||
(syntax-case a-pattern (id lit token choice repeat maybe seq elide)
|
||||
[(id val)
|
||||
(free-id-table-ref toplevel-rule-table #'val)]
|
||||
[(lit val)
|
||||
|
@ -408,13 +408,6 @@
|
|||
(define a-child (process-pattern v))
|
||||
(sat:add-child! an-or-node a-child))
|
||||
an-or-node)]
|
||||
[(elide vals ...)
|
||||
(begin
|
||||
(define an-or-node (sat:make-or))
|
||||
(for ([v (in-list (syntax->list #'(vals ...)))])
|
||||
(define a-child (process-pattern v))
|
||||
(sat:add-child! an-or-node a-child))
|
||||
an-or-node)]
|
||||
[(repeat min val)
|
||||
(syntax-case #'min ()
|
||||
[0
|
||||
|
@ -424,6 +417,13 @@
|
|||
[(maybe val)
|
||||
(make-leaf)]
|
||||
[(seq vals ...)
|
||||
(begin
|
||||
(define an-and-node (sat:make-and))
|
||||
(for ([v (in-list (syntax->list #'(vals ...)))])
|
||||
(define a-child (process-pattern v))
|
||||
(sat:add-child! an-and-node a-child))
|
||||
an-and-node)]
|
||||
[(elide vals ...)
|
||||
(begin
|
||||
(define an-and-node (sat:make-and))
|
||||
(for ([v (in-list (syntax->list #'(vals ...)))])
|
||||
|
|
|
@ -15,7 +15,7 @@
|
|||
"}")))
|
||||
|
||||
|
||||
#;(check-equal?
|
||||
(check-equal?
|
||||
(syntax->datum
|
||||
(parse "[[[{}]],[],[[{}]]]"))
|
||||
'(json (array #\[ (json (array #\[ (json (array #\[ (json (object #\{ #\})) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json (object #\{ #\})) #\])) #\])) #\])))
|
||||
|
|
|
@ -1,4 +1,11 @@
|
|||
#lang br/ragg
|
||||
#lang racket/base
|
||||
|
||||
#|
|
||||
This grammar is permanently broken with the <elider> operator active.
|
||||
|#
|
||||
|
||||
|
||||
#|
|
||||
|
||||
|
||||
## The following comes from: http://en.wikipedia.org/wiki/Backus%E2%80%93Naur_Form
|
||||
|
@ -12,3 +19,5 @@
|
|||
<list> : <term> | <term> <opt-whitespace> <list>
|
||||
<term> : <literal> | "<" <RULE-NAME> ">"
|
||||
<literal> : '"' <TEXT> '"' | "'" <TEXT> "'" ## actually, the original BNF did not use quotes
|
||||
|
||||
|#
|
|
@ -32,10 +32,10 @@
|
|||
[struct-out pattern-lit]
|
||||
[struct-out pattern-token]
|
||||
[struct-out pattern-choice]
|
||||
[struct-out pattern-elide]
|
||||
[struct-out pattern-repeat]
|
||||
[struct-out pattern-maybe]
|
||||
[struct-out pattern-seq])
|
||||
[struct-out pattern-seq]
|
||||
[struct-out pattern-elide])
|
||||
|
||||
(define-tokens tokens (LPAREN
|
||||
RPAREN
|
||||
|
@ -168,14 +168,14 @@
|
|||
(pattern-lit start-pos end-pos v)]
|
||||
[(pattern-choice _ _ vs)
|
||||
(pattern-choice start-pos end-pos vs)]
|
||||
[(pattern-elide _ _ vs)
|
||||
(pattern-elide start-pos end-pos vs)]
|
||||
[(pattern-repeat _ _ m v)
|
||||
(pattern-repeat start-pos end-pos m v)]
|
||||
[(pattern-maybe _ _ v)
|
||||
(pattern-maybe start-pos end-pos v)]
|
||||
[(pattern-seq _ _ vs)
|
||||
(pattern-seq start-pos end-pos vs)]
|
||||
[(pattern-elide _ _ vs)
|
||||
(pattern-elide start-pos end-pos vs)]
|
||||
[else
|
||||
(error 'relocate-pattern "Internal error when relocating ~s\n" a-pat)]))
|
||||
|
||||
|
|
|
@ -35,9 +35,6 @@
|
|||
(struct pattern-choice pattern (vals)
|
||||
#:transparent)
|
||||
|
||||
(struct pattern-elide pattern (val)
|
||||
#:transparent)
|
||||
|
||||
(struct pattern-repeat pattern (min ;; either 0 or 1
|
||||
val)
|
||||
#:transparent)
|
||||
|
@ -48,3 +45,6 @@
|
|||
(struct pattern-seq pattern (vals)
|
||||
#:transparent)
|
||||
|
||||
(struct pattern-elide pattern (vals)
|
||||
#:transparent)
|
||||
|
||||
|
|
|
@ -11,7 +11,7 @@
|
|||
(define (lit stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (token stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (choice stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (elide stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (repeat stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (maybe stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (seq stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (seq stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
||||
(define (elide stx) (raise-syntax-error #f "Used out of context of rules" stx))
|
|
@ -67,12 +67,12 @@
|
|||
`(token ,(datum->syntax #f (string->symbol val) source-location))]
|
||||
[(struct pattern-choice (start end vals))
|
||||
`(choice ,@(map recur vals))]
|
||||
[(struct pattern-elide (start end vals))
|
||||
`(elide ,@(map recur vals))]
|
||||
[(struct pattern-repeat (start end min val))
|
||||
`(repeat ,min ,(recur val))]
|
||||
[(struct pattern-maybe (start end val))
|
||||
`(maybe ,(recur val))]
|
||||
[(struct pattern-seq (start end vals))
|
||||
`(seq ,@(map recur vals))])
|
||||
`(seq ,@(map recur vals))]
|
||||
[(struct pattern-elide (start end vals))
|
||||
`(elide ,@(map recur vals))])
|
||||
source-location))
|
||||
|
|
Loading…
Reference in New Issue
Block a user