Fixes for pattern-matching/case synthesis & translation.

2 files changed, 49 insertions, 106 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index e11187787..ac7ab3b83 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -57,9 +57,8 @@
                                   (list))
                        #0)))
 
-(def: (path' translate stack-depth @else @end path)
-  (-> (-> Synthesis (Operation Inst))
-      Nat Label Label Path (Operation Inst))
+(def: (path' phase stack-depth @else @end path)
+  (-> Phase Nat Label Label Path (Operation Inst))
   (.case path
     #synthesis.Pop
     (operation/wrap popI)
@@ -101,15 +100,39 @@
     
     (#synthesis.Then bodyS)
     (do phase.Monad<Operation>
-      [bodyI (translate bodyS)]
+      [bodyI (phase bodyS)]
       (wrap (|>> (pop-altI stack-depth)
                  bodyI
                  (_.GOTO @end))))
     
     
-    (^template [<pattern> <method>]
+    (^template [<pattern> <flag> <prepare>]
       (^ (<pattern> idx))
-      (operation/wrap (.case idx
+      (operation/wrap (<| _.with-label (function (_ @success))
+                          _.with-label (function (_ @fail))
+                          (|>> peekI
+                               (_.CHECKCAST ($t.descriptor runtime.$Variant))
+                               (_.int (.int (<prepare> idx)))
+                               <flag>
+                               (_.INVOKESTATIC //.runtime-class "pm_variant"
+                                               ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
+                                                          (#.Some runtime.$Datum)
+                                                          (list))
+                                               #0)
+                               _.DUP
+                               (_.IFNULL @fail)
+                               (_.GOTO @success)
+                               (_.label @fail)
+                               _.POP
+                               (_.GOTO @else)
+                               (_.label @success)
+                               pushI))))
+    ([synthesis.side/left  _.NULL        .id]
+     [synthesis.side/right (_.string "") .inc])
+
+    (^template [<pattern> <method> <prepare>]
+      (^ (<pattern> idx))
+      (operation/wrap (.case (<prepare> idx)
                         0
                         (|>> peekI
                              (_.CHECKCAST ($t.descriptor runtime.$Tuple))
@@ -128,39 +151,14 @@
                                                         (list))
                                              #0)
                              pushI))))
-    ([synthesis.member/left  "pm_left"]
-     [synthesis.member/right "pm_right"])
-
-    (^template [<pattern> <flag> <mod>]
-      (^ (<pattern> idx))
-      (.let [idx (<mod> idx)]
-        (operation/wrap (<| _.with-label (function (_ @success))
-                            _.with-label (function (_ @fail))
-                            (|>> peekI
-                                 (_.CHECKCAST ($t.descriptor runtime.$Variant))
-                                 (_.int (.int idx))
-                                 <flag>
-                                 (_.INVOKESTATIC //.runtime-class "pm_variant"
-                                                 ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
-                                                            (#.Some runtime.$Datum)
-                                                            (list))
-                                                 #0)
-                                 _.DUP
-                                 (_.IFNULL @fail)
-                                 (_.GOTO @success)
-                                 (_.label @fail)
-                                 _.POP
-                                 (_.GOTO @else)
-                                 (_.label @success)
-                                 pushI)))))
-    ([synthesis.side/left  _.NULL        .id]
-     [synthesis.side/right (_.string "") .inc])
+    ([synthesis.member/left  "pm_left"  id]
+     [synthesis.member/right "pm_right" inc])
 
     (#synthesis.Alt leftP rightP)
     (do phase.Monad<Operation>
       [@alt-else _.make-label
-       leftI (path' translate (inc stack-depth) @alt-else @end leftP)
-       rightI (path' translate stack-depth @else @end rightP)]
+       leftI (path' phase (inc stack-depth) @alt-else @end leftP)
+       rightI (path' phase stack-depth @else @end rightP)]
       (wrap (|>> _.DUP
                  leftI
                  (_.label @alt-else)
@@ -169,17 +167,17 @@
     
     (#synthesis.Seq leftP rightP)
     (do phase.Monad<Operation>
-      [leftI (path' translate stack-depth @else @end leftP)
-       rightI (path' translate stack-depth @else @end rightP)]
+      [leftI (path' phase stack-depth @else @end leftP)
+       rightI (path' phase stack-depth @else @end rightP)]
       (wrap (|>> leftI
                  rightI)))
     ))
 
-(def: (path translate path @end)
+(def: (path phase path @end)
   (-> Phase Path Label (Operation Inst))
   (do phase.Monad<Operation>
     [@else _.make-label
-     pathI (..path' translate 1 @else @end path)]
+     pathI (..path' phase 1 @else @end path)]
     (wrap (|>> pathI
                (_.label @else)
                _.POP
@@ -190,12 +188,12 @@
                _.NULL
                (_.GOTO @end)))))
 
-(def: #export (if translate testS thenS elseS)
+(def: #export (if phase testS thenS elseS)
   (-> Phase Synthesis Synthesis Synthesis (Operation Inst))
   (do phase.Monad<Operation>
-    [testI (translate testS)
-     thenI (translate thenS)
-     elseI (translate elseS)]
+    [testI (phase testS)
+     thenI (phase thenS)
+     elseI (phase elseS)]
     (wrap (<| _.with-label (function (_ @else))
               _.with-label (function (_ @end))
               (|>> testI
@@ -207,21 +205,21 @@
                    elseI
                    (_.label @end))))))
 
-(def: #export (let translate inputS register exprS)
+(def: #export (let phase inputS register exprS)
   (-> Phase Synthesis Nat Synthesis (Operation Inst))
   (do phase.Monad<Operation>
-    [inputI (translate inputS)
-     exprI (translate exprS)]
+    [inputI (phase inputS)
+     exprI (phase exprS)]
     (wrap (|>> inputI
                (_.ASTORE register)
                exprI))))
 
-(def: #export (case translate valueS path)
+(def: #export (case phase valueS path)
   (-> Phase Synthesis Path (Operation Inst))
   (do phase.Monad<Operation>
     [@end _.make-label
-     valueI (translate valueS)
-     pathI (..path translate path @end)]
+     valueI (phase valueS)
+     pathI (..path phase path @end)]
     (wrap (|>> _.NULL
                valueI
                pushI
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 c92ab1026..20c31bd5d 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -106,59 +106,8 @@
   Def
   (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE)
         store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
-        store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)
-        force-textMT ($t.method (list $Object) (#.Some $String) (list))]
-    (|>> ($d.method #$.Public $.staticM "force_text" force-textMT
-                    (<| _.with-label (function (_ @is-null))
-                        _.with-label (function (_ @normal-object))
-                        _.with-label (function (_ @array-loop))
-                        _.with-label (function (_ @within-bounds))
-                        _.with-label (function (_ @is-first))
-                        _.with-label (function (_ @elem-end))
-                        _.with-label (function (_ @fold-end))
-                        (let [on-normal-objectI (|>> (_.ALOAD 0)
-                                                     (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0))
-                              on-null-objectI (_.string "NULL")
-                              arrayI (|>> (_.ALOAD 0)
-                                          (_.CHECKCAST ($t.descriptor $Object-Array)))
-                              recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0)
-                              force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI)
-                              swap2 (|>> _.DUP2_X2 ## X,Y => Y,X,Y
-                                         _.POP2 ## Y,X,Y => Y,X
-                                         )
-                              add-spacingI (|>> (_.string ", ") _.SWAP string-concatI)
-                              merge-with-totalI (|>> _.DUP_X2 _.POP ## TSIP => TPSI
-                                                     swap2 ## TPSI => SITP
-                                                     string-concatI ## SITP => SIT
-                                                     _.DUP_X2 _.POP ## SIT => TSI
-                                                     )
-                              foldI (|>> _.DUP ## TSI => TSII
-                                         (_.IFEQ @is-first) ## TSI
-                                         force-elemI add-spacingI merge-with-totalI (_.GOTO @elem-end)
-                                         (_.label @is-first) ## TSI
-                                         force-elemI merge-with-totalI
-                                         (_.label @elem-end) ## TSI
-                                         )
-                              inc-idxI (|>> (_.int +1) _.IADD)
-                              on-array-objectI (|>> (_.string "[") ## T
-                                                    arrayI _.ARRAYLENGTH ## TS
-                                                    (_.int +0) ## TSI
-                                                    (_.label @array-loop) ## TSI
-                                                    _.DUP2
-                                                    (_.IF_ICMPGT @within-bounds) ## TSI
-                                                    _.POP2 (_.string "]") string-concatI (_.GOTO @fold-end)
-                                                    (_.label @within-bounds)
-                                                    foldI inc-idxI (_.GOTO @array-loop)
-                                                    (_.label @fold-end))])
-                        (|>> (_.ALOAD 0)
-                             (_.IFNULL @is-null)
-                             (_.ALOAD 0)
-                             (_.INSTANCEOF ($t.descriptor $Object-Array))
-                             (_.IFEQ @normal-object)
-                             on-array-objectI _.ARETURN
-                             (_.label @normal-object) on-normal-objectI _.ARETURN
-                             (_.label @is-null) on-null-objectI _.ARETURN)))
-         ($d.method #$.Public $.staticM "variant_make"
+        store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
+    (|>> ($d.method #$.Public $.staticM "variant_make"
                     ($t.method (list $t.int $Object $Object)
                                (#.Some $Variant)
                                (list))
@@ -169,10 +118,6 @@
                          store-valueI
                          _.ARETURN)))))
 
-(def: #export force-textI
-  Inst
-  (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
-
 (def: frac-shiftI Inst (_.double (math.pow +32.0 +2.0)))
 
 (def: frac-methods