Adjust how the drracket repl iterates over expressions to make it more
like textual-read-eval-print-loop There is still a difference, however, because drracket's REPL has a notion of multiple expressions that are submitted simultaneously that textual-read-eval-print-loop doesn't. For example, if you type this at the prompt: (car) (+ 1 2) then textual-read-eval-print-loop will print out the error and then 3, but drracket will print only the error (ditto if (car) were replaced by a continuation abort). This difference is, IMO, a good thing, since it lets you use a single interaction to do multiple things, but stops as soon as there is an error. (It is also how drracket has behaved for a long time.) closes PR 12790
This commit is contained in:
Robby Findler
parent
daa048719a
commit
77811e0e95
|
|
@ -1075,49 +1075,63 @@ TODO
|
|||
; breaks as we go in and turn them off as we go out.
|
||||
; (Actually, we adjust breaks however the user wanted it.)
|
||||
|
||||
(call-with-continuation-prompt
|
||||
(λ ()
|
||||
(call-with-break-parameterization
|
||||
user-break-parameterization
|
||||
(λ ()
|
||||
(let loop ()
|
||||
(let ([sexp/syntax/eof (with-stack-checkpoint (get-sexp/syntax/eof))])
|
||||
(unless (eof-object? sexp/syntax/eof)
|
||||
(define results
|
||||
;; we duplicate the 'expand-syntax-to-top-form' dance that eval-syntax
|
||||
;; does here, so that we can put 'with-stack-checkpoint's in to limit
|
||||
;; the amount of DrRacket code we see in stacktraces
|
||||
(let loop ([stx sexp/syntax/eof])
|
||||
(define top-expanded (with-stack-checkpoint (expand-syntax-to-top-form stx)))
|
||||
(syntax-case top-expanded (begin)
|
||||
[(begin a1 . args)
|
||||
(let lloop ([args (syntax->list #'(a1 . args))])
|
||||
(cond
|
||||
[(null? (cdr args))
|
||||
(loop (car args))]
|
||||
[else
|
||||
(loop (car args))
|
||||
(lloop (cdr args))]))]
|
||||
[_
|
||||
(let ([expanded (with-stack-checkpoint (expand-syntax top-expanded))])
|
||||
(call-with-values
|
||||
(λ ()
|
||||
(call-with-continuation-prompt
|
||||
(λ ()
|
||||
(with-stack-checkpoint (eval-syntax expanded)))
|
||||
(default-continuation-prompt-tag)
|
||||
(λ args
|
||||
(apply
|
||||
abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
args))))
|
||||
list))])))
|
||||
(parameterize ([pretty-print-columns pretty-print-width])
|
||||
(for ([x (in-list results)])
|
||||
((current-print) x)))
|
||||
(loop)))))))
|
||||
(default-continuation-prompt-tag)
|
||||
(λ args (void)))
|
||||
|
||||
;; this binding of last-results is to catch the results
|
||||
;; that come from throwing to the prompt instead of
|
||||
;; a normal exit
|
||||
(define last-results
|
||||
(call-with-values
|
||||
(λ ()
|
||||
(call-with-continuation-prompt
|
||||
(λ ()
|
||||
(call-with-break-parameterization
|
||||
user-break-parameterization
|
||||
(λ ()
|
||||
(let loop ()
|
||||
(define sexp/syntax/eof (with-stack-checkpoint (get-sexp/syntax/eof)))
|
||||
(cond
|
||||
[(eof-object? sexp/syntax/eof) (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () (values)))]
|
||||
[else
|
||||
(define results
|
||||
(call-with-values
|
||||
(λ ()
|
||||
;; we duplicate the 'expand-syntax-to-top-form' dance that eval-syntax
|
||||
;; does here, so that we can put 'with-stack-checkpoint's in to limit
|
||||
;; the amount of DrRacket code we see in stacktraces
|
||||
(let loop ([stx sexp/syntax/eof])
|
||||
(define top-expanded (with-stack-checkpoint (expand-syntax-to-top-form stx)))
|
||||
(syntax-case top-expanded (begin)
|
||||
[(begin a1 . args)
|
||||
(let lloop ([args (syntax->list #'(a1 . args))])
|
||||
(cond
|
||||
[(null? (cdr args))
|
||||
(loop (car args))]
|
||||
[else
|
||||
(loop (car args))
|
||||
(lloop (cdr args))]))]
|
||||
[_
|
||||
(let ([expanded (with-stack-checkpoint (expand-syntax top-expanded))])
|
||||
(call-with-continuation-prompt
|
||||
(λ ()
|
||||
(with-stack-checkpoint (eval-syntax expanded)))
|
||||
(default-continuation-prompt-tag)
|
||||
(λ args
|
||||
(apply
|
||||
abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
args))))])))
|
||||
list))
|
||||
(parameterize ([pretty-print-columns pretty-print-width])
|
||||
(for ([x (in-list results)])
|
||||
((current-print) x)))
|
||||
(loop)])))))))
|
||||
list))
|
||||
|
||||
(parameterize ([pretty-print-columns pretty-print-width])
|
||||
(for ([x (in-list last-results)])
|
||||
((current-print) x)))
|
||||
|
||||
(when complete-program?
|
||||
(call-with-continuation-prompt
|
||||
|
|
|
|||
|
|
@ -385,4 +385,39 @@
|
|||
#f
|
||||
#rx"main\ntest")
|
||||
|
||||
|
||||
(test @t{#lang racket}
|
||||
(format "~s" '(+ 1 (+ 1 (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda ()
|
||||
(abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () 0)))))))
|
||||
"0")
|
||||
|
||||
(test @t{#lang racket}
|
||||
(format "~s ~s ~s"
|
||||
'1
|
||||
'(+ 1 (+ 1 (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda ()
|
||||
(abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () 0))))))
|
||||
'2)
|
||||
"1\n0")
|
||||
|
||||
(test @t{#lang racket}
|
||||
(format "~s"
|
||||
'(begin
|
||||
1
|
||||
(+ 1 (+ 1 (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda ()
|
||||
(abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () 0))))))
|
||||
2))
|
||||
"0")
|
||||
|
||||
(fire-up-drracket-and-run-tests run-test)
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ This produces an ACK message
|
|||
answer ;; : answer
|
||||
;; the answers for the various modes of the test, specifically:
|
||||
;; with debugging enabled: execute, load with different filename, load with same filename
|
||||
;; as in ordinary mzscheme: execute, load with different filename, load with same filename
|
||||
;; as in ordinary racket: execute, load with different filename, load with same filename
|
||||
|
||||
source-location ;; (or/c 'interactions 'definitions (cons number number))
|
||||
|
||||
|
|
@ -81,7 +81,6 @@ This produces an ACK message
|
|||
|
||||
(define test-data
|
||||
(list
|
||||
|
||||
;; basic tests
|
||||
(mktest "1"
|
||||
("1"
|
||||
|
|
@ -108,7 +107,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "1 2"
|
||||
|
||||
("1\n2"
|
||||
"2"
|
||||
"2"
|
||||
|
|
@ -121,7 +119,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "\"a\" \"b\""
|
||||
|
||||
("\"a\"\n\"b\""
|
||||
"\"b\""
|
||||
"\"b\""
|
||||
|
|
@ -146,7 +143,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "."
|
||||
|
||||
("{stop-22x22.png} read: illegal use of \".\""
|
||||
"{stop-multi.png} {stop-22x22.png} read: illegal use of \".\""
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: read: illegal use of \".\""
|
||||
|
|
@ -206,8 +202,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "(raise #f)"
|
||||
|
||||
("uncaught exception: #f"
|
||||
"uncaught exception: #f"
|
||||
"uncaught exception: #f"
|
||||
|
|
@ -220,7 +216,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "(values 1 2)"
|
||||
|
||||
("1\n2"
|
||||
"1\n2"
|
||||
"1\n2"
|
||||
|
|
@ -231,8 +226,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "(list 1 2)"
|
||||
|
||||
("(1 2)"
|
||||
"(1 2)"
|
||||
"(1 2)"
|
||||
|
|
@ -282,7 +277,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "(begin (values) 1)"
|
||||
|
||||
("1"
|
||||
"1"
|
||||
"1"
|
||||
|
|
@ -295,7 +289,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "(begin xx (printf \"hi\\n\"))"
|
||||
|
||||
(#rx"{stop-multi.png} {stop-22x22.png} reference to undefined identifier.*: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} reference to undefined identifier.*: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:7: reference to undefined identifier.*: xx"
|
||||
|
|
@ -327,7 +320,6 @@ This produces an ACK message
|
|||
|
||||
;; leading comment test
|
||||
(mktest "#!/bin/sh\n1"
|
||||
|
||||
("1"
|
||||
"1"
|
||||
"1"
|
||||
|
|
@ -354,7 +346,6 @@ This produces an ACK message
|
|||
;; eval tests
|
||||
|
||||
(mktest " (eval '(values 1 2))"
|
||||
|
||||
("1\n2"
|
||||
"1\n2"
|
||||
"1\n2"
|
||||
|
|
@ -367,7 +358,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest " (eval '(list 1 2))"
|
||||
|
||||
("(1 2)"
|
||||
"(1 2)"
|
||||
"(1 2)"
|
||||
|
|
@ -392,7 +382,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest " (read (open-input-string \".\"))"
|
||||
|
||||
("{stop-multi.png} read: illegal use of \".\""
|
||||
"{stop-multi.png} read: illegal use of \".\""
|
||||
"{stop-multi.png} read: illegal use of \".\""
|
||||
|
|
@ -417,7 +406,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "(eval (box 1))"
|
||||
|
||||
("#&1"
|
||||
"#&1"
|
||||
"#&1"
|
||||
|
|
@ -430,7 +418,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "(eval '(box 1))"
|
||||
|
||||
("#&1"
|
||||
"#&1"
|
||||
"#&1"
|
||||
|
|
@ -457,7 +444,6 @@ This produces an ACK message
|
|||
|
||||
;; error in the middle
|
||||
(mktest "1 2 ( 3 4"
|
||||
|
||||
("1\n2\n{stop-22x22.png} read: expected a `)' to close `('"
|
||||
"{stop-multi.png} {stop-22x22.png} read: expected a `)' to close `('"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:4: read: expected a `)' to close `('"
|
||||
|
|
@ -468,8 +454,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "1 2 . 3 4"
|
||||
|
||||
("1\n2\n{stop-22x22.png} read: illegal use of \".\""
|
||||
"{stop-multi.png} {stop-22x22.png} read: illegal use of \".\""
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:4: read: illegal use of \".\""
|
||||
|
|
@ -480,8 +466,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "1 2 (lambda ()) 3 4"
|
||||
|
||||
("1\n2\n{stop-22x22.png} lambda: bad syntax in: (lambda ())"
|
||||
"{stop-22x22.png} lambda: bad syntax in: (lambda ())"
|
||||
"{stop-22x22.png} repl-test-tmp3.rkt:1:4: lambda: bad syntax in: (lambda ())"
|
||||
|
|
@ -492,8 +478,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "1 2 x 3 4"
|
||||
|
||||
(#rx"1\n2\n{stop-multi.png} {stop-22x22.png} reference to undefined identifier.*: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} reference to undefined identifier.*: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:4: reference to undefined identifier.*: x"
|
||||
|
|
@ -504,8 +490,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "1 2 (raise 1) 3 4"
|
||||
|
||||
("1\n2\nuncaught exception: 1"
|
||||
"uncaught exception: 1"
|
||||
"uncaught exception: 1"
|
||||
|
|
@ -516,8 +502,8 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest "1 2 (raise #f) 3 4"
|
||||
|
||||
("1\n2\nuncaught exception: #f"
|
||||
"uncaught exception: #f"
|
||||
"uncaught exception: #f"
|
||||
|
|
@ -530,7 +516,6 @@ This produces an ACK message
|
|||
void)
|
||||
|
||||
(mktest "(require lang/htdp-beginner)\n(cond [1 2 3 4])"
|
||||
|
||||
("{stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
|
||||
"{stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
|
||||
"{stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
|
||||
|
|
@ -545,7 +530,6 @@ This produces an ACK message
|
|||
;; error across separate files
|
||||
(mktest
|
||||
"(load \"repl-test-tmp2.rkt\") (define (g) (+ 1 (expt 3 #f))) (f g)"
|
||||
|
||||
(#rx"{stop-multi.png} {stop-22x22.png} expt: contract violation.*given: #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} expt: contract violation.*given: #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:45: expt: contract violation.*given: #f"
|
||||
|
|
@ -591,7 +575,6 @@ This produces an ACK message
|
|||
|
||||
;; macro tests
|
||||
(mktest "(define-syntax (c stx) (syntax-case stx () [(_ p q r) (syntax (+ p q r))]))"
|
||||
|
||||
(""
|
||||
""
|
||||
""
|
||||
|
|
@ -886,7 +869,6 @@ This produces an ACK message
|
|||
;; setup of the namespaces for pict printing (from slideshow)
|
||||
|
||||
(mktest "(require texpict/utils)(disk 3)"
|
||||
|
||||
("{pict-snip}"
|
||||
"{pict-snip}"
|
||||
"{pict-snip}"
|
||||
|
|
@ -908,7 +890,6 @@ This produces an ACK message
|
|||
(current-namespace (make-namespace))
|
||||
(namespace-set-variable-value! 'd (disk 3)))
|
||||
'd)
|
||||
|
||||
("{image}"
|
||||
"{image}"
|
||||
"{image}"
|
||||
|
|
@ -919,6 +900,7 @@ This produces an ACK message
|
|||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest (to-strings
|
||||
'(let ([on (current-namespace)]
|
||||
[n ((current-module-name-resolver) 'mred #f #f)])
|
||||
|
|
@ -926,7 +908,6 @@ This produces an ACK message
|
|||
(namespace-attach-module on n))
|
||||
'(require texpict/utils)
|
||||
'(disk 3))
|
||||
|
||||
("{pict-snip}"
|
||||
"{pict-snip}"
|
||||
"{pict-snip}"
|
||||
|
|
@ -942,7 +923,6 @@ This produces an ACK message
|
|||
"(require mzlib/pretty)"
|
||||
"(pretty-print-print-hook (lambda x (expt 3 #f)))"
|
||||
"(list 1 2 3)")
|
||||
|
||||
("(1 2 3)"
|
||||
"(1 2 3)"
|
||||
"(1 2 3)"
|
||||
|
|
@ -957,7 +937,6 @@ This produces an ACK message
|
|||
(mktest (format "~s\n~s"
|
||||
`(require scheme/pretty)
|
||||
`(parameterize ((pretty-print-exact-as-decimal #t)) (display 1/4)))
|
||||
|
||||
("1/4"
|
||||
"1/4"
|
||||
"1/4"
|
||||
|
|
@ -990,7 +969,55 @@ This produces an ACK message
|
|||
'interactions
|
||||
#f
|
||||
void
|
||||
void)))
|
||||
void)
|
||||
|
||||
(mktest
|
||||
(format "~s" '(+ 1 (+ 1 (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda ()
|
||||
(abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () 0)))))))
|
||||
("0" "0" "0" "0" "0" "0")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest
|
||||
(format "~s ~s ~s"
|
||||
'1
|
||||
'(+ 1 (+ 1 (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda ()
|
||||
(abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () 0))))))
|
||||
'2)
|
||||
("1\n0" "0" "0" "1\n0" "0" "0")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
(mktest
|
||||
(format "~s"
|
||||
'(begin
|
||||
1
|
||||
(+ 1 (+ 1 (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda ()
|
||||
(abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
(λ () 0))))))
|
||||
2))
|
||||
("0" "0" "0" "0" "0" "0")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
void)
|
||||
|
||||
))
|
||||
|
||||
;; these tests aren't used at the moment.
|
||||
#;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user