diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/host')
-rw-r--r-- | new-luxc/source/luxc/lang/host/r.lux | 347 |
1 files changed, 347 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/host/r.lux b/new-luxc/source/luxc/lang/host/r.lux new file mode 100644 index 000000000..62c33479d --- /dev/null +++ b/new-luxc/source/luxc/lang/host/r.lux @@ -0,0 +1,347 @@ +(.module: + [lux #- not or and list if function cond] + (lux (control pipe) + (data [text] + text/format + [number] + (coll [list "list/" Functor<List> Fold<List>])) + (type abstract))) + +(abstract: #export Single {} Unit) +(abstract: #export Poly {} Unit) + +(abstract: #export (Var kind) + {} + + Text + + (def: name (All [k] (-> (Var k) Text)) (|>> @representation)) + + (def: #export var (-> Text (Var Single)) (|>> @abstraction)) + (def: #export var-args (Var Poly) (@abstraction "...")) + ) + +(type: #export SVar (Var Single)) +(type: #export PVar (Var Poly)) + +(abstract: #export Expression + {} + + Text + + (def: #export expression (-> Expression Text) (|>> @representation)) + + (def: #export code (-> Text Expression) (|>> @abstraction)) + + (def: (self-contained code) + (-> Text Text) + (format "(" code ")")) + + (def: #export null + Expression + (|> "NULL" self-contained @abstraction)) + + (def: #export n/a + Expression + (|> "NA" self-contained @abstraction)) + + (def: #export not-available Expression n/a) + (def: #export not-applicable Expression n/a) + (def: #export no-answer Expression n/a) + + (def: #export bool + (-> Bool Expression) + (|>> (case> true "TRUE" + false "FALSE") + self-contained + @abstraction)) + + (def: #export (int value) + (-> Int Expression) + (@abstraction + (self-contained + (format "as.integer(" (%i value) ")")))) + + (def: #export float + (-> Frac Expression) + (|>> (cond> [(f/= number.positive-infinity)] + [(new> "1.0/0.0")] + + [(f/= number.negative-infinity)] + [(new> "-1.0/0.0")] + + [(f/= number.not-a-number)] + [(new> "0.0/0.0")] + + ## else + [%f]) + self-contained + @abstraction)) + + (def: #export string + (-> Text Expression) + (|>> %t self-contained @abstraction)) + + (def: (composite-literal left-delimiter right-delimiter entry-serializer) + (All [a] (-> Text Text (-> a Text) + (-> (List a) Expression))) + (.function (_ entries) + (@abstraction + (self-contained + (format left-delimiter + (|> entries (list/map entry-serializer) (text.join-with ",")) + right-delimiter))))) + + (def: #export named-list + (-> (List [Text Expression]) Expression) + (composite-literal "list(" ")" (.function (_ [key value]) + (format key "=" (@representation value))))) + + (do-template [<name> <function>] + [(def: #export <name> + (-> (List Expression) Expression) + (composite-literal (format <function> "(") ")" expression))] + + [vector "c"] + [list "list"] + ) + + (def: #export (slice from to list) + (-> Expression Expression Expression Expression) + (@abstraction + (self-contained + (format (@representation list) + "[" (@representation from) ":" (@representation to) "]")))) + + (def: #export (slice-from from list) + (-> Expression Expression Expression) + (@abstraction + (self-contained + (format (@representation list) + "[-1" ":-" (@representation from) "]")))) + + (def: #export (apply args func) + (-> (List Expression) Expression Expression) + (@abstraction + (self-contained + (format (@representation func) "(" (text.join-with "," (list/map expression args)) ")")))) + + (def: #export (apply-kw args kw-args func) + (-> (List Expression) (List [Text Expression]) Expression Expression) + (@abstraction + (self-contained + (format (@representation func) + (format "(" + (text.join-with "," (list/map expression args)) + (text.join-with "," (list/map (.function (_ [key val]) + (format key "=" (expression val))) + kw-args)) + ")"))))) + + (def: #export (nth idx list) + (-> Expression Expression Expression) + (@abstraction + (self-contained + (format (@representation list) "[[" (@representation idx) "]]")))) + + (def: #export (if test then else) + (-> Expression Expression Expression Expression) + (@abstraction + (self-contained + (format "if(" (@representation test) ")" + " " (@representation then) + " else " (@representation else))))) + + (def: #export (cond clauses else) + (-> (List [Expression Expression]) Expression Expression) + (list/fold (.function (_ [test then] next) + (if test then next)) + else + (list.reverse clauses))) + + (do-template [<name> <op>] + [(def: #export (<name> param subject) + (-> Expression Expression Expression) + (@abstraction + (self-contained + (format (@representation subject) + " " <op> " " + (@representation param)))))] + + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [%% "%%"] + [** "**"] + [or "||"] + [and "&&"] + ) + + (def: #export @@ + (All [k] (-> (Var k) Expression)) + (|>> ..name self-contained @abstraction)) + + (def: #export global + (-> Text Expression) + (|>> var @@)) + + (do-template [<name> <func>] + [(def: #export (<name> param subject) + (-> Expression Expression Expression) + (..apply (.list subject param) (..global <func>)))] + + [bit-or "bitwOr"] + [bit-and "bitwAnd"] + [bit-xor "bitwXor"] + [bit-shl "bitwShiftL"] + [bit-ushr "bitwShiftR"] + ) + + (def: #export (bit-not subject) + (-> Expression Expression) + (..apply (.list subject) (..global "bitwNot"))) + + (do-template [<name> <op>] + [(def: #export <name> + (-> Expression Expression) + (|>> @representation (format <op>) self-contained @abstraction))] + + [not "!"] + [negate "-"] + ) + + (def: #export (length list) + (-> Expression Expression) + (..apply (.list list) (..global "length"))) + + (def: #export (range from to) + (-> Expression Expression Expression) + (@abstraction + (self-contained + (format (@representation from) ":" (@representation to))))) + ) + +(abstract: #export Statement + {} + + Text + + (def: #export statement (-> Statement Text) (|>> @representation)) + + (def: nest + (-> Statement Text) + (|>> @representation + (format "\n") + (text.replace-all "\n" "\n "))) + + (def: #export (set-nth! idx value list) + (-> Expression Expression SVar Statement) + (@abstraction (format (..name list) "[" (expression idx) "] <- " (expression value)))) + + (def: #export (set! var value) + (-> (Var Single) Expression Statement) + (@abstraction + (format (..name var) " <- " (expression value)))) + + (def: #export (if! test then! else!) + (-> Expression Statement Statement Statement) + (@abstraction + (format "if(" (expression test) ") {" + (nest then!) + "\n" "} else {" + (nest else!) + "\n" "}"))) + + (def: #export (when! test then!) + (-> Expression Statement Statement) + (@abstraction + (format "if(" (expression test) ") {" + (nest then!) + "\n" "}"))) + + (def: #export (cond! clauses else!) + (-> (List [Expression Statement]) Statement Statement) + (list/fold (.function (_ [test then!] next!) + (if! test then! next!)) + else! + (list.reverse clauses))) + + (def: #export (then! pre! post!) + (-> Statement Statement Statement) + (@abstraction + (format (@representation pre!) + "\n" + (@representation post!)))) + + (def: #export (while! test body!) + (-> Expression Statement Statement) + (@abstraction + (format "while (" (expression test) ") {" + (nest body!) + "\n" "}"))) + + (def: #export (do! expression) + (-> Expression Statement) + (@abstraction (..expression expression))) + + (def: #export no-op! + Statement + (@abstraction "\n")) + + (do-template [<name> <keyword>] + [(def: #export (<name> message) + (-> Expression Statement) + (@abstraction + (format <keyword> "(" (expression message) ")")))] + + [stop! "stop"] + [print! "print"] + ) + + (def: #export (block statement) + (-> Statement Expression) + (..code (format "{" + (nest statement) + "\n" "}"))) + + (def: #export (for-in! var inputs body!) + (-> SVar Expression Statement Statement) + (@abstraction + (format "for (" (..name var) " in " (..expression inputs) ")" + (..expression (..block body!))))) + ) + +(def: #export (function inputs body!) + (-> (List (Ex [k] (Var k))) Statement Expression) + (let [args (|> inputs (list/map ..name) (text.join-with ", "))] + (..code (format "function(" args ")" (..expression (..block body!)))))) + +(def: #export (try body! warning error finally!) + (-> Statement (Maybe Expression) (Maybe Expression) (Maybe Statement) Expression) + (..code (format "(tryCatch(" + (..expression (..block body!)) + (case warning + (#.Some warning) + (format ", warning = " (..expression warning)) + + #.None + "") + (case error + (#.Some error) + (format ", error = " (..expression error)) + + #.None + "") + (case finally! + (#.Some finally!) + (format ", finally = " (..expression (..block finally!))) + + #.None + "") + "))"))) |