From 8df7a464931969dd782f3efe6db7e322643be2f4 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 8 Sep 2008 13:27:38 -0400 Subject: [PATCH] Improve errors. --- collects/typed-scheme/private/free-variance.ss | 4 ++-- collects/typed-scheme/private/infer-dummy.ss | 4 ++-- collects/typed-scheme/private/parse-type.ss | 2 +- collects/typed-scheme/private/tc-utils.ss | 2 +- collects/typed-scheme/private/type-effect-convenience.ss | 2 +- collects/typed-scheme/private/type-rep.ss | 4 ++-- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/collects/typed-scheme/private/free-variance.ss b/collects/typed-scheme/private/free-variance.ss index db9cb4f87e..8d47655867 100644 --- a/collects/typed-scheme/private/free-variance.ss +++ b/collects/typed-scheme/private/free-variance.ss @@ -27,8 +27,8 @@ (define var-table (make-weak-hasheq)) ;; maps Type to List[Cons[Symbol,Variance]] -(define (free-idxs* t) (hash-ref index-table t (lambda _ (error "type not in index-table" (syntax-e t))))) -(define (free-vars* t) (hash-ref var-table t (lambda _ (error "type not in var-table" (syntax-e t))))) +(define (free-idxs* t) (hash-ref index-table t (lambda _ (int-err "type ~a not in index-table" (syntax-e t))))) +(define (free-vars* t) (hash-ref var-table t (lambda _ (int-err "type ~a not in var-table" (syntax-e t))))) (define empty-hash-table (make-immutable-hasheq null)) diff --git a/collects/typed-scheme/private/infer-dummy.ss b/collects/typed-scheme/private/infer-dummy.ss index 8645a31435..57debe1454 100644 --- a/collects/typed-scheme/private/infer-dummy.ss +++ b/collects/typed-scheme/private/infer-dummy.ss @@ -1,7 +1,7 @@ #lang scheme/base -(require "type-rep.ss") +(require "type-rep.ss" "tc-utils.ss") -(define infer-param (make-parameter (lambda e (error 'infer "not initialized")))) +(define infer-param (make-parameter (lambda e (int-err "infer not initialized")))) (define (unify X S T) ((infer-param) X S T (make-Univ) null)) (provide unify infer-param) \ No newline at end of file diff --git a/collects/typed-scheme/private/parse-type.ss b/collects/typed-scheme/private/parse-type.ss index 2b92c493d6..0885e9c809 100644 --- a/collects/typed-scheme/private/parse-type.ss +++ b/collects/typed-scheme/private/parse-type.ss @@ -213,7 +213,7 @@ ;(printf "found a type name ~a~n" #'id) (make-Name #'id)] [else - (tc-error/delayed "unbound type ~a" (syntax-e #'id)) + (tc-error/delayed "unbound type name ~a" (syntax-e #'id)) Univ])] [(All . rest) (eq? (syntax-e #'All) 'All) (tc-error "All: bad syntax")] diff --git a/collects/typed-scheme/private/tc-utils.ss b/collects/typed-scheme/private/tc-utils.ss index 45d1d8e349..132b220612 100644 --- a/collects/typed-scheme/private/tc-utils.ss +++ b/collects/typed-scheme/private/tc-utils.ss @@ -75,7 +75,7 @@ (define (tc-error/delayed msg #:stx [stx* (current-orig-stx)] . rest) (let ([stx (locate-stx stx*)]) (unless (syntax? stx) - (int-err "erroneous syntax was not a syntax object" stx (syntax->datum stx*))) + (int-err "erroneous syntax was not a syntax object: ~a ~a" stx (syntax->datum stx*))) (if (delay-errors?) (set! delayed-errors (cons (make-err (apply format msg rest) (list stx)) delayed-errors)) (raise-typecheck-error (apply format msg rest) (list stx))))) diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss index 06ed3c4b4e..0eb73bcd6d 100644 --- a/collects/typed-scheme/private/type-effect-convenience.ss +++ b/collects/typed-scheme/private/type-effect-convenience.ss @@ -34,7 +34,7 @@ [(Latent-Remove-Effect: t) (make-Remove-Effect t v)] [(True-Effect:) eff] [(False-Effect:) eff] - [_ (error 'internal-tc-error "can't add var to effect ~a" eff)])) + [_ (int-err "can't add var ~a to effect ~a" v eff)])) (define-syntax (-> stx) (syntax-case* stx (:) (lambda (a b) (eq? (syntax-e a) (syntax-e b))) diff --git a/collects/typed-scheme/private/type-rep.ss b/collects/typed-scheme/private/type-rep.ss index c63a2a8f76..889d0dd5fd 100644 --- a/collects/typed-scheme/private/type-rep.ss +++ b/collects/typed-scheme/private/type-rep.ss @@ -422,7 +422,7 @@ (match t [(Poly: n scope) (unless (= (length names) n) - (error "Wrong number of names")) + (int-err "Wrong number of names: expected ~a got ~a" n (length names))) (instantiate-many (map *F names) scope)])) ;; the 'smart' constructor @@ -437,7 +437,7 @@ (match t [(PolyDots: n scope) (unless (= (length names) n) - (error "Wrong number of names")) + (int-err "Wrong number of names: expected ~a got ~a" n (length names))) (instantiate-many (map *F names) scope)])) (print-struct #t)