From 30d4dec8c3eec4889d63b9265c52c37c2b95587f Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 26 Apr 2016 12:39:06 -0700
Subject: [PATCH] resume in hdl/tst

---
 beautiful-racket/br/demo/hdl/Xor-test.rkt     | 56 +++++++++++++
 beautiful-racket/br/demo/hdl/Xor.hdl          | 18 ++++
 beautiful-racket/br/demo/hdl/Xor.tst          | 14 ++++
 beautiful-racket/br/demo/hdl/tokenizer.rkt    |  2 +
 beautiful-racket/br/demo/hdl/tst.rkt          |  7 ++
 beautiful-racket/br/demo/hdl/tst/expander.rkt | 82 +++++++++++++++++++
 beautiful-racket/br/demo/hdl/tst/parser.rkt   | 21 +++++
 .../br/demo/hdl/tst/tokenizer.rkt             | 19 +++++
 8 files changed, 219 insertions(+)
 create mode 100644 beautiful-racket/br/demo/hdl/Xor-test.rkt
 create mode 100644 beautiful-racket/br/demo/hdl/Xor.hdl
 create mode 100644 beautiful-racket/br/demo/hdl/Xor.tst
 create mode 100644 beautiful-racket/br/demo/hdl/tst.rkt
 create mode 100644 beautiful-racket/br/demo/hdl/tst/expander.rkt
 create mode 100644 beautiful-racket/br/demo/hdl/tst/parser.rkt
 create mode 100644 beautiful-racket/br/demo/hdl/tst/tokenizer.rkt

diff --git a/beautiful-racket/br/demo/hdl/Xor-test.rkt b/beautiful-racket/br/demo/hdl/Xor-test.rkt
new file mode 100644
index 0000000..31077cc
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/Xor-test.rkt
@@ -0,0 +1,56 @@
+#lang br
+
+#|
+load Xor.hdl,
+output-list a, b, out;
+set a 0, set b 0,
+eval, output;
+set a 0, set b 1,
+eval, output;
+set a 1, set b 0,
+eval, output;
+set a 1, set b 1,
+eval, output;
+|#
+
+(define (vals->text vals)
+  (string-join (map ~a vals) " | "))
+
+(define (display-values . vals)
+  (displayln (vals->text vals)))
+
+(define (display-dashes . vals)
+  (displayln (make-string (string-length (vals->text vals)) #\-)))
+
+(define #'(display-header _val ...)
+  #'(begin
+      (apply display-values (list '_val ...))
+      (apply display-dashes (list '_val ...))))
+
+(define (display-status)
+  (display-values a b (out)))
+
+(define proc (dynamic-require "Xor.hdl" 'Xor))
+
+(display-header a b out)
+(define a #f)
+(define b #f)
+(define (out)
+  (keyword-apply proc '(#:a #:b) (list a b) null))
+
+
+(set! a 0)
+(set! b 0)
+(display-status)
+
+(set! a 0)
+(set! b 1)
+(display-status)
+
+(set! a 1)
+(set! b 0)
+(display-status)
+
+(set! a 1)
+(set! b 1)
+(display-status)
\ No newline at end of file
diff --git a/beautiful-racket/br/demo/hdl/Xor.hdl b/beautiful-racket/br/demo/hdl/Xor.hdl
new file mode 100644
index 0000000..c869652
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/Xor.hdl
@@ -0,0 +1,18 @@
+#lang br/demo/hdl
+
+/* Xor (exclusive or) gate:
+If a<>b out=1 else out=0. */
+
+CHIP Xor {
+          IN a, b;
+             OUT out;
+             PARTS:
+             Not(in=a, out=nota);
+             Not(in=b, out=notb);
+             And(a=a, b=notb, out=w1);
+             And(a=nota, b=b, out=w2);
+             Or(a=w1, b=w2, out=out);
+}
+
+
+
diff --git a/beautiful-racket/br/demo/hdl/Xor.tst b/beautiful-racket/br/demo/hdl/Xor.tst
new file mode 100644
index 0000000..de91fd0
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/Xor.tst
@@ -0,0 +1,14 @@
+#lang br/demo/hdl/tst
+
+load Xor.hdl,
+output-list a, b, out;
+/*
+set a 0, set b 0,
+eval, output;
+set a 0, set b 1,
+eval, output;
+set a 1, set b 0,
+eval, output;
+set a 1, set b 1,
+eval, output;
+*/
\ No newline at end of file
diff --git a/beautiful-racket/br/demo/hdl/tokenizer.rkt b/beautiful-racket/br/demo/hdl/tokenizer.rkt
index 8612454..44e644b 100644
--- a/beautiful-racket/br/demo/hdl/tokenizer.rkt
+++ b/beautiful-racket/br/demo/hdl/tokenizer.rkt
@@ -9,6 +9,8 @@
     (define get-token
       (lexer
        [(eof) eof]
+       [(seq "/*" (complement (seq any-string "*/" any-string)) "*/")
+        (token 'COMMENT lexeme #:skip? #t)]
        [(union #\tab #\space #\newline) (get-token input-port)]
        [(union "CHIP" "IN" "OUT" "PARTS:") lexeme]
        [(char-set "{}(),;=") lexeme]
diff --git a/beautiful-racket/br/demo/hdl/tst.rkt b/beautiful-racket/br/demo/hdl/tst.rkt
new file mode 100644
index 0000000..3afdaf3
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/tst.rkt
@@ -0,0 +1,7 @@
+#lang br
+
+(module reader br
+  (require br/reader-utils "tst/parser.rkt" "tst/tokenizer.rkt")
+  (define-read-and-read-syntax (source-path input-port)
+    #`(module hdl-mod br/demo/hdl/tst/expander
+        #,(parse source-path (tokenize input-port)))))
diff --git a/beautiful-racket/br/demo/hdl/tst/expander.rkt b/beautiful-racket/br/demo/hdl/tst/expander.rkt
new file mode 100644
index 0000000..8a46840
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/tst/expander.rkt
@@ -0,0 +1,82 @@
+#lang br
+(provide #%top-interaction #%module-begin #%datum #%top #%app)
+
+(provide tst-program)
+(define #'(tst-program _arg ...)
+  #'(begin _arg ...))
+
+
+(define-for-syntax private-proc-name (generate-temporary))
+
+(provide load-expr)
+;; parse shape: (load-expr "load" Xor.hdl ",")
+(define #'(load-expr "load" _filename ",")
+  (inject-syntax ([#'filename-string (symbol->string (syntax->datum #'_filename))]
+                  [#'proc-name (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))])
+                 #'(begin
+                     (define _filename (dynamic-require filename-string 'proc-name)))))
+
+(begin-for-syntax
+  (define (expand-macro mac)
+    (syntax-disarm (local-expand mac 'expression #f) #f)))
+
+;; parse shape:
+;; (header-expr "output-list" a (comma-id "," b)  "," "out" ";")
+(provide header-expr)
+(define #'(header-expr "output-list" _first-id _comma-id ... "," "out" ";")
+  (inject-syntax ([#'(_other-id ...) (map expand-macro (syntax->list #'(_comma-id ...)))])
+                 #'(begin
+                     (display-header _first-id _other-id ... out)
+                     (define _first-id #f)
+                     (define _other-id #f) ...
+                     (define (out)
+                       (keyword-apply proc '(#:a #:b) (list a b) null))
+                     )))
+
+(provide comma-id)
+(define #'(comma-id "," _id)
+  #'_id)
+
+
+(define #'(display-header _val ...)
+  #'(begin
+      (apply display-values (list '_val ...))
+      (apply display-dashes (list '_val ...))))
+
+(define (vals->text vals)
+  (string-join (map ~a vals) " | "))
+
+(define (display-values . vals)
+  (displayln (vals->text vals)))
+
+(define (display-dashes . vals)
+  (displayln (make-string (string-length (vals->text vals)) #\-)))
+
+
+(provide test-expr)
+(define #'(test-expr _first-step _comma-step ... ";")
+  (inject-syntax ([#'(_other-step ...) (expand-macro #'(_comma-step ...))])
+                 #'(let ()
+                     _first-step
+                     _other-step ...)))
+
+(provide step-expr)
+(define #'(step-expr _step)
+  #'_step)
+
+(provide set-expr)
+(define #'(set-expr "set" _id _val)
+  #'(set! _id _val))
+
+(provide comma-step)
+(define #'(comma-step "," _step)
+  #'_step)
+
+(provide eval-expr)
+(define #'(eval-expr "eval")
+  #'(set! result (param-proc)))
+
+#|
+(tst-program (load-expr "load" Xor.hdl ",") (header-expr "output-list" a "," b "," out ";") (test-expr (step-expr (set-expr "set" a 0)) "," (step-expr (set-expr "set" b 0)) "," (step-expr (eval-expr "eval")) "," (step-expr (output-expr "output")) ";") (test-expr (step-expr (set-expr "set" a 0)) "," (step-expr (set-expr "set" b 1)) "," (step-expr (eval-expr "eval")) "," (step-expr (output-expr "output")) ";") (test-expr (step-expr (set-expr "set" a 1)) "," (step-expr (set-expr "set" b 0)) "," (step-expr (eval-expr "eval")) "," (step-expr (output-expr "output")) ";") (test-expr (step-expr (set-expr "set" a 1)) "," (step-expr (set-expr "set" b 1)) "," (step-expr (eval-expr "eval")) "," (step-expr (output-expr "output")) ";"))
+|#
+
diff --git a/beautiful-racket/br/demo/hdl/tst/parser.rkt b/beautiful-racket/br/demo/hdl/tst/parser.rkt
new file mode 100644
index 0000000..95926f7
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/tst/parser.rkt
@@ -0,0 +1,21 @@
+#lang ragg
+
+tst-program : load-expr header-expr test-expr*
+
+load-expr : "load" ID ","
+
+header-expr : "output-list" ID comma-id* "," "out" ";"
+
+comma-id : "," ID
+
+test-expr : step-expr comma-step* ";"
+
+comma-step : "," step-expr
+
+step-expr : set-expr | eval-expr | output-expr
+
+set-expr : "set" ID VAL
+
+eval-expr : "eval"
+
+output-expr : "output"
\ No newline at end of file
diff --git a/beautiful-racket/br/demo/hdl/tst/tokenizer.rkt b/beautiful-racket/br/demo/hdl/tst/tokenizer.rkt
new file mode 100644
index 0000000..b49a7cd
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/tst/tokenizer.rkt
@@ -0,0 +1,19 @@
+#lang br
+(require parser-tools/lex parser-tools/lex-sre
+         ragg/support
+         racket/string)
+
+(provide tokenize)
+(define (tokenize input-port)
+  (define (next-token)
+    (define get-token
+      (lexer
+       [(eof) eof]
+       [(seq "/*" (complement (seq any-string "*/" any-string)) "*/")
+        (token 'COMMENT lexeme #:skip? #t)]
+       [(union #\tab #\space #\newline) (get-token input-port)]
+       [(union "load" "output-list" "set" "eval" "output" "out" (char-set ",;")) lexeme]
+       [(repetition 1 +inf.0 numeric) (token 'VAL (string->number lexeme))]
+       [(repetition 1 +inf.0 (union alphabetic numeric (char-set "-."))) (token 'ID (string->symbol lexeme))]))
+    (get-token input-port))  
+  next-token)