- Added all the missing tests for translation of common procedures.

- Implemented some missing process functionality in the JVM runtime.
- Minor bug fixes.

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])))