1 files changed, 121 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux
new file mode 100644
index 000000000..331ec857d
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux
@@ -0,0 +1,121 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:])
+       (data [bit]
+             [maybe]
+             ["e" error #+ Error]
+             text/format
+             (coll [array]))
+       [host])
+  (luxc [lang]
+        (lang (host [js #+ JS Expression Statement])))
+  [//])
+
+(host.import java/lang/Object
+  (toString [] String)
+  (getClass [] (Class Object)))
+
+(host.import java/lang/Long
+  (intValue [] Integer))
+
+(host.import net/sandius/rembulan/ByteString
+  (decode [] String))
+
+(host.import net/sandius/rembulan/Table
+  (rawget #as get-idx [long] #? Object)
+  (rawget #as get-key [Object] #? Object)
+  (rawlen [] long))
+
+(host.import net/sandius/rembulan/impl/DefaultTable)
+
+(def: (variant lux-object host-object)
+  (-> (-> Object (Error Top)) DefaultTable (Maybe Top))
+  (case [(Table::get-key [//.variant-tag-field] host-object)
+         (Table::get-key [//.variant-flag-field] host-object)
+         (Table::get-key [//.variant-value-field] host-object)]
+    (^multi [(#.Some tag) ?flag (#.Some value)]
+            [(lux-object value)
+             (#.Some value)])
+    (#.Some [(Long::intValue [] (:! Long tag))
+             (: Top (case ?flag (#.Some _) "" #.None (host.null)))
+             value])
+
+    _
+    #.None))
+
+(def: (array lux-object host-object)
+  (-> (-> Object (Error Top)) DefaultTable (Maybe (Array Object)))
+  (let [init-num-keys (:! Nat (Table::rawlen [] host-object))]
+    (loop [num-keys init-num-keys
+           idx +0
+           output (: (Array Object)
+                     (array.new init-num-keys))]
+      (if (n/< num-keys idx)
+        (case (Table::get-idx (:! Long (n/inc idx)) host-object)
+          (#.Some member)
+          (case (lux-object member)
+            (#e.Success parsed-member)
+            (recur num-keys (n/inc idx) (array.write idx (:! Object parsed-member) output))
+
+            (#e.Error error)
+            #.None)
+
+          #.None
+          (recur num-keys (n/inc idx) output))
+        (#.Some output)))))
+
+(exception: #export Unknown-Kind-Of-Host-Object)
+(exception: #export Null-Has-No-Lux-Representation)
+
+(def: (lux-object host-object)
+  (-> Object (Error Top))
+  (`` (cond (host.null? host-object)
+            (ex.throw Null-Has-No-Lux-Representation "")
+
+            (or (host.instance? java/lang/Boolean host-object)
+                (host.instance? java/lang/Long host-object)
+                (host.instance? java/lang/Double host-object)
+                (host.instance? java/lang/String host-object))
+            (ex.return host-object)
+
+            (host.instance? ByteString host-object)
+            (ex.return (ByteString::decode [] (:! ByteString host-object)))
+
+            (host.instance? DefaultTable host-object)
+            (let [host-object (:! DefaultTable host-object)]
+              (case (variant lux-object host-object)
+                (#.Some value)
+                (ex.return value)
+
+                #.None
+                (case (array lux-object host-object)
+                  (#.Some value)
+                  (ex.return value)
+
+                  #.None
+                  (ex.throw Unknown-Kind-Of-Host-Object (format "SECOND " (Object::toString [] (:! Object host-object)))))))
+
+            ## else
+            (ex.throw Unknown-Kind-Of-Host-Object (format "FIRST " (Object::toString [] (:! Object host-object))))
+            )))
+
+(exception: #export Cannot-Evaluate)
+
+(def: #export (eval code)
+  (-> Expression (Meta Top))
+  (function [compiler]
+    (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))]
+      (case (interpreter (format "return " code ";"))
+        (#e.Error error)
+        ((lang.throw Cannot-Evaluate error) compiler)
+
+        (#e.Success output)
+        (case (lux-object (|> output
+                              (:! (Array Object))
+                              (array.read +0)
+                              maybe.assume))
+          (#e.Success parsed-output)
+          (#e.Success [compiler parsed-output])
+
+          (#e.Error error)
+          ((lang.throw Cannot-Evaluate error) compiler))))))