From 8eb9b32220cd0706b9c0b9b95215242d67a51c9c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 13 Jun 2018 18:32:50 -0700 Subject: [PATCH] propagate hide state into subpatterns --- brag/examples/cutter-another.rkt | 9 +++ brag/rules/parser.rkt | 50 ++++++------ brag/rules/rule-structs.rkt | 10 +-- brag/rules/stx.rkt | 61 ++++++--------- brag/test/test-all.rkt | 13 ++-- brag/test/test-cutter-another.rkt | 12 +++ brag/test/test-parser.rkt | 122 +++++++++++++++++++----------- 7 files changed, 159 insertions(+), 118 deletions(-) create mode 100755 brag/examples/cutter-another.rkt create mode 100755 brag/test/test-cutter-another.rkt diff --git a/brag/examples/cutter-another.rkt b/brag/examples/cutter-another.rkt new file mode 100755 index 0000000..3e21b1c --- /dev/null +++ b/brag/examples/cutter-another.rkt @@ -0,0 +1,9 @@ +#lang brag +top : w | x | y | z | a | b | c +w : /"w" ; atom + x : /("x") ; seq + y : /("y" "y") ; seq + z : /("w" | "z") ; choice + a : /["a"] ; opt + b : /(["b"] "b") ; opt in seq + c : /"c"+ ; repeat \ No newline at end of file diff --git a/brag/rules/parser.rkt b/brag/rules/parser.rkt index 45facf1..e074491 100755 --- a/brag/rules/parser.rkt +++ b/brag/rules/parser.rkt @@ -38,7 +38,6 @@ [struct-out pattern-token] [struct-out pattern-choice] [struct-out pattern-repeat] - [struct-out pattern-maybe] [struct-out pattern-seq]) (define-tokens tokens (LPAREN @@ -133,10 +132,12 @@ (if (pattern-choice? $3) (pattern-choice (position->pos $1-start-pos) (position->pos $3-end-pos) - (cons $1 (pattern-choice-vals $3))) + (cons $1 (pattern-choice-vals $3)) + #f) (pattern-choice (position->pos $1-start-pos) (position->pos $3-end-pos) - (list $1 $3)))] + (list $1 $3) + #f))] [(implicit-pattern-sequence) $1]] @@ -145,10 +146,12 @@ (if (pattern-seq? $2) (pattern-seq (position->pos $1-start-pos) (position->pos $2-end-pos) - (cons $1 (pattern-seq-vals $2))) + (cons $1 (pattern-seq-vals $2)) + #f) (pattern-seq (position->pos $1-start-pos) (position->pos $2-end-pos) - (list $1 $2)))] + (list $1 $2) + #f))] [(repeatable-pattern) $1]] @@ -162,17 +165,17 @@ [(regexp-match #px"^\\{(\\d+)?(,)?(\\d+)?\\}$" $2) ; "{min,max}" with both min & max optional => (λ (m) (match m - [(list all min range? max) (let () - (define min (or (string->number min) 0)) - (define max (cond - [(and range? max) (string->number max)] - [(and (not range?) (not max)) min] ; {3} -> {3,3} - [else #f])) + [(list all min range? max) (let* ([min (if min (string->number min) 0)] + [max (cond + [(and range? max) (string->number max)] + [(and (not range?) (not max)) min] ; {3} -> {3,3} + [else #f])]) (cons min max))]))] - [else (raise-argument-error 'grammar-parse "unknown repetition operator ~e" $2)])) + [else (raise-argument-error 'grammar-parse "unknown repetition operator" $2)])) (pattern-repeat (position->pos $1-start-pos) (position->pos $2-end-pos) - min-repeat max-repeat $1))] + min-repeat max-repeat $1 + #f))] [(atomic-pattern) $1]] @@ -195,9 +198,10 @@ #f))] [(LBRACKET pattern RBRACKET) - (pattern-maybe (position->pos $1-start-pos) - (position->pos $3-end-pos) - $2)] + (pattern-repeat (position->pos $1-start-pos) + (position->pos $3-end-pos) + 0 1 $2 + #f)] [(LPAREN pattern RPAREN) (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))] @@ -229,14 +233,12 @@ (pattern-token start-pos end-pos v (or hide? h))] [(pattern-lit _ _ v h) (pattern-lit start-pos end-pos v (or hide? h))] - [(pattern-choice _ _ vs) - (pattern-choice start-pos end-pos vs)] - [(pattern-repeat _ _ min max v) - (pattern-repeat start-pos end-pos min max v)] - [(pattern-maybe _ _ v) - (pattern-maybe start-pos end-pos v)] - [(pattern-seq _ _ vs) - (pattern-seq start-pos end-pos vs)] + [(pattern-choice _ _ vs h) + (pattern-choice start-pos end-pos vs (or hide? h))] + [(pattern-repeat _ _ min max v h) + (pattern-repeat start-pos end-pos min max v (or hide? h))] + [(pattern-seq _ _ vs h) + (pattern-seq start-pos end-pos vs (or hide? h))] [else (error 'relocate-pattern "Internal error when relocating ~s\n" a-pat)])) diff --git a/brag/rules/rule-structs.rkt b/brag/rules/rule-structs.rkt index 262de1b..1889db2 100755 --- a/brag/rules/rule-structs.rkt +++ b/brag/rules/rule-structs.rkt @@ -28,17 +28,15 @@ (struct pattern-lit pattern (val hide) #:transparent) -(struct pattern-choice pattern (vals) +(struct pattern-choice pattern (vals hide) #:transparent) (struct pattern-repeat pattern (min max - val) + val + hide) #:transparent) -(struct pattern-maybe pattern (val) - #:transparent) - -(struct pattern-seq pattern (vals) +(struct pattern-seq pattern (vals hide) #:transparent) diff --git a/brag/rules/stx.rkt b/brag/rules/stx.rkt index 9d5f5dd..da57217 100755 --- a/brag/rules/stx.rkt +++ b/brag/rules/stx.rkt @@ -47,42 +47,29 @@ `(rule ,id-stx ,pattern-stx) (list source line column position span))) + (define (pattern->stx source a-pattern) - (define recur (lambda (s) (pattern->stx source s))) - (define line (pos-line (pattern-start a-pattern))) - (define column (pos-col (pattern-start a-pattern))) - (define position (pos-offset (pattern-start a-pattern))) - (define span (if (and (number? (pos-offset (pattern-start a-pattern))) - (number? (pos-offset (pattern-end a-pattern)))) - (- (pos-offset (pattern-end a-pattern)) - (pos-offset (pattern-start a-pattern))) - #f)) - (define source-location (list source line column position span)) - (match a-pattern - [(struct pattern-id (start end val hide)) - (syntax-property - (datum->syntax #f - `(id ,(datum->syntax #f (string->symbol val) source-location)) - source-location) - 'hide hide)] - [(struct pattern-lit (start end val hide)) - (syntax-property - (datum->syntax #f - `(lit ,(datum->syntax #f val source-location)) - source-location) - 'hide hide)] - [(struct pattern-token (start end val hide)) - (syntax-property - (datum->syntax #f - `(token ,(datum->syntax #f (string->symbol val) source-location)) - source-location) - 'hide hide)] - [(struct pattern-choice (start end vals)) - (datum->syntax #f`(choice ,@(map recur vals)) source-location)] - [(struct pattern-repeat (start end min max val)) - (datum->syntax #f`(repeat ,min ,max ,(recur val)) source-location)] - [(struct pattern-maybe (start end val)) - (datum->syntax #f`(maybe ,(recur val)) source-location)] - [(struct pattern-seq (start end vals)) - (datum->syntax #f`(seq ,@(map recur vals)) source-location)])) + (define (pat->srcloc source pat) + (match-define (pos offset line col) (pattern-start pat)) + (define offset-end (pos-offset (pattern-end pat))) + (define span (and (number? offset) (number? offset-end) (- offset-end offset))) + (list source line col offset span)) + + (let loop ([a-pattern a-pattern] [hide-state #f]) + (define (pat->stx val) (datum->syntax #f val (pat->srcloc source a-pattern))) + (define-values (pat hide) + (match a-pattern + [(struct pattern-id (start end val hide)) (values `(id ,(pat->stx (string->symbol val))) hide)] + [(struct pattern-lit (start end val hide)) (values `(lit ,(pat->stx val)) hide)] + [(struct pattern-token (start end val hide)) (values `(token ,(pat->stx (string->symbol val))) hide)] + ;; propagate hide value of choice, repeat, and seq into subpatterns + ;; use `(or hide-state hide)` to capture parent value + [(struct pattern-choice (start end vals hide)) + (values `(choice ,@(map (λ (val) (loop val (or hide-state hide))) vals)) hide)] + [(struct pattern-repeat (start end min max val hide)) + (values `(repeat ,min ,max ,(loop val (or hide-state hide))) hide)] + [(struct pattern-seq (start end vals hide)) + (values `(seq ,@(map (λ (val) (loop val (or hide-state hide))) vals)) hide)])) + + (syntax-property (pat->stx pat) 'hide (or hide-state hide)))) diff --git a/brag/test/test-all.rkt b/brag/test/test-all.rkt index 92c3153..43b37d2 100755 --- a/brag/test/test-all.rkt +++ b/brag/test/test-all.rkt @@ -4,15 +4,18 @@ (require "test-0n1.rkt" "test-0n1n.rkt" "test-01-equal.rkt" - "test-simple-arithmetic-grammar.rkt" "test-baby-json.rkt" "test-baby-json-hider.rkt" - "test-wordy.rkt" - "test-simple-line-drawing.rkt" + "test-curly-quantifier.rkt" + "test-cutter.rkt" + "test-errors.rkt" "test-flatten.rkt" "test-lexer.rkt" - "test-parser.rkt" - "test-errors.rkt" "test-old-token.rkt" + "test-parser.rkt" + "test-simple-arithmetic-grammar.rkt" + "test-simple-line-drawing.rkt" "test-weird-grammar.rkt" + "test-whitespace.rkt" + "test-wordy.rkt" (submod brag/codegen/satisfaction test)) diff --git a/brag/test/test-cutter-another.rkt b/brag/test/test-cutter-another.rkt new file mode 100755 index 0000000..db5bffd --- /dev/null +++ b/brag/test/test-cutter-another.rkt @@ -0,0 +1,12 @@ +#lang racket/base +(require brag/examples/cutter-another + brag/support + rackunit) + +(check-equal? (parse-tree "w") '(top (w))) +(check-equal? (parse-tree "x") '(top (x))) +(check-equal? (parse-tree "yy") '(top (y))) +(check-equal? (parse-tree "z") '(top (z))) +(check-equal? (parse-tree "a") '(top (a))) +(check-equal? (parse-tree "bb") '(top (b))) +(check-equal? (parse-tree "c") '(top (c))) \ No newline at end of file diff --git a/brag/test/test-parser.rkt b/brag/test/test-parser.rkt index 0038b5f..3b0d588 100755 --- a/brag/test/test-parser.rkt +++ b/brag/test/test-parser.rkt @@ -39,99 +39,123 @@ (list (rule (p 1) (p 20) (lhs-id (p 1) (p 5) "expr" #f) (pattern-seq (p 8) (p 20) - (list - (pattern-token (p 8) (p 14) "COLON" 'hide) - (pattern-token (p 15) (p 20) "COLON" #f)))))) + (list + (pattern-token (p 8) (p 14) "COLON" 'hide) + (pattern-token (p 15) (p 20) "COLON" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON"))) (list (rule (p 1) (p 20) (lhs-id (p 1) (p 5) "expr" #f) (pattern-seq (p 8) (p 20) - (list - (pattern-id (p 8) (p 14) "thing" 'hide) - (pattern-token (p 15) (p 20) "COLON" #f)))))) + (list + (pattern-id (p 8) (p 14) "thing" 'hide) + (pattern-token (p 15) (p 20) "COLON" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON"))) (list (rule (p 1) (p 20) (lhs-id (p 1) (p 5) "expr" #f) (pattern-seq (p 8) (p 20) - (list - (pattern-id (p 8) (p 14) "thing" 'splice) - (pattern-token (p 15) (p 20) "COLON" #f)))))) + (list + (pattern-id (p 8) (p 14) "thing" 'splice) + (pattern-token (p 15) (p 20) "COLON" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*"))) (list (rule (p 1) (p 16) (lhs-id (p 1) (p 5) "expr" #f) (pattern-repeat (p 8) (p 16) - 0 #f - (pattern-lit (p 8) (p 15) "hello" #f))))) + 0 #f + (pattern-lit (p 8) (p 15) "hello" #f) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+"))) (list (rule (p 1) (p 16) (lhs-id (p 1) (p 5) "expr" #f) (pattern-repeat (p 8) (p 16) - 1 #f - (pattern-lit (p 8) (p 15) "hello" #f))))) + 1 #f + (pattern-lit (p 8) (p 15) "hello" #f) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']"))) (list (rule (p 1) (p 18) (lhs-id (p 1) (p 5) "expr" #f) - (pattern-maybe (p 8) (p 18) - (pattern-lit (p 9) (p 17) "hello" 'hide))))) + #;(pattern-maybe (p 8) (p 18) + (pattern-lit (p 9) (p 17) "hello" 'hide)) + (pattern-repeat (p 8) (p 18) + 0 1 + (pattern-lit (p 9) (p 17) "hello" 'hide) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH"))) (list (rule (p 1) (p 20) (lhs-id (p 1) (p 5) "expr" #f) (pattern-choice (p 8) (p 20) - (list (pattern-token (p 8) (p 13) "COLON" #f) - (pattern-token (p 16) (p 20) "BLAH" #f)))))) + (list (pattern-token (p 8) (p 13) "COLON" #f) + (pattern-token (p 16) (p 20) "BLAH" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr"))) (list (rule (p 1) (p 31) (lhs-id (p 1) (p 5) "expr" #f) (pattern-choice (p 8) (p 31) - (list (pattern-token (p 8) (p 13) "COLON" #f) - (pattern-token (p 16) (p 20) "BLAH" #f) - (pattern-seq (p 23) (p 31) - (list (pattern-token (p 23) (p 26) "BAZ" #f) - (pattern-id (p 27) (p 31) "expr" #f)))))))) + (list (pattern-token (p 8) (p 13) "COLON" #f) + (pattern-token (p 16) (p 20) "BLAH" #f) + (pattern-seq (p 23) (p 31) + (list (pattern-token (p 23) (p 26) "BAZ" #f) + (pattern-id (p 27) (p 31) "expr" #f)) + #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three"))) (list (rule (p 1) (p 22) (lhs-id (p 1) (p 5) "expr" #f) - (pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one" #f) - (pattern-id (p 12) (p 15) "two" #f) - (pattern-id (p 16) (p 22) "three" 'hide)))))) + (pattern-seq (p 8) (p 22) + (list (pattern-id (p 8) (p 11) "one" #f) + (pattern-id (p 12) (p 15) "two" #f) + (pattern-id (p 16) (p 22) "three" 'hide)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)"))) (list (rule (p 1) (p 23) (lhs-id (p 1) (p 5) "expr" #f) - (pattern-seq (p 8) (p 23) (list (pattern-id (p 9) (p 12) "one" #f) - (pattern-id (p 13) (p 16) "two" #f) - (pattern-id (p 17) (p 22) "three" #f)))))) + (pattern-seq (p 8) (p 23) + (list (pattern-id (p 9) (p 12) "one" #f) + (pattern-id (p 13) (p 16) "two" #f) + (pattern-id (p 17) (p 22) "three" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three"))) (list (rule (p 1) (p 22) (lhs-id (p 1) (p 5) "expr" #f) - (pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one" #f) - (pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f)) - (pattern-id (p 17) (p 22) "three" #f)))))) + (pattern-seq (p 8) (p 22) + (list (pattern-id (p 8) (p 11) "one" #f) + (pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f) #f) + (pattern-id (p 17) (p 22) "three" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three"))) (list (rule (p 1) (p 22) (lhs-id (p 1) (p 5) "expr" #f) - (pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one" #f) - (pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f)) - (pattern-id (p 17) (p 22) "three" #f)))))) + (pattern-seq (p 8) (p 22) + (list (pattern-id (p 8) (p 11) "one" #f) + (pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f) #f) + (pattern-id (p 17) (p 22) "three" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three"))) (list (rule (p 1) (p 24) (lhs-id (p 1) (p 5) "expr" #f) - (pattern-seq (p 8) (p 24) (list (pattern-repeat (p 8) (p 18) 1 #f - (pattern-seq (p 8) (p 17) - (list (pattern-id (p 9) (p 12) "one" #f) - (pattern-id (p 13) (p 16) "two" #f)))) - (pattern-id (p 19) (p 24) "three" #f)))))) + (pattern-seq (p 8) (p 24) + (list (pattern-repeat (p 8) (p 18) 1 #f + (pattern-seq (p 8) (p 17) + (list (pattern-id (p 9) (p 12) "one" #f) + (pattern-id (p 13) (p 16) "two" #f)) + #f) + #f) + (pattern-id (p 19) (p 24) "three" #f)) + #f)))) (check-equal? (grammar-parser (tokenize (open-input-string #<