From c67fd14ae8bbe80d5807859efa64f8d1bc442a7f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 4 Aug 2013 09:10:26 -0600 Subject: [PATCH] remove prohibition on `handle-evt?' arguments to `wrap-evt', etc. The intent of disallowing `handle-evt?' arguments to `wrap-evt', `handle-evt', and `chaperone-evt' was that those extra wrappers break the tail-handling behavior that is almost certainly intended when `handle-evt' is used. The extra checking was not obviously worthwhile (we don't have any checked "this procedure should be called in tail position" annotations, after all), and pushing the distinction through Typed Racket looked particularly inconvenient. Dropping the constraint is trivial if we say that wrapping a `handle-evt' result disables the tail invocation of the handler procedure. --- .../racket-doc/scribblings/reference/evts.scrbl | 16 +++++++--------- .../racket-test/tests/racket/sync.rktl | 10 ++++++---- racket/collects/racket/HISTORY.txt | 2 ++ racket/src/racket/src/struct.c | 4 ++-- 4 files changed, 17 insertions(+), 15 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/evts.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/evts.scrbl index 2a71ffeb5b..97af55b264 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/evts.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/evts.scrbl @@ -138,7 +138,7 @@ pseudo-randomly, and the @tech{synchronization result} is the chosen ]} -@defproc[(wrap-evt [evt (and/c evt? (not/c handle-evt?))] +@defproc[(wrap-evt [evt evt?] [wrap (any/c ... . -> . any)]) evt?]{ @@ -163,13 +163,14 @@ combination of @racket[choice-evt] involving an event from ]} -@defproc[(handle-evt [evt (and/c evt? (not/c handle-evt?))] +@defproc[(handle-evt [evt evt?] [handle (any/c ... . -> . any)]) handle-evt?]{ Like @racket[wrap-evt], except that @racket[handle] is called in @tech{tail -position} with respect to the synchronization request, and without -breaks explicitly disabled. +position} with respect to the synchronization request---and without +breaks explicitly disabled---when it is not wrapped by @racket[wrap-evt], +@racket[chaperone-evt], or another @racket[handle-evt]. @examples[#:eval evt-eval (define msg-ch (make-channel)) @@ -292,11 +293,8 @@ more than @racket[msecs]. @ResultItself{alarm event}. Returns @racket[#t] if @racket[evt] was created by @racket[handle-evt] or by @racket[choice-evt] applied to another event for which -@racket[handle-evt?] produces @racket[#t]. Such events are illegal as -an argument to @racket[handle-evt] or @racket[wrap-evt], because they -cannot be wrapped further. For any other event, @racket[handle-evt?] -produces @racket[#f], and the event is a legal argument to -@racket[handle-evt] or @racket[wrap-evt] for further wrapping. +@racket[handle-evt?] produces @racket[#t]. For any other event, +@racket[handle-evt?] produces @racket[#f]. @examples[#:eval evt-eval (handle-evt? never-evt) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl index 5f6a0bfc06..8a801f32c4 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl @@ -302,10 +302,12 @@ (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))) +;; cac wrap a `handle-evt' with a wrap or another handle, although it +;; defeats tail behavior of the `handle-evt'. +(test (list (void)) sync (handle-evt (handle-evt always-evt void) list)) +(test (box (void)) sync (wrap-evt (handle-evt always-evt void) box)) +(test (vector (void)) sync (handle-evt (choice-evt (handle-evt always-evt void) never-evt) vector)) +(test (void) sync (chaperone-evt (handle-evt always-evt void) (lambda (x) (values x values)))) ;; can handle a wrap evt: (test #t evt? (handle-evt (wrap-evt always-evt void) void)) diff --git a/racket/collects/racket/HISTORY.txt b/racket/collects/racket/HISTORY.txt index 968196f352..c4bb6f2587 100644 --- a/racket/collects/racket/HISTORY.txt +++ b/racket/collects/racket/HISTORY.txt @@ -5,6 +5,8 @@ Changed module search to use current-library-collection-paths Changed use-user-specific-search-paths and use-collection-link-paths to affect only find-library-collection-paths and find-library-collection-links +Removed restriction against handle-evt? arguments to wrap-evt, + handle-evt. and chaperone-evt Version 5.90.0.3 Base user directoy paths on an installation name instead diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c index 5babdfc729..473140c1d3 100644 --- a/racket/src/racket/src/struct.c +++ b/racket/src/racket/src/struct.c @@ -3311,8 +3311,8 @@ static Scheme_Object *wrap_evt(const char *who, int wrap, int argc, Scheme_Objec { Wrapped_Evt *ww; - if (!scheme_is_evt(argv[0]) || handle_evt_p(0, argv)) - scheme_wrong_contract(who, "(and/c evt? (not/c handle-evt?))", 0, argc, argv); + if (!scheme_is_evt(argv[0])) + scheme_wrong_contract(who, "evt?", 0, argc, argv); if (!SCHEME_PROCP(argv[1])) scheme_wrong_contract(who, "procedure?", 1, argc, argv);