diff options
Diffstat (limited to '')
16 files changed, 88 insertions, 137 deletions
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 |