refactor ; change hiding char to slash

beautiful-racket/br/demo/txtadv/parser.rkt

@@ -2,34 +2,34 @@
 
 txtadv-program : verb-section everywhere-section things-section places-section start-section
 
-verb-section : !"===VERBS===" verb-item+
+verb-section : /"===VERBS===" verb-item+
 
-!verb-item :  verb next-verb* s-exp
+/verb-item :  verb next-verb* s-exp
 
-!verb : ID ["_"]
+/verb : ID ["_"]
 
-@next-verb : [!","] verb
+@next-verb : [/","] verb
 
-everywhere-section : !"===EVERYWHERE===" id-desc+
+everywhere-section : /"===EVERYWHERE===" id-desc+
 
-things-section : !"===THINGS===" thing-item+
+things-section : /"===THINGS===" thing-item+
 
-!thing-item : DASHED-NAME id-desc+
+/thing-item : DASHED-NAME id-desc+
 
-places-section : !"===PLACES===" place-item+
+places-section : /"===PLACES===" place-item+
 
-!place-item : DASHED-NAME STRING place-items id-desc+
+/place-item : DASHED-NAME STRING place-items id-desc+
 
-!place-items : !"[" [place next-place*] !"]"
+/place-items : /"[" [place next-place*] /"]"
 
 @place : ID
 
-@next-place: !"," place
+@next-place: /"," place
 
-start-section : !"===START===" ID
+start-section : /"===START===" ID
 
-!id-desc : ID s-exp
+/id-desc : ID s-exp
 
 @s-exp : ID | STRING | nested-s-exp
 
-!nested-s-exp : !"(" s-exp* !")"
+/nested-s-exp : /"(" s-exp* /")"

brag/brag/codegen/codegen.rkt

@@ -217,7 +217,11 @@
                            [(inferred-rule-name . rest)
                             (syntax->list #'rest)])]
                       [(id val)
-                        #`(list (syntax-property $X 'splice-rh-id #,(and (syntax-property primitive-pattern 'hide) #t)))] ; at this point, this syntax-property is either #f or "splice"
+                       ;; at this point, the 'hide property is either #f or "splice"
+                       ;; ('hide value is handled at the top of this conditional
+                       ;; we need to use boolean because a symbol is treated as an identifier.
+                       ;; also we'll separate it into its own property for clarity and test for it in "runtime.rkt"
+                        #`(list (syntax-property $X 'splice-rh-id #,(and (syntax-property primitive-pattern 'hide) #t)))]
                       [(lit val)
                        #'(list (atomic-datum->syntax $X $X-start-pos $X-end-pos))]
                       [(token val)

brag/brag/codegen/runtime.rkt

@@ -162,21 +162,25 @@ This would be the place to check a syntax property for hiding.
 ;; Creates an stx out of the rule name and its components.
 ;; The location information of the rule spans that of its components.
 (define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:hide-or-splice? [hide-or-splice #f] . componentss)
-  (let ([spliced-componentss (append-map (λ(cs)
+  (define (remove-rule-name cs) (cdr (syntax->list cs)))
-                                           (cond
+  (define spliced-componentss
-                                             [(and (pair? cs) (eq? (syntax-property (car cs) 'hide-or-splice) 'hide))
+    (apply append
-                                              (list (list (syntax-case (car cs) ()
+           (for/list ([css (in-list componentss)])
-                                                            [(rule-name c ...)
+                     (list
-                                                             #'(c ...)])))]
+                      (cond
-                                             [(and (pair? cs) (or (eq? (syntax-property (car cs) 'hide-or-splice) 'splice)
+                        [(and (pair? css) (eq? (syntax-property (car css) 'hide-or-splice) 'hide))
-                                                                  (syntax-property (car cs) 'splice-rh-id)))
+                         (list (remove-rule-name (car css)))] ; hidden version still contained in sublist
-                                              (list (cdr (syntax->list (car cs))))]
+                        [(and (pair? css) (or (eq? (syntax-property (car css) 'hide-or-splice) 'splice)
-                                             [else (list cs)])) componentss)])
+                                              (syntax-property (car css) 'splice-rh-id)))
-    (syntax-property
+                         (remove-rule-name (car css))] ; spliced version is "unlisted"
-     (datum->syntax #f 
+                        [else css])))))
-                    (cons
+  (syntax-property
-                     (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
+   (datum->syntax #f 
-                     (apply append spliced-componentss))
+                  (cons
-                    srcloc
+                   (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
-                    stx-with-original?-property)
+                   (apply append spliced-componentss))
-     'hide-or-splice hide-or-splice))) ; not 'hide-or-splice-lhs-id, because it is now a component in a different rule
+                  srcloc
+                  stx-with-original?-property)
+   ;; not 'hide-or-splice-lhs-id, because it is now a component in a different rule
+   ;; actual splicing happens when the parent rule is processed (with procedure above)
+   'hide-or-splice hide-or-splice)) 

brag/brag/examples/baby-json-hider.rkt

@@ -11,6 +11,6 @@ string: STRING
 
 array: "[" [json ("," json)*] "]"
 
-object: !"{" [kvpair ("," kvpair)*] !"}"
+object: /"{" [kvpair ("," kvpair)*] /"}"
 
-@kvpair : !ID ":" !json
+@kvpair : /ID ":" /json

brag/brag/rules/lexer.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+(require (for-syntax racket/base "parser.rkt"))
 (require parser-tools/lex
          (prefix-in : parser-tools/lex-sre)
          "parser.rkt"
@@ -9,12 +10,15 @@
 ;; A newline can be any one of the following.
 (define-lex-abbrev NL (:or "\r\n" "\r" "\n"))
 
-;; Slightly modified from the read.rkt example in parser-tools, treating
+;; chars used for quantifiers & parse-tree filtering
-;; +, :, and * as reserved, non-identifier characters.
+(define-for-syntax quantifiers "+:*")
+(define-lex-trans reserved-chars
+  (λ(stx) #`(char-set #,(format "~a~a~a" quantifiers hide-char splice-char))))
+
 (define-lex-abbrevs
    [letter (:or (:/ "a" "z") (:/ #\A #\Z))]
    [digit (:/ #\0 #\9)]
-   [id-char (:or letter digit (char-set "-.$%&/=?^_~<>"))]
+   [id-char (:or letter digit (:& (char-set "+:*@!-.$%&/=?^_~<>") (char-complement (reserved-chars))))]
  )
 
 (define-lex-abbrev id
@@ -40,10 +44,10 @@
     (token-RPAREN lexeme)]
    ["]"
     (token-RBRACKET lexeme)]
-   ["!"
+   ["/"
-    (token-BANG lexeme)]
+    (token-HIDE lexeme)]
    ["@"
-    (token-ATSIGN lexeme)]
+    (token-SPLICE lexeme)]
    ["|"
     (token-PIPE lexeme)]
    [(:or "+" "*")
@@ -61,7 +65,7 @@
     (token-EOF lexeme)]
    [(:: id (:* whitespace) ":")
     (token-RULE_HEAD lexeme)]
-   [(:: "!" id (:* whitespace) ":")
+   [(:: "/" id (:* whitespace) ":")
     (token-RULE_HEAD_HIDDEN lexeme)]
    [(:: "@" id (:* whitespace) ":")
     (token-RULE_HEAD_SPLICED lexeme)]

brag/brag/rules/parser.rkt

@@ -7,11 +7,13 @@
 
 ;; A parser for grammars.
 
-(provide tokens
+(provide hide-char
+         splice-char
+         tokens
          token-LPAREN
          token-RPAREN
-         token-BANG ; for hider
+         token-HIDE ; for hider
-         token-ATSIGN ; for splicer
+         token-SPLICE ; for splicer
          token-LBRACKET
          token-RBRACKET
          token-PIPE
@@ -42,8 +44,8 @@
                        RPAREN
                        LBRACKET
                        RBRACKET
-                       BANG
+                       HIDE
-                       ATSIGN
+                       SPLICE
                        PIPE
                        REPEAT
                        RULE_HEAD
@@ -53,6 +55,9 @@
                        LIT
                        EOF))
 
+(define hide-char #\/)
+(define splice-char #\@)
+
 ;; grammar-parser: (-> token) -> (listof rule)
 (define grammar-parser
   (parser
@@ -92,7 +97,7 @@
      
      [(RULE_HEAD_HIDDEN pattern) ; bang indicates hiding
       (begin
-        (define trimmed (cadr (regexp-match #px"!(\\S+)\\s*:$" $1)))
+        (define trimmed (cadr (regexp-match (pregexp (format "~a(\\S+)\\s*:$" hide-char)) $1)))
         (rule (position->pos $1-start-pos)
               (position->pos $2-end-pos)
               (lhs-id (position->pos $1-start-pos)
@@ -107,7 +112,7 @@
      
      [(RULE_HEAD_SPLICED pattern) ;atsign indicates splicinh
       (begin
-        (define trimmed (cadr (regexp-match #px"@(\\S+)\\s*:$" $1)))
+        (define trimmed (cadr (regexp-match (pregexp (format "~a(\\S+)\\s*:$" splice-char)) $1)))
         (rule (position->pos $1-start-pos)
               (position->pos $2-end-pos)
               (lhs-id (position->pos $1-start-pos)
@@ -185,13 +190,12 @@
      [(LPAREN pattern RPAREN)
       (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))]
      
-     [(BANG atomic-pattern)
+     [(HIDE atomic-pattern)
-      ;; bang indicates hiding. set hide value to hide
       (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $2-end-pos) 'hide)]
 
-     [(ATSIGN ID)
+     [(SPLICE ID)
-      ;; atsign indicates splicing. set hide value to splice
+      ;; only works for nonterminals on the right side
-      ;; only works for nonterminals on the right side (meaningless with terminals)
+      ;; (meaningless with terminals)
       (if (token-id? $2)
           (error 'brag "Can't use splice operator with terminal")
           (pattern-id (position->pos $1-start-pos)

brag/brag/rules/rule-structs.rkt

@@ -20,7 +20,6 @@
 (struct pattern-id pattern (val hide)
         #:transparent)
 
-
 ;; Token structure to be defined by the user
 (struct pattern-token pattern (val hide)
         #:transparent)

brag/brag/test/test-baby-json-hider.rkt

@@ -13,11 +13,7 @@
  '(json ":"))
 
 
-#;(check-equal? 
+(check-equal? 
  (syntax->datum
   (parse "[[[{}]],[],[[{}]]]"))
- '(json (array #\[ (json (array #\[ (json (array #\[ (json (object)) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json (object )) #\])) #\])) #\])))
+ '(json (array #\[ (json (array #\[ (json (array #\[ (json) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json) #\])) #\])) #\])))
-
- 
-               
-               

brag/brag/test/test-parser.rkt

@@ -25,7 +25,7 @@
                           (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")))
+(check-equal? (grammar-parser (tokenize (open-input-string "/expr : COLON")))
               (list (rule (p 1) (p 14)
                           (lhs-id (p 1) (p 6) "expr" ''hide)
                           (pattern-token (p 9) (p 14) "COLON" #f))))
@@ -35,7 +35,7 @@
                           (lhs-id (p 1) (p 6) "expr" ''splice)
                           (pattern-token (p 9) (p 14) "COLON" #f))))
 
-(check-equal? (grammar-parser (tokenize (open-input-string "expr : !COLON COLON")))
+(check-equal? (grammar-parser (tokenize (open-input-string "expr : /COLON COLON")))
               (list (rule (p 1) (p 20)
                           (lhs-id (p 1) (p 5) "expr" #f)
                           (pattern-seq (p 8) (p 20)
@@ -43,7 +43,7 @@
                                     (pattern-token (p 8) (p 14) "COLON" 'hide)
                                     (pattern-token (p 15) (p 20) "COLON" #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)
                           (lhs-id (p 1) (p 5) "expr" #f)
                           (pattern-seq (p 8) (p 20)
@@ -73,7 +73,7 @@
                                       1
                                       (pattern-lit (p 8) (p 15) "hello" #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)
                           (lhs-id (p 1) (p 5) "expr" #f)
                           (pattern-maybe (p 8) (p 18)
@@ -96,7 +96,7 @@
                                                      (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")))
+(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)