aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux41
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux99
2 files changed, 113 insertions, 27 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 57455e1e1..5ce483730 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
@@ -434,29 +434,24 @@
)
(def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list)))
-(do-template [<name> <method>]
- [(def: (<name> [textI partI startI])
- Trinary
- (<| $i.with-label (function [@not-found])
- $i.with-label (function [@end])
- (|>> textI ($i.CHECKCAST "java.lang.String")
- partI ($i.CHECKCAST "java.lang.String")
- startI jvm-intI
- ($i.INVOKEVIRTUAL "java.lang.String" <method> index-method false)
- $i.DUP
- ($i.int -1)
- ($i.IF_ICMPEQ @not-found)
- lux-intI
- runtimeT.someI
- ($i.GOTO @end)
- ($i.label @not-found)
- $i.POP
- runtimeT.noneI
- ($i.label @end))))]
-
- [text//index "indexOf"]
- [text//last-index "lastIndexOf"]
- )
+(def: (text//index [textI partI startI])
+ Trinary
+ (<| $i.with-label (function [@not-found])
+ $i.with-label (function [@end])
+ (|>> textI ($i.CHECKCAST "java.lang.String")
+ partI ($i.CHECKCAST "java.lang.String")
+ startI jvm-intI
+ ($i.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method false)
+ $i.DUP
+ ($i.int -1)
+ ($i.IF_ICMPEQ @not-found)
+ lux-intI
+ runtimeT.someI
+ ($i.GOTO @end)
+ ($i.label @not-found)
+ $i.POP
+ runtimeT.noneI
+ ($i.label @end))))
## [[Math]]
(def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list)))
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 87a47f338..2cd1c75a9 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -26,6 +26,8 @@
(def: #export $Datum $.Type $Object)
(def: #export $Function $.Type ($t.class hostL.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
@@ -549,6 +551,69 @@
$i.ARETURN)))
)))
+(def: process-methods
+ $.Def
+ (let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor"
+ executorT ($t.class executor-class (list))
+ executor-field "executor"
+ endI (|>> ($i.string hostL.unit)
+ $i.ARETURN)
+ runnableI (: (-> $.Inst $.Inst)
+ (function [functionI]
+ (|>> ($i.NEW hostL.runnable-class)
+ $i.DUP
+ functionI
+ ($i.INVOKESPECIAL hostL.runnable-class "<init>" ($t.method (list $Function) #.None (list)) false))))
+ threadI (: (-> $.Inst $.Inst)
+ (function [runnableI]
+ (|>> ($i.NEW "java.lang.Thread")
+ $i.DUP
+ runnableI
+ ($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)
+ ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false))
+ executorI (|>> ($i.NEW executor-class)
+ $i.DUP
+ concurrency-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)
+ immediacy-checkI (|>> delayI
+ ($i.long 0)
+ $i.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 ($i.GETSTATIC hostL.runtime-class executor-field executorT)
+ schedule-laterI (|>> executorI
+ (runnableI ($i.ALOAD +2))
+ delayI
+ ($i.GETSTATIC time-unit-class "MILLISECONDS" time-unitT)
+ ($i.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) false))
+ schedule-immediatelyI (|>> executorI
+ (runnableI ($i.ALOAD +2))
+ ($i.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) false))]
+ (<| $i.with-label (function [@immediately])
+ (|>> immediacy-checkI
+ ($i.IFEQ @immediately)
+ schedule-laterI
+ endI
+ ($i.label @immediately)
+ schedule-immediatelyI
+ endI))))
+ )))
+
(def: translate-runtime
(Meta commonT.Bytecode)
(do macro.Monad<Meta>
@@ -560,7 +625,8 @@
deg-methods
text-methods
pm-methods
- io-methods))]
+ io-methods
+ process-methods))]
_ (commonT.store-class hostL.runtime-class bytecode)]
(wrap bytecode)))
@@ -595,9 +661,34 @@
_ (commonT.store-class hostL.function-class bytecode)]
(wrap bytecode)))
+(def: translate-runnable
+ (Meta commonT.Bytecode)
+ (do macro.Monad<Meta>
+ [_ (wrap [])
+ #let [procedure-field "procedure"
+ bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.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))
+ (|>> ($i.ALOAD +0)
+ ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) false)
+ ($i.ALOAD +0)
+ ($i.ALOAD +1)
+ ($i.PUTFIELD hostL.runnable-class procedure-field $Function)
+ $i.RETURN))
+ ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list))
+ (|>> ($i.ALOAD +0)
+ ($i.GETFIELD hostL.runnable-class procedure-field $Function)
+ $i.NULL
+ ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) false)
+ $i.RETURN))
+ ))]
+ _ (commonT.store-class hostL.runnable-class bytecode)]
+ (wrap bytecode)))
+
(def: #export translate
- (Meta [commonT.Bytecode commonT.Bytecode])
+ (Meta [commonT.Bytecode commonT.Bytecode commonT.Bytecode])
(do macro.Monad<Meta>
[runtime-bc translate-runtime
- function-bc translate-function]
- (wrap [runtime-bc function-bc])))
+ function-bc translate-function
+ runnable-bc translate-runnable]
+ (wrap [runtime-bc function-bc runnable-bc])))