path: root/stdlib/source/library/lux/ffi.lux

(.using
 [library
  [lux {"-" Symbol Alias Global global function type_of}
   ["@" target]
   ["[0]" meta]
   [abstract
    [monad {"+" do}]]
   [control
    ["[0]" io]
    ["[0]" maybe ("[1]#[0]" functor)]
    ["<>" parser ("[1]#[0]" monad)
     ["<[0]>" code {"+" Parser}]]]
   [data
    ["[0]" product]
    ["[0]" text ("[1]#[0]" equivalence)
     ["%" format]]
    [collection
     ["[0]" list ("[1]#[0]" monad mix)]]]
   ["[0]" macro {"+" with_symbols}
    [syntax {"+" syntax:}]
    ["[0]" code]
    ["[0]" template]]
   [type
    [primitive "*"]]]])

(with_expansions [<constant> (for @.js "js constant"
                                  @.python "python constant"
                                  @.lua "lua constant"
                                  @.ruby "ruby constant")
                  <apply> (for @.js "js apply"
                               @.python "python apply"
                               @.lua "lua apply"
                               @.ruby "ruby apply")
                  <new> (for @.js "js object new"
                             @.python "python apply"
                             (these))
                  <do> (for @.js "js object do"
                            @.python "python object do"
                            @.lua "lua object do"
                            @.ruby "ruby object do")
                  <get> (for @.js "js object get"
                             @.python "python object get"
                             @.lua "lua object get"
                             @.ruby "ruby object get"
                             (these))
                  <import> (for @.python "python import"
                                @.lua "lua import"
                                @.ruby "ruby import"
                                (these))
                  <function> (for @.js "js function"
                                  @.python "python function"
                                  @.lua "lua function"
                                  (these))]
  (primitive: .public (Object brand) Any)

  (with_expansions [<un_common> (for @.js (these [Symbol]
                                                 [Null]
                                                 [Undefined])
                                     @.python (these [None]
                                                     [Dict])
                                     @.lua (these [Nil]
                                                  [Table])
                                     @.ruby (these [Nil]))
                    <un_common> <un_common>]
    (template [<name>]
      [(with_expansions [<brand> (template.symbol [<name> "'"])]
         (primitive: <brand>
           Any
           
           (type: .public <name>
             (Object <brand>))))]

      [Function]
      <un_common>
      ))

  (with_expansions [<un_common> (for @.js (these [Number  Frac])
                                     @.python (these [Integer Int]
                                                     [Float   Frac])
                                     @.lua (these [Integer Int]
                                                  [Float   Frac])
                                     @.ruby (these [Integer Int]
                                                   [Float   Frac]))
                    <un_common> <un_common>]
    (template [<name> <type>]
      [(type: .public <name>
         <type>)]

      [Boolean Bit]
      [String  Text]
      <un_common>
      ))

  (type: Alias
    (Maybe Text))

  (def: alias
    (Parser Alias)
    (<>.maybe (<>.after (<code>.this (' "as")) <code>.local)))

  (type: Optional
    (Record
     [#optional? Bit
      #mandatory Code]))

  (def: optional
    (Parser Optional)
    (let [token "?"]
      (<| (<>.and (<>.parses? (<code>.this_text token)))
          (<>.after (<>.not (<code>.this_text token)))
          <code>.any)))

  (type: (Named a)
    (Record
     [#name Text
      #alias Alias
      #anonymous a]))

  (template [<case> <name>]
    [(def: <case>
       (All (_ a) (-> (Parser a) (Parser (Named a))))
       (|>> (all <>.and
                 <name>
                 ..alias
                 )))]

    [named <code>.local]
    [anonymous (<>#in "")]
    )

  (type: Output
    Optional)

  (def: output
    (Parser Output)
    ..optional)

  (type: Global
    (Named Output))

  (def: variables
    (Parser (List Text))
    (<>.else (list) (<code>.tuple (<>.some <code>.local))))

  (def: (generalized $ it)
    (All (_ a)
      (-> (-> (List Text) a a)
          (-> (Parser a) (Parser a))))
    (do <>.monad
      [variables ..variables
       it it]
      (in ($ variables it))))

  (type: Input
    (Record
     [#variables (List Text)
      #parameters (List Optional)
      #io? Bit
      #try? Bit]))

  (def: input
    (Parser Input)
    (all <>.and
         (<>#in (list))
         (<code>.tuple (<>.some ..optional))
         (<>.parses? (<code>.this_text "io"))
         (<>.parses? (<code>.this_text "try"))))

  (type: Constructor
    (Named Input))

  (def: constructor
    (Parser Constructor)
    (<| <code>.form
        (..generalized (has [#anonymous #variables]))
        (<>.after (<code>.this (' new)))
        (..anonymous ..input)))

  (type: (Member a)
    (Record
     [#static? Bit
      #member a]))

  (def: static!
    (Parser Any)
    (<code>.this_text "static"))

  (def: (member it)
    (All (_ a)
      (-> (Parser a)
          (Parser (Member a))))
    (do [! <>.monad]
      [static? (<>.parses? ..static!)]
      (# ! each
         (|>> [#static? static?
               #member])
         it)))

  (type: Field
    (Member (Named Output)))

  (def: field
    (Parser Field)
    (<| <code>.form
        ..member
        ..named
        ..output))

  (type: Procedure
    (Record
     [#input Input
      #output Optional]))

  (def: procedure
    (Parser (Named Procedure))
    (<| (..generalized (has [#anonymous #input #variables]))
        ..named
        (all <>.and
             ..input
             ..optional
             )))

  (type: Method
    (Member (Named Procedure)))

  (def: method
    (Parser Method)
    (<| <code>.form
        ..member
        ..procedure))

  (`` (`` (type: Sub
            (Variant
             (~~ (for @.lua (~~ (these))
                      @.ruby (~~ (these))
                      {#Constructor Constructor}))
             {#Field Field}
             {#Method Method}))))

  (`` (`` (def: sub
            (Parser Sub)
            (all <>.or
                 (~~ (for @.lua (~~ (these))
                          @.ruby (~~ (these))
                          ..constructor))
                 ..field
                 ..method
                 ))))

  (def: parameters
    (-> (List Optional) (List Optional))
    (|>> list.enumeration
         (list#each (.function (_ [idx [optional? type]])
                      [#optional? optional?
                       #mandatory (|> idx %.nat code.local)]))))

  (def: (output_type it)
    (-> Optional Code)
    (if (the #optional? it)
      (` (.Maybe (~ (the #mandatory it))))
      (the #mandatory it)))

  (`` (template [<lux_it> <host_it>
                 <lux_?> <host_?>]
        [(def: .public (<lux_it> _)
           (-> Any Nothing)
           (as_expected (<host_it>)))

         (def: .public <lux_?>
           (-> Any Bit)
           (|>> <host_?>))

         (template.with_locals [g!it]
           (these (def: g!it' (' g!it))
                  (def: (host_optional it)
                    (-> Optional Code)
                    (.if (.the #optional? it)
                      (` (.case (~ (the #mandatory it))
                           {.#Some (~ g!it')}
                           (~ g!it')

                           {.#None}
                           (<host_it>)))
                      (the #mandatory it)))

                  (def: (lux_optional it output)
                    (-> Optional Code Code)
                    (` (.let [(~ g!it') (~ output)]
                         (~ (if (the #optional? it)
                              (` (.if (<host_?> (~ g!it'))
                                   {.#None}
                                   {.#Some (~ g!it')}))
                              (` (.if (.not (<host_?> (~ g!it')))
                                   (~ g!it')
                                   (.panic! "Invalid output."))))))))))]

        (~~ (for @.js [null "js object null"
                       null? "js object null?"]
                 @.python [none "python object none"
                           none? "python object none?"]
                 @.lua [nil "lua object nil"
                        nil? "lua object nil?"]
                 @.ruby [nil "ruby object nil"
                         nil? "ruby object nil?"]))
        ))

  (type: Declaration
    [Text (List Text)])

  (type: Namespace
    Text)

  (type: Class
    (Record
     [#declaration Declaration
      #class_alias Alias
      #namespace Namespace
      #members (List Sub)]))

  (def: class
    (Parser Class)
    (all <>.and
         (<>.either (<>.and <code>.local
                            (<>#in (list)))
                    (<code>.form (<>.and <code>.local
                                         (<>.some <code>.local))))
         ..alias
         <code>.text
         (<>.some ..sub)))

  (type: Import
    (Variant
     {#Class Class}
     {#Procedure (Named Procedure)}
     {#Global Global}))

  (def: import
    (Parser Import)
    (all <>.or
         ..class
         (<code>.form ..procedure)
         (<code>.form (..named ..output))))

  (def: (input_type input :it:)
    (-> Input Code Code)
    (let [:it: (if (the #try? input)
                 (` (.Either .Text (~ :it:)))
                 :it:)]
      (if (the #io? input)
        (` ((~! io.IO) (~ :it:)))
        :it:)))

  (def: (input_term input term)
    (-> Input Code Code)
    (let [term (if (the #try? input)
                 (` (.try (~ term)))
                 term)]
      (if (the #io? input)
        (` ((~! io.io) (~ term)))
        term)))

  (def: (procedure_definition import! source it)
    (-> (List Code) Code (Named Procedure) Code)
    (let [g!it (|> (the #alias it)
                   (maybe.else (the #name it))
                   code.local)
          g!variables (list#each code.local (the [#anonymous #input #variables] it))
          input (the [#anonymous #input] it)
          :parameters: (the #parameters input)
          g!parameters (..parameters :parameters:)
          :output: (the [#anonymous #output] it)
          :input:/* (case :parameters:
                      {.#End}
                      (list (` []))
                      
                      parameters
                      (list#each ..output_type :parameters:))]
      (` (.def: ((~ g!it) (~+ (case g!parameters
                                {.#End} (list g!it)
                                _ (list#each (the #mandatory) g!parameters))))
           (.All ((~ g!it) (~+ g!variables))
             (-> (~+ :input:/*)
                 (~ (|> :output:
                        ..output_type
                        (..input_type input)))))
           (.exec
             (~+ import!)
             (.as_expected
              (~ (<| (..input_term input)
                     (..lux_optional :output:)
                     (` (<apply> (.as_expected (~ source))
                                 [(~+ (list#each ..host_optional g!parameters))]))))))))))

  (def: (namespaced namespace class alias member)
    (-> Namespace Text Alias Text Text)
    (|> namespace
        (text.replaced "[1]" (maybe.else class alias))
        (text.replaced "[0]" member)))

  (def: class_separator ".")

  (def: host_path
    (text.replaced .module_separator ..class_separator))

  (for @.js (these)
       (def: (imported class)
         (-> Text Code)
         (case (text.all_split_by .module_separator class)
           {.#Item head tail}
           (list#mix (.function (_ sub super)
                       (` (<get> (~ (code.text sub))
                                 (.as (..Object .Any)
                                      (~ super)))))
                     (` (<import> (~ (code.text head))))
                     tail)
           
           {.#End}
           (` (<import> (~ (code.text class)))))))

  (def: (global_definition import! it)
    (-> (List Code) Global Code)
    (let [g!name (|> (the #alias it)
                     (maybe.else (the #name it))
                     code.local)
          :output: (the #anonymous it)]
      (` (.def: (~ g!name)
           (~ (..output_type :output:))
           (.exec
             (~+ import!)
             (.as_expected
              (~ (<| (lux_optional :output:)
                     (` (<constant> (~ (code.text (..host_path (the #name it))))))))))))))
  
  (for @.lua (these)
       @.ruby (these)
       (def: (constructor_definition [class_name class_parameters] alias namespace it)
         (-> Declaration Alias Namespace Constructor Code)
         (let [g!it (|> it
                        (the #alias)
                        (maybe.else "new")
                        (..namespaced namespace class_name alias)
                        code.local)
               input (the #anonymous it)
               g!input_variables (list#each code.local (the #variables input))
               :parameters: (the #parameters input)
               g!parameters (..parameters :parameters:)
               g!class_variables (list#each code.local class_parameters)
               g!class (` ((~ (code.local (maybe.else class_name alias))) (~+ g!class_variables)))
               :output: [#optional? false #mandatory g!class]]
           (` (.def: ((~ g!it) (~+ (case g!parameters
                                     {.#End} (list g!it)
                                     _ (list#each (the #mandatory) g!parameters))))
                (.All ((~ g!it) (~+ g!class_variables) (~+ g!input_variables))
                  (.-> (~+ (list#each ..output_type :parameters:))
                       (~ (|> :output:
                              ..output_type
                              (..input_type input)))))
                (.as_expected
                 (~ (<| (..input_term input)
                        (..lux_optional :output:)
                        (` (<new> (~ (for @.js (` (<constant> (~ (code.text (..host_path class_name)))))
                                          @.python (` (.as ..Function
                                                           (~ (..imported class_name))))))
                                  [(~+ (list#each ..host_optional g!parameters))]))))))))))

  (def: (static_field_definition import! [class_name class_parameters] alias namespace it)
    (-> (List Code) Declaration Alias Namespace (Named Output) Code)
    (let [field (the #name it)
          g!it (|> (the #alias it)
                   (maybe.else field)
                   (..namespaced namespace class_name alias)
                   code.local)
          :field: (the #anonymous it)]
      (` ((~! syntax:) ((~ g!it) [])
          (.# (~! meta.monad) (~' in)
              (.list (`' (.exec
                           (~+ import!)
                           (.as (~ (..output_type :field:))
                                (~ (<| (lux_optional :field:)
                                       (for @.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." field)))))
                                            @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" field)))))
                                            (` (<get> (~ (code.text field))
                                                      (~ (..imported class_name))))))))))))))))

  (def: (virtual_field_definition [class_name class_parameters] alias namespace it)
    (-> Declaration Alias Namespace (Named Output) Code)
    (let [name (the #name it)
          g!it (|> (the #alias it)
                   (maybe.else name)
                   (..namespaced namespace class_name alias)
                   code.local)
          path (%.format (..host_path class_name) "." name)
          :field: (the #anonymous it)
          g!variables (list#each code.local class_parameters)
          g!class (` ((~ (code.local (maybe.else class_name alias))) (~+ g!variables)))]
      (` (.def: ((~ g!it) (~ g!it))
           (.All ((~ g!it) (~+ g!variables))
             (.-> (~ g!class)
                  (~ (..output_type :field:))))
           (.as_expected
            (~ (<| (lux_optional :field:)
                   (` (<get> (~ (code.text name)) (~ g!it))))))))))

  (def: (field_definition import! class alias namespace it)
    (-> (List Code) Declaration Alias Namespace Field Code)
    (if (the #static? it)
      (..static_field_definition import! class alias namespace (the #member it))
      (..virtual_field_definition class alias namespace (the #member it))))

  (def: (static_method_definition import! [class_name class_parameters] alias namespace it)
    (-> (List Code) Declaration Alias Namespace (Named Procedure) Code)
    (let [method (the #name it)
          name (|> (the #alias it)
                   (maybe.else (the #name it))
                   (..namespaced namespace class_name alias))]
      (|> it
          (has #alias {.#Some name})
          (..procedure_definition import!
                                  (for @.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." method)))))
                                       @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" method)))))
                                       (` (<get> (~ (code.text method))
                                                 (.as (..Object .Any)
                                                      (~ (..imported class_name))))))))))

  (def: (virtual_method_definition [class_name class_parameters] alias namespace it)
    (-> Declaration Alias Namespace (Named Procedure) Code)
    (let [method (the #name it)
          g!it (|> (the #alias it)
                   (maybe.else method)
                   (..namespaced namespace class_name alias)
                   code.local)
          procedure (the #anonymous it)
          input (the #input procedure)
          g!input_variables (list#each code.local (the #variables input))
          :parameters: (the #parameters input)
          g!parameters (..parameters :parameters:)
          g!class_variables (list#each code.local class_parameters)
          g!class (` ((~ (code.local (maybe.else class_name alias))) (~+ g!class_variables)))
          :output: (the #output procedure)]
      (` (.def: ((~ g!it) (~+ (list#each (the #mandatory) g!parameters)) (~ g!it))
           (.All ((~ g!it) (~+ g!class_variables) (~+ g!input_variables))
             (.-> (~+ (list#each ..output_type :parameters:))
                  (~ g!class)
                  (~ (|> :output:
                         ..output_type
                         (..input_type input)))))
           (.as_expected
            (~ (<| (..input_term input)
                   (..lux_optional :output:)
                   (` (<do> (~ (code.text method))
                            (~ g!it)
                            [(~+ (list#each ..host_optional g!parameters))])))))))))

  (def: (method_definition import! class alias namespace it)
    (-> (List Code) Declaration Alias Namespace Method Code)
    (if (the #static? it)
      (static_method_definition import! class alias namespace (the #member it))
      (virtual_method_definition class alias namespace (the #member it))))

  (syntax: .public (import: [host_module (<>.maybe <code>.text)
                             it ..import])
    (let [host_module_import! (is (List Code)
                                  (case host_module
                                    {.#Some host_module}
                                    (list (` (<import> (~ (code.text host_module)))))

                                    {.#None}
                                    (list)))]
      (case it
        {#Global it}
        (in (list (..global_definition host_module_import! it)))

        {#Procedure it}
        (in (list (..procedure_definition host_module_import!
                                          (` (<constant> (~ (code.text (..host_path (the #name it))))))
                                          it)))

        {#Class it}
        (let [class (the #declaration it)
              alias (the #class_alias it)
              [class_name class_parameters] class
              namespace (the #namespace it)
              g!class_variables (list#each code.local class_parameters)
              declaration (` ((~ (code.local (maybe.else class_name alias)))
                              (~+ g!class_variables)))]
          (in (partial_list (` (.type: (~ declaration)
                                 (..Object (.Primitive (~ (code.text (..host_path class_name)))
                                                       [(~+ g!class_variables)]))))
                            (list#each (.function (_ member)
                                         (`` (`` (case member
                                                   (~~ (for @.lua (~~ (these))
                                                            @.ruby (~~ (these))
                                                            (~~ (these {#Constructor it}
                                                                       (..constructor_definition class alias namespace it)))))
                                                   
                                                   {#Field it}
                                                   (..field_definition host_module_import! class alias namespace it)
                                                   
                                                   {#Method it}
                                                   (..method_definition host_module_import! class alias namespace it)))))
                                       (the #members it)))))
        )))

  (for @.ruby (these)
       (syntax: .public (function [[self inputs] (<code>.form
                                                  (all <>.and
                                                       <code>.local
                                                       (<code>.tuple (<>.some (<>.and <code>.any <code>.any)))))
                                   type <code>.any
                                   term <code>.any])
         (in (list (` (.<| (.as ..Function)
                           (<function> (~ (code.nat (list.size inputs))))
                           (.as (.-> [(~+ (list.repeated (list.size inputs) (` .Any)))]
                                     .Any))
                           (.is (.-> [(~+ (list#each product.right inputs))]
                                     (~ type)))
                           (.function ((~ (code.local self)) [(~+ (list#each product.left inputs))])
                             (~ term))))))))

  (for @.js (these (template: .public (type_of object)
                     [("js type-of" object)])

                   (syntax: .public (global [type <code>.any
                                             [head tail] (<code>.tuple (<>.and <code>.local (<>.some <code>.local)))])
                     (with_symbols [g!_]
                       (let [global (` ("js constant" (~ (code.text head))))]
                         (case tail
                           {.#End}
                           (in (list (` (is (.Maybe (~ type))
                                            (case (..type_of (~ global))
                                              "undefined"
                                              {.#None}

                                              (~ g!_)
                                              {.#Some (as (~ type) (~ global))})))))
                           
                           {.#Item [next tail]}
                           (let [separator "."]
                             (in (list (` (is (.Maybe (~ type))
                                              (case (..type_of (~ global))
                                                "undefined"
                                                {.#None}

                                                (~ g!_)
                                                (..global (~ type) [(~ (code.local (%.format head "." next)))
                                                                    (~+ (list#each code.local tail))])))))))))))

                   (template: (!defined? <global>)
                     [(.case (..global Any <global>)
                        {.#None}
                        .false

                        {.#Some _}
                        .true)])

                   (template [<name> <global>]
                     [(def: .public <name>
                        Bit
                        (!defined? <global>))]

                     [on_browser? [window]]
                     [on_nashorn? [java lang Object]]
                     )

                   (def: .public on_node_js?
                     Bit
                     (|> (..global (Object Any) [process])
                         (maybe#each (|>> []
                                          ("js apply" ("js constant" "Object.prototype.toString.call"))
                                          (as Text)
                                          (text#= "[object process]")))
                         (maybe.else false)))
                   )
       (these))
  )