diff --git a/beautiful-racket-demo/hdl-demo/main.rkt b/beautiful-racket-demo/hdl-demo/main.rkt index fa033f3..d053c3c 100644 --- a/beautiful-racket-demo/hdl-demo/main.rkt +++ b/beautiful-racket-demo/hdl-demo/main.rkt @@ -22,6 +22,7 @@ (provide read-syntax)) (define (read-syntax src ip) + (port-count-lines! ip) (strip-context (with-syntax ([PT (parse src (λ () (tokenize ip)))]) #'(module hdl-mod hdl-demo/expander diff --git a/beautiful-racket-demo/hdl-tst-demo/expander.rkt b/beautiful-racket-demo/hdl-tst-demo/expander.rkt index a67c74f..fce1525 100644 --- a/beautiful-racket-demo/hdl-tst-demo/expander.rkt +++ b/beautiful-racket-demo/hdl-tst-demo/expander.rkt @@ -1,7 +1,6 @@ #lang br/quicklang (require (for-syntax racket/string) rackunit racket/file) -(provide #%module-begin - (matching-identifiers-out #rx"^tst-" (all-defined-out))) +(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 @@ -34,20 +33,20 @@ (define-for-syntax chip-prefix #f) -(define-macro (tst-program EXPR ...) +(define-macro (program EXPR ...) (with-shared-id (compare-files) #'(begin EXPR ... (compare-files)))) -(define-macro (tst-load-expr CHIPFILE-STRING) +(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 (tst-output-file-expr OUTPUT-FILE-STRING) +(define-macro (output-file-expr OUTPUT-FILE-STRING) (with-shared-id (output-file output-filename) #'(begin (define output-filename OUTPUT-FILE-STRING) @@ -55,13 +54,13 @@ #:mode 'text #:exists 'replace)))) -(define-macro (tst-compare-to-expr COMPARE-FILE-STRING) +(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 (tst-output-list-expr (COL-NAME FORMAT-SPEC) ...) +(define-macro (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 ...))]) @@ -73,17 +72,17 @@ (output COL-NAME ...))))) -(define-macro (tst-set-expr IN-BUS IN-VAL) +(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 (tst-eval-expr) +(define-macro (eval-expr) (with-shared-id (eval-result eval-chip) #'(set! eval-result (eval-chip)))) -(define-macro (tst-output-expr) +(define-macro (output-expr) (with-shared-id (output eval-result) #'(apply output eval-result))) diff --git a/beautiful-racket-demo/hdl-tst-demo/grammar.rkt b/beautiful-racket-demo/hdl-tst-demo/grammar.rkt new file mode 100644 index 0000000..7ecc668 --- /dev/null +++ b/beautiful-racket-demo/hdl-tst-demo/grammar.rkt @@ -0,0 +1,13 @@ +#lang brag + +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 : 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 diff --git a/beautiful-racket-demo/hdl-tst-demo/main.rkt b/beautiful-racket-demo/hdl-tst-demo/main.rkt index 58d29ae..5bd9390 100644 --- a/beautiful-racket-demo/hdl-tst-demo/main.rkt +++ b/beautiful-racket-demo/hdl-tst-demo/main.rkt @@ -1,14 +1,22 @@ #lang br +(require "grammar.rkt" brag/support) -(module reader br - (require "parser.rkt" "tokenizer.rkt") - (provide read-syntax) - (define (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) - (strip-context - (with-syntax ([PT (parse source-path (make-tokenizer port+newline))]) - #'(module hdl-mod hdl-tst-demo/expander - PT))))) +(module+ reader + (provide read-syntax)) + +(define tokenize + (lexer-srcloc + [(: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 (read-syntax src ip) + (port-count-lines! ip) + (strip-context + (with-syntax ([PT (parse src (λ () (tokenize ip)))]) + #'(module hdl-mod hdl-tst-demo/expander + PT)))) diff --git a/beautiful-racket-demo/hdl-tst-demo/parser.rkt b/beautiful-racket-demo/hdl-tst-demo/parser.rkt deleted file mode 100644 index a1415ab..0000000 --- a/beautiful-racket-demo/hdl-tst-demo/parser.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang brag - -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 deleted file mode 100644 index 64e9a5e..0000000 --- a/beautiful-racket-demo/hdl-tst-demo/tokenizer.rkt +++ /dev/null @@ -1,17 +0,0 @@ -#lang br/quicklang -(require brag/support) -(provide make-tokenizer) - -(define hdl-test-lexer - (lexer-srcloc - [(: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)