From 99f97b399c520a91dfa71fe1f49ac54720f99a8a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 10 Jun 2018 20:34:22 -0700 Subject: [PATCH] forward --- brag/codegen/flatten.rkt | 30 +++++++++++++++++++++--------- brag/rules/lexer.rkt | 6 ++---- brag/rules/parser.rkt | 15 ++++++++++----- 3 files changed, 33 insertions(+), 18 deletions(-) diff --git a/brag/codegen/flatten.rkt b/brag/codegen/flatten.rkt index ad3ecfc..aeb1902 100755 --- a/brag/codegen/flatten.rkt +++ b/brag/codegen/flatten.rkt @@ -1,7 +1,8 @@ #lang racket/base (require brag/rules/stx-types + racket/list (for-syntax racket/base)) - +(require (except-in sugar/debug repeat)) (provide flatten-rule flatten-rules prim-rule) @@ -102,21 +103,32 @@ (begin (define-values (inferred-rules new-sub-pats) (lift-nonprimitive-pattern #'sub-pat)) - (with-syntax ([(sub-pat ...) new-sub-pats]) + (report/file (syntax-e #'min)) + (with-syntax ([(sub-pat ...) new-sub-pats] + [MIN-REPEAT-SUB-PATS (apply append (make-list (syntax-e #'min) new-sub-pats))]) (cons (cond [(= (syntax-e #'min) 0) - #`(head origin name - [(inferred-id name repeat) sub-pat ...] - [])] - [(= (syntax-e #'min) 1) - #`(head origin name - [(inferred-id name repeat) sub-pat ...] - [sub-pat ...])]) + #`(head origin name + [(inferred-id name repeat) sub-pat ...] + [])] + [(= (syntax-e #'min) 1) + #`(head origin name + [(inferred-id name repeat) sub-pat ...] + [sub-pat ...])] + [(= (syntax-e #'min) 2) + #`(head origin name + [(inferred-id name repeat) sub-pat ...] + [sub-pat ... sub-pat ...])]) + inferred-rules) + #;(cons (report/file #`(head origin name + [(inferred-id name repeat) sub-pat ...] + MIN-REPEAT-SUB-PATS)) inferred-rules)))] [(maybe sub-pat) (begin (define-values (inferred-rules new-sub-pats) (lift-nonprimitive-pattern #'sub-pat)) + (report*/file #'pat #'sub-pat) (with-syntax ([(sub-pat ...) new-sub-pats]) (cons #'(head origin name [sub-pat ...] diff --git a/brag/rules/lexer.rkt b/brag/rules/lexer.rkt index b5a485e..44e8d13 100755 --- a/brag/rules/lexer.rkt +++ b/brag/rules/lexer.rkt @@ -65,10 +65,8 @@ ["|" (token-PIPE lexeme)] [(:or "+" "*" - ;; todo: consolidate next two patterns? - (:: "{" (:* digit) "}") - (:: "{" (:* digit) "," (:* digit) "}")) - (token-REPEAT (let () (println lexeme) lexeme))] + (:: "{" (:* digit) (:? (:: "," (:* digit))) "}")) + (token-REPEAT lexeme)] [whitespace ;; Skip whitespace (return-without-pos (lex/1 input-port))] diff --git a/brag/rules/parser.rkt b/brag/rules/parser.rkt index 05cfa9a..93c794e 100755 --- a/brag/rules/parser.rkt +++ b/brag/rules/parser.rkt @@ -4,6 +4,7 @@ racket/list racket/match "rule-structs.rkt") +(require sugar/debug) ;; A parser for grammars. @@ -162,12 +163,16 @@ (pattern-repeat (position->pos $1-start-pos) (position->pos $2-end-pos) 1 $1)] - [(regexp-match #px"^\\{(\\d+)?,?(\\d+)?\\}$" $2) + [(regexp-match #px"^\\{(\\d+)?,?(\\d+)?\\}$" $2) ; "{min,max}" with both min & max optional => (λ (m) - (define pr (match m - [(list _ min max) (cons (and min (string->number min)) - (and max (string->number max)))])) - (error (format "~a" pr)))] + (match-define (cons min-repeat max-repeat) + (match m + [(list _ min max) (cons (if min (string->number min) 0) + (and max (string->number max)))])) + (report/file min-repeat) + (pattern-repeat (position->pos $1-start-pos) + (position->pos $2-end-pos) + min-repeat $1))] [else (error 'grammar-parse "unknown repetition operator ~e" $2)])] [(atomic-pattern)