diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
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" |