diff options
Diffstat (limited to 'stdlib/source/lux/ffi.rb.lux')
-rw-r--r-- | stdlib/source/lux/ffi.rb.lux | 334 |
1 files changed, 334 insertions, 0 deletions
diff --git a/stdlib/source/lux/ffi.rb.lux b/stdlib/source/lux/ffi.rb.lux new file mode 100644 index 000000000..63f14e8a3 --- /dev/null +++ b/stdlib/source/lux/ffi.rb.lux @@ -0,0 +1,334 @@ +(.module: + [lux (#- Alias) + ["." meta] + ["@" target] + [abstract + [monad (#+ do)]] + [control + ["." io] + ["<>" parser ("#\." monad) + ["<.>" code (#+ Parser)]]] + [data + ["." product] + ["." maybe] + ["." text + ["%" format (#+ 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] + ) + +(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: Alias + Text) + +(def: alias + (Parser Alias) + (<>.after (<code>.this! (' #as)) <code>.local_identifier)) + +(type: Field + [Bit Text (Maybe Alias) Nilable]) + +(def: static! + (Parser Any) + (<code>.this! (' #static))) + +(def: field + (Parser Field) + (<code>.form ($_ <>.and + (<>.parses? ..static!) + <code>.local_identifier + (<>.maybe ..alias) + ..nilable))) + +(def: constant + (Parser Field) + (<code>.form ($_ <>.and + (<>\wrap true) + <code>.local_identifier + (<>.maybe ..alias) + ..nilable))) + +(type: Common_Method + {#name Text + #alias (Maybe Alias) + #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 ..alias) + (<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 + ("ruby object nil"))) + input)) + +(def: (without_nil g!temp [nilable? outputT] output) + (-> Code Nilable Code Code) + (if nilable? + (` (let [(~ g!temp) (~ output)] + (if ("ruby object nil?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))) + (` (let [(~ g!temp) (~ output)] + (if (not ("ruby object nil?" (~ g!temp))) + (~ g!temp) + (.error! "Nil is an invalid value!")))))) + +(type: Import + (#Class Text (Maybe Alias) (List Member)) + (#Function Static_Method) + (#Constant Field)) + +(def: import + (Parser [(Maybe Text) Import]) + ($_ <>.and + (<>.maybe <code>.text) + ($_ <>.or + ($_ <>.and + <code>.local_identifier + (<>.maybe ..alias) + (<>.some member)) + (<code>.form ..common_method) + ..constant + ))) + +(syntax: #export (try expression) + {#.doc (doc (case (try (risky_computation input)) + (#.Right success) + (do_something success) + + (#.Left error) + (recover_from_failure error)))} + (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) + +(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) + (` ("ruby apply" + (:coerce ..Function (~ source)) + (~+ (list\map (with_nil g!temp) g!inputs))))))))))) + +(syntax: #export (import: {[?module import] ..import}) + (with_gensyms [g!temp] + (case import + (#Class [class alias members]) + (with_gensyms [g!object] + (let [qualify (: (-> Text Code) + (|>> (format (maybe.default class alias) "::") code.local_identifier)) + g!type (code.local_identifier (maybe.default class alias)) + module_import (: (List Code) + (case ?module + (#.Some module) + (list (` ("ruby import" (~ (code.text module))))) + + #.None + (list))) + class_import (` ("ruby constant" (~ (code.text class))))] + (wrap (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text class)))))) + (list\map (function (_ member) + (case member + (#Field [static? field alias fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:coerce (~ (nilable_type fieldT)) + (.exec + (~+ module_import) + ("ruby constant" (~ (code.text (format class "::" field))))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nilable_type fieldT))) + (:assume + (~ (without_nil g!temp fieldT (` ("ruby object get" (~ (code.text field)) + (:coerce (..Object .Any) (~ g!object)))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("ruby object get" (~ (code.text method)) + (:coerce (..Object .Any) + (.exec + (~+ module_import) + ("ruby constant" (~ (code.text (format class "::" method)))))))) + 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) + (` ("ruby object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_nil g!temp) g!inputs))))))))))))) + members))))) + + (#Function [name alias inputsT io? try? outputT]) + (let [imported (` (.exec + (~+ (case ?module + (#.Some module) + (list (` ("ruby import" (~ (code.text module))))) + + #.None + (list))) + ("ruby constant" (~ (code.text name)))))] + (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + imported + inputsT + io? + try? + outputT)))) + + (#Constant [_ name alias fieldT]) + (let [imported (` (.exec + (~+ (case ?module + (#.Some module) + (list (` ("ruby import" (~ (code.text module))))) + + #.None + (list))) + ("ruby constant" (~ (code.text name)))))] + (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:coerce (~ (nilable_type fieldT)) (~ imported)))))))))) + ))) |