From c574ce3b5452df3bd06a2c35ed88e89c0c879513 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 13 May 2016 15:18:22 -0700
Subject: [PATCH] use cleaner grammar notation
---
beautiful-racket/br/demo/hdl-tst/expander.rkt | 74 ++++++-------------
beautiful-racket/br/demo/hdl-tst/parser.rkt | 20 +++--
.../br/demo/hdl/{Mux.hdl => Mux.hdl.rkt} | 0
beautiful-racket/br/demo/hdl/Mux.tst.rkt | 2 +-
beautiful-racket/br/demo/hdl/expander.rkt | 2 +-
5 files changed, 35 insertions(+), 63 deletions(-)
rename beautiful-racket/br/demo/hdl/{Mux.hdl => Mux.hdl.rkt} (100%)
diff --git a/beautiful-racket/br/demo/hdl-tst/expander.rkt b/beautiful-racket/br/demo/hdl-tst/expander.rkt
index 3639879..214e982 100644
--- a/beautiful-racket/br/demo/hdl-tst/expander.rkt
+++ b/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)))
diff --git a/beautiful-racket/br/demo/hdl-tst/parser.rkt b/beautiful-racket/br/demo/hdl-tst/parser.rkt
index 33e203f..cfd7637 100644
--- a/beautiful-racket/br/demo/hdl-tst/parser.rkt
+++ b/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"
\ No newline at end of file
+output-expr : /"output"
\ No newline at end of file
diff --git a/beautiful-racket/br/demo/hdl/Mux.hdl b/beautiful-racket/br/demo/hdl/Mux.hdl.rkt
similarity index 100%
rename from beautiful-racket/br/demo/hdl/Mux.hdl
rename to beautiful-racket/br/demo/hdl/Mux.hdl.rkt
diff --git a/beautiful-racket/br/demo/hdl/Mux.tst.rkt b/beautiful-racket/br/demo/hdl/Mux.tst.rkt
index 0f20c9c..66e1129 100644
--- a/beautiful-racket/br/demo/hdl/Mux.tst.rkt
+++ b/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.
diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt
index 80bda77..38e47b0 100644
--- a/beautiful-racket/br/demo/hdl/expander.rkt
+++ b/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]))