diff --git a/beautiful-racket-lib/br/main.rkt b/beautiful-racket-lib/br/main.rkt index 77ea393..d3888ef 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 racket/function racket/provide - br/define br/syntax br/datum br/debug br/cond br/list racket/class racket/vector +(require racket/provide racket/list racket/string racket/format racket/match racket/port racket/function racket/provide + br/define br/syntax br/datum br/debug br/cond br/list br/reader-utils racket/class racket/vector (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 racket/function racket/provide - br/syntax br/datum br/debug br/cond br/list racket/class racket/vector br/define) + br/syntax br/datum br/debug br/cond br/list br/reader-utils racket/class racket/vector br/define) (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 diff --git a/beautiful-racket-lib/br/reader-utils.rkt b/beautiful-racket-lib/br/reader-utils.rkt new file mode 100644 index 0000000..7b7f3f0 --- /dev/null +++ b/beautiful-racket-lib/br/reader-utils.rkt @@ -0,0 +1,44 @@ +#lang racket/base +(require (for-syntax racket/base racket/syntax br/syntax) br/define syntax/strip-context) +(provide (all-defined-out)) + +(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`. +;; in general, `read` is just the datum from the result of `read-syntax`. + +(define-macro (define-read-and-read-syntax (PATH PORT) BODY ...) + (let ([internal-prefix (gensym)]) + (with-syntax ([READ (datum->syntax caller-stx 'read)] + [READ-SYNTAX (datum->syntax caller-stx 'read-syntax)] + ;; use prefixed names to prevent namespace collisions with possibly existing `read` & `read-syntax` + [INTERNAL-READ (format-id #'here "~a-~a" internal-prefix 'read)] + [INTERNAL-READ-SYNTAX (format-id #'here "~a-~a" internal-prefix 'read-syntax)]) + #'(begin + (provide (rename-out [INTERNAL-READ READ] + [INTERNAL-READ-SYNTAX READ-SYNTAX])) + (define (calling-site-function PATH PORT) + BODY ...) ; don't care whether this produces datum or syntax + + (define INTERNAL-READ-SYNTAX + (procedure-rename (λ (path port) ; rename proc so it looks right in the REPL (otherwise retains internal prefix name) + ;; because `read-syntax` must produce syntax + ;; coerce a datum result to syntax if needed (à la `with-syntax`) + (define result-syntax (let ([output (calling-site-function path port)]) + (if (syntax? output) + output + (datum->syntax #f output)))) + ;; because `read-syntax` must produce syntax without context + ;; see http://docs.racket-lang.org/guide/hash-lang_reader.html + ;; "a `read-syntax` function should return a syntax object with no lexical context" + (strip-context result-syntax)) 'READ-SYNTAX)) + + (define INTERNAL-READ + (procedure-rename (λ (port) + ; because `read` must produce a datum + (let ([output (calling-site-function #f port)]) + (if (syntax? output) + (syntax->datum output) + output))) 'READ)))))) \ No newline at end of file diff --git a/beautiful-racket-lib/br/scribblings/br.scrbl b/beautiful-racket-lib/br/scribblings/br.scrbl index fcccf9c..9cdf242 100644 --- a/beautiful-racket-lib/br/scribblings/br.scrbl +++ b/beautiful-racket-lib/br/scribblings/br.scrbl @@ -673,6 +673,17 @@ xs ] } +@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. +} + @section{The @tt{br} teaching languages}