diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss index 78fd7e2..bc56135 100644 --- a/collects/mzlib/class.ss +++ b/collects/mzlib/class.ss @@ -20,5 +20,5 @@ is-a? subclass? implementation? interface-extension? object-interface object-info object->vector method-in-interface? interface->method-names class->interface class-info - exn:object? struct:exn:object make-exn:object + (struct exn:fail:object ()) make-primitive-class)) \ No newline at end of file diff --git a/collects/mzlib/cm.ss b/collects/mzlib/cm.ss index 863bf95..dd65523 100644 --- a/collects/mzlib/cm.ss +++ b/collects/mzlib/cm.ss @@ -237,7 +237,9 @@ [default-handler (current-load/use-compiled)] [modes (use-compiled-file-paths)]) (when (null? modes) - (error 'make-compilation-manager-... "empty use-compiled-file-paths list")) + (raise-mismatch-error 'make-compilation-manager-... + "empty use-compiled-file-paths list: " + modes)) (letrec ([compilation-manager-load-handler (lambda (path mod-name) (cond diff --git a/collects/mzlib/cml.ss b/collects/mzlib/cml.ss index ae92971..eb7288a 100644 --- a/collects/mzlib/cml.ss +++ b/collects/mzlib/cml.ss @@ -39,9 +39,9 @@ (thread-dead-waitable th)) (define (current-time) - (current-seconds)) + (current-inexact-milliseconds)) (define (time-evt t) - (make-alarm t)) + (make-alarm-waitable t)) (provide/contract (spawn ((-> any) . -> . thread?)) diff --git a/collects/mzlib/private/sigmatch.ss b/collects/mzlib/private/sigmatch.ss index dde38e3..ff779af 100644 --- a/collects/mzlib/private/sigmatch.ss +++ b/collects/mzlib/private/sigmatch.ss @@ -42,7 +42,7 @@ (let ([v (hash-table-get table s (lambda () (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "~a: ~a is missing a value name `~a', required by ~a" @@ -56,7 +56,7 @@ (unless (symbol? v) (let ([p (sig-path-name s path)]) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "~a: ~a contains `~a' as a sub-unit name, but ~a contains `~a' as a value name" @@ -72,7 +72,7 @@ (let ([v (hash-table-get table (car s) (lambda () (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "~a: ~a is missing a sub-unit name `~a', required by ~a" @@ -86,7 +86,7 @@ (unless (hash-table? v) (let ([p (sig-path-name (car s) path)]) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "~a: ~a contains `~a' as a value name, but ~a contains `~a' as a sub-unit name" @@ -108,7 +108,7 @@ (when v (let ([p (sig-path-name k path)]) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "~a: ~a contains an extra ~a name `~a' that is not required by ~a" diff --git a/collects/mzlib/private/sigutil.ss b/collects/mzlib/private/sigutil.ss index 0d908ac..637dbb9 100644 --- a/collects/mzlib/private/sigutil.ss +++ b/collects/mzlib/private/sigutil.ss @@ -792,7 +792,7 @@ (letrec ([check-sig (lambda (sig use-sig) (when use-sig - (with-handlers ([exn:unit? + (with-handlers ([exn:fail:unit? (lambda (exn) (syntax-error #f expr diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 8ca36c8..dc51bba 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -17,7 +17,7 @@ (define insp (current-inspector)) ; for named structures (define-struct unit (num-imports exports go)) ; unit value - (define-struct (exn:unit exn) ()) ; run-time exception + (define-struct (exn:fail:unit exn:fail) ()) ; run-time exception ;; For units with inferred names, generate a struct that prints using the name: (define (make-naming-constructor type name) @@ -333,13 +333,13 @@ (define (check-expected-interface tag unit num-imports exports) (unless (unit? unit) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "compound-unit: result of expression for tag ~s not a unit: ~e" tag unit)) (current-continuation-marks)))) (unless (= num-imports (unit-num-imports unit)) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "compound-unit: unit for tag ~s expects ~a imports, given ~a" tag @@ -352,7 +352,7 @@ (cond [(null? l) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "compount-unit: unit for tag ~s has no ~s export" tag ex)) @@ -719,13 +719,13 @@ (define (check-unit u n) (unless (unit? u) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "invoke-unit: result of unit expression was not a unit: ~e" u)) (current-continuation-marks)))) (unless (= (unit-num-imports u) n) (raise - (make-exn:unit + (make-exn:fail:unit (string->immutable-string (format "invoke-unit: expected a unit with ~a imports, given one with ~a imports" n (unit-num-imports u))) @@ -825,7 +825,7 @@ (values (mk #f) (mk #t)))) (provide (rename :unit unit) compound-unit invoke-unit unit? - exn:unit? struct:exn:unit make-exn:unit + (struct exn:fail:unit ()) - define-values/invoke-unit - namespace-variable-bind/invoke-unit)) + define-values/invoke-unit + namespace-variable-bind/invoke-unit)) diff --git a/collects/mzlib/unitsig.ss b/collects/mzlib/unitsig.ss index 5320bff..d245ecb 100644 --- a/collects/mzlib/unitsig.ss +++ b/collects/mzlib/unitsig.ss @@ -171,7 +171,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define verify-linkage-signature-match - (let ([make-exn make-exn:unit] + (let ([make-exn make-exn:fail:unit] [p-suffix (lambda (pos) (case pos [(1) 'st][(2) 'nd][(3) 'rd][else 'th]))]) (lambda (who tags units esigs isigs) (for-each diff --git a/collects/tests/mzscheme/unit.ss b/collects/tests/mzscheme/unit.ss index e10d509..4d90a6b 100644 --- a/collects/tests/mzscheme/unit.ss +++ b/collects/tests/mzscheme/unit.ss @@ -56,9 +56,9 @@ (syntax-test #'(unit (import i) (export) (set! i 5))) ; Empty exports are syntactically ok:: -(error-test #'(compound-unit (import) (link (A (0))) (export (A))) exn:unit?) -(error-test #'(compound-unit (import) (link (A (0 (B))) (B (0))) (export)) exn:unit?) -(error-test #'(compound-unit (import) (link (A (0)) (B (0))) (export (A x) (B))) exn:unit?) +(error-test #'(compound-unit (import) (link (A (0))) (export (A))) exn:fail:unit?) +(error-test #'(compound-unit (import) (link (A (0 (B))) (B (0))) (export)) exn:fail:unit?) +(error-test #'(compound-unit (import) (link (A (0)) (B (0))) (export (A x) (B))) exn:fail:unit?) ; Self-import is now allowed ; (syntax-test #'(compound-unit (import) (link (A (0 (A)))) (export))) diff --git a/collects/tests/mzscheme/unitsig.ss b/collects/tests/mzscheme/unitsig.ss index 51db574..93aaeb9 100644 --- a/collects/tests/mzscheme/unitsig.ss +++ b/collects/tests/mzscheme/unitsig.ss @@ -94,19 +94,19 @@ (syntax-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (b@))) (export (unit b@ : (b@))))) (syntax-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (b@))) (export (var)))) (syntax-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (b@))) (export (open)))) -(error-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (b@ (i : a)))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (5 (i : a)))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : b)) (link (b@ : b (b3@ (i : b)))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : b)) (link (b@ : b (b3u@ (i : b)))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : b)) (link (b@ : b (b3u2@ (i : b)))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : >b)) (link (b@ : b (b3@ (i : >b)))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : ((open a) x))) (link (b@ : b (b3@ (i : ((open a) x))))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : ((unit b@ : ((open b) w))))) (link (b@ : b (b3u3@ i))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : a)) (link (b@ : (w) (b@))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : ())) (link (b@ : b (b3u3@ i))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : ((unit b@ : ())))) (link (b@ : b (b3u3@ i))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : (b@))) (link (b@ : b (b3u3@ i))) (export)) exn:unit?) -(error-test #'(compound-unit/sig (import (i : ((unit b@ : (x (unit y : ())))))) (link (b@ : b (b3u3@ i))) (export)) exn:unit?) +(error-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (b@ (i : a)))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : a)) (link (b@ : b (5 (i : a)))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : b)) (link (b@ : b (b3@ (i : b)))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : b)) (link (b@ : b (b3u@ (i : b)))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : b)) (link (b@ : b (b3u2@ (i : b)))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : >b)) (link (b@ : b (b3@ (i : >b)))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : ((open a) x))) (link (b@ : b (b3@ (i : ((open a) x))))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : ((unit b@ : ((open b) w))))) (link (b@ : b (b3u3@ i))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : a)) (link (b@ : (w) (b@))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : ())) (link (b@ : b (b3u3@ i))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : ((unit b@ : ())))) (link (b@ : b (b3u3@ i))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : (b@))) (link (b@ : b (b3u3@ i))) (export)) exn:fail:unit?) +(error-test #'(compound-unit/sig (import (i : ((unit b@ : (x (unit y : ())))))) (link (b@ : b (b3u3@ i))) (export)) exn:fail:unit?) (syntax-test #'(compound-unit/sig (import) (link [b@ : b (0 5)]) (export))) (syntax-test #'(compound-unit/sig (import) (link [b@ : b (0 ())]) (export))) (syntax-test #'(compound-unit/sig (import (i : a)) (link (b@ : a (5 (i : b)))) (export)))