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

increment line counter only on real inputs (not evaluator messages)

Browse Source 
svn: r12363
This commit is contained in:
Eli Barzilay 2008-11-09 07:25:36 +00:00
parent 1e3517d904
commit f85ab5567c
1 changed files with 21 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/scheme/sandbox.ss
View File

@ -463,25 +463,27 @@
(and coverage? (lambda (es+get) (set! uncovered es+get)))) (and coverage? (lambda (es+get) (set! uncovered es+get))))
(channel-put result-ch 'ok)) (channel-put result-ch 'ok))
;; finally wait for interaction expressions ;; finally wait for interaction expressions
(let loop ([n 1]) (let ([n 0])
(let ([expr (channel-get input-ch)]) (let loop ()
(when (eof-object? expr) (channel-put result-ch expr) (user-kill)) (let ([expr (channel-get input-ch)])
(with-handlers ([void (lambda (exn) (when (eof-object? expr) (channel-put result-ch expr) (user-kill))
(channel-put result-ch (cons 'exn exn)))]) (with-handlers ([void (lambda (exn)
(let* ([run (if (evaluator-message? expr) (channel-put result-ch (cons 'exn exn)))])
(lambda () (let* ([run (if (evaluator-message? expr)
(apply (evaluator-message-msg expr) (lambda ()
(evaluator-message-args expr))) (apply (evaluator-message-msg expr)
(lambda () (evaluator-message-args expr)))
(eval* (input->code (list expr) 'eval n))))] (lambda ()
[sec (and limits (car limits))] (set! n (add1 n))
[mb (and limits (cadr limits))] (eval* (input->code (list expr) 'eval n))))]
[run (if (or sec mb) [sec (and limits (car limits))]
(lambda () (with-limits sec mb (run))) [mb (and limits (cadr limits))]
run)]) [run (if (or sec mb)
(channel-put result-ch (lambda () (with-limits sec mb (run)))
(cons 'vals (call-with-values run list))))) run)])
(loop (add1 n))))) (channel-put result-ch
(cons 'vals (call-with-values run list)))))
(loop)))))
(define (user-eval expr) (define (user-eval expr)
(let ([r (if user-thread (let ([r (if user-thread
(begin (channel-put input-ch expr) (begin (channel-put input-ch expr)