path: root/new-luxc/source/luxc/lang/host/r.lux

(.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
                    "")
                  "))")))