From 12a04bbc6a94c6c5c3c9d005956b01524ac75a4b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 4 May 2016 15:54:42 -0700 Subject: [PATCH] elider brackets work like sequence parens ; tests pass --- .../br/ragg/codegen/codegen.rkt | 38 +++++++++---------- .../br/ragg/elider/test-json-elider.rkt | 2 +- .../br/ragg/examples/bnf.rkt | 11 +++++- .../br/ragg/rules/parser.rkt | 8 ++-- .../br/ragg/rules/rule-structs.rkt | 6 +-- .../br/ragg/rules/stx-types.rkt | 4 +- beautiful-racket-ragg/br/ragg/rules/stx.rkt | 6 +-- 7 files changed, 42 insertions(+), 33 deletions(-) diff --git a/beautiful-racket-ragg/br/ragg/codegen/codegen.rkt b/beautiful-racket-ragg/br/ragg/codegen/codegen.rkt index bd46d8c..6e8050d 100755 --- a/beautiful-racket-ragg/br/ragg/codegen/codegen.rkt +++ b/beautiful-racket-ragg/br/ragg/codegen/codegen.rkt @@ -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 ...)))]) diff --git a/beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt b/beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt index 1282b60..e7ed704 100755 --- a/beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt +++ b/beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt @@ -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 #\{ #\})) #\])) #\])) #\]))) diff --git a/beautiful-racket-ragg/br/ragg/examples/bnf.rkt b/beautiful-racket-ragg/br/ragg/examples/bnf.rkt index e59f9aa..ea8bb8b 100755 --- a/beautiful-racket-ragg/br/ragg/examples/bnf.rkt +++ b/beautiful-racket-ragg/br/ragg/examples/bnf.rkt @@ -1,4 +1,11 @@ -#lang br/ragg +#lang racket/base + +#| +This grammar is permanently broken with the operator active. +|# + + +#| ## The following comes from: http://en.wikipedia.org/wiki/Backus%E2%80%93Naur_Form @@ -12,3 +19,5 @@ : | : | "<" ">" : '"' '"' | "'" "'" ## actually, the original BNF did not use quotes + +|# \ No newline at end of file diff --git a/beautiful-racket-ragg/br/ragg/rules/parser.rkt b/beautiful-racket-ragg/br/ragg/rules/parser.rkt index 59c78eb..543fce1 100755 --- a/beautiful-racket-ragg/br/ragg/rules/parser.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/parser.rkt @@ -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)])) diff --git a/beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt b/beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt index 1abe2db..cfc7334 100755 --- a/beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt @@ -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) + diff --git a/beautiful-racket-ragg/br/ragg/rules/stx-types.rkt b/beautiful-racket-ragg/br/ragg/rules/stx-types.rkt index 1072e08..3c33a39 100755 --- a/beautiful-racket-ragg/br/ragg/rules/stx-types.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/stx-types.rkt @@ -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)) \ No newline at end of file +(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)) \ No newline at end of file diff --git a/beautiful-racket-ragg/br/ragg/rules/stx.rkt b/beautiful-racket-ragg/br/ragg/rules/stx.rkt index e967475..caefdb5 100755 --- a/beautiful-racket-ragg/br/ragg/rules/stx.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/stx.rkt @@ -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))