diff options
author | Eduardo Julián | 2021-07-14 14:44:53 -0400 |
---|---|---|
committer | GitHub | 2021-07-14 14:44:53 -0400 |
commit | 89ca40f2f101b2b38187eab5cf905371cd47eb57 (patch) | |
tree | f05fd1677a70988c6b39c07e52d031d86eff28f1 /stdlib/source/library/lux/ffi.lua.lux | |
parent | 2431e767a09894c2f685911ba7f1ba0b7de2a165 (diff) | |
parent | 8252bdb938a0284dd12e7365b4eb84b5357bacac (diff) |
Merge pull request #58 from LuxLang/hierarchy_normalization
Hierarchy normalization
Diffstat (limited to 'stdlib/source/library/lux/ffi.lua.lux')
-rw-r--r-- | stdlib/source/library/lux/ffi.lua.lux | 310 |
1 files changed, 310 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/ffi.lua.lux b/stdlib/source/library/lux/ffi.lua.lux new file mode 100644 index 000000000..0099865f5 --- /dev/null +++ b/stdlib/source/library/lux/ffi.lua.lux @@ -0,0 +1,310 @@ +(.module: + [library + [lux #* + ["." meta] + ["@" target] + [abstract + [monad (#+ do)]] + [control + ["." io] + ["<>" parser ("#\." monad) + ["<.>" 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: #export <brand> Any) + (type: #export <name> + (..Object <brand>)))] + + [Nil] + [Function] + [Table] + ) + +(template [<name> <type>] + [(type: #export <name> + <type>)] + + [Boolean Bit] + [Integer Int] + [Float Frac] + [String Text] + ) + +(type: Nilable + [Bit Code]) + +(def: nilable + (Parser Nilable) + (let [token (' #?)] + (<| (<>.and (<>.parses? (<code>.this! token))) + (<>.after (<>.not (<code>.this! token))) + <code>.any))) + +(type: Field + [Bit Text Nilable]) + +(def: static! + (Parser Any) + (<code>.this! (' #static))) + +(def: field + (Parser Field) + (<code>.form ($_ <>.and + (<>.parses? ..static!) + <code>.local_identifier + ..nilable))) + +(def: constant + (Parser Field) + (<code>.form ($_ <>.and + (<>\wrap true) + <code>.local_identifier + ..nilable))) + +(type: Common_Method + {#name Text + #alias (Maybe Text) + #inputs (List Nilable) + #io? Bit + #try? Bit + #output Nilable}) + +(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 ..nilable)) + (<>.parses? (<code>.this! (' #io))) + (<>.parses? (<code>.this! (' #try))) + ..nilable)) + +(def: static_method + (<>.after ..static! ..common_method)) + +(def: method + (Parser Method) + (<code>.form (<>.or ..static_method + ..common_method))) + +(type: Member + (#Field Field) + (#Method Method)) + +(def: member + (Parser Member) + ($_ <>.or + ..field + ..method + )) + +(def: input_variables + (-> (List Nilable) (List [Bit Code])) + (|>> list.enumeration + (list\map (function (_ [idx [nilable? type]]) + [nilable? (|> idx %.nat code.local_identifier)])))) + +(def: (nilable_type [nilable? type]) + (-> Nilable Code) + (if nilable? + (` (.Maybe (~ type))) + type)) + +(def: (with_nil g!temp [nilable? input]) + (-> Code [Bit Code] Code) + (if nilable? + (` (case (~ input) + (#.Some (~ g!temp)) + (~ g!temp) + + #.Nil + ("lua object nil"))) + input)) + +(def: (without_nil g!temp [nilable? outputT] output) + (-> Code Nilable Code Code) + (if nilable? + (` (let [(~ g!temp) (~ output)] + (if ("lua object nil?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))) + (` (let [(~ g!temp) (~ output)] + (if (not ("lua object nil?" (~ g!temp))) + (~ g!temp) + (.error! "Nil is an invalid value!")))))) + +(type: Import + (#Class [Text Text (List Member)]) + (#Function Static_Method) + (#Constant Field)) + +(def: import + ($_ <>.or + (<>.and <code>.local_identifier + (<>.default ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) + (<code>.form ..common_method) + ..constant + )) + +(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 Nilable) Bit Bit Nilable Code) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ g!method) + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map nilable_type inputsT))] + (~ (|> (nilable_type outputT) + (try_type try?) + (io_type io?)))) + (:assume + (~ (<| (with_io io?) + (with_try try?) + (without_nil g!temp outputT) + (` ("lua apply" + (:as ..Function (~ source)) + (~+ (list\map (with_nil 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) + (` ("lua object get" (~ (code.text sub)) + (:as (..Object .Any) (~ super))))) + (` ("lua import" (~ (code.text head)))) + tail) + + #.Nil + (` ("lua import" (~ (code.text class)))))] + (wrap (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text real_class)))))) + (list\map (function (_ member) + (case member + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:as (~ (nilable_type fieldT)) + ("lua object get" (~ (code.text field)) + (:as (..Object .Any) (~ imported))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nilable_type fieldT))) + (:assume + (~ (without_nil g!temp fieldT (` ("lua 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 + (` ("lua 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 nilable_type inputsT))] + (~ g!type) + (~ (|> (nilable_type outputT) + (try_type try?) + (io_type io?)))) + (:assume + (~ (<| (with_io io?) + (with_try try?) + (without_nil g!temp outputT) + (` ("lua object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_nil 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 + (` ("lua constant" (~ (code.text (text.replace_all "/" "." name))))) + inputsT + io? + try? + outputT))) + + (#Constant [_ name fieldT]) + (wrap (list (` ((~! syntax:) ((~ (code.local_identifier name))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:as (~ (nilable_type fieldT)) + ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))))))))) + ))) + +(template: #export (closure <inputs> <output>) + (.:as ..Function + (`` ("lua function" + (~~ (template.count <inputs>)) + (.function (_ [<inputs>]) + <output>))))) |