From 7e44ee8a2cfb14e35f6283a9eb8d6a2ddc8bd99a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 31 Jul 2018 20:22:15 -0400 Subject: Now implementing process functionality in stdlib instead of the compiler. --- .../common-lisp/procedure/common.jvm.lux | 19 +---- .../lang/translation/common-lisp/runtime.jvm.lux | 44 +---------- .../lang/translation/js/procedure/common.jvm.lux | 20 ----- .../lang/translation/jvm/procedure/common.jvm.lux | 23 ------ .../luxc/lang/translation/jvm/runtime.jvm.lux | 92 +--------------------- .../lang/translation/lua/procedure/common.jvm.lux | 18 ----- .../luxc/lang/translation/lua/runtime.jvm.lux | 45 ----------- .../lang/translation/php/procedure/common.jvm.lux | 18 ----- .../luxc/lang/translation/php/runtime.jvm.lux | 25 ------ .../translation/python/procedure/common.jvm.lux | 18 ----- .../luxc/lang/translation/python/runtime.jvm.lux | 19 ----- .../lang/translation/r/procedure/common.jvm.lux | 18 ----- .../source/luxc/lang/translation/r/runtime.jvm.lux | 57 -------------- .../lang/translation/ruby/procedure/common.jvm.lux | 18 ----- .../luxc/lang/translation/ruby/runtime.jvm.lux | 14 ---- 15 files changed, 6 insertions(+), 442 deletions(-) (limited to 'new-luxc/source/luxc/lang') 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 585292af0..54a4336fb 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 @@ -350,22 +350,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (_.int 1)) - -(def: (process//schedule [milli-secondsO procedureO]) - Binary - (runtimeT.process//schedule milli-secondsO procedureO)) - -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule))))) - ## [Bundles] (def: #export procedures Bundle @@ -378,5 +362,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs)) - )) + ))) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux index c54fde7ce..3e8d2c514 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux @@ -296,46 +296,6 @@ (_.progn (list @@io//exit @@io//current-time))) -(def: process//incoming - SVar - (_.var (lang.normalize-name "process//incoming"))) - -(runtime: (process//loop _) - (_.if (_.not (_.null (@@ process//incoming))) - (with-vars [queue process] - (_.let (list [queue (@@ process//incoming)]) - (_.progn (list (_.setq! process//incoming (_.list (list))) - (_.map/3 _.nil - (_.lambda (_.poly (list process)) - (_.funcall (list ..unit) (@@ process))) - (@@ queue)) - (process//loop ..unit))))) - ..unit)) - -(runtime: (process//schedule milli-seconds procedure) - (_.progn - (list - (_.if (_.= (_.int 0) (@@ milli-seconds)) - (_.setq! process//incoming (_.cons (@@ procedure) (@@ process//incoming))) - (with-vars [start scheduled now diff _ignored] - (_.let (list [start (io//current-time ..unit)]) - (_.labels (list [scheduled [(_.poly+ (list) _ignored) - (_.let (list [now (io//current-time ..unit)] - [diff (|> (@@ now) (_.- (@@ start)))]) - (_.if (|> (@@ diff) (_.>= (@@ milli-seconds))) - (_.funcall (list ..unit) (@@ procedure)) - (process//schedule (|> (@@ milli-seconds) (_.- (@@ diff))) - (_.function (@@ scheduled)))))]]) - (_.setq! process//incoming (_.cons (_.function (@@ scheduled)) - (@@ process//incoming))))))) - ..unit))) - -(def: runtime//process - Runtime - (_.progn (list (_.defparameter process//incoming (_.list (list))) - @@process//loop - @@process//schedule))) - (def: runtime Runtime (_.progn (list runtime//lux @@ -344,9 +304,7 @@ runtime//text runtime//array runtime//box - runtime//io - runtime//process)) - ) + runtime//io))) (def: #export artifact Text (format prefix //.file-extension)) 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 cca49372b..df1be8508 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 @@ -320,17 +320,6 @@ Binary (void (format (box//read boxJS) " = " valueJS))) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (frac//to-int "1")) - -(def: (process//schedule [milli-secondsJS procedureJS]) - Binary - (format "setTimeout(" - "function() {" procedureJS "(null)" "}" - "," (int//to-frac milli-secondsJS) ")")) - ## [Bundles] (def: lux-procs Bundle @@ -427,14 +416,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule)) - ))) - (def: #export procedures Bundle (<| (prefix "lux") @@ -446,5 +427,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs) ))) 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 a6b037947..49b1971f1 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 @@ -433,20 +433,6 @@ (_.int 0) valueI _.AASTORE unitI)) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) #0) - (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0) - lux-intI)) - -(def: (process//schedule [millisecondsI procedureI]) - Binary - (|>> millisecondsI (_.unwrap #$.Long) - procedureI (_.CHECKCAST hostL.function-class) - (_.INVOKESTATIC hostL.runtime-class "schedule" - ($t.method (list $t.long $Function) (#.Some $Object) (list)) #0))) - ## [Bundles] (def: lux-procs Bundle @@ -543,14 +529,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule)) - ))) - (def: #export procedures Bundle (<| (prefix "lux") @@ -562,5 +540,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs) ))) 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 28bce7d28..eec57610d 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -34,7 +34,6 @@ (def: #export $Function $.Type ($t.class //.function-class (list))) (def: $Throwable $.Type ($t.class "java.lang.Throwable" (list))) (def: $Runtime $.Type ($t.class "java.lang.Runtime" (list))) -(def: $Runnable $.Type ($t.class "java.lang.Runnable" (list))) (def: #export logI Inst @@ -373,64 +372,6 @@ _.ARETURN))) ))) -(def: process-methods - Def - (let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor" - executorT ($t.class executor-class (list)) - executor-field "executor" - endI (|>> (_.string //.unit) - _.ARETURN) - runnableI (: (-> Inst Inst) - (function (_ functionI) - (|>> (_.NEW //.runnable-class) - _.DUP - functionI - (_.INVOKESPECIAL //.runnable-class "" ($t.method (list $Function) #.None (list)) #0)))) - threadI (: (-> Inst Inst) - (function (_ runnableI) - (|>> (_.NEW "java.lang.Thread") - _.DUP - runnableI - (_.INVOKESPECIAL "java.lang.Thread" "" ($t.method (list $Runnable) #.None (list)) #0))))] - (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) executor-field executorT) - ($d.method #$.Public $.staticM "" ($t.method (list) #.None (list)) - (let [parallelism-levelI (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) - (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) - executorI (|>> (_.NEW executor-class) - _.DUP - parallelism-levelI - (_.INVOKESPECIAL executor-class "" ($t.method (list $t.int) #.None (list)) #0))] - (|>> executorI - (_.PUTSTATIC //.runtime-class executor-field executorT) - _.RETURN))) - ($d.method #$.Public $.staticM "schedule" - ($t.method (list $t.long $Function) (#.Some $Object) (list)) - (let [delayI (_.LLOAD 0) - immediacy-checkI (|>> delayI - (_.long +0) - _.LCMP) - time-unit-class "java.util.concurrent.TimeUnit" - time-unitT ($t.class time-unit-class (list)) - futureT ($t.class "java.util.concurrent.ScheduledFuture" (list)) - executorI (_.GETSTATIC //.runtime-class executor-field executorT) - schedule-laterI (|>> executorI - (runnableI (_.ALOAD 2)) - delayI - (_.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) - (_.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) - schedule-immediatelyI (|>> executorI - (runnableI (_.ALOAD 2)) - (_.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] - (<| _.with-label (function (_ @immediately)) - (|>> immediacy-checkI - (_.IFEQ @immediately) - schedule-laterI - endI - (_.label @immediately) - schedule-immediatelyI - endI)))) - ))) - (def: translate-runtime (Operation ByteCode) (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list) @@ -438,8 +379,7 @@ frac-methods text-methods pm-methods - io-methods - process-methods))] + io-methods))] (do phase.Monad [_ (translation.execute! [//.runtime-class bytecode])] (wrap bytecode)))) @@ -474,33 +414,9 @@ [_ (translation.execute! [//.function-class bytecode])] (wrap bytecode)))) -(def: translate-runnable - (Operation ByteCode) - (let [procedure-field "procedure" - bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)]) - (|>> ($d.field #$.Public $.finalF procedure-field $Function) - ($d.method #$.Public $.noneM "" ($t.method (list $Function) #.None (list)) - (|>> (_.ALOAD 0) - (_.INVOKESPECIAL "java.lang.Object" "" ($t.method (list) #.None (list)) #0) - (_.ALOAD 0) - (_.ALOAD 1) - (_.PUTFIELD //.runnable-class procedure-field $Function) - _.RETURN)) - ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list)) - (|>> (_.ALOAD 0) - (_.GETFIELD //.runnable-class procedure-field $Function) - _.NULL - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) - _.RETURN)) - ))] - (do phase.Monad - [_ (translation.execute! [//.runnable-class bytecode])] - (wrap bytecode)))) - (def: #export translate - (Operation [ByteCode ByteCode ByteCode]) + (Operation [ByteCode ByteCode]) (do phase.Monad [runtime-bc translate-runtime - function-bc translate-function - runnable-bc translate-runnable] - (wrap [runtime-bc function-bc runnable-bc]))) + function-bc translate-function] + (wrap [runtime-bc function-bc]))) 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 356adb5c3..4b128f946 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 @@ -319,15 +319,6 @@ Binary (runtimeT.box//write valueO boxO)) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (lua.int 1)) - -(def: (process//schedule [milli-secondsO procedureO]) - Binary - (runtimeT.process//schedule milli-secondsO procedureO)) - ## [Bundles] (def: lux-procs Bundle @@ -424,14 +415,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule)) - ))) - (def: #export procedures Bundle (<| (prefix "lux") @@ -443,5 +426,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs) ))) 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 3a18f98e7..ce9c37db5 100644 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux @@ -258,50 +258,6 @@ Runtime (format @@box//write)) -(def: process//incoming - Text - (lang.normalize-name "process//incoming")) - -(runtime: (process//loop _) - (let [migrate-incoming! (lua.block! (list (lua.for-step! "idx" (lua.int 1) (lua.length process//incoming) (lua.int 1) - (lua.apply "table.insert" (list "queue" (lua.nth "idx" process//incoming)))) - (lua.set! process//incoming (lua.array (list))))) - consume-queue! (lua.block! (list (lua.local! "survivors" (#.Some (lua.array (list)))) - (lua.local! "active_processes" (#.Some (lua.length "queue"))) - (lua.for-step! "idx" (lua.int 1) "active_processes" (lua.int 1) - (lua.block! (list (lua.local! "process" (#.Some (lua.nth "idx" "queue"))) - (lua.when! (lua.apply "coroutine.resume" (list "process")) - (lua.apply "table.insert" (list "survivors" "process")))))) - (lua.set! "queue" "survivors"))) - loop-body! (lua.block! (list migrate-incoming! - consume-queue!))] - (lua.block! (list (lua.local! "queue" (#.Some (lua.array (list)))) - loop-body! - (lua.while! (|> (lua.length "queue") (lua.> (lua.int 0))) - loop-body!))))) - -(runtime: (process//schedule milli-seconds procedure) - (let [now (lua.apply "os.time" (list))] - (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//schedule)) - (runtime: (lua//get object field) (lua.block! (list (lua.local! "value" (#.Some (lua.nth field object))) (lua.if! (lua.= lua.nil "value") @@ -325,7 +281,6 @@ runtime//text runtime//array runtime//box - runtime//process runtime//lua)) (def: #export artifact Text (format prefix ".lua")) 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 e195130c5..774c28acf 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 @@ -338,23 +338,6 @@ ## (install "current-time" (nullary (function (_ _) ## (runtimeT.io//current-time! runtimeT.unit))))))) -## ## [[Processes]] -## (def: (process//parallelism-level []) -## Nullary -## (_.int 1)) - -## (def: (process//schedule [milli-secondsO procedureO]) -## Binary -## (runtimeT.process//schedule milli-secondsO procedureO)) - -## (def: process-procs -## Bundle -## (<| (prefix "process") -## (|> (dict.new text.Hash) -## (install "parallelism-level" (nullary process//parallelism-level)) -## (install "schedule" (binary process//schedule)) -## ))) - ## [Bundles] (def: #export procedures Bundle @@ -367,5 +350,4 @@ ## (dict.merge text-procs) ## (dict.merge array-procs) ## (dict.merge io-procs) - ## (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux index c57bc3d80..d33cdb76c 100644 --- a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux @@ -299,30 +299,6 @@ ## @@array//get ## @@array//put)) -## (runtime: (process//future procedure) -## ($_ _.then! -## (_.import! "threading") -## (let [params (_.dict (list [(_.string "target") procedure]))] -## (_.do! (|> (_.global "threading") -## (_.send-keyword (list) params "Thread") -## (_.send (list) "start")))) -## (_.return! ..unit))) - -## (runtime: (process//schedule milli-seconds procedure) -## ($_ _.then! -## (_.import! "threading") -## (let [seconds (|> milli-seconds (_./ (_.float 1_000.0)))] -## (_.do! (|> (_.global "threading") -## (_.send (list seconds procedure) "Timer") -## (_.send (list) "start")))) -## (_.return! ..unit))) - -## (def: runtime//process -## Runtime -## ($_ _.then! -## @@process//future -## @@process//schedule)) - (def: check-necessary-conditions! Statement (let [condition (_.= (_.int 8) @@ -342,7 +318,6 @@ ## runtime//text ## runtime//array ## runtime//io - ## runtime//process )) (def: #export artifact Text (format prefix //.extension)) 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 9a70c8c92..a760dc3a2 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 @@ -379,23 +379,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (python.int 1)) - -(def: (process//schedule [milli-secondsO procedureO]) - Binary - (runtimeT.process//schedule milli-secondsO procedureO)) - -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule)) - ))) - ## [Bundles] (def: #export procedures Bundle @@ -408,5 +391,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs) ))) 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 571835b79..2cfe7eb1e 100644 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux @@ -342,24 +342,6 @@ Runtime @@box//write) -(runtime: (process//schedule milli-seconds procedure) - ($_ python.then! - (python.import! "threading") - (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 - @@process//schedule) - (def: runtime Runtime ($_ python.then! @@ -371,7 +353,6 @@ runtime//array runtime//box runtime//io - runtime//process )) (def: #export artifact Text (format prefix ".py")) 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 d8f4f4662..d8b383ff2 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 @@ -371,23 +371,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (r.int 1)) - -(def: (process//schedule [milli-secondsO procedureO]) - Binary - (runtimeT.process//schedule milli-secondsO procedureO)) - -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule)) - ))) - ## [Bundles] (def: #export procedures Bundle @@ -400,5 +383,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs) ))) 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 ee46836cb..dff7c4ae1 100644 --- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux @@ -774,62 +774,6 @@ ($_ r.then @@box//write)) -(def: process//incoming - SVar - (r.var (lang.normalize-name "process//incoming"))) - -(def: (list-append! value rlist) - (-> Expression SVar Expression) - (r.set-nth! (|> (@@ rlist) r.length (r.+ (r.int 1))) - value - rlist)) - -(runtime: (process//loop _) - (let [empty (r.list (list))] - (with-vars [queue process] - (let [migrate-incoming! ($_ r.then - (r.set! queue empty) - (<| (r.for-in process (@@ process//incoming)) - (list-append! (@@ process) queue)) - (r.set! process//incoming empty)) - consume-queue! (<| (r.for-in process (@@ queue)) - (r.apply (list ..unit) (@@ process)))] - ($_ r.then - migrate-incoming! - consume-queue! - (r.when (|> (r.length (@@ queue)) (r.> (r.int 0))) - (process//loop ..unit))))))) - -(runtime: (process//schedule milli-seconds procedure) - (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//schedule - )) - (def: runtime Runtime ($_ r.then @@ -846,7 +790,6 @@ runtime//array runtime//box runtime//io - runtime//process )) (def: #export artifact Text (format prefix ".r")) 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 96d42a4a9..1f995b44b 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 @@ -412,23 +412,6 @@ (install "read" (unary box//read)) (install "write" (binary box//write))))) -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (ruby.int 1)) - -(def: (process//schedule [milli-secondsO procedureO]) - Binary - (runtimeT.process//schedule milli-secondsO procedureO)) - -(def: process-procs - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary process//schedule)) - ))) - ## [Bundles] (def: #export procedures Bundle @@ -441,5 +424,4 @@ (dict.merge array-procs) (dict.merge io-procs) (dict.merge box-procs) - (dict.merge process-procs) ))) 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 32ab5b10c..02de3dc7b 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux @@ -230,19 +230,6 @@ Runtime (format @@box//write)) -(runtime: (process//schedule milli-seconds procedure) - (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 - @@process//schedule) - (def: runtime Runtime (format runtime//lux "\n" @@ -251,7 +238,6 @@ runtime//text "\n" runtime//array "\n" runtime//box "\n" - runtime//process "\n" )) (def: #export artifact Text (format prefix ".rb")) -- cgit v1.2.3