From 9b2fa914f53446c0136fbc58afb5fddef1336840 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 13 May 2016 15:42:02 -0700
Subject: [PATCH] simplify grammar

---
 beautiful-racket/br/demo/hdl/expander.rkt | 26 +++++------------------
 beautiful-racket/br/demo/hdl/parser.rkt   | 22 ++++++++-----------
 2 files changed, 14 insertions(+), 34 deletions(-)

diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt
index 38e47b0..aa2d5f2 100644
--- a/beautiful-racket/br/demo/hdl/expander.rkt
+++ b/beautiful-racket/br/demo/hdl/expander.rkt
@@ -1,10 +1,10 @@
 #lang br
 (provide #%top-interaction #%module-begin #%app #%datum (all-defined-out))
 
-(define-inverting #'(chip-program "CHIP" _chipname "{"
-                                  (_input-pin ...)
-                                  (_output-pin ...)
-                                  _part-spec "}")
+(define #'(chip-program _chipname
+                                  (pin-spec _input-pin ...)
+                                  (pin-spec _output-pin ...)
+                                  (part-spec (part _partname (_pin _val) ... (_lastpin _pinout)) ...))
   #'(begin
       (define+provide _chipname
         (procedure-rename
@@ -12,25 +12,9 @@
           (λ (kws kw-args . rest)
             (define kw-pairs (map cons kws kw-args))
             (let ([_input-pin (cdr (assq (string->keyword (format "~a" '_input-pin)) kw-pairs))] ...)
-              _part-spec
+              (define _pinout (call-part _partname [_pin _val] ...)) ...
               (values _output-pin ...)))) '_chipname))))
 
-(define-inverting #'(pin-spec _label _pin ... ";")
-  #'(_pin ...))
-
-(define-cases #'pin
-  [#'(_ _pin ",") #'_pin]
-  [#'(_ _pin) #'_pin])
-
-(define #'(part-spec "PARTS:" _part ...)
-  #'(begin _part ...))
-
-(define-inverting #'(part _partname "(" (_pin _val) ... (_lastpin _pinout) ")" ";")
-  #'(define _pinout (call-part _partname [_pin _val] ...)))
-
-(define-cases #'pin-val-pair
-  [#'(_ _pin "=" _val ",") #'(_pin _val)]
-  [#'(_ _pin "=" _val) #'(_pin _val)])
 
 (define #'(call-part _partname [_pin _val] ...)
   (inject-syntax ([#'part-path (findf file-exists? (list (format "~a.hdl" (syntax->datum #'_partname)) (format "~a.hdl.rkt" (syntax->datum #'_partname))))]
diff --git a/beautiful-racket/br/demo/hdl/parser.rkt b/beautiful-racket/br/demo/hdl/parser.rkt
index 242ac90..a88109c 100644
--- a/beautiful-racket/br/demo/hdl/parser.rkt
+++ b/beautiful-racket/br/demo/hdl/parser.rkt
@@ -1,21 +1,17 @@
 #lang brag
 
-;; rule of thumb: use [optional] bits judiciously as they multiply the cases needed for a production rule
-;; rule of thumb: for a set of related IDs, put each into the same grammar entity
-;; rule of thumb: avoid mushing unrelated IDs into one grammar entity
-;; whereas a * corresponds directly to an ... in the expander macro
-;; syntax patterns are good for
-;; + single case / nonrecursive structure
-;; + nonalternating pattern (no "this that this that ...")
+chip-program : /"CHIP" chipname /"{" pin-spec pin-spec part-spec /"}"
 
-chip-program : "CHIP" ID "{" pin-spec pin-spec part-spec "}"
+@chipname : ID
 
-pin-spec : ("IN" | "OUT") pin+ ";"
+pin-spec : (/"IN" | /"OUT") pin [/"," pin]* /";"
 
-pin : ID [","]
+@pin : ID
 
-part-spec : "PARTS:" part+
+part-spec : /"PARTS:" part+
 
-part : ID "(" pin-val-pair+ ")" ";"
+part : partname /"(" pin-val-pair [/"," pin-val-pair]* /")" /";"
 
-pin-val-pair : ID "=" ID [","]
\ No newline at end of file
+@partname : ID
+
+/pin-val-pair : pin /"=" ID
\ No newline at end of file