From ae4b101ec5b69dcdca35323404d17818b744cbd5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 18 Aug 2018 14:36:25 -0600
Subject: [PATCH] cs: add `sync` shortcuts for simple cases

---
 racket/src/thread/channel.rkt |  7 ++++++-
 racket/src/thread/sync.rkt    | 33 +++++++++++++++++++++++++++++----
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/racket/src/thread/channel.rkt b/racket/src/thread/channel.rkt
index 520d8e378f..c58954d20b 100644
--- a/racket/src/thread/channel.rkt
+++ b/racket/src/thread/channel.rkt
@@ -12,7 +12,8 @@
          channel-get
          
          channel-put-evt
-         channel-put-evt?)
+         channel-put-evt?
+         channel-put-do)
 
 (module+ for-sync
   (provide set-sync-on-channel!))
@@ -194,6 +195,10 @@
   (define new-v ((cdr ch+put-proc) old-ch v))
   (channel-put old-ch new-v))
 
+(define (channel-put-do v)
+  (channel-put (channel-put-evt*-ch v)
+               (channel-put-evt*-v v)))
+
 ;; ----------------------------------------
 
 (define (not-matching-select-waiter w+b/v)
diff --git a/racket/src/thread/sync.rkt b/racket/src/thread/sync.rkt
index 993fc953d7..f6fa79ee95 100644
--- a/racket/src/thread/sync.rkt
+++ b/racket/src/thread/sync.rkt
@@ -166,11 +166,36 @@
       ;; Just `go`:
       (go)])))
 
-(define (sync . args)
-  (do-sync 'sync #f args))
+(define sync
+  (case-lambda
+    [(evt)
+     (cond
+       [(semaphore? evt)
+        (semaphore-wait evt)
+        evt]
+       [(channel? evt)
+        (channel-get evt)]
+       [(channel-put-evt? evt)
+        (channel-put-do evt)
+        evt]
+       [else
+        (do-sync 'sync #f (list evt))])]
+    [args
+     (do-sync 'sync #f args)]))
 
-(define (sync/timeout timeout . args)
-  (do-sync 'sync/timeout timeout args))
+(define sync/timeout
+  (case-lambda
+    [(timeout evt)
+     (cond
+       [(and (semaphore? evt)
+             (eqv? timeout 0))
+        (if (semaphore-try-wait? evt)
+            evt
+            #f)]
+       [else
+        (do-sync 'sync/timeout timeout (list evt))])]
+    [(timeout . args)
+     (do-sync 'sync/timeout timeout args)]))
 
 (define (sync/enable-break . args)
   (do-sync 'sync/enable-break #f args #:enable-break? #t))