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

adjust flattening of zero-or-more rule (fixes #18)

Browse Source
pull/24/head
Matthew Butterick 6 years ago
parent 2612c3356b
commit d1ebde511a
5 changed files with 72 additions and 40 deletions
Show Stats Download Patch File Download Diff File

42
brag/codegen/flatten.rkt
Unescape Escape View File

@ -6,38 +6,33 @@
flatten-rules
prim-rule)
(define (make-fresh-name)
(let ([n 0])
(lambda ()
(λ ()
(set! n (add1 n))
(string->symbol (format "%rule~a" n)))))
(define default-fresh-name
(make-fresh-name))
(define default-fresh-name (make-fresh-name))
;; Translates rules to lists of primitive rules.
(define (flatten-rules rules #:fresh-name [fresh-name default-fresh-name])
(define ht (make-hash))
(apply append (map (lambda (a-rule) (flatten-rule a-rule
(define ht (make-hasheq))
(apply append (for/list ([a-rule (in-list rules)])
(flatten-rule a-rule
#:ht ht
#:fresh-name fresh-name))
rules)))
#:fresh-name fresh-name))))
;; flatten-rule: rule -> (listof primitive-rule)
(define (flatten-rule a-rule
#:fresh-name [fresh-name default-fresh-name]
;; ht: (hashtableof pattern-hash-key pat)
#:ht [ht (make-hash)])
#:ht [ht (make-hasheq)])
(let recur ([a-rule a-rule]
[inferred? #f])
(let recur ([a-rule a-rule] [inferred? #f])
;; lift-nonprimitive-pattern: pattern -> (values (listof primitive-rule) pattern)
;; Turns non-primitive patterns into primitive patterns, and produces a set of
@ -98,6 +93,14 @@
(append (list #'(HEAD ORIGIN NAME [SUB-PAT ...] ...))
(apply append (reverse inferred-ruless/rev)))))]
[(repeat 0 0 SUB-PAT)
;; repeat from 0 to 0 (is a no-op)
(recur #'(rule NAME (seq)) #f)]
[(repeat 0 MAYBE-MAX SUB-PAT)
;; repeat from 0 (as a maybe rule)
(recur #'(rule NAME (maybe (repeat 1 MAYBE-MAX SUB-PAT))) #f)]
[(repeat MIN #f SUB-PAT)
;; indefinite repeat
(begin
@ -115,10 +118,15 @@
(begin
(define min (syntax-e #'MIN))
(define max (syntax-e #'MAX))
(define new-rule-stx (with-syntax ([(MIN-SUBPAT ...) (make-list min #'SUB-PAT)]
[(EXTRA-SUBPAT ...) (make-list (- max min) #'SUB-PAT)])
;; has to keep the same name to work correctly
#'(rule NAME (seq MIN-SUBPAT ... (maybe EXTRA-SUBPAT) ...))))
(unless (<= min max)
(raise-syntax-error #f (format "minimum repeat count cannot be larger than maximum, got {~a,~a}" min max) a-rule))
;; has to keep the same rule NAME to work correctly
(define new-rule-stx
(if (= min max)
(with-syntax ([MIN-SUBPATS (make-list min #'SUB-PAT)])
#'(rule NAME (seq . MIN-SUBPATS)))
(with-syntax ([REPEATS-REMAINING (- max min)]) ; REPEATS-REMAINING is a positive integer
#'(rule NAME (seq (repeat MIN MIN SUB-PAT) (repeat 0 REPEATS-REMAINING SUB-PAT))))))
(recur new-rule-stx #f))]
[(maybe SUB-PAT)

3
brag/examples/nested-repeats.rkt
Unescape Escape View File

@ -0,0 +1,3 @@
#lang brag
start : ( (X | X Y) A* )*

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

@ -12,6 +12,7 @@
"test-flatten.rkt"
"test-hide-and-splice.rkt"
"test-lexer.rkt"
"test-nested-repeats.rkt"
"test-old-token.rkt"
"test-parser.rkt"
"test-quotation-marks-and-backslashes.rkt"

37
brag/test/test-flatten.rkt
Unescape Escape View File

@ -96,14 +96,16 @@
;; repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (id rule-2)]
[])))
'((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
(inferred-prim-rule repeat %rule1
((inferred-id %rule1 repeat) (id rule-2))
((id rule-2)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2))))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (lit "+") (id rule-2)]
[])))
'((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ())
(inferred-prim-rule repeat %rule2
((inferred-id %rule2 repeat) (lit "+") (id rule-2))
((lit "+") (id rule-2)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2)))))
@ -174,8 +176,11 @@
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term)))))
#:fresh-name (make-fresh-name)))
'((prim-rule seq expr [(id term) (inferred-id r1 repeat)])
(inferred-prim-rule repeat r1 [(inferred-id r1 repeat) (lit "+") (id term)] [])))
'((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term)))))
;; larger example: simple arithmetic
@ -186,8 +191,14 @@
(rule factor (token INT))))
#:fresh-name (make-fresh-name)))
'((prim-rule seq expr [(id term) (inferred-id r1 repeat)])
(inferred-prim-rule repeat r1 [(inferred-id r1 repeat) (lit "+") (id term)] [])
(prim-rule seq term [(id factor) (inferred-id r2 repeat)])
(inferred-prim-rule repeat r2 [(inferred-id r2 repeat) (lit "*") (id factor)] [])
(prim-rule token factor [(token INT)])))
'((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term)))
(prim-rule seq term ((id factor) (inferred-id r3 repeat)))
(prim-rule maybe r3 ((inferred-id r4 repeat)) ())
(inferred-prim-rule repeat r4
((inferred-id r4 repeat) (lit "*") (id factor))
((lit "*") (id factor)))
(prim-rule token factor ((token INT)))))

9
brag/test/test-nested-repeats.rkt
Unescape Escape View File

@ -0,0 +1,9 @@
#lang racket/base
(require brag/examples/nested-repeats
rackunit)
(check-equal?
(syntax->datum (parse (list "X" "Y" "X")))
'(start "X" "Y" "X"))
Write Preview
Loading…
Cancel
Save