suzanne.soy/repltest
1
0
Fork 0
Code Issues 11 Pull Requests Actions Packages Projects Releases Wiki Activity

First working version, when run interactively (press F5 in drracket).

Browse Source
This commit is contained in:
Georges Dupéron 2016-03-30 17:47:21 +02:00
parent a9d3bf1be9
commit 92adcde5d4
2 changed files with 83 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

203
lang/reader.rkt
View File

@ -4,132 +4,73 @@
[repltest-read-syntax read-syntax] [repltest-read-syntax read-syntax]
[repltest-get-info get-info])) [repltest-get-info get-info]))
(require syntax/module-reader) (require syntax/module-reader
racket/syntax
rackunit)
#;(define (repltest-read in) (define (read-pre-prompt in)
(syntax->datum (regexp-try-match #px"^\\s*" in))
(repltest-read-syntax #f in)))
(define (read-prompt in) (define (read-actual-prompt in)
(regexp-try-match #px"^\\s*[0-9]> " in)) (regexp-try-match #px"^> " in))
(define (read-user-input reader args) (define (peak-prompt in)
(apply reader args)) (regexp-try-match #px"^\\s*> " (peeking-input-port in)))
(define (read-output-values reader args in) (define (skip-newline in)
(if (read-prompt in) (regexp-try-match #px"^\n" in))
'()
(let ([rs (apply reader args)])
(if (eof-object? rs)
'()
(read-output-values reader args in)))))
#;(let ([is (open-input-string "(+ 1 1) 'aaa")] (define (peek-read-length in)
[os (open-output-string)]) (let* ([pk (peeking-input-port in)]
(parameterize ([current-get-interaction-input-port [start (file-position pk)]
(λ () is)] [r (read pk)]
[current-namespace (make-base-namespace)] [end (file-position pk)])
[current-output-port os] (- end start)))
[current-error-port os]
[current-print (λ (v)
(unless (void? v)
(print v)
(newline)))])
(read-eval-print-loop))
(display (get-output-string os))) (define (narrow-next-read in)
(make-limited-input-port in (peek-read-length in)))
(define (peak-until-prompt-length in)
#;(define-values (wrap-read wrap-read-syntax)
(let ()
(define (wrap default-reader reader src in . args)
;(displayln (apply default-reader args))
;((λ (x) (displayln x) x) (apply reader args))
(displayln args)
((λ (x) (displayln x) x)
(apply reader src in (cddr args)));;TODO: not cddr for read
#;#`(module m typed/racket
'#,(default-reader src in))
#;(let* ([in (if (null? (cdr args)) (car args) (cadr args))]
[maybe-prompt (read-prompt in)])
(if maybe-prompt
((λ (x) (displayln x) x) (apply reader args))
((λ (x) (displayln x) x) (apply reader args))))
#;(let* ([in (if (null? (cdr args)) (car args) (cadr args))]
[first-prompt (read-prompt in)]
[user-input (read-user-input reader args)]
[output-values (read-output-values reader args in)])
(if first-prompt
#`(module anything racket
'(check-equal? #,user-input
(values . #,output-values))
(let ([os (open-output-string)])
(parameterize ([current-input-port (open-input-string "")]
[current-output-port os])
'todo
(get-output-string os))))
#'(module anything racket #f))))
(values (λ (reader)
(λ args
(apply wrap read reader #f (car args) args)))
(λ (reader)
(λ args
(apply wrap
read-syntax
reader
(car args)
(cadr args)
args))))))
(define (read-one-interaction src in)
(let ([prompt (read-prompt in)])
(if (not prompt)
(values eof #f '())
(let ([user-input (read-syntax src in)]
[output-values (let loop ()
(if (read-prompt (peeking-input-port in))
'()
(let ([val (read-syntax src in)])
(if (eof-object? val)
'()
(cons val (loop))))))])
(if (eof-object? user-input)
(values (car prompt) #f '())
(values (car prompt) user-input output-values))))))
(define ((wrap-reader reader) chr in src line col pos)
(let* ([pk (peeking-input-port in)] (let* ([pk (peeking-input-port in)]
[start (file-position pk)] [start (file-position pk)]
[end (let loop () [end (let loop ()
(let* ([pos (file-position pk)] (let* ([pre (read-pre-prompt pk)]
[pr (read-prompt pk)]) [pos (file-position pk)]
[pr (read-actual-prompt pk)])
(if (or pr (eof-object? (read pk))) (if (or pr (eof-object? (read pk)))
pos pos
(loop))))]) (loop))))])
(with-syntax ([(mod nm . body) (- end start)))
(reader chr
(make-limited-input-port in (- end start)) (define (narrow-until-prompt in)
src line col pos)]) (make-limited-input-port in (peak-until-prompt-length in)))
(let loop ()
(let-values ([(p u o) (read-one-interaction src in)]) (define silent-prompt-read
(when u (λ ()
;(display p) ;; Default current-prompt-read, without showing
;(displayln (syntax->datum u)) ;; the prompt
;(map displayln (map syntax->datum o)) (let ([in ((current-get-interaction-input-port))])
(loop)))) ((current-read-interaction) (object-name in) in))))
;; Run interactions:
(let ([is (open-input-string "x y (number->string (+ 1 1))")] (define (run-interactions mod-stx in-rest)
[os (open-output-string)] (define/with-syntax (mod nm . body) mod-stx)
[ns (make-base-namespace)]) (let ([ns (make-base-namespace)])
(eval #'(mod nm . body) ns) (eval mod-stx ns)
;; This is a hack because I can't get (module->namespace ''m) to work: ;; This is a hack because I can't get (module->namespace ''m) to work:
(define mod-ns (eval #'(begin (require racket/enter) (define mod-ns (eval #'(begin (require racket/enter)
(enter! 'nm #:dont-re-require-enter) (enter! 'nm #:dont-re-require-enter)
(current-namespace)) (current-namespace))
ns)) ns))
(parameterize ([current-get-interaction-input-port (let loop ()
(λ () is)] (let* ([pr (read-actual-prompt in-rest)])
(when pr
(let* ([narrowed (narrow-next-read in-rest)]
[os (open-output-string)]
[actual (parameterize
([current-prompt-read
silent-prompt-read]
[current-get-interaction-input-port
(λ () narrowed)]
[current-namespace mod-ns] [current-namespace mod-ns]
[current-output-port os] [current-output-port os]
[current-error-port os] [current-error-port os]
@ -137,10 +78,20 @@
(unless (void? v) (unless (void? v)
(print v) (print v)
(newline)))]) (newline)))])
(read-eval-print-loop)) (read-eval-print-loop)
(get-output-string os))]
[skip (skip-newline in-rest)]
[expected (port->string (narrow-until-prompt in-rest))])
(check-equal? actual
expected))
(loop))))))
(display (get-output-string os))) (define ((wrap-reader reader) chr in src line col pos)
#'(mod nm racket) #;#'(mod nm . body)))) (define/with-syntax (mod nm . body)
(reader chr (narrow-until-prompt in) src line col pos))
;; Run interactions:
(run-interactions #'(mod nm . body) in)
#'(mod nm . body))
(define-values (repltest-read repltest-read-syntax repltest-get-info) (define-values (repltest-read repltest-read-syntax repltest-get-info)
(make-meta-reader (make-meta-reader
@ -162,33 +113,3 @@
(define (fallback) (if proc (proc key defval) defval)) (define (fallback) (if proc (proc key defval) defval))
(case key (case key
[else (fallback)]))))) [else (fallback)])))))
#|
#lang racket
(let ([is (open-input-string "x y (number->string (+ 1 1))")]
[os (open-output-string)]
[ns (make-base-namespace)])
(eval #'(module m typed/racket
(define x 0)
(define y 1)
'displayed
(displayln "aaaa"))
ns)
(define mod-ns (eval #'(begin (require racket/enter)
(enter! 'm #:dont-re-require-enter)
(current-namespace))
ns))
(parameterize ([current-get-interaction-input-port
(λ () is)]
[current-namespace mod-ns]
[current-output-port os]
[current-error-port os]
[current-print (λ (v)
(unless (void? v)
(print v)
(newline)))])
(read-eval-print-loop))
(display (get-output-string os)))
|#

19
test/test.rkt
View File

@ -6,20 +6,17 @@
'displayed 'displayed
(displayln "displayed too") (displayln "displayed too")
1> (+ 1 1) > (+ 1 1)
- : Integer [more precisely: Positive-Index]
2 2
2> x > x
- : Integer [more precisely: Zero]
0 0
> (values x y)
3> (values x y) - : (values Integer Integer) [more precisely: (Values Zero One)]
0 0
1 1
4> #R(+ 2 0) > #R(+ 2 0)
(+ 2 0) = 2 (+ 2 0) = 2
- : Integer [more precisely: Positive-Byte]
2 2
#|
(values (+ 1 1) 4)
#R(+ 2 0)
4
|#