From da34097807a94f9c6448f0ed0cd6bb47c429217b Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Mon, 25 Apr 2016 11:45:53 -0700
Subject: [PATCH] sort of works

---
 beautiful-racket/br/demo/hdl/Not2.hdl.rkt  |  5 ++-
 beautiful-racket/br/demo/hdl/expander.rkt  | 50 +++++++++++++++++++---
 beautiful-racket/br/demo/hdl/expander0.rkt |  5 ++-
 beautiful-racket/br/demo/hdl/parser.rkt    | 11 ++---
 4 files changed, 54 insertions(+), 17 deletions(-)

diff --git a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt
index 7bfe1ce..553a72c 100644
--- a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt
+++ b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt
@@ -1,8 +1,9 @@
 #lang br/demo/hdl
 
 CHIP Not {
-          IN x, y, z;
-}
+          IN a, b, c, d;
+             OUT x, y, z;
+             }
 
 
 
diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt
index 2620f01..b0ac82d 100644
--- a/beautiful-racket/br/demo/hdl/expander.rkt
+++ b/beautiful-racket/br/demo/hdl/expander.rkt
@@ -1,9 +1,47 @@
 #lang br
 (provide (all-from-out br) (all-defined-out))
+(require "expander0.rkt")
 
-;; todo: extract identifiers from _pin-spec
-;; and introduce them
-(define #'(chip-program "CHIP" _id "{" _pin-spec "}")
-  #'(begin
-      (define _id 0)
-      ))
\ No newline at end of file
+
+#|
+
+Be your own binding procedure.
+Part parser should generate inner `define`.
+input-pin-spec parser should generate kw procedure.
+chip-name parser should generate outer define/provide form.
+
+(chip Not
+      (x)
+      (y))
+
+|#
+
+(define-for-syntax (remove-commas stx-expr)
+  (filter (λ(i)
+            (not (equal? "," (syntax->datum i)))) (syntax->list stx-expr)))
+
+(define #'(pin-spec-out "OUT" _pin-or-comma ... ";")
+  (with-syntax ([(_pinid ...) (remove-commas #'(_pin-or-comma ...))])
+    #'(begin
+        (define _pinid '(1 2 3 4)) ...
+        (list _pinid ...))))
+
+(define #'(make-kw-procedure (pin-spec-in "IN" _pin-or-comma ... ";") _pin-spec-out)
+  (with-syntax ([(_pinid ...) (remove-commas #'(_pin-or-comma ...))])
+    #'(make-keyword-procedure
+       (λ (kws kw-args . rest)
+         (define kw-pairs (map cons kws kw-args))
+         (let ([_pinid (cdr (assq (string->keyword (format "~a" '_pinid)) kw-pairs))] ...)
+           
+           _pin-spec-out)))))
+
+
+
+(define #'(chip-program "CHIP" _topid "{" _pin-spec-in _pin-spec-out "}")
+  #`(begin
+      (provide _topid)
+      (define _topid
+        (make-kw-procedure _pin-spec-in _pin-spec-out)
+        )
+      (require rackunit)
+      (check-equal? (_topid #:a 1 #:b 2 #:c 3 #:d 4) '((1 2 3 4)(1 2 3 4)(1 2 3 4)))))
\ No newline at end of file
diff --git a/beautiful-racket/br/demo/hdl/expander0.rkt b/beautiful-racket/br/demo/hdl/expander0.rkt
index b7a23f3..5b464d7 100644
--- a/beautiful-racket/br/demo/hdl/expander0.rkt
+++ b/beautiful-racket/br/demo/hdl/expander0.rkt
@@ -1,9 +1,10 @@
 #lang br
 (provide (all-from-out br) chip)
 
+
 (define #'(chip _Chip
                 (_input-pin ...)
-                (_output-pin)
+                (_output-pin ...)
                 ((_Part [_pin-in _val-id] ... [out _pin-out]) ...))
   #'(begin
       (provide _Chip)
@@ -13,7 +14,7 @@
            (define kw-pairs (map cons kws kw-args))
            (let ([_input-pin (cdr (assq (string->keyword (format "~a" '_input-pin)) kw-pairs))] ...)
              (define _pin-out (call-part _Part [_pin-in _val-id] ...)) ...
-             _output-pin))))))
+             (values _output-pin ...)))))))
 
 (define #'(call-part _Part [_pin-in _val-id] ...)
   (with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))]
diff --git a/beautiful-racket/br/demo/hdl/parser.rkt b/beautiful-racket/br/demo/hdl/parser.rkt
index 7dc003f..fee0fb2 100644
--- a/beautiful-racket/br/demo/hdl/parser.rkt
+++ b/beautiful-racket/br/demo/hdl/parser.rkt
@@ -1,13 +1,10 @@
 #lang ragg
 
-chip-program : "CHIP" ID "{" pin-spec "}"
+chip-program : "CHIP" ID "{" pin-spec-in pin-spec-out "}"
 
-pin-spec : ("IN" | "OUT") pin-list ";"
+pin-spec-in : "IN" ID ["," ID]* ";"
 
-pin-list : ID ["," pin-list]
+pin-spec-out : "OUT" ID ["," ID]* ";"
 
-part-spec : "PARTS:" part+
 
-part : ID "(" part-arg-list ")" ";"
-
-part-arg-list : ID "=" ID ["," part-arg-list]
\ No newline at end of file
+part-spec : "PARTS:" [ID "(" [ID "=" ID]+ ")" ";"]+