diff --git a/beautiful-racket-demo/hdl-tst-demo/expander.rkt b/beautiful-racket-demo/hdl-tst-demo/expander.rkt index c1f9e1e..2386697 100644 --- a/beautiful-racket-demo/hdl-tst-demo/expander.rkt +++ b/beautiful-racket-demo/hdl-tst-demo/expander.rkt @@ -1,7 +1,7 @@ #lang br/quicklang -(require (for-syntax br/syntax racket/string) rackunit racket/file) -(provide #%module-begin (all-defined-out)) - +(require (for-syntax racket/string) rackunit racket/file) +(provide #%module-begin + (matching-identifiers-out #rx"^tst-" (all-defined-out))) (define (print-cell val fmt) (match-define (list _ radix-letter number-strings) (regexp-match #px"^%(.)(.*)$" fmt)) ; like %B1.16.1 @@ -36,65 +36,59 @@ (define-macro (tst-program EXPR ...) - (with-shared-id - (compare-files) - #'(begin - EXPR ... - (compare-files)))) + (with-shared-id (compare-files) + #'(begin + EXPR ... + (compare-files)))) -(define-macro (load-expr CHIPFILE-STRING) +(define-macro (tst-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 ...))]) + ([CHIPFILE.RKT (format-string "~a.rkt" #'CHIPFILE-STRING)]) + #'(require CHIPFILE.RKT))) + + +(define-macro (tst-output-file-expr OUTPUT-FILE-STRING) + (with-shared-id (output-file output-filename) #'(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 output-filename OUTPUT-FILE-STRING) + (with-output-to-file output-filename + (λ () (printf "")) + #:mode 'text + #:exists 'replace)))) + + +(define-macro (tst-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 (tst-output-list-expr (COL-NAME FORMAT-SPEC) ...) + (with-shared-id (eval-result eval-chip output output-filename) + (with-pattern + ([(COL-ID ...) (suffix-ids #'(COL-NAME ...))] + [(CHIP-COL-ID ...) (prefix-ids 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) +(define-macro (tst-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))) + ([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 (tst-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))) +(define-macro (tst-output-expr) + (with-shared-id (output eval-result) + #'(apply output eval-result))) diff --git a/beautiful-racket-demo/hdl-tst-demo/main.rkt b/beautiful-racket-demo/hdl-tst-demo/main.rkt index e011c34..9b4f268 100644 --- a/beautiful-racket-demo/hdl-tst-demo/main.rkt +++ b/beautiful-racket-demo/hdl-tst-demo/main.rkt @@ -2,6 +2,10 @@ (module reader br (require br/reader-utils "parser.rkt" "tokenizer.rkt") - (define-read-and-read-syntax (source-path input-port) + (define-read-and-read-syntax (source-path port) + (define-values (line col pos) (port-next-location port)) + (define port+newline (input-port-append #f port (open-input-string "\n"))) + (port-count-lines! port+newline) + (set-port-next-location! port+newline line col pos) #`(module hdl-mod hdl-tst-demo/expander - #,(parse source-path (tokenize input-port))))) + #,(parse source-path (make-tokenizer port+newline))))) diff --git a/beautiful-racket-demo/hdl-tst-demo/parser.rkt b/beautiful-racket-demo/hdl-tst-demo/parser.rkt index 0e69ca8..a1415ab 100644 --- a/beautiful-racket-demo/hdl-tst-demo/parser.rkt +++ b/beautiful-racket-demo/hdl-tst-demo/parser.rkt @@ -1,23 +1,13 @@ #lang brag -tst-program : load-expr output-file-expr compare-to-expr output-list-expr /";" test-expr* - -load-expr : /"load" ID /"," - -output-file-expr : /"output-file" ID /"," - -compare-to-expr : /"compare-to" ID /"," - -output-list-expr : /"output-list" column [column]+ - -/column : ID FORMAT-STRING - -@test-expr : step-expr+ /";" - -@step-expr : (set-expr | eval-expr | output-expr) [/","] - -set-expr : /"set" ID VAL - -eval-expr : /"eval" - -output-expr : /"output" \ No newline at end of file +tst-program : tst-load-expr tst-output-file-expr tst-compare-to-expr tst-output-list-expr /";" tst-test-expr* +tst-load-expr : /"load" ID /"," +tst-output-file-expr : /"output-file" ID /"," +tst-compare-to-expr : /"compare-to" ID /"," +tst-output-list-expr : /"output-list" tst-column [tst-column]+ +/tst-column : ID FORMAT-STRING +@tst-test-expr : tst-step-expr+ /";" +@tst-step-expr : (tst-set-expr | tst-eval-expr | tst-output-expr) [/","] +tst-set-expr : /"set" ID VAL +tst-eval-expr : /"eval" +tst-output-expr : /"output" \ No newline at end of file diff --git a/beautiful-racket-demo/hdl-tst-demo/tokenizer.rkt b/beautiful-racket-demo/hdl-tst-demo/tokenizer.rkt index 21442d4..9e2292b 100644 --- a/beautiful-racket-demo/hdl-tst-demo/tokenizer.rkt +++ b/beautiful-racket-demo/hdl-tst-demo/tokenizer.rkt @@ -1,21 +1,18 @@ -#lang br -(require brag/support - racket/string) +#lang br/quicklang +(require brag/support) +(provide make-tokenizer) -(provide tokenize) -(define (tokenize input-port) - (define (next-token) - (define get-token - (lexer-src-pos - [(eof) eof] - [(union - (:seq "/*" (complement (:seq any-string "*/" any-string)) "*/") - (:seq "//" (repetition 1 +inf.0 (char-complement #\newline)) #\newline)) - (token 'COMMENT lexeme #:skip? #t)] - [(union #\tab #\space #\newline) (return-without-pos (get-token input-port))] - [(union "load" "output-list" "output-file" "compare-to" "set" "eval" "output" (char-set ",;")) lexeme] - [(:seq "%" (repetition 1 +inf.0 (union alphabetic numeric (char-set ".")))) (token 'FORMAT-STRING lexeme)] - [(repetition 1 +inf.0 numeric) (token 'VAL (string->number lexeme))] - [(repetition 1 +inf.0 (union alphabetic numeric (char-set "-."))) (token 'ID lexeme)])) - (get-token input-port)) +(define hdl-test-lexer + (lexer-srcloc + [(eof) eof] + [(:or (from/to "/*" "*/") + (from/to "//" #\newline)) (token 'COMMENT lexeme #:skip? #t)] + [whitespace (token lexeme #:skip? #t)] + [(:or "load" "output-list" "output-file" "compare-to" "set" "eval" "output" "," ";") lexeme] + [(:seq "%" (:+ alphabetic numeric ".")) (token 'FORMAT-STRING lexeme)] + [(:+ numeric) (token 'VAL (string->number lexeme))] + [(:+ alphabetic numeric "-" ".") (token 'ID lexeme)])) + +(define (make-tokenizer ip) + (define (next-token) (hdl-test-lexer ip)) next-token)