From 2fc5f63185606b31de0bf956e8ee85cedaf28599 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 18 May 2016 14:35:45 -0700 Subject: [PATCH] resume in bit subscripts / write into input bus --- beautiful-racket/br/demo/hdl/Nand.hdl.rkt | 4 +- beautiful-racket/br/demo/hdl/Not-sexp.rkt | 8 +-- beautiful-racket/br/demo/hdl/Not.hdl.rkt | 4 +- beautiful-racket/br/demo/hdl/expander.rkt | 30 ++++++++--- beautiful-racket/br/demo/hdl/helper.rkt | 58 ++++++++++------------ beautiful-racket/br/demo/hdl/parser.rkt | 9 +++- beautiful-racket/br/demo/hdl/tokenizer.rkt | 7 ++- 7 files changed, 69 insertions(+), 51 deletions(-) diff --git a/beautiful-racket/br/demo/hdl/Nand.hdl.rkt b/beautiful-racket/br/demo/hdl/Nand.hdl.rkt index 97b1a86..e181804 100644 --- a/beautiful-racket/br/demo/hdl/Nand.hdl.rkt +++ b/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) diff --git a/beautiful-racket/br/demo/hdl/Not-sexp.rkt b/beautiful-racket/br/demo/hdl/Not-sexp.rkt index d428113..61c697b 100644 --- a/beautiful-racket/br/demo/hdl/Not-sexp.rkt +++ b/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)))) \ No newline at end of file +(chip-program Not + (in-spec (in 8) (a)) + (out-spec (out 8)) + (part-spec (part Nand ((a) (in)) ((b) (in)) ((out) (out))))) \ No newline at end of file diff --git a/beautiful-racket/br/demo/hdl/Not.hdl.rkt b/beautiful-racket/br/demo/hdl/Not.hdl.rkt index e8034cd..4632613 100644 --- a/beautiful-racket/br/demo/hdl/Not.hdl.rkt +++ b/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); } diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt index 50f89cb..091989f 100644 --- a/beautiful-racket/br/demo/hdl/expander.rkt +++ b/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] ...) diff --git a/beautiful-racket/br/demo/hdl/helper.rkt b/beautiful-racket/br/demo/hdl/helper.rkt index 65e158f..a7d929e 100644 --- a/beautiful-racket/br/demo/hdl/helper.rkt +++ b/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))) ) diff --git a/beautiful-racket/br/demo/hdl/parser.rkt b/beautiful-racket/br/demo/hdl/parser.rkt index 6012e6d..975ece2 100644 --- a/beautiful-racket/br/demo/hdl/parser.rkt +++ b/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 /"]"] \ No newline at end of file +bus-range : NUMBER [/"." /"." NUMBER] + +@pin-val : ID + | BINARY-NUMBER + | TRUE + | FALSE diff --git a/beautiful-racket/br/demo/hdl/tokenizer.rkt b/beautiful-racket/br/demo/hdl/tokenizer.rkt index 4ffdc08..6b5493d 100644 --- a/beautiful-racket/br/demo/hdl/tokenizer.rkt +++ b/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)