- Changed the format for variants in JS.

- Fixed a bug when decoding fracs.

4 files changed, 58 insertions, 20 deletions

diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux
index 680439355..a28d9c3db 100644
--- a/new-luxc/source/luxc/lang/translation/js.lux
+++ b/new-luxc/source/luxc/lang/translation/js.lux
@@ -212,6 +212,10 @@
 (def: #export int-high-field Text "H")
 (def: #export int-low-field Text "L")
 
+(def: #export variant-tag-field "_lux_tag")
+(def: #export variant-flag-field "_lux_flag")
+(def: #export variant-value-field "_lux_value")
+
 (def: jvm-int
   (-> Nat Integer)
   (|>> (:! Long) (Long::intValue [])))
diff --git a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux
index fada5a70c..50cfe833c 100644
--- a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux
@@ -2,6 +2,7 @@
   lux
   (lux (control ["ex" exception #+ exception:])
        (data [bit]
+             [maybe]
              ["e" error #+ Error]
              text/format
              (coll [array]))
@@ -60,7 +61,22 @@
     _
     #.None))
 
-(def: (array element-parser js-object)
+(def: (variant lux-object js-object)
+  (-> (-> Object (Error Top)) ScriptObjectMirror (Maybe Top))
+  (case [(JSObject::getMember [//.variant-tag-field] js-object)
+         (JSObject::getMember [//.variant-flag-field] js-object)
+         (JSObject::getMember [//.variant-value-field] js-object)]
+    (^multi [(#.Some tag) ?flag (#.Some value)]
+            (host.instance? Number tag)
+            [[(Number::intValue [] (:! Number tag))
+              (lux-object value)]
+             [tag (#.Some value)]])
+    (#.Some [tag (maybe.default (host.null) ?flag) value])
+
+    _
+    #.None))
+
+(def: (array lux-object js-object)
   (-> (-> Object (Error Top)) ScriptObjectMirror (Maybe (Array Object)))
   (if (JSObject::isArray [] js-object)
     (let [init-num-keys (int-to-nat (ScriptObjectMirror::size [] js-object))]
@@ -72,7 +88,7 @@
           (let [idx-key (|> idx nat-to-int %i)]
             (case (JSObject::getMember idx-key js-object)
               (#.Some member)
-              (case (element-parser member)
+              (case (lux-object member)
                 (#e.Success parsed-member)
                 (recur num-keys (n/inc idx) (array.write idx (:! Object parsed-member) output))
 
@@ -107,7 +123,7 @@
                    (ex.return (<method> [] (:! <interface> js-object)))]
                   
                   [StructureValue StructureValue::getValue]
-                  [IntValue IntValue::getValue]))
+                  [IntValue       IntValue::getValue]))
             
             (host.instance? ScriptObjectMirror js-object)
             (let [js-object (:! ScriptObjectMirror js-object)]
@@ -116,16 +132,21 @@
                 (ex.return value)
 
                 #.None
-                (case (array lux-object js-object)
+                (case (variant lux-object js-object)
                   (#.Some value)
                   (ex.return value)
 
                   #.None
-                  ## (JSObject::isFunction [] js-object)
-                  ## js-object
+                  (case (array lux-object js-object)
+                    (#.Some value)
+                    (ex.return value)
+
+                    #.None
+                    ## (JSObject::isFunction [] js-object)
+                    ## js-object
 
-                  ## else
-                  (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
+                    ## else
+                    (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object)))))))
             
             ## else
             (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
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 ce79bda35..685043b83 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
@@ -296,8 +296,8 @@
 (def: (frac//decode inputJS)
   Unary
   (let [decoding (format "parseFloat(" inputJS ")")
-        thunk (format "(function () {" decoding "}")]
-    (lux//try decoding)))
+        thunk (self-contained (format "function () { return " decoding "; }"))]
+    (lux//try thunk)))
 
 (do-template [<name> <transform>]
   [(def: (<name> inputJS)
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 0ff5e46b9..8c33b2a82 100644
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
@@ -18,9 +18,17 @@
     (%t "")
     "null"))
 
+(def: (variant-js tag last? value)
+  (-> //.Expression //.Expression //.Expression //.Expression)
+  (format "{"
+          //.variant-tag-field ": " tag ","
+          //.variant-flag-field ": " last? ","
+          //.variant-value-field ": " value
+          "}"))
+
 (def: #export (variant tag last? value)
   (-> Nat Bool //.Expression //.Expression)
-  (format "[" (%i (nat-to-int tag)) "," (flag last?) "," value "]"))
+  (variant-js (%i (nat-to-int tag)) (flag last?) value))
 
 (def: none
   //.Expression
@@ -132,20 +140,25 @@
 
 (runtime: sum//get "sum_get"
   (let [no-match "return null;"
-        extact-match "return sum[2];"
-        test-recursion (format "if(sum[1] === '') {"
+        sum-tag (format "sum." //.variant-tag-field)
+        sum-flag (format "sum." //.variant-flag-field)
+        sum-value (format "sum." //.variant-value-field)
+        is-last? (format sum-flag " === ''")
+        extact-match (format "return " sum-value ";")
+        test-recursion (format "if(" is-last? ") {"
                                ## Must recurse.
-                               "return " @ "(sum[2], (wantedTag - sum[0]), wantsLast);"
+                               "return " @ "(" sum-value ", (wantedTag - " sum-tag "), wantsLast);"
                                "}"
                                "else { " no-match " }")]
     (format "(function " @ "(sum,wantedTag,wantsLast) {"
-            "if(wantedTag === sum[0]) {"
-            (format "if(sum[1] === wantsLast) {" extact-match "}"
+            "if(wantedTag === " sum-tag ") {"
+            (format "if(" sum-flag " === wantsLast) {" extact-match "}"
                     "else {" test-recursion "}")
             "}"
-            (format "else if(wantedTag > sum[0]) {" test-recursion "}")
-            (format "else if(wantedTag < sum[0] && wantsLast === '') {"
-                    "return [(sum[0]-wantedTag),sum[1],sum[2]];"
+            (format "else if(wantedTag > " sum-tag ") {" test-recursion "}")
+            (format "else if(wantedTag < " sum-tag " && wantsLast === '') {"
+                    (let [updated-sum (variant-js (format "(" sum-tag " - wantedTag)") sum-flag sum-value)]
+                      (format "return " updated-sum ";"))
                     "}")
             "else { " no-match " }"
             "})")))
@@ -235,7 +248,7 @@
             "})")))
 
 (bit-operation: bit//and "andI64" "&")
-(bit-operation: bit//or "orI64" "|")
+(bit-operation: bit//or  "orI64"  "|")
 (bit-operation: bit//xor "xorI64" "^")
 
 (runtime: bit//not "notI64"