diff options
| -rw-r--r-- | .gitignore | 5 | ||||
| -rw-r--r-- | commands | 10 | ||||
| -rw-r--r-- | lux-js/source/program.lux | 6 | ||||
| -rw-r--r-- | lux-python/source/program.lux | 20 | ||||
| -rw-r--r-- | lux-ruby/project.clj | 30 | ||||
| -rw-r--r-- | lux-ruby/source/program.lux | 447 | ||||
| -rw-r--r-- | luxc/src/lux/type/host.clj | 27 | ||||
| -rw-r--r-- | new-luxc/project.clj | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/ruby.lux | 195 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux | 124 | ||||
| -rw-r--r-- | stdlib/source/lux/host/ruby.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux | 6 |
15 files changed, 520 insertions, 360 deletions
diff --git a/.gitignore b/.gitignore index 9fa81e94a..47a05af09 100644 --- a/.gitignore +++ b/.gitignore @@ -30,3 +30,8 @@ pom.xml.asc /lux-python/source/lux /lux-python/source/program +/lux-ruby/target +/lux-ruby/source/lux.lux +/lux-ruby/source/lux +/lux-ruby/source/program + @@ -55,6 +55,16 @@ cd ~/lux/lux-python/ && lein clean # Try cd ~/lux/lux-python/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +# Ruby compiler + # Test + cd ~/lux/lux-ruby/ && lein_2_7_1 lux auto test + cd ~/lux/lux-ruby/ && lein clean && lein_2_7_1 lux auto test + # Build + cd ~/lux/lux-ruby/ && lein_2_7_1 lux auto build + cd ~/lux/lux-ruby/ && lein clean && lein_2_7_1 lux auto build + # Try + cd ~/lux/lux-ruby/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux + # Run compiler test suite cd ~/lux/new-luxc/ && lein_2_7_1 lux auto test cd ~/lux/new-luxc/ && lein clean && lein_2_7_1 lux auto test diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 8de905414..a55c29aa6 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -110,9 +110,6 @@ (program/IntValue (getValue) java/lang/Object (:coerce java/lang/Object value)) - ## (jdk/nashorn/api/scripting/AbstractJSObject - ## (getDefaultValue {hint (java/lang/Class java/lang/Object)}) java/lang/Object - ## "<<IntValue>>") (jdk/nashorn/api/scripting/AbstractJSObject (getMember {member java/lang/String}) java/lang/Object (case member @@ -220,9 +217,6 @@ (program/StructureValue (getValue) java/lang/Object (:coerce (Array java/lang/Object) value)) - ## (jdk/nashorn/api/scripting/AbstractJSObject - ## (getDefaultValue {hint (java/lang/Class java/lang/Object)}) java/lang/Object - ## "<<StructureValue>>") (jdk/nashorn/api/scripting/AbstractJSObject (isArray) boolean #1) diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 3a7fc9cc9..3fbd8ccd6 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -106,9 +106,6 @@ #.None) (java/lang/Object::toString object))) -(import: #long org/python/core/PyType - (getName [] java/lang/String)) - (import: #long org/python/core/PyNone) (import: #long org/python/core/PyBoolean) (import: #long org/python/core/PyInteger) @@ -128,8 +125,7 @@ (__nonzero__ [] boolean) (__getitem__ [int] #try org/python/core/PyObject) (__getitem__ #as __getitem__dict [org/python/core/PyObject] #try org/python/core/PyObject) - (__len__ [] int) - (getType [] org/python/core/PyType)) + (__len__ [] int)) (import: #long org/python/core/PyFunction (__call__ [(Array org/python/core/PyObject)] org/python/core/PyObject)) @@ -165,10 +161,6 @@ (recur (inc idx) (array.write idx lux-value output)))) (#error.Success output))))) -(def: python-type - (-> org/python/core/PyObject Text) - (|>> org/python/core/PyObject::getType org/python/core/PyType::getName (:coerce Text))) - (exception: (unknown-kind-of-object {object java/lang/Object}) (exception.report ["Object" (java/lang/Object::toString object)])) @@ -228,15 +220,11 @@ [org/python/core/PyTuple (..read-variant read)] [org/python/core/PyList (..read-tuple read)] )) - (exec (log! (java/lang/Class::getCanonicalName - (java/lang/Object::getClass - (:coerce java/lang/Object host-object)))) - (log! (python-type host-object)) - (exception.throw ..unknown-kind-of-object host-object))))) + (exception.throw ..unknown-kind-of-object host-object)))) (exception: (cannot-apply-a-non-function {object java/lang/Object}) (exception.report - ["Object" (java/lang/Object::toString object)])) + ["Non-function" (java/lang/Object::toString object)])) (def: (ensure-macro macro) (-> Macro (Maybe org/python/core/PyFunction)) @@ -252,7 +240,7 @@ (def: (call-macro inputs lux macro) (-> (List Code) Lux org/python/core/PyFunction (Error (Error [Lux (List Code)]))) - (<| (:coerce (Error (Error [Lux (List Code)]))) + (<| :assume ..read (org/python/core/PyFunction::__call__ (|> (host.array org/python/core/PyObject 2) (host.array-write 0 (..to-host inputs)) diff --git a/lux-ruby/project.clj b/lux-ruby/project.clj new file mode 100644 index 000000000..9b34f7edf --- /dev/null +++ b/lux-ruby/project.clj @@ -0,0 +1,30 @@ +(def version "0.6.0-SNAPSHOT") +(def repo "https://github.com/LuxLang/lux") +(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/") +(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") + +(defproject com.github.luxlang/lux-python #=(identity version) + :description "A Python compiler for Lux." + :url ~repo + :license {:name "Lux License v0.1" + :url ~(str repo "/blob/master/license.txt")} + :scm {:name "git" + :url ~(str repo ".git")} + :pom-addition [:developers [:developer + [:name "Eduardo Julian"] + [:url "https://github.com/eduardoejp"]]] + + :repositories [["releases" ~sonatype-releases] + ["snapshots" ~sonatype-snapshots]] + :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] + ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] + + :plugins [[com.github.luxlang/lein-luxc ~version]] + :dependencies [[com.github.luxlang/luxc-jvm ~version] + [com.github.luxlang/stdlib ~version] + [org.jruby/jruby-complete "9.2.6.0"]] + + :manifest {"lux" ~version} + :source-paths ["source"] + :lux {:program "program"} + ) diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux new file mode 100644 index 000000000..b9b576f29 --- /dev/null +++ b/lux-ruby/source/program.lux @@ -0,0 +1,447 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + pipe + [cli (#+ program:)] + ["p" parser] + ["." exception (#+ exception:)] + ["." io (#+ IO io)]] + [data + ["." maybe] + ["." error (#+ Error)] + [number + ["." i64]] + ["." text ("#@." hash) + format] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + ["." macro + ["s" syntax (#+ syntax:)] + ["." code] + ["." template]] + [world + ["." file]] + ["." host (#+ import: interface: do-to object) + ["_" ruby]] + [tool + [compiler + ["." name] + ["." synthesis] + [phase + [macro (#+ Expander)] + ["." generation + ["." ruby + ["." runtime] + ["." extension]]]] + [default + ["." platform (#+ Platform)]]]]] + [program + ["/" compositor + ["/." cli]]]) + +(import: #long java/lang/String) + +(import: #long (java/lang/Class a) + (getCanonicalName [] java/lang/String)) + +(import: #long java/lang/Object + (new []) + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))) + +(import: #long java/lang/Integer + (longValue [] java/lang/Long)) + +(import: #long java/lang/Long + (intValue [] java/lang/Integer)) + +(import: #long java/lang/Number + (intValue [] java/lang/Integer) + (longValue [] long) + (doubleValue [] double)) + +(def: (inspect object) + (-> java/lang/Object Text) + (<| (case (host.check java/lang/Boolean object) + (#.Some value) + (%b value) + #.None) + (case (host.check java/lang/String object) + (#.Some value) + (%t value) + #.None) + (case (host.check java/lang/Long object) + (#.Some value) + (%i (.int value)) + #.None) + (case (host.check java/lang/Number object) + (#.Some value) + (%f (java/lang/Number::doubleValue value)) + #.None) + (case (host.check (Array java/lang/Object) object) + (#.Some value) + (let [value (:coerce (Array java/lang/Object) value)] + (case (array.read 0 value) + (^multi (#.Some tag) + [(host.check java/lang/Integer tag) + (#.Some tag)] + [[(array.read 1 value) + (array.read 2 value)] + [last? + (#.Some choice)]]) + (let [last? (case last? + (#.Some _) #1 + #.None #0)] + (|> (format (%n (.nat (java/lang/Integer::longValue tag))) + " " (%b last?) + " " (inspect choice)) + (text.enclose ["(" ")"]))) + + _ + (|> value + array.to-list + (list@map inspect) + (text.join-with " ") + (text.enclose ["[" "]"])))) + #.None) + (java/lang/Object::toString object))) + +(import: #long org/jruby/RubyArray + (getLength [] int) + (get [int] #? Object)) + +(import: #long org/jruby/RubyHash + (get [Object] #? Object)) + +(import: #long org/jruby/runtime/builtin/IRubyObject) + +(import: #long org/jruby/runtime/ThreadContext) + +(template [<name>] + [(interface: <name> + (getValue [] java/lang/Object)) + + (`` (import: (~~ (template.identifier ["program/" <name>])) + (getValue [] java/lang/Object)))] + + [StructureValue] + ) + +(syntax: (method-inputs {input-classes (s.tuple (p.some s.any))}) + (monad.map @ (function (_ class) + (do @ + [var (macro.gensym "input")] + (wrap (code.record (list [var class]))))) + input-classes)) + +(import: #long org/jruby/runtime/JavaSites$CheckedSites) + +(def: (lux-structure value) + (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) + (with-expansions [<checkers> (template [<name>] + [[<name> [] boolean]] + + [isNil] [isTaint] [isClass] [isFrozen] + [isImmediate] [isModule] [isSpecialConst] [isTrue] + [isUntrusted] [hasVariables]) + <markers> (template [<name>] + [[<name> [boolean] void]] + + [setFrozen] [setTaint] [setUntrusted]) + <nullaries> (template [<name>] + [[<name> [] org/jruby/runtime/builtin/IRubyObject]] + + [dup] [checkArrayType] [inspect] [checkStringType] + [checkStringType19] [id] [rbClone] [anyToString]) + <class> (template [<name>] + [[<name> [] org/jruby/RubyClass]] + + [getMetaClass] [getType] [getSingletonClass]) + <call> (template [<inputs>] + [[callMethod <inputs> + org/jruby/runtime/builtin/IRubyObject]] + + [[org/jruby/runtime/ThreadContext int java/lang/String]] + [[org/jruby/runtime/ThreadContext int java/lang/String org/jruby/runtime/builtin/IRubyObject]] + [[org/jruby/runtime/ThreadContext java/lang/String]] + [[org/jruby/runtime/ThreadContext java/lang/String org/jruby/runtime/builtin/IRubyObject]] + ## [[org/jruby/runtime/ThreadContext java/lang/String (Array org/jruby/runtime/builtin/IRubyObject)]] + [[org/jruby/runtime/ThreadContext java/lang/String (Array org/jruby/runtime/builtin/IRubyObject) org/jruby/runtime/Block]] + ) + <placeholders> (template [<name> <inputs> <output>] + [(org/jruby/runtime/builtin/IRubyObject + (<name> (~~ (method-inputs <inputs>))) + <output> + (error! (template.text ["UNIMPLEMENTED METHOD: " <name>])))] + + [getJavaClass [] (java/lang/Class java/lang/Object)] + [asJavaString [] java/lang/String] + [getInstanceVariables [] org/jruby/runtime/builtin/InstanceVariables] + [convertToInteger [] org/jruby/RubyInteger] + [convertToInteger [java/lang/String] org/jruby/RubyInteger] + [convertToInteger [int java/lang/String] org/jruby/RubyInteger] + [convertToArray [] org/jruby/RubyArray] + [convertToHash [] org/jruby/RubyHash] + [convertToFloat [] org/jruby/RubyFloat] + [convertToString [] org/jruby/RubyString] + [asString [] org/jruby/RubyString] + [respondsTo [java/lang/String] boolean] + [respondsToMissing [java/lang/String] boolean] + [respondsToMissing [java/lang/String boolean] boolean] + [dataGetStruct [] java/lang/Object] + [dataGetStructChecked [] java/lang/Object] + [infectBy [org/jruby/runtime/builtin/IRubyObject] org/jruby/runtime/builtin/IRubyObject] + [eql [org/jruby/runtime/builtin/IRubyObject] boolean] + [toJava [(java/lang/Class java/lang/Object)] java/lang/Object] + + [op_eqq + [org/jruby/runtime/ThreadContext + org/jruby/runtime/builtin/IRubyObject] + org/jruby/runtime/builtin/IRubyObject] + + [op_equal + [org/jruby/runtime/ThreadContext + org/jruby/runtime/builtin/IRubyObject] + org/jruby/runtime/builtin/IRubyObject] + + [callSuper + [org/jruby/runtime/ThreadContext + (Array org/jruby/runtime/builtin/IRubyObject) + org/jruby/runtime/Block] + org/jruby/runtime/builtin/IRubyObject] + + [checkCallMethod + [org/jruby/runtime/ThreadContext + java/lang/String] + org/jruby/runtime/builtin/IRubyObject] + + ## [checkCallMethod + ## [org/jruby/runtime/ThreadContext + ## org/jruby/runtime/JavaSites$CheckedSites] + ## org/jruby/runtime/builtin/IRubyObject] + + <checkers> + <markers> + <nullaries> + <class> + <call> + )] + (`` (object [] [program/StructureValue + org/jruby/runtime/builtin/IRubyObject] + [] + ## Methods + (program/StructureValue + (getValue) + java/lang/Object + (:coerce (Array java/lang/Object) value)) + + (org/jruby/runtime/builtin/IRubyObject + (callMethod {thread-context org/jruby/runtime/ThreadContext} + {member java/lang/String} + {inputs (Array org/jruby/runtime/builtin/IRubyObject)}) + org/jruby/runtime/builtin/IRubyObject + (exec + (log! (format "Was called: " (%t member))) + (error! "OOPS!"))) + + <placeholders> + )))) + +(import: #long org/jruby/RubyProc + (call [org/jruby/runtime/ThreadContext (Array org/jruby/runtime/builtin/IRubyObject)] + org/jruby/runtime/builtin/IRubyObject)) + +(import: #long org/jruby/Ruby + (getCurrentContext [] org/jruby/runtime/ThreadContext)) + +(import: #long org/jruby/javasupport/JavaArray + (new [org/jruby/Ruby java/lang/Object])) + +(type: Translator + (-> java/lang/Object (Error Any))) + +(def: (read-tuple read host-object) + (-> Translator org/jruby/RubyArray (Error Any)) + (let [size (:coerce Nat (org/jruby/RubyArray::getLength host-object))] + (loop [idx 0 + output (:coerce (Array Any) (array.new size))] + (if (n/< size idx) + (case (org/jruby/RubyArray::get (.int idx) host-object) + #.None + (recur (inc idx) output) + + (#.Some value) + (case (read value) + (#error.Failure error) + (#error.Failure error) + + (#error.Success lux-value) + (recur (inc idx) (array.write idx lux-value output)))) + (#error.Success output))))) + +(exception: (unknown-kind-of-object {object java/lang/Object}) + (exception.report + ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))] + ["Object" (java/lang/Object::toString object)])) + +(def: (read-variant read host-object) + (-> Translator org/jruby/RubyHash (Error Any)) + (case [(org/jruby/RubyHash::get runtime.variant-tag-field host-object) + (org/jruby/RubyHash::get runtime.variant-flag-field host-object) + (org/jruby/RubyHash::get runtime.variant-value-field host-object)] + (^multi [(#.Some tag) ?flag (#.Some value)] + [(read value) + (#.Some value)]) + (#error.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag)) + (: Any (case ?flag + (#.Some _) + "" + + #.None + (host.null))) + value]) + + _ + (exception.throw ..unknown-kind-of-object host-object))) + +(exception: #export nil-has-no-lux-representation) + +(def: (read host-object) + Translator + (`` (<| (if (host.null? host-object) + (exception.throw nil-has-no-lux-representation [])) + (~~ (template [<class> <post-processing>] + [(case (host.check <class> host-object) + (#.Some typed-object) + (|> typed-object <post-processing>) + + _)] + + [java/lang/Boolean #error.Success] + [java/lang/Long #error.Success] + [java/lang/Double #error.Success] + [java/lang/String #error.Success] + [org/jruby/RubyArray (read-tuple read)] + [org/jruby/RubyHash (read-variant read)] + [org/jruby/RubySymbol #error.Success] + [org/jruby/RubyProc #error.Success] + )) + (exception.throw ..unknown-kind-of-object host-object) + ))) + +(exception: (cannot-apply-a-non-function {object java/lang/Object}) + (exception.report + ["Non-function" (java/lang/Object::toString object)])) + +(import: #long org/jruby/embed/internal/LocalContextProvider + (getRuntime [] org/jruby/Ruby)) + +(import: #long org/jruby/embed/ScriptingContainer + (new []) + (runScriptlet [java/lang/String] #try #? java/lang/Object) + (getProvider [] org/jruby/embed/internal/LocalContextProvider)) + +## TODO; Figure out a way to not need "interpreter" to be a global variable. +(def: interpreter (org/jruby/embed/ScriptingContainer::new)) + +(def: ensure-macro + (-> Macro (Maybe org/jruby/RubyProc)) + (|>> (:coerce java/lang/Object) (host.check org/jruby/RubyProc))) + +(template: (!ruby-runtime) + (|> ..interpreter + org/jruby/embed/ScriptingContainer::getProvider + org/jruby/embed/internal/LocalContextProvider::getRuntime)) + +(template: (!ruby-thread-context) + (|> (!ruby-runtime) + org/jruby/Ruby::getCurrentContext)) + +(def: to-host + (-> Any org/jruby/runtime/builtin/IRubyObject) + (|>> (:coerce (Array java/lang/Object)) + ..lux-structure + ## (org/jruby/javasupport/JavaArray::new (!ruby-runtime)) + )) + +(def: (call-macro inputs lux macro) + (-> (List Code) Lux org/jruby/RubyProc (Error (Error [Lux (List Code)]))) + (<| :assume + ..read + (:coerce java/lang/Object) + (org/jruby/RubyProc::call (!ruby-thread-context) + (|> (host.array org/jruby/runtime/builtin/IRubyObject 2) + (host.array-write 0 (..to-host inputs)) + (host.array-write 1 (..to-host lux))) + macro))) + +(def: (expander macro inputs lux) + Expander + (case (ensure-macro macro) + (#.Some macro) + (case (call-macro inputs lux macro) + (#error.Success output) + (|> output + (:coerce java/lang/Object) + ..read + (:coerce (Error (Error [Lux (List Code)])))) + + (#error.Failure error) + (#error.Failure error)) + + #.None + (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro)))) + +(def: separator "___") + +(type: Host + (generation.Host (_.Expression Any) (_.Statement Any))) + +(def: host + (IO Host) + (io (let [run! (: (-> Text (_.Code Any) (Error Any)) + (function (_ dummy-name code) + (do error.monad + [output (org/jruby/embed/ScriptingContainer::runScriptlet (_.code code) ..interpreter)] + (..read (maybe.default (:coerce java/lang/Object []) + output)))))] + (: Host + (structure + (def: evaluate! run!) + (def: execute! run!) + (def: (define! [module name] input) + (let [global (format (text.replace-all .module-separator ..separator module) + ..separator (name.normalize name) + "___" (%n (text@hash name))) + @global (_.global global)] + (do error.monad + [#let [definition (_.set (list @global) input)] + _ (run! global definition) + value (run! global @global)] + (wrap [global value definition]))))))))) + +(def: platform + (IO (Platform IO _.LVar (_.Expression Any) (_.Statement Any))) + (do io.monad + [host ..host] + (wrap {#platform.&monad io.monad + #platform.&file-system file.system + #platform.host host + #platform.phase ruby.generate + #platform.runtime runtime.generate}))) + +(def: (program program) + (-> (_.Expression Any) (_.Statement Any)) + (_.statement (_.apply/* (list (runtime.lux//program-args _.command-line-arguments) + _.nil) + program))) + +(program: [{service /cli.service}] + (/.compiler ..expander + ..platform + extension.bundle + ..program + service)) diff --git a/luxc/src/lux/type/host.clj b/luxc/src/lux/type/host.clj index 038111c84..bddc6829b 100644 --- a/luxc/src/lux/type/host.clj +++ b/luxc/src/lux/type/host.clj @@ -72,8 +72,9 @@ (def rev-data-tag "#Rev") ;; [Utils] -(defn ^:private trace-lineage* [^Class super-class ^Class sub-class] +(defn ^:private trace-lineage* "(-> Class Class (List Class))" + [^Class super-class ^Class sub-class] ;; Either they're both interfaces, or they're both classes (let [valid-sub? #(if (or (= super-class %) (.isAssignableFrom super-class %)) @@ -97,8 +98,9 @@ (&/$Cons super* stack) (recur super* (&/$Cons super* stack)))))))) -(defn ^:private trace-lineage [^Class sub-class ^Class super-class] +(defn ^:private trace-lineage "(-> Class Class (List Class))" + [^Class sub-class ^Class super-class] (if (= sub-class super-class) (&/|list) (&/|reverse (trace-lineage* super-class sub-class)))) @@ -121,8 +123,9 @@ "F" "float" "D" "double" "C" "char"))] - (defn class->type [^Class class] + (defn class->type "(-> Class Type)" + [^Class class] (let [gclass-name (.getName class)] (case gclass-name ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") @@ -141,8 +144,9 @@ (range (count (or arr-obrackets arr-pbrackets ""))))) )))))) -(defn instance-param [existential matchings refl-type] +(defn instance-param "(-> (Lux Type) (List (, Text Type)) (^ java.lang.reflect.Type) (Lux Type))" + [existential matchings refl-type] (cond (instance? Class refl-type) (return (class->type refl-type)) @@ -201,8 +205,9 @@ (principal-class bound) (&host-generics/->type-signature "java.lang.Object")))) -(defn instance-gtype [existential matchings gtype] +(defn instance-gtype "(-> (Lux Type) (List (, Text Type)) GenericType (Lux Type))" + [existential matchings gtype] (|case gtype (&/$GenericArray component-type) (|do [inner-type (instance-gtype existential matchings component-type)] @@ -234,13 +239,15 @@ existential)) ;; [Utils] -(defn ^:private translate-params [existential super-type-params sub-type-params params] +(defn ^:private translate-params "(-> (List (^ java.lang.reflect.Type)) (List (^ java.lang.reflect.Type)) (List Type) (Lux (List Type)))" + [existential super-type-params sub-type-params params] (|let [matchings (match-params sub-type-params params)] (&/map% (partial instance-param existential matchings) super-type-params))) -(defn ^:private raise* [existential sub+params ^Class super] +(defn ^:private raise* "(-> (, Class (List Type)) Class (Lux (, Class (List Type))))" + [existential sub+params ^Class super] (|let [[^Class sub params] sub+params] (if (.isInterface super) (|do [:let [super-params (->> sub @@ -341,8 +348,9 @@ (catch Exception e (throw e))))) -(defn gtype->gclass [gtype] +(defn gtype->gclass "(-> GenericType GenericClass)" + [gtype] (cond (instance? Class gtype) (&/$GenericClass (.getName ^Class gtype) &/$Nil) @@ -368,8 +376,9 @@ (&/$GenericWildcard &/$None))))) (let [generic-type-sig "Ljava/lang/Object;"] - (defn gclass->sig [gclass] + (defn gclass->sig "(-> GenericClass Text)" + [gclass] (|case gclass (&/$GenericClass gclass-name (&/$Nil)) (case gclass-name diff --git a/new-luxc/project.clj b/new-luxc/project.clj index 2229decd1..5017e821d 100644 --- a/new-luxc/project.clj +++ b/new-luxc/project.clj @@ -27,8 +27,6 @@ ;; [net.sandius.rembulan/rembulan-runtime "0.1-SNAPSHOT"] ;; [net.sandius.rembulan/rembulan-stdlib "0.1-SNAPSHOT"] ;; [net.sandius.rembulan/rembulan-compiler "0.1-SNAPSHOT"] - ;; ;; Ruby - ;; [org.jruby/jruby-complete "9.1.16.0"] ;; ;; Scheme ;; [kawa-scheme/kawa-core "2.4"] ;; ;; Common Lisp diff --git a/new-luxc/source/luxc/lang/translation/ruby.lux b/new-luxc/source/luxc/lang/translation/ruby.lux deleted file mode 100644 index 084c614ec..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby.lux +++ /dev/null @@ -1,195 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:] - pipe - [monad #+ do]) - (data [bit] - [maybe] - ["e" error #+ Error] - [text "text/" Eq<Text>] - text/format - (coll [array])) - [macro] - [io #+ IO Process io] - [host #+ class: interface: object] - (world [file #+ File])) - (luxc [lang] - (lang [".L" variable #+ Register] - (host [ruby #+ Ruby Expression Statement])) - [".C" io])) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [No-Active-Module-Buffer] - [Cannot-Execute] - - [No-Anchor] - ) - -(host.import: java/lang/Object) - -(host.import: java/lang/String - (getBytes [String] #try (Array byte))) - -(host.import: java/lang/CharSequence) - -(host.import: java/lang/Appendable - (append [CharSequence] Appendable)) - -(host.import: java/lang/StringBuilder - (new []) - (toString [] String)) - -(host.import: org/jruby/embed/ScriptingContainer - (new []) - (runScriptlet [String] #? Object)) - -(type: #export Anchor [Text Register]) - -(type: #export Host - {#context [Text Nat] - #anchor (Maybe Anchor) - #interpreter (-> Text (Error Any)) - #module-buffer (Maybe StringBuilder) - #program-buffer StringBuilder}) - -(def: #export init - (IO Host) - (io {#context ["" +0] - #anchor #.None - #interpreter (let [interpreter (ScriptingContainer::new [])] - (function (_ code) - ("lux try" (io (: Any (maybe.default [] (ScriptingContainer::runScriptlet [code] interpreter))))))) - #module-buffer #.None - #program-buffer (StringBuilder::new [])})) - -(def: #export ruby-module-name Text "module.rb") - -(def: #export init-module-buffer - (Meta Any) - (function (_ compiler) - (#e.Success [(update@ #.host - (|>> (:coerce Host) - (set@ #module-buffer (#.Some (StringBuilder::new []))) - (:coerce Nothing)) - compiler) - []]))) - -(def: #export (with-sub-context expr) - (All [a] (-> (Meta a) (Meta [Text a]))) - (function (_ compiler) - (let [old (:coerce Host (get@ #.host compiler)) - [old-name old-sub] (get@ #context old) - new-name (format old-name "___" (%i (.int old-sub)))] - (case (expr (set@ #.host - (:coerce Nothing (set@ #context [new-name +0] old)) - compiler)) - (#e.Success [compiler' output]) - (#e.Success [(update@ #.host - (|>> (:coerce Host) - (set@ #context [old-name (inc old-sub)]) - (:coerce Nothing)) - compiler') - [new-name output]]) - - (#e.Error error) - (#e.Error error))))) - -(def: #export context - (Meta Text) - (function (_ compiler) - (#e.Success [compiler - (|> (get@ #.host compiler) - (:coerce Host) - (get@ #context) - (let> [name sub] - name))]))) - -(def: #export (with-anchor anchor expr) - (All [a] (-> Anchor (Meta a) (Meta a))) - (function (_ compiler) - (let [old (:coerce Host (get@ #.host compiler))] - (case (expr (set@ #.host - (:coerce Nothing (set@ #anchor (#.Some anchor) old)) - compiler)) - (#e.Success [compiler' output]) - (#e.Success [(update@ #.host - (|>> (:coerce Host) - (set@ #anchor (get@ #anchor old)) - (:coerce Nothing)) - compiler') - output]) - - (#e.Error error) - (#e.Error error))))) - -(def: #export anchor - (Meta Anchor) - (function (_ compiler) - (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor)) - (#.Some anchor) - (#e.Success [compiler anchor]) - - #.None - ((lang.throw No-Anchor "") compiler)))) - -(def: #export module-buffer - (Meta StringBuilder) - (function (_ compiler) - (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer)) - #.None - ((lang.throw No-Active-Module-Buffer "") compiler) - - (#.Some module-buffer) - (#e.Success [compiler module-buffer])))) - -(def: #export program-buffer - (Meta StringBuilder) - (function (_ compiler) - (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))]))) - -(def: (execute code) - (-> Expression (Meta Any)) - (function (_ compiler) - (let [interpreter (|> compiler (get@ #.host) (:coerce Host) (get@ #interpreter))] - (case (interpreter code) - (#e.Error error) - ((lang.throw Cannot-Execute error) compiler) - - (#e.Success _) - (#e.Success [compiler []]))))) - -(def: #export variant-tag-field "_lux_tag") -(def: #export variant-flag-field "_lux_flag") -(def: #export variant-value-field "_lux_value") - -(def: #export unit Text "") - -(def: #export (definition-name [module name]) - (-> Name Text) - (lang.normalize-name (format module "$" name))) - -(def: #export (save code) - (-> Ruby (Meta Any)) - (do macro.Monad<Meta> - [module-buffer module-buffer - #let [_ (Appendable::append [(:coerce CharSequence code)] - module-buffer)]] - (execute code))) - -(def: #export (save-module! target) - (-> File (Meta (Process Any))) - (do macro.Monad<Meta> - [module macro.current-module-name - module-buffer module-buffer - program-buffer program-buffer - #let [module-code (StringBuilder::toString [] module-buffer) - _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))] - program-buffer)]] - (wrap (ioC.write target - (format (lang.normalize-name module) "/" ruby-module-name) - (|> module-code - (String::getBytes ["UTF-8"]) - e.assume))))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux deleted file mode 100644 index 3742ae467..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux +++ /dev/null @@ -1,124 +0,0 @@ -(.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]))) - [//]) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Not-A-Variant] - [Unknown-Kind-Of-Host-Object] - [Null-Has-No-Lux-Representation] - [Cannot-Evaluate] - ) - -(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 Any)) RubyArray (Error Any)) - (let [size (:coerce Nat (RubyArray::getLength [] host-object))] - (loop [idx +0 - output (:coerce (Array Any) (array.new size))] - (if (n/< size idx) - (case (RubyArray::get [(:coerce Int idx)] host-object) - #.None - (recur (inc idx) output) - - (#.Some value) - (case (lux-object value) - (#e.Error error) - (#e.Error error) - - (#e.Success lux-value) - (recur (inc idx) (array.write idx lux-value output)))) - (#e.Success output))))) - -(def: (variant lux-object host-object) - (-> (-> Object (Error Any)) RubyHash (Error Any)) - (case [(RubyHash::get [(:coerce Object //.variant-tag-field)] host-object) - (RubyHash::get [(:coerce Object //.variant-flag-field)] host-object) - (RubyHash::get [(:coerce Object //.variant-value-field)] host-object)] - (^multi [(#.Some tag) ?flag (#.Some value)] - [(lux-object value) - (#.Some value)]) - (#e.Success [(Long::intValue [] (:coerce Long tag)) - (: Any (case ?flag (#.Some _) "" #.None (host.null))) - value]) - - _ - (ex.throw Not-A-Variant ""))) - -(def: (lux-object host-object) - (-> Object (Error Any)) - (`` (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 (:coerce RubyArray host-object)) - - (host.instance? org/jruby/RubyHash host-object) - (case (variant lux-object (:coerce RubyHash host-object)) - (#e.Success value) - (#e.Success value) - - _ - (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object)))) - text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))] - (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation)))) - - ## else - (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object)))) - text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))] - (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation))) - ))) - -(def: #export (eval code) - (-> Expression (Meta Any)) - (function (_ compiler) - (let [interpreter (|> compiler (get@ #.host) (:coerce //.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 (:coerce 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))))))) diff --git a/stdlib/source/lux/host/ruby.lux b/stdlib/source/lux/host/ruby.lux index 6bf113ed0..8f54bbdeb 100644 --- a/stdlib/source/lux/host/ruby.lux +++ b/stdlib/source/lux/host/ruby.lux @@ -57,8 +57,6 @@ [Literal Computation] [Access Location] - [Loop Statement] - [Label Code] ) (template [<var> <brand> <prefix> <constructor>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux index 7bc52c318..01b405dff 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux @@ -41,7 +41,7 @@ (wrap (|> bodyO _.return (_.lambda #.None (list (..register register))) - (_.apply/* (list valueO)))))) + (_.do "call" (list valueO)))))) (def: #export (record-get generate valueS pathP) (-> Phase Synthesis (List (Either Nat Nat)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux index 486b68592..be12aa2e2 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux @@ -29,7 +29,7 @@ (do ////.monad [functionO (generate functionS) argsO+ (monad.map @ generate argsS+)] - (wrap (_.apply/* argsO+ functionO)))) + (wrap (_.do "call" argsO+ functionO)))) (def: #export capture (///reference.foreign _.local)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux index 6ff021863..a5dcc1302 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux @@ -7,5 +7,5 @@ ["." reference]]]) (def: #export system - (reference.system (: (-> Text (Expression Any)) _.local) + (reference.system (: (-> Text (Expression Any)) _.global) (: (-> Text (Expression Any)) _.local))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux index b3dcbd8ee..e39e6af8e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux @@ -162,9 +162,9 @@ (runtime: (sum//get sum wantsLast wantedTag) (let [no-match! (_.return _.nil) - sum-tag (_.nth (_.int +0) sum) - sum-flag (_.nth (_.int +1) sum) - sum-value (_.nth (_.int +2) sum) + sum-tag (_.nth (_.string ..variant-tag-field) sum) + sum-flag (_.nth (_.string ..variant-flag-field) sum) + sum-value (_.nth (_.string ..variant-value-field) sum) is-last? (_.= (_.string "") sum-flag) test-recursion! (_.if is-last? ## Must recurse. |