path: root/stdlib/source/library/lux/target/php.lux

(.using
 [library
  [lux (.except Location Code Global Label static int if cond or and not comment for try global the parameter)
   ["@" target]
   [abstract
    [equivalence (.only Equivalence)]
    [hash (.only Hash)]
    ["[0]" enum]]
   [control
    ["[0]" pipe]
    [parser
     ["<[0]>" code]]]
   [data
    ["[0]" text (.only)
     ["%" \\format (.only format)]]
    [collection
     ["[0]" list (.open: "[1]#[0]" functor mix)]]]
   [macro
    [syntax (.only syntax)]
    ["[0]" template]
    ["[0]" code]]
   [math
    [number
     ["n" nat]
     ["f" frac]]]
   [type
    [primitive (.except)]]]])

(def input_separator ", ")
(def statement_suffix ";")

... Added the carriage return for better Windows compatibility.
(def \n+
  Text
  (format text.carriage_return text.new_line))

(def nested
  (-> Text Text)
  (.let [nested_new_line (format text.new_line text.tab)]
    (|>> (format \n+)
         (text.replaced text.new_line nested_new_line))))

(def block
  (-> Text Text)
  (|>> ..nested (text.enclosed ["{" (format \n+ "}")])))

(def group
  (-> Text Text)
  (text.enclosed ["(" ")"]))

(primitive .public (Code brand)
  Text

  (def .public equivalence
    (All (_ brand) (Equivalence (Code brand)))
    (implementation
     (def (= reference subject)
       (at text.equivalence = (representation reference) (representation subject)))))

  (def .public hash
    (All (_ brand) (Hash (Code brand)))
    (implementation
     (def equivalence ..equivalence)
     (def hash (|>> representation (at text.hash hash)))))

  (def .public manual
    (-> Text Code)
    (|>> abstraction))

  (def .public code
    (-> (Code Any) Text)
    (|>> representation))

  (with_template [<type> <super>+]
    [(with_expansions [<brand> (template.symbol [<type> "'"])]
       (primitive (<brand> brand) Any)
       (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))]
    
    [Expression [Code]]
    [Computation [Expression' Code]]
    [Location [Computation' Expression' Code]]
    [Statement [Code]]
    )

  (with_template [<type> <super>+]
    [(with_expansions [<brand> (template.symbol [<type> "'"])]
       (primitive .public <brand> Any)
       (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))]

    [Literal [Computation' Expression' Code]]
    [Var [Location' Computation' Expression' Code]]
    [Access [Location' Computation' Expression' Code]]
    [Constant [Location' Computation' Expression' Code]]
    [Global [Location' Computation' Expression' Code]]
    [Label [Code]]
    )

  (type: .public Argument
    (Record
     [#reference? Bit
      #var Var]))

  (def .public ;
    (-> Expression Statement)
    (|>> representation
         (text.suffix ..statement_suffix)
         abstraction))

  (def .public var
    (-> Text Var)
    (|>> (format "$") abstraction))

  (with_template [<name> <type>]
    [(def .public <name>
       (-> Text <type>)
       (|>> abstraction))]

    [constant Constant]
    [label Label]
    )

  (def .public (set_label label)
    (-> Label Statement)
    (abstraction (format (representation label) ":")))

  (def .public (go_to label)
    (-> Label Statement)
    (abstraction
     (format "goto " (representation label) ..statement_suffix)))

  (def .public null
    Literal
    (abstraction "NULL"))

  (def .public bool
    (-> Bit Literal)
    (|>> (pipe.case
           #0 "false"
           #1 "true")
         abstraction))

  (def .public int
    (-> Int Literal)
    (.let [to_hex (at n.hex encoded)]
      (|>> .nat
           to_hex
           (format "0x")
           abstraction)))

  (def .public float
    (-> Frac Literal)
    (|>> (pipe.cond [(f.= f.positive_infinity)]
                    [(pipe.new "+INF" [])]
                    
                    [(f.= f.negative_infinity)]
                    [(pipe.new "-INF" [])]
                    
                    [(f.= f.not_a_number)]
                    [(pipe.new "NAN" [])]
                    
                    ... else
                    [%.frac])
         abstraction))

  (def safe
    (-> Text Text)
    (`` (|>> (~~ (with_template [<find> <replace>]
                   [(text.replaced <find> <replace>)]

                   ["\" "\\"]
                   [text.tab "\t"]
                   [text.vertical_tab "\v"]
                   [text.null "\0"]
                   [text.back_space "\b"]
                   [text.form_feed "\f"]
                   [text.new_line "\n"]
                   [text.carriage_return "\r"]
                   [text.double_quote (format "\" text.double_quote)]
                   ["$" "\$"]
                   ))
             )))

  (def .public string
    (-> Text Literal)
    (|>> ..safe
         (text.enclosed [text.double_quote text.double_quote])
         abstraction))

  (def arguments
    (-> (List Expression) Text)
    (|>> (list#each ..code) (text.interposed ..input_separator) ..group))

  (def .public (apply args func)
    (-> (List Expression) Expression Computation)
    (|> (format (representation func) (..arguments args))
        abstraction))

  ... TODO: Remove when no longer using JPHP.
  (def .public (apply' args func)
    (-> (List Expression) Expression Computation)
    (apply (list.partial func args) (..constant "call_user_func")))

  (def parameters
    (-> (List Argument) Text)
    (|>> (list#each (function (_ [reference? var])
                      (.if reference?
                        (format "&" (representation var))
                        (representation var))))
         (text.interposed ..input_separator)
         ..group))

  (with_template [<name> <reference?>]
    [(def .public <name>
       (-> Var Argument)
       (|>> [<reference?>]))]

    [parameter #0]
    [reference #1]
    )

  (def .public (closure uses arguments body!)
    (-> (List Argument) (List Argument) Statement Literal)
    (let [uses (case uses
                 {.#End}
                 ""

                 _
                 (format "use " (..parameters uses)))]
      (|> (format "function " (..parameters arguments)
                  " " uses " "
                  (..block (representation body!)))
          ..group
          abstraction)))

  (def arity_inputs
    (syntax (_ [arity <code>.nat])
      (in (case arity
            0 (.list)
            _ (|> (-- arity)
                  (enum.range n.enum 0)
                  (list#each (|>> %.nat code.local)))))))

  (def arity_types
    (syntax (_ [arity <code>.nat])
      (in (list.repeated arity (` ..Expression)))))

  (with_template [<arity> <function>+]
    [(with_expansions [<apply> (template.symbol ["apply/" <arity>])
                       <inputs> (arity_inputs <arity>)
                       <types> (arity_types <arity>)
                       <definitions> (template.spliced <function>+)]
       (def .public (<apply> function [<inputs>])
         (-> Expression [<types>] Computation)
         (..apply (.list <inputs>) function))

       (with_template [<function>]
         [(`` (def .public (~~ (template.symbol [<function> "/" <arity>]))
                (<apply> (..constant <function>))))]

         <definitions>))]

    [0
     [["func_num_args"]
      ["func_get_args"]
      ["time"]
      ["phpversion"]]]

    [1
     [["isset"]
      ["var_dump"]
      ["is_null"]
      ["empty"]
      ["count"]
      ["array_pop"]
      ["array_reverse"]
      ["intval"]
      ["floatval"]
      ["strval"]
      ["ord"]
      ["chr"]
      ["print"]
      ["exit"]
      ["iconv_strlen"] ["strlen"]
      ["log"]
      ["ceil"]
      ["floor"]
      ["is_nan"]]]

    [2
     [["intdiv"]
      ["fmod"]
      ["number_format"]
      ["array_key_exists"]
      ["call_user_func_array"]
      ["array_slice"]
      ["array_push"]
      ["pack"]
      ["unpack"]
      ["iconv_strpos"] ["strpos"]
      ["pow"]
      ["max"]]]

    [3
     [["array_fill"]
      ["array_slice"]
      ["array_splice"]
      ["iconv"]
      ["iconv_strpos"] ["strpos"]
      ["iconv_substr"] ["substr"]]]
    )

  (def .public (key_value key value)
    (-> Expression Expression Expression)
    (abstraction (format (representation key) " => " (representation value))))

  (def .public (array/* values)
    (-> (List Expression) Literal)
    (|> values
        (list#each ..code)
        (text.interposed ..input_separator)
        ..group
        (format "array")
        abstraction))

  (def .public (array_merge/+ required optionals)
    (-> Expression (List Expression) Computation)
    (..apply (list.partial required optionals) (..constant "array_merge")))

  (def .public (array/** kvs)
    (-> (List [Expression Expression]) Literal)
    (|> kvs
        (list#each (function (_ [key value])
                     (format (representation key) " => " (representation value))))
        (text.interposed ..input_separator)
        ..group
        (format "array")
        abstraction))

  (def .public (new constructor inputs)
    (-> Constant (List Expression) Computation)
    (|> (format "new " (representation constructor) (arguments inputs))
        abstraction))

  (def .public (the field object)
    (-> Text Expression Computation)
    (|> (format (representation object) "->" field)
        abstraction))

  (def .public (do method inputs object)
    (-> Text (List Expression) Expression Computation)
    (|> (format (representation (..the method object))
                (..arguments inputs))
        abstraction))

  (def .public (item idx array)
    (-> Expression Expression Access)
    (|> (format (representation array) "[" (representation idx) "]")
        abstraction))

  (def .public (global name)
    (-> Text Global)
    (|> (..var "GLOBALS") (..item (..string name)) transmutation))

  (def .public (? test then else)
    (-> Expression Expression Expression Computation)
    (|> (format (..group (representation test)) " ? "
                (..group (representation then)) " : "
                (..group (representation else)))
        ..group
        abstraction))

  (with_template [<name> <op>]
    [(def .public (<name> parameter subject)
       (-> Expression Expression Computation)
       (|> (format (representation subject) " " <op> " " (representation parameter))
           ..group
           abstraction))]

    [or      "||"]
    [and     "&&"]
    [==      "=="]
    [===     "==="]
    [<       "<"]
    [<=      "<="]
    [>       ">"]
    [>=      ">="]
    [+       "+"]
    [-       "-"]
    [*       "*"]
    [/       "/"]
    [%       "%"]
    [bit_or  "|"]
    [bit_and "&"]
    [bit_xor "^"]
    [bit_shl "<<"]
    [bit_shr ">>"]
    [concat  "."]
    )

  (with_template [<unary> <name>]
    [(def .public <name>
       (-> Computation Computation)
       (|>> representation (format <unary>) abstraction))]

    ["!" not]
    ["~" bit_not]
    ["-" opposite]
    )

  (def .public (set var value)
    (-> Location Expression Computation)
    (|> (format (representation var) " = " (representation value))
        ..group
        abstraction))

  (def .public (set! var value)
    (-> Location Expression Statement)
    (abstraction (format (representation var) " = " (representation value) ";")))

  (def .public (set? var)
    (-> Var Computation)
    (..apply/1 [var] (..constant "isset")))

  (with_template [<name> <modifier>]
    [(def .public <name>
       (-> Var Statement)
       (|>> representation (format <modifier> " ") (text.suffix ..statement_suffix) abstraction))]

    [define_global "global"]
    )

  (with_template [<name> <modifier> <location>]
    [(def .public (<name> location value)
       (-> <location> Expression Statement)
       (abstraction (format <modifier> " " (representation location)
                            " = " (representation value)
                            ..statement_suffix)))]

    [define_static   "static" Var]
    [define_constant "const"  Constant]
    )

  (def .public (if test then! else!)
    (-> Expression Statement Statement Statement)
    (abstraction
     (format "if" (..group (representation test)) " "
             (..block (representation then!))
             " else "
             (..block (representation else!)))))

  (def .public (when test then!)
    (-> Expression Statement Statement)
    (abstraction
     (format "if" (..group (representation test)) " "
             (..block (representation then!)))))

  (def .public (then pre! post!)
    (-> Statement Statement Statement)
    (abstraction
     (format (representation pre!)
             \n+
             (representation post!))))

  (def .public (while test body!)
    (-> Expression Statement Statement)
    (abstraction
     (format "while" (..group (representation test)) " "
             (..block (representation body!)))))

  (def .public (do_while test body!)
    (-> Expression Statement Statement)
    (abstraction
     (format "do " (..block (representation body!))
             " while" (..group (representation test))
             ..statement_suffix)))

  (def .public (for_each array value body!)
    (-> Expression Var Statement Statement)
    (abstraction
     (format "foreach(" (representation array)
             " as " (representation value)
             ") " (..block (representation body!)))))

  (type: .public Except
    (Record
     [#class Constant
      #exception Var
      #handler Statement]))

  (def (catch except)
    (-> Except Text)
    (let [declaration (format (representation (.the #class except))
                              " " (representation (.the #exception except)))]
      (format "catch" (..group declaration) " "
              (..block (representation (.the #handler except))))))
  
  (def .public (try body! excepts)
    (-> Statement (List Except) Statement)
    (abstraction
     (format "try " (..block (representation body!))
             \n+
             (|> excepts
                 (list#each catch)
                 (text.interposed \n+)))))

  (with_template [<name> <keyword>]
    [(def .public <name>
       (-> Expression Statement)
       (|>> representation (format <keyword> " ") (text.suffix ..statement_suffix) abstraction))]

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

  (def .public (define name value)
    (-> Constant Expression Expression)
    (..apply/2 (..constant "define")
               [(|> name representation ..string)
                value]))

  (def .public (define_function name arguments body!)
    (-> Constant (List Argument) Statement Statement)
    (abstraction
     (format "function " (representation name)
             (..parameters arguments)
             " "
             (..block (representation body!)))))

  (with_template [<name> <keyword>]
    [(def .public <name>
       Statement
       (|> <keyword>
           (text.suffix ..statement_suffix)
           abstraction))]

    [break "break"]
    [continue "continue"]
    )

  (def .public splat
    (-> Expression Expression)
    (|>> representation  (format "...") abstraction))
  )

(def .public (cond clauses else!)
  (-> (List [Expression Statement]) Statement Statement)
  (list#mix (function (_ [test then!] next!)
              (..if test then! next!))
            else!
            (list.reversed clauses)))

(def .public command_line_arguments
  Var
  (..var "argv"))