path: root/stdlib/source/library/lux/meta/target/lua.lux

(.require
 [library
  [lux (.except Location Code Label int if function or and not let local comment the when)
   [abstract
    [equivalence (.only Equivalence)]
    [hash (.only Hash)]
    ["[0]" enum]]
   [control
    ["[0]" pipe]]
   [data
    ["[0]" text (.only)
     ["%" \\format (.only format)]]
    [collection
     ["[0]" list (.use "[1]#[0]" functor mix)]]]
   [math
    [number
     ["n" nat]
     ["i" int]
     ["f" frac]]]
   [meta
    ["@" target]
    ["[0]" code (.only)
     ["<[1]>" \\parser]]
    [macro
     [syntax (.only syntax)]
     ["[0]" template]]
    [type
     ["[0]" primitive (.except def)]]]]])

... 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 input_separator ", ")

(primitive.def .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.def (<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.def <brand> Any)
       (`` (type .public <type> (|> <brand> (,, (template.spliced <super>+))))))]

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

  (def .public nil
    Literal
    (abstraction "nil"))

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

  (def .public int
    (-> Int Literal)
    ... Integers must be turned into hexadecimal to avoid quirks in how Lua parses integers.
    ... In particular, the number -9223372036854775808 will be incorrectly parsed as a float by Lua.
    (.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 "(1.0/0.0)" [])]
                    
                    [(f.= f.negative_infinity)]
                    [(pipe.new "(-1.0/0.0)" [])]
                    
                    [(f.= f.not_a_number)]
                    [(pipe.new "(0.0/0.0)" [])]

                    ... else
                    [%.frac (text.replaced "+" "")])
         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) abstraction))

  (def .public multi
    (-> (List Expression) Expression)
    (|>> (list#each ..code)
         (text.interposed ..input_separator)
         abstraction))

  (def .public array
    (-> (List Expression) Literal)
    (|>> (list#each ..code)
         (text.interposed ..input_separator)
         (text.enclosed ["{" "}"])
         abstraction))

  (def .public table
    (-> (List [Text Expression]) Literal)
    (|>> (list#each (.function (_ [key value])
                      (format key " = " (representation value))))
         (text.interposed ..input_separator)
         (text.enclosed ["({" "})"])
         abstraction))

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

  (def .public (the field table)
    (-> Text Expression Access)
    (abstraction (format (representation table) "." field)))

  (def .public length
    (-> Expression Computation)
    (|>> representation
         (text.enclosed ["#(" ")"])
         abstraction))

  (def .public (apply args func)
    (-> (List Expression) Expression Computation)
    (|> args
        (list#each ..code)
        (text.interposed ..input_separator)
        (text.enclosed ["(" ")"])
        (format (representation func))
        abstraction))

  (def .public (do method args table)
    (-> Text (List Expression) Expression Computation)
    (|> args
        (list#each ..code)
        (text.interposed ..input_separator)
        (text.enclosed ["(" ")"])
        (format (representation table) ":" method)
        abstraction))

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

    ["==" =]
    ["<"  <]
    ["<=" <=]
    [">"  >]
    [">=" >=]
    ["+"  +]
    ["-"  -]
    ["*"  *]
    ["^"  ^]
    ["/"  /]
    ["//" //]
    ["%"  %]
    [".." concat]

    ["or"  or]
    ["and" and]
    ["|"   bit_or]
    ["&"   bit_and]
    ["~"   bit_xor]

    ["<<" bit_shl]
    [">>" bit_shr]
    )

  (with_template [<name> <unary>]
    [(def .public (<name> subject)
       (-> Expression Expression)
       (abstraction (format "(" <unary> " " (representation subject) ")")))]

    [not "not"]
    [opposite "-"]
    )

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

    [var Var]
    [label Label]
    )

  (def .public statement
    (-> Expression Statement)
    (|>> representation abstraction))

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

  (def locations
    (-> (List Location) Text)
    (|>> (list#each ..code)
         (text.interposed ..input_separator)))

  (def .public (local vars)
    (-> (List Var) Statement)
    (abstraction (format "local " (..locations vars))))

  (def .public (set vars value)
    (-> (List Location) Expression Statement)
    (abstraction (format (..locations vars) " = " (representation value))))

  (def .public (let vars value)
    (-> (List Var) Expression Statement)
    (abstraction (format "local " (..locations vars) " = " (representation value))))

  (def .public (local/1 var value)
    (-> Var Expression Statement)
    (abstraction (format "local " (representation var) " = " (representation value))))

  (def .public (if test then! else!)
    (-> Expression Statement Statement Statement)
    (abstraction (format "if " (representation test)
                         \n+ "then" (..nested (representation then!))
                         \n+ "else" (..nested (representation else!))
                         \n+ "end")))

  (def .public (when test then!)
    (-> Expression Statement Statement)
    (abstraction (format "if " (representation test)
                         \n+ "then" (..nested (representation then!))
                         \n+ "end")))

  (def .public (while test body!)
    (-> Expression Statement Statement)
    (abstraction
     (format "while " (representation test) " do"
             (..nested (representation body!))
             \n+ "end")))

  (def .public (repeat until body!)
    (-> Expression Statement Statement)
    (abstraction
     (format "repeat"
             (..nested (representation body!))
             \n+ "until " (representation until))))

  (def .public (for_in vars source body!)
    (-> (List Var) Expression Statement Statement)
    (abstraction
     (format "for " (|> vars
                        (list#each ..code)
                        (text.interposed ..input_separator))
             " in " (representation source) " do"
             (..nested (representation body!))
             \n+ "end")))

  (def .public (for_step var from to step body!)
    (-> Var Expression Expression Expression Statement
        Statement)
    (abstraction
     (format "for " (representation var)
             " = " (representation from)
             ..input_separator (representation to)
             ..input_separator (representation step) " do"
             (..nested (representation body!))
             \n+ "end")))

  (def .public (return value)
    (-> Expression Statement)
    (abstraction (format "return " (representation value))))

  (def .public (closure args body!)
    (-> (List Var) Statement Expression)
    (|> (format "function " (|> args
                                ..locations
                                (text.enclosed ["(" ")"]))
                (..nested (representation body!))
                \n+ "end")
        (text.enclosed ["(" ")"])
        abstraction))

  (with_template [<name> <code> <binding>]
    [(def .public (<name> name args body!)
       (-> <binding> (List Var) Statement Statement)
       (abstraction
        (format <code> " " (representation name)
                (|> args
                    ..locations
                    (text.enclosed ["(" ")"]))
                (..nested (representation body!))
                \n+ "end")))]

    [function "function" Location]
    [local_function "local function" Var]
    )

  (def .public break
    Statement
    (abstraction "break"))

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

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

  ... https://www.lua.org/pil/1.3.html
  (def .public (comment commentary on)
    (All (_ kind) (-> Text (Code kind) (Code kind)))
    (abstraction (format "-- "  commentary \n+ (representation on))))
  )

(def arity_inputs
  (syntax (_ [arity <code>.nat])
    (in (.when 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 [<inputs> (arity_inputs <arity>)
                     <types> (arity_types <arity>)
                     <definitions> (template.spliced <function>+)]
     (with_template [<function>]
       [(`` (def .public ((,, (template.symbol [<function> "/" <arity>])) <inputs>)
              (-> <types> Computation)
              (..apply (.list <inputs>) (..var <function>))))]

       <definitions>))]

  [1
   [["error"]
    ["pcall"]
    ["print"]
    ["require"]
    ["type"]
    ["ipairs"]]]
  [2
   [["error"]]]
  )