Some fixes for the scripting languages.

+ Small optimizations for pattern-matching generation.

2 files changed, 49 insertions, 13 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux
index 63d440c72..898c211f4 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux
@@ -150,6 +150,40 @@
                                          #0)
                          pushI))
 
+    ## Extra optimization
+    (^ (synthesis.path/seq
+        (synthesis.member/left 0)
+        (synthesis.!bind-top register thenP)))
+    (do phase.monad
+      [then! (path' phase stack-depth @else @end thenP)]
+      (wrap (|>> peekI
+                 (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+                 (_.int +0)
+                 _.AALOAD
+                 (_.ASTORE register)
+                 then!)))
+
+    ## Extra optimization
+    (^template [<pm> <getter>]
+      (^ (synthesis.path/seq
+          (<pm> lefts)
+          (synthesis.!bind-top register thenP)))
+      (do phase.monad
+        [then! (path' phase stack-depth @else @end thenP)]
+        (wrap (|>> peekI
+                   (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+                   (_.int (.int lefts))
+                   (_.INVOKESTATIC //.runtime-class
+                                   <getter>
+                                   ($t.method (list runtime.$Tuple $t.int)
+                                              (#.Some $Object)
+                                              (list))
+                                   #0)
+                   (_.ASTORE register)
+                   then!))))
+    ([synthesis.member/left  "tuple_left"]
+     [synthesis.member/right "tuple_right"])
+
     (#synthesis.Alt leftP rightP)
     (do phase.monad
       [@alt-else _.make-label
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 9f5627ee3..4d6d63835 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #*
-   ["@" host (#+ import:)]
+   ["@" target]
+   ["." host (#+ import:)]
    [abstract
     [monad (#+ do)]]
    [control
@@ -39,8 +40,8 @@
       ["." runtime]
       ["." expression]
       [procedure
-       ["." common]
-       ["." host]]]]]])
+       [".E" common]
+       [".E" host]]]]]])
 
 (import: #long java/lang/reflect/Method
   (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
@@ -53,13 +54,13 @@
 
 (def: _object-class
   (java/lang/Class java/lang/Object)
-  (@.class-for java/lang/Object))
+  (host.class-for java/lang/Object))
 
 (def: _apply-args
   (Array (java/lang/Class java/lang/Object))
-  (|> (@.array (java/lang/Class java/lang/Object) 2)
-      (@.array-write 0 _object-class)
-      (@.array-write 1 _object-class)))
+  (|> (host.array (java/lang/Class java/lang/Object) 2)
+      (host.array-write 0 _object-class)
+      (host.array-write 1 _object-class)))
 
 (def: #export (expander macro inputs lux)
   Expander
@@ -71,9 +72,9 @@
     (:coerce (Error (Error [Lux (List Code)]))
              (java/lang/reflect/Method::invoke
               (:coerce java/lang/Object macro)
-              (|> (@.array java/lang/Object 2)
-                  (@.array-write 0 (:coerce java/lang/Object inputs))
-                  (@.array-write 1 (:coerce java/lang/Object lux)))
+              (|> (host.array java/lang/Object 2)
+                  (host.array-write 0 (:coerce java/lang/Object inputs))
+                  (host.array-write 1 (:coerce java/lang/Object lux)))
               apply-method))))
 
 (def: #export jvm
@@ -153,11 +154,12 @@
 
 (def: #export bundle
   _.Bundle
-  (dictionary.merge common.bundle
-                    host.bundle))
+  (dictionary.merge commonE.bundle
+                    hostE.bundle))
 
 (program: [{service /cli.service}]
-  (/.compiler ..expander
+  (/.compiler @.jvm
+              ..expander
               ..jvm
               ..bundle
               jvmS.bundle