From 6d1ae97db4354e379846227f3a0b92900551603d Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 10 Apr 2016 10:23:48 -0700
Subject: [PATCH] add `define-read-functions`

---
 br-bf/main.rkt             |  7 +++++++
 br-bf/reader-proc-test.rkt |  6 ++++++
 br/read-functions.rkt      | 34 ++++++++++++++++++++++++++++++++++
 3 files changed, 47 insertions(+)
 create mode 100644 br-bf/reader-proc-test.rkt
 create mode 100644 br/read-functions.rkt

diff --git a/br-bf/main.rkt b/br-bf/main.rkt
index 10e6a7a..0f58076 100644
--- a/br-bf/main.rkt
+++ b/br-bf/main.rkt
@@ -13,6 +13,13 @@
                     #'(module bf-interpreter br-bf
                         parsed-syntax)))))
 
+;; compact version
+#;(module reader br
+  (require br/read-functions "tokenizer.rkt" "parser.rkt")
+  (define-read-functions (src-path src-port)
+    #`(module bf-interpreter br-bf
+        #,(parse src-path (tokenize src-port)))))
+
 (provide (rename-out [bf-module-begin #%module-begin])
          #%top-interaction bf-program op loop)
 
diff --git a/br-bf/reader-proc-test.rkt b/br-bf/reader-proc-test.rkt
new file mode 100644
index 0000000..c56cf6f
--- /dev/null
+++ b/br-bf/reader-proc-test.rkt
@@ -0,0 +1,6 @@
+#lang racket
+
+(read-accept-reader #t)
+(call-with-input-file "bf-hash.rkt" read)
+
+(syntax->datum (call-with-input-file "bf-hash.rkt" (curry read-syntax #f)))
\ No newline at end of file
diff --git a/br/read-functions.rkt b/br/read-functions.rkt
new file mode 100644
index 0000000..768fdd5
--- /dev/null
+++ b/br/read-functions.rkt
@@ -0,0 +1,34 @@
+#lang racket/base
+(require (for-syntax racket/base) syntax/strip-context)
+(provide define-read-functions)
+
+;; `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-syntax-rule (define-read-functions (PATH PORT) BODY ...)
+  (begin
+    
+    (provide read read-syntax)
+    
+    (define (use-site-read-function PATH PORT)
+      BODY ...) ; don't care whether this produces datum or syntax
+    
+    (define (read-syntax path port)
+      ;; because `read-syntax` must produce syntax
+      ;; coerce a datum result to syntax if needed (à la `with-syntax`)
+      (define result-syntax (let ([output (use-site-read-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)) 
+    
+    (define (read port)
+      ; because `read` must produce a datum
+      (let ([output (use-site-read-function #f port)])
+        (if (syntax? output)
+            (syntax->datum output)
+            output)))))