resume in bit subscripts / write into input bus

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

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

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

@@ -10,7 +10,7 @@ CHIP Not {
 }
 |#
 
-#;(chip-program Not
-              (in-spec in)
-              (out-spec out)
-              (part-spec (part Nand (a in) (b in) (out out))))
+(chip-program Not
+              (in-spec (in 8) (a))
+              (out-spec (out 8))
+              (part-spec (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;
+          IN in[8];
           OUT out;
              
           PARTS:
-          Nand(a=in, b=in, out=out);
+          Nand(a[2..4]=in, b=011, c=true, out[3]=v);
 }
 
 

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

@@ -1,17 +1,31 @@
 #lang br
 (require "helper.rkt" (for-syntax racket/base racket/syntax "helper.rkt" racket/list racket/require-transform))
-(provide #%top-interaction #%module-begin #%app #%datum (all-defined-out))
+(provide #%top-interaction (rename-out [mb #%module-begin]) #%app #%datum (all-defined-out))
 
+(define #'(mb _arg ...)
+  #'(#%module-begin
+     _arg ...))
 
 (define #'(chip-program _chipname
-                        (in-spec (_input-pin _inlen ...) ...)
-                        (out-spec (_output-pin _outlen ...) ...)
-                        (part-spec (part _partname ((_pin _pinwhich ...) (_val _valwhich ...)) ... ) ...))
+                        (in-spec (_input-pin _input-width ...) ...)
+                        (out-spec (_output-pin _output-width ...) ...)
+                        . args)
   (with-syntax ([chip-prefix (format-id #'_chipname "~a-" #'_chipname)])
-    #'(begin
-        (provide (prefix-out chip-prefix (combine-out _input-pin ... _output-pin ...))) 
-        (define _input-pin (make-input _inlen ...)) ...
-        (handle-part _partname (_pin (or #f _pinwhich ...) (_val (or #f _valwhich ...))) ...) ...)))
+    #''(begin
+         (provide (prefix-out chip-prefix (combine-out _input-pin ... _output-pin ...))) 
+         (define _input-pin (make-bus '_input-pin _input-width ...)) ...
+         . args)))
+
+#;(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
+           (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] ...)

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

@@ -1,51 +1,47 @@
 #lang racket/base
+(require racket/match racket/list)
 (provide (all-defined-out))
 
+(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 (make-input [max-length 16])
+(define (make-bus bus-name [width 1])
   (impersonate-procedure 
-   (let ([max-length max-length]
-         [val 0])
-     (case-lambda
-       [() val]
-       [(bit)
-        (when (and bit (>= bit max-length))
-          (raise-argument-error 'make-input (format "bit index too large for bit length ~a" max-length) bit))
-        (if (bitwise-bit-set? val (or bit 0)) 1 0)]
-       [(bit arg)
-        (when (and bit (>= bit max-length))
-          (raise-argument-error 'make-input (format "bit index too large for bit length ~a" max-length) bit))
-        (when (and arg (> arg (expt 2 max-length)))
-          (raise-argument-error 'make-input (format "value too large for bit length ~a" max-length) arg))
-        (cond
-          [(and bit arg) (set! val (bitwise-ior val (expt 2 bit)))]
-          [else (set! val arg)])])) ;; aka (and arg (not bit))
+   (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))
 
 (module+ test
   (require rackunit)
-  (define in-wire (make-input))
+  (define in-wire (make-bus 'in-wire))
   (define other (λ () (+ 2 2)))
   (check-true (input-wire? in-wire))
   (check-false (input-wire? other))
   
-  (define x (make-input 4))
+  (define x (make-bus 'x 4))
   (check-equal? (x) 0)
-  (x #f 12)
+  (x 12)
   (check-equal? (x) 12)
-  (x #f 0)
+  (x 0)
   (check-equal? (x) 0)
-  (x 3 1)
-  (check-equal? (x) 8)
-  (x 2 1)
+  (x 12)
   (check-equal? (x) 12)
-  (check-equal? (x 3) 1)
-  (check-equal? (x 2) 1)
-  (check-equal? (x 1) 0)
-  (check-equal? (x 0) 0)
-  
-  (check-exn exn:fail? (λ () (x #f 32)))
-  (check-exn exn:fail? (λ () (x 22 1)))
+  (check-exn exn:fail? (λ () (x 32)))
   )

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

@@ -18,6 +18,11 @@ part : partname /"(" pin-val-pair [/"," pin-val-pair]* /")" /";"
 
 @partname : ID
 
-/pin-val-pair : pin /"=" pin-val
+/pin-val-pair : ID  [/"[" bus-range /"]"] /"=" pin-val
 
-/pin-val : ID  [/"[" NUMBER /"]"]
+bus-range : NUMBER [/"." /"." NUMBER]
+
+@pin-val : ID
+         | BINARY-NUMBER
+         | TRUE
+         | FALSE

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

@@ -15,8 +15,11 @@
         (token 'COMMENT lexeme #:skip? #t)]
        [(union #\tab #\space #\newline) (get-token input-port)]
        [(union "CHIP" "IN" "OUT" "PARTS:") lexeme]
-       [(char-set "[]{}(),;=") lexeme]
+       [(char-set "[]{}(),;=.") lexeme]
+       ["true" (token 'TRUE 1)]
+       ["false" (token 'FALSE 0)]
+       [(repetition 1 +inf.0 (char-set "01")) (token 'BINARY-NUMBER (string->number lexeme 2))]
        [(repetition 1 +inf.0 numeric) (token 'NUMBER (string->number lexeme))]
-       [(repetition 1 +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)