From a93f583fc4087698beed14a0f3d17c8c3b3ed9f9 Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Wed, 22 Apr 2015 18:46:03 -0400
Subject: [PATCH] make language-info compose nicely

---
 afl/lang/language-info.rkt  | 15 +++++++++++++--
 afl/lang/reader.rkt         |  7 ++++---
 afl/lang/runtime-config.rkt |  7 ++-----
 afl/reader.rkt              |  5 +++--
 4 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/afl/lang/language-info.rkt b/afl/lang/language-info.rkt
index 3e36d4d..dae2368 100644
--- a/afl/lang/language-info.rkt
+++ b/afl/lang/language-info.rkt
@@ -2,9 +2,20 @@
 
 (provide get-language-info)
 
+(require racket/match)
+
 (define (get-language-info data)
+  (define other-get-info
+    (match data
+      [(vector mod sym data2)
+       ((dynamic-require mod sym) data2)]
+      [_ (lambda (key default) default)]))
   (lambda (key default)
     (case key
       [(configure-runtime)
-       '(#[afl/lang/runtime-config configure #f])]
-      [else default])))
+       (define config-vec '#[afl/lang/runtime-config configure #f])
+       (define other-config (other-get-info key default))
+       (cond [(list? other-config) (cons config-vec other-config)]
+             [else (list config-vec)])]
+      [else (other-get-info key default)])))
+
diff --git a/afl/lang/reader.rkt b/afl/lang/reader.rkt
index dfce6e1..e7d04a7 100644
--- a/afl/lang/reader.rkt
+++ b/afl/lang/reader.rkt
@@ -23,9 +23,10 @@
      (lambda (orig-read-syntax)
        (define read-syntax (wrap-reader orig-read-syntax))
        (lambda args
-         (syntax-property (apply read-syntax args)
-                          'module-language
-                          '#(afl/lang/language-info get-language-info #f))))
+         (define stx (apply read-syntax args))
+         (define old-prop (syntax-property stx 'module-language))
+         (define new-prop `#(afl/lang/language-info get-language-info ,old-prop))
+         (syntax-property stx 'module-language new-prop)))
      (lambda (proc)
        (lambda (key defval)
          (define (fallback) (if proc (proc key defval) defval))
diff --git a/afl/lang/runtime-config.rkt b/afl/lang/runtime-config.rkt
index 5808bbf..b0b41c3 100644
--- a/afl/lang/runtime-config.rkt
+++ b/afl/lang/runtime-config.rkt
@@ -5,8 +5,5 @@
 (require (only-in afl/reader make-afl-readtable))
 
 (define (configure data)
-  (define old-read (current-read-interaction))
-  (define (new-read src in)
-    (parameterize ([current-readtable (make-afl-readtable (current-readtable))])
-      (old-read src in)))
-  (current-read-interaction new-read))
+  (current-readtable (make-afl-readtable)))
+
diff --git a/afl/reader.rkt b/afl/reader.rkt
index cbb3ebd..6f55536 100644
--- a/afl/reader.rkt
+++ b/afl/reader.rkt
@@ -121,9 +121,10 @@
                   [%1 (string->id stx* arg-str "1")]
                   [body stx*])
       (intro
-       #'(lambda args
+       (syntax/loc stx
+         (lambda args
            (define-syntax % (make-rename-transformer #'%1))
-           body)))))
+           body))))))
 
 (module+ test
   ;; These test `parse`. See test.rkt for tests of readtable use per se.