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

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

(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"]
                             (as_is))
                  <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"]
                             (as_is))
                  <import> (for [@.python "python import"
                                 @.lua "lua import"
                                 @.ruby "ruby import"]
                                (as_is))
                  <function> (for [@.js "js function"
                                   @.python "python function"
                                   @.lua "lua function"]
                                  (as_is))]
  (abstract: .public (Object brand) Any)

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

      [Function]
      <un_common>
      ))

  (with_expansions [<un_common> (for [@.js (as_is [Number  Frac])
                                      @.python (as_is [Integer Int]
                                                      [Float   Frac])
                                      @.lua (as_is [Integer Int]
                                                   [Float   Frac])
                                      @.ruby (as_is [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_symbol)))

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

  (def: optional
    (Parser Optional)
    (let [token "?"]
      (<| (<>.and (<>.parses? (<code>.text! token)))
          (<>.after (<>.not (<code>.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))))
       (|>> ($_ <>.and
                <name>
                ..alias
                )))]

    [named <code>.local_symbol]
    [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_symbol))))

  (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)
    ($_ <>.and
        (<>#in (list))
        (<code>.tuple (<>.some ..optional))
        (<>.parses? (<code>.text! "io"))
        (<>.parses? (<code>.text! "try"))))

  (type: Constructor
    (Named Input))

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

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

  (def: static!
    (Parser Any)
    (<code>.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 (with@ [#anonymous #input #variables]))
        ..named
        ($_ <>.and
            ..input
            ..optional
            )))

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

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

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

  (`` (`` (def: sub
            (Parser Sub)
            ($_ <>.or
                (~~ (for [@.lua (~~ (as_is))
                          @.ruby (~~ (as_is))]
                         ..constructor))
                ..field
                ..method
                ))))

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

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

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

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

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

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

                  (def: (lux_optional it output)
                    (-> Optional Code Code)
                    (` (.let [(~ g!it') (~ output)]
                         (~ (if (value@ #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)
    ($_ <>.and
        (<>.either (<>.and <code>.local_symbol
                           (<>#in (list)))
                   (<code>.form (<>.and <code>.local_symbol
                                        (<>.some <code>.local_symbol))))
        ..alias
        <code>.text
        (<>.some ..sub)))

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

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

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

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

  (def: (procedure_definition import! source it)
    (-> (List Code) Code (Named Procedure) Code)
    (let [g!it (|> (value@ #alias it)
                   (maybe.else (value@ #name it))
                   code.local_symbol)
          g!variables (list#each code.local_symbol (value@ [#anonymous #input #variables] it))
          input (value@ [#anonymous #input] it)
          :parameters: (value@ #parameters input)
          g!parameters (..parameters :parameters:)
          :output: (value@ [#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 (value@ #mandatory) g!parameters))))
           (.All ((~ g!it) (~+ g!variables))
             (-> (~+ :input:/*)
                 (~ (|> :output:
                        ..output_type
                        (..input_type input)))))
           (.exec
             (~+ import!)
             (.:expected
              (~ (<| (..input_term input)
                     (..lux_optional :output:)
                     (` (<apply> (.: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 (as_is)]
       (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 (|> (value@ #alias it)
                     (maybe.else (value@ #name it))
                     code.local_symbol)
          :output: (value@ #anonymous it)]
      (` (.def: (~ g!name)
           (~ (..output_type :output:))
           (.exec
             (~+ import!)
             (.:expected
              (~ (<| (lux_optional :output:)
                     (` (<constant> (~ (code.text (..host_path (value@ #name it))))))))))))))
  
  (for [@.lua (as_is)
        @.ruby (as_is)]
       (def: (constructor_definition [class_name class_parameters] alias namespace it)
         (-> Declaration Alias Namespace Constructor Code)
         (let [g!it (|> it
                        (value@ #alias)
                        (maybe.else "new")
                        (..namespaced namespace class_name alias)
                        code.local_symbol)
               input (value@ #anonymous it)
               g!input_variables (list#each code.local_symbol (value@ #variables input))
               :parameters: (value@ #parameters input)
               g!parameters (..parameters :parameters:)
               g!class_variables (list#each code.local_symbol class_parameters)
               g!class (` ((~ (code.local_symbol (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 (value@ #mandatory) g!parameters))))
                (.All ((~ g!it) (~+ g!class_variables) (~+ g!input_variables))
                  (.-> (~+ (list#each ..output_type :parameters:))
                       (~ (|> :output:
                              ..output_type
                              (..input_type input)))))
                (.: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 (value@ #name it)
          g!it (|> (value@ #alias it)
                   (maybe.else field)
                   (..namespaced namespace class_name alias)
                   code.local_symbol)
          :field: (value@ #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 (value@ #name it)
          g!it (|> (value@ #alias it)
                   (maybe.else name)
                   (..namespaced namespace class_name alias)
                   code.local_symbol)
          path (%.format (..host_path class_name) "." name)
          :field: (value@ #anonymous it)
          g!variables (list#each code.local_symbol class_parameters)
          g!class (` ((~ (code.local_symbol (maybe.else class_name alias))) (~+ g!variables)))]
      (` (.def: ((~ g!it) (~ g!it))
           (.All ((~ g!it) (~+ g!variables))
             (.-> (~ g!class)
                  (~ (..output_type :field:))))
           (.: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 (value@ #static? it)
      (..static_field_definition import! class alias namespace (value@ #member it))
      (..virtual_field_definition class alias namespace (value@ #member it))))

  (def: (static_method_definition import! [class_name class_parameters] alias namespace it)
    (-> (List Code) Declaration Alias Namespace (Named Procedure) Code)
    (let [method (value@ #name it)
          name (|> (value@ #alias it)
                   (maybe.else (value@ #name it))
                   (..namespaced namespace class_name alias))]
      (|> it
          (with@ #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 (value@ #name it)
          g!it (|> (value@ #alias it)
                   (maybe.else method)
                   (..namespaced namespace class_name alias)
                   code.local_symbol)
          procedure (value@ #anonymous it)
          input (value@ #input procedure)
          g!input_variables (list#each code.local_symbol (value@ #variables input))
          :parameters: (value@ #parameters input)
          g!parameters (..parameters :parameters:)
          g!class_variables (list#each code.local_symbol class_parameters)
          g!class (` ((~ (code.local_symbol (maybe.else class_name alias))) (~+ g!class_variables)))
          :output: (value@ #output procedure)]
      (` (.def: ((~ g!it) (~+ (list#each (value@ #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)))))
           (.: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 (value@ #static? it)
      (static_method_definition import! class alias namespace (value@ #member it))
      (virtual_method_definition class alias namespace (value@ #member it))))

  (syntax: .public (import: [host_module (<>.maybe <code>.text)
                             it ..import])
    (let [host_module_import! (: (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 (value@ #name it))))))
                                          it)))

        {#Class it}
        (let [class (value@ #declaration it)
              alias (value@ #class_alias it)
              [class_name class_parameters] class
              namespace (value@ #namespace it)
              g!class_variables (list#each code.local_symbol class_parameters)
              declaration (` ((~ (code.local_symbol (maybe.else class_name alias)))
                              (~+ g!class_variables)))]
          (in (list& (` (.type: (~ declaration)
                          (..Object (.Primitive (~ (code.text (..host_path class_name)))
                                                [(~+ g!class_variables)]))))
                     (list#each (.function (_ member)
                                  (`` (`` (case member
                                            (~~ (for [@.lua (~~ (as_is))
                                                      @.ruby (~~ (as_is))]
                                                     (~~ (as_is {#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)))))
                                (value@ #members it)))))
        )))

  (for [@.ruby (as_is)]
       (template: .public (function <inputs> <output>)
         [(.:as ..Function
                (`` (<function> (~~ (template.amount <inputs>))
                                (.function (_ [<inputs>])
                                  <output>))))]))

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

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

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

                                                (~ g!_)
                                                (..global (~ type) [(~ (code.local_symbol (%.format head "." next)))
                                                                    (~+ (list#each code.local_symbol 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)))
                    )]
       (as_is))
  )