From 07a31b48712d8b36cc8965a7f00928628d47028e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 12 Apr 2004 15:16:58 +0000
Subject: [PATCH] .

original commit: eebe1a57eadf3a8f491371e54d595fc6c0b7c24c
---
 collects/mzlib/class.ss    |  5 ++++-
 collects/mzlib/cml.ss      | 15 +++++----------
 collects/mzlib/contract.ss |  2 +-
 3 files changed, 10 insertions(+), 12 deletions(-)

diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss
index 21cb9a4..78fd7e2 100644
--- a/collects/mzlib/class.ss
+++ b/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
diff --git a/collects/mzlib/cml.ss b/collects/mzlib/cml.ss
index 9eafa5b..ae92971 100644
--- a/collects/mzlib/cml.ss
+++ b/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?))
diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index d6e9a81..b50aa8d 100644
--- a/collects/mzlib/contract.ss
+++ b/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")