From c574ce3b5452df3bd06a2c35ed88e89c0c879513 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 13 May 2016 15:18:22 -0700 Subject: [PATCH] use cleaner grammar notation --- beautiful-racket/br/demo/hdl-tst/expander.rkt | 78 +++++++------------ 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, 37 insertions(+), 65 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-inverting #'(load-expr "load" (_filename-string _procname) ",") - #'(_filename-string _procname)) - -(define #'(filename _filename) +(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 #'(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-cases #'step-expr - [#'(_ _step) #'_step] - [#'(_ _step ",") #'_step]) - - -(define #'(set-expr "set" _id _val) - #'(_id _val)) - - -(define #'(eval-expr "eval") - #'(void)) - +(define #'eval-expr #'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]))