From 4ac44712207d8f9c51675947cd40e47342eec939 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 24 Apr 2016 15:24:59 -0700
Subject: [PATCH] capture

---
 beautiful-racket/br/demo/hdl/And.hdl       |  2 +-
 beautiful-racket/br/demo/hdl/Not.hdl       |  2 +-
 beautiful-racket/br/demo/hdl/Or.hdl        |  2 +-
 beautiful-racket/br/demo/hdl/expander0.rkt | 23 ++++++++++++++++++++++
 4 files changed, 26 insertions(+), 3 deletions(-)
 create mode 100644 beautiful-racket/br/demo/hdl/expander0.rkt

diff --git a/beautiful-racket/br/demo/hdl/And.hdl b/beautiful-racket/br/demo/hdl/And.hdl
index bbf7067..e5f9b1b 100644
--- a/beautiful-racket/br/demo/hdl/And.hdl
+++ b/beautiful-racket/br/demo/hdl/And.hdl
@@ -1,4 +1,4 @@
-#lang s-exp br/demo/hdl/expander
+#lang s-exp br/demo/hdl/expander0
 
 (chip And
       (a b)
diff --git a/beautiful-racket/br/demo/hdl/Not.hdl b/beautiful-racket/br/demo/hdl/Not.hdl
index 5b9838f..6c9ee66 100644
--- a/beautiful-racket/br/demo/hdl/Not.hdl
+++ b/beautiful-racket/br/demo/hdl/Not.hdl
@@ -1,4 +1,4 @@
-#lang s-exp br/demo/hdl/expander
+#lang s-exp br/demo/hdl/expander0
 
 (chip Not
       (in)
diff --git a/beautiful-racket/br/demo/hdl/Or.hdl b/beautiful-racket/br/demo/hdl/Or.hdl
index a20a449..7794ab9 100644
--- a/beautiful-racket/br/demo/hdl/Or.hdl
+++ b/beautiful-racket/br/demo/hdl/Or.hdl
@@ -1,4 +1,4 @@
-#lang s-exp br/demo/hdl/expander
+#lang s-exp br/demo/hdl/expander0
 
 (chip Or
       (a b)
diff --git a/beautiful-racket/br/demo/hdl/expander0.rkt b/beautiful-racket/br/demo/hdl/expander0.rkt
new file mode 100644
index 0000000..b7a23f3
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/expander0.rkt
@@ -0,0 +1,23 @@
+#lang br
+(provide (all-from-out br) chip)
+
+(define #'(chip _Chip
+                (_input-pin ...)
+                (_output-pin)
+                ((_Part [_pin-in _val-id] ... [out _pin-out]) ...))
+  #'(begin
+      (provide _Chip)
+      (define _Chip
+        (make-keyword-procedure
+         (λ (kws kw-args . rest)
+           (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))))))
+
+(define #'(call-part _Part [_pin-in _val-id] ...)
+  (with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))]
+                [(kw ...) (map (λ(pi) (string->keyword (format "~a" (syntax->datum pi)))) (syntax->list #'(_pin-in ...)))])
+    #'(let ()
+        (local-require (rename-in part-path [_Part local-name]))
+        (keyword-apply local-name '(kw ...) (list _val-id ...) null))))