|
|
@ -23,7 +23,7 @@
|
|
|
|
([(PARTNAME-BUS-LEFT ...) (prefix-id #'PARTNAME "-" #'(BUS-LEFT ...))]
|
|
|
|
([(PARTNAME-BUS-LEFT ...) (prefix-id #'PARTNAME "-" #'(BUS-LEFT ...))]
|
|
|
|
[CHIP-MODULE-PATH (format-string "~a.hdl.rkt" #'PARTNAME)])
|
|
|
|
[CHIP-MODULE-PATH (format-string "~a.hdl.rkt" #'PARTNAME)])
|
|
|
|
#'(begin
|
|
|
|
#'(begin
|
|
|
|
(require (import-chip CHIP-MODULE-PATH) #;(for-syntax (import-chip CHIP-MODULE-PATH)))
|
|
|
|
(require (import-chip CHIP-MODULE-PATH) (for-syntax (import-chip CHIP-MODULE-PATH)))
|
|
|
|
(handle-buses ((PARTNAME-BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...))))
|
|
|
|
(handle-buses ((PARTNAME-BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -34,7 +34,6 @@
|
|
|
|
[(_ module-path)
|
|
|
|
[(_ module-path)
|
|
|
|
(expand-import #'module-path)]))))
|
|
|
|
(expand-import #'module-path)]))))
|
|
|
|
|
|
|
|
|
|
|
|
(require (for-syntax rackunit))
|
|
|
|
|
|
|
|
(define-macro (handle-buses BUS-ASSIGNMENTS ...)
|
|
|
|
(define-macro (handle-buses BUS-ASSIGNMENTS ...)
|
|
|
|
(let-values
|
|
|
|
(let-values
|
|
|
|
([(in-bus-assignments out-bus-assignments)
|
|
|
|
([(in-bus-assignments out-bus-assignments)
|
|
|
@ -52,15 +51,12 @@ phase 1 binding of `input-bus?` with shift 1:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(syntax-local-eval (with-syntax ([ib (syntax-shift-phase-level #'input-bus? 1)]
|
|
|
|
(syntax-local-eval (with-syntax ([ib (syntax-shift-phase-level #'input-bus? 1)]
|
|
|
|
[pw (syntax-shift-phase-level #'PREFIXED-WIRE 3)])
|
|
|
|
[pw (syntax-shift-phase-level #'PREFIXED-WIRE 1)])
|
|
|
|
#;(report (identifier-binding #'input-bus? 0))
|
|
|
|
#;(report (identifier-binding #'input-bus? 0))
|
|
|
|
#;(report (identifier-binding #'ib 1))
|
|
|
|
#;(report (identifier-binding #'ib 1))
|
|
|
|
#;(report (identifier-binding #'PREFIXED-WIRE 0))
|
|
|
|
#;(report (identifier-binding #'PREFIXED-WIRE 0))
|
|
|
|
#;(report (identifier-binding #'pw 1))
|
|
|
|
#;(report (identifier-binding #'pw 1))
|
|
|
|
#'(ib pw))))])])
|
|
|
|
#'(ib pw))))])])
|
|
|
|
(check-equal? (length in-bus-assignments) 2)
|
|
|
|
|
|
|
|
(check-equal? (length out-bus-assignments) 1)
|
|
|
|
|
|
|
|
(error 'stop)
|
|
|
|
|
|
|
|
(with-pattern
|
|
|
|
(with-pattern
|
|
|
|
([(((IN-BUS IN-BUS-ARG ...) IN-BUS-VALUE) ...) in-bus-assignments]
|
|
|
|
([(((IN-BUS IN-BUS-ARG ...) IN-BUS-VALUE) ...) in-bus-assignments]
|
|
|
|
[(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")]
|
|
|
|
[(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")]
|
|
|
|