elider brackets work like sequence parens ; tests pass

dev-elider
Matthew Butterick 9 years ago
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…
Cancel
Save