fix non-tail loop in parallel `raco setup'

Deep recursion with too-few recognizable JIT frames caused
trouble with `current-continuation-marks'.
This commit is contained in:
Matthew Flatt 2012-02-27 14:12:41 -07:00
parent 172c6379d1
commit 012ef60cd5

View File

@ -425,16 +425,16 @@
(send/resp (list 'ERROR message))) (send/resp (list 'ERROR message)))
(define (send/reportp message) (define (send/reportp message)
(send/resp (list 'REPORT message))) (send/resp (list 'REPORT message)))
(with-handlers* ([exn:fail? (lambda (x) ((with-handlers* ([exn:fail? (lambda (x)
(send/errorp (exn-message x)) (send/errorp (exn-message x))
(loop (add1 i)))]) (lambda () (loop (add1 i))))])
(parameterize ([current-output-port out-str-port] (parameterize ([current-output-port out-str-port]
[current-error-port err-str-port]) [current-error-port err-str-port])
(let ([msg (pdo-recv)]) (let ([msg (pdo-recv)])
(match msg (match msg
[(list 'DIE) (void)] [(list 'DIE) void]
[_ (msg-proc msg send/successp send/errorp send/reportp) [_ (msg-proc msg send/successp send/errorp send/reportp)
(loop (add1 i))]))))))))))) (lambda () (loop (add1 i)))]))))))))))))
(define-syntax (lambda-worker stx) (define-syntax (lambda-worker stx)
(syntax-parse stx #:literals (match-message-loop) (syntax-parse stx #:literals (match-message-loop)