diff options
Diffstat (limited to '')
22 files changed, 1151 insertions, 613 deletions
diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux index 29d4b82b3..4213cd339 100644 --- a/stdlib/source/lux/target/lua.lux +++ b/stdlib/source/lux/target/lua.lux @@ -232,9 +232,14 @@ [">>" bit_shr] ) - (def: #export (not subject) - (-> Expression Expression) - (:abstraction (format "(not " (:representation subject) ")"))) + (template [<name> <unary>] + [(def: #export (<name> subject) + (-> Expression Expression) + (:abstraction (format "(" <unary> " " (:representation subject) ")")))] + + [not "not"] + [negate "-"] + ) (template [<name> <type>] [(def: #export <name> diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux index d0622f6c8..4cb2f0602 100644 --- a/stdlib/source/lux/target/php.lux +++ b/stdlib/source/lux/target/php.lux @@ -1,30 +1,44 @@ (.module: - [lux (#- Code Global static int if cond or and not comment for) + [lux (#- Location Code Global static int if cond or and not comment for) + ["@" 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))))) (def: block (-> Text Text) - (|>> ..nest (text.enclose ["{" (format text.new-line "}")]))) + (|>> ..nest (text.enclose ["{" (format text.new_line "}")]))) (def: group (-> Text Text) @@ -41,28 +55,27 @@ (-> (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] + [Expression [Code]] + [Computation [Expression' Code]] + [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] - [Var Location] - [Constant Location] - [Global Location] - [Access Location] - [Statement Code] + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: #export <brand> Any) + (`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Constant [Location' Computation' Expression' Code]] + [Global [Location' Computation' Expression' Code]] ) (type: #export Argument @@ -70,9 +83,9 @@ #var Var}) (def: #export ; - (-> (Expression Any) Statement) + (-> Expression Statement) (|>> :representation - (text.suffix ..statement-suffix) + (text.suffix ..statement_suffix) :abstraction)) (def: #export var @@ -99,13 +112,13 @@ (def: #export float (-> Frac Literal) - (|>> (cond> [(f.= f.positive-infinity)] + (|>> (cond> [(f.= f.positive_infinity)] [(new> "+INF" [])] - [(f.= f.negative-infinity)] + [(f.= f.negative_infinity)] [(new> "-INF" [])] - [(f.= f.not-a-number)] + [(f.= f.not_a_number)] [(new> "NAN" [])] ## else @@ -115,32 +128,32 @@ (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)] )) ))) (def: #export string (-> Text Literal) (|>> ..sanitize - (text.enclose [text.double-quote text.double-quote]) + (text.enclose [text.double_quote text.double_quote]) :abstraction)) (def: arguments - (-> (List (Expression Any)) Text) - (|>> (list\map ..code) (text.join-with ..input-separator) ..group)) + (-> (List Expression) Text) + (|>> (list\map ..code) (text.join_with ..input_separator) ..group)) (def: #export (apply/* args func) - (-> (List (Expression Any)) (Expression Any) (Computation Any)) + (-> (List Expression) Expression Computation) (:abstraction (format (:representation func) (..arguments args)))) @@ -150,7 +163,7 @@ (.if reference? (format "&" (:representation var)) (:representation var)))) - (text.join-with ..input-separator) + (text.join_with ..input_separator) ..group)) (template [<name> <reference?>] @@ -176,29 +189,29 @@ ..group :abstraction))) - (template [<apply> <input-var>+ <input-type>+ <function>+] - [(`` (def: #export (<apply> [(~~ (template.splice <input-var>+))] function) - (-> [(~~ (template.splice <input-type>+))] (Expression Any) (Computation Any)) - (..apply/* (list (~~ (template.splice <input-var>+))) function))) + (template [<apply> <input_var>+ <input_type>+ <function>+] + [(`` (def: #export (<apply> [(~~ (template.splice <input_var>+))] function) + (-> [(~~ (template.splice <input_type>+))] Expression Computation) + (..apply/* (list (~~ (template.splice <input_var>+))) function))) - (`` (template [<lux-name> <php-name>] - [(def: #export (<lux-name> args) - (-> [(~~ (template.splice <input-type>+))] (Computation Any)) - (<apply> args (..constant <php-name>)))] + (`` (template [<lux_name> <php_name>] + [(def: #export (<lux_name> args) + (-> [(~~ (template.splice <input_type>+))] Computation) + (<apply> args (..constant <php_name>)))] (~~ (template.splice <function>+))))] [apply/0 [] [] - [[func-num-args/0 "func_num_args"] - [func-get-args/0 "func_get_args"] + [[func_num_args/0 "func_num_args"] + [func_get_args/0 "func_get_args"] [time/0 "time"]]] - [apply/1 [in0] [(Expression Any)] - [[is-null/1 "is_null"] + [apply/1 [in0] [Expression] + [[is_null/1 "is_null"] [empty/1 "empty"] [count/1 "count"] [strlen/1 "strlen"] - [array-pop/1 "array_pop"] - [array-reverse/1 "array_reverse"] + [array_pop/1 "array_pop"] + [array_reverse/1 "array_reverse"] [intval/1 "intval"] [floatval/1 "floatval"] [strval/1 "strval"] @@ -206,52 +219,52 @@ [chr/1 "chr"] [print/1 "print"] [exit/1 "exit"]]] - [apply/2 [in0 in1] [(Expression Any) (Expression Any)] - [[call-user-func-array/2 "call_user_func_array"] - [array-slice/2 "array_slice"] - [array-push/2 "array_push"]]] - [apply/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)] - [[array-slice/3 "array_slice"] - [array-splice/3 "array_splice"] + [apply/2 [in0 in1] [Expression Expression] + [[call_user_func_array/2 "call_user_func_array"] + [array_slice/2 "array_slice"] + [array_push/2 "array_push"]]] + [apply/3 [in0 in1 in2] [Expression Expression Expression] + [[array_slice/3 "array_slice"] + [array_splice/3 "array_splice"] [strpos/3 "strpos"] [substr/3 "substr"]]] ) (def: #export (array/* values) - (-> (List (Expression Any)) Literal) + (-> (List Expression) Literal) (|> values (list\map ..code) - (text.join-with ..input-separator) + (text.join_with ..input_separator) ..group (format "array") :abstraction)) - (def: #export (array-merge/+ required optionals) - (-> (Expression Any) (List (Expression Any)) (Computation Any)) + (def: #export (array_merge/+ required optionals) + (-> Expression (List Expression) Computation) (..apply/* (list& required optionals) (..constant "array_merge"))) (def: #export (array/** kvs) - (-> (List [(Expression Any) (Expression Any)]) Literal) + (-> (List [Expression Expression]) Literal) (|> kvs (list\map (function (_ [key value]) (format (:representation key) " => " (:representation value)))) - (text.join-with ..input-separator) + (text.join_with ..input_separator) ..group (format "array") :abstraction)) (def: #export (new constructor inputs) - (-> Constant (List (Expression Any)) (Computation Any)) + (-> Constant (List Expression) Computation) (|> (format "new " (:representation constructor) (arguments inputs)) :abstraction)) (def: #export (do method inputs object) - (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) + (-> Text (List Expression) Expression Computation) (|> (format (:representation object) "->" method (arguments inputs)) :abstraction)) (def: #export (nth idx array) - (-> (Expression Any) (Expression Any) Access) + (-> Expression Expression Access) (|> (format (:representation array) "[" (:representation idx) "]") :abstraction)) @@ -260,7 +273,7 @@ (|> (..var "GLOBALS") (..nth (..string name)) :transmutation)) (def: #export (? test then else) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (-> Expression Expression Expression Computation) (|> (format (:representation test) " ? " (:representation then) " : " (:representation else)) @@ -269,7 +282,7 @@ (template [<name> <op>] [(def: #export (<name> parameter subject) - (-> (Expression Any) (Expression Any) (Computation Any)) + (-> Expression Expression Computation) (|> (format (:representation subject) " " <op> " " (:representation parameter)) ..group :abstraction))] @@ -286,49 +299,49 @@ [* "*"] [/ "/"] [% "%"] - [bit-or "|"] - [bit-and "&"] - [bit-xor "^"] - [bit-shl "<<"] - [bit-shr ">>"] + [bit_or "|"] + [bit_and "&"] + [bit_xor "^"] + [bit_shl "<<"] + [bit_shr ">>"] [concat "."] ) (def: #export not - (-> (Computation Any) (Computation Any)) + (-> Computation Computation) (|>> :representation (format "!") :abstraction)) (def: #export (set var value) - (-> (Location Any) (Expression Any) (Computation Any)) + (-> Location Expression Computation) (|> (format (:representation var) " = " (:representation value)) ..group :abstraction)) (def: #export (set? var) - (-> Var (Computation Any)) + (-> Var Computation) (..apply/1 [var] (..constant "isset"))) (template [<name> <modifier>] [(def: #export <name> (-> Var Statement) - (|>> :representation (format <modifier> " ") (text.suffix ..statement-suffix) :abstraction))] + (|>> :representation (format <modifier> " ") (text.suffix ..statement_suffix) :abstraction))] - [define-global "global"] + [define_global "global"] ) (template [<name> <modifier> <location>] [(def: #export (<name> location value) - (-> <location> (Expression Any) Statement) + (-> <location> Expression Statement) (:abstraction (format <modifier> " " (:representation location) " = " (:representation value) - ..statement-suffix)))] + ..statement_suffix)))] - [define-static "static" Var] - [define-constant "const" Constant] + [define_static "static" Var] + [define_constant "const" Constant] ) (def: #export (if test then! else!) - (-> (Expression Any) Statement Statement Statement) + (-> Expression Statement Statement Statement) (:abstraction (format "if " (..group (:representation test)) " " (..block (:representation then!)) @@ -336,7 +349,7 @@ (..block (:representation else!))))) (def: #export (when test then!) - (-> (Expression Any) Statement Statement) + (-> Expression Statement Statement) (:abstraction (format "if " (..group (:representation test)) " " (..block (:representation then!))))) @@ -345,24 +358,24 @@ (-> Statement Statement Statement) (:abstraction (format (:representation pre!) - text.new-line + text.new_line (:representation post!)))) (def: #export (while test body!) - (-> (Expression Any) Statement Statement) + (-> Expression Statement Statement) (:abstraction (format "while " (..group (:representation test)) " " (..block (:representation body!))))) - (def: #export (do-while test body!) - (-> (Expression Any) Statement Statement) + (def: #export (do_while test body!) + (-> Expression Statement Statement) (:abstraction (format "do " (..block (:representation body!)) " while " (..group (:representation test)) - ..statement-suffix))) + ..statement_suffix))) - (def: #export (for-each array value body!) - (-> (Expression Any) Var Statement Statement) + (def: #export (for_each array value body!) + (-> Expression Var Statement Statement) (:abstraction (format "foreach(" (:representation array) " as " (:representation value) @@ -384,15 +397,15 @@ (-> Statement (List Except) Statement) (:abstraction (format "try " (..block (:representation body!)) - text.new-line + text.new_line (|> excepts (list\map catch) - (text.join-with text.new-line))))) + (text.join_with text.new_line))))) (template [<name> <keyword>] [(def: #export <name> - (-> (Expression Any) Statement) - (|>> :representation (format <keyword> " ") (text.suffix ..statement-suffix) :abstraction))] + (-> Expression Statement) + (|>> :representation (format <keyword> " ") (text.suffix ..statement_suffix) :abstraction))] [throw "throw"] [return "return"] @@ -400,29 +413,24 @@ ) (def: #export (define name value) - (-> Constant (Expression Any) (Expression Any)) + (-> Constant Expression Expression) (..apply/2 [(|> name :representation ..string) value] (..constant "define"))) - (def: #export (define-function name uses arguments body!) - (-> Constant (List Argument) (List Argument) Statement Statement) - (let [uses (case uses - #.Nil - "" - - _ - (format " use " (..parameters uses)))] - (:abstraction - (format "function " (:representation name) " " (..parameters arguments) - uses " " - (..block (:representation body!)))))) + (def: #export (define_function name arguments body!) + (-> Constant (List Argument) Statement Statement) + (:abstraction + (format "function " (:representation name) + " " (..parameters arguments) + " " + (..block (:representation body!))))) (template [<name> <keyword>] [(def: #export <name> Statement (|> <keyword> - (text.suffix ..statement-suffix) + (text.suffix ..statement_suffix) :abstraction))] [break "break"] @@ -431,12 +439,12 @@ ) (def: #export (cond clauses else!) - (-> (List [(Expression Any) Statement]) Statement Statement) + (-> (List [Expression Statement]) Statement Statement) (list\fold (function (_ [test then!] next!) (..if test then! next!)) else! (list.reverse clauses))) -(def: #export command-line-arguments +(def: #export command_line_arguments Var (..var "argv")) diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index f8c7157a3..e27ae9b83 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -292,11 +292,16 @@ [and "and"] ) - (def: #export (not subject) - (-> (Expression Any) (Computation Any)) - (<| :abstraction - ## ..expression - (format "not " (:representation subject)))) + (template [<name> <unary>] + [(def: #export (<name> subject) + (-> (Expression Any) (Computation Any)) + (<| :abstraction + ## ..expression + (format <unary> " " (:representation subject))))] + + [not "not"] + [negate "-"] + ) (def: #export (lambda arguments body) (-> (List (Var Any)) (Expression Any) (Computation Any)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 6b0e59d0e..647ae8895 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -285,7 +285,7 @@ (list\fold (function (_ short aggregate) (case aggregate "" short - _ (format short ..coverage_separator aggregate))) + _ (format aggregate ..coverage_separator short))) "")) (def: (decode_coverage module encoding) @@ -297,7 +297,7 @@ (recur tail (set.add [module head] output)) #.None - output))) + (set.add [module remaining] output)))) (template [<macro> <function>] [(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))} diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux new file mode 100644 index 000000000..466c8daea --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.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 + ["_" php]]] + [// + ["/" lux (#+ custom)] + [// + ["." bundle] + [// + ["." analysis #_ + ["#/." type]] + [// + ["." analysis (#+ Analysis Operation Phase Handler Bundle)] + [/// + ["." phase]]]]]]) + +(def: #export bundle + Bundle + (<| (bundle.prefix "php") + (|> bundle.empty + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index 29d3704fe..33a952596 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -122,7 +122,7 @@ (/.install "-" (binary (product.uncurry _.-))) (/.install "*" (binary (product.uncurry _.*))) (/.install "/" (binary (product.uncurry _./))) - (/.install "%" (binary (product.uncurry _.%))) + (/.install "%" (binary (product.uncurry (function.flip (_.apply/2 (_.var "math.fmod")))))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) (/.install "i64" (unary (!unary "math.floor"))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux new file mode 100644 index 000000000..2f2d75c31 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux @@ -0,0 +1,17 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + ["." / #_ + ["#." common] + ["#." host] + [//// + [generation + [php + [runtime (#+ Bundle)]]]]]) + +(def: #export bundle + Bundle + (dictionary.merge /common.bundle + /host.bundle)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux new file mode 100644 index 000000000..ab2f480fe --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux @@ -0,0 +1,185 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function] + ["." try] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [collection + ["." dictionary] + ["." list ("#\." functor fold)]]] + [math + [number + ["f" frac]]] + ["@" target + ["_" php (#+ Expression)]]] + ["." //// #_ + ["/" bundle] + ["/#" // #_ + ["." extension] + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" php #_ + ["#." 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') + + (#try.Failure error) + (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + +## (template: (!unary function) +## (|>> list _.apply/* (|> (_.var function)))) + +## ## TODO: Get rid of this ASAP +## (def: lux::syntax_char_case! +## (..custom [($_ <>.and +## <s>.any +## <s>.any +## (<>.some (<s>.tuple ($_ <>.and +## (<s>.tuple (<>.many <s>.i64)) +## <s>.any)))) +## (function (_ extension_name phase archive [input else conditionals]) +## (do {! /////.monad} +## [inputG (phase archive input) +## elseG (phase archive else) +## @input (\ ! map _.var (generation.gensym "input")) +## conditionalsG (: (Operation (List [Expression Expression])) +## (monad.map ! (function (_ [chars branch]) +## (do ! +## [branchG (phase archive branch)] +## (wrap [(|> chars +## (list\map (|>> .int _.int (_.= @input))) +## (list\fold (function (_ clause total) +## (if (is? _.nil total) +## clause +## (_.or clause total))) +## _.nil)) +## branchG]))) +## conditionals)) +## #let [closure (_.closure (list @input) +## (list\fold (function (_ [test then] else) +## (_.if test (_.return then) else)) +## (_.return elseG) +## conditionalsG))]] +## (wrap (_.apply/1 closure inputG))))])) + +## (def: lux_procs +## Bundle +## (|> /.empty +## (/.install "syntax char case!" lux::syntax_char_case!) +## (/.install "is" (binary (product.uncurry _.=))) +## (/.install "try" (unary //runtime.lux//try)))) + +## (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 (product.uncurry //runtime.i64//left_shift))) +## (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift))) +## (/.install "=" (binary (product.uncurry _.=))) +## (/.install "+" (binary (product.uncurry _.+))) +## (/.install "-" (binary (product.uncurry _.-))) +## (/.install "<" (binary (product.uncurry _.<))) +## (/.install "*" (binary (product.uncurry _.*))) +## (/.install "/" (binary (product.uncurry //runtime.i64//division))) +## (/.install "%" (binary (product.uncurry //runtime.i64//remainder))) +## (/.install "f64" (unary (_./ (_.float +1.0)))) +## (/.install "char" (unary (_.apply/1 (_.var "utf8.char")))) +## ))) + +## (def: f64//decode +## (Unary Expression) +## (|>> list _.apply/* (|> (_.var "tonumber")) _.return (_.closure (list)) //runtime.lux//try)) + +## (def: f64_procs +## Bundle +## (<| (/.prefix "f64") +## (|> /.empty +## (/.install "+" (binary (product.uncurry _.+))) +## (/.install "-" (binary (product.uncurry _.-))) +## (/.install "*" (binary (product.uncurry _.*))) +## (/.install "/" (binary (product.uncurry _./))) +## (/.install "%" (binary (product.uncurry (function.flip (_.apply/2 (_.var "math.fmod")))))) +## (/.install "=" (binary (product.uncurry _.=))) +## (/.install "<" (binary (product.uncurry _.<))) +## (/.install "i64" (unary (!unary "math.floor"))) +## (/.install "encode" (unary (_.apply/2 (_.var "string.format") (_.string "%.17g")))) +## (/.install "decode" (unary ..f64//decode))))) + +## (def: (text//char [paramO subjectO]) +## (Binary Expression) +## (//runtime.text//char (_.+ (_.int +1) paramO) subjectO)) + +## (def: (text//clip [paramO extraO subjectO]) +## (Trinary Expression) +## (//runtime.text//clip subjectO paramO extraO)) + +## (def: (text//index [startO partO textO]) +## (Trinary Expression) +## (//runtime.text//index textO partO startO)) + +## (def: text_procs +## Bundle +## (<| (/.prefix "text") +## (|> /.empty +## (/.install "=" (binary (product.uncurry _.=))) +## (/.install "<" (binary (product.uncurry _.<))) +## (/.install "concat" (binary (product.uncurry (function.flip _.concat)))) +## (/.install "index" (trinary ..text//index)) +## (/.install "size" (unary //runtime.text//size)) +## ## TODO: Use version below once the Lua compiler becomes self-hosted. +## ## (/.install "size" (unary (for {@.lua (!unary "utf8.len")} +## ## (!unary "string.len")))) +## (/.install "char" (binary ..text//char)) +## (/.install "clip" (trinary ..text//clip)) +## ))) + +## (def: (io//log! messageO) +## (Unary Expression) +## (|> (_.apply/* (list messageO) (_.var "print")) +## (_.or //runtime.unit))) + +## (def: io_procs +## Bundle +## (<| (/.prefix "io") +## (|> /.empty +## (/.install "log" (unary ..io//log!)) +## (/.install "error" (unary (!unary "error"))) +## (/.install "current-time" (nullary (function.constant (|> (_.var "os.time") +## (_.apply/* (list)) +## (_.* (_.int +1,000))))))))) + +(def: #export bundle + Bundle + (<| (/.prefix "lux") + /.empty + ## (|> lux_procs + ## (dictionary.merge i64_procs) + ## (dictionary.merge f64_procs) + ## (dictionary.merge text_procs) + ## (dictionary.merge io_procs) + ## ) + )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux new file mode 100644 index 000000000..fef37539e --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux @@ -0,0 +1,199 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] + [data + [collection + ["." dictionary] + ["." list]] + [text + ["%" format (#+ format)]]] + [target + ["_" php (#+ Var Expression)]]] + ["." // #_ + ["#." common (#+ custom)] + ["//#" /// #_ + ["/" bundle] + ["/#" // #_ + ["." extension] + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["." reference] + ["//" php #_ + ["#." runtime (#+ Operation Phase Handler Bundle + with_vars)]]] + ["/#" // #_ + ["." generation] + ["//#" /// #_ + ["#." phase]]]]]]) + +## (def: array::new +## (Unary Expression) +## (|>> ["n"] list _.table)) + +## (def: array::length +## (Unary Expression) +## (_.the "n")) + +## (def: (array::read [indexG arrayG]) +## (Binary Expression) +## (_.nth (_.+ (_.int +1) indexG) arrayG)) + +## (def: (array::write [indexG valueG arrayG]) +## (Trinary Expression) +## (//runtime.array//write indexG valueG arrayG)) + +## (def: (array::delete [indexG arrayG]) +## (Binary Expression) +## (//runtime.array//write indexG _.nil arrayG)) + +## (def: array +## Bundle +## (<| (/.prefix "array") +## (|> /.empty +## (/.install "new" (unary array::new)) +## (/.install "length" (unary array::length)) +## (/.install "read" (binary array::read)) +## (/.install "write" (trinary array::write)) +## (/.install "delete" (binary array::delete)) +## ))) + +## (def: object::get +## Handler +## (custom +## [($_ <>.and <s>.text <s>.any) +## (function (_ extension phase archive [fieldS objectS]) +## (do ////////phase.monad +## [objectG (phase archive objectS)] +## (wrap (_.the fieldS objectG))))])) + +## (def: object::do +## Handler +## (custom +## [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) +## (function (_ extension phase archive [methodS objectS inputsS]) +## (do {! ////////phase.monad} +## [objectG (phase archive objectS) +## inputsG (monad.map ! (phase archive) inputsS)] +## (wrap (_.do methodS inputsG objectG))))])) + +## (template [<!> <?> <unit>] +## [(def: <!> (Nullary Expression) (function.constant <unit>)) +## (def: <?> (Unary Expression) (_.= <unit>))] + +## [object::nil object::nil? _.nil] +## ) + +## (def: object +## Bundle +## (<| (/.prefix "object") +## (|> /.empty +## (/.install "get" object::get) +## (/.install "do" object::do) +## (/.install "nil" (nullary object::nil)) +## (/.install "nil?" (unary object::nil?)) +## ))) + +## (def: $input +## (_.var "input")) + +## (def: utf8::encode +## (custom +## [<s>.any +## (function (_ extension phase archive inputS) +## (do {! ////////phase.monad} +## [inputG (phase archive inputS)] +## (wrap (_.apply/1 (<| (_.closure (list $input)) +## (_.return (|> (_.var "string.byte") +## (_.apply/* (list $input (_.int +1) (_.length $input))) +## (_.apply/1 (_.var "table.pack"))))) +## inputG))))])) + +## (def: utf8::decode +## (custom +## [<s>.any +## (function (_ extension phase archive inputS) +## (do {! ////////phase.monad} +## [inputG (phase archive inputS)] +## (wrap (|> inputG +## (_.apply/1 (_.var "table.unpack")) +## (_.apply/1 (_.var "string.char"))))))])) + +## (def: utf8 +## Bundle +## (<| (/.prefix "utf8") +## (|> /.empty +## (/.install "encode" utf8::encode) +## (/.install "decode" utf8::decode) +## ))) + +## (def: lua::constant +## (custom +## [<s>.text +## (function (_ extension phase archive name) +## (\ ////////phase.monad wrap (_.var name)))])) + +## (def: lua::apply +## (custom +## [($_ <>.and <s>.any (<>.some <s>.any)) +## (function (_ extension phase archive [abstractionS inputsS]) +## (do {! ////////phase.monad} +## [abstractionG (phase archive abstractionS) +## inputsG (monad.map ! (phase archive) inputsS)] +## (wrap (_.apply/* inputsG abstractionG))))])) + +## (def: lua::power +## (custom +## [($_ <>.and <s>.any <s>.any) +## (function (_ extension phase archive [powerS baseS]) +## (do {! ////////phase.monad} +## [powerG (phase archive powerS) +## baseG (phase archive baseS)] +## (wrap (_.^ powerG baseG))))])) + +## (def: lua::import +## (custom +## [<s>.text +## (function (_ extension phase archive module) +## (\ ////////phase.monad wrap +## (_.require/1 (_.string module))))])) + +## (def: lua::function +## (custom +## [($_ <>.and <s>.i64 <s>.any) +## (function (_ extension phase archive [arity abstractionS]) +## (do {! ////////phase.monad} +## [abstractionG (phase archive abstractionS) +## #let [variable (: (-> Text (Operation Var)) +## (|>> generation.gensym +## (\ ! map _.var)))] +## g!inputs (monad.map ! (function (_ _) +## (variable "input")) +## (list.repeat (.nat arity) []))] +## (wrap (<| (_.closure g!inputs) +## _.statement +## (case (.nat arity) +## 0 (_.apply/1 abstractionG //runtime.unit) +## 1 (_.apply/* g!inputs abstractionG) +## _ (_.apply/1 abstractionG (_.array g!inputs)))))))])) + +(def: #export bundle + Bundle + (<| (/.prefix "php") + (|> /.empty + ## (dictionary.merge ..array) + ## (dictionary.merge ..object) + ## (dictionary.merge ..utf8) + + ## (/.install "constant" lua::constant) + ## (/.install "apply" lua::apply) + ## (/.install "power" lua::power) + ## (/.install "import" lua::import) + ## (/.install "function" lua::function) + ## (/.install "script universe" (nullary (function.constant (_.bool reference.universe)))) + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 14d206e23..20d825912 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -115,7 +115,8 @@ list.concat))] (~ body))))))) -(def: module_id 0) +(def: module_id + 0) (syntax: (runtime: {declaration (<>.or <code>.local_identifier (<code>.form (<>.and <code>.local_identifier @@ -279,9 +280,9 @@ ($_ _.then (_.local/1 floored (_.// param subject)) (let [potentially_floored? (_.< (_.int +0) floored) - inexact? (|> floored - (_.* param) - (_.= subject) + inexact? (|> subject + (_.% param) + (_.= (_.int +0)) _.not)] (_.if (_.and potentially_floored? inexact?) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux index f3afe14a6..c310de4a9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux @@ -1,60 +1,58 @@ (.module: [lux #* [abstract - [monad (#+ do)]]] - [/ - [runtime (#+ Phase)] - ["." primitive] - ["." structure] - ["." reference ("#\." system)] - ["." case] - ["." loop] - ["." function] - ["." /// - ["." extension] - [// - ["." synthesis]]]]) - -(def: #export (generate synthesis) + [monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [target + ["_" php]]] + ["." / #_ + [runtime (#+ Phase Phase!)] + ["#." primitive] + ["#." structure] + ["#." reference] + ["#." case] + ["#." loop] + ["#." function] + ["/#" // #_ + ["#." reference] + ["/#" // #_ + ["#." extension] + ["/#" // #_ + [analysis (#+)] + ["." synthesis] + ["//#" /// #_ + ["#." phase ("#\." monad)] + [reference (#+) + [variable (#+)]]]]]]]) + +(def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (\ ///.monad wrap (<generator> value))]) - ([synthesis.bit primitive.bit] - [synthesis.i64 primitive.i64] - [synthesis.f64 primitive.f64] - [synthesis.text primitive.text]) - - (^ (synthesis.variant variantS)) - (structure.variant generate variantS) - - (^ (synthesis.tuple members)) - (structure.tuple generate members) + (//////phase\wrap (<generator> value))]) + ([synthesis.bit /primitive.bit] + [synthesis.i64 /primitive.i64] + [synthesis.f64 /primitive.f64] + [synthesis.text /primitive.text]) (#synthesis.Reference value) - (reference\reference value) - - (^ (synthesis.branch/case case)) - (case.case generate case) - - (^ (synthesis.branch/let let)) - (case.let generate let) - - (^ (synthesis.branch/if if)) - (case.if generate if) + (//reference.reference /reference.system archive value) - (^ (synthesis.loop/scope scope)) - (loop.scope generate scope) - - (^ (synthesis.loop/recur updates)) - (loop.recur generate updates) - - (^ (synthesis.function/abstraction abstraction)) - (function.function generate abstraction) - - (^ (synthesis.function/apply application)) - (function.apply generate application) + (^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/apply /function.apply] + [synthesis.function/abstraction /function.function]) (#synthesis.Extension extension) - (extension.apply generate extension))) + (///extension.apply archive generate extension))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 141f651f8..e129af245 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -1,56 +1,60 @@ (.module: [lux (#- case let if) [abstract - [monad (#+ do)]] - [control - ["ex" exception (#+ exception:)]] + ["." monad (#+ do)]] [data ["." product] ["." text ["%" format (#+ format)]] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#\." functor fold)] ["." set]]] + [math + [number + ["i" int]]] [target - ["_" php (#+ Var Expression Statement)]]] + ["_" php (#+ Expression Var Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Phase! Generator Generator!)] ["#." reference] ["#." primitive] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // ("#\." monad) - [synthesis - ["." case]] - ["#/" // #_ - ["." reference (#+ Register)] - ["#." synthesis (#+ Synthesis Path)]]]]]) + ["/#" // #_ + ["#." synthesis #_ + ["#/." case]] + ["/#" // #_ + ["#." synthesis (#+ Member Synthesis Path)] + ["#." generation] + ["//#" /// #_ + [reference + ["#." variable (#+ Register)]] + ["#." phase ("#\." monad)] + [meta + [archive (#+ Archive)]]]]]]]) (def: #export register - (///reference.local _.var)) + (-> Register Var) + (|>> (///reference.local //reference.system) :assume)) (def: #export capture - (///reference.foreign _.var)) - -(def: #export (let generate [valueS register bodyS]) - (-> Phase [Synthesis Register Synthesis] - (Operation (Expression Any))) - (do ////.monad - [valueG (generate valueS) - bodyG (generate bodyS)] + (-> Register Var) + (|>> (///reference.foreign //reference.system) :assume)) + +(def: #export (let generate archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueG (generate archive valueS) + bodyG (generate archive bodyS)] (wrap (|> bodyG (list (_.set (..register register) valueG)) _.array/* (_.nth (_.int +1)))))) -(def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List (Either Nat Nat)) - (Operation (Expression Any))) - (do ////.monad - [valueG (generate valueS)] +(def: #export (get generate archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueG (generate archive valueS)] (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -62,13 +66,12 @@ valueG pathP)))) -(def: #export (if generate [testS thenS elseS]) - (-> Phase [Synthesis Synthesis Synthesis] - (Operation (Expression Any))) - (do ////.monad - [testG (generate testS) - thenG (generate thenS) - elseG (generate elseS)] +(def: #export (if generate archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testG (generate archive testS) + thenG (generate archive thenS) + elseG (generate archive elseS)] (wrap (_.? testG thenG elseG)))) (def: @savepoint (_.var "lux_pm_savepoint")) @@ -76,36 +79,36 @@ (def: @temp (_.var "lux_pm_temp")) (def: (push! value) - (-> (Expression Any) Statement) - (_.; (_.array-push/2 [@cursor value]))) + (-> Expression Statement) + (_.; (_.array_push/2 [@cursor value]))) -(def: peek-and-pop - (Expression Any) - (_.array-pop/1 @cursor)) +(def: peek_and_pop + Expression + (_.array_pop/1 @cursor)) (def: pop! Statement - (_.; ..peek-and-pop)) + (_.; ..peek_and_pop)) (def: peek - (Expression Any) + Expression (_.nth (|> @cursor _.count/1 (_.- (_.int +1))) @cursor)) (def: save! Statement - (.let [cursor (_.array-slice/2 [@cursor (_.int +0)])] - (_.; (_.array-push/2 [@savepoint cursor])))) + (.let [cursor (_.array_slice/2 [@cursor (_.int +0)])] + (_.; (_.array_push/2 [@savepoint cursor])))) (def: restore! Statement - (_.; (_.set @cursor (_.array-pop/1 @savepoint)))) + (_.; (_.set @cursor (_.array_pop/1 @savepoint)))) (def: fail! _.break) -(def: (multi-pop! pops) +(def: (multi_pop! pops) (-> Nat Statement) - (_.; (_.array-splice/3 [@cursor + (_.; (_.array_splice/3 [@cursor (_.int +0) (_.int (i.* -1 (.int pops)))]))) @@ -115,20 +118,20 @@ ($_ _.then (_.; (_.set @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>)))) (.if simple? - (_.when (_.is-null/1 @temp) + (_.when (_.is_null/1 @temp) fail!) - (_.if (_.is-null/1 @temp) + (_.if (_.is_null/1 @temp) fail! (..push! @temp)))))] - [left-choice _.null (<|)] - [right-choice (_.string "") inc] + [left_choice _.null (<|)] + [right_choice (_.string "") inc] ) (def: (alternation pre! post!) (-> Statement Statement Statement) ($_ _.then - (_.do-while (_.bool false) + (_.do_while (_.bool false) ($_ _.then ..save! pre!)) @@ -136,103 +139,127 @@ ..restore! post!))) -(def: (pattern-matching' generate pathP) - (-> Phase Path (Operation Statement)) - (.case pathP - (^ (/////synthesis.path/then bodyS)) - (\ ////.monad map _.return (generate bodyS)) - - #/////synthesis.Pop - (////\wrap ..pop!) - - (#/////synthesis.Bind register) - (////\wrap (_.; (_.set (..register register) ..peek))) - - (^template [<tag> <format>] - [(^ (<tag> value)) - (////\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)) - (////\wrap (<choice> false idx)) - - (^ (<simple> idx nextP)) - (|> nextP - (pattern-matching' generate) - (\ ////.monad 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)) - (////\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) - - (^template [<pm> <getter>] - [(^ (<pm> lefts)) - (////\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 ////.monad - [then! (pattern-matching' generate thenP)] - (////\wrap ($_ _.then - (_.; (_.set (..register register) ..peek-and-pop)) - then!))) - - ## (^ (/////synthesis.!multi-pop nextP)) - ## (.let [[extra-pops nextP'] (case.count-pops nextP)] - ## (do ////.monad - ## [next! (pattern-matching' generate nextP')] - ## (////\wrap ($_ _.then - ## (..multi-pop! (n.+ 2 extra-pops)) - ## next!)))) - - (^template [<tag> <combinator>] - [(^ (<tag> preP postP)) - (do ////.monad - [pre! (pattern-matching' generate preP) - post! (pattern-matching' generate postP)] - (wrap (<combinator> pre! post!)))]) - ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation]))) - -(def: (pattern-matching generate pathP) - (-> Phase Path (Operation Statement)) - (do ////.monad - [pattern-matching! (pattern-matching' generate pathP)] +(def: (pattern_matching' generate archive) + (-> Phase Archive Path (Operation Statement)) + (function (recur pathP) + (.case pathP + (#/////synthesis.Then bodyS) + (\ ///////phase.monad map _.return (generate archive bodyS)) + + #/////synthesis.Pop + (///////phase\wrap ..pop!) + + (#/////synthesis.Bind register) + (///////phase\wrap (_.; (_.set (..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]) + (do ! + [then! (recur then)] + (wrap [(_.= (|> match <format>) + ..peek) + then!]))) + (#.Cons cons))] + (wrap (_.cond clauses ..fail!)))]) + ([#/////synthesis.I64_Fork //primitive.i64] + [#/////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.monad 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! (recur thenP)] + (///////phase\wrap ($_ _.then + (_.; (_.set (..register register) ..peek_and_pop)) + then!))) + + ## (^ (/////synthesis.!multi_pop nextP)) + ## (.let [[extra_pops nextP'] (////synthesis/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 generate archive pathP) + (-> Phase Archive Path (Operation Statement)) + (do ///////phase.monad + [pattern_matching! (pattern_matching' generate archive pathP)] (wrap ($_ _.then - (_.do-while (_.bool false) - pattern-matching!) - (_.throw (_.new (_.constant "Exception") (list (_.string case.pattern-matching-error)))))))) + (_.do_while (_.bool false) + pattern_matching!) + (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error)))))))) (def: (gensym prefix) (-> Text (Operation Text)) - (\ ////.monad map (|>> %.nat (format prefix)) ///.next)) + (\ ///////phase.monad map (|>> %.nat (format prefix)) /////generation.next)) -(def: #export (case generate [valueS pathP]) - (-> Phase [Synthesis Path] (Operation (Expression Any))) - (do {! ////.monad} - [initG (generate valueS) - pattern-matching! (pattern-matching generate pathP) +(def: #export (case generate archive [valueS pathP]) + (Generator [Synthesis Path]) + (do {! ///////phase.monad} + [initG (generate archive valueS) + pattern_matching! (pattern_matching generate archive pathP) @case (..gensym "case") #let [@caseG (_.global @case) @caseL (_.var @case)] @init (\ ! map _.var (..gensym "init")) - #let [@dependencies+ (|> (case.storage pathP) - (get@ #case.dependencies) - set.to-list + #let [@dependencies+ (|> (////synthesis/case.storage pathP) + (get@ #////synthesis/case.dependencies) + set.to_list (list\map (function (_ variable) - [#0 (.case variable - (#reference.Local register) - (..register register) - - (#reference.Foreign register) - (..capture register))])))] + [false (.case variable + (#///////variable.Local register) + (..register register) + + (#///////variable.Foreign register) + (..capture register))])))] #let [directive ($_ _.then (<| _.; (_.set @caseL) @@ -241,9 +268,9 @@ ($_ _.then (_.; (_.set @cursor (_.array/* (list @init)))) (_.; (_.set @savepoint (_.array/* (list)))) - pattern-matching!)) + pattern_matching!)) (_.; (_.set @caseG @caseL)))] - _ (///.execute! directive) - _ (///.save! @case directive)] + _ (/////generation.execute! directive) + _ (/////generation.save! @case directive)] (wrap (_.apply/* (list& initG (list\map product.right @dependencies+)) @caseG)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux index 33660380c..718ee1e79 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -1,105 +1,124 @@ (.module: - [lux (#- function) + [lux (#- Global function) [abstract ["." monad (#+ do)]] [control pipe] [data ["." product] - ["." text] + ["." text + ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)]]] [target - ["_" php (#+ Argument Expression Statement)]]] + ["_" php (#+ Var Global Expression Argument Statement)]]] ["." // #_ - [runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Phase! Generator)] ["#." reference] ["#." case] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // - ["." // #_ - [reference (#+ Register Variable)] + ["//#" /// #_ + [analysis (#+ Variant Tuple Abstraction Application Analysis)] + [synthesis (#+ Synthesis)] + ["#." generation (#+ Context)] + ["//#" /// #_ [arity (#+ Arity)] - [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] - [synthesis (#+ Synthesis)]]]]]) + ["#." phase ("#\." monad)] + [reference + [variable (#+ Register Variable)]]]]]]) -(def: #export (apply generate [functionS argsS+]) - (-> Phase (Application Synthesis) (Operation (Expression Any))) - (do {! ////.monad} - [functionG (generate functionS) - argsG+ (monad.map ! generate argsS+)] +(def: #export (apply expression archive [functionS argsS+]) + (Generator (Application Synthesis)) + (do {! ///////phase.monad} + [functionG (expression archive functionS) + argsG+ (monad.map ! (expression archive) argsS+)] (wrap (_.apply/* argsG+ functionG)))) -(def: #export capture - (///reference.foreign _.var)) +(def: capture + (-> Register Var) + (|>> (///reference.foreign //reference.system) :assume)) (def: input (|>> inc //case.register)) -(def: #export (function generate [environment arity bodyS]) - (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) - (do {! ////.monad} - [[function-name bodyG] (///.with-context +(def: (with_closure inits @selfG @selfL body!) + (-> (List Expression) Global Var Statement [Statement Expression]) + (case inits + #.Nil + [($_ _.then + (_.; (_.set @selfL (_.closure (list (_.reference @selfL)) (list) body!))) + (_.; (_.set @selfG @selfL))) + @selfG] + + _ + (let [@inits (|> (list.enumeration inits) + (list\map (|>> product.left ..capture _.reference)))] + [(_.; (_.set @selfG (_.closure (list) @inits + ($_ _.then + (_.; (_.set @selfL (_.closure (list& (_.reference @selfL) @inits) + (list) + body!))) + (_.return @selfL))))) + (_.apply/* inits @selfG)]))) + +(def: #export (function expression archive [environment arity bodyS]) + (Generator (Abstraction Synthesis)) + (do {! ///////phase.monad} + [[function_name bodyG] (/////generation.with_new_context archive (do ! - [function-name ///.context] - (///.with-anchor (_.var function-name) - (generate bodyS)))) - closureG+ (: (Operation (List Argument)) - (monad.map ! (|>> (\ //reference.system variable) - (\ ! map _.reference)) - environment)) + [function_name (\ ! map ///reference.artifact + (/////generation.context archive))] + (/////generation.with_anchor (_.var function_name) + (expression archive bodyS)))) + closureG+ (monad.map ! (expression archive) environment) #let [@curried (_.var "curried") arityG (|> arity .int _.int) - @num-args (_.var "num_args") - @selfG (_.global function-name) - @selfL (_.var function-name) - initialize-self! (_.; (_.set (//case.register 0) @selfL)) + @num_args (_.var "num_args") + @selfG (_.global (///reference.artifact function_name)) + @selfL (_.var (///reference.artifact function_name)) + initialize_self! (_.; (_.set (//case.register 0) @selfL)) initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! (_.; (_.set (..input post) (_.nth (|> post .int _.int) @curried))))) - initialize-self! + initialize_self! (list.indices arity))] - #let [directive ($_ _.then - (<| _.; - (_.set @selfL) - (_.closure (list& (_.reference @selfL) closureG+) (list)) - ($_ _.then - (_.echo (_.string "'ello, world! ")) - (_.; (_.set @num-args (_.func-num-args/0 []))) - (_.echo @num-args) (_.echo (_.string " ~ ")) (_.echo arityG) - (_.echo (_.string text.new-line)) - (_.; (_.set @curried (_.func-get-args/0 []))) - (_.cond (list [(|> @num-args (_.= arityG)) - ($_ _.then - initialize! - (_.return bodyG))] - [(|> @num-args (_.> arityG)) - (let [arity-inputs (_.array-slice/3 [@curried (_.int +0) arityG]) - extra-inputs (_.array-slice/2 [@curried arityG]) - next (_.call-user-func-array/2 [@selfL arity-inputs]) - done (_.call-user-func-array/2 [next extra-inputs])] - ($_ _.then - (_.echo (_.string "STAGED ")) (_.echo (_.count/1 arity-inputs)) - (_.echo (_.string " + ")) (_.echo (_.count/1 extra-inputs)) - (_.echo (_.string text.new-line)) - (_.echo (_.string "@selfL ")) (_.echo @selfL) (_.echo (_.string text.new-line)) - (_.echo (_.string " next ")) (_.echo next) (_.echo (_.string text.new-line)) - (_.echo (_.string " done ")) (_.echo done) (_.echo (_.string text.new-line)) - (_.return done)))]) - ## (|> @num-args (_.< arityG)) - (let [@missing (_.var "missing")] - (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list)) - ($_ _.then - (_.; (_.set @missing (_.func-get-args/0 []))) - (_.echo (_.string "NEXT ")) (_.echo (_.count/1 @curried)) - (_.echo (_.string " ")) (_.echo (_.count/1 @missing)) - (_.echo (_.string " ")) (_.echo (_.count/1 (_.array-merge/+ @curried (list @missing)))) - (_.echo (_.string text.new-line)) - (_.return (_.call-user-func-array/2 [@selfL (_.array-merge/+ @curried (list @missing))]))))))) - )) - (_.; (_.set @selfG @selfL)))] - _ (///.execute! directive) - _ (///.save! function-name directive)] - (wrap @selfG))) + #let [[definition instantiation] (..with_closure closureG+ @selfG @selfL + ($_ _.then + (_.echo (_.string "'ello, world! ")) + (_.; (_.set @num_args (_.func_num_args/0 []))) + (_.echo @num_args) (_.echo (_.string " ~ ")) (_.echo arityG) + (_.echo (_.string text.new_line)) + (_.; (_.set @curried (_.func_get_args/0 []))) + (_.cond (list [(|> @num_args (_.= arityG)) + ($_ _.then + initialize! + (_.return bodyG))] + [(|> @num_args (_.> arityG)) + (let [arity_inputs (_.array_slice/3 [@curried (_.int +0) arityG]) + extra_inputs (_.array_slice/2 [@curried arityG]) + next (_.call_user_func_array/2 [@selfL arity_inputs]) + done (_.call_user_func_array/2 [next extra_inputs])] + ($_ _.then + (_.echo (_.string "STAGED ")) (_.echo (_.count/1 arity_inputs)) + (_.echo (_.string " + ")) (_.echo (_.count/1 extra_inputs)) + (_.echo (_.string text.new_line)) + (_.echo (_.string "@selfL ")) (_.echo @selfL) (_.echo (_.string text.new_line)) + (_.echo (_.string " next ")) (_.echo next) (_.echo (_.string text.new_line)) + (_.echo (_.string " done ")) (_.echo done) (_.echo (_.string text.new_line)) + (_.return done)))]) + ## (|> @num_args (_.< arityG)) + (let [@missing (_.var "missing")] + (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list)) + ($_ _.then + (_.; (_.set @missing (_.func_get_args/0 []))) + (_.echo (_.string "NEXT ")) (_.echo (_.count/1 @curried)) + (_.echo (_.string " ")) (_.echo (_.count/1 @missing)) + (_.echo (_.string " ")) (_.echo (_.count/1 (_.array_merge/+ @curried (list @missing)))) + (_.echo (_.string text.new_line)) + (_.return (_.call_user_func_array/2 [@selfL (_.array_merge/+ @curried (list @missing))]))))))) + ))] + _ (/////generation.execute! definition) + _ (/////generation.save! (%.nat (product.right function_name)) definition)] + (wrap instantiation))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index a3482d8a7..1bc853e64 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -4,31 +4,40 @@ ["." monad (#+ do)]] [data ["." product] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection - ["." list ("#\." functor)]]] + ["." list ("#\." functor)] + ["." set]]] + [math + [number + ["n" nat]]] [target - ["_" php (#+ Expression)]]] + ["_" php (#+ Var Expression Statement)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Phase! Generator Generator!)] ["#." case] - ["#/" // - ["#/" // - [// - [synthesis (#+ Scope Synthesis)]]]]]) + ["/#" // #_ + ["#." reference] + ["//#" /// #_ + ["."synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase] + [meta + [archive (#+ Archive)]] + [reference + [variable (#+ Register)]]]]]]) -(def: #export (scope generate [start initsS+ bodyS]) - (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do {! ////.monad} - [@loop (\ ! map (|>> %.nat (format "loop")) ///.next) +(def: #export (scope generate archive [start initsS+ bodyS]) + (Generator (Scope Synthesis)) + (do {! ///////phase.monad} + [@loop (\ ! map (|>> %.nat (format "loop")) /////generation.next) #let [@loopG (_.global @loop) @loopL (_.var @loop)] - initsO+ (monad.map ! generate initsS+) - bodyO (///.with-anchor @loopL - (generate bodyS)) + initsO+ (monad.map ! (generate archive) initsS+) + bodyO (/////generation.with_anchor @loopL + (generate archive bodyS)) #let [directive ($_ _.then (<| _.; (_.set @loopL) @@ -38,13 +47,13 @@ (list\map (|>> product.left (n.+ start) //case.register [#0]))) (_.return bodyO))) (_.; (_.set @loopG @loopL)))] - _ (///.execute! directive) - _ (///.save! @loop directive)] + _ (/////generation.execute! directive) + _ (/////generation.save! @loop directive)] (wrap (_.apply/* initsO+ @loopG)))) -(def: #export (recur generate argsS+) - (-> Phase (List Synthesis) (Operation (Expression Any))) - (do {! ////.monad} - [@scope ///.anchor - argsO+ (monad.map ! generate argsS+)] +(def: #export (recur generate archive argsS+) + (Generator (List Synthesis)) + (do {! ///////phase.monad} + [@scope /////generation.anchor + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux index b5b953ba7..7838ce804 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux @@ -2,7 +2,7 @@ [lux (#- i64) [control [pipe (#+ cond> new>)]] - [data + [math [number ["." frac]]] [target diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux index 77b9bec74..776245b61 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux @@ -2,10 +2,11 @@ [lux #* [target ["_" php (#+ Expression)]]] - [// - [// - ["." reference]]]) + [/// + [reference (#+ System)]]) -(def: #export system - (reference.system (: (-> Text (Expression Any)) _.global) - (: (-> Text (Expression Any)) _.var))) +(structure: #export system + (System Expression) + + (def: constant _.global) + (def: variable _.var)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux index 88a8897f2..3a50bba43 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux @@ -1,62 +1,84 @@ (.module: - [lux (#- Global inc) + [lux (#- Location 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 - ["_" php (#+ Expression Var Global Computation Literal Statement)]]] - ["." /// - ["//." // - [// - ["/////." name] - ["." synthesis]]]] - ) + [syntax (#+ syntax:)] + ["." code]] + [math + [number (#+ hex) + ["." i64]]] + ["@" target + ["_" php (#+ Expression Location Constant Var Computation Literal Statement)]]] + ["." /// #_ + ["#." reference] + ["//#" /// #_ + ["#." synthesis (#+ Synthesis)] + ["#." generation] + ["//#" /// + ["#." phase] + [reference + [variable (#+ Register)]] + [meta + [archive (#+ Output Archive) + ["." artifact (#+ Registry)]]]]]]) (template [<name> <base>] [(type: #export <name> - (<base> Var (Expression Any) Statement))] + (<base> Var Expression Statement))] - [Operation ///.Operation] - [Phase ///.Phase] - [Handler ///.Handler] - [Bundle ///.Bundle] + [Operation /////generation.Operation] + [Phase /////generation.Phase] + [Handler /////generation.Handler] + [Bundle /////generation.Bundle] ) -(def: prefix Text "LuxRuntime") +(type: #export (Generator i) + (-> Phase Archive i (Operation Expression))) + +(type: #export Phase! + (-> Phase Archive Synthesis (Operation Statement))) -(def: #export unit (_.string synthesis.unit)) +(type: #export (Generator! i) + (-> Phase! Phase Archive i (Operation Statement))) + +(def: prefix + "LuxRuntime") + +(def: #export unit + (_.string /////synthesis.unit)) (def: (flag value) (-> Bit Literal) (if value - (_.string "") + ..unit _.null)) -(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) - (_.array/** (list [(_.string ..variant-tag-field) tag] - [(_.string ..variant-flag-field) last?] - [(_.string ..variant-value-field) value]))) + (-> Expression Expression Expression Literal) + (_.array/** (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)) @@ -66,94 +88,93 @@ (..variant 0 #0 ..unit)) (def: #export some - (-> (Expression Any) Literal) + (-> Expression Literal) (..variant 1 #1)) (def: #export left - (-> (Expression Any) Literal) + (-> Expression Literal) (..variant 0 #0)) (def: #export right - (-> (Expression Any) Literal) + (-> Expression Literal) (..variant 1 #1)) -(def: (runtime-name raw) - (-> Text [Global Var]) - (let [refined (|> raw - /////name.normalize - (format ..prefix "_"))] - [(_.global refined) (_.var refined)])) - (def: (feature name definition) - (-> [Global Var] (-> [Global Var] Statement) Statement) + (-> Constant (-> Constant 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) - (` (_.var (~ (code.text (/////name.normalize 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) + (` (_.var (~ (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) - (macro.with-gensyms [g!_ g!G g!L] - (case declaration - (#.Left name) - (let [code-nameC (code.local-identifier (format "@" name)) - runtime-nameC (` (runtime-name (~ (code.text name))))] - (wrap (list (` (def: #export (~ (code.local-identifier name)) _.Global (~ runtime-nameC))) - (` (def: (~ code-nameC) - _.Statement - (..feature (~ runtime-nameC) - (function ((~ g!_) [(~ g!G) (~ g!L)]) - (_.; (_.set (~ g!G) (~ code)))))))))) - - (#.Right [name inputs]) - (let [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 ((~ (code.local-identifier name)) (~+ inputsC)) - (-> (~+ inputs-typesC) (_.Computation Any)) - (.let [[(~ g!G) (~ g!L)] (~ runtime-nameC)] - (_.apply/* (list (~+ inputsC)) (~ g!G))))) - (` (def: (~ code-nameC) - _.Statement - (..feature (~ runtime-nameC) - (function ((~ g!_) [(~ g!G) (~ g!L)]) - (..with-vars [(~+ inputsC)] - ($_ _.then - (<| _.; - (_.set (~ g!L)) - (_.closure (list (_.reference (~ g!L))) - (list (~+ (|> inputsC - (list\map (function (_ inputC) - (` [#0 (~ inputC)])))))) - (~ code))) - (_.; (_.set (~ g!G) (~ g!L))) - )))))))))))) + (do meta.monad + [runtime_id meta.count] + (macro.with_gensyms [g!_] + (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.constant (~ (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) + Var + (~ runtime_name))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.define (~ 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)] + (_.define_function (~ g!_) + (list (~+ (list\map (|>> (~) [false] (`)) inputsC))) + (~ code)))))))))))))))) (runtime: (lux//try op) - (with-vars [value] + (with_vars [value] (_.try ($_ _.then (_.; (_.set value (_.apply/1 [..unit] op))) (_.return (..right value))) - (list (with-vars [error] + (list (with_vars [error] {#_.class (_.constant "Exception") #_.exception error #_.handler (_.return (..left (_.do "getMessage" (list) error)))}))))) -(runtime: (lux//program-args inputs) - (with-vars [head tail] +(runtime: (lux//program_args inputs) + (with_vars [head tail] ($_ _.then (_.; (_.set tail ..none)) - (<| (_.for-each (_.array-reverse/1 inputs) head) + (<| (_.for_each (_.array_reverse/1 inputs) head) (_.; (_.set tail (..some (_.array/* (list head tail)))))) (_.return tail)))) @@ -161,7 +182,7 @@ Statement ($_ _.then @lux//try - @lux//program-args + @lux//program_args )) (runtime: (io//throw! message) @@ -175,71 +196,71 @@ @io//throw! )) -(def: tuple-size +(def: tuple_size _.count/1) -(def: last-index - (|>> ..tuple-size (_.- (_.int +1)))) +(def: last_index + (|>> ..tuple_size (_.- (_.int +1)))) -(with-expansions [<recur> (as-is ($_ _.then - (_.; (_.set lefts (_.- last-index-right lefts))) - (_.; (_.set tuple (_.nth last-index-right tuple)))))] +(with_expansions [<recur> (as_is ($_ _.then + (_.; (_.set lefts (_.- last_index_right lefts))) + (_.; (_.set 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 last-index-right (..last-index tuple))) - (_.if (_.> lefts last-index-right) + (_.; (_.set 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 last-index-right (..last-index tuple))) - (_.; (_.set right-index (_.+ (_.int +1) lefts))) - (_.cond (list [(_.= last-index-right right-index) - (_.return (_.nth right-index tuple))] - [(_.> last-index-right right-index) + (_.; (_.set last_index_right (..last_index tuple))) + (_.; (_.set 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-slice/2 [tuple right-index]))) + (_.return (_.array_slice/2 [tuple right_index]))) ))))) (runtime: (sum//get sum wantsLast wantedTag) - (let [no-match! (_.return _.null) - sum-tag (_.nth (_.string ..variant-tag-field) sum) - ## sum-tag (_.nth (_.int +0) sum) - sum-flag (_.nth (_.string ..variant-flag-field) sum) - ## sum-flag (_.nth (_.int +1) sum) - sum-value (_.nth (_.string ..variant-value-field) sum) - ## sum-value (_.nth (_.int +2) sum) - is-last? (_.= (_.string "") sum-flag) - test-recursion! (_.if is-last? + (let [no_match! (_.return _.null) + sum_tag (_.nth (_.string ..variant_tag_field) sum) + ## sum_tag (_.nth (_.int +0) sum) + sum_flag (_.nth (_.string ..variant_flag_field) sum) + ## sum_flag (_.nth (_.int +1) sum) + sum_value (_.nth (_.string ..variant_value_field) sum) + ## sum_value (_.nth (_.int +2) sum) + is_last? (_.= (_.string "") sum_flag) + test_recursion! (_.if is_last? ## Must recurse. - (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag))) - no-match!)] + (_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag))) + no_match!)] ($_ _.then (_.echo (_.string "sum//get ")) (_.echo (_.count/1 sum)) (_.echo (_.string " ")) (_.echo (_.apply/1 [sum] (_.constant "gettype"))) - (_.echo (_.string " ")) (_.echo sum-tag) + (_.echo (_.string " ")) (_.echo sum_tag) (_.echo (_.string " ")) (_.echo wantedTag) - (_.echo (_.string text.new-line)) - (_.cond (list [(_.= sum-tag wantedTag) - (_.if (_.= wantsLast sum-flag) - (_.return sum-value) - test-recursion!)] + (_.echo (_.string text.new_line)) + (_.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) + [(_.and (_.< sum_tag wantedTag) (_.= (_.string "") wantsLast)) - (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))]) - no-match!) + (_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))]) + no_match!) ))) (def: runtime//adt @@ -250,22 +271,22 @@ @sum//get )) -(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 ($_ _.then - @i64//logic-right-shift + @i64//logic_right_shift )) (runtime: (text//index subject param start) - (with-vars [idx] + (with_vars [idx] ($_ _.then (_.; (_.set idx (_.strpos/3 [subject param start]))) (_.if (_.= (_.bool false) idx) @@ -278,19 +299,19 @@ @text//index )) -(def: check-necessary-conditions! +(def: check_necessary_conditions! Statement (let [condition (_.= (_.int +8) (_.constant "PHP_INT_SIZE")) - error-message (_.string (format "Cannot run program!" text.new-line + error_message (_.string (format "Cannot run program!" text.new_line "Lux/PHP programs require 64-bit PHP builds!"))] (_.when (_.not condition) - (_.throw (_.new (_.constant "Exception") (list error-message)))))) + (_.throw (_.new (_.constant "Exception") (list error_message)))))) (def: runtime Statement ($_ _.then - check-necessary-conditions! + check_necessary_conditions! runtime//lux runtime//adt runtime//i64 @@ -301,9 +322,14 @@ (def: #export artifact ..prefix) (def: #export generate - (Operation Any) - (///.with-buffer - (do ////.monad - [_ (///.execute! ..runtime) - _ (///.save! ..prefix ..runtime)] - (///.save-buffer! ..artifact)))) + (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))])]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux index 9748ede02..307417c6c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux @@ -5,32 +5,32 @@ [target ["_" php (#+ Expression)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] - ["#//" /// - ["#/" // #_ - [analysis (#+ Variant Tuple)] - ["#." synthesis (#+ Synthesis)]]]]) + ["///#" //// #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)] + ["//#" /// #_ + ["#." phase ("#\." monad)]]]]) -(def: #export (tuple generate elemsS+) - (-> Phase (Tuple Synthesis) (Operation (Expression Any))) +(def: #export (tuple generate archive elemsS+) + (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (\ ////.monad wrap (//primitive.text /////synthesis.unit)) + (///////phase\wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) - (generate singletonS) + (generate archive singletonS) _ (|> elemsS+ - (monad.map ////.monad generate) - (\ ////.monad map _.array/*)))) + (monad.map ///////phase.monad (generate archive)) + (///////phase\map _.array/*)))) -(def: #export (variant generate [lefts right? valueS]) - (-> Phase (Variant Synthesis) (Operation (Expression Any))) - (\ ////.monad map - (//runtime.variant (if right? - (inc lefts) - lefts) - right?) - (generate valueS))) +(def: #export (variant generate archive [lefts right? valueS]) + (Generator (Variant Synthesis)) + (let [tag (if right? + (inc lefts) + lefts)] + (///////phase\map (//runtime.variant tag right?) + (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 1af62cf7e..6d218b137 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -314,9 +314,9 @@ ($_ _.then (_.set (list floored) (_.// param subject)) (_.return (let [potentially_floored? (_.< (_.int +0) floored) - inexact? (|> floored - (_.* param) - (_.= subject) + inexact? (|> subject + (_.% param) + (_.= (_.int +0)) _.not)] (_.? (_.and potentially_floored? inexact?) diff --git a/stdlib/source/lux/tool/compiler/reference.lux b/stdlib/source/lux/tool/compiler/reference.lux index 96cefe81a..856435fe8 100644 --- a/stdlib/source/lux/tool/compiler/reference.lux +++ b/stdlib/source/lux/tool/compiler/reference.lux @@ -71,7 +71,9 @@ [constant #..Constant] ) -(def: #export self Reference (..local 0)) +(def: #export self + Reference + (..local 0)) (def: #export format (Format Reference) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index a39671ea4..0379b8427 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -34,7 +34,7 @@ ["#." math] ["#." meta] ["#." time] - ## ["#." tool] + ## ["#." tool] ## TODO: Update & expand tests for this ["#." type] ["#." world] ["#." host] @@ -181,7 +181,9 @@ (n.= on_valid_host (for {@.old on_valid_host @.jvm on_valid_host - @.js on_valid_host} + @.js on_valid_host + @.python on_valid_host + @.lua on_valid_host} on_default)))))) (def: conversion_tests diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index b129aaaef..9032453c5 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -41,10 +41,10 @@ [left random.nat mid random.nat right random.nat] - (with_expansions [<module> (as_is [-8.9 +6.7 .5 -4 +3 2 #1 #0 #c b "a"]) - <module>' "-8.9+6.7.5-4+32#1#0cba" - <short> (as_is ["a" b #c #0 #1 2 +3 -4 .5 +6.7 -8.9]) - <short>' "abc#0#12+3-4.5+6.7-8.9"] + (with_expansions [<module> (as_is [.5 -4 +3 2 #1 #0 #c b "a"]) + <module>' ".5-4+32#1#0cba" + <short> (as_is ["a" b #c #0 #1 2 +3 -4 .5]) + <short>' "abc#0#12+3-4.5"] ($_ _.and (_.cover [/.splice] (\ (list.equivalence nat.equivalence) = |