v6.3-exception
Matthew Butterick 7 years ago
parent f21e0f7c20
commit 28bc51a793

@ -22,6 +22,7 @@
(provide read-syntax)) (provide read-syntax))
(define (read-syntax src ip) (define (read-syntax src ip)
(port-count-lines! ip)
(strip-context (strip-context
(with-syntax ([PT (parse src (λ () (tokenize ip)))]) (with-syntax ([PT (parse src (λ () (tokenize ip)))])
#'(module hdl-mod hdl-demo/expander #'(module hdl-mod hdl-demo/expander

@ -1,7 +1,6 @@
#lang br/quicklang #lang br/quicklang
(require (for-syntax racket/string) rackunit racket/file) (require (for-syntax racket/string) rackunit racket/file)
(provide #%module-begin (provide #%module-begin (all-defined-out))
(matching-identifiers-out #rx"^tst-" (all-defined-out)))
(define (print-cell val fmt) (define (print-cell val fmt)
(match-define (list _ radix-letter number-strings) (regexp-match #px"^%(.)(.*)$" fmt)) ; like %B1.16.1 (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-for-syntax chip-prefix #f)
(define-macro (tst-program EXPR ...) (define-macro (program EXPR ...)
(with-shared-id (compare-files) (with-shared-id (compare-files)
#'(begin #'(begin
EXPR ... EXPR ...
(compare-files)))) (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" "")) (set! chip-prefix (string-replace (syntax->datum #'CHIPFILE-STRING) ".hdl" ""))
(with-pattern ([CHIPFILE.RKT (format-string "~a.rkt" #'CHIPFILE-STRING)]) (with-pattern ([CHIPFILE.RKT (format-string "~a.rkt" #'CHIPFILE-STRING)])
#'(require CHIPFILE.RKT))) #'(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) (with-shared-id (output-file output-filename)
#'(begin #'(begin
(define output-filename OUTPUT-FILE-STRING) (define output-filename OUTPUT-FILE-STRING)
@ -55,13 +54,13 @@
#:mode 'text #:exists 'replace)))) #: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) (with-shared-id (compare-files output-filename)
#'(define (compare-files) #'(define (compare-files)
(check-equal? (file->lines output-filename) (file->lines COMPARE-FILE-STRING))))) (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-shared-id (eval-result eval-chip output output-filename)
(with-pattern ([(COL-ID ...) (suffix-ids #'(COL-NAME ...) "")] (with-pattern ([(COL-ID ...) (suffix-ids #'(COL-NAME ...) "")]
[(CHIP-COL-ID ...) (prefix-ids chip-prefix "-" #'(COL-NAME ...))]) [(CHIP-COL-ID ...) (prefix-ids chip-prefix "-" #'(COL-NAME ...))])
@ -73,17 +72,17 @@
(output COL-NAME ...))))) (output COL-NAME ...)))))
(define-macro (tst-set-expr IN-BUS IN-VAL) (define-macro (set-expr IN-BUS IN-VAL)
(with-pattern (with-pattern
([CHIP-IN-BUS-ID-WRITE (prefix-id chip-prefix "-" (suffix-id #'IN-BUS "-write"))]) ([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 IN-VAL)))
(define-macro (tst-eval-expr) (define-macro (eval-expr)
(with-shared-id (eval-result eval-chip) (with-shared-id (eval-result eval-chip)
#'(set! eval-result (eval-chip)))) #'(set! eval-result (eval-chip))))
(define-macro (tst-output-expr) (define-macro (output-expr)
(with-shared-id (output eval-result) (with-shared-id (output eval-result)
#'(apply output eval-result))) #'(apply output eval-result)))

@ -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"

@ -1,14 +1,22 @@
#lang br #lang br
(require "grammar.rkt" brag/support)
(module reader br (module+ reader
(require "parser.rkt" "tokenizer.rkt") (provide read-syntax))
(provide read-syntax)
(define (read-syntax source-path port) (define tokenize
(define-values (line col pos) (port-next-location port)) (lexer-srcloc
(define port+newline (input-port-append #f port (open-input-string "\n"))) [(:or (from/to "/*" "*/")
(port-count-lines! port+newline) (from/to "//" #\newline)) (token 'COMMENT lexeme #:skip? #t)]
(set-port-next-location! port+newline line col pos) [whitespace (token lexeme #:skip? #t)]
(strip-context [(:or "load" "output-list" "output-file" "compare-to" "set" "eval" "output" "," ";") lexeme]
(with-syntax ([PT (parse source-path (make-tokenizer port+newline))]) [(:seq "%" (:+ alphabetic numeric ".")) (token 'FORMAT-STRING lexeme)]
#'(module hdl-mod hdl-tst-demo/expander [(:+ numeric) (token 'VAL (string->number lexeme))]
PT))))) [(:+ 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))))

@ -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"

@ -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)
Loading…
Cancel
Save