diff --git a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt index 7bfe1ce..553a72c 100644 --- a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt +++ b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt @@ -1,8 +1,9 @@ #lang br/demo/hdl CHIP Not { - IN x, y, z; -} + IN a, b, c, d; + OUT x, y, z; + } diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt index 2620f01..b0ac82d 100644 --- a/beautiful-racket/br/demo/hdl/expander.rkt +++ b/beautiful-racket/br/demo/hdl/expander.rkt @@ -1,9 +1,47 @@ #lang br (provide (all-from-out br) (all-defined-out)) +(require "expander0.rkt") -;; todo: extract identifiers from _pin-spec -;; and introduce them -(define #'(chip-program "CHIP" _id "{" _pin-spec "}") - #'(begin - (define _id 0) - )) \ No newline at end of file + +#| + +Be your own binding procedure. +Part parser should generate inner `define`. +input-pin-spec parser should generate kw procedure. +chip-name parser should generate outer define/provide form. + +(chip Not + (x) + (y)) + +|# + +(define-for-syntax (remove-commas stx-expr) + (filter (λ(i) + (not (equal? "," (syntax->datum i)))) (syntax->list stx-expr))) + +(define #'(pin-spec-out "OUT" _pin-or-comma ... ";") + (with-syntax ([(_pinid ...) (remove-commas #'(_pin-or-comma ...))]) + #'(begin + (define _pinid '(1 2 3 4)) ... + (list _pinid ...)))) + +(define #'(make-kw-procedure (pin-spec-in "IN" _pin-or-comma ... ";") _pin-spec-out) + (with-syntax ([(_pinid ...) (remove-commas #'(_pin-or-comma ...))]) + #'(make-keyword-procedure + (λ (kws kw-args . rest) + (define kw-pairs (map cons kws kw-args)) + (let ([_pinid (cdr (assq (string->keyword (format "~a" '_pinid)) kw-pairs))] ...) + + _pin-spec-out))))) + + + +(define #'(chip-program "CHIP" _topid "{" _pin-spec-in _pin-spec-out "}") + #`(begin + (provide _topid) + (define _topid + (make-kw-procedure _pin-spec-in _pin-spec-out) + ) + (require rackunit) + (check-equal? (_topid #:a 1 #:b 2 #:c 3 #:d 4) '((1 2 3 4)(1 2 3 4)(1 2 3 4))))) \ No newline at end of file diff --git a/beautiful-racket/br/demo/hdl/expander0.rkt b/beautiful-racket/br/demo/hdl/expander0.rkt index b7a23f3..5b464d7 100644 --- a/beautiful-racket/br/demo/hdl/expander0.rkt +++ b/beautiful-racket/br/demo/hdl/expander0.rkt @@ -1,9 +1,10 @@ #lang br (provide (all-from-out br) chip) + (define #'(chip _Chip (_input-pin ...) - (_output-pin) + (_output-pin ...) ((_Part [_pin-in _val-id] ... [out _pin-out]) ...)) #'(begin (provide _Chip) @@ -13,7 +14,7 @@ (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)))))) + (values _output-pin ...))))))) (define #'(call-part _Part [_pin-in _val-id] ...) (with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))] diff --git a/beautiful-racket/br/demo/hdl/parser.rkt b/beautiful-racket/br/demo/hdl/parser.rkt index 7dc003f..fee0fb2 100644 --- a/beautiful-racket/br/demo/hdl/parser.rkt +++ b/beautiful-racket/br/demo/hdl/parser.rkt @@ -1,13 +1,10 @@ #lang ragg -chip-program : "CHIP" ID "{" pin-spec "}" +chip-program : "CHIP" ID "{" pin-spec-in pin-spec-out "}" -pin-spec : ("IN" | "OUT") pin-list ";" +pin-spec-in : "IN" ID ["," ID]* ";" -pin-list : ID ["," pin-list] +pin-spec-out : "OUT" ID ["," ID]* ";" -part-spec : "PARTS:" part+ -part : ID "(" part-arg-list ")" ";" - -part-arg-list : ID "=" ID ["," part-arg-list] \ No newline at end of file +part-spec : "PARTS:" [ID "(" [ID "=" ID]+ ")" ";"]+