From 1b4ef83c1e44122e2698860f51366d86a4bdb5dc Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 15 Mar 2017 14:58:59 -0700
Subject: [PATCH] restore test-reader

---
 beautiful-racket-lib/br/main.rkt             |  6 +--
 beautiful-racket-lib/br/reader-utils.rkt     | 44 ++++++++++++++++++++
 beautiful-racket-lib/br/scribblings/br.scrbl | 11 +++++
 3 files changed, 58 insertions(+), 3 deletions(-)
 create mode 100644 beautiful-racket-lib/br/reader-utils.rkt

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}