diff options
Diffstat (limited to 'stdlib/source/library/lux/meta/compiler/target/php.lux')
-rw-r--r-- | stdlib/source/library/lux/meta/compiler/target/php.lux | 554 |
1 files changed, 554 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/target/php.lux b/stdlib/source/library/lux/meta/compiler/target/php.lux new file mode 100644 index 000000000..98c95a5aa --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/target/php.lux @@ -0,0 +1,554 @@ +(.require + [library + [lux (.except Location Code Global Label static int if cond or and not comment for try global the parameter when) + [abstract + [equivalence (.only Equivalence)] + [hash (.only Hash)] + ["[0]" enum]] + [control + ["[0]" pipe]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + [number + ["n" nat] + ["f" frac]]] + [meta + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)] + ["[0]" template]] + [type + ["[0]" nominal (.except def)]]]]]) + +(def input_separator ", ") +(def statement_suffix ";") + +... Added the carriage return for better Windows compatibility. +(def \n+ + Text + (format text.carriage_return text.new_line)) + +(def nested + (-> Text Text) + (.let [nested_new_line (format text.new_line text.tab)] + (|>> (format \n+) + (text.replaced text.new_line nested_new_line)))) + +(def block + (-> Text Text) + (|>> ..nested (text.enclosed ["{" (format \n+ "}")]))) + +(def group + (-> Text Text) + (text.enclosed ["(" ")"])) + +(nominal.def .public (Code brand) + Text + + (def .public equivalence + (All (_ brand) (Equivalence (Code brand))) + (implementation + (def (= reference subject) + (of text.equivalence = (representation reference) (representation subject))))) + + (def .public hash + (All (_ brand) (Hash (Code brand))) + (implementation + (def equivalence ..equivalence) + (def hash (|>> representation (of text.hash hash))))) + + (def .public manual + (-> Text Code) + (|>> abstraction)) + + (def .public code + (-> (Code Any) Text) + (|>> representation)) + + (with_template [<type> <super>+] + [(with_expansions [<brand> (template.symbol [<type> "'"])] + (nominal.def (<brand> brand) Any) + (`` (type .public <type> (|> Any <brand> (,, (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (with_template [<type> <super>+] + [(with_expansions [<brand> (template.symbol [<type> "'"])] + (nominal.def .public <brand> Any) + (`` (type .public <type> (|> <brand> (,, (template.spliced <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]] + [Label [Code]] + ) + + (type .public Argument + (Record + [#reference? Bit + #var Var])) + + (def .public ; + (-> Expression Statement) + (|>> representation + (text.suffix ..statement_suffix) + abstraction)) + + (def .public var + (-> Text Var) + (|>> (format "$") abstraction)) + + (with_template [<name> <type>] + [(def .public <name> + (-> Text <type>) + (|>> abstraction))] + + [constant Constant] + [label Label] + ) + + (def .public (set_label label) + (-> Label Statement) + (abstraction (format (representation label) ":"))) + + (def .public (go_to label) + (-> Label Statement) + (abstraction + (format "goto " (representation label) ..statement_suffix))) + + (def .public null + Literal + (abstraction "NULL")) + + (def .public bool + (-> Bit Literal) + (|>> (pipe.when + #0 "false" + #1 "true") + abstraction)) + + (def .public int + (-> Int Literal) + (.let [to_hex (of n.hex encoded)] + (|>> .nat + to_hex + (format "0x") + abstraction))) + + (def .public float + (-> Frac Literal) + (|>> (pipe.cond [(f.= f.positive_infinity)] + [(pipe.new "+INF" [])] + + [(f.= f.negative_infinity)] + [(pipe.new "-INF" [])] + + [(f.= f.not_a_number)] + [(pipe.new "NAN" [])] + + ... else + [%.frac]) + abstraction)) + + (def safe + (-> Text Text) + (`` (|>> (,, (with_template [<find> <replace>] + [(text.replaced <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 .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) + abstraction)) + + (def arguments + (-> (List Expression) Text) + (|>> (list#each ..code) (text.interposed ..input_separator) ..group)) + + (def .public (apply args func) + (-> (List Expression) Expression Computation) + (|> (format (representation func) (..arguments args)) + abstraction)) + + ... TODO: Remove when no longer using JPHP. + (def .public (apply' args func) + (-> (List Expression) Expression Computation) + (apply (list.partial func args) (..constant "call_user_func"))) + + (def parameters + (-> (List Argument) Text) + (|>> (list#each (function (_ [reference? var]) + (.if reference? + (format "&" (representation var)) + (representation var)))) + (text.interposed ..input_separator) + ..group)) + + (with_template [<name> <reference?>] + [(def .public <name> + (-> Var Argument) + (|>> [<reference?>]))] + + [parameter #0] + [reference #1] + ) + + (def .public (closure uses arguments body!) + (-> (List Argument) (List Argument) Statement Literal) + (let [uses (.when uses + {.#End} + "" + + _ + (format "use " (..parameters uses)))] + (|> (format "function " (..parameters arguments) + " " uses " " + (..block (representation body!))) + ..group + abstraction))) + + (def arity_inputs + (syntax (_ [arity <code>.nat]) + (in (.when arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + + (def arity_types + (syntax (_ [arity <code>.nat]) + (in (list.repeated arity (` ..Expression))))) + + (with_template [<arity> <function>+] + [(with_expansions [<apply> (template.symbol ["apply/" <arity>]) + <inputs> (arity_inputs <arity>) + <types> (arity_types <arity>) + <definitions> (template.spliced <function>+)] + (def .public (<apply> function [<inputs>]) + (-> Expression [<types>] Computation) + (..apply (.list <inputs>) function)) + + (with_template [<function>] + [(`` (def .public (,, (template.symbol [<function> "/" <arity>])) + (<apply> (..constant <function>))))] + + <definitions>))] + + [0 + [["func_num_args"] + ["func_get_args"] + ["time"] + ["phpversion"]]] + + [1 + [["isset"] + ["var_dump"] + ["is_null"] + ["empty"] + ["count"] + ["array_pop"] + ["array_reverse"] + ["intval"] + ["floatval"] + ["strval"] + ["ord"] + ["chr"] + ["print"] + ["exit"] + ["iconv_strlen"] ["strlen"] + ["log"] + ["ceil"] + ["floor"] + ["is_nan"]]] + + [2 + [["intdiv"] + ["fmod"] + ["number_format"] + ["array_key_exists"] + ["call_user_func_array"] + ["array_slice"] + ["array_push"] + ["pack"] + ["unpack"] + ["iconv_strpos"] ["strpos"] + ["pow"] + ["max"]]] + + [3 + [["array_fill"] + ["array_slice"] + ["array_splice"] + ["iconv"] + ["iconv_strpos"] ["strpos"] + ["iconv_substr"] ["substr"]]] + ) + + (def .public (key_value key value) + (-> Expression Expression Expression) + (abstraction (format (representation key) " => " (representation value)))) + + (def .public (array/* values) + (-> (List Expression) Literal) + (|> values + (list#each ..code) + (text.interposed ..input_separator) + ..group + (format "array") + abstraction)) + + (def .public (array_merge/+ required optionals) + (-> Expression (List Expression) Computation) + (..apply (list.partial required optionals) (..constant "array_merge"))) + + (def .public (array/** kvs) + (-> (List [Expression Expression]) Literal) + (|> kvs + (list#each (function (_ [key value]) + (format (representation key) " => " (representation value)))) + (text.interposed ..input_separator) + ..group + (format "array") + abstraction)) + + (def .public (new constructor inputs) + (-> Constant (List Expression) Computation) + (|> (format "new " (representation constructor) (arguments inputs)) + abstraction)) + + (def .public (the field object) + (-> Text Expression Computation) + (|> (format (representation object) "->" field) + abstraction)) + + (def .public (do method inputs object) + (-> Text (List Expression) Expression Computation) + (|> (format (representation (..the method object)) + (..arguments inputs)) + abstraction)) + + (def .public (item idx array) + (-> Expression Expression Access) + (|> (format (representation array) "[" (representation idx) "]") + abstraction)) + + (def .public (global name) + (-> Text Global) + (|> (..var "GLOBALS") (..item (..string name)) transmutation)) + + (def .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (..group (representation test)) " ? " + (..group (representation then)) " : " + (..group (representation else))) + ..group + abstraction)) + + (with_template [<name> <op>] + [(def .public (<name> parameter subject) + (-> Expression Expression Computation) + (|> (format (representation subject) " " <op> " " (representation parameter)) + ..group + abstraction))] + + [or "||"] + [and "&&"] + [== "=="] + [=== "==="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [% "%"] + [bit_or "|"] + [bit_and "&"] + [bit_xor "^"] + [bit_shl "<<"] + [bit_shr ">>"] + [concat "."] + ) + + (with_template [<unary> <name>] + [(def .public <name> + (-> Computation Computation) + (|>> representation (format <unary>) abstraction))] + + ["!" not] + ["~" bit_not] + ["-" opposite] + ) + + (def .public (set var value) + (-> Location Expression Computation) + (|> (format (representation var) " = " (representation value)) + ..group + abstraction)) + + (def .public (set! var value) + (-> Location Expression Statement) + (abstraction (format (representation var) " = " (representation value) ";"))) + + (def .public (set? var) + (-> Var Computation) + (..apply/1 [var] (..constant "isset"))) + + (with_template [<name> <modifier>] + [(def .public <name> + (-> Var Statement) + (|>> representation (format <modifier> " ") (text.suffix ..statement_suffix) abstraction))] + + [define_global "global"] + ) + + (with_template [<name> <modifier> <location>] + [(def .public (<name> location value) + (-> <location> Expression Statement) + (abstraction (format <modifier> " " (representation location) + " = " (representation value) + ..statement_suffix)))] + + [define_static "static" Var] + [define_constant "const" Constant] + ) + + (def .public (if test then! else!) + (-> Expression Statement Statement Statement) + (abstraction + (format "if" (..group (representation test)) " " + (..block (representation then!)) + " else " + (..block (representation else!))))) + + (def .public (when test then!) + (-> Expression Statement Statement) + (abstraction + (format "if" (..group (representation test)) " " + (..block (representation then!))))) + + (def .public (then pre! post!) + (-> Statement Statement Statement) + (abstraction + (format (representation pre!) + \n+ + (representation post!)))) + + (def .public (while test body!) + (-> Expression Statement Statement) + (abstraction + (format "while" (..group (representation test)) " " + (..block (representation body!))))) + + (def .public (do_while test body!) + (-> Expression Statement Statement) + (abstraction + (format "do " (..block (representation body!)) + " while" (..group (representation test)) + ..statement_suffix))) + + (def .public (for_each array value body!) + (-> Expression Var Statement Statement) + (abstraction + (format "foreach(" (representation array) + " as " (representation value) + ") " (..block (representation body!))))) + + (type .public Except + (Record + [#class Constant + #exception Var + #handler Statement])) + + (def (catch except) + (-> Except Text) + (let [declaration (format (representation (.the #class except)) + " " (representation (.the #exception except)))] + (format "catch" (..group declaration) " " + (..block (representation (.the #handler except)))))) + + (def .public (try body! excepts) + (-> Statement (List Except) Statement) + (abstraction + (format "try " (..block (representation body!)) + \n+ + (|> excepts + (list#each catch) + (text.interposed \n+))))) + + (with_template [<name> <keyword>] + [(def .public <name> + (-> Expression Statement) + (|>> representation (format <keyword> " ") (text.suffix ..statement_suffix) abstraction))] + + [throw "throw"] + [return "return"] + [echo "echo"] + ) + + (def .public (define name value) + (-> Constant Expression Expression) + (..apply/2 (..constant "define") + [(|> name representation ..string) + value])) + + (def .public (define_function name arguments body!) + (-> Constant (List Argument) Statement Statement) + (abstraction + (format "function " (representation name) + (..parameters arguments) + " " + (..block (representation body!))))) + + (with_template [<name> <keyword>] + [(def .public <name> + Statement + (|> <keyword> + (text.suffix ..statement_suffix) + abstraction))] + + [break "break"] + [continue "continue"] + ) + + (def .public splat + (-> Expression Expression) + (|>> representation (format "...") abstraction)) + ) + +(def .public (cond clauses else!) + (-> (List [Expression Statement]) Statement Statement) + (list#mix (function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reversed clauses))) + +(def .public command_line_arguments + Var + (..var "argv")) |