.

original commit: d16f71928826ba081f2239bc24a758da8acf3f97

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)

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))])))))
   

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)))))
 

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)))
 

collects/mzlib/thread.ss

@@ -59,6 +59,7 @@
 		      (make-exn:application:arity
 		       (format "<procedure-from-consumer-thread>: 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)))))

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

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