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

(.module:
  [lux #- Code' Code not or and function]
  (lux (control pipe)
       (data [text]
             text/format
             [number]
             (coll [list "list/" Functor<List> Fold<List>]))
       (type abstract)))

(abstract: Global' {} Any)
(abstract: Var' {} Any)
(abstract: Computation' {} Any)
(abstract: (Expression' k) {} Any)
(abstract: Statement' {} Any)

(abstract: (Code' k)
  {}
  
  Text

  (type: #export Code (Ex [k] (Code' k)))
  (type: #export Expression (Code' (Ex [k] (Expression' k))))
  (type: #export Global (Code' (Expression' Global')))
  (type: #export Var (Code' (Expression' Var')))
  (type: #export Argument
    {#reference? Bool
     #var Var})
  (type: #export Computation (Code' (Expression' Computation')))
  (type: #export Statement (Code' Statement'))
  
  (def: #export code (-> Code Text) (|>> @representation))

  (def: nest
    (-> Text Text)
    (|>> (format "\n")
         (text.replace-all "\n" "\n  ")))

  (def: block
    (-> Text Text)
    (|>> nest (text.enclose ["{" "\n}"])))

  (def: computation
    (-> Text Computation)
    (|>> (text.enclose ["(" ")"]) @abstraction))

  (def: (statement code)
    (-> Text Statement)
    (@abstraction (format code ";")))

  (def: parameters
    (-> (List Argument) Text)
    (|>> (list/map (.function (_ [reference? var])
                     (if reference?
                       (format "&" (@representation var))
                       (@representation var))))
         (text.join-with ", ")
         (text.enclose ["(" ")"])))

  (do-template [<name> <reference?>]
    [(def: #export <name>
       (-> Var Argument)
       (|>> [<reference?>]))]

    [parameter false]
    [reference true]
    )

  (def: arguments
    (-> (List Expression) Text)
    (|>> (list/map ..code) (text.join-with ", ") (text.enclose ["(" ")"])))

  (def: #export var
    (-> Text Var)
    (|>> (format "$") @abstraction))

  (def: #export global
    (-> Text Global)
    (|>> @abstraction))

  (def: #export null
    Computation
    (@abstraction "NULL"))

  (def: #export bool
    (-> Bool Computation)
    (|>> %b @abstraction))

  (def: #export int
    (-> Int Computation)
    (|>> %i @abstraction))

  (def: #export float
    (-> Frac Computation)
    (|>> (cond> [(f/= number.positive-infinity)]
                [(new> "INF" computation)]
                
                [(f/= number.negative-infinity)]
                [(new> "-INF" computation)]
                
                [(f/= number.not-a-number)]
                [(new> "NAN" computation)]
                
                ## else
                [%f @abstraction])))

  (def: #export string
    (-> Text Computation)
    (|>> %t @abstraction))

  (def: #export (apply args func)
    (-> (List Expression) Expression Computation)
    (@abstraction
     (format (@representation func) (..arguments args))))

  (def: #export (function arguments uses body)
    (-> (List Argument) (List Argument) Statement Computation)
    (let [uses (case uses
                 #.Nil
                 ""

                 _
                 (format "use " (..parameters uses)))]
      (computation
       (format "function " (..parameters arguments)
               " " uses " "
               (block (@representation body))))))

  (do-template [<name> <function>]
    [(def: #export <name>
       Computation
       (..apply (list) (..global <function>)))]

    [func-num-args/0 "func_num_args"]
    [func-get-args/0 "func_get_args"]
    )

  (do-template [<name> <function>]
    [(def: #export (<name> values)
       (-> (List Expression) Computation)
       (..apply values (..global <function>)))]

    [array/* "array"]
    )

  (do-template [<name> <function>]
    [(def: #export (<name> required optionals)
       (-> Expression (List Expression) Computation)
       (..apply (list& required optionals) (..global <function>)))]

    [array-merge/+ "array_merge"]
    )

  (def: #export (array/** kvs)
    (-> (List [Expression Expression]) Computation)
    (computation
     (format "array("
             (|> kvs
                 (list/map (.function (_ [key value])
                             (format (@representation key) " => " (@representation value))))
                 (text.join-with ", "))
             ")")))

  (do-template [<name> <function>]
    [(def: #export (<name> input0)
       (-> Expression Computation)
       (..apply (list input0) (..global <function>)))]

    [is-null/1   "is_null"]
    [empty/1     "empty"]
    [count/1     "count"]
    [array-pop/1 "array_pop"]
    [floatval/1 "floatval"]
    )

  (do-template [<name> <function>]
    [(def: #export (<name> input0 input1)
       (-> Expression Expression Computation)
       (..apply (list input0 input1) (..global <function>)))]

    [call-user-func-array/2 "call_user_func_array"]
    [array-slice/2          "array_slice"]
    [array-push/2           "array_push"]
    )

  (do-template [<name> <function>]
    [(def: #export (<name> input0 input1 input2)
       (-> Expression Expression Expression Computation)
       (..apply (list input0 input1 input2) (..global <function>)))]

    [array-slice/3 "array_slice"])

  (def: #export (new constructor inputs)
    (-> Global (List Expression) Computation)
    (computation
     (format "new " (@representation constructor) (arguments inputs))))

  (def: #export (send method inputs object)
    (-> Text (List Expression) Expression Computation)
    (computation
     (format (@representation object) "->" method (arguments inputs))))

  (def: #export (nth idx array)
    (-> Expression Expression Computation)
    (computation
     (format (@representation array) "[" (@representation idx) "]")))

  (def: #export (? test then else)
    (-> Expression Expression Expression Computation)
    (computation
     (format (@representation test) " ? "
             (@representation then) " : "
             (@representation else))))

  (do-template [<name> <op>]
    [(def: #export (<name> param subject)
       (-> Expression Expression Computation)
       (computation
        (format (@representation subject) " " <op> " " (@representation param))))]

    [or      "||"]
    [and     "&&"]
    ## [is      "is"]
    [=       "=="]
    [<       "<"]
    [<=      "<="]
    [>       ">"]
    [>=      ">="]
    [+       "+"]
    [-       "-"]
    [*       "*"]
    [/       "/"]
    [%       "%"]
    [**      "**"]
    ## [bit-or  "|"]
    ## [bit-and "&"]
    ## [bit-xor "^"]
    ## [bit-shl "<<"]
    ## [bit-shr ">>"]
    )

  (def: #export not
    (-> Computation Computation)
    (|>> @representation (format "!") @abstraction))

  (do-template [<name> <type> <constructor>]
    [(def: #export (<name> var value)
       (-> Var Expression <type>)
       (<constructor> (format (@representation var) " = " (@representation value))))]

    [set!  Statement   ..statement]
    [set!' Computation ..computation]
    )
  
  (def: #export (set-nth! idx value array)
    (-> Expression Expression Expression Statement)
    (..statement
     (format (@representation array) "[" (@representation idx) "] = " (@representation value))))

  (def: #export global!
    (-> Var Statement)
    (|>> @representation (format "global ") ..statement))

  (def: #export (set-global! name value)
    (-> Text Expression Statement)
    (|> (..var "GLOBALS") (..set-nth! (..string name) value)))

  (def: #export (if! test then! else!)
    (-> Expression Statement Statement Statement)
    (@abstraction
     (format "if (" (@representation test) ")"
             (block (@representation then!))
             " else "
             (block (@representation else!)))))

  (def: #export (when! test then!)
    (-> Expression Statement Statement)
    (@abstraction
     (format "if (" (@representation test) ") "
             (block (@representation then!)))))

  (def: #export (then! post! pre!)
    (-> Statement Statement Statement)
    (@abstraction
     (format (@representation pre!)
             "\n"
             (@representation post!))))

  ## (def: #export (while! test body!)
  ##   (-> Computation Statement Statement)
  ##   (@abstraction
  ##    (format "while " (expression test) ":"
  ##            (nest body!))))

  ## (def: #export (for-in! variable inputs body!)
  ##   (-> SVariable Computation Statement Statement)
  ##   (@abstraction
  ##    (format "for " (..name variable) " in " (expression inputs) ":"
  ##            (nest body!))))

  (type: #export Except
    {#class Global
     #exception Var
     #handler Statement})

  (def: (catch! except)
    (-> Except Text)
    (let [declaration (format "(" (@representation (get@ #class except))
                              " " (@representation (get@ #exception except)) ")")]
      (format "catch" declaration  " "
              (block (@representation (get@ #handler except))))))
  
  (def: #export (try! body! excepts)
    (-> Statement (List Except) Statement)
    (@abstraction
     (format "try " (block (@representation body!)) "\n"
             (|> excepts (list/map catch!) (text.join-with "\n")))))

  (do-template [<name> <keyword>]
    [(def: #export (<name> message)
       (-> Expression Statement)
       (statement (format <keyword> " " (@representation message))))]

    [throw!  "throw"]
    [return! "return"]
    [echo!   "echo"]
    )

  (def: #export do!
    (-> Expression Statement)
    (|>> @representation statement))

  (def: #export (define! name value)
    (-> Global Expression Statement)
    (do! (..apply (list (|> name @representation ..string)
                        value)
                  (..global "define"))))
  
  (def: #export (function! name args body)
    (-> Global (List Argument) Statement Statement)
    (@abstraction
     (format "function " (@representation name) (..parameters args)
             " " (block (@representation body)))))
  )