suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

resume in bit subscripts / write into input bus

Browse Source
This commit is contained in:
Matthew Butterick 2016-05-18 14:35:45 -07:00
parent e3334e6498
commit 2fc5f63185
7 changed files with 69 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
beautiful-racket/br/demo/hdl/Nand.hdl.rkt
View File

@ -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)

8
beautiful-racket/br/demo/hdl/Not-sexp.rkt
View File

@ -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)))))

4
beautiful-racket/br/demo/hdl/Not.hdl.rkt
View File

@ -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);
}

30
beautiful-racket/br/demo/hdl/expander.rkt
View File

@ -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] ...)

58
beautiful-racket/br/demo/hdl/helper.rkt
View File

@ -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)))
)

9
beautiful-racket/br/demo/hdl/parser.rkt
View File

@ -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

7
beautiful-racket/br/demo/hdl/tokenizer.rkt
View File

@ -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)