WIP: Fix new-luxc's JVM back-end.

1 files changed, 115 insertions, 112 deletions

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 0d37031e0..86fe53d1e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -1,19 +1,25 @@
 (.module:
-  lux
-  (lux (control monad)
-       (data text/format
-             (coll [list "list/" Functor<List>]))
-       [math]
-       [macro])
-  (luxc ["&" lang]
-        (lang [".L" host]
-              (host ["$" jvm]
-                    (jvm ["$t" type]
-                         ["$d" def]
-                         ["$i" inst]))
-              ["la" analysis]
-              ["ls" synthesis]))
-  (// [".T" common]))
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [data
+    [text
+     format]
+    [collection
+     [list ("list/" Functor<List>)]]]
+   ["." math]
+   [language
+    ["." compiler
+     [analysis (#+ Arity)]
+     ["." translation]]]]
+  [luxc
+   [lang
+    [host
+     ["$" jvm (#+ Inst Method Def Operation)
+      ["$t" type]
+      ["$d" def]
+      ["$i" inst]]]]]
+  ["." // (#+ ByteCode)])
 
 (def: $Object $.Type ($t.class "java.lang.Object" (list)))
 (def: $Object-Array $.Type ($t.array +1 $Object))
@@ -24,28 +30,28 @@
 (def: #export $Tag $.Type $t.int)
 (def: #export $Flag $.Type $Object)
 (def: #export $Datum $.Type $Object)
-(def: #export $Function $.Type ($t.class hostL.function-class (list)))
+(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
+  Inst
   (let [outI ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
         printI (function (_ method) ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))]
     (|>> outI ($i.string "LOG: ") (printI "print")
          outI $i.SWAP (printI "println"))))
 
 (def: variant-method
-  $.Method
+  Method
   ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list)))
 
 (def: #export variantI
-  $.Inst
-  ($i.INVOKESTATIC hostL.runtime-class "variant_make" variant-method #0))
+  Inst
+  ($i.INVOKESTATIC //.runtime-class "variant_make" variant-method #0))
 
 (def: #export leftI
-  $.Inst
+  Inst
   (|>> ($i.int 0)
        $i.NULL
        $i.DUP2_X1
@@ -53,24 +59,24 @@
        variantI))
 
 (def: #export rightI
-  $.Inst
+  Inst
   (|>> ($i.int 1)
        ($i.string "")
        $i.DUP2_X1
        $i.POP2
        variantI))
 
-(def: #export someI $.Inst rightI)
+(def: #export someI Inst rightI)
 
 (def: #export noneI
-  $.Inst
+  Inst
   (|>> ($i.int 0)
        $i.NULL
-       ($i.string hostL.unit)
+       ($i.string //.unit)
        variantI))
 
 (def: (try-methodI unsafeI)
-  (-> $.Inst $.Inst)
+  (-> Inst Inst)
   (<| $i.with-label (function (_ @from))
       $i.with-label (function (_ @to))
       $i.with-label (function (_ @handler))
@@ -85,7 +91,7 @@
            $i.ARETURN)))
 
 (def: #export string-concatI
-  $.Inst
+  Inst
   ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0))
 
 (def: #export partials-field Text "partials")
@@ -93,11 +99,11 @@
 (def: #export num-apply-variants Nat +8)
 
 (def: #export (apply-signature arity)
-  (-> ls.Arity $.Method)
+  (-> Arity Method)
   ($t.method (list.repeat arity $Object) (#.Some $Object) (list)))
 
 (def: adt-methods
-  $.Def
+  Def
   (let [store-tagI (|>> $i.DUP ($i.int 0) ($i.ILOAD +0) ($i.wrap #$.Int) $i.AASTORE)
         store-flagI (|>> $i.DUP ($i.int 1) ($i.ALOAD +1) $i.AASTORE)
         store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE)
@@ -115,7 +121,7 @@
                               on-null-objectI ($i.string "NULL")
                               arrayI (|>> ($i.ALOAD +0)
                                           ($i.CHECKCAST ($t.descriptor $Object-Array)))
-                              recurseI ($i.INVOKESTATIC hostL.runtime-class "force_text" force-textMT #0)
+                              recurseI ($i.INVOKESTATIC //.runtime-class "force_text" force-textMT #0)
                               force-elemI (|>> $i.DUP arrayI $i.SWAP $i.AALOAD recurseI)
                               swap2 (|>> $i.DUP2_X2 ## X,Y => Y,X,Y
                                          $i.POP2 ## Y,X,Y => Y,X
@@ -164,13 +170,13 @@
                          $i.ARETURN)))))
 
 (def: #export force-textI
-  $.Inst
-  ($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
+  Inst
+  ($i.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
 
-(def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0)))
+(def: frac-shiftI Inst ($i.double (math.pow 32.0 2.0)))
 
 (def: frac-methods
-  $.Def
+  Def
   (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list))
                   (try-methodI
                    (|>> ($i.ALOAD +0)
@@ -178,10 +184,10 @@
                         ($i.wrap #$.Double))))
        ))
 
-(def: clz-method $.Method ($t.method (list $t.long) (#.Some $t.int) (list)))
+(def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list)))
 
 (def: text-methods
-  $.Def
+  Def
   (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list))
                   (try-methodI
                    (|>> ($i.ALOAD +0)
@@ -198,7 +204,7 @@
        ))
 
 (def: pm-methods
-  $.Def
+  Def
   (let [tuple-sizeI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH)
         tuple-elemI (|>> ($i.ALOAD +0) ($i.ILOAD +1) $i.AALOAD)
         expected-last-sizeI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD)
@@ -245,10 +251,10 @@
                         $i.with-label (function (_ @further))
                         $i.with-label (function (_ @shorten))
                         $i.with-label (function (_ @wrong))
-                        (let [variant-partI (: (-> Nat $.Inst)
+                        (let [variant-partI (: (-> Nat Inst)
                                                (function (_ idx)
                                                  (|>> ($i.int (.int idx)) $i.AALOAD)))
-                              tagI (: $.Inst
+                              tagI (: Inst
                                       (|>> (variant-partI +0) ($i.unwrap #$.Int)))
                               flagI (variant-partI +1)
                               datumI (variant-partI +2)
@@ -332,7 +338,7 @@
          )))
 
 (def: io-methods
-  $.Def
+  Def
   (let [string-writerI (|>> ($i.NEW "java.io.StringWriter")
                             $i.DUP
                             ($i.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0))
@@ -352,7 +358,7 @@
                              ($i.label @from)
                              ($i.ALOAD +0)
                              $i.NULL
-                             ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) #0)
+                             ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0)
                              rightI
                              $i.ARETURN
                              ($i.label @to)
@@ -367,19 +373,19 @@
          )))
 
 (def: process-methods
-  $.Def
+  Def
   (let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor"
         executorT ($t.class executor-class (list))
         executor-field "executor"
-        endI (|>> ($i.string hostL.unit)
+        endI (|>> ($i.string //.unit)
                   $i.ARETURN)
-        runnableI (: (-> $.Inst $.Inst)
+        runnableI (: (-> Inst Inst)
                      (function (_ functionI)
-                       (|>> ($i.NEW hostL.runnable-class)
+                       (|>> ($i.NEW //.runnable-class)
                             $i.DUP
                             functionI
-                            ($i.INVOKESPECIAL hostL.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0))))
-        threadI (: (-> $.Inst $.Inst)
+                            ($i.INVOKESPECIAL //.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0))))
+        threadI (: (-> Inst Inst)
                    (function (_ runnableI)
                      (|>> ($i.NEW "java.lang.Thread")
                           $i.DUP
@@ -394,7 +400,7 @@
                                          parallelism-levelI
                                          ($i.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) #0))]
                       (|>> executorI
-                           ($i.PUTSTATIC hostL.runtime-class executor-field executorT)
+                           ($i.PUTSTATIC //.runtime-class executor-field executorT)
                            $i.RETURN)))
          ($d.method #$.Public $.staticM "schedule"
                     ($t.method (list $t.long $Function) (#.Some $Object) (list))
@@ -405,7 +411,7 @@
                           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)
+                          executorI ($i.GETSTATIC //.runtime-class executor-field executorT)
                           schedule-laterI (|>> executorI
                                                (runnableI ($i.ALOAD +2))
                                                delayI
@@ -425,77 +431,74 @@
          )))
 
 (def: translate-runtime
-  (Meta commonT.Bytecode)
-  (do macro.Monad<Meta>
-    [_ (wrap [])
-     #let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list)
-                              (|>> adt-methods
-                                   frac-methods
-                                   text-methods
-                                   pm-methods
-                                   io-methods
-                                   process-methods))]
-     _ (commonT.store-class hostL.runtime-class bytecode)]
-    (wrap bytecode)))
+  (Operation ByteCode)
+  (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list)
+                           (|>> adt-methods
+                                frac-methods
+                                text-methods
+                                pm-methods
+                                io-methods
+                                process-methods))]
+    (do compiler.Monad<Operation>
+      [_ (translation.execute! [//.runtime-class bytecode])]
+      (wrap bytecode))))
 
 (def: translate-function
-  (Meta commonT.Bytecode)
-  (do macro.Monad<Meta>
-    [_ (wrap [])
-     #let [applyI (|> (list.n/range +2 num-apply-variants)
-                      (list/map (function (_ arity)
-                                  ($d.method #$.Public $.noneM apply-method (apply-signature arity)
-                                             (let [preI (|> (list.n/range +0 (dec arity))
-                                                            (list/map $i.ALOAD)
-                                                            $i.fuse)]
-                                               (|>> preI
-                                                    ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (dec arity)) #0)
-                                                    ($i.CHECKCAST hostL.function-class)
-                                                    ($i.ALOAD arity)
-                                                    ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) #0)
-                                                    $i.ARETURN)))))
-                      (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1)))
-                      $d.fuse)
-           bytecode ($d.abstract #$.V1_6 #$.Public $.noneC hostL.function-class (list) ["java.lang.Object" (list)] (list)
-                                 (|>> ($d.field #$.Public $.finalF partials-field $t.int)
-                                      ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
-                                                 (|>> ($i.ALOAD +0)
-                                                      ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
-                                                      ($i.ALOAD +0)
-                                                      ($i.ILOAD +1)
-                                                      ($i.PUTFIELD hostL.function-class partials-field $t.int)
-                                                      $i.RETURN))
-                                      applyI))]
-     _ (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))
+  (Operation ByteCode)
+  (let [applyI (|> (list.n/range +2 num-apply-variants)
+                   (list/map (function (_ arity)
+                               ($d.method #$.Public $.noneM apply-method (apply-signature arity)
+                                          (let [preI (|> (list.n/range +0 (dec arity))
+                                                         (list/map $i.ALOAD)
+                                                         $i.fuse)]
+                                            (|>> preI
+                                                 ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0)
+                                                 ($i.CHECKCAST //.function-class)
+                                                 ($i.ALOAD arity)
+                                                 ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0)
+                                                 $i.ARETURN)))))
+                   (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1)))
+                   $d.fuse)
+        bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list)
+                              (|>> ($d.field #$.Public $.finalF partials-field $t.int)
+                                   ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
                                               (|>> ($i.ALOAD +0)
                                                    ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
                                                    ($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) #0)
+                                                   ($i.ILOAD +1)
+                                                   ($i.PUTFIELD //.function-class partials-field $t.int)
                                                    $i.RETURN))
-                                   ))]
-     _ (commonT.store-class hostL.runnable-class bytecode)]
-    (wrap bytecode)))
+                                   applyI))]
+    (do compiler.Monad<Operation>
+      [_ (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))
+                                           (|>> ($i.ALOAD +0)
+                                                ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
+                                                ($i.ALOAD +0)
+                                                ($i.ALOAD +1)
+                                                ($i.PUTFIELD //.runnable-class procedure-field $Function)
+                                                $i.RETURN))
+                                ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list))
+                                           (|>> ($i.ALOAD +0)
+                                                ($i.GETFIELD //.runnable-class procedure-field $Function)
+                                                $i.NULL
+                                                ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0)
+                                                $i.RETURN))
+                                ))]
+    (do compiler.Monad<Operation>
+      [_ (translation.execute! [//.runnable-class bytecode])]
+      (wrap bytecode))))
 
 (def: #export translate
-  (Meta [commonT.Bytecode commonT.Bytecode commonT.Bytecode])
-  (do macro.Monad<Meta>
+  (Operation [ByteCode ByteCode ByteCode])
+  (do compiler.Monad<Operation>
     [runtime-bc translate-runtime
      function-bc translate-function
      runnable-bc translate-runnable]