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/lux/ffi.scm.lux | |
parent | 2431e767a09894c2f685911ba7f1ba0b7de2a165 (diff) | |
parent | 8252bdb938a0284dd12e7365b4eb84b5357bacac (diff) |
Merge pull request #58 from LuxLang/hierarchy_normalization
Hierarchy normalization
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/ffi.scm.lux | 219 |
1 files changed, 0 insertions, 219 deletions
diff --git a/stdlib/source/lux/ffi.scm.lux b/stdlib/source/lux/ffi.scm.lux deleted file mode 100644 index c6c447b72..000000000 --- a/stdlib/source/lux/ffi.scm.lux +++ /dev/null @@ -1,219 +0,0 @@ -(.module: - [lux (#- Alias) - ["@" target] - ["." meta] - [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}) - -(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: 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 - ("scheme object nil"))) - input)) - -(def: (without_nil g!temp [nilable? outputT] output) - (-> Code Nilable Code Code) - (if nilable? - (` (let [(~ g!temp) (~ output)] - (if ("scheme object nil?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))) - (` (let [(~ g!temp) (~ output)] - (if (not ("scheme object nil?" (~ g!temp))) - (~ g!temp) - (.error! "Nil is an invalid value!")))))) - -(type: Import - (#Function Common_Method) - (#Constant Field)) - -(def: import - (Parser Import) - ($_ <>.or - (<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) - (` ("scheme apply" - (:as ..Function (~ source)) - (~+ (list\map (with_nil g!temp) g!inputs))))))))))) - -(syntax: #export (import: {import ..import}) - (with_gensyms [g!temp] - (case import - (#Function [name alias inputsT io? try? outputT]) - (let [imported (` ("scheme 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 (` ("scheme constant" (~ (code.text name))))] - (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) - ))) |