aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--luxc/src/lux/analyser/proc/common.clj15
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj15
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj14
-rw-r--r--new-luxc/source/luxc/lang/extension/analysis/common.lux3
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux11
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux11
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux9
-rw-r--r--new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux9
-rw-r--r--new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux29
-rw-r--r--new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux29
-rw-r--r--new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux42
-rw-r--r--new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux9
-rw-r--r--new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux21
-rw-r--r--new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux28
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/procedure/common.lux6
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux2
-rw-r--r--stdlib/source/lux/concurrency/promise.lux40
-rw-r--r--stdlib/source/lux/test.lux2
-rw-r--r--stdlib/test/test/lux/concurrency/stm.lux4
24 files changed, 120 insertions, 203 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 44095998c..589ce42e2 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -399,20 +399,12 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["box" "write"]) (&/|list valueA boxA) (&/|list)))))))))))
-(defn ^:private analyse-process-concurrency-level [analyse exo-type ?values]
+(defn ^:private analyse-process-parallelism-level [analyse exo-type ?values]
(|do [:let [(&/$Nil) ?values]
_ (&type/check exo-type &type/Nat)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["process" "concurrency-level"]) (&/|list) (&/|list)))))))
-
-(defn ^:private analyse-process-future [analyse exo-type ?values]
- (|do [:let [(&/$Cons ?procedure (&/$Nil)) ?values]
- =procedure (&&/analyse-1 analyse (&/$Apply &type/Top &type/IO) ?procedure)
- _ (&type/check exo-type &type/Top)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["process" "future"]) (&/|list =procedure) (&/|list)))))))
+ (&&/$proc (&/T ["process" "parallelism-level"]) (&/|list) (&/|list)))))))
(defn ^:private analyse-process-schedule [analyse exo-type ?values]
(|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values]
@@ -507,8 +499,7 @@
"lux atom read" (analyse-atom-read analyse exo-type ?values)
"lux atom compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values)
- "lux process concurrency-level" (analyse-process-concurrency-level analyse exo-type ?values)
- "lux process future" (analyse-process-future analyse exo-type ?values)
+ "lux process parallelism-level" (analyse-process-parallelism-level analyse exo-type ?values)
"lux process schedule" (analyse-process-schedule analyse exo-type ?values)
;; else
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index 4bf2e8dbf..c671c5328 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -626,7 +626,7 @@
(.visitLdcInsn &/unit-tag))]]
(return nil)))
-(defn ^:private compile-process-concurrency-level [compile ?values special-args]
+(defn ^:private compile-process-parallelism-level [compile ?values special-args]
(|do [:let [(&/$Nil) ?values]
^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
@@ -635,16 +635,6 @@
&&/wrap-long)]]
(return nil)))
-(defn ^:private compile-process-future [compile ?values special-args]
- (|do [:let [(&/$Cons ?procedure (&/$Nil)) ?values]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?procedure)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST "lux/Function"))]
- :let [_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "future" "(Llux/Function;)Ljava/lang/Object;"))]]
- (return nil)))
-
(defn ^:private compile-process-schedule [compile ?values special-args]
(|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values]
^MethodVisitor *writer* &/get-writer
@@ -770,8 +760,7 @@
"process"
(case proc
- "concurrency-level" (compile-process-concurrency-level compile ?values special-args)
- "future" (compile-process-future compile ?values special-args)
+ "parallelism-level" (compile-process-parallelism-level compile ?values special-args)
"schedule" (compile-process-schedule compile ?values special-args)
)
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index da5917e3b..0f9c4cb86 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -440,20 +440,6 @@
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd))
- (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "future" "(Llux/Function;)Ljava/lang/Object;" nil nil)
- (.visitCode)
- (.visitTypeInsn Opcodes/NEW "java/lang/Thread")
- (.visitInsn Opcodes/DUP)
- (.visitTypeInsn Opcodes/NEW "lux/LuxRunnable")
- (.visitInsn Opcodes/DUP)
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitMethodInsn Opcodes/INVOKESPECIAL "lux/LuxRunnable" "<init>" "(Llux/Function;)V")
- (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Thread" "<init>" "(Ljava/lang/Runnable;)V")
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Thread" "start" "()V")
- (.visitLdcInsn &/unit-tag)
- (.visitInsn Opcodes/ARETURN)
- (.visitMaxs 0 0)
- (.visitEnd))
(let [$immediately (new Label)]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "schedule" "(JLlux/Function;)Ljava/lang/Object;" nil nil)
(.visitCode)
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
index 3b0286021..9f2ac5aa8 100644
--- a/new-luxc/source/luxc/lang/extension/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -426,8 +426,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary Nat))
- (install "future" (unary (type (io.IO Top)) Top))
+ (install "parallelism-level" (nullary Nat))
(install "schedule" (binary Nat (type (io.IO Top)) Top))
)))
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux
index 27a92c1cc..100e99ef8 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux
@@ -422,7 +422,7 @@
(install "write" (binary box//write)))))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(_.int 1))
@@ -434,7 +434,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule)))))
## [Bundles]
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
index 3e8ec79cf..54a557ec9 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -399,16 +399,10 @@
(void (format (box//read boxJS) " = " valueJS)))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(frac//to-int "1"))
-(def: (process//future procedureJS)
- Unary
- (format "setTimeout("
- "function() {" procedureJS "(null)" "}"
- ",0)"))
-
(def: (process//schedule [milli-secondsJS procedureJS])
Binary
(format "setTimeout("
@@ -554,8 +548,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 95d243761..5cb4d52ec 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -535,18 +535,12 @@
unitI))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) false)
($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false)
lux-intI))
-(def: (process//future procedureI)
- Unary
- (|>> procedureI ($i.CHECKCAST hostL.function-class)
- ($i.INVOKESTATIC hostL.runtime-class "future"
- ($t.method (list $Function) (#.Some $Object) (list)) false)))
-
(def: (process//schedule [millisecondsI procedureI])
Binary
(|>> millisecondsI ($i.unwrap #$.Long)
@@ -693,8 +687,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index 300c0c353..456974ccd 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -387,20 +387,15 @@
($i.INVOKESPECIAL "java.lang.Thread" "<init>" ($t.method (list $Runnable) #.None (list)) false))))]
(|>> ($d.field #$.Public ($.++F $.finalF $.staticF) executor-field executorT)
($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list))
- (let [concurrency-levelI (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) false)
+ (let [parallelism-levelI (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) false)
($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false))
executorI (|>> ($i.NEW executor-class)
$i.DUP
- concurrency-levelI
+ parallelism-levelI
($i.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) false))]
(|>> executorI
($i.PUTSTATIC hostL.runtime-class executor-field executorT)
$i.RETURN)))
- ($d.method #$.Public $.staticM "future"
- ($t.method (list $Function) (#.Some $Object) (list))
- (|>> (threadI (runnableI ($i.ALOAD +0)))
- ($i.INVOKEVIRTUAL "java.lang.Thread" "start" ($t.method (list) #.None (list)) false)
- endI))
($d.method #$.Public $.staticM "schedule"
($t.method (list $t.long $Function) (#.Some $Object) (list))
(let [delayI ($i.LLOAD +0)
diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
index 3c8f94557..f3b437444 100644
--- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
@@ -390,14 +390,10 @@
(runtimeT.box//write valueO boxO))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(lua.int 1))
-(def: process//future
- Unary
- runtimeT.process//future)
-
(def: (process//schedule [milli-secondsO procedureO])
Binary
(runtimeT.process//schedule milli-secondsO procedureO))
@@ -536,8 +532,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
index 03d84f400..70b498dfa 100644
--- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
@@ -334,29 +334,26 @@
(lua.while! (|> (lua.length "queue") (lua.> (lua.int 0)))
loop-body!)))))
-(runtime: (process//future procedure)
- (lua.block! (list (lua.apply "table.insert" (list process//incoming
- (lua.function (list)
- (lua.return! (lua.apply procedure (list unit))))))
- (lua.return! unit))))
-
(runtime: (process//schedule milli-seconds procedure)
(let [now (lua.apply "os.time" (list))]
- (lua.block! (list (lua.local! "start" (#.Some now))
- (lua.local! "seconds" (#.Some (lua.// (lua.int 1_000)
- milli-seconds)))
- (lua.apply "table.insert" (list process//incoming
- (lua.function (list)
- (lua.block! (list (lua.while! (lua.< "seconds" (lua.- "start" now))
- (lua.apply "coroutine.yield" (list)))
- (lua.return! (lua.apply procedure (list unit))))))))
- (lua.return! unit)))))
+ (lua.if! (lua.= (lua.int 0) milli-seconds)
+ (lua.apply "table.insert" (list process//incoming
+ (lua.function (list)
+ (lua.return! (lua.apply procedure (list unit))))))
+ (lua.block! (list (lua.local! "start" (#.Some now))
+ (lua.local! "seconds" (#.Some (lua.// (lua.int 1_000)
+ milli-seconds)))
+ (lua.apply "table.insert" (list process//incoming
+ (lua.function (list)
+ (lua.block! (list (lua.while! (lua.< "seconds" (lua.- "start" now))
+ (lua.apply "coroutine.yield" (list)))
+ (lua.return! (lua.apply procedure (list unit))))))))
+ (lua.return! unit))))))
(def: runtime//process
Runtime
(format (lua.global! process//incoming (#.Some (lua.array (list))))
@@process//loop
- @@process//future
@@process//schedule))
(runtime: (lua//get object field)
diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
index ce0038430..b4e9737ee 100644
--- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
@@ -422,7 +422,7 @@
## (install "compare-and-swap" (trinary atom//compare-and-swap)))))
## ## [[Processes]]
-## (def: (process//concurrency-level [])
+## (def: (process//parallelism-level [])
## Nullary
## (_.int 1))
@@ -434,8 +434,7 @@
## Bundle
## (<| (prefix "process")
## (|> (dict.new text.Hash<Text>)
-## (install "concurrency-level" (nullary process//concurrency-level))
-## (install "future" (unary runtimeT.process//future))
+## (install "parallelism-level" (nullary process//parallelism-level))
## (install "schedule" (binary process//schedule))
## )))
diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
index 7a907edb0..e76b369fc 100644
--- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
@@ -463,7 +463,7 @@
(install "write" (binary box//write)))))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(python.int 1))
@@ -475,8 +475,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary runtimeT.process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
index a7bd45ff8..8167537f5 100644
--- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
@@ -355,32 +355,25 @@
(def: runtime//box
Runtime
- ($_ python.then!
- @@box//write))
-
-(runtime: (process//future procedure)
- ($_ python.then!
- (python.import! "threading")
- (let [params (python.dict (list [(python.string "target") procedure]))]
- (python.do! (|> (python.global "threading")
- (python.send-keyword (list) params "Thread")
- (python.send (list) "start"))))
- (python.return! ..unit)))
+ @@box//write)
(runtime: (process//schedule milli-seconds procedure)
($_ python.then!
(python.import! "threading")
- (let [seconds (|> milli-seconds (python./ (python.float 1_000.0)))]
- (python.do! (|> (python.global "threading")
- (python.send (list seconds procedure) "Timer")
- (python.send (list) "start"))))
+ (python.if! (python.= (python.int 0) milli-seconds)
+ (let [params (python.dict (list [(python.string "target") procedure]))]
+ (python.do! (|> (python.global "threading")
+ (python.send-keyword (list) params "Thread")
+ (python.send (list) "start"))))
+ (let [seconds (|> milli-seconds (python./ (python.float 1_000.0)))]
+ (python.do! (|> (python.global "threading")
+ (python.send (list seconds procedure) "Timer")
+ (python.send (list) "start")))))
(python.return! ..unit)))
(def: runtime//process
Runtime
- ($_ python.then!
- @@process//future
- @@process//schedule))
+ @@process//schedule)
(do-template [<name> <method>]
[(runtime: (<name> input)
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
index 5c4909d9b..582cda4c6 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
@@ -460,7 +460,7 @@
(install "write" (binary box//write)))))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(r.int 1))
@@ -472,8 +472,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary runtimeT.process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
index 5f073eb17..f13329e26 100644
--- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
@@ -829,35 +829,33 @@
(r.when (|> (r.length (@@ queue)) (r.> (r.int 0)))
(process//loop ..unit)))))))
-(runtime: (process//future procedure)
- ($_ r.then
- (list-append! (@@ procedure) process//incoming)
- ..unit))
-
(runtime: (process//schedule milli-seconds procedure)
- (let [to-seconds (|>> (r./ (r.float 1_000.0)))
- to-millis (|>> (r.* (r.float 1_000.0)))]
- (with-vars [start now seconds _arg elapsed-time]
- ($_ r.then
- (r.set! start current-time-float)
- (r.set! seconds (to-seconds (int//to-float (@@ milli-seconds))))
- (list-append! (r.function (list _arg)
- ($_ r.then
- (r.set! now current-time-float)
- (r.set! elapsed-time (|> (@@ now) (r.- (@@ start))))
- (r.if (|> (@@ elapsed-time) (r.>= (@@ seconds)))
- (@@ procedure)
- (process//schedule (to-millis (@@ elapsed-time))
- (@@ procedure)))))
- process//incoming)
- ..unit))))
+ (r.if (r.= (r.int 0) (@@ milli-seconds))
+ ($_ r.then
+ (list-append! (@@ procedure) process//incoming)
+ ..unit)
+ (let [to-seconds (|>> (r./ (r.float 1_000.0)))
+ to-millis (|>> (r.* (r.float 1_000.0)))]
+ (with-vars [start now seconds _arg elapsed-time]
+ ($_ r.then
+ (r.set! start current-time-float)
+ (r.set! seconds (to-seconds (int//to-float (@@ milli-seconds))))
+ (list-append! (r.function (list _arg)
+ ($_ r.then
+ (r.set! now current-time-float)
+ (r.set! elapsed-time (|> (@@ now) (r.- (@@ start))))
+ (r.if (|> (@@ elapsed-time) (r.>= (@@ seconds)))
+ (@@ procedure)
+ (process//schedule (to-millis (@@ elapsed-time))
+ (@@ procedure)))))
+ process//incoming)
+ ..unit)))))
(def: runtime//process
Runtime
($_ r.then
(r.set! process//incoming (r.list (list)))
@@process//loop
- @@process//future
@@process//schedule
))
diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
index bcc555fe2..a8d4efc4a 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
@@ -526,14 +526,10 @@
(install "write" (binary box//write)))))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(ruby.int 1))
-(def: process//future
- Unary
- runtimeT.process//future)
-
(def: (process//schedule [milli-secondsO procedureO])
Binary
(runtimeT.process//schedule milli-secondsO procedureO))
@@ -542,8 +538,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
index ef840d210..e2bf83dfa 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
@@ -243,23 +243,18 @@
Runtime
(format @@box//write))
-(runtime: (process//future procedure)
- (ruby.and (format "(Thread.new {"
- (ruby.statement (ruby.call (list ..unit) procedure))
- "})")
- ..unit))
-
(runtime: (process//schedule milli-seconds procedure)
- (ruby.and (format "(Thread.new {"
- (ruby.statement (ruby.apply "sleep" (list (ruby./ (ruby.float 1_000.0) milli-seconds))))
- (ruby.statement (ruby.call (list ..unit) procedure))
- "})")
- ..unit))
+ (ruby.block!
+ (list (format "(Thread.new {"
+ (ruby.when! (ruby.not (ruby.= (ruby.int 0) milli-seconds))
+ (ruby.statement (ruby.apply "sleep" (list (ruby./ (ruby.float 1_000.0) milli-seconds)))))
+ (ruby.statement (ruby.call (list ..unit) procedure))
+ "})")
+ (ruby.return! ..unit))))
(def: runtime//process
Runtime
- (format @@process//future
- @@process//schedule))
+ @@process//schedule)
(def: runtime
Runtime
diff --git a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
index 727f6fc40..e4b6ccde5 100644
--- a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
@@ -427,7 +427,7 @@
(install "write" (binary box//write)))))
## [[Processes]]
-(def: (process//concurrency-level [])
+(def: (process//parallelism-level [])
Nullary
(_.int 1))
@@ -439,8 +439,7 @@
Bundle
(<| (prefix "process")
(|> (dict.new text.Hash<Text>)
- (install "concurrency-level" (nullary process//concurrency-level))
- (install "future" (unary runtimeT.process//future))
+ (install "parallelism-level" (nullary process//parallelism-level))
(install "schedule" (binary process//schedule))
)))
diff --git a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux
index c4cd0a909..3bdfc614f 100644
--- a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux
@@ -327,25 +327,27 @@
(@@ queue)))
(process//loop ..unit)))))))
-(runtime: (process//future procedure)
- (_.begin (list (_.set! process//incoming (_.cons (@@ procedure) (@@ process//incoming)))
- ..unit)))
-
(runtime: (process//schedule milli-seconds procedure)
- (with-vars [start process now _ignored]
- (_.let (list [start (io//current-time ..unit)])
- (_.letrec (list [process (_.lambda _ignored
- (_.let (list [now (io//current-time ..unit)])
- (_.if (|> (@@ now) (_.- (@@ start)) (_.>= (@@ milli-seconds)))
- (_.apply (@@ procedure) (list ..unit))
- (process//future (@@ process)))))])
- (process//future (@@ process))))))
+ (let [process//future (function (_ process)
+ (_.set! process//incoming (_.cons process (@@ process//incoming))))]
+ (_.begin
+ (list
+ (_.if (_.= (_.int 0) (@@ milli-seconds))
+ (process//future (@@ procedure))
+ (with-vars [start process now _ignored]
+ (_.let (list [start (io//current-time ..unit)])
+ (_.letrec (list [process (_.lambda _ignored
+ (_.let (list [now (io//current-time ..unit)])
+ (_.if (|> (@@ now) (_.- (@@ start)) (_.>= (@@ milli-seconds)))
+ (_.apply (@@ procedure) (list ..unit))
+ (process//future (@@ process)))))])
+ (process//future (@@ process))))))
+ ..unit))))
(def: runtime//process
Runtime
(_.begin (list (_.define process//incoming (list) (_.list (list)))
@@process//loop
- @@process//future
@@process//schedule)))
(def: runtime
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
index a482c4265..4cee3dce3 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
@@ -299,11 +299,7 @@
timeC (|> r.nat (:: @ map code.nat))]
($_ seq
(test "Can query the level of concurrency."
- (check-success+ "lux process concurrency-level" (list) Nat))
- (test "Can run an IO computation concurrently."
- (check-success+ "lux process future"
- (list (` ("lux function" (~' _) (~' _) (~ primC))))
- Top))
+ (check-success+ "lux process parallelism-level" (list) Nat))
(test "Can schedule an IO computation to run concurrently at some future time."
(check-success+ "lux process schedule"
(list timeC
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 25d3c4dc9..cfc96fbcf 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -529,7 +529,7 @@
(-> Runner Test)
($_ seq
(test "Can query the concurrency level of the machine."
- (|> (run (` ("lux process concurrency-level")))
+ (|> (run (` ("lux process parallelism-level")))
(case> (#e.Success valueV)
(n/>= +1 (:! Nat valueV))
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index 63305f318..a2311d272 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -9,9 +9,9 @@
(concurrency [atom #+ Atom atom])
(type abstract)))
-(def: #export concurrency-level
+(def: #export parallelism-level
Nat
- ("lux process concurrency-level"))
+ ("lux process parallelism-level"))
(abstract: #export (Promise a)
{#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."}
@@ -139,27 +139,31 @@
[right]))
left||right))))
-(def: #export (future computation)
- {#.doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."}
- (All [a] (-> (IO a) (Promise a)))
+(def: #export (schedule millis-delay computation)
+ {#.doc "Runs an I/O computation on its own process (after a specified delay) and returns a Promise that will eventually host its result."}
+ (All [a] (-> Nat (IO a) (Promise a)))
(let [!out (promise #.None)]
- (exec ("lux process future" (io (io.run (resolve (io.run computation)
- !out))))
+ (exec ("lux process schedule" millis-delay
+ (io (io.run (resolve (io.run computation)
+ !out))))
!out)))
-(def: #export (wait time)
+(def: #export future
+ {#.doc "Runs an I/O computation on its own process and returns a Promise that will eventually host its result."}
+ (All [a] (-> (IO a) (Promise a)))
+ (schedule +0))
+
+(def: #export (delay time-millis value)
+ {#.doc "Delivers a value after a certain period has passed."}
+ (All [a] (-> Nat a (Promise a)))
+ (schedule time-millis (io value)))
+
+(def: #export (wait time-millis)
{#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."}
(-> Nat (Promise Top))
- (let [!out (: (Promise Top) (promise #.None))]
- (exec ("lux process schedule" time (resolve [] !out))
- !out)))
+ (delay time-millis []))
-(def: #export (time-out time promise)
+(def: #export (time-out time-millis promise)
{#.doc "Wait for a promise to be resolved within the specified amount of milliseconds."}
(All [a] (-> Nat (Promise a) (Promise (Maybe a))))
- (alt (wait time) promise))
-
-(def: #export (delay time value)
- {#.doc "Delivers a value after a certain period has passed."}
- (All [a] (-> Nat a (Promise a)))
- (:: Functor<Promise> map (function.const value) (wait time)))
+ (alt (wait time-millis) promise))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index e32bd2058..948923aeb 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -228,7 +228,7 @@
(` [(~ (code.text module-name)) (~ (code.symbol [module-name test])) (~ (code.text desc))]))
tests)
num-tests (list.size tests+)
- groups (list.split-all promise.concurrency-level tests+)]]
+ groups (list.split-all promise.parallelism-level tests+)]]
(wrap (list (` (: (~! (IO Top))
((~! io) (exec ((~! do) (~! promise.Monad<Promise>)
[(~' #let) [(~ g!total-successes) +0
diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux
index 58c0d7ef3..bf562c0fa 100644
--- a/stdlib/test/test/lux/concurrency/stm.lux
+++ b/stdlib/test/test/lux/concurrency/stm.lux
@@ -63,8 +63,8 @@
(map (function (_ _)
(M.map @ (function (_ _) (&.commit (&.update i/inc _concurrency-var)))
(list.i/range 1 iterations/processes)))
- (list.i/range 1 (nat-to-int promise.concurrency-level))))
+ (list.i/range 1 (nat-to-int promise.parallelism-level))))
last-val (&.commit (&.read _concurrency-var))]
(assert "Can modify STM vars concurrently from multiple threads."
- (i/= (i/* iterations/processes (nat-to-int promise.concurrency-level))
+ (i/= (i/* iterations/processes (nat-to-int promise.parallelism-level))
last-val)))))))