aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux121
1 files changed, 121 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux
new file mode 100644
index 000000000..bce63ce9c
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/ruby/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 [ruby #+ Ruby Expression Statement])))
+ [//])
+
+(host.import java/lang/Object
+ (toString [] String)
+ (getClass [] (Class Object)))
+
+(host.import java/lang/Long
+ (intValue [] Integer))
+
+(host.import org/jruby/RubyArray
+ (getLength [] int)
+ (get [int] #? Object))
+
+(host.import org/jruby/RubyHash
+ (get [Object] #? Object))
+
+(def: (tuple lux-object host-object)
+ (-> (-> Object (Error Top)) RubyArray (Error Top))
+ (let [size (:! Nat (RubyArray::getLength [] host-object))]
+ (loop [idx +0
+ output (:! (Array Top) (array.new size))]
+ (if (n/< size idx)
+ (case (RubyArray::get [(:! Int idx)] host-object)
+ #.None
+ (recur (n/inc idx) output)
+
+ (#.Some value)
+ (case (lux-object value)
+ (#e.Error error)
+ (#e.Error error)
+
+ (#e.Success lux-value)
+ (recur (n/inc idx) (array.write idx lux-value output))))
+ (#e.Success output)))))
+
+(exception: #export Not-A-Variant)
+
+(def: (variant lux-object host-object)
+ (-> (-> Object (Error Top)) RubyHash (Error Top))
+ (case [(RubyHash::get [(:! Object //.variant-tag-field)] host-object)
+ (RubyHash::get [(:! Object //.variant-flag-field)] host-object)
+ (RubyHash::get [(:! Object //.variant-value-field)] host-object)]
+ (^multi [(#.Some tag) ?flag (#.Some value)]
+ [(lux-object value)
+ (#.Some value)])
+ (#e.Success [(Long::intValue [] (:! Long tag))
+ (: Top (case ?flag (#.Some _) "" #.None (host.null)))
+ value])
+
+ _
+ (ex.throw Not-A-Variant "")))
+
+(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? org/jruby/RubyArray host-object)
+ (tuple lux-object (:! RubyArray host-object))
+
+ (host.instance? org/jruby/RubyHash host-object)
+ (case (variant lux-object (:! RubyHash host-object))
+ (#e.Success value)
+ (#e.Success value)
+
+ _
+ (let [object-class (:! Text (Object::toString [] (Object::getClass [] (:! Object host-object))))
+ text-representation (:! Text (Object::toString [] (:! Object host-object)))]
+ (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation))))
+
+ ## else
+ (let [object-class (:! Text (Object::toString [] (Object::getClass [] (:! Object host-object))))
+ text-representation (:! Text (Object::toString [] (:! Object host-object)))]
+ (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation)))
+ )))
+
+(exception: #export Cannot-Evaluate)
+
+(def: #export (eval code)
+ (-> Expression (Meta Top))
+ (function [compiler]
+ (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))]
+ (case (interpreter code)
+ (#e.Error error)
+ (exec (log! (format "eval #e.Error\n"
+ "<< " code "\n"
+ error))
+ ((lang.throw Cannot-Evaluate error) compiler))
+
+ (#e.Success output)
+ (case (lux-object (:! Object output))
+ (#e.Success parsed-output)
+ (exec ## (log! (format "eval #e.Success\n"
+ ## "<< " code))
+ (#e.Success [compiler parsed-output]))
+
+ (#e.Error error)
+ (exec (log! (format "eval #e.Error\n"
+ "<< " code "\n"
+ error))
+ ((lang.throw Cannot-Evaluate error) compiler)))))))