diff options
Diffstat (limited to 'stdlib/source/library/lux/ffi.py.lux')
-rw-r--r-- | stdlib/source/library/lux/ffi.py.lux | 315 |
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>))))) |