.

original commit: eebe1a57eadf3a8f491371e54d595fc6c0b7c24c

collects/mzlib/class.ss

@@ -1,5 +1,8 @@
 (module class mzscheme
-  (require "private/class-sneaky.ss")
+
+  ;; All of the implementation is actually in private/class-internal.ss,
+  ;;  which provides extra (private) functionality to contract.ss.
+  (require "private/class-internal.ss")
   
   (provide class
 	   class* class*/names

collects/mzlib/cml.ss

@@ -8,6 +8,9 @@
   (define (sync w)
     (object-wait-multiple #f w))
 
+  (define (sync/enable-break w)
+    (object-wait-multiple/enable-break #f w))
+
   (define (channel)
     (make-channel))
 
@@ -38,20 +41,12 @@
   (define (current-time)
     (current-seconds))
   (define (time-evt t)
-    (make-nack-guard-waitable
-     (lambda (nack)
-       (let ([s (make-semaphore)])
-	 (thread-resume (thread/suspend-to-kill
-			 (lambda ()
-			   (object-wait-multiple (max 0 (- t (current-seconds)))
-						 nack)
-			   (semaphore-post s)))
-			(current-thread))
-	 (make-wrapped-waitable s void)))))
+    (make-alarm t))
 
   (provide/contract
    (spawn ((-> any) . -> . thread?))
    (sync (object-waitable? . -> . any))
+   (sync/enable-break (object-waitable? . -> . any))
    (channel (-> channel?))
    (channel-recv-evt (channel? . -> . object-waitable?))
    (channel-send-evt (channel? any? . -> . object-waitable?))

collects/mzlib/contract.ss

@@ -33,7 +33,7 @@ add struct contracts for immutable structs?
                       (lib "stx.ss" "syntax")
                       (lib "name.ss" "syntax"))
   
-  (require "private/class-sneaky.ss"
+  (require "private/class-private.ss"
            "etc.ss"
            "list.ss")