From 3d020b33fd6999a22d36e93c6481bc8cab9dafba Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 22 Apr 2008 22:05:33 +0000 Subject: [PATCH] Handle 0 and 1 cases better. Use sync to avoid sleeping. svn: r9407 --- collects/typed-scheme/private/tc-utils.ss | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/collects/typed-scheme/private/tc-utils.ss b/collects/typed-scheme/private/tc-utils.ss index 4ea5aec86b..a2a412f7ed 100644 --- a/collects/typed-scheme/private/tc-utils.ss +++ b/collects/typed-scheme/private/tc-utils.ss @@ -1,6 +1,6 @@ #lang scheme/base (provide (all-defined-out)) -(require "syntax-traversal.ss" (for-syntax scheme/base)) +(require "syntax-traversal.ss" (for-syntax scheme/base) scheme/match) ;; a parameter representing the original location of the syntax being currently checked (define current-orig-stx (make-parameter #'here)) @@ -42,14 +42,18 @@ (define-struct err (msg stx) #:prefab) -(define (report-all-errors) - (define stxs - (for/list ([e (reverse delayed-errors)]) - (thread (lambda () (raise-typecheck-error (err-msg e) (err-stx e)))) - (sleep .01) - (err-stx e))) - (unless (null? stxs) - (raise-typecheck-error "Errors encountered" (apply append stxs)))) +(define (report-all-errors) + (match (reverse delayed-errors) + [(list) (void)] + [(list (struct err (msg stx))) + (raise-typecheck-error msg stx)] + [l + (let ([stxs + (for/list ([e (reverse delayed-errors)]) + (sync (thread (lambda () (raise-typecheck-error (err-msg e) (err-stx e))))) + (err-stx e))]) + (unless (null? stxs) + (raise-typecheck-error "Errors encountered" (apply append stxs))))])) (define (tc-error/delayed msg #:stx [stx (current-orig-stx)] . rest) (set! delayed-errors (cons (make-err (apply format msg rest) (list (locate-stx stx))) delayed-errors)))