diff --git a/beautiful-racket/br/demo/hdl/And.hdl b/beautiful-racket/br/demo/hdl/And.hdl index bbf7067..e5f9b1b 100644 --- a/beautiful-racket/br/demo/hdl/And.hdl +++ b/beautiful-racket/br/demo/hdl/And.hdl @@ -1,4 +1,4 @@ -#lang s-exp br/demo/hdl/expander +#lang s-exp br/demo/hdl/expander0 (chip And (a b) diff --git a/beautiful-racket/br/demo/hdl/Not.hdl b/beautiful-racket/br/demo/hdl/Not.hdl index 5b9838f..6c9ee66 100644 --- a/beautiful-racket/br/demo/hdl/Not.hdl +++ b/beautiful-racket/br/demo/hdl/Not.hdl @@ -1,4 +1,4 @@ -#lang s-exp br/demo/hdl/expander +#lang s-exp br/demo/hdl/expander0 (chip Not (in) diff --git a/beautiful-racket/br/demo/hdl/Or.hdl b/beautiful-racket/br/demo/hdl/Or.hdl index a20a449..7794ab9 100644 --- a/beautiful-racket/br/demo/hdl/Or.hdl +++ b/beautiful-racket/br/demo/hdl/Or.hdl @@ -1,4 +1,4 @@ -#lang s-exp br/demo/hdl/expander +#lang s-exp br/demo/hdl/expander0 (chip Or (a b) diff --git a/beautiful-racket/br/demo/hdl/expander0.rkt b/beautiful-racket/br/demo/hdl/expander0.rkt new file mode 100644 index 0000000..b7a23f3 --- /dev/null +++ b/beautiful-racket/br/demo/hdl/expander0.rkt @@ -0,0 +1,23 @@ +#lang br +(provide (all-from-out br) chip) + +(define #'(chip _Chip + (_input-pin ...) + (_output-pin) + ((_Part [_pin-in _val-id] ... [out _pin-out]) ...)) + #'(begin + (provide _Chip) + (define _Chip + (make-keyword-procedure + (λ (kws kw-args . rest) + (define kw-pairs (map cons kws kw-args)) + (let ([_input-pin (cdr (assq (string->keyword (format "~a" '_input-pin)) kw-pairs))] ...) + (define _pin-out (call-part _Part [_pin-in _val-id] ...)) ... + _output-pin)))))) + +(define #'(call-part _Part [_pin-in _val-id] ...) + (with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))] + [(kw ...) (map (λ(pi) (string->keyword (format "~a" (syntax->datum pi)))) (syntax->list #'(_pin-in ...)))]) + #'(let () + (local-require (rename-in part-path [_Part local-name])) + (keyword-apply local-name '(kw ...) (list _val-id ...) null))))