aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/ffi.py.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/ffi.py.lux')
-rw-r--r--stdlib/source/library/lux/ffi.py.lux315
1 files changed, 315 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/ffi.py.lux b/stdlib/source/library/lux/ffi.py.lux
new file mode 100644
index 000000000..737cfefd8
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.py.lux
@@ -0,0 +1,315 @@
+(.module:
+ [library
+ [lux #*
+ ["." meta]
+ ["@" target]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io]
+ ["<>" parser
+ ["<.>" code (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." text
+ ["%" format]]
+ [collection
+ ["." list ("#\." functor fold)]]]
+ [type
+ abstract]
+ [macro (#+ with_gensyms)
+ [syntax (#+ syntax:)]
+ ["." code]
+ ["." template]]]])
+
+(abstract: #export (Object brand) Any)
+
+(template [<name>]
+ [(with_expansions [<brand> (template.identifier [<name> "'"])]
+ (abstract: <brand> Any)
+ (type: #export <name>
+ (..Object <brand>)))]
+
+ [None]
+ [Dict]
+ [Function]
+ )
+
+(template [<name> <type>]
+ [(type: #export <name>
+ <type>)]
+
+ [Boolean Bit]
+ [Integer Int]
+ [Float Frac]
+ [String Text]
+ )
+
+(type: Noneable
+ [Bit Code])
+
+(def: noneable
+ (Parser Noneable)
+ (let [token (' #?)]
+ (<| (<>.and (<>.parses? (<code>.this! token)))
+ (<>.after (<>.not (<code>.this! token)))
+ <code>.any)))
+
+(type: Constructor
+ (List Noneable))
+
+(def: constructor
+ (Parser Constructor)
+ (<code>.form (<>.after (<code>.this! (' new))
+ (<code>.tuple (<>.some ..noneable)))))
+
+(type: Field
+ [Bit Text Noneable])
+
+(def: static!
+ (Parser Any)
+ (<code>.this! (' #static)))
+
+(def: field
+ (Parser Field)
+ (<code>.form ($_ <>.and
+ (<>.parses? ..static!)
+ <code>.local_identifier
+ ..noneable)))
+
+(type: Common_Method
+ {#name Text
+ #alias (Maybe Text)
+ #inputs (List Noneable)
+ #io? Bit
+ #try? Bit
+ #output Noneable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+ (#Static Static_Method)
+ (#Virtual Virtual_Method))
+
+(def: common_method
+ (Parser Common_Method)
+ ($_ <>.and
+ <code>.local_identifier
+ (<>.maybe (<>.after (<code>.this! (' #as)) <code>.local_identifier))
+ (<code>.tuple (<>.some ..noneable))
+ (<>.parses? (<code>.this! (' #io)))
+ (<>.parses? (<code>.this! (' #try)))
+ ..noneable))
+
+(def: static_method
+ (<>.after ..static! ..common_method))
+
+(def: method
+ (Parser Method)
+ (<code>.form (<>.or ..static_method
+ ..common_method)))
+
+(type: Member
+ (#Constructor Constructor)
+ (#Field Field)
+ (#Method Method))
+
+(def: member
+ (Parser Member)
+ ($_ <>.or
+ ..constructor
+ ..field
+ ..method
+ ))
+
+(def: input_variables
+ (-> (List Noneable) (List [Bit Code]))
+ (|>> list.enumeration
+ (list\map (function (_ [idx [noneable? type]])
+ [noneable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (noneable_type [noneable? type])
+ (-> Noneable Code)
+ (if noneable?
+ (` (.Maybe (~ type)))
+ type))
+
+(def: (with_none g!temp [noneable? input])
+ (-> Code [Bit Code] Code)
+ (if noneable?
+ (` (case (~ input)
+ (#.Some (~ g!temp))
+ (~ g!temp)
+
+ #.None
+ ("python object none")))
+ input))
+
+(def: (without_none g!temp [noneable? outputT] output)
+ (-> Code Noneable Code Code)
+ (if noneable?
+ (` (let [(~ g!temp) (~ output)]
+ (if ("python object none?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp)))))
+ (` (let [(~ g!temp) (~ output)]
+ (if (not ("python object none?" (~ g!temp)))
+ (~ g!temp)
+ (.error! "None is an invalid value!"))))))
+
+(type: Import
+ (#Class [Text Text (List Member)])
+ (#Function Static_Method))
+
+(def: import
+ (Parser Import)
+ (<>.or (<>.and <code>.local_identifier
+ (<>.default ["" (list)]
+ (<code>.tuple (<>.and <code>.text
+ (<>.some member)))))
+ (<code>.form ..common_method)))
+
+(def: (with_io with? without)
+ (-> Bit Code Code)
+ (if with?
+ (` (io.io (~ without)))
+ without))
+
+(def: (io_type io? rawT)
+ (-> Bit Code Code)
+ (if io?
+ (` (io.IO (~ rawT)))
+ rawT))
+
+(def: (with_try with? without_try)
+ (-> Bit Code Code)
+ (if with?
+ (` (.try (~ without_try)))
+ without_try))
+
+(def: (try_type try? rawT)
+ (-> Bit Code Code)
+ (if try?
+ (` (.Either .Text (~ rawT)))
+ rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+ (-> Code Code Code (List Noneable) Bit Bit Noneable Code)
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ g!method)
+ [(~+ (list\map product.right g!inputs))])
+ (-> [(~+ (list\map noneable_type inputsT))]
+ (~ (|> (noneable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_none g!temp outputT)
+ (` ("python apply"
+ (:as ..Function (~ source))
+ (~+ (list\map (with_none g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+ (with_gensyms [g!temp]
+ (case import
+ (#Class [class format members])
+ (with_gensyms [g!object]
+ (let [qualify (: (-> Text Code)
+ (function (_ member_name)
+ (|> format
+ (text.replace_all "#" class)
+ (text.replace_all "." member_name)
+ code.local_identifier)))
+ g!type (code.local_identifier class)
+ real_class (text.replace_all "/" "." class)
+ imported (case (text.split_all_with "/" class)
+ (#.Cons head tail)
+ (list\fold (function (_ sub super)
+ (` ("python object get" (~ (code.text sub))
+ (:as (..Object .Any) (~ super)))))
+ (` ("python import" (~ (code.text head))))
+ tail)
+
+ #.Nil
+ (` ("python import" (~ (code.text class)))))]
+ (wrap (list& (` (type: (~ g!type)
+ (..Object (primitive (~ (code.text real_class))))))
+ (list\map (function (_ member)
+ (case member
+ (#Constructor inputsT)
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ (qualify "new"))
+ [(~+ (list\map product.right g!inputs))])
+ (-> [(~+ (list\map noneable_type inputsT))]
+ (~ g!type))
+ (:assume
+ ("python apply"
+ (:as ..Function (~ imported))
+ (~+ (list\map (with_none g!temp) g!inputs)))))))
+
+ (#Field [static? field fieldT])
+ (if static?
+ (` ((~! syntax:) ((~ (qualify field)))
+ (\ (~! meta.monad) (~' wrap)
+ (list (` (.:as (~ (noneable_type fieldT))
+ ("python object get" (~ (code.text field))
+ (:as (..Object .Any) (~ imported)))))))))
+ (` (def: ((~ (qualify field))
+ (~ g!object))
+ (-> (~ g!type)
+ (~ (noneable_type fieldT)))
+ (:assume
+ (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field))
+ (:as (..Object .Any) (~ g!object))))))))))
+
+ (#Method method)
+ (case method
+ (#Static [method alias inputsT io? try? outputT])
+ (..make_function (qualify (maybe.default method alias))
+ g!temp
+ (` ("python object get" (~ (code.text method))
+ (:as (..Object .Any) (~ imported))))
+ inputsT
+ io?
+ try?
+ outputT)
+
+ (#Virtual [method alias inputsT io? try? outputT])
+ (let [g!inputs (input_variables inputsT)]
+ (` (def: ((~ (qualify (maybe.default method alias)))
+ [(~+ (list\map product.right g!inputs))]
+ (~ g!object))
+ (-> [(~+ (list\map noneable_type inputsT))]
+ (~ g!type)
+ (~ (|> (noneable_type outputT)
+ (try_type try?)
+ (io_type io?))))
+ (:assume
+ (~ (<| (with_io io?)
+ (with_try try?)
+ (without_none g!temp outputT)
+ (` ("python object do"
+ (~ (code.text method))
+ (~ g!object)
+ (~+ (list\map (with_none g!temp) g!inputs)))))))))))))
+ members)))))
+
+ (#Function [name alias inputsT io? try? outputT])
+ (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+ g!temp
+ (` ("python constant" (~ (code.text name))))
+ inputsT
+ io?
+ try?
+ outputT)))
+ )))
+
+(template: #export (lambda <inputs> <output>)
+ (.:as ..Function
+ (`` ("python function"
+ (~~ (template.count <inputs>))
+ (.function (_ [<inputs>])
+ <output>)))))