diff --git a/beautiful-racket-lib/br/main.rkt b/beautiful-racket-lib/br/main.rkt index 0196117..acddfe0 100644 --- a/beautiful-racket-lib/br/main.rkt +++ b/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 diff --git a/beautiful-racket-lib/br/reader-utils.rkt b/beautiful-racket-lib/br/reader-utils.rkt index 57e3623..d3030bb 100644 --- a/beautiful-racket-lib/br/reader-utils.rkt +++ b/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`. diff --git a/beautiful-racket-lib/br/scribblings/br.scrbl b/beautiful-racket-lib/br/scribblings/br.scrbl index 3f796a8..9c47308 100644 --- a/beautiful-racket-lib/br/scribblings/br.scrbl +++ b/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 ...+) diff --git a/beautiful-racket/br/demo/wires/main.rkt b/beautiful-racket/br/demo/wires/main.rkt index 7e64b6a..be4bdc6 100644 --- a/beautiful-racket/br/demo/wires/main.rkt +++ b/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)) \ No newline at end of file +(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) \ No newline at end of file