use cleaner grammar notation

beautiful-racket/br/demo/hdl-tst/expander.rkt

@@ -8,77 +8,51 @@
       (displayln (format "got unbound identifier: ~a" 'id))
       (procedure-rename (λ xs (cons 'id xs)) (string->symbol (format "undefined:~a" 'id)))))
 
-(define-inverting #'(tst-program _arg ...)
+(define #'(tst-program _arg ...)
   #'(begin 
       _arg ...))
 
 (define-for-syntax output-here #'output-here)
 
-(define-inverting #'(header-expr (_filename-string _procname) (_colid ... _outid) ";")
-  (inject-syntax ([#'shared-procname (shared-syntax #'_procname)]
-                  [#'output (shared-syntax 'output)])
-    #'(begin
-        (provide (all-defined-out))
-        (define shared-procname (dynamic-require (findf file-exists? (list _filename-string (format "~a.rkt" _filename-string))) 'shared-procname))
-        (display-header '_colid ... '_outid)
-        (define _colid (make-parameter 0)) ...
-        (define (_outid)
-          (keyword-apply shared-procname
-                         (map (compose1 string->keyword symbol->string) (list '_colid ...))
-                         (list (_colid) ...) null))
-        
-        (define (output)
-          (display-values (_colid) ... (_outid))))))
+(define #'(header-expr _filename (_colid ... _outid))
+  (with-syntax* ([filename-string (symbol->string (syntax->datum #'_filename))]
+                 [procname (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))]
+                 [output (shared-syntax 'output)])
+  #'(begin
+      (provide (all-defined-out))
+      (define procname (dynamic-require (findf file-exists? (list filename-string (format "~a.rkt" filename-string))) 'procname))
+      (display-header '_colid ... '_outid)
+      (define _colid (make-parameter 0)) ...
+      (define (_outid)
+        (keyword-apply procname
+                       (map (compose1 string->keyword symbol->string) (list '_colid ...))
+                       (list (_colid) ...) null))
+      
+      (define (output)
+        (display-values (_colid) ... (_outid))))))
 
-(define-inverting #'(load-expr "load" (_filename-string _procname) ",")
-  #'(_filename-string _procname))
 
-(define #'(filename _filename)
+(define #'(load-expr _filename)
   (inject-syntax ([#'filename-string (symbol->string (syntax->datum #'_filename))]
                   [#'proc-name (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))])
                  #'(filename-string proc-name)))
 
-(define-inverting #'(table-expr "output-list" _column-id ...)
-  #'(_column-id ...))
-
-(define-cases #'column-id
-  [#'(_ _colid) #'_colid]
-  [#'(_ _colid ",") #'_colid])
-
-
 (define #'(display-header _sym ...)
   #'(begin
       (apply display-values (list _sym ...))
       (apply display-dashes (list _sym ...))))
 
-(define (vals->text vals)
-  (string-join (map ~a vals) " | "))
+(define (vals->text vals) (string-join (map ~a vals) " | "))
 
-(define (display-values . vals)
-  (displayln (vals->text vals)))
+(define (display-values . vals) (displayln (vals->text vals)))
 
 (define (display-dashes . vals)
   (displayln (make-string (string-length (vals->text vals)) #\-)))
 
+(define #'test-expr #'begin)
 
-(define-inverting #'(test-expr _step-expr ... ";")
-  #'(begin
-      _step-expr ...))
+(define #'eval-expr #'void)
 
-
-(define-cases #'step-expr
-  [#'(_ _step) #'_step]
-  [#'(_ _step ",") #'_step])
-
-
-(define #'(set-expr "set" _id _val)
-  #'(_id _val))
-
-
-(define #'(eval-expr "eval")
-  #'(void))
-
-
-(define #'(output-expr "output")
+(define #'(output-expr)
   (inject-syntax ([#'output (shared-syntax 'output)])
-  #'(output)))
+                 #'(output)))

beautiful-racket/br/demo/hdl-tst/parser.rkt

@@ -2,22 +2,20 @@
 
 tst-program : header-expr test-expr*
 
-header-expr : load-expr table-expr ";"
+header-expr : load-expr table-expr /";"
 
-load-expr : "load" filename ","
+@load-expr : /"load" ID /","
 
-filename : ID
+/table-expr : /"output-list" columns
 
-table-expr : "output-list" column-id+
+@columns :  ID [/"," columns]
 
-column-id :  ID [","]
+test-expr : step-expr+ /";"
 
-test-expr : step-expr+ ";"
+@step-expr : (set-expr | @eval-expr | output-expr) [/","]
 
-step-expr : (set-expr | eval-expr | output-expr) [","]
+/set-expr : /"set" ID VAL
 
-set-expr : "set" ID VAL
+eval-expr : /"eval"
 
-eval-expr : "eval"
-
-output-expr : "output"
+output-expr : /"output"

beautiful-racket/br/demo/hdl/Mux.tst.rkt

@@ -1,4 +1,4 @@
-#lang br/demo/hdl/tst
+#lang br/demo/hdl-tst
 // This file is part of www.nand2tetris.org
 // and the book "The Elements of Computing Systems"
 // by Nisan and Schocken, MIT Press.

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

@@ -33,7 +33,7 @@
   [#'(_ _pin "=" _val) #'(_pin _val)])
 
 (define #'(call-part _partname [_pin _val] ...)
-  (inject-syntax ([#'part-path (format "~a.hdl" (syntax->datum #'_partname))]
+  (inject-syntax ([#'part-path (findf file-exists? (list (format "~a.hdl" (syntax->datum #'_partname)) (format "~a.hdl.rkt" (syntax->datum #'_partname))))]
                   [#'(kw ...) (map (λ(pi) (string->keyword (format "~a" (syntax->datum pi)))) (syntax->list #'(_pin ...)))])
                  #'(let ()
                      (local-require (rename-in part-path [_partname local-name]))