diff options
16 files changed, 991 insertions, 737 deletions
diff --git a/compilers.md b/compilers.md index beba9dcc3..5aabf4445 100644 --- a/compilers.md +++ b/compilers.md @@ -245,8 +245,16 @@ cd ~/lux/lux-ruby/ && lein clean && lein lux auto test ## Build ``` -cd ~/lux/lux-ruby/ && lein lux auto build -cd ~/lux/lux-ruby/ && lein clean && lein lux auto build +## Develop +cd ~/lux/lux-ruby/ \ +&& lein clean \ +&& lein lux auto build + +## Build JVM-based compiler +cd ~/lux/lux-ruby/ \ +&& lein clean \ +&& lein lux build \ +&& mv target/program.jar jvm_based_compiler.jar ``` ## Try diff --git a/lux-bootstrapper/src/lux/analyser/parser.clj b/lux-bootstrapper/src/lux/analyser/parser.clj index 6a46bab3c..15224573c 100644 --- a/lux-bootstrapper/src/lux/analyser/parser.clj +++ b/lux-bootstrapper/src/lux/analyser/parser.clj @@ -40,12 +40,15 @@ (return (&/|list head)))) state*)))) +(def ^:private class-name-regex + #"^([a-zA-Z0-9_\.$]+)") + (def ^:private parse-name - (|do [[_ _ =name] (&reader/read-regex #"^([a-zA-Z0-9_\.]+)")] + (|do [[_ _ =name] (&reader/read-regex class-name-regex)] (return =name))) (def ^:private parse-name? - (|do [[_ _ =name] (&reader/read-regex? #"^([a-zA-Z0-9_\.]+)")] + (|do [[_ _ =name] (&reader/read-regex? class-name-regex)] (return =name))) (def ^:private parse-ident diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 166dee982..366395232 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -281,7 +281,10 @@ (wrap [global value definition])))) (def: (ingest context content) - (|> content (\ encoding.utf8 decode) try.assume (:coerce (_.Statement Any)))) + (|> content + (\ encoding.utf8 decode) + try.assume + (:coerce (_.Statement Any)))) (def: (re_learn context content) (execute! content)) diff --git a/lux-ruby/project.clj b/lux-ruby/project.clj index c6cdfb6d9..88b172b40 100644 --- a/lux-ruby/project.clj +++ b/lux-ruby/project.clj @@ -22,7 +22,7 @@ :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"]] + [org.jruby/jruby-complete "9.2.15.0"]] :manifest {"lux" ~version} :source-paths ["source"] diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index 48a398233..e373e20b5 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -1,93 +1,131 @@ (.module: [lux #* + [program (#+ program:)] + ["." host (#+ import:)] + ["." meta] [abstract ["." monad (#+ do)]] [control - pipe - [cli (#+ program:)] - ["p" parser] + [pipe (#+ new>)] + ["." try (#+ Try)] ["." exception (#+ exception:)] - ["." io (#+ IO io)]] + ["." io (#+ IO io)] + [concurrency + ["." promise (#+ Promise)]] + ["<>" parser + ["<.>" code]]] [data ["." maybe] - ["." error (#+ Error)] - [number - ["." i64]] - ["." text ("#@." hash) - format] + ["." text ("#\." hash) + ["%" format (#+ format)] + ["." encoding]] [collection - ["." array (#+ Array)] - ["." list ("#@." functor)]]] + ["." array (#+ Array)]]] ["." macro - ["s" syntax (#+ syntax:)] - ["." code] - ["." template]] - [world - ["." file]] - ["." host (#+ import: interface: do-to object) + [syntax (#+ syntax:)] + ["." template] + ["." code]] + [math + [number + ["n" nat] + ["." i64]]] + ["." world #_ + ["." file] + ["#/." program]] + ["@" target ["_" ruby]] [tool [compiler - ["." name] - ["." synthesis] - [phase - [macro (#+ Expander)] - ["." generation - ["." ruby - ["." runtime] - ["." extension]]]] + [phase (#+ Operation Phase)] + [reference + [variable (#+ Register)]] + [language + [lux + [program (#+ Program)] + [generation (#+ Context Host)] + ["." synthesis] + [analysis + [macro (#+ Expander)]] + [phase + ["." extension (#+ Bundle Extender Handler) + ["#/." bundle] + ["." analysis #_ + ["#" ruby]] + ["." generation #_ + ["#" ruby]]] + [generation + ["." reference] + ["." ruby + ["." runtime]]]]]] [default - ["." platform (#+ Platform)]]]]] + ["." platform (#+ Platform)]] + [meta + ["." packager #_ + ["#" script]]]]]] [program ["/" compositor - ["/." cli]]]) + ["/." cli] + ["/." static]]]) + +(import: java/lang/String) -(import: #long java/lang/String) +(import: (java/lang/Class a)) -(import: #long (java/lang/Class a)) +(import: java/lang/Object + ["#::." + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))]) -(import: #long java/lang/Object - (toString [] java/lang/String) - (getClass [] (java/lang/Class java/lang/Object))) +(import: java/lang/Integer) -(import: #long java/lang/Integer) +(import: java/lang/Long + ["#::." + (intValue [] java/lang/Integer)]) -(import: #long java/lang/Long - (intValue [] java/lang/Integer)) +(import: org/jruby/RubyArray + ["#::." + (getLength [] int) + (get [int] #? Object)]) -(import: #long org/jruby/RubyArray - (getLength [] int) - (get [int] #? Object)) +(import: org/jruby/RubyHash + ["#::." + (get [java/lang/Object] #? java/lang/Object)]) -(import: #long org/jruby/RubyHash - (get [Object] #? Object)) +(import: org/jruby/Ruby + ["#::." + (getCurrentContext [] org/jruby/runtime/ThreadContext)]) -(import: #long org/jruby/runtime/builtin/IRubyObject) +(import: org/jruby/runtime/builtin/IRubyObject) -(import: #long org/jruby/runtime/ThreadContext) +(import: org/jruby/runtime/ThreadContext) (template [<name>] - [(interface: <name> + [(host.interface: <name> (getValue [] java/lang/Object)) (`` (import: (~~ (template.identifier ["program/" <name>])) - (getValue [] java/lang/Object)))] + ["#::." + (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)) +(syntax: (method_inputs {input_classes (<code>.tuple (<>.some <code>.any))}) + (monad.map meta.monad + (function (_ class) + (do meta.monad + [var (macro.gensym "input")] + (wrap (code.record (list [var class]))))) + input_classes)) -(import: #long org/jruby/runtime/JavaSites$CheckedSites) +(import: org/jruby/runtime/JavaSites$CheckedSites) +(import: org/jruby/runtime/builtin/Variable) +(import: org/jruby/runtime/builtin/InstanceVariables) +(import: org/jruby/runtime/builtin/InternalVariables) -(def: (lux-structure value) +(def: (lux_structure value) (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject) - (with-expansions [<checkers> (template [<name>] + (with_expansions [<checkers> (template [<name>] [[<name> [] boolean]] [isNil] [isTaint] [isClass] [isFrozen] @@ -119,13 +157,26 @@ ) <placeholders> (template [<name> <inputs> <output>] [(org/jruby/runtime/builtin/IRubyObject - (<name> (~~ (method-inputs <inputs>))) + (<name> self (~~ (method_inputs <inputs>))) <output> (error! (template.text ["UNIMPLEMENTED METHOD: " <name>])))] + [getRuntime [] org/jruby/Ruby] + [copySpecialInstanceVariables [org/jruby/runtime/builtin/IRubyObject] void] + [syncVariables [org/jruby/runtime/builtin/IRubyObject] void] + [syncVariables [(java/util/List (org/jruby/runtime/builtin/Variable java/lang/Object))] void] + [dataWrapStruct [java/lang/Object] void] + [addFinalizer [org/jruby/runtime/builtin/IRubyObject] void] + [removeFinalizers [] void] + [getVariable [int] java/lang/Object] + [setVariable [int java/lang/Object] void] + [getVariableList [] (java/util/List (org/jruby/runtime/builtin/Variable java/lang/Object))] + [getVariableNameList [] (java/util/List java/lang/String)] + [getVariableCount [] int] [getJavaClass [] (java/lang/Class java/lang/Object)] [asJavaString [] java/lang/String] [getInstanceVariables [] org/jruby/runtime/builtin/InstanceVariables] + [getInternalVariables [] org/jruby/runtime/builtin/InternalVariables] [convertToInteger [] org/jruby/RubyInteger] [convertToInteger [java/lang/String] org/jruby/RubyInteger] [convertToInteger [int java/lang/String] org/jruby/RubyInteger] @@ -164,10 +215,10 @@ java/lang/String] org/jruby/runtime/builtin/IRubyObject] - ## [checkCallMethod - ## [org/jruby/runtime/ThreadContext - ## org/jruby/runtime/JavaSites$CheckedSites] - ## org/jruby/runtime/builtin/IRubyObject] + [checkCallMethod + [org/jruby/runtime/ThreadContext + org/jruby/runtime/JavaSites$CheckedSites] + org/jruby/runtime/builtin/IRubyObject] <checkers> <markers> @@ -175,219 +226,297 @@ <class> <call> )] - (`` (object [] [program/StructureValue - org/jruby/runtime/builtin/IRubyObject] + (`` (host.object [] [program/StructureValue + org/jruby/runtime/builtin/IRubyObject] [] ## Methods (program/StructureValue - (getValue) + [] (getValue self) 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 [org/jruby/runtime/builtin/IRubyObject]}) + [] (callMethod self + {thread_context org/jruby/runtime/ThreadContext} + {member java/lang/String} + {inputs [org/jruby/runtime/builtin/IRubyObject]}) org/jruby/runtime/builtin/IRubyObject (exec - (log! (format "Was called: " (%t member))) + ("lux io log" (format "Was called: " (%.text member))) (error! "OOPS!"))) <placeholders> )))) -(import: #long org/jruby/RubyProc - (call [org/jruby/runtime/ThreadContext [org/jruby/runtime/builtin/IRubyObject]] - org/jruby/runtime/builtin/IRubyObject)) +(import: org/jruby/RubyProc + ["#::." + (call [org/jruby/runtime/ThreadContext [org/jruby/runtime/builtin/IRubyObject]] + #try 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])) +(import: org/jruby/javasupport/JavaArray + ["#::." + (new [org/jruby/Ruby java/lang/Object])]) (type: Translator - (-> java/lang/Object (Error Any))) + (-> java/lang/Object (Try Any))) -(def: (read-tuple read host-object) - (-> Translator org/jruby/RubyArray (Error Any)) - (let [size (:coerce Nat (org/jruby/RubyArray::getLength host-object))] +(def: (read_tuple read host_object) + (-> Translator org/jruby/RubyArray (Try 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) + (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) + (#try.Failure error) + (#try.Failure error) - (#error.Success lux-value) - (recur (inc idx) (array.write idx lux-value output)))) - (#error.Success output))))) + (#try.Success lux_value) + (recur (inc idx) (array.write! idx lux_value output)))) + (#try.Success output))))) -(exception: (unknown-kind-of-object {object java/lang/Object}) +(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)] +(def: (read_variant read host_object) + (-> Translator org/jruby/RubyHash (Try 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 _) - "" + (#try.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag)) + (: Any (case ?flag + (#.Some _) + "" - #.None - (host.null))) - value]) + #.None + (host.null))) + value]) _ - (exception.throw ..unknown-kind-of-object host-object))) + (exception.throw ..unknown_kind_of_object host_object))) -(exception: #export nil-has-no-lux-representation) +(exception: #export nil_has_no_lux_representation) -(def: (read host-object) +(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>) + (`` (<| (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] + [java/lang/Boolean #try.Success] + [java/lang/Long #try.Success] + [java/lang/Double #try.Success] + [java/lang/String #try.Success] + [org/jruby/RubyArray (read_tuple read)] + [org/jruby/RubyHash (read_variant read)] + [org/jruby/RubySymbol #try.Success] + [org/jruby/RubyProc #try.Success] )) - (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: (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: 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)) +(import: 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 +(def: ensure_macro (-> Macro (Maybe org/jruby/RubyProc)) (|>> (:coerce java/lang/Object) (host.check org/jruby/RubyProc))) -(template: (!ruby-runtime) +(template: (!ruby_runtime) (|> ..interpreter org/jruby/embed/ScriptingContainer::getProvider org/jruby/embed/internal/LocalContextProvider::getRuntime)) -(template: (!ruby-thread-context) - (|> (!ruby-runtime) +(template: (!ruby_thread_context) + (|> (!ruby_runtime) org/jruby/Ruby::getCurrentContext)) -(def: to-host +(def: to_host (-> Any org/jruby/runtime/builtin/IRubyObject) (|>> (:coerce (Array java/lang/Object)) - ..lux-structure - ## (org/jruby/javasupport/JavaArray::new (!ruby-runtime)) + ..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: (call_macro inputs lux macro) + (-> (List Code) Lux org/jruby/RubyProc (Try (Try [Lux (List Code)]))) + (:assume + (do try.monad + [expansion (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)] + (..read (:coerce java/lang/Object expansion))))) (def: (expander macro inputs lux) Expander - (case (ensure-macro macro) + (case (ensure_macro macro) (#.Some macro) - (case (call-macro inputs lux macro) - (#error.Success output) + (case (call_macro inputs lux macro) + (#try.Success output) (|> output (:coerce java/lang/Object) ..read - (:coerce (Error (Error [Lux (List Code)])))) + (:coerce (Try (Try [Lux (List Code)])))) - (#error.Failure error) - (#error.Failure error)) + (#try.Failure error) + (#try.Failure error)) #.None - (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro)))) + (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 + (IO (Host _.Expression _.Statement)) + (io (let [run! (: (-> (_.Code Any) (Try Any)) + (function (_ code) + (do try.monad [output (org/jruby/embed/ScriptingContainer::runScriptlet (_.code code) ..interpreter)] (..read (maybe.default (:coerce java/lang/Object []) output)))))] - (: Host + (: (Host _.Expression _.Statement) (structure - (def: evaluate! run!) + (def: (evaluate! context code) + (run! code)) + (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))) + + (def: (define! context input) + (let [global (reference.artifact context) @global (_.global global)] - (do error.monad + (do try.monad [#let [definition (_.set (list @global) input)] - _ (run! global definition) - value (run! global @global)] - (wrap [global value definition]))))))))) + _ (run! definition) + value (run! @global)] + (wrap [global value definition])))) + + (def: (ingest context content) + (|> content + (\ encoding.utf8 decode) + try.assume + (:coerce _.Statement))) + + (def: (re_learn context content) + (run! content)) + + (def: (re_load context content) + (do try.monad + [_ (run! content)] + (run! (_.global (reference.artifact context)))))))))) (def: platform - (IO (Platform IO _.LVar (_.Expression Any) (_.Statement Any))) + (IO (Platform _.LVar _.Expression _.Statement)) (do io.monad [host ..host] - (wrap {#platform.&monad io.monad - #platform.&file-system file.system + (wrap {#platform.&file_system (file.async file.default) #platform.host host #platform.phase ruby.generate - #platform.runtime runtime.generate}))) + #platform.runtime runtime.generate + #platform.write (|>> _.code (\ encoding.utf8 encode))}))) -(def: (program program) - (-> (_.Expression Any) (_.Statement Any)) - (_.statement (_.apply/* (list (runtime.lux//program-args _.command-line-arguments) +(def: (program context program) + (Program _.Expression _.Statement) + (_.statement (_.apply/* (list (runtime.lux//program_args _.command_line_arguments) _.nil) program))) +(import: org/jruby/RubyString + ["#::." + (#static newInternalFromJavaExternal [org/jruby/Ruby java/lang/String] org/jruby/RubyString)]) + +(def: extender + Extender + ## TODO: Stop relying on coercions ASAP. + (<| (:coerce Extender) + (function (@self handler)) + (:coerce Handler) + (function (@self name phase)) + (:coerce Phase) + (function (@self archive parameters)) + (:coerce Operation) + (function (@self state)) + (:coerce Try) + try.assume + (:coerce Try) + (do try.monad + [handler (try.from_maybe (..ensure_macro handler)) + output (org/jruby/RubyProc::call (!ruby_thread_context) + (|> (host.array org/jruby/runtime/builtin/IRubyObject 5) + (host.array_write 0 (org/jruby/RubyString::newInternalFromJavaExternal (!ruby_runtime) name)) + (host.array_write 1 (..to_host phase)) + (host.array_write 2 (..to_host archive)) + (host.array_write 3 (..to_host parameters)) + (host.array_write 4 (..to_host state))) + handler)] + (..read (:coerce java/lang/Object output))))) + +(def: (declare_success! _) + (-> Any (Promise Any)) + (promise.future (\ world/program.default exit +0))) + +(def: (scope body!) + (-> _.Statement _.Statement) + (let [@program (_.local "lux_program")] + ($_ _.then + (_.function @program (list) body!) + (_.statement (_.apply/* (list) @program)) + ))) + (program: [{service /cli.service}] - (/.compiler ..expander - ..platform - extension.bundle - ..program - service)) + (let [extension ".rb"] + (exec (do promise.monad + [_ (/.compiler {#/static.host @.ruby + #/static.host_module_extension extension + #/static.target (/cli.target service) + #/static.artifact_extension extension} + ..expander + analysis.bundle + ..platform + generation.bundle + extension/bundle.empty + ..program + [_.LVar + _.Expression + _.Statement] + ..extender + service + [(packager.package (: _.Statement (_.manual "")) + _.code + _.then + ..scope) + (format (/cli.target service) + (\ file.default separator) + "program" + extension)])] + (..declare_success! [])) + (io.io [])))) diff --git a/stdlib/source/lux/target/ruby.lux b/stdlib/source/lux/target/ruby.lux index e1df6bba6..c170f3504 100644 --- a/stdlib/source/lux/target/ruby.lux +++ b/stdlib/source/lux/target/ruby.lux @@ -1,26 +1,40 @@ (.module: - [lux (#- Code Global static int if cond function or and not comment) + [lux (#- Location Code static int if cond function or and not comment) + ["@" target] + ["." host] [control [pipe (#+ case> cond> new>)]] [data - [number - ["f" frac]] ["." text ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)]]] [macro ["." template]] + [math + [number + ["f" frac]]] [type abstract]]) -(def: input-separator ", ") -(def: statement-suffix ";") +(def: input_separator ", ") +(def: statement_suffix ";") + +(for {@.old (as_is (host.import: java/lang/CharSequence) + (host.import: java/lang/String + ["#::." + (replace [java/lang/CharSequence java/lang/CharSequence] java/lang/String)]))} + (as_is)) (def: nest (-> Text Text) - (|>> (format text.new-line) - (text.replace-all text.new-line (format text.new-line text.tab)))) + (.let [nested_new_line (format text.new_line text.tab)] + (for {@.old (|>> (format text.new_line) + (:coerce java/lang/String) + (java/lang/String::replace (:coerce java/lang/CharSequence text.new_line) + (:coerce java/lang/CharSequence nested_new_line)))} + (|>> (format text.new_line) + (text.replace_all text.new_line nested_new_line))))) (abstract: #export (Code brand) Text @@ -33,82 +47,76 @@ (-> (Code Any) Text) (|>> :representation)) - (template [<type> <super>] - [(with-expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: #export (<brand> brand) Any)) - (`` (type: #export (<type> brand) - (<super> (<brand> brand)))))] + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any) + (`` (type: #export <type> (|> Any <brand> (~~ (template.splice <super>+))))))] - [Expression Code] - [Computation Expression] - [Location Computation] - [Var Location] - [Statement Code] + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [LVar [Var' Location' Computation' Expression' Code]] + [Statement [Code]] ) - (template [<type> <super>] - [(with-expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: #export <brand> Any)) - (`` (type: #export <type> (<super> <brand>))))] - - [Literal Computation] - [Access Location] + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: #export <brand> Any) + (`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [GVar [Var' Location' Computation' Expression' Code]] + [IVar [Var' Location' Computation' Expression' Code]] + [SVar [Var' Location' Computation' Expression' Code]] + [LVar* [LVar' Var' Location' Computation' Expression' Code]] + [LVar** [LVar' Var' Location' Computation' Expression' Code]] ) - (template [<var> <brand> <prefix> <constructor>] - [(abstract: #export <brand> Any) - - (type: #export <var> (Var <brand>)) - - (def: #export <constructor> + (template [<var> <prefix> <constructor>] + [(def: #export <constructor> (-> Text <var>) (|>> (format <prefix>) :abstraction))] - [GVar Global "$" global] - [IVar Instance "@" instance] - [SVar Static "@@" static] + [GVar "$" global] + [IVar "@" instance] + [SVar "@@" static] ) - (abstract: #export (Local brand) Any) - (type: #export LVar (Var (Local Any))) - (def: #export local (-> Text LVar) (|>> :abstraction)) - (template [<var> <brand> <prefix> <modifier> <unpacker>] - [(abstract: #export <brand> Any) - - (type: #export <var> (Var (Local <brand>))) - - (template [<name> <input> <output>] + (template [<var> <prefix> <modifier> <unpacker>] + [(template [<name> <input> <output>] [(def: #export <name> (-> <input> <output>) (|>> :representation (format <prefix>) :abstraction))] [<modifier> LVar <var>] - [<unpacker> (Expression Any) (Computation Any)] + [<unpacker> Expression Computation] )] - [LVar* Poly "*" variadic splat] - [LVar** PolyKV "**" variadic-kv double-splat] + [LVar* "*" variadic splat] + [LVar** "**" variadic_kv double_splat] ) - (template [<ruby-name> <lux-name>] - [(def: #export <lux-name> (..global <ruby-name>))] - - ["@" latest-error] - ["_" last-string-read] - ["." last-line-number-read] - ["&" last-string-matched] - ["~" last-regexp-match] - ["=" case-insensitivity-flag] - ["/" input-record-separator] - ["\" output-record-separator] - ["0" script-name] - ["*" command-line-arguments] - ["$" process-id] - ["?" exit-status] + (template [<ruby_name> <lux_name>] + [(def: #export <lux_name> (..global <ruby_name>))] + + ["@" latest_error] + ["_" last_string_read] + ["." last_line_number_read] + ["&" last_string_matched] + ["~" last_regexp_match] + ["=" case_insensitivity_flag] + ["/" input_record_separator] + ["\" output_record_separator] + ["0" script_name] + ["*" command_line_arguments] + ["$" process_id] + ["?" exit_status] ) (def: #export nil @@ -124,17 +132,17 @@ (def: sanitize (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] - [(text.replace-all <find> <replace>)] + [(text.replace_all <find> <replace>)] ["\" "\\"] [text.tab "\t"] - [text.vertical-tab "\v"] + [text.vertical_tab "\v"] [text.null "\0"] - [text.back-space "\b"] - [text.form-feed "\f"] - [text.new-line "\n"] - [text.carriage-return "\r"] - [text.double-quote (format "\" text.double-quote)] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] )) ))) @@ -149,63 +157,63 @@ (def: #export float (-> Frac Literal) - (|>> (cond> [(f.= f.positive-infinity)] + (|>> (cond> [(f.= f.positive_infinity)] [(new> "(+1.0/0.0)" [])] - [(f.= f.negative-infinity)] + [(f.= f.negative_infinity)] [(new> "(-1.0/0.0)" [])] - [(f.= f.not-a-number)] + [(f.= f.not_a_number)] [(new> "(+0.0/-0.0)" [])] ## else [%.frac]) :abstraction)) - (def: #export (array-range from to array) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (def: #export (array_range from to array) + (-> Expression Expression Expression Computation) (|> (format (:representation from) ".." (:representation to)) (text.enclose ["[" "]"]) (format (:representation array)) :abstraction)) (def: #export array - (-> (List (Expression Any)) Literal) + (-> (List Expression) Literal) (|>> (list\map (|>> :representation)) - (text.join-with ..input-separator) + (text.join_with ..input_separator) (text.enclose ["[" "]"]) :abstraction)) (def: #export hash - (-> (List [(Expression Any) (Expression Any)]) Literal) + (-> (List [Expression Expression]) Literal) (|>> (list\map (.function (_ [k v]) (format (:representation k) " => " (:representation v)))) - (text.join-with ..input-separator) + (text.join_with ..input_separator) (text.enclose ["{" "}"]) :abstraction)) (def: #export (apply/* args func) - (-> (List (Expression Any)) (Expression Any) (Computation Any)) + (-> (List Expression) Expression Computation) (|> args (list\map (|>> :representation)) - (text.join-with ..input-separator) + (text.join_with ..input_separator) (text.enclose ["(" ")"]) (format (:representation func)) :abstraction)) (def: #export (the field object) - (-> Text (Expression Any) Access) + (-> Text Expression Access) (:abstraction (format (:representation object) "." field))) (def: #export (nth idx array) - (-> (Expression Any) (Expression Any) Access) + (-> Expression Expression Access) (|> (:representation idx) (text.enclose ["[" "]"]) (format (:representation array)) :abstraction)) (def: #export (? test then else) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (-> Expression Expression Expression Computation) (|> (format (:representation test) " ? " (:representation then) " : " (:representation else)) @@ -213,92 +221,92 @@ :abstraction)) (def: #export statement - (-> (Expression Any) (Statement Any)) + (-> Expression Statement) (|>> :representation - (text.suffix ..statement-suffix) + (text.suffix ..statement_suffix) :abstraction)) (def: #export (then pre! post!) - (-> (Statement Any) (Statement Any) (Statement Any)) + (-> Statement Statement Statement) (:abstraction (format (:representation pre!) - text.new-line + text.new_line (:representation post!)))) (def: #export (set vars value) - (-> (List (Location Any)) (Expression Any) (Statement Any)) + (-> (List Location) Expression Statement) (:abstraction (format (|> vars (list\map (|>> :representation)) - (text.join-with ..input-separator)) - " = " (:representation value) ..statement-suffix))) + (text.join_with ..input_separator)) + " = " (:representation value) ..statement_suffix))) (def: (block content) (-> Text Text) (format content - text.new-line "end" ..statement-suffix)) + text.new_line "end" ..statement_suffix)) (def: #export (if test then! else!) - (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) + (-> Expression Statement Statement Statement) (<| :abstraction ..block (format "if " (:representation test) - text.new-line (..nest (:representation then!)) - text.new-line "else" - text.new-line (..nest (:representation else!))))) + text.new_line (..nest (:representation then!)) + text.new_line "else" + text.new_line (..nest (:representation else!))))) (template [<name> <block>] [(def: #export (<name> test then!) - (-> (Expression Any) (Statement Any) (Statement Any)) + (-> Expression Statement Statement) (<| :abstraction ..block (format <block> " " (:representation test) - text.new-line (..nest (:representation then!)))))] + text.new_line (..nest (:representation then!)))))] [when "if"] [while "while"] ) - (def: #export (for-in var array iteration!) - (-> LVar (Expression Any) (Statement Any) (Statement Any)) + (def: #export (for_in var array iteration!) + (-> LVar Expression Statement Statement) (<| :abstraction ..block (format "for " (:representation var) " in " (:representation array) " do " - text.new-line (..nest (:representation iteration!))))) + text.new_line (..nest (:representation iteration!))))) (type: #export Rescue {#classes (List Text) #exception LVar - #rescue (Statement Any)}) + #rescue Statement}) (def: #export (begin body! rescues) - (-> (Statement Any) (List Rescue) (Statement Any)) + (-> Statement (List Rescue) Statement) (<| :abstraction ..block (format "begin" - text.new-line (:representation body!) + text.new_line (:representation body!) (|> rescues (list\map (.function (_ [classes exception rescue]) - (format text.new-line "rescue " (text.join-with ..input-separator classes) + (format text.new_line "rescue " (text.join_with ..input_separator classes) " => " (:representation exception) - text.new-line (..nest (:representation rescue))))) - (text.join-with text.new-line))))) + text.new_line (..nest (:representation rescue))))) + (text.join_with text.new_line))))) (def: #export (return value) - (-> (Expression Any) (Statement Any)) - (:abstraction (format "return " (:representation value) ..statement-suffix))) + (-> Expression Statement) + (:abstraction (format "return " (:representation value) ..statement_suffix))) (def: #export (raise message) - (-> (Expression Any) (Computation Any)) + (-> Expression Computation) (:abstraction (format "raise " (:representation message)))) (template [<name> <keyword>] [(def: #export <name> - (Statement Any) + Statement (|> <keyword> - (text.suffix ..statement-suffix) + (text.suffix ..statement_suffix) :abstraction))] [next "next"] @@ -307,21 +315,21 @@ ) (def: #export (function name args body!) - (-> LVar (List (Var Any)) (Statement Any) (Statement Any)) + (-> LVar (List Var) Statement Statement) (<| :abstraction ..block (format "def " (:representation name) (|> args (list\map (|>> :representation)) - (text.join-with ..input-separator) + (text.join_with ..input_separator) (text.enclose ["(" ")"])) - text.new-line (:representation body!)))) + text.new_line (:representation body!)))) (def: #export (lambda name args body!) - (-> (Maybe LVar) (List (Var Any)) (Statement Any) Literal) + (-> (Maybe LVar) (List Var) Statement Literal) (let [proc (|> (format (|> args (list\map (|>> :representation)) - (text.join-with ..input-separator) + (text.join_with ..input_separator) (text.enclose' "|")) " " (:representation body!)) @@ -338,7 +346,7 @@ (template [<op> <name>] [(def: #export (<name> parameter subject) - (-> (Expression Any) (Expression Any) (Computation Any)) + (-> Expression Expression Computation) (:abstraction (format "(" (:representation subject) " " <op> " " (:representation parameter) ")")))] ["==" =] @@ -356,30 +364,30 @@ ["||" or] ["&&" and] - [ "|" bit-or] - [ "&" bit-and] - [ "^" bit-xor] + [ "|" bit_or] + [ "&" bit_and] + [ "^" bit_xor] - ["<<" bit-shl] - [">>" bit-shr] + ["<<" bit_shl] + [">>" bit_shr] ) (def: #export (not subject) - (-> (Expression Any) (Computation Any)) + (-> Expression Computation) (:abstraction (format "(!" (:representation subject) ")"))) (def: #export (comment commentary on) (All [brand] (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..sanitize commentary) text.new-line + (:abstraction (format "# " (..sanitize commentary) text.new_line (:representation on)))) ) (def: #export (do method args object) - (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) + (-> Text (List Expression) Expression Computation) (|> object (..the method) (..apply/* args))) (def: #export (cond clauses else!) - (-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any)) + (-> (List [Expression Statement]) Statement Statement) (list\fold (.function (_ [test then!] next!) (..if test then! next!)) else! diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux new file mode 100644 index 000000000..3b9f4ad75 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -0,0 +1,34 @@ +(.module: + [lux #* + ["." host] + [abstract + ["." monad (#+ do)]] + [control + ["<>" parser + ["<c>" code (#+ Parser)]]] + [data + [collection + ["." array (#+ Array)] + ["." dictionary] + ["." list]]] + ["." type + ["." check]] + ["@" target + ["_" ruby]]] + [// + ["/" lux (#+ custom)] + [// + ["." bundle] + [// + ["." analysis #_ + ["#/." type]] + [// + ["." analysis (#+ Analysis Operation Phase Handler Bundle)] + [/// + ["." phase]]]]]]) + +(def: #export bundle + Bundle + (<| (bundle.prefix "ruby") + (|> bundle.empty + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index 0ab831668..d43f3833a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -3,64 +3,88 @@ [abstract ["." monad (#+ do)]] [control - ["." function]] + ["." function] + ["." try] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] [data ["." product] - ["." text] - [number - ["f" frac]] + ["." text + ["%" format (#+ format)]] [collection - ["." dictionary]]] + ["." dictionary] + ["." list ("#\." functor fold)]]] + [math + [number + ["f" frac]]] [target ["_" ruby (#+ Expression)]]] - [//// + ["." //// #_ ["/" bundle] - [// + ["/#" // #_ + ["." extension] [generation [extension (#+ Nullary Unary Binary Trinary nullary unary binary trinary)] ["//" ruby #_ - ["#." runtime (#+ Operation Phase Handler Bundle)]]]]]) + ["#." runtime (#+ Operation Phase Handler Bundle Generator)]]] + [// + [synthesis (#+ %synthesis)] + ["." generation] + [/// + ["#" phase]]]]]) + +(def: #export (custom [parser handler]) + (All [s] + (-> [(Parser s) + (-> Text (Generator s))] + Handler)) + (function (_ extension_name phase archive input) + (case (<s>.run parser input) + (#try.Success input') + (handler extension_name phase archive input') -(def: lux-procs + (#try.Failure error) + (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + +(def: lux_procs Bundle (|> /.empty (/.install "is" (binary (product.uncurry _.=))) (/.install "try" (unary //runtime.lux//try)))) -(def: keep-i64 +(def: keep_i64 (All [input] - (-> (-> input (Expression Any)) - (-> input (Expression Any)))) - (function.compose (_.bit-and (_.manual "0xFFFFFFFFFFFFFFFF")))) + (-> (-> input Expression) + (-> input Expression))) + (function.compose (_.bit_and (_.manual "0xFFFFFFFFFFFFFFFF")))) -(def: i64-procs +(def: i64_procs Bundle (<| (/.prefix "i64") (|> /.empty - (/.install "and" (binary (product.uncurry _.bit-and))) - (/.install "or" (binary (product.uncurry _.bit-or))) - (/.install "xor" (binary (product.uncurry _.bit-xor))) - (/.install "left-shift" (binary (..keep-i64 (product.uncurry _.bit-shl)))) - (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic-right-shift))) - (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) + (/.install "and" (binary (product.uncurry _.bit_and))) + (/.install "or" (binary (product.uncurry _.bit_or))) + (/.install "xor" (binary (product.uncurry _.bit_xor))) + (/.install "left-shift" (binary (..keep_i64 (product.uncurry _.bit_shl)))) + (/.install "right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift))) (/.install "=" (binary (product.uncurry _.=))) - (/.install "+" (binary (..keep-i64 (product.uncurry _.+)))) - (/.install "-" (binary (..keep-i64 (product.uncurry _.-)))) + (/.install "+" (binary (..keep_i64 (product.uncurry _.+)))) + (/.install "-" (binary (..keep_i64 (product.uncurry _.-)))) ))) -(def: int-procs +(def: int_procs Bundle (<| (/.prefix "int") (|> /.empty (/.install "<" (binary (product.uncurry _.<))) - (/.install "*" (binary (..keep-i64 (product.uncurry _.*)))) + (/.install "*" (binary (..keep_i64 (product.uncurry _.*)))) (/.install "/" (binary (product.uncurry _./))) (/.install "%" (binary (product.uncurry _.%))) (/.install "frac" (unary (_./ (_.float +1.0)))) (/.install "char" (unary (_.do "chr" (list))))))) -(def: frac-procs +(def: frac_procs Bundle (<| (/.prefix "frac") (|> /.empty @@ -76,18 +100,18 @@ (/.install "decode" (unary //runtime.f64//decode))))) (def: (text//char [subjectO paramO]) - (Binary (Expression Any)) + (Binary Expression) (//runtime.text//char subjectO paramO)) (def: (text//clip [paramO extraO subjectO]) - (Trinary (Expression Any)) + (Trinary Expression) (//runtime.text//clip subjectO paramO extraO)) (def: (text//index [startO partO textO]) - (Trinary (Expression Any)) + (Trinary Expression) (//runtime.text//index textO partO startO)) -(def: text-procs +(def: text_procs Bundle (<| (/.prefix "text") (|> /.empty @@ -101,43 +125,38 @@ ))) (def: (io//log! messageG) - (Unary (Expression Any)) - (_.or (_.apply/* (list (|> messageG (_.+ (_.string text.new-line)))) + (Unary Expression) + (_.or (_.apply/* (list (|> messageG (_.+ (_.string text.new_line)))) (_.local "puts")) //runtime.unit)) (def: io//error! - (Unary (Expression Any)) + (Unary Expression) _.raise) -(def: (io//exit! code) - (Unary (Expression Any)) - (_.apply/* (list code) (_.local "exit"))) - -(def: (io//current-time! _) - (Nullary (Expression Any)) +(def: (io//current_time! _) + (Nullary Expression) (|> (_.local "Time") (_.do "now" (list)) (_.do "to_f" (list)) (_.* (_.float +1000.0)) (_.do "to_i" (list)))) -(def: io-procs +(def: io_procs Bundle (<| (/.prefix "io") (|> /.empty (/.install "log" (unary ..io//log!)) (/.install "error" (unary ..io//error!)) - (/.install "exit" (unary ..io//exit!)) - (/.install "current-time" (nullary ..io//current-time!))))) + (/.install "current-time" (nullary ..io//current_time!))))) (def: #export bundle Bundle (<| (/.prefix "lux") - (|> lux-procs - (dictionary.merge ..i64-procs) - (dictionary.merge ..int-procs) - (dictionary.merge ..frac-procs) - (dictionary.merge ..text-procs) - (dictionary.merge ..io-procs) + (|> lux_procs + (dictionary.merge ..i64_procs) + (dictionary.merge ..int_procs) + (dictionary.merge ..frac_procs) + (dictionary.merge ..text_procs) + (dictionary.merge ..io_procs) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux index 2de025059..cdaabfc08 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -48,17 +48,13 @@ (^ (////synthesis.branch/case case)) (/case.case! false statement expression archive case) - (^ (////synthesis.branch/let let)) - (/case.let! statement expression archive let) - - (^ (////synthesis.branch/if if)) - (/case.if! statement expression archive if) - - (^ (////synthesis.loop/scope scope)) - (/loop.scope! statement expression archive scope) - - (^ (////synthesis.loop/recur updates)) - (/loop.recur! statement expression archive updates) + (^template [<tag> <generator>] + [(^ (<tag> value)) + (<generator> statement expression archive value)]) + ([////synthesis.branch/let /case.let!] + [////synthesis.branch/if /case.if!] + [////synthesis.loop/scope /loop.scope!] + [////synthesis.loop/recur /loop.recur!]) (^ (////synthesis.function/abstraction abstraction)) (//////phase\map _.return (/function.function statement expression archive abstraction)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 62225bb9c..eb6ae3e19 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -177,7 +177,7 @@ (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) (function (recur pathP) (.case pathP - (^ (/////synthesis.path/then bodyS)) + (#/////synthesis.Then bodyS) (statement expression archive bodyS) #/////synthesis.Pop @@ -203,31 +203,20 @@ else! then!)))) - (#/////synthesis.I64_Fork cons) - (do {! ///////phase.monad} - [clauses (monad.map ! (function (_ [match then]) - (do ! - [then! (recur then)] - (wrap [(_.= (//primitive.i64 (.int match)) - ..peek) - then!]))) - (#.Cons cons))] - (wrap (_.cond clauses - ..fail_pm!))) - (^template [<tag> <format>] [(<tag> cons) (do {! ///////phase.monad} [clauses (monad.map ! (function (_ [match then]) (\ ! map - (|>> [(_.= (<format> match) + (|>> [(_.= (|> match <format>) ..peek)]) (recur then))) (#.Cons cons))] (wrap (_.cond clauses ..fail_pm!)))]) - ([#/////synthesis.F64_Fork //primitive.f64] - [#/////synthesis.Text_Fork //primitive.text]) + ([#/////synthesis.I64_Fork (<| //primitive.i64 .int)] + [#/////synthesis.F64_Fork (<| //primitive.f64)] + [#/////synthesis.Text_Fork (<| //primitive.text)]) (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux index d7e02b980..9524441f2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux @@ -1,21 +1,30 @@ (.module: [lux #* [abstract - [monad (#+ do)]]] + [monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [target + ["_" ruby]]] ["." / #_ - [runtime (#+ Phase)] + [runtime (#+ Phase Phase!)] ["#." primitive] ["#." structure] - ["#." reference ("#\." system)] + ["#." reference] ["#." function] ["#." case] ["#." loop] - ["//#" /// #_ - ["#." extension] + ["/#" // #_ + ["#." reference] ["/#" // #_ - ["#." synthesis] - ["//#" /// #_ - ["#." phase ("#\." monad)]]]]]) + ["#." extension] + ["/#" // #_ + [analysis (#+)] + ["#." synthesis] + ["//#" /// #_ + ["#." phase ("#\." monad)] + [reference (#+) + [variable (#+)]]]]]]]) (def: #export (generate archive synthesis) Phase @@ -28,35 +37,25 @@ [////synthesis.f64 /primitive.f64] [////synthesis.text /primitive.text]) - (^ (////synthesis.variant variantS)) - (/structure.variant generate archive variantS) - - (^ (////synthesis.tuple members)) - (/structure.tuple generate archive members) + (^template [<tag> <generator>] + [(^ (<tag> value)) + (<generator> generate archive value)]) + ([////synthesis.variant /structure.variant] + [////synthesis.tuple /structure.tuple] + + [////synthesis.branch/case /case.case] + [////synthesis.branch/let /case.let] + [////synthesis.branch/if /case.if] + [////synthesis.branch/get /case.get] + + [////synthesis.loop/scope /loop.scope] + [////synthesis.loop/recur /loop.recur] + + [////synthesis.function/abstraction /function.function] + [////synthesis.function/apply /function.apply]) (#////synthesis.Reference value) - (/reference\reference archive value) - - (^ (////synthesis.branch/case case)) - (/case.case generate archive case) - - (^ (////synthesis.branch/let let)) - (/case.let generate archive let) - - (^ (////synthesis.branch/if if)) - (/case.if generate archive if) - - (^ (////synthesis.loop/scope scope)) - (/loop.scope generate archive scope) - - (^ (////synthesis.loop/recur updates)) - (/loop.recur generate archive updates) - - (^ (////synthesis.function/abstraction abstraction)) - (/function.function generate archive abstraction) - - (^ (////synthesis.function/apply application)) - (/function.apply generate archive application) + (//reference.reference /reference.system archive value) (#////synthesis.Extension extension) (///extension.apply archive generate extension))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index bd85ca44a..fd9916a9b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -1,21 +1,24 @@ (.module: [lux (#- case let if) [abstract - [monad (#+ do)]] + ["." monad (#+ do)]] [control - ["ex" exception (#+ exception:)]] + [exception (#+ exception:)]] [data - ["." text] - [number - ["n" nat] - ["i" int]] + ["." text + ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)] ["." set]]] + [math + [number + ["n" nat] + ["i" int]]] [target - ["_" ruby (#+ Expression Statement)]]] + ["_" ruby (#+ Expression LVar Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase Generator)] + ["#." runtime (#+ Operation Phase Generator Phase! Generator!)] + ["#." reference] ["#." primitive] ["/#" // #_ ["#." reference] @@ -23,35 +26,46 @@ [synthesis ["." case]] ["/#" // #_ - ["#." synthesis (#+ Synthesis Path)] + ["#." synthesis (#+ Member Synthesis Path)] ["#." generation] ["//#" /// #_ - ["#." reference (#+ Register)] + [reference + ["#." variable (#+ Register)]] ["#." phase ("#\." monad)] [meta [archive (#+ Archive)]]]]]]]) (def: #export register - (///reference.local _.local)) + (-> Register LVar) + (|>> (///reference.local //reference.system) :assume)) (def: #export capture - (///reference.foreign _.local)) + (-> Register LVar) + (|>> (///reference.foreign //reference.system) :assume)) -(def: #export (let generate archive [valueS register bodyS]) +(def: #export (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) (do ///////phase.monad - [valueO (generate archive valueS) - bodyO (generate archive bodyS)] + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (|> bodyO _.return (_.lambda #.None (list (..register register))) (_.do "call" (list valueO)))))) -(def: #export (record-get generate archive [valueS pathP]) - (Generator [Synthesis (List (Either Nat Nat))]) +(def: #export (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (wrap (_.? testO thenO elseO)))) + +(def: #export (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) (do ///////phase.monad - [valueO (generate archive valueS)] + [valueO (expression archive valueS)] (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -61,56 +75,48 @@ [#.Right //runtime.tuple//right]))] (method source))) valueO - pathP)))) - -(def: #export (if generate archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (generate archive testS) - thenO (generate archive thenS) - elseO (generate archive elseS)] - (wrap (_.? testO thenO elseO)))) + (list.reverse pathP))))) (def: @savepoint (_.local "lux_pm_savepoint")) (def: @cursor (_.local "lux_pm_cursor")) (def: @temp (_.local "lux_pm_temp")) (def: (push! value) - (-> (Expression Any) (Statement Any)) + (-> Expression Statement) (_.statement (|> @cursor (_.do "push" (list value))))) -(def: peek-and-pop - (Expression Any) +(def: peek_and_pop + Expression (|> @cursor (_.do "pop" (list)))) (def: pop! - (Statement Any) - (_.statement ..peek-and-pop)) + Statement + (_.statement ..peek_and_pop)) (def: peek - (Expression Any) + Expression (_.nth (_.int -1) @cursor)) (def: save! - (Statement Any) - (.let [cursor (_.array-range (_.int +0) (_.int -1) @cursor)] + Statement + (.let [cursor (_.array_range (_.int +0) (_.int -1) @cursor)] (_.statement (|> @savepoint (_.do "push" (list cursor)))))) (def: restore! - (Statement Any) + Statement (_.set (list @cursor) (|> @savepoint (_.do "pop" (list))))) (def: fail! _.break) -(def: (multi-pop! pops) - (-> Nat (Statement Any)) +(def: (multi_pop! pops) + (-> Nat Statement) (_.statement (_.do "slice!" (list (_.int (i.* -1 (.int pops))) (_.int (.int pops))) @cursor))) (template [<name> <flag> <prep>] [(def: (<name> simple? idx) - (-> Bit Nat (Statement Any)) + (-> Bit Nat Statement) ($_ _.then (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) (.if simple? @@ -120,12 +126,12 @@ fail! (..push! @temp)))))] - [left-choice _.nil (<|)] - [right-choice (_.string "") inc] + [left_choice _.nil (<|)] + [right_choice (_.string "") inc] ) (def: (alternation pre! post!) - (-> (Statement Any) (Statement Any) (Statement Any)) + (-> Statement Statement Statement) ($_ _.then (_.while (_.bool true) ($_ _.then @@ -135,88 +141,112 @@ ..restore! post!))) -(def: (pattern-matching' generate archive pathP) - (-> Phase Archive Path (Operation (Statement Any))) - (.case pathP - (^ (/////synthesis.path/then bodyS)) - (///////phase\map _.return (generate archive bodyS)) - - #/////synthesis.Pop - (///////phase\wrap ..pop!) - - (#/////synthesis.Bind register) - (///////phase\wrap (_.set (list (..register register)) ..peek)) - - (^template [<tag> <format>] - [(^ (<tag> value)) - (///////phase\wrap (_.when (|> value <format> (_.= ..peek) _.not) - fail!))]) - ([/////synthesis.path/bit //primitive.bit] - [/////synthesis.path/i64 //primitive.i64] - [/////synthesis.path/f64 //primitive.f64] - [/////synthesis.path/text //primitive.text]) - - (^template [<complex> <simple> <choice>] - [(^ (<complex> idx)) - (///////phase\wrap (<choice> false idx)) - - (^ (<simple> idx nextP)) - (|> nextP - (pattern-matching' generate archive) - (///////phase\map (_.then (<choice> true idx))))]) - ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] - [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) - - (^ (/////synthesis.member/left 0)) - (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) - - (^template [<pm> <getter>] - [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (^ (/////synthesis.!bind-top register thenP)) - (do ///////phase.monad - [then! (pattern-matching' generate archive thenP)] - (///////phase\wrap ($_ _.then - (_.set (list (..register register)) ..peek-and-pop) - then!))) - - (^ (/////synthesis.!multi-pop nextP)) - (.let [[extra-pops nextP'] (case.count-pops nextP)] +(def: (pattern_matching' expression archive) + (-> Phase Archive Path (Operation Statement)) + (function (recur pathP) + (.case pathP + (#/////synthesis.Then bodyS) + (///////phase\map _.return (expression archive bodyS)) + + #/////synthesis.Pop + (///////phase\wrap ..pop!) + + (#/////synthesis.Bind register) + (///////phase\wrap (_.set (list (..register register)) ..peek)) + + (#/////synthesis.Bit_Fork when thenP elseP) + (do {! ///////phase.monad} + [then! (recur thenP) + else! (.case elseP + (#.Some elseP) + (recur elseP) + + #.None + (wrap ..fail!))] + (wrap (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^template [<tag> <format>] + [(<tag> cons) + (do {! ///////phase.monad} + [clauses (monad.map ! (function (_ [match then]) + (\ ! map + (|>> [(_.= (|> match <format>) + ..peek)]) + (recur then))) + (#.Cons cons))] + (wrap (_.cond clauses + ..fail!)))]) + ([#/////synthesis.I64_Fork (<| //primitive.i64 .int)] + [#/////synthesis.F64_Fork (<| //primitive.f64)] + [#/////synthesis.Text_Fork (<| //primitive.text)]) + + (^template [<complex> <simple> <choice>] + [(^ (<complex> idx)) + (///////phase\wrap (<choice> false idx)) + + (^ (<simple> idx nextP)) + (|> nextP + recur + (///////phase\map (_.then (<choice> true idx))))]) + ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] + [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + + (^ (/////synthesis.member/left 0)) + (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) + + (^template [<pm> <getter>] + [(^ (<pm> lefts)) + (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad - [next! (pattern-matching' generate archive nextP')] + [then! (recur thenP)] (///////phase\wrap ($_ _.then - (..multi-pop! (n.+ 2 extra-pops)) - next!)))) - - (^template [<tag> <combinator>] - [(^ (<tag> preP postP)) - (do ///////phase.monad - [pre! (pattern-matching' generate archive preP) - post! (pattern-matching' generate archive postP)] - (wrap (<combinator> pre! post!)))]) - ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation]))) - -(def: (pattern-matching generate archive pathP) - (-> Phase Archive Path (Operation (Statement Any))) + (_.set (list (..register register)) ..peek_and_pop) + then!))) + + (^ (/////synthesis.!multi_pop nextP)) + (.let [[extra_pops nextP'] (case.count_pops nextP)] + (do ///////phase.monad + [next! (recur nextP')] + (///////phase\wrap ($_ _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) + + (^template [<tag> <combinator>] + [(^ (<tag> preP postP)) + (do ///////phase.monad + [pre! (recur preP) + post! (recur postP)] + (wrap (<combinator> pre! post!)))]) + ([/////synthesis.path/seq _.then] + [/////synthesis.path/alt ..alternation])))) + +(def: (pattern_matching expression archive pathP) + (-> Phase Archive Path (Operation Statement)) (do ///////phase.monad - [pattern-matching! (pattern-matching' generate archive pathP)] + [pattern_matching! (pattern_matching' expression archive pathP)] (wrap ($_ _.then (_.while (_.bool true) - pattern-matching!) - (_.statement (_.raise (_.string case.pattern-matching-error))))))) + pattern_matching!) + (_.statement (_.raise (_.string case.pattern_matching_error))))))) -(def: #export (case generate archive [valueS pathP]) +(def: #export (case expression archive [valueS pathP]) (Generator [Synthesis Path]) (do ///////phase.monad - [initG (generate archive valueS) - pattern-matching! (pattern-matching generate archive pathP)] + [initG (expression archive valueS) + pattern_matching! (pattern_matching expression archive pathP)] (wrap (|> ($_ _.then (_.set (list @cursor) (_.array (list initG))) (_.set (list @savepoint) (_.array (list))) - pattern-matching!) + pattern_matching!) (_.lambda #.None (list)) (_.do "call" (list)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 091c8fb6a..d153670b7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -2,47 +2,53 @@ [lux (#- function) [abstract ["." monad (#+ do)]] - [control - pipe] [data ["." product] + [text + ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)]]] [target - ["_" ruby (#+ Expression Statement)]]] + ["_" ruby (#+ LVar Expression Statement)]]] ["." // #_ - [runtime (#+ Operation Phase Generator)] + [runtime (#+ Operation Phase Generator Phase! Generator!)] ["#." reference] ["#." case] + ["#." loop] ["/#" // #_ ["#." reference] ["//#" /// #_ [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] [synthesis (#+ Synthesis)] - ["#." generation] + ["#." generation (#+ Context)] ["//#" /// #_ - [reference (#+ Register Variable)] [arity (#+ Arity)] - ["#." phase]]]]]) + ["#." phase] + [reference + [variable (#+ Register Variable)]] + [meta + [archive (#+ Archive) + ["." artifact]]]]]]]) -(def: #export (apply generate archive [functionS argsS+]) +(def: #export (apply expression archive [functionS argsS+]) (Generator (Application Synthesis)) (do {! ///////phase.monad} - [functionO (generate archive functionS) - argsO+ (monad.map ! (generate archive) argsS+)] + [functionO (expression archive functionS) + argsO+ (monad.map ! (expression archive) argsS+)] (wrap (_.do "call" argsO+ functionO)))) (def: #export capture - (///reference.foreign _.local)) + (-> Register LVar) + (|>> (///reference.foreign //reference.system) :assume)) -(def: (with-closure inits function-definition) - (-> (List (Expression Any)) (Expression Any) (Expression Any)) +(def: (with_closure inits function_definition) + (-> (List Expression) Expression Expression) (case inits #.Nil - function-definition + function_definition _ - (|> function-definition + (|> function_definition _.return (_.lambda #.None (|> (list.enumeration inits) @@ -52,47 +58,46 @@ (def: input (|>> inc //case.register)) -(def: #export (function generate archive [environment arity bodyS]) +(def: #export (function expression archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) (do {! ///////phase.monad} - [[function-name bodyO] (/////generation.with-new-context + [[function_name bodyO] (/////generation.with_new_context archive (do ! - [function-name (\ ! map ///reference.artifact-name - /////generation.context)] - (/////generation.with-anchor (_.local function-name) - (generate archive bodyS)))) - closureO+ (: (Operation (List (Expression Any))) - (monad.map ! (\ //reference.system variable) environment)) - #let [function-name (///reference.artifact-name function-name) + [function_name (\ ! map ///reference.artifact + (/////generation.context archive))] + (/////generation.with_anchor (_.local function_name) + (expression archive bodyS)))) + closureO+ (monad.map ! (expression archive) environment) + #let [function_name (///reference.artifact function_name) @curried (_.local "curried") arityO (|> arity .int _.int) limitO (|> arity dec .int _.int) - @num-args (_.local "num_args") - @self (_.local function-name) - initialize-self! (_.set (list (//case.register 0)) @self) + @num_args (_.local "num_args") + @self (_.local function_name) + initialize_self! (_.set (list (//case.register 0)) @self) initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried)))) - initialize-self! + initialize_self! (list.indices arity))]] - (wrap (with-closure closureO+ + (wrap (with_closure closureO+ (_.lambda (#.Some @self) (list (_.variadic @curried)) ($_ _.then - (_.set (list @num-args) (_.the "length" @curried)) - (_.cond (list [(|> @num-args (_.= arityO)) + (_.set (list @num_args) (_.the "length" @curried)) + (_.cond (list [(|> @num_args (_.= arityO)) ($_ _.then initialize! (_.return bodyO))] - [(|> @num-args (_.> arityO)) + [(|> @num_args (_.> arityO)) (let [slice (.function (_ from to) - (_.array-range from to @curried)) - arity-args (_.splat (slice (_.int +0) limitO)) - output-func-args (_.splat (slice arityO @num-args))] + (_.array_range from to @curried)) + arity_args (_.splat (slice (_.int +0) limitO)) + output_func_args (_.splat (slice arityO @num_args))] (_.return (|> @self - (_.do "call" (list arity-args)) - (_.do "call" (list output-func-args)))))]) - ## (|> @num-args (_.< arityO)) + (_.do "call" (list arity_args)) + (_.do "call" (list output_func_args)))))]) + ## (|> @num_args (_.< arityO)) (let [@missing (_.local "missing")] (_.return (_.lambda #.None (list (_.variadic @missing)) (_.return (|> @self diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index cecea44e9..3a6152337 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -4,34 +4,43 @@ ["." monad (#+ do)]] [data ["." product] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection - ["." list ("#\." functor)]]] + ["." list ("#\." functor fold)] + ["." set]]] + [math + [number + ["n" nat]]] [target - ["_" ruby (#+ Expression LVar)]]] + ["_" ruby (#+ Expression LVar Statement)]]] ["." // #_ - [runtime (#+ Operation Phase Generator)] + [runtime (#+ Operation Phase Generator Phase! Generator!)] ["#." case] - ["///#" //// #_ - [synthesis (#+ Scope Synthesis)] - ["#." generation] - ["//#" /// #_ - ["#." phase]]]]) + ["/#" // #_ + ["#." reference] + ["/#" // #_ + [synthesis + ["." case]] + ["/#" // #_ + ["." synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase] + [reference + ["#." variable (#+ Register)]]]]]]]) -(def: loop-name +(def: loop_name (-> Nat LVar) (|>> %.nat (format "loop") _.local)) -(def: #export (scope generate archive [start initsS+ bodyS]) +(def: #export (scope expression archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) (do {! ///////phase.monad} - [@loop (\ ! map ..loop-name /////generation.next) - initsO+ (monad.map ! (generate archive) initsS+) - bodyO (/////generation.with-anchor @loop - (generate archive bodyS))] + [@loop (\ ! map ..loop_name /////generation.next) + initsO+ (monad.map ! (expression archive) initsS+) + bodyO (/////generation.with_anchor @loop + (expression archive bodyS))] (wrap (|> (_.return bodyO) (_.lambda (#.Some @loop) (|> initsS+ @@ -39,9 +48,9 @@ (list\map (|>> product.left (n.+ start) //case.register)))) (_.apply/* initsO+))))) -(def: #export (recur generate archive argsS+) +(def: #export (recur expression archive argsS+) (Generator (List Synthesis)) (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map ! (generate archive) argsS+)] + argsO+ (monad.map ! (expression archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux index 936f9249e..1149b2e8d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux @@ -2,12 +2,11 @@ [lux #* [target ["_" ruby (#+ Expression)]]] - ["." /// #_ - ["#." reference]]) + [/// + [reference (#+ System)]]) -(def: #export system - (let [constant (: (-> Text (Expression Any)) - _.global) - variable (: (-> Text (Expression Any)) - _.local)] - (///reference.system constant variable))) +(structure: #export system + (System Expression) + + (def: constant _.global) + (def: variable _.local)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index 221442863..76460e39a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -1,36 +1,45 @@ (.module: [lux (#- inc) + ["." meta] [abstract - [monad (#+ do)]] + ["." monad (#+ do)]] [control ["." function] - ["p" parser - ["s" code]]] + ["<>" parser + ["<.>" code]]] [data - [number (#+ hex) - ["." i64]] - ["." text - ["%" format (#+ format)]] + ["." product] + ["." text ("#\." hash) + ["%" format (#+ format)] + ["." encoding]] [collection - ["." list ("#\." functor)]]] + ["." list ("#\." functor)] + ["." row]]] ["." macro - ["." code] - [syntax (#+ syntax:)]] - [target + [syntax (#+ syntax:)] + ["." code]] + [math + [number (#+ hex) + ["." i64]]] + ["@" target ["_" ruby (#+ Expression LVar Computation Literal Statement)]]] ["." /// #_ ["#." reference] ["//#" /// #_ - ["#." synthesis] - ["#." generation (#+ Buffer)] - ["//#" /// #_ + ["$" version] + ["#." synthesis (#+ Synthesis)] + ["#." generation] + ["//#" /// ["#." phase] + [reference + [variable (#+ Register)]] [meta - [archive (#+ Archive)]]]]]) + [archive (#+ Output Archive) + ["." artifact (#+ Registry)]]]]]]) (template [<name> <base>] [(type: #export <name> - (<base> LVar (Expression Any) (Statement Any)))] + (<base> LVar Expression Statement))] [Operation /////generation.Operation] [Phase /////generation.Phase] @@ -39,163 +48,172 @@ ) (type: #export (Generator i) - (-> Phase Archive i (Operation (Expression Any)))) + (-> Phase Archive i (Operation Expression))) + +(type: #export Phase! + (-> Phase Archive Synthesis (Operation (Statement Any)))) + +(type: #export (Generator! i) + (-> Phase! Phase Archive i (Operation (Statement Any)))) (def: prefix Text "LuxRuntime") -(def: #export unit (_.string /////synthesis.unit)) +(def: #export unit + (_.string /////synthesis.unit)) (def: (flag value) (-> Bit Literal) (if value - (_.string "") + ..unit _.nil)) -(def: #export variant-tag-field "_lux_tag") -(def: #export variant-flag-field "_lux_flag") -(def: #export variant-value-field "_lux_value") +(def: #export variant_tag_field "_lux_tag") +(def: #export variant_flag_field "_lux_flag") +(def: #export variant_value_field "_lux_value") (def: (variant' tag last? value) - (-> (Expression Any) (Expression Any) (Expression Any) Literal) - (_.hash (list [(_.string ..variant-tag-field) tag] - [(_.string ..variant-flag-field) last?] - [(_.string ..variant-value-field) value]))) + (-> Expression Expression Expression Literal) + (_.hash (list [(_.string ..variant_tag_field) tag] + [(_.string ..variant_flag_field) last?] + [(_.string ..variant_value_field) value]))) (def: #export (variant tag last? value) - (-> Nat Bit (Expression Any) Literal) + (-> Nat Bit Expression Literal) (variant' (_.int (.int tag)) (..flag last?) value)) (def: #export none Literal - (variant 0 #0 unit)) + (..variant 0 #0 ..unit)) (def: #export some - (-> (Expression Any) Literal) - (variant 1 #1)) + (-> Expression Literal) + (..variant 1 #1)) (def: #export left - (-> (Expression Any) Literal) - (variant 0 #0)) + (-> Expression Literal) + (..variant 0 #0)) (def: #export right - (-> (Expression Any) Literal) - (variant 1 #1)) - -(def: runtime-name - (-> Text LVar) - (|>> ///reference.sanitize - (format ..prefix "_") - _.local)) + (-> Expression Literal) + (..variant 1 #1)) (def: (feature name definition) - (-> LVar (-> LVar (Statement Any)) (Statement Any)) + (-> LVar (-> LVar Statement) Statement) (definition name)) -(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} +(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))} body) - (wrap (list (` (let [(~+ (|> vars - (list\map (function (_ var) - (list (code.local-identifier var) - (` (_.local (~ (code.text (///reference.sanitize var)))))))) - list.concat))] - (~ body)))))) - -(syntax: (runtime: {declaration (p.or s.local-identifier - (s.form (p.and s.local-identifier - (p.some s.local-identifier))))} + (do {! meta.monad} + [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + (wrap (list (` (let [(~+ (|> vars + (list.zip/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.local (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) + +(def: module_id + 0) + +(syntax: (runtime: {declaration (<>.or <code>.local_identifier + (<code>.form (<>.and <code>.local_identifier + (<>.some <code>.local_identifier))))} code) - (case declaration - (#.Left name) - (macro.with-gensyms [g!_] - (let [nameC (code.local-identifier name) - code-nameC (code.local-identifier (format "@" name)) - runtime-nameC (` (runtime-name (~ (code.text name))))] - (wrap (list (` (def: #export (~ nameC) LVar (~ runtime-nameC))) - (` (def: (~ code-nameC) - (Statement Any) - (..feature (~ runtime-nameC) - (function ((~ g!_) (~ nameC)) - (~ code))))))))) - - (#.Right [name inputs]) - (macro.with-gensyms [g!_] - (let [nameC (code.local-identifier name) - code-nameC (code.local-identifier (format "@" name)) - runtime-nameC (` (runtime-name (~ (code.text name)))) - inputsC (list\map code.local-identifier inputs) - inputs-typesC (list\map (function.constant (` (_.Expression Any))) - inputs)] - (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) - (-> (~+ inputs-typesC) (Computation Any)) - (_.apply/* (list (~+ inputsC)) (~ runtime-nameC)))) - (` (def: (~ code-nameC) - (Statement Any) - (..feature (~ runtime-nameC) - (function ((~ g!_) (~ g!_)) - (..with-vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code))))))))))))) - -(def: tuple-size + (do meta.monad + [runtime_id meta.count] + (macro.with_gensyms [g!_] + (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.local (~ (code.text (%.code runtime)))))] + (case declaration + (#.Left name) + (macro.with_gensyms [g!_] + (let [g!name (code.local_identifier name)] + (wrap (list (` (def: #export (~ g!name) LVar (~ runtime_name))) + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.set (list (~ g!name)) (~ code)))))))))) + + (#.Right [name inputs]) + (macro.with_gensyms [g!_] + (let [g!name (code.local_identifier name) + inputsC (list\map code.local_identifier inputs) + inputs_typesC (list\map (function.constant (` _.Expression)) + inputs)] + (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code)))))))))))))))) + +(def: tuple_size (_.the "length")) -(def: last-index - (|>> ..tuple-size (_.- (_.int +1)))) +(def: last_index + (|>> ..tuple_size (_.- (_.int +1)))) -(with-expansions [<recur> (as-is ($_ _.then - (_.set (list lefts) (_.- last-index-right lefts)) - (_.set (list tuple) (_.nth last-index-right tuple))))] +(with_expansions [<recur> (as_is ($_ _.then + (_.set (list lefts) (_.- last_index_right lefts)) + (_.set (list tuple) (_.nth last_index_right tuple))))] (runtime: (tuple//left lefts tuple) - (with-vars [last-index-right] + (with_vars [last_index_right] (<| (_.while (_.bool true)) ($_ _.then - (_.set (list last-index-right) (..last-index tuple)) - (_.if (_.> lefts last-index-right) + (_.set (list last_index_right) (..last_index tuple)) + (_.if (_.> lefts last_index_right) ## No need for recursion (_.return (_.nth lefts tuple)) ## Needs recursion <recur>))))) (runtime: (tuple//right lefts tuple) - (with-vars [last-index-right right-index] + (with_vars [last_index_right right_index] (<| (_.while (_.bool true)) ($_ _.then - (_.set (list last-index-right) (..last-index tuple)) - (_.set (list right-index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= last-index-right right-index) - (_.return (_.nth right-index tuple))] - [(_.> last-index-right right-index) + (_.set (list last_index_right) (..last_index tuple)) + (_.set (list right_index) (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= last_index_right right_index) + (_.return (_.nth right_index tuple))] + [(_.> last_index_right right_index) ## Needs recursion. <recur>]) - (_.return (_.array-range right-index (..tuple-size tuple) tuple))) + (_.return (_.array_range right_index (..tuple_size tuple) tuple))) ))))) (runtime: (sum//get sum wantsLast wantedTag) - (let [no-match! (_.return _.nil) - 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? + (let [no_match! (_.return _.nil) + 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? (_.= ..unit sum_flag) + test_recursion! (_.if is_last? ## Must recurse. - (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag))) - no-match!)] - (_.cond (list [(_.= sum-tag wantedTag) - (_.if (_.= wantsLast sum-flag) - (_.return sum-value) - test-recursion!)] + (_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag))) + no_match!)] + (_.cond (list [(_.= sum_tag wantedTag) + (_.if (_.= wantsLast sum_flag) + (_.return sum_value) + test_recursion!)] - [(_.> sum-tag wantedTag) - test-recursion!] + [(_.> sum_tag wantedTag) + test_recursion!] - [(_.and (_.< sum-tag wantedTag) - (_.= (_.string "") wantsLast)) - (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))]) + [(_.and (_.< sum_tag wantedTag) + (_.= ..unit wantsLast)) + (_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))]) - no-match!))) + no_match!))) (def: runtime//adt - (Statement Any) + Statement ($_ _.then @tuple//left @tuple//right @@ -203,44 +221,44 @@ )) (runtime: (lux//try risky) - (with-vars [error value] + (with_vars [error value] (_.begin ($_ _.then (_.set (list value) (_.do "call" (list ..unit) risky)) (_.return (..right value))) (list [(list) error (_.return (..left (_.the "message" error)))])))) -(runtime: (lux//program-args raw) - (with-vars [tail head] +(runtime: (lux//program_args raw) + (with_vars [tail head] ($_ _.then (_.set (list tail) ..none) - (<| (_.for-in head raw) + (<| (_.for_in head raw) (_.set (list tail) (..some (_.array (list head tail))))) (_.return tail)))) (def: runtime//lux - (Statement Any) + Statement ($_ _.then @lux//try - @lux//program-args + @lux//program_args )) -(runtime: (i64//logic-right-shift param subject) +(runtime: (i64//logic_right_shift param subject) (let [mask (|> (_.int +1) - (_.bit-shl (_.- param (_.int +64))) + (_.bit_shl (_.- param (_.int +64))) (_.- (_.int +1)))] (_.return (|> subject - (_.bit-shr param) - (_.bit-and mask))))) + (_.bit_shr param) + (_.bit_and mask))))) (def: runtime//i64 - (Statement Any) + Statement ($_ _.then - @i64//logic-right-shift + @i64//logic_right_shift )) (runtime: (f64//decode inputG) - (with-vars [@input @temp] + (with_vars [@input @temp] ($_ _.then (_.set (list @input) inputG) (_.set (list @temp) (_.do "to_f" (list) @input)) @@ -253,13 +271,13 @@ (_.return ..none))))) (def: runtime//f64 - (Statement Any) + Statement ($_ _.then @f64//decode )) (runtime: (text//index subject param start) - (with-vars [idx] + (with_vars [idx] ($_ _.then (_.set (list idx) (|> subject (_.do "index" (list param start)))) (_.if (_.= _.nil idx) @@ -267,20 +285,20 @@ (_.return (..some idx)))))) (def: (within? top value) - (-> (Expression Any) (Expression Any) (Computation Any)) + (-> Expression Expression Computation) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) (runtime: (text//clip @text @from @to) - (_.return (|> @text (_.array-range @from @to)))) + (_.return (|> @text (_.array_range @from @to)))) (runtime: (text//char idx text) (_.if (|> idx (within? (_.the "length" text))) - (_.return (..some (|> text (_.array-range idx idx) (_.do "ord" (list))))) + (_.return (..some (|> text (_.array_range idx idx) (_.do "ord" (list))))) (_.return ..none))) (def: runtime//text - (Statement Any) + Statement ($_ _.then @text//index @text//clip @@ -288,7 +306,7 @@ )) (def: runtime - (Statement Any) + Statement ($_ _.then runtime//adt runtime//lux @@ -301,9 +319,14 @@ ..prefix) (def: #export generate - (Operation (Buffer (Statement Any))) - (/////generation.with-buffer - (do ///////phase.monad - [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..prefix ..runtime)] - /////generation.buffer))) + (Operation [Registry Output]) + (do ///////phase.monad + [_ (/////generation.execute! ..runtime) + _ (/////generation.save! (%.nat ..module_id) ..runtime)] + (wrap [(|> artifact.empty + artifact.resource + product.right) + (row.row [(%.nat ..module_id) + (|> ..runtime + _.code + (\ encoding.utf8 encode))])]))) |