- Initial R back-end implementation.

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
+                    "")
+                  "))")))