victory

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

@@ -30,61 +30,30 @@
        (parameterize ([cmd-line-mode? #t])
          (do-place)))))
 
+
 (provide txtadv-program)
-(define #'(txtadv-program _section ...)
+(define #'txtadv-program #'module-begin)
-  #'(module-begin _section ...))
 
 (provide verb-section)
-(define-inverting #'(verb-section _verb-item ...)
+(define #'(verb-section
+           ((_name0 . _transitive0?)
+            (_name . _transitive?) ... _desc) ...)
   (inject-syntax ([#'in-verbs (shared-syntax 'in-verbs)])
                  #'(define-verbs in-verbs
-                     _verb-item ...)))
+                     [_name0 #,@(if (syntax->datum #'_transitive0?) #'(_) #'()) (= _name ...) _desc] ...)))
-
-
-(provide verb-item)
-(define-inverting #'(verb-item (_name0 _transitive0?) (_name _transitive?) ... _desc)
-  #`[_name0 #,@(if (syntax->datum #'_transitive0?) #'(_) #'()) (= _name ...) _desc])
-
-(provide verb-name)
-(define-cases #'verb-name
-  [#'(_ _id) #'(_id #f)]
-  [#'(_ _id _underscore) #'(_id #t)])
 
 (provide everywhere-section)
-(define-inverting #'(everywhere-section [_name _desc] ...)
+(define #'(everywhere-section [_id _desc] ...)
   #'(define-everywhere everywhere-actions
-      ([_name _desc] ...)))
+      ([_id _desc] ...)))
-
-(provide id-desc)
-(define-inverting #'(id-desc _id _desc)
-  #'(_id _desc))
 
 (provide things-section)
-(define-inverting #'(things-section _thing ...)
+(define #'(things-section (_thingname (_actionname _actiondesc) ...) ...)
-  #'(begin _thing ...))
+  #'(begin (define-thing _thingname [_actionname _actiondesc] ...) ...))
-
-(provide thing-item)
-(define-inverting #'(thing-item _thingname (_actionname _actiondesc) ...)
-  #'(define-thing _thingname [_actionname _actiondesc] ...))
 
 (provide places-section)
-(define-inverting #'(places-section _placeitem ...)
+(define #'(places-section (_place-id _place-desc [_place-item ...] [_actionname _actiondesc] ...) ...)
-  #'(begin _placeitem ...))
+  #'(begin (define-place _place-id _place-desc [_place-item ...] ([_actionname _actiondesc] ...)) ...))
-
-(provide place-item)
-(define-inverting #'(place-item _place-id _place-desc [_place-item ...] [_actionname _actiondesc] ...)
-  #'(define-place _place-id _place-desc [_place-item ...] ([_actionname _actiondesc] ...)))
-
-(provide place-descrip)
-(define #'(place-descrip _desc) #'_desc)
-
-(provide place-items)
-(define-inverting #'(place-items _id ...) #'(_id ...))
-
-(provide place-name)
-(define-cases #'place-name
-  [#'(_ _id) #'_id])
-
 
 (provide s-exp)
 (define-cases-inverting #'s-exp

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

@@ -4,28 +4,24 @@ txtadv-program : verb-section everywhere-section things-section places-section s
 
 verb-section : <"===VERBS==="> verb-item+
 
-verb-item : verb-name+ s-exp
+<verb-item> : verb-name+ s-exp
 
-verb-name : [<",">] ID ["_"]
+<verb-name> : [<",">] ID ["_"]
 
 everywhere-section : <"===EVERYWHERE==="> id-desc+
 
 things-section : <"===THINGS==="> thing-item+
 
-thing-item : DASHED-NAME id-desc+
+<thing-item> : DASHED-NAME id-desc+
 
 places-section : <"===PLACES==="> place-item+
 
-place-item : DASHED-NAME place-descrip place-items id-desc+
+<place-item> : DASHED-NAME STRING place-items id-desc+
 
-place-descrip : STRING ; `place-desc` is already used in expander
+<place-items> : <"["> ([<",">] ID)* <"]">
 
-place-items : <"["> place-name* <"]"> ; `place-things` is already used
+start-section : <"===START==="> ID
 
-place-name : [<",">] ID
+<id-desc> : ID s-exp
-
-start-section : <"===START==="> place-name
-
-id-desc : ID s-exp
 
 s-exp : ID | STRING | <"("> s-exp* <")">

brag/brag/codegen/runtime.rkt

@@ -165,7 +165,9 @@ This would be the place to check a syntax property for hiding.
 (define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:splice? [splice #f] . componentss)
   (let ([spliced-componentss (append-map (λ(cs)
                                    (if (and (pair? cs) (syntax-property (car cs) 'splice))
-                                            (list (cdr (syntax->list (car cs)))) ; pop off the rule name and splice its components into this rule
+                                            (list (list (syntax-case (car cs) ()
+                                                    [(rule-name c ...)
+                                                     #'(c ...)])))
                                             (list cs))) componentss)])
     (syntax-property
      (datum->syntax #f 

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

@@ -10,7 +10,7 @@
                ":"
                (token 'STRING "'hello world'")
                "}")))
- '(json (object ":")))
+ '(json (object (":"))))
 
 
 (check-equal?