updates

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)))

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)))))

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

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)