resume in require transformer for Not2

beautiful-racket/br/demo/hdl/Fanout.hdl.rkt

@@ -0,0 +1,11 @@
+#lang br
+(provide (prefix-out Fanout- (all-defined-out)))
+(require "helper.rkt")
+(define in (make-input))
+
+
+(define (outa)
+  (in))
+
+(define (outb)
+  (in))

beautiful-racket/br/demo/hdl/Nand2.hdl.rkt

@@ -1,24 +1,8 @@
 #lang br
-(provide (all-defined-out))
-
-(struct Nand (a b out) #:transparent)
-
-(define (make-Nand)
-  (Nand a b out))
-
-(define a
-  (let ([Nand-a-val 0])
-    (λ ([val #f])
-      (if val
-          (set! Nand-a-val val)
-          Nand-a-val))))
-
-(define b
-  (let ([Nand-b-val 0])
-    (λ ([val #f])
-      (if val
-          (set! Nand-b-val val)
-          Nand-b-val))))
+(provide (prefix-out Nand2- (all-defined-out)))
+(require "helper.rkt")
+(define a (make-input))
+(define b (make-input))
 
 
 (define (out)
@@ -33,4 +17,4 @@
   (check-equal? (begin (a 1) (b 0) (out)) 1)
   (check-equal? (begin (a 1) (b 1) (out)) 0))
 
-(define n (make-Nand))
+#;(define n (make-Nand))

beautiful-racket/br/demo/hdl/Not2.hdl.rkt

@@ -3,25 +3,36 @@
 
 CHIP Not {
           IN in;
-          OUT out;
+          OUT out, outb;
              
              PARTS:
-             Nand(a=in, b=in, out=out);
+             ;; each part has only as many args as wires in that part
+             Nand(a=in, b=in, out=nand-out); 
+             Fanout(in=nand-out, outa=out, outb=outb);
              
              }
 
 |#
 
-(provide (prefix-out Not- (all-defined-out)))
+(require "helper.rkt" "helper-macro.rkt" (for-syntax "helper.rkt" racket/syntax racket/list))
 
-(require "Nand2.hdl.rkt")
+;; IN and OUT spec becomes provide spec, prefixed with chip name
+(provide (prefix-out Not- (combine-out in out outb))) 
 
-(define in
-  (let ([in-val 0])
-    (λ ([val #f])
-      (if val
-          (set! in-val val)
-          in-val))))
+;; all IN and OUT pins are functions.
 
-(define n (make-Nand))
-(define (out) (begin ((Nand-a n) (in)) ((Nand-b n) (in)) ((Nand-out n))))
+(define in (make-input)) ; all inputs are made from the same function that holds state like a parameter.
+
+;; all outputs are computed at runtime.
+(require "Nand2.hdl.rkt" (for-syntax "Nand2.hdl.rkt"))
+(handle-part Nand2 [a in] [b in] [out nand-out])
+(require "Fanout.hdl.rkt" (for-syntax "Fanout.hdl.rkt"))
+(handle-part Fanout [in nand-out] [outa out] [outb outb])
+;(handle-require Fanout [in nand-out] [outa out] [outb outb])
+
+(module+ test
+  (require rackunit)
+  (in 1)
+  (check-equal? (out) 0)
+  (in 0)
+  (check-equal? (out) 1))

beautiful-racket/br/demo/hdl/helper-macro.rkt

@@ -0,0 +1,35 @@
+#lang racket/base
+(require (for-syntax racket/base racket/syntax "helper.rkt" racket/list))
+(provide (all-defined-out))
+
+
+(define-syntax (handle-require stx)
+  (syntax-case stx ()
+    [(_ prefix [suffix arg] ...)
+     (with-syntax ([(prefix-suffix ...) (map (λ(s) (format-id s "~a-~a" #'prefix s)) (syntax->list #'(suffix ...)))]
+                   [module-name (format "~a.hdl.rkt" (syntax->datum #'prefix))])
+       #'(begin
+           (local-require module-name (for-syntax module-name))
+           (handle-wires [prefix-suffix arg] ...)))]))
+
+
+(define-syntax (handle-part stx)
+  (syntax-case stx ()
+    [(_ prefix [suffix arg] ...)
+     (with-syntax ([(prefix-suffix ...) (map (λ(s) (format-id s "~a-~a" #'prefix s)) (syntax->list #'(suffix ...)))]
+                   [module-name (format "~a.hdl.rkt" (syntax->datum #'prefix))])
+       #'(begin
+           (require module-name (for-syntax module-name))
+           (handle-wires [prefix-suffix arg] ...)))]))
+
+
+(define-syntax (handle-wires stx)
+  (syntax-case stx ()
+    [(_ [wire arg] ...)
+     (let ()
+       (define-values (in-wires out-wires) (partition (λ(stx) (let ([wire (car (syntax->list stx))])
+                                                                (input-wire? (syntax-local-eval wire)))) (syntax->list #'([wire arg] ...))))
+       (with-syntax ([([in-wire in-arg] ...) in-wires]
+                     [([out-wire out-arg] ...) out-wires])
+         #'(begin
+             (define out-arg (λ () (in-wire (in-arg)) ... (out-wire))) ...)))]))

beautiful-racket/br/demo/hdl/helper.rkt

@@ -0,0 +1,21 @@
+#lang racket/base
+(provide (all-defined-out))
+
+(define-values (input-wire input-wire? input-wire-get)
+  (make-impersonator-property 'input-wire))
+
+(define (make-input)
+  (impersonate-procedure 
+   (let ([val #f])
+     (λ ([arg #f])
+       (if arg
+           (set! val arg)
+           val)))
+   #f input-wire #t))
+
+(module+ test
+  (require rackunit)
+  (define in-wire (make-input))
+  (define other (λ () (+ 2 2)))
+  (check-true (input-wire? in-wire))
+  (check-false (input-wire? other)))