diff --git a/beautiful-racket/br/demo/hdl/Fanout.hdl.rkt b/beautiful-racket/br/demo/hdl/Fanout.hdl.rkt new file mode 100644 index 0000000..e29ea96 --- /dev/null +++ b/beautiful-racket/br/demo/hdl/Fanout.hdl.rkt @@ -0,0 +1,11 @@ +#lang br +(provide (prefix-out Fanout- (all-defined-out))) +(require "helper.rkt") +(define in (make-input)) + + +(define (outa) + (in)) + +(define (outb) + (in)) diff --git a/beautiful-racket/br/demo/hdl/Nand2.hdl.rkt b/beautiful-racket/br/demo/hdl/Nand2.hdl.rkt index 4c5872e..84bd339 100644 --- a/beautiful-racket/br/demo/hdl/Nand2.hdl.rkt +++ b/beautiful-racket/br/demo/hdl/Nand2.hdl.rkt @@ -1,24 +1,8 @@ #lang br -(provide (all-defined-out)) - -(struct Nand (a b out) #:transparent) - -(define (make-Nand) - (Nand a b out)) - -(define a - (let ([Nand-a-val 0]) - (λ ([val #f]) - (if val - (set! Nand-a-val val) - Nand-a-val)))) - -(define b - (let ([Nand-b-val 0]) - (λ ([val #f]) - (if val - (set! Nand-b-val val) - Nand-b-val)))) +(provide (prefix-out Nand2- (all-defined-out))) +(require "helper.rkt") +(define a (make-input)) +(define b (make-input)) (define (out) @@ -33,4 +17,4 @@ (check-equal? (begin (a 1) (b 0) (out)) 1) (check-equal? (begin (a 1) (b 1) (out)) 0)) -(define n (make-Nand)) +#;(define n (make-Nand)) diff --git a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt index 752f7f5..757ccfb 100644 --- a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt +++ b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt @@ -3,25 +3,36 @@ CHIP Not { IN in; - OUT out; + OUT out, outb; PARTS: - Nand(a=in, b=in, out=out); + ;; each part has only as many args as wires in that part + Nand(a=in, b=in, out=nand-out); + Fanout(in=nand-out, outa=out, outb=outb); } |# -(provide (prefix-out Not- (all-defined-out))) +(require "helper.rkt" "helper-macro.rkt" (for-syntax "helper.rkt" racket/syntax racket/list)) -(require "Nand2.hdl.rkt") +;; IN and OUT spec becomes provide spec, prefixed with chip name +(provide (prefix-out Not- (combine-out in out outb))) -(define in - (let ([in-val 0]) - (λ ([val #f]) - (if val - (set! in-val val) - in-val)))) +;; all IN and OUT pins are functions. -(define n (make-Nand)) -(define (out) (begin ((Nand-a n) (in)) ((Nand-b n) (in)) ((Nand-out n)))) \ No newline at end of file +(define in (make-input)) ; all inputs are made from the same function that holds state like a parameter. + +;; all outputs are computed at runtime. +(require "Nand2.hdl.rkt" (for-syntax "Nand2.hdl.rkt")) +(handle-part Nand2 [a in] [b in] [out nand-out]) +(require "Fanout.hdl.rkt" (for-syntax "Fanout.hdl.rkt")) +(handle-part Fanout [in nand-out] [outa out] [outb outb]) +;(handle-require Fanout [in nand-out] [outa out] [outb outb]) + +(module+ test + (require rackunit) + (in 1) + (check-equal? (out) 0) + (in 0) + (check-equal? (out) 1)) \ No newline at end of file diff --git a/beautiful-racket/br/demo/hdl/helper-macro.rkt b/beautiful-racket/br/demo/hdl/helper-macro.rkt new file mode 100644 index 0000000..137f70a --- /dev/null +++ b/beautiful-racket/br/demo/hdl/helper-macro.rkt @@ -0,0 +1,35 @@ +#lang racket/base +(require (for-syntax racket/base racket/syntax "helper.rkt" racket/list)) +(provide (all-defined-out)) + + +(define-syntax (handle-require stx) + (syntax-case stx () + [(_ prefix [suffix arg] ...) + (with-syntax ([(prefix-suffix ...) (map (λ(s) (format-id s "~a-~a" #'prefix s)) (syntax->list #'(suffix ...)))] + [module-name (format "~a.hdl.rkt" (syntax->datum #'prefix))]) + #'(begin + (local-require module-name (for-syntax module-name)) + (handle-wires [prefix-suffix arg] ...)))])) + + +(define-syntax (handle-part stx) + (syntax-case stx () + [(_ prefix [suffix arg] ...) + (with-syntax ([(prefix-suffix ...) (map (λ(s) (format-id s "~a-~a" #'prefix s)) (syntax->list #'(suffix ...)))] + [module-name (format "~a.hdl.rkt" (syntax->datum #'prefix))]) + #'(begin + (require module-name (for-syntax module-name)) + (handle-wires [prefix-suffix arg] ...)))])) + + +(define-syntax (handle-wires stx) + (syntax-case stx () + [(_ [wire arg] ...) + (let () + (define-values (in-wires out-wires) (partition (λ(stx) (let ([wire (car (syntax->list stx))]) + (input-wire? (syntax-local-eval wire)))) (syntax->list #'([wire arg] ...)))) + (with-syntax ([([in-wire in-arg] ...) in-wires] + [([out-wire out-arg] ...) out-wires]) + #'(begin + (define out-arg (λ () (in-wire (in-arg)) ... (out-wire))) ...)))])) \ No newline at end of file diff --git a/beautiful-racket/br/demo/hdl/helper.rkt b/beautiful-racket/br/demo/hdl/helper.rkt new file mode 100644 index 0000000..4c828b8 --- /dev/null +++ b/beautiful-racket/br/demo/hdl/helper.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(provide (all-defined-out)) + +(define-values (input-wire input-wire? input-wire-get) + (make-impersonator-property 'input-wire)) + +(define (make-input) + (impersonate-procedure + (let ([val #f]) + (λ ([arg #f]) + (if arg + (set! val arg) + val))) + #f input-wire #t)) + +(module+ test + (require rackunit) + (define in-wire (make-input)) + (define other (λ () (+ 2 2))) + (check-true (input-wire? in-wire)) + (check-false (input-wire? other))) \ No newline at end of file