diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux | 23 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | 92 |
2 files changed, 4 insertions, 111 deletions
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<Text>) - (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 "<init>" ($t.method (list $Function) #.None (list)) #0)))) - threadI (: (-> Inst Inst) - (function (_ runnableI) - (|>> (_.NEW "java.lang.Thread") - _.DUP - runnableI - (_.INVOKESPECIAL "java.lang.Thread" "<init>" ($t.method (list $Runnable) #.None (list)) #0))))] - (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) executor-field executorT) - ($d.method #$.Public $.staticM "<clinit>" ($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 "<init>" ($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<Operation> [_ (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 "<init>" ($t.method (list $Function) #.None (list)) - (|>> (_.ALOAD 0) - (_.INVOKESPECIAL "java.lang.Object" "<init>" ($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<Operation> - [_ (translation.execute! [//.runnable-class bytecode])] - (wrap bytecode)))) - (def: #export translate - (Operation [ByteCode ByteCode ByteCode]) + (Operation [ByteCode ByteCode]) (do phase.Monad<Operation> [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]))) |