diff options
Diffstat (limited to 'stdlib/source/library/lux/meta/compiler/target/r.lux')
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/target/r.lux | 394 |
1 files changed, 394 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/target/r.lux b/stdlib/source/library/lux/meta/compiler/target/r.lux new file mode 100644 index 000000000..e95eff6df --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/target/r.lux @@ -0,0 +1,394 @@ +(.require + [library + [lux (.except Code or and list if function cond not int when) + [control + ["[0]" pipe] + ["[0]" function] + ["[0]" maybe (.use "[1]#[0]" functor)]] + [data + ["[0]" text + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + [number + ["f" frac]]] + [meta + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)] + ["[0]" template]] + [type + ["[0]" nominal (.except def)]]]]]) + +(nominal.def .public (Code kind) + Text + + (with_template [<type> <super>+] + [(with_expansions [<kind> (template.symbol [<type> "'"])] + (nominal.def .public (<kind> kind) Any) + (`` (type .public <type> (|> Any <kind> (,, (template.spliced <super>+))))))] + + [Expression [Code]] + ) + + (with_template [<type> <super>+] + [(with_expansions [<kind> (template.symbol [<type> "'"])] + (nominal.def .public (<kind> kind) Any) + (`` (type .public (<type> <brand>) (|> <brand> <kind> (,, (template.spliced <super>+))))))] + + [Var [Expression' Code]] + ) + + (with_template [<var> <kind>] + [(nominal.def .public <kind> Any) + (type .public <var> (Var <kind>))] + + [SVar Single] + [PVar Poly] + ) + + (def .public var + (-> Text SVar) + (|>> abstraction)) + + (def .public var_args + PVar + (abstraction "...")) + + (def .public manual + (-> Text Code) + (|>> abstraction)) + + (def .public code + (-> (Code Any) Text) + (|>> representation)) + + (def (self_contained code) + (-> Text Expression) + (abstraction + (format "(" code ")"))) + + ... Added the carriage return for better Windows compatibility. + (def \n+ + Text + (format text.carriage_return text.new_line)) + + (def nested_new_line + (format text.new_line text.tab)) + + (def nested + (-> Text Text) + (|>> (text.replaced text.new_line ..nested_new_line) + (format text.carriage_return ..nested_new_line))) + + (def (_block expression) + (-> Text Text) + (format "{" (nested expression) \n+ "}")) + + (def .public (block expression) + (-> Expression Expression) + (abstraction + (format "{" + (..nested (representation expression)) + \n+ "}"))) + + (with_template [<name> <r>] + [(def .public <name> + Expression + (abstraction <r>))] + + [null "NULL"] + [n/a "NA"] + ) + + (with_template [<name>] + [(def .public <name> Expression n/a)] + + [not_available] + [not_applicable] + [no_answer] + ) + + (def .public bool + (-> Bit Expression) + (|>> (pipe.when + #0 "FALSE" + #1 "TRUE") + abstraction)) + + (def .public int + (-> Int Expression) + (|>> %.int abstraction)) + + (def .public float + (-> Frac Expression) + (|>> (pipe.cond [(f.= f.positive_infinity)] + [(pipe.new "1.0/0.0" [])] + + [(f.= f.negative_infinity)] + [(pipe.new "-1.0/0.0" [])] + + [(f.= f.not_a_number)] + [(pipe.new "0.0/0.0" [])] + + ... else + [%.frac]) + ..self_contained)) + + (def safe + (-> Text Text) + (`` (|>> (,, (with_template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + ["|" "\|"] + [text.alarm "\a"] + [text.back_space "\b"] + [text.tab "\t"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def .public string + (-> Text Expression) + (|>> ..safe %.text abstraction)) + + (def .public (slice from to list) + (-> Expression Expression Expression Expression) + (..self_contained + (format (representation list) + "[" (representation from) ":" (representation to) "]"))) + + (def .public (slice_from from list) + (-> Expression Expression Expression) + (..self_contained + (format (representation list) + "[-1" ":-" (representation from) "]"))) + + (def .public (apply args func) + (-> (List Expression) Expression Expression) + (let [func (representation func) + spacing (|> " " + (list.repeated (text.size func)) + text.together)] + (abstraction + (format func "(" + (|> args + (list#each ..code) + (text.interposed (format "," \n+)) + ..nested) + ")")))) + + (with_template [<name> <function>] + [(def .public (<name> members) + (-> (List Expression) Expression) + (..apply members (..var <function>)))] + + [vector "c"] + [list "list"] + ) + + (def .public named_list + (-> (List [Text Expression]) Expression) + (|>> (list#each (.function (_ [key value]) + (abstraction (format key "=" (representation value))))) + ..list)) + + (def .public (apply_kw args kw_args func) + (-> (List Expression) (List [Text Expression]) Expression Expression) + (..self_contained + (format (representation func) + (format "(" + (text.interposed "," (list#each ..code args)) "," + (text.interposed "," (list#each (.function (_ [key val]) + (format key "=" (representation val))) + kw_args)) + ")")))) + + (def arity_inputs + (syntax (_ [arity <code>.nat]) + (in (.when arity + 0 (.list) + _ (|> arity + list.indices + (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>] Expression) + (..apply (.list <inputs>) function)) + + (with_template [<function>] + [(`` (def .public (,, (template.symbol [<function> "/" <arity>])) + (-> [<types>] Expression) + (<apply> (..var <function>))))] + + <definitions>))] + + [0 + [["commandArgs"]]] + [1 + [["intToUtf8"]]] + [2 + [["paste"]]] + ) + + (def .public as::integer + (-> Expression Expression) + (..apply/1 (..var "as.integer"))) + + (def .public (item idx list) + (-> Expression Expression Expression) + (..self_contained + (format (representation list) "[[" (representation idx) "]]"))) + + (def .public (if test then else) + (-> Expression Expression Expression Expression) + (abstraction + (format "if(" (representation test) ")" + " " (.._block (representation then)) + " else " (.._block (representation else))))) + + (def .public (when test then) + (-> Expression Expression Expression) + (abstraction + (format "if(" (representation test) ") {" + (.._block (representation then)) + \n+ "}"))) + + (def .public (cond clauses else) + (-> (List [Expression Expression]) Expression Expression) + (list#mix (.function (_ [test then] next) + (if test then next)) + else + (list.reversed clauses))) + + (with_template [<name> <op>] + [(def .public (<name> param subject) + (-> Expression Expression Expression) + (..self_contained + (format (representation subject) + " " <op> " " + (representation param))))] + + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [%% "%%"] + [** "**"] + [or "||"] + [and "&&"] + ) + + (with_template [<name> <func>] + [(def .public (<name> param subject) + (-> Expression Expression Expression) + (..apply (.list subject param) (..var <func>)))] + + [bit_or "bitwOr"] + [bit_and "bitwAnd"] + [bit_xor "bitwXor"] + [bit_shl "bitwShiftL"] + [bit_ushr "bitwShiftR"] + ) + + (def .public (bit_not subject) + (-> Expression Expression) + (..apply (.list subject) (..var "bitwNot"))) + + (with_template [<name> <op>] + [(def .public <name> + (-> Expression Expression) + (|>> representation (format <op>) ..self_contained))] + + [not "!"] + [negate "-"] + ) + + (def .public (length list) + (-> Expression Expression) + (..apply (.list list) (..var "length"))) + + (def .public (range from to) + (-> Expression Expression Expression) + (..self_contained + (format (representation from) ":" (representation to)))) + + (def .public (function inputs body) + (-> (List (Ex (_ k) (Var k))) Expression Expression) + (let [args (|> inputs (list#each ..code) (text.interposed ", "))] + (..self_contained + (format "function(" args ") " + (.._block (representation body)))))) + + (def .public (try body warning error finally) + (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression) + (let [optional (is (-> Text (Maybe Expression) (-> Text Text) Text) + (.function (_ parameter value preparation) + (|> value + (maybe#each (|>> representation preparation (format ", " parameter " = "))) + (maybe.else ""))))] + (..self_contained + (format "tryCatch(" + (.._block (representation body)) + (optional "warning" warning function.identity) + (optional "error" error function.identity) + (optional "finally" finally .._block) + ")")))) + + (def .public (while test body) + (-> Expression Expression Expression) + (..self_contained + (format "while (" (representation test) ") " + (.._block (representation body))))) + + (def .public (for_in var inputs body) + (-> SVar Expression Expression Expression) + (..self_contained + (format "for (" (representation var) " in " (representation inputs) ")" + (.._block (representation body))))) + + (with_template [<name> <keyword>] + [(def .public (<name> message) + (-> Expression Expression) + (..apply (.list message) (..var <keyword>)))] + + [stop "stop"] + [print "print"] + ) + + (def .public (set! var value) + (-> SVar Expression Expression) + (..self_contained + (format (representation var) " <- " (representation value)))) + + (def .public (set_item! idx value list) + (-> Expression Expression SVar Expression) + (..self_contained + (format (representation list) "[[" (representation idx) "]] <- " (representation value)))) + + (def .public (then pre post) + (-> Expression Expression Expression) + (abstraction + (format (representation pre) + \n+ + (representation post)))) + ) |