From 6c3e9f8c02ce153380392ba5bc8eeb517de5f781 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 9 Apr 2019 18:59:33 -0400 Subject: WIP: Ruby compiler. --- new-luxc/project.clj | 2 - new-luxc/source/luxc/lang/translation/ruby.lux | 195 --------------------- .../source/luxc/lang/translation/ruby/eval.jvm.lux | 124 ------------- 3 files changed, 321 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/ruby.lux delete mode 100644 new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux (limited to 'new-luxc') 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/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 [] - [(exception: #export ( {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 - [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 - [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 [] - [(exception: #export ( {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))))))) -- cgit v1.2.3