Bracket expressions are now correctly read in the DrRacket REPL

This commit is contained in:
Jens Axel Søgaard 2012-06-26 13:55:18 +02:00
parent aa5284534a
commit 4283d69763
3 changed files with 44 additions and 60 deletions

View File

@ -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))

View File

@ -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])))

View File

@ -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))))