diff options
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))))))) |