aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r--new-luxc/source/luxc/lang/host.jvm.lux1
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux18
-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
5 files changed, 128 insertions, 35 deletions
diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux
index 4b2dced82..f22bf3302 100644
--- a/new-luxc/source/luxc/lang/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/host.jvm.lux
@@ -182,4 +182,5 @@
(def: #export runtime-class Text "LuxRuntime")
(def: #export function-class Text "LuxFunction")
+(def: #export runnable-class Text "LuxRunnable")
(def: #export unit Text "\u0000")
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 685043b83..efef6084c 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
@@ -398,7 +398,7 @@
## [[IO]]
(def: (io//log messageJS)
Unary
- (void (format "console.log(" messageJS ")")))
+ (void (format runtimeT.io//log "(" messageJS ")")))
(def: (io//error messageJS)
Unary
@@ -425,7 +425,7 @@
(def: (atom//read atomJS)
Unary
- (format atomJS "." runtimeT.atom-field))
+ (format (self-contained atomJS) "." runtimeT.atom-field))
(def: (atom//compare-and-swap [atomJS oldJS newJS])
Trinary
diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
index 8c33b2a82..70f648be1 100644
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
@@ -1018,15 +1018,13 @@
(runtime: text//char "textChar"
(format "(function " @ "(text,idx) {"
- "var result = text.charAt(idx.L);"
- (format "if(result === '') {"
+ "var result = text.charCodeAt(idx.L);"
+ (format "if(result === NaN) {"
(format "return " none ";")
"}"
"else {"
- (format "return " (some "{'C':result}") ";")
+ (format "return " (some (format int//from-number "(result)")) ";")
"}")
- "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');"
- "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);"
"})"))
(runtime: text//hash "textHash"
@@ -1076,6 +1074,13 @@
__array//put
__array//remove))
+(runtime: io//log "log"
+ (format "(function " @ "(message) {"
+ "if(typeof console !== \"undefined\" && console.log) { console.log(message); }"
+ "else if(typeof print !== \"undefined\") { print(message); }"
+ "return " unit ";"
+ "})"))
+
(runtime: io//error "error"
(format "(function " @ "(message) {"
"throw new Error(message);"
@@ -1083,7 +1088,8 @@
(def: runtime//io
Runtime
- (format __io//error))
+ (format __io//log
+ __io//error))
(def: #export atom-field Text "V")
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])))