rearrangements

beautiful-racket-lib/br/main.rkt

@@ -1,10 +1,10 @@
 #lang racket/base
 (require racket/provide racket/list racket/string racket/format racket/match racket/port
-         br/define br/syntax br/datum br/debug br/cond racket/class racket/vector
+         br/define br/syntax br/datum br/debug br/cond racket/class racket/vector br/reader-utils
          (for-syntax racket/base racket/syntax br/syntax br/debug br/define br/datum))
 (provide (all-from-out racket/base)
          (all-from-out racket/list racket/string racket/format racket/match racket/port
-                       br/syntax br/datum br/debug br/cond racket/class racket/vector br/define)
+                       br/syntax br/datum br/debug br/cond racket/class racket/vector br/define br/reader-utils)
          (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug br/datum))
          (for-syntax caller-stx with-shared-id)) ; from br/define
          
@@ -21,6 +21,7 @@
   #'(parameterize ([current-namespace (make-base-namespace)])
       (dynamic-require . ARGS)))
 
+
 (module reader syntax/module-reader
   #:language 'br
   #:info br-get-info

beautiful-racket-lib/br/reader-utils.rkt

@@ -1,6 +1,9 @@
 #lang racket/base
 (require (for-syntax racket/base racket/syntax br/syntax) br/define syntax/strip-context)
-(provide define-read-and-read-syntax)
+(provide define-read-and-read-syntax test-reader)
+
+(define (test-reader read-syntax-proc str)
+  (syntax->datum (read-syntax-proc #f (open-input-string str))))
 
 ;; `define-read-functions` simplifies support for the standard reading API,
 ;; which asks for `read` and `read-syntax`.

beautiful-racket-lib/br/scribblings/br.scrbl

@@ -375,6 +375,16 @@ As with @racket[define-macro], wildcards in each syntax pattern must be @tt{CAPI
 
 @defmodule[br/reader-utils]
 
+
+@defproc[
+(test-reader
+[read-syntax-proc procedure?]
+[source-str string?])
+datum?]{
+Applies @racket[read-syntax-proc] to @racket[source-str] as if it were being read in from a source file. 
+}
+
+
 @defform[
 (define-read-and-read-syntax (path-id port-id) 
   reader-result-expr ...+)

beautiful-racket/br/demo/wires/main.rkt

@@ -1,6 +1,4 @@
 #lang br/quicklang
-(provide #%module-begin wire
-         AND OR LSHIFT RSHIFT NOT)
 
 (module+ reader
   (provide read-syntax))
@@ -8,19 +6,22 @@
 (define (read-syntax path port)
   (define wire-datums
     (for/list ([wire-str (in-lines port)])
-              (format-datum '(wire ~a) wire-str)))
-  (strip-context
+      (format-datum '(wire ~a) wire-str)))
+  (strip-bindings
    #`(module wires-mod br/demo/wires/main
        #,@wire-datums)))
 
+(provide #%module-begin)
+
 (define-macro-cases wire
-  [(wire ARG -> ID) #'(define/display (ID)
-                        (val ARG))]
-  [(wire OP ARG -> ID) #'(define/display (ID)
-                           (OP (val ARG)))]
-  [(wire ARG1 OP ARG2 -> ID) #'(define/display (ID)
-                                 (OP (val ARG1) (val ARG2)))]
+  [(wire ARG -> WIRE) #'(define/display (WIRE)
+                          (val ARG))]
+  [(wire OP ARG -> WIRE) #'(define/display (WIRE)
+                             (OP (val ARG)))]
+  [(wire ARG1 OP ARG2 -> WIRE) #'(define/display (WIRE)
+                                   (OP (val ARG1) (val ARG2)))]
   [else #'(void)])
+(provide wire)
 
 (define-macro (define/display (ID) BODY)
   #'(begin
@@ -29,18 +30,19 @@
         (displayln (format "~a: ~a" 'ID (ID))))))
 
 (define val
-  (let ([wire-cache (make-hash)])
-    (λ (num-or-wire)
+  (let ([val-cache (make-hash)])
+    (lambda (num-or-wire)
       (if (number? num-or-wire)
           num-or-wire
-          (hash-ref! wire-cache num-or-wire num-or-wire)))))
+          (hash-ref! val-cache num-or-wire num-or-wire)))))
 
-(define 16bit-max (expt 2 16))
-(define-macro (define-16bit ID+ARGS BODY)
-  #'(define ID+ARGS (modulo BODY 16bit-max)))
+(define (mod-16bit x) (modulo x 65535))
+(define-macro (define-16bit ID PROC-ID)
+  #'(define ID (compose1 mod-16bit PROC-ID)))
 
-(define-16bit (AND x y) (bitwise-and x y))
-(define-16bit (OR x y) (bitwise-ior x y))
-(define-16bit (LSHIFT x y) (arithmetic-shift x y))
-(define-16bit (RSHIFT x y) (LSHIFT x (- y)))
-(define-16bit (NOT arg) (bitwise-not arg))
+(define-16bit AND bitwise-and)
+(define-16bit OR bitwise-ior)
+(define-16bit NOT bitwise-not)
+(define-16bit LSHIFT arithmetic-shift)
+(define (RSHIFT x y) (LSHIFT x (- y)))
+(provide AND OR NOT LSHIFT RSHIFT)