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)
+(require (for-syntax racket/string) rackunit racket/file)
-(provide #%module-begin (all-defined-out))
+(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,23 +36,21 @@
 
 
 (define-macro (tst-program EXPR ...)
-  (with-shared-id
+  (with-shared-id (compare-files)
-   (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)
+(define-macro (tst-output-file-expr OUTPUT-FILE-STRING)
-  (with-shared-id
+  (with-shared-id (output-file output-filename)
-   (output-file output-filename)
     #'(begin
         (define output-filename OUTPUT-FILE-STRING)
         (with-output-to-file output-filename
@@ -61,19 +59,17 @@
           #:exists 'replace))))
 
 
-(define-macro (compare-to-expr COMPARE-FILE-STRING)
+(define-macro (tst-compare-to-expr COMPARE-FILE-STRING)
-  (with-shared-id
+  (with-shared-id (compare-files output-filename)
-   (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) ...)
+(define-macro (tst-output-list-expr (COL-NAME FORMAT-SPEC) ...)
-  (with-shared-id
+  (with-shared-id (eval-result eval-chip output output-filename)
-   (eval-result eval-chip output output-filename)
     (with-pattern
-    ([(COL-ID ...) (suffix-id #'(COL-NAME ...))]
+        ([(COL-ID ...) (suffix-ids #'(COL-NAME ...))]
-     [(CHIP-COL-ID ...) (prefix-id chip-prefix "-" #'(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 ...))))
@@ -82,19 +78,17 @@
           (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)))
 
 
-(define-macro (eval-expr)
+(define-macro (tst-eval-expr)
-  (with-shared-id
+  (with-shared-id (eval-result eval-chip)
-   (eval-result eval-chip)
     #'(set! eval-result (eval-chip))))
 
 
-(define-macro (output-expr)
+(define-macro (tst-output-expr)
-  (with-shared-id
+  (with-shared-id (output eval-result)
-   (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*
+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 /","
-load-expr : /"load" ID /","
+tst-output-file-expr : /"output-file" ID /","
-
+tst-compare-to-expr : /"compare-to" ID /","
-output-file-expr : /"output-file" ID /","
+tst-output-list-expr : /"output-list" tst-column [tst-column]+
-
+/tst-column :  ID FORMAT-STRING
-compare-to-expr : /"compare-to" ID /","
+@tst-test-expr : tst-step-expr+ /";"
-
+@tst-step-expr : (tst-set-expr | tst-eval-expr | tst-output-expr) [/","]
-output-list-expr : /"output-list" column [column]+
+tst-set-expr : /"set" ID VAL
-
+tst-eval-expr : /"eval"
-/column :  ID FORMAT-STRING
+tst-output-expr : /"output"
-
-@test-expr : step-expr+ /";"
-
-@step-expr : (set-expr | eval-expr | output-expr) [/","]
-
-set-expr : /"set" ID VAL
-
-eval-expr : /"eval"
-
-output-expr : /"output"

beautiful-racket-demo/hdl-tst-demo/tokenizer.rkt

@@ -1,21 +1,18 @@
-#lang br
+#lang br/quicklang
-(require brag/support
+(require brag/support)
-         racket/string)
+(provide make-tokenizer)
 
-(provide tokenize)
+(define hdl-test-lexer
-(define (tokenize input-port)
+  (lexer-srcloc
-  (define (next-token)
-    (define get-token
-      (lexer-src-pos
    [(eof) eof]
-        [(union
+   [(:or (from/to "/*" "*/")
-         (:seq "/*" (complement (:seq any-string "*/" any-string)) "*/")
+         (from/to "//" #\newline)) (token 'COMMENT lexeme #:skip? #t)]
-         (:seq "//" (repetition 1 +inf.0 (char-complement #\newline)) #\newline))
+   [whitespace (token lexeme #:skip? #t)]
-        (token 'COMMENT lexeme #:skip? #t)]
+   [(:or "load" "output-list" "output-file" "compare-to" "set" "eval" "output" "," ";") lexeme]
-       [(union #\tab #\space #\newline) (return-without-pos (get-token input-port))]
+   [(:seq "%" (:+ alphabetic numeric ".")) (token 'FORMAT-STRING lexeme)]
-       [(union "load" "output-list" "output-file" "compare-to" "set" "eval" "output" (char-set ",;")) lexeme]
+   [(:+ numeric) (token 'VAL (string->number lexeme))]
-       [(:seq "%" (repetition 1 +inf.0 (union alphabetic numeric (char-set ".")))) (token 'FORMAT-STRING lexeme)]
+   [(:+ alphabetic numeric "-" ".") (token 'ID lexeme)]))
-       [(repetition 1 +inf.0 numeric) (token 'VAL (string->number lexeme))]
+
-       [(repetition 1 +inf.0 (union alphabetic numeric (char-set "-."))) (token 'ID lexeme)]))
+(define (make-tokenizer ip)
-    (get-token input-port))  
+  (define (next-token) (hdl-test-lexer ip))  
   next-token)