start hdl

beautiful-racket/br/demo/hdl/And.hdl

@@ -0,0 +1,7 @@
+#lang racket/base
+(provide And)
+(define (And #:a a #:b b)
+  (define out (if (and (not (zero? a)) (not (zero? b)))
+                  1
+                  0))
+  out)

beautiful-racket/br/demo/hdl/Not.hdl

@@ -0,0 +1,7 @@
+#lang racket/base
+(provide Not)
+(define (Not #:in in)
+  (define out (if (zero? in)
+                  1
+                  0))
+  out)

beautiful-racket/br/demo/hdl/Or.hdl

@@ -0,0 +1,7 @@
+#lang racket/base
+(provide Or)
+(define (Or #:a a #:b b)
+  (define out (if (or (not (zero? a)) (not (zero? b)))
+                  1
+                  0))
+  out)

beautiful-racket/br/demo/hdl/Xor0.hdl

@@ -0,0 +1,37 @@
+#lang racket/base
+(provide Xor)
+
+(define Xor
+  (make-keyword-procedure
+   (λ (kws kw-args . rest)
+     (define kw-pairs (map cons kws kw-args))
+     (let ([a (cdr (assq (string->keyword (format "~a" 'a)) kw-pairs))]
+           [b (cdr (assq (string->keyword (format "~a" 'b)) kw-pairs))])
+       (define nota
+         (let ()
+           (local-require "Not.hdl")
+           (Not #:in a)))
+       (define notb
+         (let ()
+           (local-require "Not.hdl")
+           (Not #:in b)))
+       (define w1
+         (let ()
+           (local-require "And.hdl")
+           (And #:a a #:b notb)))
+       (define w2
+         (let ()
+           (local-require "And.hdl")
+           (And #:a nota #:b b)))
+       (define out
+         (let ()
+           (local-require "Or.hdl")
+           (Or #:a w1 #:b w2)))
+       out))))
+
+(module+ test
+  (require rackunit)
+  (check-equal? (Xor #:a 0 #:b 0) 0)
+  (check-equal? (Xor #:a 0 #:b 1) 1)
+  (check-equal? (Xor #:a 1 #:b 0) 1)
+  (check-equal? (Xor #:a 1 #:b 1) 0))

beautiful-racket/br/demo/hdl/Xor1.hdl

@@ -0,0 +1,18 @@
+#lang s-exp "hdl.rkt"
+
+(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])))
+
+
+(module+ test
+  (require rackunit)
+  (check-equal? (Xor #:a 0 #:b 0) 0)
+  (check-equal? (Xor #:a 0 #:b 1) 1)
+  (check-equal? (Xor #:a 1 #:b 0) 1)
+  (check-equal? (Xor #:a 1 #:b 1) 0))

beautiful-racket/br/demo/hdl/Xor2.hdl

@@ -0,0 +1,20 @@
+#lang reader "hdl-reader.rkt"
+
+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);
+}
+
+
+(module+ test
+  (require rackunit)
+  (check-equal? (Xor #:a 0 #:b 0) 0)
+  (check-equal? (Xor #:a 0 #:b 1) 1)
+  (check-equal? (Xor #:a 1 #:b 0) 1)
+  (check-equal? (Xor #:a 1 #:b 1) 0))

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

@@ -0,0 +1,27 @@
+#lang br
+(provide #%module-begin #%top-interaction #%top #%app #%datum module+ require chip)
+
+
+(define #'(chip _Chip
+                (IN _input-pin ...)
+                (OUT _output-pin)
+                (PARTS
+                 (_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))))
+