You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
101 lines
3.1 KiB
Racket
101 lines
3.1 KiB
Racket
#lang br/quicklang
|
|
(require (for-syntax br/syntax racket/string) rackunit racket/file)
|
|
(provide #%module-begin (all-defined-out))
|
|
|
|
|
|
(define (print-cell val fmt)
|
|
(match-define (list _ radix-letter number-strings) (regexp-match #px"^%(.)(.*)$" fmt)) ; like %B1.16.1
|
|
(match-define (list left-margin width right-margin) (map string->number (string-split number-strings ".")))
|
|
(cond
|
|
[(number? val)
|
|
(define radix (case radix-letter
|
|
[("B") 2]))
|
|
(string-append (make-string left-margin #\space)
|
|
(~r val #:min-width width #:pad-string "0" #:base radix)
|
|
(make-string right-margin #\space))]
|
|
[(string? val) (~a val #:min-width (+ left-margin width right-margin) #:pad-string " " #:align 'center)]
|
|
[else (error 'unknown-value)]))
|
|
|
|
|
|
(define (print-line output-filename cells)
|
|
(with-output-to-file output-filename
|
|
(λ () (printf (format "~a\n" (string-join cells "|" #:before-first "|" #:after-last "|"))))
|
|
#:mode 'text
|
|
#:exists 'append))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
(define a 123)
|
|
(check-equal? (print-cell a "%B1.16.1") " 0000000001111011 ")
|
|
(check-equal? (print-cell "out" "%B1.16.1") " out ")
|
|
(check-equal? (print-cell "out" "%B3.1.3") " out ")
|
|
(check-equal? (print-cell "in" "%B3.1.3") " in "))
|
|
|
|
|
|
(define-for-syntax chip-prefix #f)
|
|
|
|
|
|
(define-macro (tst-program EXPR ...)
|
|
(with-shared-id
|
|
(compare-files)
|
|
#'(begin
|
|
EXPR ...
|
|
(compare-files))))
|
|
|
|
|
|
(define-macro (load-expr CHIPFILE-STRING)
|
|
(set! chip-prefix (string-replace (syntax->datum #'CHIPFILE-STRING) ".hdl" ""))
|
|
(with-pattern
|
|
([CHIPFILE.RKT (format-string "~a.rkt" #'CHIPFILE-STRING)])
|
|
#'(require CHIPFILE.RKT)))
|
|
|
|
|
|
(define-macro (output-file-expr OUTPUT-FILE-STRING)
|
|
(with-shared-id
|
|
(output-file output-filename)
|
|
#'(begin
|
|
(define output-filename OUTPUT-FILE-STRING)
|
|
(with-output-to-file output-filename
|
|
(λ () (printf ""))
|
|
#:mode 'text
|
|
#:exists 'replace))))
|
|
|
|
|
|
(define-macro (compare-to-expr COMPARE-FILE-STRING)
|
|
(with-shared-id
|
|
(compare-files output-filename)
|
|
#'(define (compare-files)
|
|
(check-equal? (file->lines output-filename) (file->lines COMPARE-FILE-STRING)))))
|
|
|
|
|
|
(define-macro (output-list-expr (COL-NAME FORMAT-SPEC) ...)
|
|
(with-shared-id
|
|
(eval-result eval-chip output output-filename)
|
|
(with-pattern
|
|
([(COL-ID ...) (suffix-id #'(COL-NAME ...))]
|
|
[(CHIP-COL-ID ...) (prefix-id chip-prefix "-" #'(COL-NAME ...))])
|
|
#'(begin
|
|
(define (output COL-ID ...)
|
|
(print-line output-filename (map print-cell (list COL-ID ...) (list FORMAT-SPEC ...))))
|
|
(define eval-result #f)
|
|
(define (eval-chip) (list (CHIP-COL-ID) ...))
|
|
(output COL-NAME ...)))))
|
|
|
|
|
|
(define-macro (set-expr IN-BUS IN-VAL)
|
|
(with-pattern
|
|
([CHIP-IN-BUS-ID-WRITE (prefix-id chip-prefix "-" (suffix-id #'IN-BUS "-write"))])
|
|
#'(CHIP-IN-BUS-ID-WRITE IN-VAL)))
|
|
|
|
|
|
(define-macro (eval-expr)
|
|
(with-shared-id
|
|
(eval-result eval-chip)
|
|
#'(set! eval-result (eval-chip))))
|
|
|
|
|
|
(define-macro (output-expr)
|
|
(with-shared-id
|
|
(output eval-result)
|
|
#'(apply output eval-result)))
|