From 4283d69763d7864e2c0bfc0e8d297737d1f978b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jens=20Axel=20S=C3=B8gaard?= <jensaxel@soegaard.net>
Date: Tue, 26 Jun 2012 13:55:18 +0200
Subject: [PATCH] Bracket expressions are now correctly read in the DrRacket
 REPL

---
 bracket/lang/parser.rkt    | 11 ++++---
 bracket/lang/reader.rkt    | 27 ++++++++++------
 bracket/runtime-config.rkt | 66 +++++++++++---------------------------
 3 files changed, 44 insertions(+), 60 deletions(-)

diff --git a/bracket/lang/parser.rkt b/bracket/lang/parser.rkt
index 47e973975..d062c692a 100644
--- a/bracket/lang/parser.rkt
+++ b/bracket/lang/parser.rkt
@@ -79,7 +79,7 @@
 
 (define expression-lexer
   (lexer-src-pos
-   [(eof) 'EOF]
+   [(eof) (token-EOF)]
    [(:or #\tab #\space #\newline)    ; this skips whitespace
     (return-without-pos (expression-lexer input-port))] 
    [#\newline (token-newline)]  ; (token-newline) returns 'newline
@@ -392,7 +392,8 @@
    ; The following Tom Foolery is to needed to turn
    ;   SEMI EOF into EOF
    ; This allows one to have an optional semi colon in the end of the file.   
-   (let ([peek  (expression-lexer ip)]
+   (λ () (expression-lexer ip))
+   #;(let ([peek  (expression-lexer ip)]
          [peek1 (expression-lexer ip)])
      (define (next)
        (cond
@@ -404,5 +405,7 @@
                 (eq? (position-token-token peek1) 'EOF))
            (begin0 peek1 (next))
            (begin0 peek  (next)))))))
-  (displayln out)
-  out)
+  ;(displayln out)
+  (if (eq? out #f)
+      eof
+      out))
diff --git a/bracket/lang/reader.rkt b/bracket/lang/reader.rkt
index f0c7b8cb8..dc888d62b 100644
--- a/bracket/lang/reader.rkt
+++ b/bracket/lang/reader.rkt
@@ -1,16 +1,26 @@
 #lang racket
 (provide (rename-out 
           [bracket-read read]
-          [bracket-read-syntax read-syntax])
+          [bracket-read-syntax read-syntax]
+          [bracket-read-expression-syntax read-expression-syntax])
          get-info)
 
 (require "parser.rkt")
-(require syntax/strip-context)
+(require syntax/strip-context
+         racket/syntax)
 
 (define (bracket-read in)
   (syntax->datum
    (bracket-read-syntax #'from-my-read in)))
 
+(define (bracket-read-expression-syntax src in)
+  (if (eof-object? (peek-byte in))
+      eof
+      (with-syntax ([body (parse-expression 
+                           src
+                           #'from-my-read-syntax in)])
+        (strip-context #'body))))
+
 (define (bracket-read-syntax src in)
   (define out
   (if (eof-object? (peek-byte in))
@@ -37,10 +47,11 @@
                             (syntax-source-module #'here)))))
                        (path->string 
                         (simplify-path
-                         (build-path base "../bracket.rkt"))))])
+                         (build-path base "../bracket.rkt"))))]
+                    [module-name (generate-temporary "main")])
         (syntax-property 
          (strip-context   
-          #'(module main bracket/bracket-lang
+          #'(module module-name bracket/bracket-lang
               (require (submod (file bracket.rkt) bracket)
                        (submod (file bracket.rkt) symbolic-application))
               (define-syntax (#%infix stx)
@@ -58,9 +69,9 @@
               (define-syntax (define stx)
                 (syntax-case stx () [(_ . more) #'(Define . more)]))
               (require bracket/lang/parser)
-              (current-read-interaction
-               (λ (_ in)
-                 (parse-expression 'repl #'repl (open-input-string "1+2"))))
+              #;(current-read-interaction
+                 (λ (_ in)
+                   (parse-expression 'repl #'repl in)))
               body))
          'module-language
          '#(bracket/bracket-info get-language-info #f)))))
@@ -74,5 +85,3 @@
       [(color-lexer)
        (dynamic-require 'bracket/lang/parser 'color-lexer)]
       [else default])))
-
-
diff --git a/bracket/runtime-config.rkt b/bracket/runtime-config.rkt
index 7a6234fb0..caea0f849 100644
--- a/bracket/runtime-config.rkt
+++ b/bracket/runtime-config.rkt
@@ -1,56 +1,28 @@
 #lang racket
-(provide show show-enabled configure)
- 
-(define show-enabled (make-parameter #f))
- 
-(define (show v)
-  (when (show-enabled)
-    (display v)))
- 
-(define (configure data)
-  (show-enabled #t)
-  (current-read-interaction read0))
+(provide configure)
 
 (require bracket/lang/reader)
+ 
+(define (configure data)
+  (current-read-interaction read0)
+  #;(define old-eval (current-eval))  
+  #;(current-eval (λ (form) (displayln (list 'eval: form)) 
+                    (define val (old-eval form))
+                    (displayln (list 'eval-result: val))
+                    val))
+  #;(define old-print (current-print))
+  #;(current-print (λ (val) (displayln (list 'print: val)) (old-print val)))
+  )
 
-(define (without-lang-read src in)
-  (parameterize ([read-accept-reader #f]
-                 [read-accept-lang #f])
-    (read-one-line src in)))
 
-; XXX This is almost certainly wrong.
 (define (read0 src ip)
-  (displayln (list 'read0 src ip))
-  (begin0
-    (without-lang-read src ip)
-    (current-read-interaction read1)))
-
+  ;(displayln (list 'read0 src ip))
+  (define expr (read-expression-syntax src ip))
+  (current-read-interaction read1)
+  ;(displayln (list 'read0 expr))
+  expr)
+    
 (define (read1 src ip)
-  (displayln (list 'read1 src ip))
+  ;(displayln (list 'read1 src ip))
   (current-read-interaction read0)
   eof)
-
-(define (read2 src ip)
-  (displayln (list 'read2 src ip))
-  (current-read-interaction read0)
-  eof)
-
-;; at the repl, honu will only read a single line at a time regardless
-;; of how many expressions it contains
-(define (read-one-line name input)
-  (define quit? #f)
-  (define one-line
-    (with-output-to-string
-     (lambda ()
-        (let loop ()
-          (define next (read-char input))
-          (when (eof-object? next)
-            (set! quit? #t))
-          (when (not (or (eof-object? next)
-                         (char=? next #\newline)))
-            (display next)
-            (loop))))))
-  (if quit?
-    eof
-    (read-syntax name (open-input-string one-line))))
-