diff options
Diffstat (limited to 'stdlib/source/library')
13 files changed, 466 insertions, 512 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index fa0108157..be2a9eb33 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -4884,62 +4884,61 @@ {#None} (failure (..wrong_syntax_error (symbol ..loop))))))) -(def (with_expansions' label tokens target) - (-> Text (List Code) Code (List Code)) - (case target - (pattern#or [_ {#Bit _}] - [_ {#Nat _}] - [_ {#Int _}] - [_ {#Rev _}] - [_ {#Frac _}] - [_ {#Text _}]) - (list target) - - [_ {#Symbol [module name]}] - (if (and (text#= "" module) - (text#= label name)) - tokens - (list target)) - - (with_template#pattern [<tag>] - [[location {<tag> elems}] - (list [location {<tag> (list#conjoint (list#each (with_expansions' label tokens) elems))}])]) - ([#Form] - [#Variant] - [#Tuple]))) - (def .public with_expansions - (macro (_ tokens) - (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) - {#Some [bindings bodies]} - (loop (again [bindings bindings - map (is (Property_List (List Code)) - (list))]) - (let [normal (is (-> Code (List Code)) - (function (_ it) - (list#mix (function (_ [binding expansion] it) - (list#conjoint (list#each (with_expansions' binding expansion) it))) - (list it) - map)))] - (case bindings - {#Item [var_name expr] &rest} - (do meta#monad - [expansion (case (normal expr) - (list expr) - (single_expansion expr) + (let [with_expansions' (is (-> Text (List Code) Code (List Code)) + (function (with_expansions' label tokens target) + (case target + (pattern#or [_ {#Bit _}] + [_ {#Nat _}] + [_ {#Int _}] + [_ {#Rev _}] + [_ {#Frac _}] + [_ {#Text _}]) + (list target) + + [_ {#Symbol [module name]}] + (if (and (text#= "" module) + (text#= label name)) + tokens + (list target)) + + (with_template#pattern [<tag>] + [[location {<tag> elems}] + (list [location {<tag> (list#conjoint (list#each (with_expansions' label tokens) elems))}])]) + ([#Form] + [#Variant] + [#Tuple]))))] + (macro (_ tokens) + (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) + {#Some [bindings bodies]} + (loop (again [bindings bindings + map (is (Property_List (List Code)) + (list))]) + (let [normal (is (-> Code (List Code)) + (function (_ it) + (list#mix (function (_ [binding expansion] it) + (list#conjoint (list#each (with_expansions' binding expansion) it))) + (list it) + map)))] + (case bindings + {#Item [var_name expr] &rest} + (do meta#monad + [expansion (case (normal expr) + (list expr) + (single_expansion expr) - _ - (failure (all text#composite - "Incorrect expansion in with_expansions" - " | Binding: " (text#encoded var_name) - " | Expression: " (code#encoded expr))))] - (again &rest (property#with var_name expansion map))) - - {#End} - (at meta#monad #in (list#conjoint (list#each normal bodies)))))) - - {#None} - (failure (..wrong_syntax_error (symbol ..with_expansions)))))) + _ + (failure (all text#composite + "Incorrect expansion in with_expansions" + " | Binding: " (text#encoded var_name) + " | Expression: " (code#encoded expr))))] + (again &rest (property#with var_name expansion map))) + + {#End} + (at meta#monad #in (list#conjoint (list#each normal bodies)))))) + + {#None} + (failure (..wrong_syntax_error (symbol ..with_expansions))))))) (def (flat_alias type) (-> Type Type) @@ -4960,136 +4959,58 @@ _ type)) -(def (static_simple_literal name) - (-> Symbol (Meta Code)) - (do meta#monad - [type+value (definition_value name) - .let [[type value] type+value]] - (case (flat_alias type) - (with_template#pattern [<name> <type> <wrapper>] - [{#Named ["library/lux" <name>] _} - (in (<wrapper> (as <type> value)))]) - (["Bit" Bit bit$] - ["Nat" Nat nat$] - ["Int" Int int$] - ["Rev" Rev rev$] - ["Frac" Frac frac$] - ["Text" Text text$]) - - _ - (failure (text#composite "Cannot anti-quote type: " (symbol#encoded name)))))) - -(def (static_literal token) - (-> Code (Meta Code)) - (case token - [_ {#Symbol [def_module def_name]}] - (if (text#= "" def_module) - (do meta#monad - [current_module current_module_name] - (static_simple_literal [current_module def_name])) - (static_simple_literal [def_module def_name])) - - (with_template#pattern [<tag>] - [[meta {<tag> parts}] - (do meta#monad - [=parts (monad#each meta#monad static_literal parts)] - (in [meta {<tag> =parts}]))]) - ([#Form] - [#Variant] - [#Tuple]) - - _ - (meta#in token) - ... TODO: Figure out why this doesn't work: - ... (at meta#monad in token) - )) - (def .public static - (macro (_ tokens) - (case tokens - (list pattern) - (do meta#monad - [pattern' (static_literal pattern)] - (in (list pattern'))) - - _ - (failure (..wrong_syntax_error (symbol ..static)))))) - -(type Multi_Level_Case - [Code (List [Code Code])]) - -(def (case_level^ level) - (-> Code (Meta [Code Code])) - (meta#in (case level - [_ {#Tuple (list expr binding)}] - [expr binding] - - _ - [level (` #1)]))) - -(def (multi_level_case^ levels) - (-> (List Code) (Meta Multi_Level_Case)) - (case levels - {#End} - (failure "Multi-level patterns cannot be empty.") - - {#Item init extras} - (do meta#monad - [extras' (monad#each meta#monad case_level^ extras)] - (in [init extras'])))) - -(def (multi_level_case$ g!_ [[init_pattern levels] body]) - (-> Code [Multi_Level_Case Code] (List Code)) - (let [inner_pattern_body (list#mix (function (_ [calculation pattern] success) - (let [bind? (case pattern - [_ {#Symbol _}] - #1 - - _ - #0)] - (` (case (, calculation) - (, pattern) - (, success) - - (,* (if bind? - (list) - (list g!_ (` {.#None})))))))) - (` {.#Some (, body)}) - (is (List [Code Code]) (list#reversed levels)))] - (list init_pattern inner_pattern_body))) - -(def pattern#multi - (pattern - (macro (_ tokens) - (case tokens - (list#partial [_meta {#Form levels}] body next_branches) - (do meta#monad - [mlc (multi_level_case^ levels) - .let [initial_bind? (case mlc - [[_ {#Symbol _}] _] - #1 + (let [simple_literal (is (-> Symbol (Meta Code)) + (function (simple_literal name) + (do meta#monad + [type+value (definition_value name) + .let [[type value] type+value]] + (case (flat_alias type) + (with_template#pattern [<name> <type> <wrapper>] + [{#Named ["library/lux" <name>] _} + (in (<wrapper> (as <type> value)))]) + (["Bit" Bit bit$] + ["Nat" Nat nat$] + ["Int" Int int$] + ["Rev" Rev rev$] + ["Frac" Frac frac$] + ["Text" Text text$]) + + _ + (failure (text#composite "Cannot anti-quote type: " (symbol#encoded name))))))) + literal (is (-> Code (Meta Code)) + (function (literal token) + (case token + [_ {#Symbol [def_module def_name]}] + (if (text#= "" def_module) + (do meta#monad + [current_module current_module_name] + (simple_literal [current_module def_name])) + (simple_literal [def_module def_name])) - _ - #0)] - expected ..expected_type - g!temp (..generated_symbol "temp")] - (in (list g!temp - (` ({{.#Some (, g!temp)} - (, g!temp) - - {.#None} - (case (, g!temp) - (,* next_branches))} - ("lux type check" {.#Apply (, (type_code expected)) Maybe} - (case (, g!temp) - (,* (multi_level_case$ g!temp [mlc body])) - - (,* (if initial_bind? - (list) - (list g!temp (` {.#None}))))))))))) - - _ - (failure (..wrong_syntax_error (symbol ..pattern#multi))))))) + (with_template#pattern [<tag>] + [[meta {<tag> parts}] + (do meta#monad + [=parts (monad#each meta#monad literal parts)] + (in [meta {<tag> =parts}]))]) + ([#Form] + [#Variant] + [#Tuple]) + + _ + (meta#in token) + ... TODO: Figure out why this doesn't work: + ... (at meta#monad in token) + )))] + (macro (_ tokens) + (case tokens + (list pattern) + (do meta#monad + [pattern' (literal pattern)] + (in (list pattern'))) + + _ + (failure (..wrong_syntax_error (symbol ..static))))))) (def .public (same? reference sample) (All (_ a) @@ -5107,24 +5028,22 @@ _ (failure (..wrong_syntax_error (symbol ..as_expected)))))) -(def location - (Meta Location) - (function (_ compiler) - {#Right [compiler (the #location compiler)]})) - (def .public undefined - (macro (_ tokens) - (case tokens - {#End} - (do meta#monad - [location ..location - .let [[module line column] location - location (all "lux text concat" (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) - message (all "lux text concat" "Undefined behavior @ " location)]] - (in (list (` (..panic! (, (text$ message))))))) - - _ - (failure (..wrong_syntax_error (symbol ..undefined)))))) + (let [location (is (Meta Location) + (function (_ compiler) + {#Right [compiler (the #location compiler)]}))] + (macro (_ tokens) + (case tokens + {#End} + (do meta#monad + [location location + .let [[module line column] location + location (all "lux text concat" (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) + message (all "lux text concat" "Undefined behavior @ " location)]] + (in (list (` (..panic! (, (text$ message))))))) + + _ + (failure (..wrong_syntax_error (symbol ..undefined))))))) (def .public type_of (macro (_ tokens) @@ -5143,42 +5062,43 @@ _ (failure (..wrong_syntax_error (symbol ..type_of)))))) -(def (templateP tokens) - (-> (List Code) (Maybe [Text (List Text) (List Code)])) - (do maybe#monad - [% (local_declarationP tokens) - .let' [[tokens [name parameters]] %] - % (tupleP (someP anyP) tokens) - .let' [[tokens templates] %] - _ (endP tokens)] - (in [name parameters templates]))) - (def .public template - (macro (_ tokens) - (case (templateP tokens) - {#Some [name args input_templates]} - (do meta#monad - [g!tokens (..generated_symbol "tokens") - g!compiler (..generated_symbol "compiler") - g!_ (..generated_symbol "_") - .let [rep_env (list#each (function (_ arg) - [arg (` ((,' ,) (, (local$ arg))))]) - args)] - this_module current_module_name] - (in (list (` (..macro ((, (local$ name)) (, g!tokens) (, g!compiler)) - (case (, g!tokens) - (list (,* (list#each local$ args))) - {.#Right [(, g!compiler) - (list (,* (list#each (function (_ template) - (` (`' (, (with_replacements rep_env - template))))) - input_templates)))]} - - (, g!_) - {.#Left "Invalid syntax."})))))) + (let [templateP (is (-> (List Code) (Maybe [Text (List Text) (List Code)])) + (function (_ tokens) + (do maybe#monad + [% (local_declarationP tokens) + .let' [[tokens [name parameters]] %] + % (tupleP (someP anyP) tokens) + .let' [[tokens templates] %] + _ (endP tokens)] + (in [name parameters templates])))) + simple_replacement_environment (is (-> (List Text) Replacement_Environment) + (list#each (function (_ arg) + [arg (` ((,' ,) (, (local$ arg))))]))) + instantiated_template (is (-> Replacement_Environment Code Code) + (function (_ replacement_environment template) + (` (`' (, (with_replacements replacement_environment + template))))))] + (macro (_ tokens) + (case (templateP tokens) + {#Some [name args input_templates]} + (do meta#monad + [g!tokens (..generated_symbol "tokens") + g!compiler (..generated_symbol "compiler") + g!_ (..generated_symbol "_") + this_module ..current_module_name] + (in (list (` (..macro ((, (local$ name)) (, g!tokens) (, g!compiler)) + (case (, g!tokens) + (list (,* (list#each local$ args))) + {.#Right [(, g!compiler) + (list (,* (list#each (instantiated_template (simple_replacement_environment args)) + input_templates)))]} + + (, g!_) + {.#Left "Invalid syntax."})))))) - {#None} - (failure (..wrong_syntax_error (symbol ..template)))))) + {#None} + (failure (..wrong_syntax_error (symbol ..template))))))) (with_template [<name> <to>] [(def .public <name> @@ -5198,76 +5118,73 @@ (def .public char (macro (_ tokens compiler) (case tokens - (pattern#multi (list [_ {#Text input}]) - (|> input "lux text size" ("lux i64 =" 1))) - (|> input ("lux text char" 0) - nat$ list - [compiler] {#Right}) + (list [_ {#Text input}]) + (if (|> input "lux text size" ("lux i64 =" 1)) + (|> input ("lux text char" 0) + nat$ list + [compiler] {#Right}) + {#Left (..wrong_syntax_error (symbol ..char))}) _ {#Left (..wrong_syntax_error (symbol ..char))}))) -(def target - (Meta Text) - (function (_ compiler) - {#Right [compiler (the [#info #target] compiler)]})) - -(def (platform_name choice) - (-> Code (Meta Text)) - (case choice - [_ {#Text platform}] - (..meta#in platform) - - [_ {#Symbol symbol}] - (do meta#monad - [symbol (..global_symbol symbol) - type+value (..definition_value symbol) - .let [[type value] type+value]] - (case (..flat_alias type) - (pattern#or {#Primitive "#Text" {#End}} - {#Named ["library/lux" "Text"] {#Primitive "#Text" {#End}}}) - (in (as ..Text value)) - - _ - (failure (all text#composite - "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) - " : " (..code#encoded (..type_code type)))))) - - _ - (failure (all text#composite - "Invalid target platform syntax: " (..code#encoded choice) - \n "Must be either a text literal or a symbol.")))) - -(def (target_pick target options default) - (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) - (case options - {#End} - (case default - {#None} - (failure (all text#composite "No code for target platform: " target)) - - {#Some default} - (meta#in (list default))) - - {#Item [key pick] options'} - (do meta#monad - [platform (..platform_name key)] - (if (text#= target platform) - (meta#in (list pick)) - (target_pick target options' default))))) - (def .public for - (macro (_ tokens) - (case (..parsed (..andP (..someP (..andP ..anyP ..anyP)) - (..maybeP ..anyP)) - tokens) - {.#Some [options default]} - (do meta#monad - [target ..target] - (target_pick target options default)) + (let [target (is (Meta Text) + (function (_ compiler) + {#Right [compiler (the [#info #target] compiler)]})) + platform_name (is (-> Code (Meta Text)) + (function (_ choice) + (case choice + [_ {#Text platform}] + (..meta#in platform) + + [_ {#Symbol symbol}] + (do meta#monad + [symbol (..global_symbol symbol) + type+value (..definition_value symbol) + .let [[type value] type+value]] + (case (..flat_alias type) + (pattern#or {#Primitive "#Text" {#End}} + {#Named ["library/lux" "Text"] {#Primitive "#Text" {#End}}}) + (in (as ..Text value)) - {.#None} - (failure (..wrong_syntax_error (symbol ..for)))))) + _ + (failure (all text#composite + "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) + " : " (..code#encoded (..type_code type)))))) + + _ + (failure (all text#composite + "Invalid target platform syntax: " (..code#encoded choice) + \n "Must be either a text literal or a symbol."))))) + target_pick (is (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) + (function (target_pick target options default) + (case options + {#End} + (case default + {#None} + (failure (all text#composite "No code for target platform: " target)) + + {#Some default} + (meta#in (list default))) + + {#Item [key pick] options'} + (do meta#monad + [platform (platform_name key)] + (if (text#= target platform) + (meta#in (list pick)) + (target_pick target options' default))))))] + (macro (_ tokens) + (case (..parsed (..andP (..someP (..andP ..anyP ..anyP)) + (..maybeP ..anyP)) + tokens) + {.#Some [options default]} + (do meta#monad + [target target] + (target_pick target options default)) + + {.#None} + (failure (..wrong_syntax_error (symbol ..for))))))) ... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and "parameter" ASAP. (for "{old}" (these (def (scope_type_vars state) @@ -5296,40 +5213,39 @@ (failure (..wrong_syntax_error (symbol ..$))))))) (these (def .public parameter ""))) -(def (refer_code imported_module alias referrals) - (-> Text Text (List Referral) Code) - (` (..refer (, (text$ imported_module)) - (, (text$ alias)) - (,* (list#each (function (_ [macro parameters]) - (` ((, (symbol$ macro)) (,* parameters)))) - referrals))))) - (def .public require - (macro (_ _imports) - (do meta#monad - [current_module ..current_module_name - imports (imports_parser #0 current_module {#End} _imports) - .let [=imports (|> imports - (list#each (is (-> Importation Code) - (function (_ [module_name m_alias =refer]) - (` [(, (text$ module_name)) (, (text$ (..maybe#else "" m_alias)))])))) - tuple$) - =refers (list#each (is (-> Importation Code) - (function (_ [module_name m_alias =refer]) - (refer_code module_name (..maybe#else "" m_alias) =refer))) - imports) - =module (` ("lux def module" (, =imports)))] - g!_ (..generated_symbol "")] - (in {#Item =module - (for "Python" - ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. - ... Without it, I get this strange error - ... {library/lux/tool/compiler/language/lux/generation.no_buffer_for_saving_code} - ... Artifact ID: 0 - ... Which only ever happens for the Python compiler. - (list#partial (` ("lux def" (, g!_) [] #0)) - =refers) - =refers)})))) + (let [refer_code (is (-> Text Text (List Referral) Code) + (function (_ imported_module alias referrals) + (` (..refer (, (text$ imported_module)) + (, (text$ alias)) + (,* (list#each (function (_ [macro parameters]) + (` ((, (symbol$ macro)) (,* parameters)))) + referrals))))))] + (macro (_ _imports) + (do meta#monad + [current_module ..current_module_name + imports (imports_parser #0 current_module {#End} _imports) + .let [=imports (|> imports + (list#each (is (-> Importation Code) + (function (_ [module_name m_alias =refer]) + (` [(, (text$ module_name)) (, (text$ (..maybe#else "" m_alias)))])))) + tuple$) + =refers (list#each (is (-> Importation Code) + (function (_ [module_name m_alias =refer]) + (refer_code module_name (..maybe#else "" m_alias) =refer))) + imports) + =module (` ("lux def module" (, =imports)))] + g!_ (..generated_symbol "")] + (in {#Item =module + (for "Python" + ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. + ... Without it, I get this strange error + ... {library/lux/tool/compiler/language/lux/generation.no_buffer_for_saving_code} + ... Artifact ID: 0 + ... Which only ever happens for the Python compiler. + (list#partial (` ("lux def" (, g!_) [] #0)) + =refers) + =refers)}))))) (type .public Immediate_UnQuote (Primitive "#Macro/Immediate_UnQuote")) @@ -5467,30 +5383,29 @@ {#None} (failure (..wrong_syntax_error (symbol ..Interface))))))) -(def (recursive_type g!self g!dummy name body) - (-> Code Code Text Code Code) - (` {.#Apply (..Primitive "") - (.All ((, g!self) (, g!dummy)) - (, (let$ (local$ name) (` {.#Apply (..Primitive "") (, g!self)}) - body)))})) - (def .public Rec - (macro (_ tokens) - (case tokens - (list [_ {#Symbol "" name}] body) - (do meta#monad - [body' (expansion body) - g!self (generated_symbol "g!self") - g!dummy (generated_symbol "g!dummy")] - (case body' - (list body' labels) - (in (list (..recursive_type g!self g!dummy name body') labels)) + (let [recursive_type (is (-> Code Code Text Code Code) + (function (recursive_type g!self g!dummy name body) + (` {.#Apply (..Primitive "") + (.All ((, g!self) (, g!dummy)) + (, (let$ (local$ name) (` {.#Apply (..Primitive "") (, g!self)}) + body)))})))] + (macro (_ tokens) + (case tokens + (list [_ {#Symbol "" name}] body) + (do meta#monad + [body' (expansion body) + g!self (generated_symbol "g!self") + g!dummy (generated_symbol "g!dummy")] + (case body' + (list body' labels) + (in (list (recursive_type g!self g!dummy name body') labels)) - (list body') - (in (list (..recursive_type g!self g!dummy name body'))) + (list body') + (in (list (recursive_type g!self g!dummy name body'))) - _ - (failure (..wrong_syntax_error (symbol ..Rec))))) + _ + (failure (..wrong_syntax_error (symbol ..Rec))))) - _ - (failure (..wrong_syntax_error (symbol ..Rec)))))) + _ + (failure (..wrong_syntax_error (symbol ..Rec))))))) diff --git a/stdlib/source/library/lux/control/function/inline.lux b/stdlib/source/library/lux/control/function/inline.lux index 6d5f3bebf..a06d2daf7 100644 --- a/stdlib/source/library/lux/control/function/inline.lux +++ b/stdlib/source/library/lux/control/function/inline.lux @@ -11,42 +11,43 @@ ["[0]" meta (.only) ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] - ["[0]" macro (.only) - [syntax (.only syntax) - ["|[0]|" export]]]]]]) + ["[0]" macro (.only with_symbols) + [syntax (.only syntax)]]]]]) + +(type Declaration + [Text (List Code)]) (def declaration - (Parser [Text (List Code)]) + (Parser Declaration) (<code>.form (<>.and <code>.local (<>.some <code>.any)))) (def inline - (Parser [Code [Text (List Code)] Code Code]) - (|export|.parser - (all <>.and - ..declaration - <code>.any - <code>.any - ))) + (Parser [Declaration Code Code]) + (all <>.and + ..declaration + <code>.any + <code>.any + )) (def .public inlined - (syntax (_ [[privacy [name parameters] type term] ..inline]) - (do [! meta.monad] - [@ meta.current_module_name - g!parameters (|> (macro.symbol "parameter") - (list.repeated (list.size parameters)) - (monad.all !)) - .let [inlined (` (("lux in-module" - (, (code.text @)) - (.is (, type) - (.function ((, (code.local name)) (,* parameters)) - (, term)))) - (,* (list#each (function (_ g!parameter) - (` ((,' ,) (, g!parameter)))) - g!parameters)))) - g!parameters (|> g!parameters - (list#each (function (_ parameter) - (list parameter (` <code>.any)))) - list#conjoint)]] - (in (list (` (def (, privacy) (, (code.local name)) - (syntax ((, (code.local name)) [(,* g!parameters)]) + (syntax (_ [[[name parameters] type term] ..inline]) + (with_symbols [g!_] + (do [! meta.monad] + [@ meta.current_module_name + g!parameters (|> (macro.symbol "parameter") + (list.repeated (list.size parameters)) + (monad.all !)) + .let [inlined (` (("lux in-module" + (, (code.text @)) + (.is (, type) + (.function ((, (code.local name)) (,* parameters)) + (, term)))) + (,* (list#each (function (_ g!parameter) + (` ((,' ,) (, g!parameter)))) + g!parameters)))) + g!parameters (|> g!parameters + (list#each (function (_ parameter) + (list parameter (` <code>.any)))) + list#conjoint)]] + (in (list (` (syntax ((, g!_) [(,* g!parameters)]) (.at meta.monad (,' in) (.list (.`' (, inlined)))))))))))) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index a4866a106..ad5fa71fb 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except private) + [lux (.except private type) ["[0]" ffi (.only import)] [abstract ["[0]" monad (.only do)]] @@ -81,7 +81,7 @@ ("static" isArray [.Any] ffi.Boolean))) @.python - (these (type PyType + (these (.type PyType (Primitive "python_type")) (import (type [.Any] PyType)) @@ -385,7 +385,7 @@ (exception.report (list ["Type" (%.type type)]))) -(type Representation +(.type Representation (-> Any Text)) (def primitive_representation @@ -547,7 +547,7 @@ expectedT meta.expected_type] (function.constant (exception.except ..type_hole [location expectedT]))))) -(type Target +(.type Target [Text (Maybe Code)]) (def target diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index 66009f8ba..3f8561b78 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -18,8 +18,9 @@ ["[0]" static] ["[0]" code (.only) ["<[1]>" \\parser]] - ["[0]" macro (.only) - [syntax (.only syntax)]] + [macro + [syntax (.only syntax)] + ["[0]" expansion]] [target ["/" js]] [compiler @@ -88,7 +89,7 @@ (syntax (_ [exports (<>.many <code>.any)]) (let [! meta.monad] (|> exports - (monad.each ! macro.expansion) + (monad.each ! expansion.complete) (at ! each (|>> list#conjoint (monad.each ! ..definition))) (at ! conjoint) diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 30af57aa4..c00493f77 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -18,8 +18,9 @@ ["[0]" static] ["[0]" code (.only) ["<[1]>" \\parser]] - ["[0]" macro (.only) - [syntax (.only syntax)]] + [macro + [syntax (.only syntax)] + ["[0]" expansion]] [target ["/" lua]] [compiler @@ -104,7 +105,7 @@ (syntax (_ [exports (<>.many <code>.any)]) (let [! meta.monad] (|> exports - (monad.each ! macro.expansion) + (monad.each ! expansion.complete) (at ! each (|>> list#conjoint (monad.each ! ..definition))) (at ! conjoint) diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 370ed7a9d..7633ed73a 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -18,8 +18,9 @@ ["[0]" static] ["[0]" code (.only) ["<[1]>" \\parser]] - ["[0]" macro (.only) - [syntax (.only syntax)]] + [macro + [syntax (.only syntax)] + ["[0]" expansion]] [target ["/" python]] [compiler @@ -81,7 +82,7 @@ (syntax (_ [exports (<>.many <code>.any)]) (let [! meta.monad] (|> exports - (monad.each ! macro.expansion) + (monad.each ! expansion.complete) (at ! each (|>> list#conjoint (monad.each ! ..definition))) (at ! conjoint) diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 1558aad67..7a102720a 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -20,8 +20,9 @@ ["[0]" type] ["[0]" code (.only) ["<[1]>" \\parser]] - ["[0]" macro (.only) - [syntax (.only syntax)]] + [macro + [syntax (.only syntax)] + ["[0]" expansion]] [target ["/" ruby]] [compiler @@ -130,7 +131,7 @@ (syntax (_ [exports (<>.many <code>.any)]) (let [! meta.monad] (|> exports - (monad.each ! macro.expansion) + (monad.each ! expansion.complete) (at ! each (|>> list#conjoint (monad.each ! ..definition))) (at ! conjoint) diff --git a/stdlib/source/library/lux/ffi/node_js.js.lux b/stdlib/source/library/lux/ffi/node_js.js.lux index 1f3f2fb4a..3ee4c8d33 100644 --- a/stdlib/source/library/lux/ffi/node_js.js.lux +++ b/stdlib/source/library/lux/ffi/node_js.js.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except) + [lux (.except require) ["[0]" ffi] [control ["[0]" function] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux index 36047a0ed..09010717a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -57,7 +57,7 @@ ["[0]" parser] ["[0]" alias (.only Aliasing)] ["[0]T" lux (.only Mapping)]]]] - ["[0]" type (.only) + ["[0]" type (.use "[1]#[0]" equivalence) ["[0]" check (.only Check) (.use "[1]#[0]" monad)]]]]] ["[0]" // ["[1][0]" lux (.only custom)] @@ -92,7 +92,8 @@ (import java/lang/Object "[1]::[0]" - (equals [java/lang/Object] boolean)) + (equals [java/lang/Object] boolean) + (toString [] java/lang/String)) (import java/lang/reflect/Type "[1]::[0]") @@ -282,12 +283,12 @@ [too_many_candidates] ) -(exception .public (cannot_cast [from .Type - to .Type +(exception .public (cannot_cast [from (Type Value) + to (Type Value) value Code]) (exception.report - (list ["From" (%.type from)] - ["To" (%.type to)] + (list ["From" (..signature from)] + ["To" (..signature to)] ["Value" (%.code value)]))) (with_template [<name>] @@ -935,11 +936,11 @@ (in {/////analysis.#Extension extension_name (list (/////analysis.text sub_class) objectA)}) (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) -(def (class_candidate_parents class_loader source_name fromT target_name target_class) +(def (class_candidate_parents class_loader from_name fromT to_name to_class) (-> java/lang/ClassLoader External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) (do [! phase.monad] - [source_class (phase.lifted (reflection!.load class_loader source_name)) - mapping (phase.lifted (reflection!.correspond source_class fromT))] + [from_class (phase.lifted (reflection!.load class_loader from_name)) + mapping (phase.lifted (reflection!.correspond from_class fromT))] (monad.each ! (function (_ superJT) (do ! @@ -947,32 +948,16 @@ .let [super_name (..reflection superJT)] super_class (phase.lifted (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] - (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)]))) - (case (java/lang/Class::getGenericSuperclass source_class) + (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) + (case (java/lang/Class::getGenericSuperclass from_class) {.#Some super} - (list.partial super (array.list {.#None} (java/lang/Class::getGenericInterfaces source_class))) + (list.partial super (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))) {.#None} - (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers source_class)) + (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers from_class)) {.#Item (as java/lang/reflect/Type (ffi.class_for java/lang/Object)) - (array.list {.#None} (java/lang/Class::getGenericInterfaces source_class))} - (array.list {.#None} (java/lang/Class::getGenericInterfaces source_class))))))) - -(def (inheritance_candidate_parents class_loader fromT target_class toT fromC) - (-> java/lang/ClassLoader .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit]))) - (case fromT - {.#Primitive _ (list.partial self_classT super_classT super_interfacesT+)} - (monad.each phase.monad - (function (_ superT) - (do [! phase.monad] - [super_name (at ! each ..reflection (check_jvm superT)) - super_class (phase.lifted (reflection!.load class_loader super_name))] - (in [[super_name superT] - (java/lang/Class::isAssignableFrom super_class target_class)]))) - (list.partial super_classT super_interfacesT+)) - - _ - (/////analysis.except ..cannot_cast [fromT toT fromC]))) + (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))} + (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))))))) (def (object::cast class_loader) (-> java/lang/ClassLoader Handler) @@ -981,18 +966,20 @@ (list fromC) (do [! phase.monad] [toT (///.lifted meta.expected_type) - target_name (at ! each ..reflection (check_jvm toT)) + toJT (check_jvm toT) [fromT fromA] (typeA.inferring (analyse archive fromC)) - source_name (at ! each ..reflection (check_jvm fromT)) + fromJT (check_jvm fromT) + .let [from_name (..reflection fromJT) + to_name (..reflection toJT)] can_cast? (is (Operation Bit) (`` (cond (,, (with_template [<primitive> <object>] [(let [=primitive (reflection.reflection <primitive>)] - (or (and (text#= =primitive source_name) - (or (text#= <object> target_name) - (text#= =primitive target_name))) - (and (text#= <object> source_name) - (text#= =primitive target_name)))) + (or (and (text#= =primitive from_name) + (or (text#= <object> to_name) + (text#= =primitive to_name))) + (and (text#= <object> from_name) + (text#= =primitive to_name)))) (in true)] [reflection.boolean box.boolean] @@ -1006,34 +993,39 @@ ... else (do ! - [_ (phase.assertion ..primitives_are_not_objects [source_name] - (not (dictionary.key? ..boxes source_name))) - _ (phase.assertion ..primitives_are_not_objects [target_name] - (not (dictionary.key? ..boxes target_name))) - target_class (phase.lifted (reflection!.load class_loader target_name)) - _ (do ! - [source_class (phase.lifted (reflection!.load class_loader source_name))] - (phase.assertion ..cannot_cast [fromT toT fromC] - (java/lang/Class::isAssignableFrom source_class target_class)))] - (loop (again [[current_name currentT] [source_name fromT]]) - (if (text#= target_name current_name) - (in true) - (do ! - [candidate_parents (is (Operation (List [[Text .Type] Bit])) - (class_candidate_parents class_loader current_name currentT target_name target_class))] - (case (|> candidate_parents - (list.only product.right) - (list#each product.left)) - {.#Item [next_name nextT] _} - (again [next_name nextT]) - - {.#End} - (in false)))))))))] + [_ (phase.assertion ..primitives_are_not_objects [from_name] + (not (dictionary.key? ..boxes from_name))) + _ (phase.assertion ..primitives_are_not_objects [to_name] + (not (dictionary.key? ..boxes to_name))) + to_class (phase.lifted (reflection!.load class_loader to_name)) + from_class (phase.lifted (reflection!.load class_loader from_name))] + (if (java/lang/Class::isAssignableFrom from_class to_class) + (loop (again [[current_name currentT] [from_name fromT]]) + (if (text#= to_name current_name) + (in true) + (do ! + [candidate_parents (is (Operation (List [[Text .Type] Bit])) + (class_candidate_parents class_loader current_name currentT to_name to_class))] + (case (|> candidate_parents + (list.only product.right) + (list#each product.left)) + {.#Item [next_name nextT] _} + (again [next_name nextT]) + + {.#End} + (in false))))) + (in (case [(type#= java/lang/Object fromT) + (parser.array? toJT)] + [#1 {.#Some _}] + true + + _ + false)))))))] (if can_cast? - (in {/////analysis.#Extension extension_name (list (/////analysis.text source_name) - (/////analysis.text target_name) + (in {/////analysis.#Extension extension_name (list (/////analysis.text from_name) + (/////analysis.text to_name) fromA)}) - (/////analysis.except ..cannot_cast [fromT toT fromC]))) + (/////analysis.except ..cannot_cast [fromJT toJT fromC]))) _ (/////analysis.except ///.invalid_syntax [extension_name %.code args])))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux index 270ff3256..437f6624d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux @@ -796,7 +796,7 @@ @array//delete )) -(def runtime +(def full Statement (all _.then runtime//structure @@ -814,13 +814,13 @@ (def .public generate (Operation [Registry Output]) (do ///////phase.monad - [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id {.#None} ..runtime)] + [_ (/////generation.execute! ..full) + _ (/////generation.save! ..module_id {.#None} ..full)] (in [(|> registry.empty (registry.resource true unit.none) product.right) (sequence.sequence [..module_id {.#None} - (|> ..runtime + (|> ..full _.code (at utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux index 8a124aadc..e8ba62726 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux @@ -427,7 +427,7 @@ @array//write )) -(def runtime +(def full Statement (all _.then ..runtime//adt @@ -440,13 +440,13 @@ (def .public generate (Operation [Registry Output]) (do ///////phase.monad - [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id {.#None} ..runtime)] + [_ (/////generation.execute! ..full) + _ (/////generation.save! ..module_id {.#None} ..full)] (in [(|> registry.empty (registry.resource true unit.none) product.right) (sequence.sequence [..module_id {.#None} - (|> ..runtime + (|> ..full _.code (at utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux index 194b97c7e..b193b5b84 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -595,11 +595,11 @@ @array//write )) -(def runtime +(def full Statement (all _.then (_.when ..mruby? - ... We're in DragonRuby territory. + ... We're in mRuby/DragonRuby territory. (_.statement (_.do "class_eval" (list) {.#Some [(list (_.local "_")) (_.statement @@ -617,13 +617,13 @@ (def .public generate (Operation [Registry Output]) (do ///////phase.monad - [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id {.#None} ..runtime)] + [_ (/////generation.execute! ..full) + _ (/////generation.save! ..module_id {.#None} ..full)] (in [(|> registry.empty (registry.resource true unit.none) product.right) (sequence.sequence [..module_id {.#None} - (|> ..runtime + (|> ..full _.code (at utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/meta/macro/pattern.lux b/stdlib/source/library/lux/meta/macro/pattern.lux index 4c78c8c36..367c77bd4 100644 --- a/stdlib/source/library/lux/meta/macro/pattern.lux +++ b/stdlib/source/library/lux/meta/macro/pattern.lux @@ -11,8 +11,8 @@ ["[0]" try]] [data [collection - ["[0]" list (.use "[1]#[0]" monoid monad)]]]]] - ["[0]" // (.only) + ["[0]" list (.use "[1]#[0]" monoid monad mix)]]]]] + ["[0]" // (.only with_symbols) [vocabulary (.only vocabulary)] ["/[1]" // (.use "[1]#[0]" monad)]]) @@ -40,7 +40,6 @@ [tuple_list] [text$] - [generated_symbol] [type_definition] [record_slots] [text#composite] @@ -50,8 +49,6 @@ [tuple$] [zipped_2] - [multi_level_case^] - [multi_level_case$] [type_code] [expected_type] @@ -116,35 +113,81 @@ _ (///.failure (..wrong_syntax_error (symbol ..with_template))))))) +(type Level + [Code Code]) + +(def (level it) + (-> Code (Meta Level)) + (///#in (case it + [_ {.#Tuple (list expr binding)}] + [expr binding] + + _ + [it (.` #1)]))) + +(type Multi + [Code (List Level)]) + +(def (multiP levels) + (-> (List Code) (Meta Multi)) + (case levels + {.#End} + (///.failure "Multi-level patterns cannot be empty.") + + {.#Item init extras} + (do ///.monad + [extras' (monad.each ///.monad ..level extras)] + (in [init extras'])))) + +(def (multiG g!_ [[init_pattern levels] body]) + (-> Code [Multi Code] (List Code)) + (.let [inner_pattern_body (list#mix (function (_ [calculation pattern] success) + (.let [bind? (case pattern + [_ {.#Symbol _}] + #1 + + _ + #0)] + (.` (case (., calculation) + (., pattern) + (., success) + + (.,* (if bind? + (list) + (list g!_ (.` {.#None})))))))) + (.` {.#Some (., body)}) + (list.reversed levels))] + (list init_pattern inner_pattern_body))) + (def .public multi (pattern (macro (_ tokens) (case tokens (list.partial [_meta {.#Form levels}] body next_branches) - (do ///.monad - [mlc (multi_level_case^ levels) - .let [initial_bind? (case mlc - [[_ {.#Symbol _}] _] - #1 - - _ - #0)] - expected ..expected_type - g!temp (..generated_symbol "temp")] - (in (list g!temp - (.` ({{.#Some (., g!temp)} - (., g!temp) - - {.#None} - (.case (., g!temp) - (.,* next_branches))} - ("lux type check" {.#Apply (., (type_code expected)) Maybe} - (.case (., g!temp) - (.,* (multi_level_case$ g!temp [mlc body])) - - (.,* (if initial_bind? - (list) - (list g!temp (.` {.#None}))))))))))) + (with_symbols [g!temp] + (do ///.monad + [mlc (multiP levels) + .let [initial_bind? (case mlc + [[_ {.#Symbol _}] _] + #1 + + _ + #0)] + expected ..expected_type] + (in (list g!temp + (.` ({{.#Some (., g!temp)} + (., g!temp) + + {.#None} + (.case (., g!temp) + (.,* next_branches))} + ("lux type check" {.#Apply (., (type_code expected)) Maybe} + (.case (., g!temp) + (.,* (multiG g!temp [mlc body])) + + (.,* (if initial_bind? + (list) + (list g!temp (.` {.#None})))))))))))) _ (///.failure (..wrong_syntax_error (symbol ..multi))))))) @@ -237,12 +280,11 @@ (def (untemplated_pattern pattern) (-> Code (Meta Code)) - (do ///.monad - [g!meta (..generated_symbol "g!meta")] + (with_symbols [g!meta] (case pattern (..with_template [<tag> <gen>] [[_ {<tag> value}] - (in (.` [(., g!meta) {<tag> (., (<gen> value))}]))]) + (///#in (.` [(., g!meta) {<tag> (., (<gen> value))}]))]) ([.#Bit bit$] [.#Nat nat$] [.#Int int$] @@ -252,11 +294,11 @@ [.#Symbol name$]) [@composite {.#Form {.#Item [@global {.#Symbol global}] parameters}}] - (do ///.monad + (do [! ///.monad] [micro (///.try (..named_unquote global))] (case micro {try.#Success micro} - (do ///.monad + (do ! [[_ output] (..one_expansion ((//.function micro) parameters))] (in [@composite output])) |