resume in mux

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

@@ -16,5 +16,6 @@ CHIP DMux {
     OUT a, b;
 
     PARTS:
-    Not
+    And(a=in, b=sel, out=a);
+    And(a=in, b=sel, out=b);
 }

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

@@ -0,0 +1,39 @@
+#lang racket
+(require "Mux.hdl.rkt")
+(require rackunit)
+
+(Mux-sel 0)
+
+(Mux-a 0)
+(Mux-b 0)
+(check-equal? (Mux-out) (Mux-a))
+
+(Mux-a 0)
+(Mux-b 1)
+(check-equal? (Mux-out) (Mux-a))
+
+(Mux-a 1)
+(Mux-b 0)
+(check-equal? (Mux-out) (Mux-a))
+
+(Mux-a 1)
+(Mux-b 1)
+(check-equal? (Mux-out) (Mux-a))
+
+(Mux-sel 1)
+
+(Mux-a 0)
+(Mux-b 0)
+(check-equal? (Mux-out) (Mux-b))
+
+(Mux-a 0)
+(Mux-b 1)
+(check-equal? (Mux-out) (Mux-b))
+
+(Mux-a 1)
+(Mux-b 0)
+(check-equal? (Mux-out) (Mux-b))
+
+(Mux-a 1)
+(Mux-b 1)
+(check-equal? (Mux-out) (Mux-b))

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

@@ -16,8 +16,10 @@ CHIP Mux {
     OUT out;
 
     PARTS:
-    // Put your code here:
     Not(in=sel, out=sel-opposite);
-    And(a=a, b=sel-opposite, out=maybe-a);
+    Not(in=a, out=not-a);
+    Or(a=not-a, b=sel-opposite, out=maybe-a);
+    Not(in=b, out=not-b);
+    Or(a=not-b, b=sel, out=maybe-b);
     Or(a=maybe-a, b=b, out=out);
 }

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

@@ -2,9 +2,8 @@
 (provide (prefix-out Nand- (all-defined-out)))
 (require "helper.rkt")
 
-(define a (make-bus))
-(define b (make-bus))
-
+(define-input-bus a)
+(define-input-bus b)
 
 (define (out . etc)
   (if (< (+ (a) (b)) 2)

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

@@ -13,4 +13,4 @@ CHIP Not {
 (chip-program Not
               (in-spec (in 8) (a))
               (out-spec (out 8))
-              (part-spec (part Nand ((a) (in)) ((b) (in)) ((out) (out)))))
+              (part Nand (a in) (b in) (out out)))

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

@@ -1,11 +1,11 @@
 #lang br/demo/hdl
 
 CHIP Not {
-          IN in[8];
+          IN in;
           OUT out;
              
           PARTS:
-          Nand(a[2..4]=in, b=011, c=true, out[3]=v);
+          Nand(a=in, b=in, out=out);
 }
 
 

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

@@ -9,31 +9,30 @@
 (define #'(chip-program _chipname
                         (in-spec (_input-pin _input-width ...) ...)
                         (out-spec (_output-pin _output-width ...) ...)
-                        . args)
+                        _part ...)
   (with-syntax ([chip-prefix (format-id #'_chipname "~a-" #'_chipname)])
-    #''(begin
+    #'(begin
          (provide (prefix-out chip-prefix (combine-out _input-pin ... _output-pin ...))) 
-         (define _input-pin (make-bus '_input-pin _input-width ...)) ...
-         . args)))
+         (define-input-bus _input-pin _input-width ...) ...
+         _part ...)))
 
 #;(define #'(chip-program _chipname
                           (in-spec (_input-pin _input-width ...) ...)
                           (out-spec (_output-pin _output-width ...) ...)
                           (part-spec (part _partname ((_pin _pinwhich ...) (_val _valwhich ...)) ... ) ...))
     (with-syntax ([chip-prefix (format-id #'_chipname "~a-" #'_chipname)])
-      #''(begin
+      #'(begin
            (provide (prefix-out chip-prefix (combine-out _input-pin ... _output-pin ...))) 
            (define _input-pin (make-bus _input-width ...)) ...
-           #;(define _output-pin (make-bus _output-width ...)) #;...
            (handle-part _partname (_pin (or #f _pinwhich ...) (_val (or #f _valwhich ...))) ...) ...)))
 
 
-(define #'(handle-part _prefix [_suffix _which _arg] ...)
+(define #'(part _prefix [_suffix _arg ...] ...)
   (with-syntax ([(prefix-suffix ...) (map (λ(s) (format-id s "~a-~a" #'_prefix s)) (syntax->list #'(_suffix ...)))]
                 [chip-module-path (datum->syntax #'_prefix (format "~a.hdl.rkt" (syntax->datum #'_prefix)))])
     #'(begin
         (require (import-chip chip-module-path) (for-syntax (import-chip chip-module-path)))
-        (handle-wires [prefix-suffix _which _arg] ...))))
+        (handle-wires [prefix-suffix _arg ...] ...))))
 
 
 (define-syntax import-chip
@@ -48,11 +47,12 @@
   (let-values ([(in-wire-stxs out-wire-stxs)
                 (partition (λ(wirearg-pair-stx)
                              (define wire-stx (car (syntax->list wirearg-pair-stx)))
-                             (input-wire? (syntax-local-eval wire-stx)))
+                             (input-bus? (syntax-local-eval wire-stx)))
                            (syntax->list #'(_wirearg-pair ...)))])
     (with-syntax ([([in-wire . in-args] ...) in-wire-stxs]
-                  [([out-wire which (out-arg . args)] ...) out-wire-stxs])
+                  [([out-wire out-arg ... out-bus] ...) out-wire-stxs])
       #'(begin
-          (define (out-arg)
+          (define-output-bus out-bus
+            (λ ()
             (in-wire . in-args) ...
-            (out-wire which)) ...))))
+            (out-wire out-arg ...))) ...))))

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

@@ -2,46 +2,180 @@
 (require racket/match racket/list)
 (provide (all-defined-out))
 
+(module+ test
+  (require rackunit))
+
+(define (bitwise-bit-set x bit)
+  (if (not (bitwise-bit-set? x bit))
+      (bitwise-ior x (expt 2 bit))
+      x))
+
+(define (bitwise-bit-unset x bit)
+  (if (bitwise-bit-set? x bit)
+      (bitwise-and x (bitwise-not (expt 2 bit)))
+      x))
+
+(module+ test
+  (define x-bitset (string->number "1011" 2)) ; decimal 11
+  
+  (check-true (bitwise-bit-set? x-bitset 0))
+  (check-true (bitwise-bit-set? x-bitset 1))
+  (check-false (bitwise-bit-set? x-bitset 2))
+  (check-true (bitwise-bit-set? x-bitset 3))
+  
+  (set! x-bitset (bitwise-bit-set x-bitset 2))
+  (check-true (bitwise-bit-set? x-bitset 2))
+  
+  (set! x-bitset (bitwise-bit-unset x-bitset 2))
+  (check-false (bitwise-bit-set? x-bitset 2)))
+
 (define (bus-range start [finish start])
   (range start (add1 finish)))
 
-(define-values (input-wire input-wire? input-wire-get)
-  (make-impersonator-property 'input-wire))
+(define-values (input-bus input-bus? input-bus-get)
+  (make-impersonator-property 'input-bus))
+
+(define (integer->bitvals int width)
+  (reverse (for/list ([i (in-range width)])
+                     (bitwise-bit-field int i (add1 i)))))
+
+(define max-bus-width 16)
 
-(define (make-bus bus-name [width 1])
-  (impersonate-procedure 
+(define (check-bit-against-width bus-name bit width)
+  (unless (< bit width)
+    (raise-argument-error bus-name (format "bit less than bus width ~a" width) bit)))
+
+(require sugar/debug)
+(define (make-input-bus bus-name [width 1])
+  (impersonate-procedure
    (procedure-rename
     (let ([bus-width width]
           [bus-val 0])
-      (define (do-arg-check arg)
-        (when (and arg (> arg (expt 2 bus-width)))
-          (raise-argument-error bus-name (format "value that fits into bus width ~a (= under ~a)" bus-width (expt 2 bus-width)) arg)))
-      (case-lambda
-        [() bus-val]
-        [(arg)
-         (do-arg-check arg)
-         (set! bus-val arg)]
-        [(bus-bits arg)
-         (unless (and (< (first bus-bits) bus-width) (< (last bus-bits) bus-width))
-           (raise-argument-error bus-name (format "bus bit spec less than bus width ~a" bus-width) bus-bits))
-         (do-arg-check arg)
-         (set! bus-val arg)])) bus-name)
-   #f input-wire #t))
+      (unless (<= bus-width max-bus-width)
+        (raise-argument-error bus-name (format "bus width <= max width ~a" max-bus-width) bus-width))
+      (define (check-val-against-width val width)
+        (when (and val (> val (sub1 (expt 2 width))))
+          (raise-argument-error bus-name
+                                (format "~a-bit value (0 to ~a inclusive)" width (sub1 (expt 2 width))) val)))
+      (define func
+        (case-lambda
+          [() bus-val]
+          [(new-val-in)
+           (define new-val (cond
+                             [(boolean? new-val-in)
+                               (if new-val-in (sub1 (expt 2 bus-width)) 0)]
+                             [(or (input-bus? new-val-in) (output-bus? new-val-in)) (new-val-in)]
+                             [else new-val-in]))
+           (check-val-against-width new-val bus-width)
+           (set! bus-val new-val)]
+          [(bit new-val) (func bit bit new-val)]
+          [(first-bit last-bit new-val-in)
+           (define bit-range-width (add1 (- last-bit first-bit)))
+           (define new-val (cond
+                             [(boolean? new-val-in)
+                               (if new-val-in (sub1 (expt 2 bit-range-width)) 0)]
+                             [(or (input-bus? new-val-in) (output-bus? new-val-in)) (new-val-in)]
+                             [else new-val-in]))
+           (unless (<= first-bit last-bit)
+             (raise-argument-error bus-name (format "last bit greater than or equal to first bit ~a" first-bit) last-bit))
+           (check-bit-against-width bus-name first-bit bus-width)
+           (check-bit-against-width bus-name last-bit bus-width)
+           (check-val-against-width new-val bit-range-width)
+           (for ([bit (in-range first-bit (add1 last-bit))]
+                 [new-bit-val (in-list (integer->bitvals new-val bit-range-width))])
+                (set! bus-val ((if (= 1 new-bit-val) bitwise-bit-set bitwise-bit-unset) bus-val bit)))]))
+      func)
+    bus-name)
+   #f input-bus #t))
+
+(define-syntax-rule (define-input-bus id arg ...)
+  (define id (make-input-bus 'id arg ...)))
 
 (module+ test
-  (require rackunit)
-  (define in-wire (make-bus 'in-wire))
+  (define-input-bus in-bus)
   (define other (λ () (+ 2 2)))
-  (check-true (input-wire? in-wire))
-  (check-false (input-wire? other))
+  (check-true (input-bus? in-bus))
+  (check-false (input-bus? other))
   
-  (define x (make-bus 'x 4))
-  (check-equal? (x) 0)
-  (x 12)
-  (check-equal? (x) 12)
-  (x 0)
-  (check-equal? (x) 0)
-  (x 12)
-  (check-equal? (x) 12)
-  (check-exn exn:fail? (λ () (x 32)))
+  (define-input-bus ib 4)
+  (check-exn exn:fail? (λ () (define-input-bus ib 17) ib)) ; exceeds 16-bit width
+  (check-equal? (ib) 0)
+  (ib 11) ; set whole value
+  (check-exn exn:fail? (λ () (ib #b11111))) ; overflow
+  (ib 2 1) ; set bit
+  (check-equal? (ib) #b1111)  
+  (ib 0 #b0) ; set bit
+  (ib 1 #b0) ; set bit
+  (ib 2 #b0) ; set bit
+  (check-equal? (ib) #b1000)
+  (check-exn exn:fail? (λ () (ib 5 1 #b0))) ; last index smaller than first
+  (check-exn exn:fail? (λ () (ib 1 300 #b0))) ; overlarge bit index
+  (check-exn exn:fail? (λ () (ib 300 500 #b0))) ; overlarge bit index
+  (check-exn exn:fail? (λ () (ib 1 #b11111))) ; overflow value
+  (ib 0)
+  (ib 1 2 #b11) 
+  (check-equal? (ib) #b0110)
+  (ib 3 3 #b1)
+  (ib 0 0 #b1)
+  (check-equal? (ib) #b1111)
+  (check-exn exn:fail? (λ () (ib 0 300 #b0))) ; overlarge bit index
+  (check-exn exn:fail? (λ () (ib 1 1 #b11111))) ; overflow value
+  (ib 0)
+  (ib 1 2 #t) ; using #t to fill certain bits
+  (check-equal? (ib) #b0110)
+  (ib 2 2 #f) ; using #f to fill certain bits
+  (check-equal? (ib) #b0010)
+  (ib 0)
+  (ib #t) ; using #t to fill all bits
+  (check-equal? (ib) #b1111)
+  (ib #f) ; using #f to fill all bits
+  (check-equal? (ib) #b0000)
+  (define-input-bus ib2 4)
+  (check-exn exn:fail? (λ () (ib2 16))) ; overflow value
+  (ib2 #b1100)
+  (ib ib2) ; using bus as input value
+  (check-equal? (ib) (ib2))
+  )
+
+
+(define-values (output-bus output-bus? output-bus-get)
+  (make-impersonator-property 'output-bus))
+
+(define (make-output-bus bus-name thunk [width 1])
+  (impersonate-procedure
+   (procedure-rename
+    (let ([bus-width width])
+      (unless (<= bus-width max-bus-width)
+        (raise-argument-error bus-name (format "bus width <= max width ~a" max-bus-width) bus-width))
+      (define func
+        (case-lambda
+          [() (func 0 (sub1 bus-width))]
+          [(bit) (func bit bit)]
+          [(first-bit last-bit)
+           (unless (<= first-bit last-bit)
+             (raise-argument-error bus-name (format "last bit greater than or equal to first bit ~a" first-bit) last-bit))
+           (check-bit-against-width bus-name first-bit bus-width)
+           (check-bit-against-width bus-name last-bit bus-width)
+           (bitwise-bit-field (thunk) first-bit (add1 last-bit))]))
+      func)
+    bus-name)
+   #f output-bus #t))
+
+(define-syntax-rule (define-output-bus id thunk arg ...)
+  (define id (make-output-bus 'id thunk arg ...)))
+
+(module+ test
+  (define-output-bus ob (λ () #b0110) 4)
+  (check-exn exn:fail? (λ () (define-input-bus ob (λ () #b0110) 17) ob)) ; exceeds 16-bit width
+  (check-equal? (ob) #b0110)
+  (check-equal? (ob 0) #b0)
+  (check-equal? (ob 1) #b1)
+  (check-equal? (ob 2) #b1)
+  (check-equal? (ob 3) #b0)
+  (check-exn exn:fail? (λ () (ob 5))) ; exceeds bus width
+  (check-equal? (ob 0 1) #b10)
+  (check-equal? (ob 1 2) #b11)
+  (check-equal? (ob 2 3) #b01)
+  (check-exn exn:fail? (λ () (ob 3 2))) ; inverted bus spec
+  (check-exn exn:fail? (λ () (ob 5 10))) ; exceeds bus width
   )

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

@@ -12,7 +12,7 @@ out-spec : pin-spec
 
 /pin : ID  [/"[" NUMBER /"]"]
 
-part-spec : /"PARTS:" part+
+@part-spec : /"PARTS:" part+
 
 part : partname /"(" pin-val-pair [/"," pin-val-pair]* /")" /";"
 
@@ -20,7 +20,7 @@ part : partname /"(" pin-val-pair [/"," pin-val-pair]* /")" /";"
 
 /pin-val-pair : ID  [/"[" bus-range /"]"] /"=" pin-val
 
-bus-range : NUMBER [/"." /"." NUMBER]
+@bus-range : NUMBER [/"." /"." NUMBER]
 
 @pin-val : ID
          | BINARY-NUMBER

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

@@ -16,10 +16,10 @@
        [(union #\tab #\space #\newline) (get-token input-port)]
        [(union "CHIP" "IN" "OUT" "PARTS:") lexeme]
        [(char-set "[]{}(),;=.") lexeme]
-       ["true" (token 'TRUE 1)]
-       ["false" (token 'FALSE 0)]
+       ["true" (token 'TRUE #t)]
+       ["false" (token 'FALSE #f)]
        [(repetition 1 +inf.0 (char-set "01")) (token 'BINARY-NUMBER (string->number lexeme 2))]
        [(repetition 1 +inf.0 numeric) (token 'NUMBER (string->number lexeme))]
-       [(seq (repetition 1 1 alphabetic) (repetition 0 +inf.0 (union alphabetic numeric))) (token 'ID (string->symbol lexeme))]))
+       [(seq (repetition 1 1 alphabetic) (repetition 0 +inf.0 (union alphabetic numeric "-"))) (token 'ID (string->symbol lexeme))]))
     (get-token input-port))  
   next-token)