(.using [library [lux (.except Location Code Global Label static int if cond or and not comment for try global the parameter) ["@" target] [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] ["[0]" enum]] [control ["[0]" pipe] [parser ["<[0]>" code]]] [data ["[0]" text (.only) ["%" \\format (.only format)]] [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math [number ["n" nat] ["f" frac]]] [type [primitive (.except)]]]]) (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 ["(" ")"])) (primitive .public (Code brand) Text (def .public equivalence (All (_ brand) (Equivalence (Code brand))) (implementation (def (= reference subject) (at text.equivalence = (representation reference) (representation subject))))) (def .public hash (All (_ brand) (Hash (Code brand))) (implementation (def equivalence ..equivalence) (def hash (|>> representation (at text.hash hash))))) (def .public manual (-> Text Code) (|>> abstraction)) (def .public code (-> (Code Any) Text) (|>> representation)) (with_template [ +] [(with_expansions [ (template.symbol [ "'"])] (primitive ( brand) Any) (`` (type: .public (|> Any (~~ (template.spliced +))))))] [Expression [Code]] [Computation [Expression' Code]] [Location [Computation' Expression' Code]] [Statement [Code]] ) (with_template [ +] [(with_expansions [ (template.symbol [ "'"])] (primitive .public Any) (`` (type: .public (|> (~~ (template.spliced +))))))] [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 [ ] [(def .public (-> Text ) (|>> 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.case #0 "false" #1 "true") abstraction)) (def .public int (-> Int Literal) (.let [to_hex (at 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 [ ] [(text.replaced )] ["\" "\\"] [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 [ ] [(def .public (-> Var Argument) (|>> []))] [parameter #0] [reference #1] ) (def .public (closure uses arguments body!) (-> (List Argument) (List Argument) Statement Literal) (let [uses (case uses {.#End} "" _ (format "use " (..parameters uses)))] (|> (format "function " (..parameters arguments) " " uses " " (..block (representation body!))) ..group abstraction))) (def arity_inputs (syntax (_ [arity .nat]) (in (case arity 0 (.list) _ (|> (-- arity) (enum.range n.enum 0) (list#each (|>> %.nat code.local))))))) (def arity_types (syntax (_ [arity .nat]) (in (list.repeated arity (` ..Expression))))) (with_template [ +] [(with_expansions [ (template.symbol ["apply/" ]) (arity_inputs ) (arity_types ) (template.spliced +)] (def .public ( function []) (-> Expression [] Computation) (..apply (.list ) function)) (with_template [] [(`` (def .public (~~ (template.symbol [ "/" ])) ( (..constant ))))] ))] [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 [ ] [(def .public ( parameter subject) (-> Expression Expression Computation) (|> (format (representation subject) " " " " (representation parameter)) ..group abstraction))] [or "||"] [and "&&"] [== "=="] [=== "==="] [< "<"] [<= "<="] [> ">"] [>= ">="] [+ "+"] [- "-"] [* "*"] [/ "/"] [% "%"] [bit_or "|"] [bit_and "&"] [bit_xor "^"] [bit_shl "<<"] [bit_shr ">>"] [concat "."] ) (with_template [ ] [(def .public (-> Computation Computation) (|>> representation (format ) 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 [ ] [(def .public (-> Var Statement) (|>> representation (format " ") (text.suffix ..statement_suffix) abstraction))] [define_global "global"] ) (with_template [ ] [(def .public ( location value) (-> Expression Statement) (abstraction (format " " (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 [ ] [(def .public (-> Expression Statement) (|>> representation (format " ") (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 [ ] [(def .public Statement (|> (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"))