refactory

beautiful-racket-lib/br/define.rkt

@@ -3,11 +3,8 @@
   racket/function
   (for-syntax racket/base
               syntax/parse
-              br/syntax
-              racket/syntax
-              syntax/datum
-              syntax/define
-              racket/string))
+              br/private/syntax-flatten
+              syntax/define))
 (provide (all-defined-out)
          (for-syntax with-shared-id))
 
@@ -26,18 +23,18 @@
 
 
 (begin-for-syntax
-  (define (upcased? str)
-    (equal? (string-upcase str) str))
+  (define (upcased-and-capitalized? str)
+    (and (equal? (string-upcase str) str)
+         (not (equal? (string-downcase (substring str 0 1)) (substring str 0 1)))))
 
   (define (generate-literals pats)
-    ;; generate literals for any symbols that are not ... or _ or _underscore-prefixed
+    ;; generate literals for any symbols that are not ... or _ 
     (define pattern-arg-prefixer "_")
     (for*/list ([pat-arg (in-list (syntax-flatten pats))]
                 [pat-datum (in-value (syntax->datum pat-arg))]
                 #:when (and (symbol? pat-datum)
                             (not (member pat-datum '(... _))) ; exempted from literality
-                            (not (string-prefix? (symbol->string pat-datum) pattern-arg-prefixer))
-                            (not (upcased? (symbol->string pat-datum)))))
+                            (not (upcased-and-capitalized? (symbol->string pat-datum)))))
                pat-arg)))
 
 (begin-for-syntax
@@ -94,11 +91,11 @@
   (require rackunit racket/port)
   (parameterize ([current-output-port (open-output-nowhere)])
     (check-equal? (let ()
-                    (debug-define-macro (foo _X _Y _Z)
-                                        #'(apply + (list _X _Y _Z)))
+                    (debug-define-macro (foo X Y Z)
+                                        #'(apply + (list X Y Z)))
                     (foo 1 2 3)) 6)  
     (check-equal? (let ()
-                    (debug-define-macro (foo _X ...) #'(apply * (list _X ...)))
+                    (debug-define-macro (foo X ...) #'(apply * (list X ...)))
                     (foo 10 11 12)) 1320)))
 
 
@@ -228,7 +225,7 @@
   (zam 'this 'that 42)
   (check-equal? dirty-zam 'got-dirty-zam)
   
-  (define-macro (add _x) #'(+ _x _x))
+  (define-macro (add X) #'(+ X X))
   (check-equal? (add 5) 10)
   (define-macro-cases add-again [(_ X) #'(+ X X)])
   (check-equal? (add-again 5) 10)
@@ -240,7 +237,7 @@
   (define (foo-func) 'got-foo-func)
   (define-macro-cases op
     [(_ "+") #''got-plus]
-    [(_ _ARG) #''got-something-else]
+    [(_ ARG) #''got-something-else]
     [(_) #'(foo-func)]
     [_ #'foo-val])
   
@@ -250,7 +247,7 @@
   (check-equal? op 'got-foo-val)
   
   (define-macro-cases elseop
-    [(_ _arg) #''got-arg]
+    [(_ ARG) #''got-arg]
     [else #''got-else])
   
   (check-equal? (elseop "+") 'got-arg)

beautiful-racket-lib/br/experimental/eopl.rkt

@@ -2,7 +2,7 @@
 (require racket/struct (for-syntax br/datum))
 (provide define-datatype cases occurs-free?)
 
-(define-macro (define-datatype BASE-TYPE _base-type-predicate?
+(define-macro (define-datatype BASE-TYPE BASE-TYPE-PREDICATE?
                 (SUBTYPE [FIELD FIELD-PREDICATE?] ...) ...)
   #'(begin
       (struct BASE-TYPE () #:transparent #:mutable)
@@ -35,6 +35,7 @@
            SUBTYPE-CASE ...
            [else (void)])]))
 
+
 (define-macro-cases cases
   [(_ BASE-TYPE INPUT-VAR
       [SUBTYPE (POSITIONAL-VAR ...) . BODY] ...

beautiful-racket-lib/br/private/syntax-flatten.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+(require racket/list)
+(provide (all-defined-out))
+
+(define (syntax-flatten stx)
+  (flatten
+   (let loop ([stx stx])
+     (let* ([stx-unwrapped (syntax-e stx)]
+            [maybe-pair (and (pair? stx-unwrapped) (flatten stx-unwrapped))])
+       (if maybe-pair
+           (map loop maybe-pair)
+           stx)))))

beautiful-racket-lib/br/private/to-string.rkt

@@ -1,92 +0,0 @@
-#lang racket/base
-(require racket/contract/base
-         syntax/stx)
-
-(require racket/list)
-
-(define (syntax->string c)
-  (let* ([s (open-output-string)]
-         [l (syntax->list c)]
-         [init-col (or (syntax-column (first l)) 0)]
-         [col init-col]
-         [line (or (syntax-line (first l)) 0)])
-    (define (advance c init-line!)
-      (let ([c (syntax-column c)]
-            [l (syntax-line c)])
-        (when (and l (l . > . line))
-          (for-each (λ (_) (newline)) (range (- l line)))
-          (set! line l)
-          (init-line!))
-        (when c
-          (display (make-string (max 0 (- c col)) #\space))
-          (set! col c))))
-    (parameterize ([current-output-port s]
-                   [read-case-sensitive #t])
-      (define (loop init-line!)
-        (lambda (c)
-          (cond
-            [(eq? 'code:blank (syntax-e c))
-             (advance c init-line!)]
-            [(eq? '_ (syntax-e c)) (void)]
-            [(eq? '... (syntax-e c))
-             (void)]
-            [(and (pair? (syntax-e c))
-                  (eq? (syntax-e (car (syntax-e c))) 'code:comment))
-             (advance c init-line!)
-             (printf "; ")
-             (display (syntax-e (cadr (syntax->list c))))]
-            [(and (pair? (syntax-e c))
-                  (eq? (syntax-e (car (syntax-e c))) 'code:contract))
-             (advance c init-line!)
-             (printf "; ")
-             (let* ([l (cdr (syntax->list c))]
-                    [s-col (or (syntax-column (first l)) col)])
-               (set! col s-col)
-               (for-each (loop (lambda ()
-                                 (set! col s-col)
-                                 (printf "; ")))
-                         l))]
-            [(and (pair? (syntax-e c))
-                  (eq? (syntax-e (car (syntax-e c))) 'quote))
-             (advance c init-line!)
-             (printf "'")
-             (let ([i (cadr (syntax->list c))])
-               (set! col (or (syntax-column i) col))
-               ((loop init-line!) i))]
-            [(pair? (syntax-e c))
-             (advance c init-line!)
-             (define c-paren-shape (syntax-property c 'paren-shape))
-             (printf (format "~a" (or c-paren-shape #\()))
-             (set! col (+ col 1))
-             (map (loop init-line!) (syntax->list c))
-             (printf (case c-paren-shape
-                       [(#\[) "]"]
-                       [(#\{) "}"]
-                       [else ")"]))
-             (set! col (+ col 1))]
-            [(vector? (syntax-e c))
-             (advance c init-line!)
-             (printf "#(")
-             (set! col (+ col 2))
-             (map (loop init-line!) (vector->list (syntax-e c)))
-             (printf ")")
-             (set! col (+ col 1))]
-            [else
-             (advance c init-line!)
-             (let ([s (format "~s" (syntax-e c))])
-               (set! col (+ col (string-length s)))
-               (display s))])))
-      (for-each (loop (lambda () (set! col init-col))) l))
-    (get-output-string s)))
-
-(provide/contract [syntax->string (-> (and/c syntax? stx-list?)
-                                      string?)])
-
-(module+ test
-  (require rackunit)
-  (check-equal? (syntax->string
-                #'((define (f x)
-                     [+ x x])
-                   
-                   (define (g x)
-                     (* x x)))) "(define (f x)\n  [+ x x])\n\n(define (g x)\n  (* x x))"))

beautiful-racket-lib/br/quicklang.rkt

@@ -3,10 +3,10 @@
 (provide (except-out (all-from-out br) #%module-begin)
          (rename-out [quicklang-mb #%module-begin]))
 
-(define-macro (quicklang-mb . exprs)
+(define-macro (quicklang-mb . EXPRS)
   (define-values
     (kw-pairs other-exprs)
-    (let loop ([kw-pairs null][exprs (syntax->list #'exprs)])
+    (let loop ([kw-pairs null][exprs (syntax->list #'EXPRS)])
       (if (and (pair? exprs) (keyword? (syntax-e (car exprs))))
           (loop (cons (cons (string->symbol (keyword->string (syntax-e (car exprs))))
                             (cadr exprs)) ; leave val in stx form so local binding is preserved
@@ -22,7 +22,7 @@
        (provide PROVIDED-ID ...)
        (provide (rename-out [VAL KW]) ...)
        (provide #%top #%app #%datum #%top-interaction)
-       . #,(datum->syntax #'exprs other-exprs #'exprs))))
+       . #,(datum->syntax #'EXPRS other-exprs #'EXPRS))))
 
 
 (module reader syntax/module-reader

beautiful-racket-lib/br/syntax.rkt

@@ -1,45 +1,29 @@
 #lang racket/base
-(require (for-syntax racket/base syntax/parse racket/syntax syntax/strip-context)
-         syntax/strip-context racket/function racket/list racket/syntax "private/to-string.rkt")
-(provide (all-defined-out) (all-from-out syntax/strip-context)
-         (rename-out [strip-context strip-identifier-bindings]))
+(require (for-syntax racket/base racket/syntax)
+         racket/list
+         racket/syntax
+         br/define
+         br/private/syntax-flatten)
+(provide (all-defined-out)
+         syntax-flatten)
 
 (module+ test
   (require rackunit))
 
-(define-syntax (syntax-match stx)
-  (syntax-case stx (syntax)
-    [(_ stx-arg [(syntax pattern) body ...] ...)
-     #'(syntax-case stx-arg ()
-         [pattern body ...] ...)]))
-
-(define-syntax (inject-syntax stx)
-  ;; todo: permit mixing of two-arg and one-arg binding forms
-  ;; one-arg form allows you to inject an existing syntax object using its current name
-  (syntax-case stx (syntax)
-    [(_ ([(syntax sid) sid-stx] ...) body ...)
-     #'(inject-syntax ([sid sid-stx] ...) body ...)]
-    [(_ ([sid sid-stx] ...) body ...)
-     #'(with-syntax ([sid sid-stx] ...) body ...)]
-    ;; todo: limit `sid` to be an identifier
-    [(_ ([sid] ...) body ...)
-     #'(with-syntax ([sid sid] ...) body ...)]))
-
-(define-syntax (inject-syntax* stx)
-  (syntax-case stx ()
-    [(_ () . body) #'(begin . body)]
-    [(_ (stx-expr0 stx-expr ...) . body)
-     #'(inject-syntax (stx-expr0)
-                      (inject-syntax* (stx-expr ...) . body))]))
-
-(define-syntax with-pattern (make-rename-transformer #'inject-syntax*))
-(define-syntax let-syntax-pattern (make-rename-transformer #'inject-syntax*))
-(define-syntax let*-syntax-pattern (make-rename-transformer #'inject-syntax*))
-(define-syntax syntax-let (make-rename-transformer #'inject-syntax))
-(define-syntax add-syntax (make-rename-transformer #'inject-syntax))
-
-(define-syntax-rule (test-macro mac-expr)
-  (syntax->datum (expand-once #'mac-expr)))
+
+(define-macro (syntax-match STX-ARG [(syntax PATTERN) BODY ...] ...)
+  #'(syntax-case STX-ARG ()
+      [PATTERN BODY ...] ...))
+
+
+(define-macro-cases with-pattern
+  [(_ () . BODY) #'(begin . BODY)]
+  [(_ ([SID SID-STX] STX ...) . BODY)
+   #'(with-syntax ([SID SID-STX])
+       (with-pattern (STX ...) . BODY))]
+  [(_ ([SID] STX ...) . BODY) ; standalone id
+   #'(with-pattern ([SID SID] STX ...) . BODY)]) ; convert to previous case
+
 
 (define (check-syntax-list-argument caller-name arg)
   (cond
@@ -48,118 +32,84 @@
     [else (raise-argument-error caller-name "list of syntax, or syntaxed list" arg)]))
 
 
-(define-syntax-rule (syntax-case-partition _stx-list _literals . _matchers)
-  (partition (λ(stx-item)
-               (with-handlers ([exn:fail:syntax? (λ (exn) #f)])
-                 (syntax-case stx-item _literals
-                   . _matchers))) (check-syntax-list-argument 'syntax-case-partition _stx-list)))
-
-
-(define-syntax-rule (syntax-case-filter _stx-list _literals . _matchers)
-  (filter (λ(stx-item)
-            (with-handlers ([exn:fail:syntax? (λ (exn) #f)])
-              (syntax-case stx-item _literals
-                . _matchers))) (check-syntax-list-argument 'syntax-case-filter _stx-list)))
-
-
-(define-syntax-rule (syntax-case-map _stx-list _literals . _matchers)
-  (map (λ(stx-item)
-         (syntax-case stx-item _literals
-           . _matchers)) (check-syntax-list-argument 'syntax-case-map _stx-list)))
-
-
-(define-syntax-rule (reformat-id fmt id0 id ...)
-  (format-id id0 fmt id0 id ...))
-
-(define-syntax-rule (format-string fmt id0 id ...)
-  (datum->syntax id0 (format fmt (syntax->datum id0) (syntax->datum id) ...)))
-
-
-(define-syntax-rule (->unsyntax x)
-  (if (syntax? x)
-      (syntax->datum x)
-      x))
-
-(define-syntax-rule (prefix-id _prefix ... _base-or-bases)
-  (let* ([bob _base-or-bases]
-         [got-single? (and (not (list? bob)) (not (syntax->list bob)))]
-         [bases (if got-single?
-                    (list bob)
-                    bob)]
-         [result (syntax-case-map
-                  bases ()
-                  [base (format-id #'base "~a~a"
-                                   (string-append (format "~a" (->unsyntax _prefix)) ...)
-                                   (syntax-e #'base))])])
-    (if got-single? (car result) result)))
-
-(define-syntax-rule (infix-id _prefix _base-or-bases _suffix ...)
-  (let* ([bob _base-or-bases]
-         [got-single? (and (not (list? bob)) (not (syntax->list bob)))]
-         [bases (if got-single?
-                    (list bob)
-                    bob)]
-         [result (syntax-case-map
-                  bases ()
-                  [base (format-id #'base "~a~a~a" (->unsyntax _prefix) (syntax-e #'base)
-                                   (string-append (format "~a" (->unsyntax _suffix)) ...))])])
-    (if got-single? (car result) result)))
-
-(define-syntax-rule (suffix-id _base-or-bases _suffix ...)
-  (infix-id "" _base-or-bases _suffix ...))
-
-(define-syntax (syntax-property* stx)
-  (syntax-case stx (quote)
-    [(_ stx-object 'prop0)
-     #'(syntax-property stx-object 'prop0)]
-    [(_ stx-object 'prop0 'prop ...)
-     #'(cons (syntax-property stx-object 'prop0) (let ([result (syntax-property* stx-object 'prop ...)])
-                                                   (if (pair? result)
-                                                       result
-                                                       (list result))))]
-    [(_ stx-object ['prop0 val0 . preserved0])
-     #'(syntax-property stx-object 'prop0 val0 . preserved0)]
-    [(_ stx-object ['prop0 val0 . preserved0] ['prop val . preserved] ...)
-     #'(syntax-property* (syntax-property stx-object 'prop0 val0 . preserved0) ['prop val . preserved] ...)]))
+(define-macro (define-listy-macro MACRO-ID LIST-FUNC)
+  #'(define-macro (MACRO-ID STX-LIST LITERALS . MATCHERS)
+      #'(LIST-FUNC
+         (λ(stx-item)
+           (with-handlers ([exn:fail:syntax? (λ (exn) #f)])
+             (syntax-case stx-item LITERALS
+               . MATCHERS)))
+         (check-syntax-list-argument 'MACRO-ID STX-LIST))))
 
-(module+ test
-  (define x (syntax-property* #'foo ['bar #t] ['zam 'boni]))
-  (check-false (syntax-property* x 'foo))
-  (check-true (syntax-property* x 'bar))
-  (check-equal? (syntax-property* x 'foo 'bar 'zam) '(#f #t boni)))
+(define-listy-macro syntax-case-partition partition)
+(define-listy-macro syntax-case-filter filter)
+(define-listy-macro syntax-case-map map)
 
 
-;; the Søgaard technique
-;; http://blog.scheme.dk/2006/05/how-to-write-unhygienic-macro.html
-(define-syntax-rule (introduce-id (id ...) . body)
-  (with-syntax ([id (syntax-local-introduce (syntax-local-get-shadower #'id))] ...)
-    . body))
+(define-macro (reformat-id FMT ID0 ID ...)
+  #'(format-id ID0 FMT ID0 ID ...))
 
 
-(define (syntax-flatten stx)
-  (flatten
-   (let loop ([stx stx])
-     (define maybe-pair (let ([e-stx (syntax-e stx)])
-                          (and (pair? e-stx) (flatten e-stx))))
-     (if maybe-pair
-         (map loop maybe-pair)
-         stx))))
+(define-macro (format-string FMT ID0 ID ...)
+  #'(datum->syntax ID0 (format FMT (syntax->datum ID0) (syntax->datum ID) ...)))
 
-(define-syntax-rule (begin-label LABEL . EXPRS)
-  (begin
-    (define LABEL (syntax->string #'EXPRS))
-    (provide LABEL)
-    (begin . EXPRS)))
 
-(module+ test
-  (begin-label
-    zing
-    (define (f x)
-      [+ x x])
+(define-macro (->unsyntax X)
+  #'(if (syntax? X)
+        (syntax->datum X)
+        X))
+
+
+(define-macro (prefix-id PREFIX ... BASE-OR-BASES)
+  #'(let* ([bobs BASE-OR-BASES]
+           [got-single? (and (not (list? bobs)) (not (syntax->list bobs)))]
+           [bases (if got-single?
+                      (list bobs)
+                      bobs)]
+           [result (syntax-case-map
+                    bases ()
+                    [base (format-id #'base "~a~a"
+                                     (string-append (format "~a" (->unsyntax PREFIX)) ...)
+                                     (syntax-e #'base))])])
+      (if got-single? (car result) result)))
 
-    (define (g x)
-      (* x x)))
 
-  (check-equal? zing "(define (f x)\n  [+ x x])\n\n(define (g x)\n  (* x x))")
-  (check-equal? (f 5) 10)
-  (check-equal? (g 5) 25))
+(define-macro (infix-id PREFIX BASE-OR-BASES SUFFIX ...)
+  #'(let* ([bobs BASE-OR-BASES]
+           [got-single? (and (not (list? bobs)) (not (syntax->list bobs)))]
+           [bases (if got-single?
+                      (list bobs)
+                      bobs)]
+           [result (syntax-case-map
+                    bases ()
+                    [base (format-id #'base "~a~a~a"
+                                     (->unsyntax PREFIX)
+                                     (syntax-e #'base)
+                                     (string-append (format "~a" (->unsyntax SUFFIX)) ...))])])
+      (if got-single? (car result) result)))
+
+
+(define-macro (suffix-id BASE-OR-BASES SUFFIX ...)
+  #'(infix-id "" BASE-OR-BASES SUFFIX ...))
+
+
+(define-macro-cases syntax-property*
+  [(_ STX 'PROP0) ; read one
+   #'(syntax-property STX 'PROP0)]
+  [(_ STX 'PROP0 'PROP ...) ; read multiple
+   #'(cons (syntax-property* STX 'PROP0)
+           (let ([result (syntax-property* STX 'PROP ...)])
+             (if (pair? result)
+                 result
+                 (list result))))]
+  [(_ STX ['PROP0 VAL0 . PRESERVED0]) ; write one
+   #'(syntax-property STX 'PROP0 VAL0 . PRESERVED0)]
+  [(_ STX ['PROP0 VAL0 . PRESERVED0] ['PROP VAL . PRESERVED] ...) ; write multiple
+   #'(syntax-property* (syntax-property STX 'PROP0 VAL0 . PRESERVED0) ['PROP VAL . PRESERVED] ...)])
+
+
+(module+ test
+  (define x (syntax-property* #'foo ['bar #t] ['zam 'boni]))
+  (check-false (syntax-property* x 'foo))
+  (check-true (syntax-property* x 'bar))
+  (check-equal? (syntax-property* x 'foo 'bar 'zam) '(#f #t boni)))

beautiful-racket/br/demo/basic/expander.rkt

@@ -1,4 +1,5 @@
 #lang br
+(require (for-syntax syntax/strip-context))
 (provide #%top-interaction #%app #%datum
          (rename-out [basic-module-begin #%module-begin])
          (rename-out [basic-top #%top])

beautiful-racket/br/demo/hdl-tst/expander.rkt

@@ -1,6 +1,6 @@
-#lang br
+#lang br/quicklang
 (require (for-syntax br/syntax racket/string) rackunit racket/file)
-(provide #%top-interaction #%module-begin #%datum #%app (all-defined-out))
+(provide #%module-begin (all-defined-out))
 
 
 (define (print-cell val fmt)

beautiful-racket/br/demo/hdl/bus.rkt

@@ -103,29 +103,29 @@ base bus:
 
 
 (define-macro-cases define-base-bus
-  [(_macro-name ID THUNK) #'(_macro-name ID THUNK default-bus-width)]
-  [(_macro-name ID THUNK _bus-width-in)
+  [(_ ID THUNK) #'(define-base-bus ID THUNK default-bus-width)]
+  [(_ ID THUNK BUS-WIDTH-IN)
    (with-pattern
-    ([_id-thunk (suffix-id #'ID "-val")]
-     [_bus-type (or (syntax-property caller-stx 'impersonate) #'bus)])
-    #`(splicing-let ([_id-thunk THUNK]
-                     [bus-width _bus-width-in])
+    ([ID-THUNK (suffix-id #'ID "-val")]
+     [BUS-TYPE (or (syntax-property caller-stx 'impersonate) #'bus)])
+    #`(splicing-let ([ID-THUNK THUNK]
+                     [bus-width BUS-WIDTH-IN])
         (define ID
           (begin
             (unless (<= bus-width max-bus-width)
               (raise-argument-error 'id (format "bus width <= max width ~a" max-bus-width) bus-width))
             (impersonate-procedure
              (let ([reader (make-bus-reader 'id bus-width)])
-               (procedure-rename (λ args (apply reader (_id-thunk) args)) (string->symbol (format "~a, a bus of width ~a" 'ID bus-width))))
-             #f _bus-type #t)))
+               (procedure-rename (λ args (apply reader (ID-THUNK) args)) (string->symbol (format "~a, a bus of width ~a" 'ID bus-width))))
+             #f BUS-TYPE #t)))
         #,(when (syntax-property caller-stx 'writer)
             (with-pattern
              ([_id-write (suffix-id #'ID "-write")])
              #'(define _id-write
                  (let ([writer (make-bus-writer 'id-write bus-width)])
                    (λ args
-                     (define result (apply writer (_id-thunk) args))
-                     (set! _id-thunk (λ () result)))))))))])
+                     (define result (apply writer (ID-THUNK) args))
+                     (set! ID-THUNK (λ () result)))))))))])
 
 
 (module+ test
@@ -157,8 +157,8 @@ output bus:
 
 
 
-(define-macro (define-output-bus . _args)
-  (syntax-property #'(define-base-bus . _args) 'impersonate #'output-bus))
+(define-macro (define-output-bus . ARGS)
+  (syntax-property #'(define-base-bus . ARGS) 'impersonate #'output-bus))
 
 (module+ test
   (define-output-bus ob (λ () #b0110) 4)
@@ -188,10 +188,10 @@ input bus:
 
 
 (define-macro-cases define-input-bus
-  [(_macro-name _id)
-   #'(_macro-name _id default-bus-width)]
-  [(_macro-name _id _bus-width)
-   (syntax-property* #'(define-base-bus _id (λ () 0) _bus-width)
+  [(MACRO-NAME ID)
+   #'(MACRO-NAME ID default-bus-width)]
+  [(MACRO-NAME ID BUS-WIDTH)
+   (syntax-property* #'(define-base-bus ID (λ () 0) BUS-WIDTH)
                      ['impersonate #'input-bus]
                      ['writer #t])])
 

beautiful-racket/br/demo/hdl/expander.rkt

@@ -1,6 +1,6 @@
-#lang br
+#lang br/quicklang
 (require "bus.rkt" (for-syntax racket/syntax racket/require-transform br/syntax "bus-properties.rkt"))
-(provide #%top-interaction #%module-begin #%app #%datum (all-defined-out))
+(provide #%module-begin (all-defined-out))
 
 (define-macro (chip-program CHIPNAME
                             (in-spec (IN-BUS IN-WIDTH ...) ...)

beautiful-racket/br/demo/hdl/reader.rkt

@@ -1,7 +1,6 @@
 #lang br
 (require br/reader-utils "parser.rkt" "tokenizer.rkt")
 
-(provide read-syntax)
-(define (read-syntax source-path input-port)
-  (strip-context #`(module hdl-mod br/demo/hdl/expander
-                     #,(parse source-path (tokenize input-port)))))
+(define-read-and-read-syntax (source-path input-port)
+  #`(module hdl-mod br/demo/hdl/expander
+      #,(parse source-path (tokenize input-port))))