diff options
Diffstat (limited to 'stdlib')
18 files changed, 1448 insertions, 57 deletions
diff --git a/stdlib/source/lux/host/php.lux b/stdlib/source/lux/host/php.lux new file mode 100644 index 000000000..286d8d397 --- /dev/null +++ b/stdlib/source/lux/host/php.lux @@ -0,0 +1,444 @@ +(.module: + [lux (#- Code static int if cond or and not comment for) + [control + [pipe (#+ case> cond> new>)]] + [data + [number + ["." frac]] + ["." text + format] + [collection + ["." list ("#@." functor fold)]]] + [macro + ["." template]] + [type + abstract]]) + +(def: input-separator ", ") +(def: statement-suffix ";") + +(def: nest + (-> Text Text) + (|>> (format text.new-line) + (text.replace-all text.new-line (format text.new-line text.tab)))) + +(def: block + (-> Text Text) + (|>> ..nest (text.enclose ["{" (format text.new-line "}")]))) + +(def: group + (-> Text Text) + (text.enclose ["(" ")"])) + +(abstract: #export (Code brand) + {} + + Text + + (def: #export manual + (-> Text Code) + (|>> :abstraction)) + + (def: #export code + (-> (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)))))] + + [Expression Code] + [Computation Expression] + [Location Computation] + ) + + (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] + ) + + (type: #export Argument + {#reference? Bit + #var Var}) + + (def: #export ; + (-> (Expression Any) Statement) + (|>> :representation + (text.suffix ..statement-suffix) + :abstraction)) + + (def: #export var + (-> Text Var) + (|>> (format "$") :abstraction)) + + (def: #export constant + (-> Text Constant) + (|>> :abstraction)) + + (def: #export null + Literal + (:abstraction "NULL")) + + (def: #export bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: #export int + (-> Int Literal) + (|>> %i :abstraction)) + + (def: #export float + (-> Frac Literal) + (|>> (cond> [(f/= frac.positive-infinity)] + [(new> "+INF" [])] + + [(f/= frac.negative-infinity)] + [(new> "-INF" [])] + + [(f/= frac.not-a-number)] + [(new> "NAN" [])] + + ## else + [%f]) + :abstraction)) + + (def: sanitize + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replace-all <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [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)] + )) + ))) + + (def: #export string + (-> Text Literal) + (|>> ..sanitize + (text.enclose [text.double-quote text.double-quote]) + :abstraction)) + + (def: arguments + (-> (List (Expression Any)) Text) + (|>> (list@map ..code) (text.join-with ..input-separator) ..group)) + + (def: #export (apply/* args func) + (-> (List (Expression Any)) (Expression Any) (Computation Any)) + (:abstraction + (format (:representation func) (..arguments args)))) + + (def: parameters + (-> (List Argument) Text) + (|>> (list@map (function (_ [reference? var]) + (.if reference? + (format "&" (:representation var)) + (:representation var)))) + (text.join-with ..input-separator) + ..group)) + + (template [<name> <reference?>] + [(def: #export <name> + (-> Var Argument) + (|>> [<reference?>]))] + + [parameter #0] + [reference #1] + ) + + (def: #export (closure uses arguments body!) + (-> (List Argument) (List Argument) Statement Literal) + (let [uses (case uses + #.Nil + "" + + _ + (format "use " (..parameters uses)))] + (|> (format "function " (..parameters arguments) + " " uses " " + (..block (:representation body!))) + ..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 [<lux-name> <php-name>] + [(def: #export (<lux-name> args) + (-> [(~~ (template.splice <input-type>+))] (Computation Any)) + (<apply> args (..constant <php-name>)))] + + (~~ (template.splice <function>+))))] + + [apply/0 [] [] + [[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"] + [empty/1 "empty"] + [count/1 "count"] + [strlen/1 "strlen"] + [array-pop/1 "array_pop"] + [array-reverse/1 "array_reverse"] + [intval/1 "intval"] + [floatval/1 "floatval"] + [strval/1 "strval"] + [ord/1 "ord"] + [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"] + [strpos/3 "strpos"] + [substr/3 "substr"]]] + ) + + (def: #export (array/* values) + (-> (List (Expression Any)) Literal) + (|> values + (list@map ..code) + (text.join-with ..input-separator) + ..group + (format "array") + :abstraction)) + + (def: #export (array-merge/+ required optionals) + (-> (Expression Any) (List (Expression Any)) (Computation Any)) + (..apply/* (list& required optionals) (..constant "array_merge"))) + + (def: #export (array/** kvs) + (-> (List [(Expression Any) (Expression Any)]) Literal) + (|> kvs + (list@map (function (_ [key value]) + (format (:representation key) " => " (:representation value)))) + (text.join-with ..input-separator) + ..group + (format "array") + :abstraction)) + + (def: #export (new constructor inputs) + (-> Constant (List (Expression Any)) (Computation Any)) + (|> (format "new " (:representation constructor) (arguments inputs)) + :abstraction)) + + (def: #export (do method inputs object) + (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) + (|> (format (:representation object) "->" method (arguments inputs)) + :abstraction)) + + (def: #export (nth idx array) + (-> (Expression Any) (Expression Any) Access) + (|> (format (:representation array) "[" (:representation idx) "]") + :abstraction)) + + (def: #export (global name) + (-> Text Global) + (|> (..var "GLOBALS") (..nth (..string name)) :transmutation)) + + (def: #export (? test then else) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (|> (format (:representation test) " ? " + (:representation then) " : " + (:representation else)) + ..group + :abstraction)) + + (template [<name> <op>] + [(def: #export (<name> parameter subject) + (-> (Expression Any) (Expression Any) (Computation Any)) + (|> (format (:representation subject) " " <op> " " (:representation parameter)) + ..group + :abstraction))] + + [or "||"] + [and "&&"] + [= "==="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [% "%"] + [bit-or "|"] + [bit-and "&"] + [bit-xor "^"] + [bit-shl "<<"] + [bit-shr ">>"] + [concat "."] + ) + + (def: #export not + (-> (Computation Any) (Computation Any)) + (|>> :representation (format "!") :abstraction)) + + (def: #export (set var value) + (-> (Location Any) (Expression Any) (Computation Any)) + (|> (format (:representation var) " = " (:representation value)) + ..group + :abstraction)) + + (def: #export (set? var) + (-> Var (Computation Any)) + (..apply/1 [var] (..constant "isset"))) + + (template [<name> <modifier>] + [(def: #export <name> + (-> Var Statement) + (|>> :representation (format <modifier> " ") (text.suffix ..statement-suffix) :abstraction))] + + [define-global "global"] + ) + + (template [<name> <modifier> <location>] + [(def: #export (<name> location value) + (-> <location> (Expression Any) Statement) + (:abstraction (format <modifier> " " (:representation location) + " = " (:representation value) + ..statement-suffix)))] + + [define-static "static" Var] + [define-constant "const" Constant] + ) + + (def: #export (if test then! else!) + (-> (Expression Any) Statement Statement Statement) + (:abstraction + (format "if " (..group (:representation test)) " " + (..block (:representation then!)) + " else " + (..block (:representation else!))))) + + (def: #export (when test then!) + (-> (Expression Any) Statement Statement) + (:abstraction + (format "if " (..group (:representation test)) " " + (..block (:representation then!))))) + + (def: #export (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new-line + (:representation post!)))) + + (def: #export (while test body!) + (-> (Expression Any) Statement Statement) + (:abstraction + (format "while " (..group (:representation test)) " " + (..block (:representation body!))))) + + (def: #export (do-while test body!) + (-> (Expression Any) Statement Statement) + (:abstraction + (format "do " (..block (:representation body!)) + " while " (..group (:representation test)) + ..statement-suffix))) + + (def: #export (for-each array value body!) + (-> (Expression Any) Var Statement Statement) + (:abstraction + (format "foreach(" (:representation array) + " as " (:representation value) + ") " (..block (:representation body!))))) + + (type: #export Except + {#class Constant + #exception Var + #handler Statement}) + + (def: (catch except) + (-> Except Text) + (let [declaration (format (:representation (get@ #class except)) + " " (:representation (get@ #exception except)))] + (format "catch" (..group declaration) " " + (..block (:representation (get@ #handler except)))))) + + (def: #export (try body! excepts) + (-> Statement (List Except) Statement) + (:abstraction + (format "try " (..block (:representation body!)) + text.new-line + (|> excepts + (list@map catch) + (text.join-with text.new-line))))) + + (template [<name> <keyword>] + [(def: #export <name> + (-> (Expression Any) Statement) + (|>> :representation (format <keyword> " ") (text.suffix ..statement-suffix) :abstraction))] + + [throw "throw"] + [return "return"] + [echo "echo"] + ) + + (def: #export (define name value) + (-> Constant (Expression Any) (Expression Any)) + (..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!)))))) + + (template [<name> <keyword>] + [(def: #export <name> + Statement + (|> <keyword> + (text.suffix ..statement-suffix) + :abstraction))] + + [break "break"] + [continue "continue"] + ) + ) + +(def: #export (cond clauses else!) + (-> (List [(Expression Any) Statement]) Statement Statement) + (list@fold (function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) + +(def: #export command-line-arguments + Var + (..var "argv")) diff --git a/stdlib/source/lux/host/ruby.lux b/stdlib/source/lux/host/ruby.lux index e52fb6f37..037cdca5b 100644 --- a/stdlib/source/lux/host/ruby.lux +++ b/stdlib/source/lux/host/ruby.lux @@ -1,9 +1,7 @@ (.module: [lux (#- Code static int if cond function or and not comment) [control - [pipe (#+ case> cond> new>)] - [parser - ["s" code]]] + [pipe (#+ case> cond> new>)]] [data [number ["." frac]] @@ -12,9 +10,7 @@ [collection ["." list ("#@." functor fold)]]] [macro - ["." template] - ["." code] - [syntax (#+ syntax:)]] + ["." template]] [type abstract]]) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index 61243a9bc..6c2ba872f 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -80,7 +80,7 @@ (do ///.monad [codeT (generate codeS) [target-name value statement] (///generation.define! name codeT) - _ (///generation.save! name statement)] + _ (///generation.save! false name statement)] (wrap [code//type codeT target-name value])))) (def: (definition name ?type codeC) @@ -296,7 +296,7 @@ (///generation.Operation anchor expression statement Any))) (do ///.monad [programG (generate programS)] - (///generation.save! ["" ""] (program programG)))) + (///generation.save! false ["" ""] (program programG)))) (def: (def::program program) (All [anchor expression statement] diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index edf260e19..4482daa3b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -221,12 +221,14 @@ (#error.Failure error) (exception.throw cannot-interpret error)))) -(def: #export (save! name code) +(def: #export (save! execute? name code) (All [anchor expression statement] - (-> Name statement (Operation anchor expression statement Any))) + (-> Bit Name statement (Operation anchor expression statement Any))) (do //.monad [label (..gensym "save") - _ (execute! label code) + _ (if execute? + (execute! label code) + (wrap [])) ?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php.lux b/stdlib/source/lux/tool/compiler/phase/generation/php.lux new file mode 100644 index 000000000..480c473bf --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]]] + [/ + [runtime (#+ Phase)] + ["." primitive] + ["." structure] + ["." reference ("#@." system)] + ["." case] + ["." loop] + ["." function] + ["." /// + ["." extension] + [// + ["." synthesis]]]]) + +(def: #export (generate 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) + + (#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) + + (^ (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) + + (#synthesis.Extension extension) + (extension.apply generate extension))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux new file mode 100644 index 000000000..1167ae5a6 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/case.lux @@ -0,0 +1,250 @@ +(.module: + [lux (#- case let if) + [abstract + [monad (#+ do)]] + [control + ["ex" exception (#+ exception:)]] + [data + ["." product] + ["." text + format] + [collection + ["." list ("#@." functor fold)] + ["." set]]] + [host + ["_" php (#+ Var Expression Statement)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." reference] + ["#." primitive] + ["#/" // + ["#." reference] + ["#/" // ("#@." monad) + [synthesis + ["." case]] + ["#/" // #_ + ["." reference (#+ Register)] + ["#." synthesis (#+ Synthesis Path)]]]]]) + +(def: #export register + (///reference.local _.var)) + +(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)] + (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)] + (wrap (list@fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + (<side> lefts) + (<accessor> (_.int (.int lefts)))) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + 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)] + (wrap (_.? testG thenG elseG)))) + +(def: @savepoint (_.var "lux_pm_savepoint")) +(def: @cursor (_.var "lux_pm_cursor")) +(def: @temp (_.var "lux_pm_temp")) + +(def: (push! value) + (-> (Expression Any) Statement) + (_.; (_.array-push/2 [@cursor value]))) + +(def: peek-and-pop + (Expression Any) + (_.array-pop/1 @cursor)) + +(def: pop! + Statement + (_.; ..peek-and-pop)) + +(def: peek + (Expression Any) + (_.nth (|> @cursor _.count/1 (_.- (_.int +1))) + @cursor)) + +(def: save! + Statement + (.let [cursor (_.array-slice/2 [@cursor (_.int +0)])] + (_.; (_.array-push/2 [@savepoint cursor])))) + +(def: restore! + Statement + (_.; (_.set @cursor (_.array-pop/1 @savepoint)))) + +(def: fail! _.break) + +(exception: #export unrecognized-path) + +(def: (multi-pop! pops) + (-> Nat Statement) + (_.; (_.array-splice/3 [@cursor + (_.int +0) + (_.int (i/* -1 (.int pops)))]))) + +(template [<name> <flag> <prep>] + [(def: (<name> simple? idx) + (-> Bit Nat Statement) + ($_ _.then + (_.; (_.set @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>)))) + (.if simple? + (_.when (_.is-null/1 @temp) + fail!) + (_.if (_.is-null/1 @temp) + fail! + (..push! @temp)))))] + + [left-choice _.null (<|)] + [right-choice (_.string "") inc] + ) + +(def: (alternation pre! post!) + (-> Statement Statement Statement) + ($_ _.then + (_.do-while (_.bool false) + ($_ _.then + ..save! + pre!)) + ($_ _.then + ..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]) + + _ + (////.throw unrecognized-path []))) + +(def: (pattern-matching generate pathP) + (-> Phase Path (Operation Statement)) + (do ////.monad + [pattern-matching! (pattern-matching' generate pathP)] + (wrap ($_ _.then + (_.do-while (_.bool false) + pattern-matching!) + (_.throw (_.new (_.constant "Exception") (list (_.string case.pattern-matching-error)))))))) + +(def: (gensym prefix) + (-> Text (Operation Text)) + (:: ////.monad map (|>> %n (format prefix)) ///.next)) + +(def: #export (case generate [valueS pathP]) + (-> Phase [Synthesis Path] (Operation (Expression Any))) + (do ////.monad + [initG (generate valueS) + pattern-matching! (pattern-matching generate 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 + (list@map (function (_ variable) + [#0 (.case variable + (#reference.Local register) + (..register register) + + (#reference.Foreign register) + (..capture register))])))] + _ (///.save! true ["" @case] + ($_ _.then + (<| _.; + (_.set @caseL) + (_.closure (list (_.reference @caseL)) (list& [#0 @init] + @dependencies+)) + ($_ _.then + (_.; (_.set @cursor (_.array/* (list @init)))) + (_.; (_.set @savepoint (_.array/* (list)))) + pattern-matching!)) + (_.; (_.set @caseG @caseL))))] + (wrap (_.apply/* (list& initG (list@map product.right @dependencies+)) + @caseG)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/extension.lux new file mode 100644 index 000000000..3bc0a0887 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/extension.lux @@ -0,0 +1,13 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [// + [runtime (#+ Bundle)]] + [/ + ["." common]]) + +(def: #export bundle + Bundle + common.bundle) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux new file mode 100644 index 000000000..9938bb2c1 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux @@ -0,0 +1,126 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + ["." product] + ["." text] + [collection + ["." dictionary]]] + [host (#+ import:) + ["_" php (#+ Expression)]]] + ["." /// #_ + ["#." runtime (#+ Operation Phase Handler Bundle)] + ["#." primitive] + [// + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + [// + [extension + ["." bundle]]]]]) + +(def: lux-procs + Bundle + (|> bundle.empty + (bundle.install "is" (binary (product.uncurry _.=))) + (bundle.install "try" (unary ///runtime.lux//try)))) + +(def: i64-procs + Bundle + (<| (bundle.prefix "i64") + (|> bundle.empty + (bundle.install "and" (binary (product.uncurry _.bit-and))) + (bundle.install "or" (binary (product.uncurry _.bit-or))) + (bundle.install "xor" (binary (product.uncurry _.bit-xor))) + (bundle.install "left-shift" (binary (product.uncurry _.bit-shl))) + (bundle.install "logical-right-shift" (binary (product.uncurry ///runtime.i64//logic-right-shift))) + (bundle.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "-" (binary (product.uncurry _.-))) + ))) + +(def: int-procs + Bundle + (<| (bundle.prefix "int") + (|> bundle.empty + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "frac" (unary _.floatval/1)) + (bundle.install "char" (unary _.chr/1))))) + +(import: #long java/lang/Double + (#static MIN_VALUE Double) + (#static MAX_VALUE Double)) + +(template [<name> <const>] + [(def: (<name> _) + (Nullary (Expression Any)) + (_.float <const>))] + + [frac//smallest (java/lang/Double::MIN_VALUE)] + [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//max (java/lang/Double::MAX_VALUE)] + ) + +(def: frac-procs + Bundle + (<| (bundle.prefix "frac") + (|> bundle.empty + (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "-" (binary (product.uncurry _.-))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "smallest" (nullary frac//smallest)) + (bundle.install "min" (nullary frac//min)) + (bundle.install "max" (nullary frac//max)) + (bundle.install "int" (unary _.intval/1)) + (bundle.install "encode" (unary _.strval/1)) + (bundle.install "decode" (unary (|>> _.floatval/1 ///runtime.some))) + ))) + +(def: (text//index [startO partO textO]) + (Trinary (Expression Any)) + (///runtime.text//index textO partO startO)) + +(def: text-procs + Bundle + (<| (bundle.prefix "text") + (|> bundle.empty + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "concat" (binary (product.uncurry _.concat))) + (bundle.install "index" (trinary text//index)) + (bundle.install "size" (unary _.strlen/1)) + (bundle.install "char" (binary (function (text//char [text idx]) + (|> text (_.nth idx) _.ord/1)))) + (bundle.install "clip" (trinary (function (text//clip [from to text]) + (_.substr/3 [text from (_.- from to)])))) + ))) + +(def: io-procs + Bundle + (<| (bundle.prefix "io") + (|> bundle.empty + (bundle.install "log" (unary (|>> (_.concat (_.string text.new-line)) _.print/1))) + (bundle.install "error" (unary ///runtime.io//throw!)) + (bundle.install "exit" (unary _.exit/1)) + (bundle.install "current-time" (nullary (|>> _.time/0 (_.* (_.int +1,000)))))))) + +(def: #export bundle + 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) + ))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux new file mode 100644 index 000000000..b2b446ed0 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux @@ -0,0 +1,104 @@ +(.module: + [lux (#- function) + [abstract + ["." monad (#+ do)]] + [control + pipe] + [data + ["." product] + ["." text + format] + [collection + ["." list ("#@." functor fold)]]] + [host + ["_" php (#+ Argument Expression Statement)]]] + ["." // #_ + [runtime (#+ Operation Phase)] + ["#." reference] + ["#." case] + ["#/" // + ["#." reference] + ["#/" // + ["." // #_ + [reference (#+ Register Variable)] + [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] + [synthesis (#+ Synthesis)]]]]]) + +(def: #export (apply generate [functionS argsS+]) + (-> Phase (Application Synthesis) (Operation (Expression Any))) + (do ////.monad + [functionG (generate functionS) + argsG+ (monad.map @ generate argsS+)] + (wrap (_.apply/* argsG+ functionG)))) + +(def: #export capture + (///reference.foreign _.var)) + +(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 + (do @ + [function-name ///.context] + (///.with-anchor (_.var function-name) + (generate bodyS)))) + closureG+ (: (Operation (List Argument)) + (monad.map @ (|>> (:: //reference.system variable) + (:: @ map _.reference)) + 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)) + initialize! (list@fold (.function (_ post pre!) + ($_ _.then + pre! + (_.; (_.set (..input post) (_.nth (|> post .int _.int) @curried))))) + initialize-self! + (list.indices arity))] + _ (///.save! true ["" function-name] + ($_ _.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))))] + (wrap @selfG))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux new file mode 100644 index 000000000..3404953fe --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/loop.lux @@ -0,0 +1,47 @@ +(.module: + [lux (#- Scope) + [abstract + ["." monad (#+ do)]] + [data + ["." product] + [text + format] + [collection + ["." list ("#@." functor)]]] + [host + ["_" php (#+ Expression)]]] + ["." // #_ + [runtime (#+ Operation Phase)] + ["#." case] + ["#/" // + ["#/" // + [// + [synthesis (#+ Scope Synthesis)]]]]]) + +(def: #export (scope generate [start initsS+ bodyS]) + (-> Phase (Scope Synthesis) (Operation (Expression Any))) + (do ////.monad + [@loop (:: @ map (|>> %n (format "loop")) ///.next) + #let [@loopG (_.global @loop) + @loopL (_.var @loop)] + initsO+ (monad.map @ generate initsS+) + bodyO (///.with-anchor @loopL + (generate bodyS)) + _ (///.save! true ["" @loop] + ($_ _.then + (<| _.; + (_.set @loopL) + (_.closure (list (_.reference @loopL)) + (|> initsS+ + list.enumerate + (list@map (|>> product.left (n/+ start) //case.register [#0]))) + (_.return bodyO))) + (_.; (_.set @loopG @loopL))))] + (wrap (_.apply/* initsO+ @loopG)))) + +(def: #export (recur generate argsS+) + (-> Phase (List Synthesis) (Operation (Expression Any))) + (do ////.monad + [@scope ///.anchor + argsO+ (monad.map @ generate argsS+)] + (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/primitive.lux new file mode 100644 index 000000000..48a32389b --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/primitive.lux @@ -0,0 +1,27 @@ +(.module: + [lux (#- i64) + [control + [pipe (#+ cond> new>)]] + [data + [number + ["." frac]]] + [host + ["_" php (#+ Literal)]]] + ["." // #_ + ["#." runtime]]) + +(def: #export bit + (-> Bit Literal) + _.bool) + +(def: #export i64 + (-> (I64 Any) Literal) + (|>> .int _.int)) + +(def: #export f64 + (-> Frac Literal) + _.float) + +(def: #export text + (-> Text Literal) + _.string) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/reference.lux new file mode 100644 index 000000000..8f5313421 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/reference.lux @@ -0,0 +1,11 @@ +(.module: + [lux #* + [host + ["_" php (#+ Expression)]]] + [// + [// + ["." reference]]]) + +(def: #export system + (reference.system (: (-> Text (Expression Any)) _.global) + (: (-> Text (Expression Any)) _.var))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux new file mode 100644 index 000000000..e29b7622a --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux @@ -0,0 +1,305 @@ +(.module: + [lux (#- inc) + [abstract + [monad (#+ do)]] + [control + ["." function] + ["p" parser + ["s" code]]] + [data + [number (#+ hex) + ["." i64]] + ["." text + format] + [collection + ["." list ("#@." functor)]]] + ["." macro + ["." code] + [syntax (#+ syntax:)]] + [host + ["_" php (#+ Expression Var Global Computation Literal Statement)]]] + ["." /// + ["//." // + [// + ["/////." name] + ["." synthesis]]]] + ) + +(template [<name> <base>] + [(type: #export <name> + (<base> Var (Expression Any) Statement))] + + [Operation ///.Operation] + [Phase ///.Phase] + [Handler ///.Handler] + [Bundle ///.Bundle] + ) + +(def: prefix Text "LuxRuntime") + +(def: #export unit (_.string synthesis.unit)) + +(def: (flag value) + (-> Bit Literal) + (if value + (_.string "") + _.null)) + +(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]))) + +(def: #export (variant tag last? value) + (-> Nat Bit (Expression Any) Literal) + (variant' (_.int (.int tag)) + (..flag last?) + value)) + +(def: #export none + Literal + (..variant 0 #0 ..unit)) + +(def: #export some + (-> (Expression Any) Literal) + (..variant 1 #1)) + +(def: #export left + (-> (Expression Any) Literal) + (..variant 0 #0)) + +(def: #export right + (-> (Expression Any) 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) + (definition name)) + +(syntax: #export (with-vars {vars (s.tuple (p.some s.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))))} + 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))) + )))))))))))) + +(runtime: (lux//try op) + (with-vars [value] + (_.try ($_ _.then + (_.; (_.set value (_.apply/1 [..unit] op))) + (_.return (..right value))) + (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] + ($_ _.then + (_.; (_.set tail ..none)) + (<| (_.for-each (_.array-reverse/1 inputs) head) + (_.; (_.set tail (..some (_.array/* (list head tail)))))) + (_.return tail)))) + +(def: runtime//lux + Statement + ($_ _.then + @lux//try + @lux//program-args)) + +(runtime: (io//throw! message) + ($_ _.then + (_.throw (_.new (_.constant "Exception") (list message))) + (_.return ..unit))) + +(def: runtime//io + Statement + ($_ _.then + @io//throw!)) + +(def: tuple-size + _.count/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)))))] + (runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] + (<| (_.while (_.bool true)) + ($_ _.then + (_.; (_.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] + (<| (_.while (_.bool true)) + ($_ _.then + (_.; (_.set last-index-right (..last-index tuple))) + (_.; (_.set right-index (_.+ (_.int +1) lefts))) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.nth right-index tuple))] + [(_.> right-index last-index-right) + ## Needs recursion. + <recur>]) + (_.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? + ## Must recurse. + (_.return (sum//get sum-value (_.- sum-tag wantedTag) wantsLast)) + 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 wantedTag) + (_.echo (_.string text.new-line)) + (_.cond (list [(_.= sum-tag wantedTag) + (_.if (_.= wantsLast sum-flag) + (_.return sum-value) + test-recursion!)] + + [(_.> sum-tag wantedTag) + test-recursion!] + + [(_.and (_.< sum-tag wantedTag) + (_.= (_.string "") wantsLast)) + (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))]) + no-match!) + ))) + +(def: runtime//adt + Statement + ($_ _.then + @tuple//left + @tuple//right + @sum//get)) + +(runtime: (i64//logic-right-shift param subject) + (let [mask (|> (_.int +1) + (_.bit-shl (_.- param (_.int +64))) + (_.- (_.int +1)))] + (_.return (|> subject + (_.bit-shr param) + (_.bit-and mask))))) + +(def: runtime//i64 + Statement + ($_ _.then + @i64//logic-right-shift + )) + +(runtime: (text//index subject param start) + (with-vars [idx] + ($_ _.then + (_.; (_.set idx (_.strpos/3 [subject param start]))) + (_.if (_.= (_.bool false) idx) + (_.return ..none) + (_.return (..some idx)))))) + +(def: runtime//text + Statement + ($_ _.then + @text//index + )) + +(def: check-necessary-conditions! + Statement + (let [condition (_.= (_.int +8) + (_.constant "PHP_INT_SIZE")) + 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)))))) + +(def: runtime + Statement + ($_ _.then + check-necessary-conditions! + runtime//lux + runtime//adt + runtime//i64 + runtime//text + runtime//io + )) + +(def: #export artifact ..prefix) + +(def: #export generate + (Operation Any) + (///.with-buffer + (do ////.monad + [_ (///.save! true ["" ..prefix] ..runtime)] + (///.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/structure.lux new file mode 100644 index 000000000..7bc675d7e --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/structure.lux @@ -0,0 +1,36 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [host + ["_" php (#+ Expression)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." primitive] + ["#//" /// + ["#/" // #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)]]]]) + +(def: #export (tuple generate elemsS+) + (-> Phase (Tuple Synthesis) (Operation (Expression Any))) + (case elemsS+ + #.Nil + (:: ////.monad wrap (//primitive.text /////synthesis.unit)) + + (#.Cons singletonS #.Nil) + (generate singletonS) + + _ + (|> elemsS+ + (monad.map ////.monad generate) + (:: ////.monad 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))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux index adec09fa3..1113ec3b6 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux @@ -41,6 +41,17 @@ (bundle.install "-" (binary (product.uncurry _.-))) ))) +(def: int-procs + Bundle + (<| (bundle.prefix "int") + (|> bundle.empty + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "frac" (unary _.float/1)) + (bundle.install "char" (unary _.chr/1))))) + (import: #long java/lang/Double (#static MIN_VALUE Double) (#static MAX_VALUE Double)) @@ -55,17 +66,6 @@ [frac//max (java/lang/Double::MAX_VALUE)] ) -(def: int-procs - Bundle - (<| (bundle.prefix "int") - (|> bundle.empty - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "*" (binary (product.uncurry _.*))) - (bundle.install "/" (binary (product.uncurry _./))) - (bundle.install "%" (binary (product.uncurry _.%))) - (bundle.install "frac" (unary _.float/1)) - (bundle.install "char" (unary _.chr/1))))) - (def: frac-procs Bundle (<| (bundle.prefix "frac") @@ -84,10 +84,6 @@ (bundle.install "encode" (unary _.repr/1)) (bundle.install "decode" (unary ///runtime.frac//decode))))) -(def: (text//char [subjectO paramO]) - (Binary (Expression Any)) - (///runtime.text//char subjectO paramO)) - (def: (text//clip [paramO extraO subjectO]) (Trinary (Expression Any)) (///runtime.text//clip subjectO paramO extraO)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux index 81bdc8702..8858e9d4f 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux @@ -274,34 +274,6 @@ @text//clip @text//char)) -(runtime: (array//get array idx) - (with-vars [temp] - ($_ _.then - (_.set (list temp) (_.nth idx array)) - (_.if (_.= _.nil temp) - (_.return ..none) - (_.return (..some temp)))))) - -(runtime: (array//put array idx value) - ($_ _.then - (_.set (list (_.nth idx array)) value) - (_.return array))) - -(def: runtime//array - (Statement Any) - ($_ _.then - @array//get - @array//put)) - -(runtime: (box//write value box) - ($_ _.then - (_.set (list (_.nth (_.int +0) box)) value) - (_.return ..unit))) - -(def: runtime//box - (Statement Any) - @box//write) - (def: runtime (Statement Any) ($_ _.then @@ -310,8 +282,6 @@ runtime//i64 runtime//f64 runtime//text - runtime//array - runtime//box )) (def: #export artifact ..prefix) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index a92aea013..5dd2fd1ba 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -4,8 +4,9 @@ [abstract [monad (#+ do)]] [control - [cli (#+ program:)] ["." io (#+ IO io)] + [parser + [cli (#+ program:)]] [security ["!" capability]]] [data diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index f62a071ae..5c5051a2c 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -40,6 +40,7 @@ [python (#+)] [lua (#+)] [ruby (#+)] + [php (#+)] [scheme (#+)]] [tool [compiler @@ -53,6 +54,8 @@ <host-modules>] [ruby (#+) <host-modules>] + [php (#+) + <host-modules>] [scheme (#+) <host-modules>]]]]] ## [control |