diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss index ce683b5..267d5ef 100644 --- a/collects/mzlib/class.ss +++ b/collects/mzlib/class.ss @@ -1393,7 +1393,7 @@ (define (do-make-object class by-pos-args named-args) (unless (class? class) - (raise-type-error 'make-object "class" class)) + (raise-type-error (quote-syntax make-object) "class" class)) (let ([o ((class-make-object class))]) ;; Initialize it: (let loop ([c class][by-pos-args by-pos-args][named-args named-args]) @@ -1704,6 +1704,7 @@ (string-append (format "~a: " where) (apply format msg)) + where (syntax-source-module (quote-syntax here)) (current-continuation-marks)))) (define (for-class name) diff --git a/collects/mzlib/list.ss b/collects/mzlib/list.ss index 15c67af..8a24e65 100644 --- a/collects/mzlib/list.ss +++ b/collects/mzlib/list.ss @@ -218,6 +218,7 @@ [(not (pair? l)) (raise (make-exn:application:mismatch (format "~a: second argument must be a (proper) list; given ~e" name list) + name (syntax-source-module (quote-syntax here)) (current-continuation-marks) list))] [(f (car l)) (if whole-list? l (car l))] @@ -246,6 +247,7 @@ frest))] [else (raise (make-exn:application:mismatch (format "filter: second argument must be a (proper) list; given ~e" list) + 'filter (syntax-source-module (quote-syntax here)) (current-continuation-marks) list))]))))) diff --git a/collects/mzlib/match.ss b/collects/mzlib/match.ss index d2eb04a..fe9b21b 100644 --- a/collects/mzlib/match.ss +++ b/collects/mzlib/match.ss @@ -117,12 +117,14 @@ (raise (make-exn:misc:match (format "match: no matching clause for ~s" val) + 'match (syntax-source-module (quote-syntax here)) (current-continuation-marks) val))) ((val expr) (raise (make-exn:misc:match (format "match: no matching clause for ~s: ~s" val expr) + 'match (syntax-source-module (quote-syntax here)) (current-continuation-marks) val))))) diff --git a/collects/mzlib/private/sigmatch.ss b/collects/mzlib/private/sigmatch.ss index 058a845..5d6f1fa 100644 --- a/collects/mzlib/private/sigmatch.ss +++ b/collects/mzlib/private/sigmatch.ss @@ -48,6 +48,7 @@ src-context (sig-path-name s path) dest-context) + who #f (current-continuation-marks)))))]) (and v (begin @@ -62,6 +63,7 @@ p dest-context p) + who #f (current-continuation-marks))))) (hash-table-put! table s #f) #t)))] @@ -76,6 +78,7 @@ src-context (sig-path-name (car s) path) dest-context) + who #f (current-continuation-marks)))))]) (and v (begin @@ -90,6 +93,7 @@ p dest-context p) + who #f (current-continuation-marks))))) (hash-table-put! table (car s) #f) (check-sig-match v (cdr s) (cons (car s) path) @@ -111,6 +115,7 @@ (if (symbol? v) 'value 'sub-unit) p dest-context) + who #f (current-continuation-marks))))))) #t))) diff --git a/collects/mzlib/thread.ss b/collects/mzlib/thread.ss index 0621f79..3e68e6a 100644 --- a/collects/mzlib/thread.ss +++ b/collects/mzlib/thread.ss @@ -59,6 +59,7 @@ (make-exn:application:arity (format ": consumer procedure arity is ~e; provided ~s argument~a" (procedure-arity f) num (if (= 1 num) "" "s")) + #f #f (current-continuation-marks) num (procedure-arity f))))) diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 939651a..af5e1e1 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -278,6 +278,7 @@ (raise (make-exn:unit (format "compound-unit: result of expression for tag ~s not a unit: ~e" tag unit) + 'compound-unit (syntax-source-module (quote-syntax here)) (current-continuation-marks)))) (unless (= num-imports (unit-num-imports unit)) (raise @@ -286,6 +287,7 @@ tag (unit-num-imports unit) num-imports) + 'compound-unit (syntax-source-module (quote-syntax here)) (current-continuation-marks)))) (list->vector (map (lambda (ex) @@ -296,6 +298,7 @@ (make-exn:unit (format "compount-unit: unit for tag ~s has no ~s export" tag ex) + 'compound-unit (syntax-source-module (quote-syntax here)) (current-continuation-marks)))] [(eq? (car l) ex) i] @@ -607,12 +610,14 @@ (raise (make-exn:unit (format "invoke-unit: result of unit expression was not a unit: ~e" u) + 'invoke-unit (syntax-source-module (quote-syntax here)) (current-continuation-marks)))) (unless (= (unit-num-imports u) n) (raise (make-exn:unit (format "invoke-unit: expected a unit with ~a imports, given one with ~a imports" n (unit-num-imports u)) + 'invoke-unit (syntax-source-module (quote-syntax here)) (current-continuation-marks))))) (define-syntax invoke-unit diff --git a/collects/mzlib/unitsig.ss b/collects/mzlib/unitsig.ss index a2eee29..07eb1a1 100644 --- a/collects/mzlib/unitsig.ss +++ b/collects/mzlib/unitsig.ss @@ -172,6 +172,7 @@ (format "~s: expression for \"~s\" is not a signed unit: ~e" who tag u)) + who #f (current-continuation-marks))))) units tags) (for-each @@ -194,6 +195,7 @@ (format "~s: ~a unit imports ~a units, but ~a units were provided" who tag n c)) + who #f (current-continuation-marks)))))) units tags isigs) (for-each