mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

propagate hide state into subpatterns

Browse Source
hide-top-rule-name
Matthew Butterick 7 years ago
parent ca0bf7feb6
commit 8eb9b32220
7 changed files with 159 additions and 118 deletions
Show Stats Download Patch File Download Diff File

9
brag/examples/cutter-another.rkt
Unescape Escape View File

@ -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

44
brag/rules/parser.rkt
Unescape Escape View File

@ -38,7 +38,6 @@
[struct-out pattern-token] [struct-out pattern-token]
[struct-out pattern-choice] [struct-out pattern-choice]
[struct-out pattern-repeat] [struct-out pattern-repeat]
[struct-out pattern-maybe]
[struct-out pattern-seq]) [struct-out pattern-seq])
(define-tokens tokens (LPAREN (define-tokens tokens (LPAREN
@ -133,10 +132,12 @@
(if (pattern-choice? $3) (if (pattern-choice? $3)
(pattern-choice (position->pos $1-start-pos) (pattern-choice (position->pos $1-start-pos)
(position->pos $3-end-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) (pattern-choice (position->pos $1-start-pos)
(position->pos $3-end-pos) (position->pos $3-end-pos)
(list $1 $3)))] (list $1 $3)
#f))]
[(implicit-pattern-sequence) [(implicit-pattern-sequence)
$1]] $1]]
@ -145,10 +146,12 @@
(if (pattern-seq? $2) (if (pattern-seq? $2)
(pattern-seq (position->pos $1-start-pos) (pattern-seq (position->pos $1-start-pos)
(position->pos $2-end-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) (pattern-seq (position->pos $1-start-pos)
(position->pos $2-end-pos) (position->pos $2-end-pos)
(list $1 $2)))] (list $1 $2)
#f))]
[(repeatable-pattern) [(repeatable-pattern)
$1]] $1]]
@ -162,17 +165,17 @@
[(regexp-match #px"^\\{(\\d+)?(,)?(\\d+)?\\}$" $2) ; "{min,max}" with both min & max optional [(regexp-match #px"^\\{(\\d+)?(,)?(\\d+)?\\}$" $2) ; "{min,max}" with both min & max optional
=> (λ (m) => (λ (m)
(match m (match m
[(list all min range? max) (let () [(list all min range? max) (let* ([min (if min (string->number min) 0)]
(define min (or (string->number min) 0)) [max (cond
(define max (cond
[(and range? max) (string->number max)] [(and range? max) (string->number max)]
[(and (not range?) (not max)) min] ; {3} -> {3,3} [(and (not range?) (not max)) min] ; {3} -> {3,3}
[else #f])) [else #f])])
(cons min max))]))] (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) (pattern-repeat (position->pos $1-start-pos)
(position->pos $2-end-pos) (position->pos $2-end-pos)
min-repeat max-repeat $1))] min-repeat max-repeat $1
#f))]
[(atomic-pattern) [(atomic-pattern)
$1]] $1]]
@ -195,9 +198,10 @@
#f))] #f))]
[(LBRACKET pattern RBRACKET) [(LBRACKET pattern RBRACKET)
(pattern-maybe (position->pos $1-start-pos) (pattern-repeat (position->pos $1-start-pos)
(position->pos $3-end-pos) (position->pos $3-end-pos)
$2)] 0 1 $2
#f)]
[(LPAREN pattern RPAREN) [(LPAREN pattern RPAREN)
(relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))] (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-token start-pos end-pos v (or hide? h))]
[(pattern-lit _ _ v h) [(pattern-lit _ _ v h)
(pattern-lit start-pos end-pos v (or hide? h))] (pattern-lit start-pos end-pos v (or hide? h))]
[(pattern-choice _ _ vs) [(pattern-choice _ _ vs h)
(pattern-choice start-pos end-pos vs)] (pattern-choice start-pos end-pos vs (or hide? h))]
[(pattern-repeat _ _ min max v) [(pattern-repeat _ _ min max v h)
(pattern-repeat start-pos end-pos min max v)] (pattern-repeat start-pos end-pos min max v (or hide? h))]
[(pattern-maybe _ _ v) [(pattern-seq _ _ vs h)
(pattern-maybe start-pos end-pos v)] (pattern-seq start-pos end-pos vs (or hide? h))]
[(pattern-seq _ _ vs)
(pattern-seq start-pos end-pos vs)]
[else [else
(error 'relocate-pattern "Internal error when relocating ~s\n" a-pat)])) (error 'relocate-pattern "Internal error when relocating ~s\n" a-pat)]))

10
brag/rules/rule-structs.rkt
Unescape Escape View File

@ -28,17 +28,15 @@
(struct pattern-lit pattern (val hide) (struct pattern-lit pattern (val hide)
#:transparent) #:transparent)
(struct pattern-choice pattern (vals) (struct pattern-choice pattern (vals hide)
#:transparent) #:transparent)
(struct pattern-repeat pattern (min (struct pattern-repeat pattern (min
max max
val) val
hide)
#:transparent) #:transparent)
(struct pattern-maybe pattern (val) (struct pattern-seq pattern (vals hide)
#:transparent)
(struct pattern-seq pattern (vals)
#:transparent) #:transparent)

59
brag/rules/stx.rkt
Unescape Escape View File

@ -47,42 +47,29 @@
`(rule ,id-stx ,pattern-stx) `(rule ,id-stx ,pattern-stx)
(list source line column position span))) (list source line column position span)))
(define (pattern->stx source a-pattern) (define (pattern->stx source a-pattern)
(define recur (lambda (s) (pattern->stx source s)))
(define line (pos-line (pattern-start a-pattern))) (define (pat->srcloc source pat)
(define column (pos-col (pattern-start a-pattern))) (match-define (pos offset line col) (pattern-start pat))
(define position (pos-offset (pattern-start a-pattern))) (define offset-end (pos-offset (pattern-end pat)))
(define span (if (and (number? (pos-offset (pattern-start a-pattern))) (define span (and (number? offset) (number? offset-end) (- offset-end offset)))
(number? (pos-offset (pattern-end a-pattern)))) (list source line col offset span))
(- (pos-offset (pattern-end a-pattern))
(pos-offset (pattern-start a-pattern))) (let loop ([a-pattern a-pattern] [hide-state #f])
#f)) (define (pat->stx val) (datum->syntax #f val (pat->srcloc source a-pattern)))
(define source-location (list source line column position span)) (define-values (pat hide)
(match a-pattern (match a-pattern
[(struct pattern-id (start end val hide)) [(struct pattern-id (start end val hide)) (values `(id ,(pat->stx (string->symbol val))) hide)]
(syntax-property [(struct pattern-lit (start end val hide)) (values `(lit ,(pat->stx val)) hide)]
(datum->syntax #f [(struct pattern-token (start end val hide)) (values `(token ,(pat->stx (string->symbol val))) hide)]
`(id ,(datum->syntax #f (string->symbol val) source-location)) ;; propagate hide value of choice, repeat, and seq into subpatterns
source-location) ;; use `(or hide-state hide)` to capture parent value
'hide hide)] [(struct pattern-choice (start end vals hide))
[(struct pattern-lit (start end val hide)) (values `(choice ,@(map (λ (val) (loop val (or hide-state hide))) vals)) hide)]
(syntax-property [(struct pattern-repeat (start end min max val hide))
(datum->syntax #f (values `(repeat ,min ,max ,(loop val (or hide-state hide))) hide)]
`(lit ,(datum->syntax #f val source-location)) [(struct pattern-seq (start end vals hide))
source-location) (values `(seq ,@(map (λ (val) (loop val (or hide-state hide))) vals)) hide)]))
'hide hide)]
[(struct pattern-token (start end val hide)) (syntax-property (pat->stx pat) 'hide (or hide-state 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)]))

13
brag/test/test-all.rkt
Unescape Escape View File

@ -4,15 +4,18 @@
(require "test-0n1.rkt" (require "test-0n1.rkt"
"test-0n1n.rkt" "test-0n1n.rkt"
"test-01-equal.rkt" "test-01-equal.rkt"
"test-simple-arithmetic-grammar.rkt"
"test-baby-json.rkt" "test-baby-json.rkt"
"test-baby-json-hider.rkt" "test-baby-json-hider.rkt"
"test-wordy.rkt" "test-curly-quantifier.rkt"
"test-simple-line-drawing.rkt" "test-cutter.rkt"
"test-errors.rkt"
"test-flatten.rkt" "test-flatten.rkt"
"test-lexer.rkt" "test-lexer.rkt"
"test-parser.rkt"
"test-errors.rkt"
"test-old-token.rkt" "test-old-token.rkt"
"test-parser.rkt"
"test-simple-arithmetic-grammar.rkt"
"test-simple-line-drawing.rkt"
"test-weird-grammar.rkt" "test-weird-grammar.rkt"
"test-whitespace.rkt"
"test-wordy.rkt"
(submod brag/codegen/satisfaction test)) (submod brag/codegen/satisfaction test))

12
brag/test/test-cutter-another.rkt
Unescape Escape View File

@ -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)))

86
brag/test/test-parser.rkt
Unescape Escape View File

@ -41,7 +41,8 @@
(pattern-seq (p 8) (p 20) (pattern-seq (p 8) (p 20)
(list (list
(pattern-token (p 8) (p 14) "COLON" 'hide) (pattern-token (p 8) (p 14) "COLON" 'hide)
(pattern-token (p 15) (p 20) "COLON" #f)))))) (pattern-token (p 15) (p 20) "COLON" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
@ -49,7 +50,8 @@
(pattern-seq (p 8) (p 20) (pattern-seq (p 8) (p 20)
(list (list
(pattern-id (p 8) (p 14) "thing" 'hide) (pattern-id (p 8) (p 14) "thing" 'hide)
(pattern-token (p 15) (p 20) "COLON" #f)))))) (pattern-token (p 15) (p 20) "COLON" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
@ -57,34 +59,42 @@
(pattern-seq (p 8) (p 20) (pattern-seq (p 8) (p 20)
(list (list
(pattern-id (p 8) (p 14) "thing" 'splice) (pattern-id (p 8) (p 14) "thing" 'splice)
(pattern-token (p 15) (p 20) "COLON" #f)))))) (pattern-token (p 15) (p 20) "COLON" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*")))
(list (rule (p 1) (p 16) (list (rule (p 1) (p 16)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16) (pattern-repeat (p 8) (p 16)
0 #f 0 #f
(pattern-lit (p 8) (p 15) "hello" #f))))) (pattern-lit (p 8) (p 15) "hello" #f)
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+")))
(list (rule (p 1) (p 16) (list (rule (p 1) (p 16)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16) (pattern-repeat (p 8) (p 16)
1 #f 1 #f
(pattern-lit (p 8) (p 15) "hello" #f))))) (pattern-lit (p 8) (p 15) "hello" #f)
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']")))
(list (rule (p 1) (p 18) (list (rule (p 1) (p 18)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-maybe (p 8) (p 18) #;(pattern-maybe (p 8) (p 18)
(pattern-lit (p 9) (p 17) "hello" 'hide))))) (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"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice (p 8) (p 20) (pattern-choice (p 8) (p 20)
(list (pattern-token (p 8) (p 13) "COLON" #f) (list (pattern-token (p 8) (p 13) "COLON" #f)
(pattern-token (p 16) (p 20) "BLAH" #f)))))) (pattern-token (p 16) (p 20) "BLAH" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr")))
(list (rule (p 1) (p 31) (list (rule (p 1) (p 31)
@ -94,44 +104,58 @@
(pattern-token (p 16) (p 20) "BLAH" #f) (pattern-token (p 16) (p 20) "BLAH" #f)
(pattern-seq (p 23) (p 31) (pattern-seq (p 23) (p 31)
(list (pattern-token (p 23) (p 26) "BAZ" #f) (list (pattern-token (p 23) (p 26) "BAZ" #f)
(pattern-id (p 27) (p 31) "expr" #f)))))))) (pattern-id (p 27) (p 31) "expr" #f))
#f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three")))
(list (rule (p 1) (p 22) (list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one" #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 12) (p 15) "two" #f)
(pattern-id (p 16) (p 22) "three" 'hide)))))) (pattern-id (p 16) (p 22) "three" 'hide))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)")))
(list (rule (p 1) (p 23) (list (rule (p 1) (p 23)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 23) (list (pattern-id (p 9) (p 12) "one" #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 13) (p 16) "two" #f)
(pattern-id (p 17) (p 22) "three" #f)))))) (pattern-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three")))
(list (rule (p 1) (p 22) (list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one" #f) (pattern-seq (p 8) (p 22)
(pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f)) (list (pattern-id (p 8) (p 11) "one" #f)
(pattern-id (p 17) (p 22) "three" #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"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three")))
(list (rule (p 1) (p 22) (list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one" #f) (pattern-seq (p 8) (p 22)
(pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f)) (list (pattern-id (p 8) (p 11) "one" #f)
(pattern-id (p 17) (p 22) "three" #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"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three")))
(list (rule (p 1) (p 24) (list (rule (p 1) (p 24)
(lhs-id (p 1) (p 5) "expr" #f) (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 24)
(list (pattern-repeat (p 8) (p 18) 1 #f
(pattern-seq (p 8) (p 17) (pattern-seq (p 8) (p 17)
(list (pattern-id (p 9) (p 12) "one" #f) (list (pattern-id (p 9) (p 12) "one" #f)
(pattern-id (p 13) (p 16) "two" #f)))) (pattern-id (p 13) (p 16) "two" #f))
(pattern-id (p 19) (p 24) "three" #f)))))) #f)
#f)
(pattern-id (p 19) (p 24) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string #<<EOF (check-equal? (grammar-parser (tokenize (open-input-string #<<EOF
@ -139,15 +163,21 @@ statlist : stat+
stat: ID '=' expr stat: ID '=' expr
| 'print' expr | 'print' expr
EOF EOF
))) )))
(list (rule (p 1) (p 17) (list (rule (p 1) (p 17)
(lhs-id (p 1) (p 9) "statlist" #f) (lhs-id (p 1) (p 9) "statlist" #f)
(pattern-repeat (p 12) (p 17) 1 #f (pattern-id (p 12) (p 16) "stat" #f))) (pattern-repeat (p 12) (p 17) 1 #f (pattern-id (p 12) (p 16) "stat" #f) #f))
(rule (p 18) (p 54) (rule (p 18) (p 54)
(lhs-id (p 18) (p 22) "stat" #f) (lhs-id (p 18) (p 22) "stat" #f)
(pattern-choice (p 24) (p 54) (list (pattern-seq (p 24) (p 35) (list (pattern-token (p 24) (p 26) "ID" #f) (pattern-choice (p 24) (p 54)
(list (pattern-seq (p 24) (p 35)
(list (pattern-token (p 24) (p 26) "ID" #f)
(pattern-lit (p 27) (p 30) "=" #f) (pattern-lit (p 27) (p 30) "=" #f)
(pattern-id (p 31) (p 35) "expr" #f))) (pattern-id (p 31) (p 35) "expr" #f))
(pattern-seq (p 42) (p 54) (list (pattern-lit (p 42) (p 49) "print" #f) #f)
(pattern-id (p 50) (p 54) "expr" #f)))))))) (pattern-seq (p 42) (p 54)
(list (pattern-lit (p 42) (p 49) "print" #f)
(pattern-id (p 50) (p 54) "expr" #f))
#f))
#f))))

Write Preview
Loading…
Cancel
Save