From f8687db35aa0d28bc13d7d76d10786cc1d11fa63 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 13 Jul 2018 10:21:04 -0600
Subject: [PATCH] improve cutting of top-level rule name

---
 brag/codegen/expander.rkt | 16 ++++++++++------
 brag/codegen/runtime.rkt  | 10 ++++++----
 2 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/brag/codegen/expander.rkt b/brag/codegen/expander.rkt
index a3e9336..8ddf73f 100755
--- a/brag/codegen/expander.rkt
+++ b/brag/codegen/expander.rkt
@@ -2,6 +2,7 @@
 (require (for-syntax racket/base
                      racket/list
                      "codegen.rkt"
+                     "runtime.rkt"
                      "flatten.rkt")
          br-parser-tools/lex
          br-parser-tools/cfg-parser
@@ -88,12 +89,15 @@
                         (case-lambda [(tokenizer)
                                       (define next-token
                                         (make-permissive-tokenizer tokenizer all-tokens-hash/mutable))
-                                      ;; little post-processor to allow cuts on top rule name
-                                      (syntax-case (THE-GRAMMAR next-token) ()
-                                        [(TOP-RULE-NAME . REST)
-                                         (eq? (syntax-property #'TOP-RULE-NAME 'hide-or-splice?) 'hide)
-                                         #'REST]
-                                        [ALL #'ALL])]
+                                      ;; little post-processor to support cuts on top rule name
+                                      (define parse-tree-stx (THE-GRAMMAR next-token))
+                                      (define top-rule-name-stx (syntax-case parse-tree-stx ()
+                                                                  [(TRN . REST) #'TRN]
+                                                                  [_ (error 'malformed-parse-tree)]))
+                                      (if (eq? (syntax-property top-rule-name-stx 'hide-or-splice?) 'hide)
+                                          ;; use `remove-rule-name` so we get the same housekeeping
+                                          (remove-rule-name parse-tree-stx) 
+                                          parse-tree-stx)]
                                      [(source tokenizer)
                                       (parameterize ([current-source source])
                                         (PARSE tokenizer))])
diff --git a/brag/codegen/runtime.rkt b/brag/codegen/runtime.rkt
index 613a1c8..315caf4 100755
--- a/brag/codegen/runtime.rkt
+++ b/brag/codegen/runtime.rkt
@@ -1,5 +1,4 @@
 #lang racket/base
-
 (require racket/match 
          racket/list
          racket/generator
@@ -12,7 +11,8 @@
          make-permissive-tokenizer
          atomic-datum->syntax
          positions->srcloc
-         rule-components->syntax)
+         rule-components->syntax
+         remove-rule-name)
 
 
 
@@ -177,12 +177,14 @@ This would be the place to check a syntax property for hiding.
   (syntax-case component-stx ()
     [(name . subcomponents)
      (let ([name-datum (syntax->datum #'name)])
+       ;; two properties: 'rule returns name-datum, and name-datum returns original #'name stx
+       (define (annotate-name stx) (syntax-property (syntax-property stx name-datum #'name) 'rule name-datum))
        (if splice
            ;; when splicing, returned list is a regular list, with each element having the property.
-           (map (λ(sc) (syntax-property sc name-datum #'name)) (syntax->list #'subcomponents))
+           (map annotate-name (syntax->list #'subcomponents))
            ;; when hiding, returned list should be a syntaxed list with the property
            ;; iow, basically the same as `component-stx`, minus the name
-           (syntax-property (datum->syntax component-stx #'subcomponents component-stx component-stx) name-datum #'name)))]
+           (annotate-name (datum->syntax component-stx #'subcomponents component-stx component-stx))))]
     [_ (raise-syntax-error 'remove-rule-name "component has no name" component-stx)]))