Go macro uses virtual threads (#1517)

This commit is contained in:
Michiel Borkent 2023-03-10 19:22:53 +01:00 committed by GitHub
parent 4438f3bbcf
commit 7aba75564e
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 42 additions and 4 deletions

View file

@ -50,7 +50,7 @@
org.clojure/data.priority-map {:mvn/version "1.1.0"} org.clojure/data.priority-map {:mvn/version "1.1.0"}
insn/insn {:mvn/version "0.5.2"} insn/insn {:mvn/version "0.5.2"}
org.clojure/core.rrb-vector {:mvn/version "0.1.2"} org.clojure/core.rrb-vector {:mvn/version "0.1.2"}
org.babashka/cli {:mvn/version "0.6.46"} org.babashka/cli {:mvn/version "0.6.49"}
org.babashka/http-client {:mvn/version "0.1.6"}} org.babashka/http-client {:mvn/version "0.1.6"}}
:aliases {:babashka/dev :aliases {:babashka/dev
{:main-opts ["-m" "babashka.main"]} {:main-opts ["-m" "babashka.main"]}

View file

@ -8,6 +8,10 @@
(def ^java.util.concurrent.Executor executor @#'async/thread-macro-executor) (def ^java.util.concurrent.Executor executor @#'async/thread-macro-executor)
(def ^java.util.concurrent.Executor virtual-executor
(try (eval '(java.util.concurrent.Executors/newVirtualThreadPerTaskExecutor))
(catch Exception _ nil)))
(defn thread-call (defn thread-call
"Executes f in another thread, returning immediately to the calling "Executes f in another thread, returning immediately to the calling
thread. Returns a channel which will receive the result of calling thread. Returns a channel which will receive the result of calling
@ -26,10 +30,32 @@
(async/close! c)))))) (async/close! c))))))
c)) c))
(defn -vthread-call
"Executes f in another virtual thread, returning immediately to the calling
thread. Returns a channel which will receive the result of calling
f when completed, then close."
[f]
(let [c (async/chan 1)]
(let [binds (vars/get-thread-binding-frame)]
(.execute virtual-executor
(fn []
(vars/reset-thread-binding-frame binds)
(try
(let [ret (f)]
(when-not (nil? ret)
(async/>!! c ret)))
(finally
(async/close! c))))))
c))
(defn thread (defn thread
[_ _ & body] [_ _ & body]
`(~'clojure.core.async/thread-call (fn [] ~@body))) `(~'clojure.core.async/thread-call (fn [] ~@body)))
(defn -vthread
[_ _ & body]
`(~'clojure.core.async/-vthread-call (fn [] ~@body)))
(defn alt!! (defn alt!!
"Like alt!, except as if by alts!!, will block until completed, and "Like alt!, except as if by alts!!, will block until completed, and
not intended for use in (go ...) blocks." not intended for use in (go ...) blocks."
@ -38,10 +64,19 @@
(defn go-loop (defn go-loop
[_ _ bindings & body] [_ _ bindings & body]
(list 'clojure.core.async/thread (list* 'loop bindings body))) (list 'clojure.core.async/go (list* 'loop bindings body)))
(def core-async-namespace (sci/create-ns 'clojure.core.async nil)) (def core-async-namespace (sci/create-ns 'clojure.core.async nil))
(defn timeout [ms]
(if virtual-executor
(let [chan (async/chan nil)]
(.execute virtual-executor (fn []
(Thread/sleep ms)
(async/close! chan)))
chan)
(async/timeout ms)))
(def async-namespace (def async-namespace
{:obj core-async-namespace {:obj core-async-namespace
'<!! (copy-var async/<!! core-async-namespace) '<!! (copy-var async/<!! core-async-namespace)
@ -92,7 +127,8 @@
'tap (copy-var async/tap core-async-namespace) 'tap (copy-var async/tap core-async-namespace)
'thread (macrofy 'thread thread core-async-namespace) 'thread (macrofy 'thread thread core-async-namespace)
'thread-call (copy-var thread-call core-async-namespace) 'thread-call (copy-var thread-call core-async-namespace)
'timeout (copy-var async/timeout core-async-namespace) '-vthread-call (copy-var -vthread-call core-async-namespace)
'timeout (copy-var timeout core-async-namespace)
'to-chan (copy-var async/to-chan core-async-namespace) 'to-chan (copy-var async/to-chan core-async-namespace)
'to-chan! (copy-var async/to-chan! core-async-namespace) 'to-chan! (copy-var async/to-chan! core-async-namespace)
'to-chan!! (copy-var async/to-chan!! core-async-namespace) 'to-chan!! (copy-var async/to-chan!! core-async-namespace)
@ -107,7 +143,9 @@
'untap (copy-var async/untap core-async-namespace) 'untap (copy-var async/untap core-async-namespace)
'untap-all (copy-var async/untap-all core-async-namespace) 'untap-all (copy-var async/untap-all core-async-namespace)
;; polyfill ;; polyfill
'go (macrofy 'go thread core-async-namespace) 'go (if virtual-executor
(macrofy 'go -vthread core-async-namespace)
(macrofy 'go thread core-async-namespace))
'<! (copy-var async/<!! core-async-namespace {:name '<!}) '<! (copy-var async/<!! core-async-namespace {:name '<!})
'>! (copy-var async/>!! core-async-namespace {:name '>!}) '>! (copy-var async/>!! core-async-namespace {:name '>!})
'alt! (macrofy 'alt! alt!! core-async-namespace) 'alt! (macrofy 'alt! alt!! core-async-namespace)