Bracket expressions are now correctly read in the DrRacket REPL
This commit is contained in:
parent
aa5284534a
commit
4283d69763
|
@ -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))
|
||||
|
|
|
@ -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])))
|
||||
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user