diff options
Diffstat (limited to '')
11 files changed, 667 insertions, 556 deletions
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))])]))) |