handle-evt' cannot wrap handle-evt'

The prohbition against `handle-evt' on `handle-evt' is as
document and as originally intended. I'm not sure why it
was allowed.

Existing programs that use `handle-evt' incorrectly
can break. I found and fixed one incorrect use and one
questionable use in the Racket tree (which is a small
minority of the uses of `handle-evt' in the tree).

collects/ffi/unsafe/com.rkt

@@ -1640,7 +1640,7 @@
                                (lambda ()
                                  (thread-resume (com-event-executor-t self)
                                                 (current-thread))
-                                 (handle-evt 
+                                 (wrap-evt 
                                   (com-event-executor-ch self)
                                   (lambda (v)
                                     (lambda ()

collects/frtime/core/mailbox.rkt

@@ -11,8 +11,8 @@
 (define (new-mailbox)
   (define control-ch (make-channel))
   (define (thread-recv-evt)
-    (handle-evt (thread-receive-evt)
+    (wrap-evt (thread-receive-evt)
-                (lambda (e) (thread-receive))))
+              (lambda (e) (thread-receive))))
   ; Try to match one message
   (define (try-to-match req msg)
     (match req

collects/mzlib/port.rkt

@@ -437,7 +437,7 @@
    (lambda (s)
      (let ([r (peek-bytes-avail!* s delta #f orig-in)])
        (set! delta (+ delta (if (number? r) r 1)))
-       (if (eq? r 0) (handle-evt orig-in (lambda (v) 0)) r)))
+       (if (eq? r 0) (wrap-evt orig-in (lambda (v) 0)) r)))
    (lambda (s skip default)
      (peek-bytes-avail!* s (+ delta skip) #f orig-in))
    void

collects/racket/promise.rkt

@@ -72,7 +72,7 @@
   #:property prop:evt
   (lambda (p)
     (let ([v (pref p)])
-      (handle-evt (if (syncinfo? v) (syncinfo-done-evt v) always-evt) void))))
+      (wrap-evt (if (syncinfo? v) (syncinfo-done-evt v) always-evt) void))))
 
 (provide (rename-out [delay/sync* delay/sync]))
 (define (delay/sync thunk)
@@ -95,8 +95,8 @@
   #:property prop:evt
   (lambda (p)
     (let ([v (pref p)])
-      (handle-evt (if (running? v) (running-thread-thread v) always-evt)
+      (wrap-evt (if (running? v) (running-thread-thread v) always-evt)
-                  void))))
+                void))))
 
 (provide (rename-out [delay/thread* delay/thread]))
 (define (delay/thread thunk group)

collects/tests/racket/sync.rktl

@@ -269,6 +269,35 @@
       (wrap-evt (choice-evt (make-semaphore 1) (make-semaphore 1))
 			     (lambda (x) 78)))
 
+;; ----------------------------------------
+;; handle evt
+
+(test 10 sync (handle-evt always-evt (lambda (x) 10)))
+(test 11 sync (handle-evt (wrap-evt always-evt (lambda (x) 10)) add1))
+(test-values '(1 2) (lambda () (sync (handle-evt always-evt (lambda (x) (values 1 2))))))
+;; check tail call via loop:
+(test 'ok sync (let loop ([n 1000000])
+                 (if (zero? n)
+                     (handle-evt always-evt (lambda (x) 'ok))
+                     (sync
+                      (handle-evt always-evt (lambda (x) (loop (sub1 n))))))))
+
+;; cannot wrap a `handle-evt' returns with a wrap or another handle:
+(err/rt-test (handle-evt (handle-evt always-evt void) void))
+(err/rt-test (wrap-evt (handle-evt always-evt void) void))
+(err/rt-test (handle-evt (choice-evt (handle-evt always-evt void) void)))
+
+;; can handle a wrap evt:
+(test #t evt? (handle-evt (wrap-evt always-evt void) void))
+(test #t evt? (handle-evt (choice-evt (wrap-evt always-evt void)
+                                      (wrap-evt never-evt void))
+                          void))
+
+(test #t handle-evt? (handle-evt always-evt void))
+(test #t handle-evt? (choice-evt (wrap-evt always-evt void) (handle-evt always-evt void)))
+(test #f handle-evt? (wrap-evt always-evt void))
+(test #f handle-evt? (choice-evt (wrap-evt always-evt void) (wrap-evt always-evt void)))
+
 ;; ----------------------------------------
 ;; Nack waitables
 

collects/tests/racket/syntax.rktl

@@ -632,6 +632,15 @@
 (syntax-test #'(delay . 1))
 (syntax-test #'(delay 1 . 2))
 
+(let ([p (delay/sync 12)]
+      [v #f])
+  (thread (lambda () (set! v (force p))))
+  (sync (system-idle-evt))
+  (test 12 force p)
+  (test 12 values v)
+  (test (void) sync p)
+  (test (list (void)) sync (wrap-evt p list)))
+
 (test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4))
 (test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name)))
 (test '(a 3 4 5 6 b) 'quasiquote `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))

src/racket/src/struct.c

@@ -3130,8 +3130,8 @@ static Scheme_Object *wrap_evt(const char *who, int wrap, int argc, Scheme_Objec
 {
   Wrapped_Evt *ww;
 
-  if (!scheme_is_evt(argv[0]) || (wrap && handle_evt_p(0, argv)))
+  if (!scheme_is_evt(argv[0]) || handle_evt_p(0, argv))
-    scheme_wrong_type(who, wrap ? "non-handle evt" : "evt", 0, argc, argv);
+    scheme_wrong_type(who, "non-handle evt", 0, argc, argv);
   scheme_check_proc_arity(who, 1, 1, argc, argv);
 
   ww = MALLOC_ONE_TAGGED(Wrapped_Evt);