From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- lux-r/source/luxc/lang/host/r.lux | 299 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 299 insertions(+) create mode 100644 lux-r/source/luxc/lang/host/r.lux (limited to 'lux-r/source/luxc/lang/host/r.lux') diff --git a/lux-r/source/luxc/lang/host/r.lux b/lux-r/source/luxc/lang/host/r.lux new file mode 100644 index 000000000..6e4c7fb5b --- /dev/null +++ b/lux-r/source/luxc/lang/host/r.lux @@ -0,0 +1,299 @@ +(.module: + [lux #- not or and list if function cond when] + (lux (control pipe) + (data [maybe "maybe/" Functor] + [text] + text/format + [number] + (coll [list "list/" Functor Fold])) + (type abstract))) + +(abstract: #export Single {} Any) +(abstract: #export Poly {} Any) + +(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 Expression) + (:abstraction + (format "(" code ")"))) + + (def: nest + (-> Text Text) + (|>> (format "\n") + (text.replace-all "\n" "\n "))) + + (def: (_block expression) + (-> Text Text) + (format "{" (nest expression) "\n" "}")) + + (def: #export (block expression) + (-> Expression Expression) + (:abstraction + (format "{" (:representation expression) "}"))) + + (def: #export null + Expression + (|> "NULL" self-contained)) + + (def: #export n/a + Expression + (|> "NA" self-contained)) + + (def: #export not-available Expression n/a) + (def: #export not-applicable Expression n/a) + (def: #export no-answer Expression n/a) + + (def: #export bool + (-> Bit Expression) + (|>> (case> #0 "FALSE" + #1 "TRUE") + self-contained)) + + (def: #export (int value) + (-> Int Expression) + (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)) + + (def: #export string + (-> Text Expression) + (|>> %t self-contained)) + + (def: (composite-literal left-delimiter right-delimiter entry-serializer) + (All [a] (-> Text Text (-> a Text) + (-> (List a) Expression))) + (.function (_ entries) + (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))))) + + (template [ ] + [(def: #export + (-> (List Expression) Expression) + (composite-literal (format "(") ")" expression))] + + [vector "c"] + [list "list"] + ) + + (def: #export (slice from to list) + (-> Expression Expression Expression Expression) + (self-contained + (format (:representation list) + "[" (:representation from) ":" (:representation to) "]"))) + + (def: #export (slice-from from list) + (-> Expression Expression Expression) + (self-contained + (format (:representation list) + "[-1" ":-" (:representation from) "]"))) + + (def: #export (apply args func) + (-> (List Expression) Expression Expression) + (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) + (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) + (self-contained + (format (:representation list) "[[" (:representation idx) "]]"))) + + (def: #export (if test then else) + (-> Expression Expression Expression Expression) + (self-contained + (format "if(" (:representation test) ")" + " " (.._block (:representation then)) + " else " (.._block (:representation else))))) + + (def: #export (when test then) + (-> Expression Expression Expression) + (self-contained + (format "if(" (:representation test) ") {" + (.._block (:representation then)) + "\n" "}"))) + + (def: #export (cond clauses else) + (-> (List [Expression Expression]) Expression Expression) + (list/fold (.function (_ [test then] next) + (if test then next)) + else + (list.reverse clauses))) + + (template [ ] + [(def: #export ( param subject) + (-> Expression Expression Expression) + (self-contained + (format (:representation subject) + " " " " + (:representation param))))] + + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [%% "%%"] + [** "**"] + [or "||"] + [and "&&"] + ) + + (def: #export @@ + (All [k] (-> (Var k) Expression)) + (|>> ..name self-contained)) + + (def: #export global + (-> Text Expression) + (|>> var @@)) + + (template [ ] + [(def: #export ( param subject) + (-> Expression Expression Expression) + (..apply (.list subject param) (..global )))] + + [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"))) + + (template [ ] + [(def: #export + (-> Expression Expression) + (|>> :representation (format ) self-contained))] + + [not "!"] + [negate "-"] + ) + + (def: #export (length list) + (-> Expression Expression) + (..apply (.list list) (..global "length"))) + + (def: #export (range from to) + (-> Expression Expression Expression) + (self-contained + (format (:representation from) ":" (:representation to)))) + + (def: #export (function inputs body) + (-> (List (Ex [k] (Var k))) Expression Expression) + (let [args (|> inputs (list/map ..name) (text.join-with ", "))] + (self-contained + (format "function(" args ") " + (.._block (:representation body)))))) + + (def: #export (try body warning error finally) + (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression) + (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text) + (.function (_ parameter value preparation) + (|> value + (maybe/map (|>> :representation preparation (format ", " parameter " = "))) + (maybe.default ""))))] + (self-contained + (format "tryCatch(" + (.._block (:representation body)) + (optional "warning" warning id) + (optional "error" error id) + (optional "finally" finally .._block) + ")")))) + + (def: #export (while test body) + (-> Expression Expression Expression) + (self-contained + (format "while (" (:representation test) ") " + (.._block (:representation body))))) + + (def: #export (for-in var inputs body) + (-> SVar Expression Expression Expression) + (self-contained + (format "for (" (..name var) " in " (..expression inputs) ")" + (.._block (:representation body))))) + + (template [ ] + [(def: #export ( message) + (-> Expression Expression) + (..apply (.list message) (..global )))] + + [stop "stop"] + [print "print"] + ) + + (def: #export (set! var value) + (-> (Var Single) Expression Expression) + (self-contained + (format (..name var) " <- " (:representation value)))) + + (def: #export (set-nth! idx value list) + (-> Expression Expression SVar Expression) + (self-contained + (format (..name list) "[[" (:representation idx) "]] <- " (:representation value)))) + + (def: #export (then pre post) + (-> Expression Expression Expression) + (:abstraction + (format (:representation pre) + "\n" + (:representation post)))) + ) -- cgit v1.2.3