Falling back to using the old method of JVM generation while I properly debug and optimize the new one.

9 files changed, 314 insertions, 53 deletions

diff --git a/luxc/src/lux/compiler/jvm/function.clj b/luxc/src/lux/compiler/jvm/function.clj
index 14ad9884f..551f0851c 100644
--- a/luxc/src/lux/compiler/jvm/function.clj
+++ b/luxc/src/lux/compiler/jvm/function.clj
@@ -164,7 +164,6 @@
           $default (new Label)
           $labels* (map (fn [_] (new Label)) (repeat num-partials nil))
           $labels (vec (concat $labels* (list $default)))
-          $end (new Label)
           method-writer (.visitMethod class-writer (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STRICT) &&/apply-method (&&/apply-signature +degree+) nil nil)
           frame-locals (to-array (list class-name "java/lang/Object" "java/lang/Object"))
           frame-stack (to-array [Opcodes/INTEGER])
@@ -186,7 +185,7 @@
                   (consecutive-args 1 +degree+)
                   (fill-nulls! (- (- num-partials +degree+) stage))
                   (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (function-<init>-signature env arity))
-                  (.visitJumpInsn Opcodes/GOTO $end))
+                  (.visitInsn Opcodes/ARETURN))
                 (->> (cond (= stage arity-over-extent)
                            (doto method-writer
                              (.visitLabel $label)
@@ -197,7 +196,7 @@
                                  (->> (dotimes [idx stage])))
                              (consecutive-args 1 +degree+)
                              (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (function-impl-signature arity))
-                             (.visitJumpInsn Opcodes/GOTO $end))
+                             (.visitInsn Opcodes/ARETURN))
 
                            (> stage arity-over-extent)
                            (let [args-to-completion (- arity stage)
@@ -211,12 +210,10 @@
                                (consecutive-args 1 args-to-completion)
                                (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (function-impl-signature arity))
                                (consecutive-applys (+ 1 args-to-completion) args-left)
-                               (.visitJumpInsn Opcodes/GOTO $end)))
+                               (.visitInsn Opcodes/ARETURN)))
 
                            :else)
                      (doseq [[stage $label] (map vector (range arity) $labels)])))
-            (.visitLabel $end)
-            (.visitInsn Opcodes/ARETURN)
             (.visitMaxs 0 0)
             (.visitEnd))
         (return nil)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
new file mode 100644
index 000000000..fccbd14bf
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -0,0 +1,154 @@
+(.module:
+  [lux (#- Definition)
+   ["." host (#+ import: do-to object)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    pipe
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]
+    ["." io (#+ IO io)]
+    [concurrency
+     ["." atom (#+ Atom atom)]]]
+   [data
+    [binary (#+ Binary)]
+    ["." product]
+    ["." text ("#@." hash)
+     ["%" format (#+ format)]]
+    [collection
+     ["." array]
+     ["." dictionary (#+ Dictionary)]]]
+   [target
+    [jvm
+     ["." loader (#+ Library)]
+     ["." type
+      ["." descriptor]]]]
+   [tool
+    [compiler
+     ["." name]]]]
+  [///
+   [host
+    ["." jvm (#+ Inst Definition Host State)
+     ["." def]
+     ["." inst]]]]
+  )
+
+(import: org/objectweb/asm/Label)
+
+(import: java/lang/reflect/Field
+  (get [#? Object] #try #? Object))
+
+(import: (java/lang/Class a)
+  (getField [String] #try Field))
+
+(import: java/lang/Object
+  (getClass [] (Class Object)))
+
+(import: java/lang/ClassLoader)
+
+(type: #export ByteCode Binary)
+
+(def: #export value-field Text "_value")
+(def: #export $Value (type.class "java.lang.Object" (list)))
+
+(exception: #export (cannot-load {class Text} {error Text})
+  (exception.report
+   ["Class" class]
+   ["Error" error]))
+
+(exception: #export (invalid-field {class Text} {field Text} {error Text})
+  (exception.report
+   ["Class" class]
+   ["Field" field]
+   ["Error" error]))
+
+(exception: #export (invalid-value {class Text})
+  (exception.report
+   ["Class" class]))
+
+(def: (class-value class-name class)
+  (-> Text (Class Object) (Try Any))
+  (case (Class::getField ..value-field class)
+    (#try.Success field)
+    (case (Field::get #.None field)
+      (#try.Success ?value)
+      (case ?value
+        (#.Some value)
+        (#try.Success value)
+        
+        #.None
+        (exception.throw invalid-value class-name))
+      
+      (#try.Failure error)
+      (exception.throw cannot-load [class-name error]))
+    
+    (#try.Failure error)
+    (exception.throw invalid-field [class-name ..value-field error])))
+
+(def: class-path-separator ".")
+
+(def: (evaluate! library loader eval-class valueI)
+  (-> Library ClassLoader Text Inst (Try [Any Definition]))
+  (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class)
+        bytecode (def.class #jvm.V1_6
+                            #jvm.Public jvm.noneC
+                            bytecode-name
+                            (list) $Value
+                            (list)
+                            (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
+                                            ..value-field ..$Value)
+                                 (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
+                                             "<clinit>"
+                                             (type.method [(list) type.void (list)])
+                                             (|>> valueI
+                                                  (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value)
+                                                  inst.RETURN))))]
+    (io.run (do (try.with io.monad)
+              [_ (loader.store eval-class bytecode library)
+               class (loader.load eval-class loader)
+               value (:: io.monad wrap (class-value eval-class class))]
+              (wrap [value
+                     [eval-class bytecode]])))))
+
+(def: (execute! library loader temp-label [class-name class-bytecode])
+  (-> Library ClassLoader Text Definition (Try Any))
+  (io.run (do (try.with io.monad)
+            [existing-class? (|> (atom.read library)
+                                 (:: io.monad map (dictionary.contains? class-name))
+                                 (try.lift io.monad)
+                                 (: (IO (Try Bit))))
+             _ (if existing-class?
+                 (wrap [])
+                 (loader.store class-name class-bytecode library))]
+            (loader.load class-name loader))))
+
+(def: (define! library loader [module name] valueI)
+  (-> Library ClassLoader Name Inst (Try [Text Any Definition]))
+  (let [class-name (format (text.replace-all .module-separator class-path-separator module)
+                           class-path-separator (name.normalize name)
+                           "___" (%.nat (text@hash name)))]
+    (do try.monad
+      [[value definition] (evaluate! library loader class-name valueI)]
+      (wrap [class-name value definition]))))
+
+(def: #export host
+  (IO Host)
+  (io (let [library (loader.new-library [])
+            loader (loader.memory library)]
+        (: Host
+           (structure
+            (def: (evaluate! temp-label valueI)
+              (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
+                (:: try.monad map product.left
+                    (..evaluate! library loader eval-class valueI))))
+            
+            (def: execute!
+              (..execute! library loader))
+            
+            (def: define!
+              (..define! library loader)))))))
+
+(def: #export $Variant (type.array ..$Value))
+(def: #export $Tuple (type.array ..$Value))
+(def: #export $Function (type.class "LuxFunction" (list)))
+(def: #export $Runtime (type.class "LuxRuntime" (list)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux
index 8b2a83526..6cd7f4f2f 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/common.lux
@@ -1,24 +1,25 @@
 (.module:
   [lux #*
-   [abstract
-    [monad (#+ do)]]
-   [control
-    ["." try (#+ Try)]
-    ["ex" exception (#+ exception:)]
-    ["." io]]
-   [data
-    [binary (#+ Binary)]
-    ["." text ("#/." hash)
-     format]
-    [collection
-     ["." dictionary (#+ Dictionary)]]]
-   ["." macro]
-   [host (#+ import:)]
-   [tool
-    [compiler
-     [reference (#+ Register)]
-     ["." name]
-     ["." phase]]]]
+   ## [abstract
+   ##  [monad (#+ do)]]
+   ## [control
+   ##  ["." try (#+ Try)]
+   ##  ["ex" exception (#+ exception:)]
+   ##  ["." io]]
+   ## [data
+   ##  [binary (#+ Binary)]
+   ##  ["." text ("#/." hash)
+   ##   format]
+   ##  [collection
+   ##   ["." dictionary (#+ Dictionary)]]]
+   ## ["." macro]
+   ## [host (#+ import:)]
+   ## [tool
+   ##  [compiler
+   ##   [reference (#+ Register)]
+   ##   ["." name]
+   ##   ["." phase]]]
+   ]
   ## [luxc
   ##  [lang
   ##   [host
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux
index 34a4c890e..7a4bbef4e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/function.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux
@@ -240,16 +240,12 @@
                                               (_.INVOKESPECIAL class "<init>" (init-method env function-arity))
                                               _.ARETURN))
                                        ))))
-                   _.fuse)
-        failureI (|>> (_.INVOKESTATIC //.$Runtime "apply_fail" (type.method [(list) type.void (list)]))
-                      _.NULL
-                      _.ARETURN)]
+                   _.fuse)]
     (def.method #$.Public $.noneM runtime.apply-method (runtime.apply-signature apply-arity)
                 (|>> get-amount-of-partialsI
                      (_.TABLESWITCH +0 (|> num-partials dec .int)
                                     @default @labels)
                      casesI
-                     failureI
                      ))))
 
 (def: #export with-environment
diff --git a/new-luxc/source/luxc/lang/translation/jvm/program.lux b/new-luxc/source/luxc/lang/translation/jvm/program.lux
new file mode 100644
index 000000000..7ac897009
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/program.lux
@@ -0,0 +1,82 @@
+(.module:
+  [lux #*
+   [target
+    [jvm
+     ["$t" type]]]]
+  [luxc
+   [lang
+    [host
+     ["_" jvm
+      ["$d" def]
+      ["$i" inst]]]
+    [translation
+     ["." jvm
+      ["." runtime]]]]])
+
+(def: #export class "LuxProgram")
+
+(def: ^Object ($t.class "java.lang.Object" (list)))
+
+(def: #export (program programI)
+  (-> _.Inst _.Definition)
+  (let [nilI runtime.noneI
+        num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
+        decI (|>> ($i.int +1) $i.ISUB)
+        headI (|>> $i.DUP
+                   ($i.ALOAD 0)
+                   $i.SWAP
+                   $i.AALOAD
+                   $i.SWAP
+                   $i.DUP_X2
+                   $i.POP)
+        pairI (|>> ($i.int +2)
+                   ($i.ANEWARRAY ..^Object)
+                   $i.DUP_X1
+                   $i.SWAP
+                   ($i.int +0)
+                   $i.SWAP
+                   $i.AASTORE
+                   $i.DUP_X1
+                   $i.SWAP
+                   ($i.int +1)
+                   $i.SWAP
+                   $i.AASTORE)
+        consI (|>> ($i.int +1)
+                   ($i.string "")
+                   $i.DUP2_X1
+                   $i.POP2
+                   runtime.variantI)
+        prepare-input-listI (<| $i.with-label (function (_ @loop))
+                                $i.with-label (function (_ @end))
+                                (|>> nilI
+                                     num-inputsI
+                                     ($i.label @loop)
+                                     decI
+                                     $i.DUP
+                                     ($i.IFLT @end)
+                                     headI
+                                     pairI
+                                     consI
+                                     $i.SWAP
+                                     ($i.GOTO @loop)
+                                     ($i.label @end)
+                                     $i.POP))
+        feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))
+        run-ioI (|>> ($i.CHECKCAST jvm.$Function)
+                     $i.NULL
+                     ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)))
+        main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list))))
+                              $t.void
+                              (list)])]
+    [..class
+     ($d.class #_.V1_6
+               #_.Public _.finalC
+               ..class
+               (list) ..^Object
+               (list)
+               (|>> ($d.method #_.Public _.staticM "main" main-type
+                               (|>> programI
+                                    prepare-input-listI
+                                    feed-inputsI
+                                    run-ioI
+                                    $i.RETURN))))]))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 2b2278cec..d802f7f32 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -25,22 +25,33 @@
      [phase
       ["." macro (#+ Expander)]
       [extension (#+ Phase Bundle Operation Handler Extender)
+       ["." bundle]
        ["." analysis #_
         ["#" jvm]]
        ["." directive #_
         ["#" jvm]]]
       ["." generation #_
        ["#" jvm/extension]
-       ["." jvm
-        ["." runtime (#+ Anchor Definition)]
-        ["#/." program]
+       ["." jvm #_
+        ## ["." runtime (#+ Anchor Definition)]
         ["." packager]
-        ["#/." host]]]]
+        ## ["#/." host]
+        ]]]
      [default
       ["." platform (#+ Platform)]]]]]
   [program
    ["/" compositor
-    ["/." cli]]])
+    ["/." cli]]]
+  [luxc
+   [lang
+    [host
+     ["_" jvm]]
+    [translation
+     ["." jvm
+      ["." runtime]
+      ["." expression]
+      ["#/." program]
+      ["translation" extension]]]]])
 
 (import: #long java/lang/reflect/Method
   (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
@@ -85,14 +96,18 @@
               apply-method))))
 
 (def: #export platform
-  (IO (Platform IO Anchor (Bytecode Any) Definition))
+  ## (IO (Platform IO Anchor (Bytecode Any) Definition))
+  (IO (Platform IO _.Anchor _.Inst _.Definition))
   (do io.monad
-    [host jvm/host.host]
+    [## host jvm/host.host
+     host jvm.host]
     (wrap {#platform.&monad io.monad
            #platform.&file-system file.system
            #platform.host host
-           #platform.phase jvm.generate
-           #platform.runtime runtime.generate})))
+           ## #platform.phase jvm.generate
+           #platform.phase expression.translate
+           ## #platform.runtime runtime.generate
+           #platform.runtime runtime.translate})))
 
 (def: extender
   Extender
@@ -132,8 +147,9 @@
                 ..expander
                 analysis.bundle
                 ..platform
-                generation.bundle
-                directive.bundle
+                ## generation.bundle
+                translation.bundle
+                bundle.empty
                 jvm/program.program
                 ..extender
                 service
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index d0952f71e..b34cd4242 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -32,7 +32,7 @@
      [encoding
       ["." name (#+ External)]]
      ["." type (#+ Type Argument Typed)
-      ["." category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)]
+      ["." category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
       ["." box]
       ["." descriptor]
       ["." signature]
@@ -44,8 +44,15 @@
   (|>> name.internal
        name.read))
 
-(def: signature (|>> type.signature signature.signature))
-(def: reflection (|>> type.reflection reflection.reflection))
+(def: signature
+  (All [category]
+    (-> (Type category) Text))
+  (|>> type.signature signature.signature))
+
+(def: reflection
+  (All [category]
+    (-> (Type (<| Return' Value' category)) Text))
+  (|>> type.reflection reflection.reflection))
 
 (template [<name> <class>]
   [(def: #export <name> .Type (#.Primitive <class> #.Nil))]
@@ -657,7 +664,9 @@
            )))))
 
 (def: (itself^ type)
-  (All [a] (-> (Type a) (Parser (Type a))))
+  (All [category]
+    (-> (Type (<| Return' Value' category))
+        (Parser (Type (<| Return' Value' category)))))
   (do <>.monad
     [_ (<c>.identifier! ["" (..reflection type)])]
     (wrap type)))
@@ -690,9 +699,15 @@
          (..array^ type^)
          ))))
 
+(def: void^
+  (Parser (Type Void))
+  (do <>.monad
+    [_ (<c>.identifier! ["" (reflection.reflection reflection.void)])]
+    (wrap type.void)))
+
 (def: (return^ imports type-vars)
   (-> Context (List (Type Var)) (Parser (Type Return)))
-  (<>.either (itself^ type.void)
+  (<>.either ..void^
              (..type^ imports type-vars)))
 
 (def: var^
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index bba140a7a..9092445c7 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -458,7 +458,7 @@
 
 (import: #long java/lang/Float)
 
-(template [<name> <type> <constructor> <constant> <ldc> <to-lux> <specializations>]
+(template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>]
   [(def: #export (<name> value)
      (-> <type> (Bytecode Any))
      (case (|> value <to-lux>)
@@ -473,7 +473,7 @@
              (..bytecode $0 $1 @_ _.ldc [index])
 
              (#try.Failure _)
-             (..bytecode $0 $1 @_ <ldc> [index])))))]
+             (..bytecode $0 $1 @_ <wide> [index])))))]
 
   [int I32 //constant.integer //constant/pool.integer _.ldc-w/integer
    (<| .int i32.i64)
@@ -485,13 +485,13 @@
     [+4 _.iconst-4]
     [+5 _.iconst-5])]
   [float java/lang/Float //constant.float //constant/pool.float _.ldc-w/float
-   host.float-to-double
+   (<| (:coerce Frac) host.float-to-double)
    ([+0.0 _.fconst-0]
     [+1.0 _.fconst-1]
     [+2.0 _.fconst-2])]
   )
 
-(template [<name> <type> <constructor> <constant> <ldc> <to-lux> <specializations>]
+(template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>]
   [(def: #export (<name> value)
      (-> <type> (Bytecode Any))
      (case (|> value <to-lux>)
@@ -501,7 +501,7 @@
        
        _ (do ..monad
            [index (..lift (<constant> (<constructor> value)))]
-           (..bytecode $0 $2 @_ <ldc> [index]))))]
+           (..bytecode $0 $2 @_ <wide> [index]))))]
 
   [long Int //constant.long //constant/pool.long _.ldc2-w/long
    (<|)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
index d06a5167c..d57dd6b50 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
@@ -184,8 +184,8 @@
   )
 
 (import: #long java/lang/Double
-  (#static MIN_VALUE java/lang/Double)
-  (#static MAX_VALUE java/lang/Double))
+  (#static MIN_VALUE double)
+  (#static MAX_VALUE double))
 
 (template [<name> <const>]
   [(def: (<name> _)