diff --git a/beautiful-racket-ragg/br/ragg/codegen/codegen.rkt b/beautiful-racket-ragg/br/ragg/codegen/codegen.rkt index 6e8050d..583d517 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 repeat maybe seq elide) + (syntax-case a-pattern (id lit token choice repeat maybe seq) [(id val) (values implicit explicit)] [(lit val) @@ -280,11 +280,6 @@ [(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 +342,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 repeat maybe seq elide) + (syntax-case a-pattern (id lit token choice repeat maybe seq) [(id val) (cons #'val acc)] [(lit val) @@ -363,10 +358,6 @@ [(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 +385,7 @@ a-leaf) (define (process-pattern a-pattern) - (syntax-case a-pattern (id lit token choice repeat maybe seq elide) + (syntax-case a-pattern (id lit token choice repeat maybe seq) [(id val) (free-id-table-ref toplevel-rule-table #'val)] [(lit val) @@ -417,13 +408,6 @@ [(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/codegen/flatten.rkt b/beautiful-racket-ragg/br/ragg/codegen/flatten.rkt index a36eb69..524484d 100755 --- a/beautiful-racket-ragg/br/ragg/codegen/flatten.rkt +++ b/beautiful-racket-ragg/br/ragg/codegen/flatten.rkt @@ -72,7 +72,7 @@ [origin (syntax-case a-rule (rule) [(rule name (pat-head rest ...)) #'pat-head])]) (syntax-case a-rule (rule) [(rule name pat) - (syntax-case #'pat (id inferred-id lit token choice repeat maybe seq elide) + (syntax-case #'pat (id inferred-id lit token choice repeat maybe seq) ;; The primitive types stay as they are: [(id val) @@ -124,14 +124,6 @@ inferred-rules)))] [(seq sub-pat ...) - (begin - (define-values (inferred-rules new-sub-pats) - (lift-nonprimitive-patterns (syntax->list #'(sub-pat ...)))) - (with-syntax ([(sub-pat ...) new-sub-pats]) - (cons #'(head origin name [sub-pat ...]) - inferred-rules)))] - - [(elide sub-pat ...) (begin (define-values (inferred-rules new-sub-pats) (lift-nonprimitive-patterns (syntax->list #'(sub-pat ...)))) 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 63cb110..e7ed704 100755 --- a/beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt +++ b/beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt @@ -11,7 +11,7 @@ (token 'STRING "'hello world'") "}"))) '(json (object "{" - (kvpair "message" (json (string "'hello world'"))) + (kvpair "message" ":" (json (string "'hello world'"))) "}"))) diff --git a/beautiful-racket-ragg/br/ragg/rules/parser.rkt b/beautiful-racket-ragg/br/ragg/rules/parser.rkt index 543fce1..a9dc02d 100755 --- a/beautiful-racket-ragg/br/ragg/rules/parser.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/parser.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang br (require parser-tools/yacc parser-tools/lex racket/list @@ -34,8 +34,7 @@ [struct-out pattern-choice] [struct-out pattern-repeat] [struct-out pattern-maybe] - [struct-out pattern-seq] - [struct-out pattern-elide]) + [struct-out pattern-seq]) (define-tokens tokens (LPAREN RPAREN @@ -49,7 +48,7 @@ ID LIT EOF)) -(require sugar/debug) + ;; grammar-parser: (-> token) -> (listof rule) (define grammar-parser (parser @@ -83,7 +82,8 @@ (string-length trimmed)) (position-line $1-start-pos) (position-col $1-start-pos)) - trimmed) + trimmed + #f) $2))]] [pattern @@ -129,16 +129,19 @@ [(LIT) (pattern-lit (position->pos $1-start-pos) (position->pos $1-end-pos) - (substring $1 1 (sub1 (string-length $1))))] + (substring $1 1 (sub1 (string-length $1))) + #f)] [(ID) (if (token-id? $1) (pattern-token (position->pos $1-start-pos) (position->pos $1-end-pos) - $1) + $1 + #f) (pattern-id (position->pos $1-start-pos) (position->pos $1-end-pos) - $1))] + $1 + #f))] [(LBRACKET pattern RBRACKET) (pattern-maybe (position->pos $1-start-pos) @@ -149,7 +152,8 @@ (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))] [(LANGLE pattern RANGLE) - (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))]]) + ;; angles indicate hiding. set hide value to #t + (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos) #t)]]) (error (lambda (tok-ok? tok-name tok-value start-pos end-pos) @@ -158,14 +162,14 @@ ;; relocate-pattern: pattern -> pattern ;; Rewrites the pattern's start and end pos accordingly. -(define (relocate-pattern a-pat start-pos end-pos) +(define (relocate-pattern a-pat start-pos end-pos [hide? #f]) (match a-pat - [(pattern-id _ _ v) - (pattern-id start-pos end-pos v)] - [(pattern-token _ _ v) - (pattern-token start-pos end-pos v)] - [(pattern-lit _ _ v) - (pattern-lit start-pos end-pos v)] + [(pattern-id _ _ v h) + (pattern-id start-pos end-pos v (or hide? h))] + [(pattern-token _ _ v h) + (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 _ _ m v) @@ -174,8 +178,6 @@ (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 cfc7334..b4d64af 100755 --- a/beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt @@ -12,7 +12,7 @@ (struct rule (start end lhs pattern) #:transparent) -(struct lhs-id (start end val) +(struct lhs-id (start end val hide) #:transparent) @@ -20,16 +20,16 @@ (struct pattern (start end) #:transparent) -(struct pattern-id pattern (val) +(struct pattern-id pattern (val hide) #:transparent) ;; Token structure to be defined by the user -(struct pattern-token pattern (val) +(struct pattern-token pattern (val hide) #:transparent) ;; Token structure defined as the literal string to be matched. -(struct pattern-lit pattern (val) +(struct pattern-lit pattern (val hide) #:transparent) (struct pattern-choice pattern (vals) @@ -45,6 +45,3 @@ (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 3c33a39..e0ac70a 100755 --- a/beautiful-racket-ragg/br/ragg/rules/stx-types.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/stx-types.rkt @@ -13,5 +13,4 @@ (define (choice 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)) -(define (elide 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)) \ 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 caefdb5..6c68516 100755 --- a/beautiful-racket-ragg/br/ragg/rules/stx.rkt +++ b/beautiful-racket-ragg/br/ragg/rules/stx.rkt @@ -57,22 +57,30 @@ (pos-offset (pattern-start a-pattern))) #f)) (define source-location (list source line column position span)) - (datum->syntax #f - (match a-pattern - [(struct pattern-id (start end val)) - `(id ,(datum->syntax #f (string->symbol val) source-location))] - [(struct pattern-lit (start end val)) - `(lit ,(datum->syntax #f val source-location))] - [(struct pattern-token (start end val)) - `(token ,(datum->syntax #f (string->symbol val) source-location))] - [(struct pattern-choice (start end vals)) - `(choice ,@(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))] - [(struct pattern-elide (start end vals)) - `(elide ,@(map recur vals))]) - source-location)) + (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 val)) + (datum->syntax #f`(repeat ,min ,(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)])) diff --git a/beautiful-racket-ragg/br/ragg/test/test-parser.rkt b/beautiful-racket-ragg/br/ragg/test/test-parser.rkt index 9d8310e..d57b5d4 100755 --- a/beautiful-racket-ragg/br/ragg/test/test-parser.rkt +++ b/beautiful-racket-ragg/br/ragg/test/test-parser.rkt @@ -17,97 +17,97 @@ ;; FIXME: fix the test cases so they work on locations rather than just offsets. (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'"))) (list (rule (p 1) (p 15) - (lhs-id (p 1) (p 5) "expr" ) - (pattern-lit (p 8) (p 15) "hello")))) + (lhs-id (p 1) (p 5) "expr" #f) + (pattern-lit (p 8) (p 15) "hello" #f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON"))) (list (rule (p 1) (p 13) - (lhs-id (p 1) (p 5) "expr") - (pattern-token (p 8) (p 13) "COLON")))) + (lhs-id (p 1) (p 5) "expr" #f) + (pattern-token (p 8) (p 13) "COLON" #f)))) -(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON COLON"))) - (list (rule (p 1) (p 19) - (lhs-id (p 1) (p 5) "expr") - (pattern-seq (p 8) (p 19) +(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON"))) + (list (rule (p 1) (p 21) + (lhs-id (p 1) (p 5) "expr" #f) + (pattern-seq (p 8) (p 21) (list - (pattern-token (p 8) (p 13) "COLON") - (pattern-token (p 14) (p 19) "COLON")))))) + (pattern-token (p 8) (p 15) "COLON" #t) + (pattern-token (p 16) (p 21) "COLON" #f)))))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*"))) (list (rule (p 1) (p 16) - (lhs-id (p 1) (p 5) "expr" ) + (lhs-id (p 1) (p 5) "expr" #f) (pattern-repeat (p 8) (p 16) 0 - (pattern-lit (p 8) (p 15) "hello"))))) + (pattern-lit (p 8) (p 15) "hello" #f))))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+"))) (list (rule (p 1) (p 16) - (lhs-id (p 1) (p 5) "expr" ) + (lhs-id (p 1) (p 5) "expr" #f) (pattern-repeat (p 8) (p 16) 1 - (pattern-lit (p 8) (p 15) "hello"))))) + (pattern-lit (p 8) (p 15) "hello" #f))))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : ['hello']"))) (list (rule (p 1) (p 17) - (lhs-id (p 1) (p 5) "expr" ) + (lhs-id (p 1) (p 5) "expr" #f) (pattern-maybe (p 8) (p 17) - (pattern-lit (p 9) (p 16) "hello"))))) + (pattern-lit (p 9) (p 16) "hello" #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") + (lhs-id (p 1) (p 5) "expr" #f) (pattern-choice (p 8) (p 20) - (list (pattern-token (p 8) (p 13) "COLON") - (pattern-token (p 16) (p 20) "BLAH")))))) + (list (pattern-token (p 8) (p 13) "COLON" #f) + (pattern-token (p 16) (p 20) "BLAH" #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") + (lhs-id (p 1) (p 5) "expr" #f) (pattern-choice (p 8) (p 31) - (list (pattern-token (p 8) (p 13) "COLON") - (pattern-token (p 16) (p 20) "BLAH") + (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") - (pattern-id (p 27) (p 31) "expr")))))))) + (list (pattern-token (p 23) (p 26) "BAZ" #f) + (pattern-id (p 27) (p 31) "expr" #f)))))))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two three"))) (list (rule (p 1) (p 21) - (lhs-id (p 1) (p 5) "expr") - (pattern-seq (p 8) (p 21) (list (pattern-id (p 8) (p 11) "one") - (pattern-id (p 12) (p 15) "two") - (pattern-id (p 16) (p 21) "three")))))) + (lhs-id (p 1) (p 5) "expr" #f) + (pattern-seq (p 8) (p 21) (list (pattern-id (p 8) (p 11) "one" #f) + (pattern-id (p 12) (p 15) "two" #f) + (pattern-id (p 16) (p 21) "three" #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") - (pattern-seq (p 8) (p 23) (list (pattern-id (p 9) (p 12) "one") - (pattern-id (p 13) (p 16) "two") - (pattern-id (p 17) (p 22) "three")))))) + (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)))))) (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") - (pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one") - (pattern-repeat (p 12) (p 16) 0 (pattern-id (p 12) (p 15) "two")) - (pattern-id (p 17) (p 22) "three")))))) + (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 (pattern-id (p 12) (p 15) "two" #f)) + (pattern-id (p 17) (p 22) "three" #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") - (pattern-seq (p 8) (p 22) (list (pattern-id (p 8) (p 11) "one") - (pattern-repeat (p 12) (p 16) 1 (pattern-id (p 12) (p 15) "two")) - (pattern-id (p 17) (p 22) "three")))))) + (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 (pattern-id (p 12) (p 15) "two" #f)) + (pattern-id (p 17) (p 22) "three" #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") + (lhs-id (p 1) (p 5) "expr" #f) (pattern-seq (p 8) (p 24) (list (pattern-repeat (p 8) (p 18) 1 (pattern-seq (p 8) (p 17) - (list (pattern-id (p 9) (p 12) "one") - (pattern-id (p 13) (p 16) "two")))) - (pattern-id (p 19) (p 24) "three")))))) + (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)))))) (check-equal? (grammar-parser (tokenize (open-input-string #<