rearrangements

dev-srcloc
Matthew Butterick 8 years ago
parent 54f1703eb2
commit 7e4d33176a

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

@ -1,6 +1,9 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax br/syntax) br/define syntax/strip-context) (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, ;; `define-read-functions` simplifies support for the standard reading API,
;; which asks for `read` and `read-syntax`. ;; which asks for `read` and `read-syntax`.

@ -375,6 +375,16 @@ As with @racket[define-macro], wildcards in each syntax pattern must be @tt{CAPI
@defmodule[br/reader-utils] @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[ @defform[
(define-read-and-read-syntax (path-id port-id) (define-read-and-read-syntax (path-id port-id)
reader-result-expr ...+) reader-result-expr ...+)

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