From 5232f0701cd95f260005a65d220a361dd71b6b96 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Jun 2022 02:28:21 -0400 Subject: Better syntax for calling virtual methods when defining JVM classes. --- stdlib/source/library/lux/abstract/predicate.lux | 61 ---- .../source/library/lux/control/function/mixin.lux | 6 +- .../library/lux/control/function/predicate.lux | 60 ++++ .../source/library/lux/data/collection/array.lux | 6 +- stdlib/source/library/lux/data/collection/list.lux | 4 +- .../library/lux/data/collection/sequence.lux | 7 +- stdlib/source/library/lux/data/collection/set.lux | 4 +- .../library/lux/data/collection/tree/finger.lux | 4 +- stdlib/source/library/lux/data/format/json.lux | 5 +- stdlib/source/library/lux/ffi.jvm.lux | 395 ++++++++++----------- stdlib/source/library/lux/macro/context.lux | 7 +- stdlib/source/library/lux/math/logic/fuzzy.lux | 4 +- stdlib/source/library/lux/math/number/frac.lux | 161 ++++----- stdlib/source/library/lux/math/number/int.lux | 5 +- .../language/lux/phase/extension/analysis/jvm.lux | 7 +- .../library/lux/tool/compiler/meta/cache/purge.lux | 5 +- .../library/lux/tool/compiler/meta/io/context.lux | 5 +- stdlib/source/library/lux/type/refinement.lux | 5 +- stdlib/source/library/lux/world/file/watch.lux | 5 +- 19 files changed, 377 insertions(+), 379 deletions(-) delete mode 100644 stdlib/source/library/lux/abstract/predicate.lux create mode 100644 stdlib/source/library/lux/control/function/predicate.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux deleted file mode 100644 index 1fa3a3dc4..000000000 --- a/stdlib/source/library/lux/abstract/predicate.lux +++ /dev/null @@ -1,61 +0,0 @@ -(.require - [library - [lux (.except all or and) - [control - ["[0]" function]]]] - [// - [monoid (.only Monoid)] - [functor - ["[0]" contravariant]]]) - -(type .public (Predicate a) - (-> a Bit)) - -(with_template [ ] - [(def .public - Predicate - (function.constant )) - - (def .public ( left right) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) - (function (_ value) - ( (left value) - (right value))))] - - [none #0 or .or] - [all #1 and .and] - ) - -(with_template [ ] - [(def .public - (All (_ a) (Monoid (Predicate a))) - (implementation - (def identity ) - (def composite )))] - - [union ..none ..or] - [intersection ..all ..and] - ) - -(def .public (complement predicate) - (All (_ a) (-> (Predicate a) (Predicate a))) - (|>> predicate not)) - -(def .public (difference sub base) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) - (function (_ value) - (.and (base value) - (not (sub value))))) - -(def .public (rec predicate) - (All (_ a) - (-> (-> (Predicate a) (Predicate a)) - (Predicate a))) - (function (again input) - (predicate again input))) - -(def .public functor - (contravariant.Functor Predicate) - (implementation - (def (each f fb) - (|>> f fb)))) diff --git a/stdlib/source/library/lux/control/function/mixin.lux b/stdlib/source/library/lux/control/function/mixin.lux index 113d17fa9..36610827b 100644 --- a/stdlib/source/library/lux/control/function/mixin.lux +++ b/stdlib/source/library/lux/control/function/mixin.lux @@ -6,8 +6,10 @@ [lux (.except) [abstract [monoid (.only Monoid)] - [predicate (.only Predicate)] - [monad (.only Monad do)]]]]) + [monad (.only Monad do)]] + [control + [function + [predicate (.only Predicate)]]]]]) (type .public (Mixin i o) (-> (-> i o) (-> i o) (-> i o))) diff --git a/stdlib/source/library/lux/control/function/predicate.lux b/stdlib/source/library/lux/control/function/predicate.lux new file mode 100644 index 000000000..131a6520f --- /dev/null +++ b/stdlib/source/library/lux/control/function/predicate.lux @@ -0,0 +1,60 @@ +(.require + [library + [lux (.except all or and) + [abstract + [monoid (.only Monoid)] + [functor + ["[0]" contravariant]]]]] + ["[0]" //]) + +(type .public (Predicate a) + (-> a Bit)) + +(with_template [ ] + [(def .public + Predicate + (//.constant )) + + (def .public ( left right) + (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (function (_ value) + ( (left value) + (right value))))] + + [none #0 or .or] + [all #1 and .and] + ) + +(with_template [ ] + [(def .public + (All (_ a) (Monoid (Predicate a))) + (implementation + (def identity ) + (def composite )))] + + [union ..none ..or] + [intersection ..all ..and] + ) + +(def .public (complement predicate) + (All (_ a) (-> (Predicate a) (Predicate a))) + (|>> predicate not)) + +(def .public (difference sub base) + (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (function (_ value) + (.and (base value) + (not (sub value))))) + +(def .public (rec predicate) + (All (_ a) + (-> (-> (Predicate a) (Predicate a)) + (Predicate a))) + (function (again input) + (predicate again input))) + +(def .public functor + (contravariant.Functor Predicate) + (implementation + (def (each f fb) + (|>> f fb)))) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index 54206f22a..06704ae38 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -5,8 +5,10 @@ [monoid (.only Monoid)] [functor (.only Functor)] [equivalence (.only Equivalence)] - [mix (.only Mix)] - [predicate (.only Predicate)]] + [mix (.only Mix)]] + [control + [function + [predicate (.only Predicate)]]] [data [collection ["[0]" list]]] diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 55363092b..478a3d6aa 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -8,10 +8,12 @@ [equivalence (.only Equivalence)] [hash (.only Hash)] [mix (.only Mix)] - [predicate (.only Predicate)] ["[0]" functor (.only Functor)] ["[0]" monad (.only Monad do)] ["[0]" enum]] + [control + [function + [predicate (.only Predicate)]]] [data ["[0]" bit] ["[0]" product]] diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 3d5dfd300..1f5186289 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -11,13 +11,14 @@ [monad (.only Monad do)] [equivalence (.only Equivalence)] [monoid (.only Monoid)] - [mix (.only Mix)] - [predicate (.only Predicate)]] + [mix (.only Mix)]] [control ["<>" parser] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only exception)] + [function + [predicate (.only Predicate)]]] [data ["[0]" product] [collection diff --git a/stdlib/source/library/lux/data/collection/set.lux b/stdlib/source/library/lux/data/collection/set.lux index f78afec97..049acac93 100644 --- a/stdlib/source/library/lux/data/collection/set.lux +++ b/stdlib/source/library/lux/data/collection/set.lux @@ -4,8 +4,10 @@ [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] - [predicate (.only Predicate)] [monoid (.only Monoid)]] + [control + [function + [predicate (.only Predicate)]]] [data [collection ["[0]" list (.use "[1]#[0]" mix)]]] diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux index 7d981c667..72ef03d8e 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -2,8 +2,10 @@ [library [lux (.except) [abstract - [predicate (.only Predicate)] ["[0]" monoid (.only Monoid)]] + [control + [function + [predicate (.only Predicate)]]] [data [collection ["[0]" list (.use "[1]#[0]" monoid)]]] diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 3f14a9599..2bb8638fb 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -5,13 +5,14 @@ [abstract [equivalence (.only Equivalence)] [codec (.only Codec)] - [predicate (.only Predicate)] ["[0]" monad (.only do)]] [control ["<>" parser (.use "[1]#[0]" monad)] ["[0]" pipe] ["[0]" maybe] - ["[0]" try (.only Try)]] + ["[0]" try (.only Try)] + [function + [predicate (.only Predicate)]]] [data ["[0]" bit] ["[0]" product] diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 12cbdc539..a31b1df99 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -412,97 +412,10 @@ (-> (Type Declaration) Code) (|>> ..signature code.text)) -(def (replaced f input) - (-> (-> Code Code) Code Code) - (case (f input) - (^.with_template [] - [[meta { parts}] - [meta { (list#each (replaced f) parts)}]]) - ([.#Form] - [.#Variant] - [.#Tuple]) - - ast' - ast')) - -(def (parser->replacer p ast) - (-> (Parser Code) (-> Code Code)) - (case (<>.result p (list ast)) - {.#Right [{.#End} ast']} - ast' - - _ - ast - )) - (def (decorate_input [class value]) (-> [(Type Value) Code] Code) (` [(~ (code.text (..signature class))) (~ value)])) -(def (constructor_parser class_name arguments) - (-> Text (List Argument) (Parser Code)) - (do <>.monad - [args (.is (Parser (List Code)) - (.form (<>.after (.this (' ::new!)) - (.tuple (<>.exactly (list.size arguments) .any)))))] - (in (` ("jvm member invoke constructor" (~ (code.text class_name)) - (~+ (|> args - (list.zipped_2 (list#each product.right arguments)) - (list#each ..decorate_input)))))))) - -(def (static_method_parser class_name method_name arguments) - (-> Text Text (List Argument) (Parser Code)) - (do <>.monad - [.let [dotted_name (format "::" method_name "!")] - args (.is (Parser (List Code)) - (.form (<>.after (.this (code.symbol ["" dotted_name])) - (.tuple (<>.exactly (list.size arguments) .any)))))] - (in (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name)) - (~+ (|> args - (list.zipped_2 (list#each product.right arguments)) - (list#each ..decorate_input)))))))) - -(with_template [ ] - [(def ( class_vars class_name type_vars method_name arguments self_name) - (-> (List (Type Var)) Text (List (Type Var)) Text (List Argument) Text (Parser Code)) - (do <>.monad - [.let [dotted_name (format "::" method_name "!")] - args (.is (Parser (List Code)) - (.form (<>.after (.this (code.symbol ["" dotted_name])) - (.tuple (<>.exactly (list.size arguments) .any)))))] - (in (` ( [(~+ (list#each (|>> ..signature code.text) class_vars))] - (~ (code.text class_name)) (~ (code.text method_name)) - [(~+ (list#each (|>> ..signature code.text) type_vars))] - (~ (code.local self_name)) - (~+ (|> args - (list.zipped_2 (list#each product.right arguments)) - (list#each ..decorate_input))))))))] - - [special_method_parser "jvm member invoke special"] - [virtual_method_parser "jvm member invoke virtual"] - ) - -(def (method->parser class_vars class_name [[method_name _ _] meth_def]) - (-> (List (Type Var)) Text [Member_Declaration Method_Definition] (Parser Code)) - (case meth_def - {#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs} - (constructor_parser class_name args) - - {#StaticMethod strict? type_vars args return_type return_expr exs} - (static_method_parser class_name method_name args) - - {#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs} - (virtual_method_parser class_vars class_name type_vars method_name args self_name) - - {#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs} - (special_method_parser class_vars class_name type_vars method_name args self_name) - - {#AbstractMethod type_vars args return_type exs} - (virtual_method_parser class_vars class_name type_vars method_name args "") - - {#NativeMethod type_vars args return_type exs} - (virtual_method_parser class_vars class_name type_vars method_name args ""))) - (def privacy_modifier^ (Parser Privacy) (let [(open "[0]") <>.monad] @@ -1059,8 +972,7 @@ (.type Super [[External (List (Type Var))] - [Member_Declaration MethodDecl] - Text]) + [Member_Declaration MethodDecl]]) (context.def [super_context super_expression super_declaration] Super) @@ -1107,14 +1019,13 @@ [(~+ (list#each class$ #method_exs))])))) (def with_super - (syntax (_ [declaration,method,self (.tuple - (all <>.and - (.then parser.declaration' .text) - method_decl^^ - .text)) + (syntax (_ [declaration,method (.tuple + (all <>.and + (.then parser.declaration' .text) + method_decl^^)) body .any]) (do meta.monad - [body (super_expression declaration,method,self body)] + [body (super_expression declaration,method body)] (in (list body))))) (exception .public (insufficient_parameters [expected Nat @@ -1124,9 +1035,10 @@ "Actual" (%.nat actual))) (def .public super - (syntax (_ [inputs (<>.some .any)]) + (syntax (_ [inputs (.tuple (<>.some .any)) + self .any]) (do meta.monad - [[[super_name super_vars] [member method] self] (context.peek ..super_context) + [[[super_name super_vars] [member method]] (context.peek ..super_context) .let [expected_arguments (list.size (the #method_inputs method)) actual_arguments (list.size inputs)]] (if (n.= expected_arguments actual_arguments) @@ -1135,7 +1047,7 @@ (~ (code.text super_name)) (~ (code.text (the #member_name member))) [(~+ (list#each (|>> ..signature code.text) (the #method_tvars method)))] - ("jvm object cast" (~ (code.local self))) + ("jvm object cast" (~ self)) (~+ (|> inputs (list#each (|>> ~ "jvm object cast" `)) (list.zipped_2 (the #method_inputs method)) @@ -1144,8 +1056,7 @@ (.type Get|Set [External - (List [Member_Declaration FieldDecl]) - Text]) + (List [Member_Declaration FieldDecl])]) (context.def [get|set_context get|set_expression get|set_declaration] Get|Set) @@ -1185,54 +1096,62 @@ (in [[name pm anns] {#VariableField [sm static? type]}]))))) (def with_get|set - (syntax (_ [declaration,fields,self (.tuple - (all <>.and - .text - (.tuple (<>.some field_decl^^)) - .text)) + (syntax (_ [declaration,fields (.tuple + (all <>.and + .text + (.tuple (<>.some field_decl^^)))) body .any]) (do meta.monad - [body (get|set_expression declaration,fields,self body)] + [body (get|set_expression declaration,fields body)] (in (list body))))) -(with_template [] +(with_template [ ] [(exception .public ( [class Text - field Text]) + member Text]) (exception.report "Class" (%.text class) - "Field" (%.text field)))] + (%.text member)))] - [cannot_get_field] - [cannot_set_field] + ["Field" cannot_get_field] + ["Field" cannot_set_field] + ["Member" cannot_call_method] ) (def .public get - (syntax (_ [field .local]) + (syntax (_ [field .local + this (<>.maybe .any)]) (do meta.monad - [[class_name member,field/* self] (context.peek ..get|set_context) + [[class_name member,field/*] (context.peek ..get|set_context) .let [fields (|> member,field/* (list#each (function (_ [member field]) [(the #member_name member) [member field]])) (dictionary.of_list text.hash))]] (case (dictionary.value field fields) {.#Some [member {#VariableField _ static? :field:}]} - (in (list (if static? - (` ("jvm member get static" + (case [static? this] + [#1 {.#None}] + (in (list (` ("jvm member get static" (~ (code.text class_name)) - (~ (code.text (the #member_name member))))) - (` ("jvm member get virtual" + (~ (code.text (the #member_name member))))))) + + [#0 {.#Some this}] + (in (list (` ("jvm member get virtual" (~ (code.text class_name)) (~ (code.text (the #member_name member))) - (~ (code.local self))))))) + (~ this))))) + + _ + (meta.failure (exception.error ..cannot_get_field [class_name field]))) _ (meta.failure (exception.error ..cannot_get_field [class_name field])))))) (def .public set (syntax (_ [field .local - value .any]) + value .any + this (<>.maybe .any)]) (do meta.monad - [[class_name member,field/* self] (context.peek ..get|set_context) + [[class_name member,field/*] (context.peek ..get|set_context) .let [fields (|> member,field/* (list#each (function (_ [member field]) [(the #member_name member) [member field]])) @@ -1244,105 +1163,168 @@ (meta.failure (exception.error ..cannot_set_field [class_name field])) _ - (in (list (if static? - (` ("jvm member put static" + (case [static? this] + [#1 {.#None}] + (in (list (` ("jvm member put static" (~ (code.text class_name)) (~ (code.text (the #member_name member))) - (~ value))) - (` ("jvm member put virtual" + (~ value))))) + + [#0 {.#Some this}] + (in (list (` ("jvm member put virtual" (~ (code.text class_name)) (~ (code.text (the #member_name member))) (~ value) - (~ (code.local self)))))))) + (~ this))))) + + _ + (meta.failure (exception.error ..cannot_set_field [class_name field])))) _ (meta.failure (exception.error ..cannot_set_field [class_name field])))))) -(def (method_def$ fully_qualified_class_name method_parser super_class fields [method_declaration method_def]) - (-> External (Parser Code) (Type Class) (List [Member_Declaration FieldDecl]) [Member_Declaration Method_Definition] (Meta Code)) - (let [[name pm anns] method_declaration] +(.type Call + [[External (List (Type Var))] + (List [Member_Declaration MethodDecl])]) + +(context.def [call_context call_expression call_declaration] + Call) + +(def with_call + (syntax (_ [declaration,methods (.tuple + (all <>.and + (.then parser.declaration' .text) + (.tuple (<>.some method_decl^^)))) + body .any]) + (do meta.monad + [body (call_expression declaration,methods body)] + (in (list body))))) + +(def .public call + (syntax (_ [method .local + inputs (.tuple (<>.some .any)) + self .any]) + (do meta.monad + [[[class_name class_vars] member,virtual/*] (context.peek ..call_context) + .let [virtuals (|> member,virtual/* + (list#each (function (_ [member virtual]) + [(the #member_name member) [member virtual]])) + (dictionary.of_list text.hash))]] + (case (dictionary.value method virtuals) + {.#Some [member method]} + (let [expected_arguments (list.size (the #method_inputs method)) + actual_arguments (list.size inputs)] + (if (n.= expected_arguments actual_arguments) + (in (list (` ("jvm member invoke virtual" + [(~+ (list#each (|>> ..signature code.text) class_vars))] + (~ (code.text class_name)) + (~ (code.text (the #member_name member))) + [(~+ (list#each (|>> ..signature code.text) (the #method_tvars method)))] + ("jvm object cast" (~ self)) + (~+ (|> inputs + (list#each (|>> ~ "jvm object cast" `)) + (list.zipped_2 (the #method_inputs method)) + (list#each ..decorate_input))))))) + (meta.failure (exception.error ..insufficient_parameters [expected_arguments actual_arguments])))) + + _ + (meta.failure (exception.error ..cannot_call_method [class_name method])))))) + +(def (method_declaration [member definition]) + (-> [Member_Declaration Method_Definition] + (Maybe [Member_Declaration MethodDecl])) + (case definition + {#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs} + {.#Some [member + [#method_tvars type_vars + #method_inputs (list#each product.right arguments) + #method_output return_type + #method_exs exs]]} + + _ + {.#None})) + +(def (method_def$ fully_qualified_class_name class_vars super_class fields methods [method_declaration method_def]) + (-> External (List (Type Var)) (Type Class) (List [Member_Declaration FieldDecl]) (List [Member_Declaration Method_Definition]) [Member_Declaration Method_Definition] (Meta Code)) + (let [[name pm anns] method_declaration + virtual_methods (case (list.all ..method_declaration methods) + {.#End} + (list) + + virtual_methods + (list (` ((~! ..with_call) [(~ (declaration$ (jvm.declaration fully_qualified_class_name class_vars))) + [(~+ (list#each method_decl$$ virtual_methods))]]))))] (case method_def {#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs} - (let [replacer (|> (list) - (list#mix <>.either method_parser) - parser->replacer)] - (meta#in (` ("init" - (~ (privacy_modifier$ pm)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - [(~+ (list#each class$ exs))] - (~ (code.text self_name)) - [(~+ (list#each argument$ arguments))] - [(~+ (list#each constructor_arg$ constructor_args))] - (<| ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) - [(~+ (list#each field_decl$ fields))] - (~ (code.text self_name))]) - (~ (replaced replacer body))) - )))) + (meta#in (` ("init" + (~ (privacy_modifier$ pm)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + [(~+ (list#each class$ exs))] + (~ (code.text self_name)) + [(~+ (list#each argument$ arguments))] + [(~+ (list#each constructor_arg$ constructor_args))] + (<| ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) + [(~+ (list#each field_decl$ fields))]]) + (~+ virtual_methods) + (~ body)) + ))) {#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs} - (let [replacer (|> (list) - (list#mix <>.either method_parser) - parser->replacer)] - (meta#in (` ("virtual" - (~ (code.text name)) - (~ (privacy_modifier$ pm)) - (~ (code.bit final?)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - (~ (code.text self_name)) - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))] - (<| ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) - [(~+ (list#each field_decl$ fields))] - (~ (code.text self_name))]) - (~ (replaced replacer body))) - )))) + (meta#in (` ("virtual" + (~ (code.text name)) + (~ (privacy_modifier$ pm)) + (~ (code.bit final?)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + (~ (code.text self_name)) + [(~+ (list#each argument$ arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))] + (<| ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) + [(~+ (list#each field_decl$ fields))]]) + (~+ virtual_methods) + (~ body)) + ))) {#OverridenMethod strict_fp? declaration type_vars self_name expected_arguments return_type body exs} - (let [replacer (|> (list) - (list#mix <>.either method_parser) - parser->replacer)] - (do meta.monad - [@ meta.current_module_name] - (in (` ("override" - (~ (declaration$ declaration)) - (~ (code.text name)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - (~ (code.text self_name)) - [(~+ (list#each argument$ expected_arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))] - (<| ((~! ..with_super) [(~ (declaration$ declaration)) - (~ (method_decl$$ [method_declaration - [#method_tvars type_vars - #method_inputs (list#each product.right expected_arguments) - #method_output return_type - #method_exs exs]])) - (~ (code.text self_name))]) - ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) - [(~+ (list#each field_decl$ fields))] - (~ (code.text self_name))]) - (~ (replaced replacer body))) - ))))) + (do meta.monad + [@ meta.current_module_name] + (in (` ("override" + (~ (declaration$ declaration)) + (~ (code.text name)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + (~ (code.text self_name)) + [(~+ (list#each argument$ expected_arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))] + (<| ((~! ..with_super) [(~ (declaration$ declaration)) + (~ (method_decl$$ [method_declaration + [#method_tvars type_vars + #method_inputs (list#each product.right expected_arguments) + #method_output return_type + #method_exs exs]]))]) + ((~! ..with_get|set) [(~ (code.text fully_qualified_class_name)) + [(~+ (list#each field_decl$ fields))]]) + (~+ virtual_methods) + (~ body)) + )))) {#StaticMethod strict_fp? type_vars arguments return_type body exs} - (let [replacer (parser->replacer (<>.failure ""))] - (meta#in (` ("static" - (~ (code.text name)) - (~ (privacy_modifier$ pm)) - (~ (code.bit strict_fp?)) - [(~+ (list#each annotation$ anns))] - [(~+ (list#each var$ type_vars))] - [(~+ (list#each argument$ arguments))] - (~ (return$ return_type)) - [(~+ (list#each class$ exs))] - (~ (replaced replacer body)))))) + (meta#in (` ("static" + (~ (code.text name)) + (~ (privacy_modifier$ pm)) + (~ (code.bit strict_fp?)) + [(~+ (list#each annotation$ anns))] + [(~+ (list#each var$ type_vars))] + [(~+ (list#each argument$ arguments))] + (~ (return$ return_type)) + [(~+ (list#each class$ exs))] + (~ body)))) {#AbstractMethod type_vars arguments return_type exs} (meta#in (` ("abstract" @@ -1385,12 +1367,7 @@ fields (<>.some (..field_decl^ class_vars)) methods (<>.some (..method_def^ class_vars))]) (do meta.monad - [.let [fully_qualified_class_name full_class_name - method_parser (.is (Parser Code) - (|> methods - (list#each (method->parser class_vars fully_qualified_class_name)) - (list#mix <>.either (<>.failure ""))))] - methods (monad.each ! (method_def$ fully_qualified_class_name method_parser super fields) methods)] + [methods (monad.each ! (method_def$ full_class_name class_vars super fields methods) methods)] (in (list (` ("jvm class" (~ (declaration$ (jvm.declaration full_class_name class_vars))) (~ (class$ super)) @@ -1422,7 +1399,7 @@ constructor_args (..constructor_args^ class_vars) methods (<>.some ..overriden_method_def^)]) (do [! meta.monad] - [methods (monad.each ! (method_def$ "" (<>.failure "") super (list)) methods)] + [methods (monad.each ! (method_def$ "" (list) super (list) methods) methods)] (in (list (` ("jvm class anonymous" [(~+ (list#each var$ class_vars))] (~ (class$ super)) diff --git a/stdlib/source/library/lux/macro/context.lux b/stdlib/source/library/lux/macro/context.lux index 4d4224ccf..4b243e53a 100644 --- a/stdlib/source/library/lux/macro/context.lux +++ b/stdlib/source/library/lux/macro/context.lux @@ -2,12 +2,13 @@ [library [lux (.except def global) [abstract - [monad (.only do)] - ["[0]" predicate (.only Predicate)]] + [monad (.only do)]] [control ["?" parser] ["[0]" exception (.only exception)] - ["[0]" maybe]] + ["[0]" maybe] + [function + [predicate (.only Predicate)]]] [data ["[0]" text (.use "[1]#[0]" equivalence monoid)] [collection diff --git a/stdlib/source/library/lux/math/logic/fuzzy.lux b/stdlib/source/library/lux/math/logic/fuzzy.lux index b6f98a940..87f61bde3 100644 --- a/stdlib/source/library/lux/math/logic/fuzzy.lux +++ b/stdlib/source/library/lux/math/logic/fuzzy.lux @@ -3,9 +3,11 @@ [library [lux (.except) [abstract - [predicate (.only Predicate)] [functor ["[0]" contravariant]]] + [control + [function + [predicate (.only Predicate)]]] [data [collection ["[0]" list] diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 79dc77d92..a91d24bd8 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -7,12 +7,13 @@ [monoid (.only Monoid)] [equivalence (.only Equivalence)] [codec (.only Codec)] - [predicate (.only Predicate)] [order (.only Order)] [monad (.only do)]] [control ["[0]" maybe] - ["[0]" try (.only Try)]] + ["[0]" try (.only Try)] + [function + [predicate (.only Predicate)]]] [data ["[0]" text]] [macro @@ -40,19 +41,19 @@ (-> Frac Frac) ( it))] - [cos "jvm invokestatic:java.lang.Math:cos:double"] - [sin "jvm invokestatic:java.lang.Math:sin:double"] - [tan "jvm invokestatic:java.lang.Math:tan:double"] + [cos "jvm invokestatic:java.lang.Math:cos:double"] + [sin "jvm invokestatic:java.lang.Math:sin:double"] + [tan "jvm invokestatic:java.lang.Math:tan:double"] - [acos "jvm invokestatic:java.lang.Math:acos:double"] - [asin "jvm invokestatic:java.lang.Math:asin:double"] - [atan "jvm invokestatic:java.lang.Math:atan:double"] + [acos "jvm invokestatic:java.lang.Math:acos:double"] + [asin "jvm invokestatic:java.lang.Math:asin:double"] + [atan "jvm invokestatic:java.lang.Math:atan:double"] - [exp "jvm invokestatic:java.lang.Math:exp:double"] - [log "jvm invokestatic:java.lang.Math:log:double"] + [exp "jvm invokestatic:java.lang.Math:exp:double"] + [log "jvm invokestatic:java.lang.Math:log:double"] - [ceil "jvm invokestatic:java.lang.Math:ceil:double"] - [floor "jvm invokestatic:java.lang.Math:floor:double"] + [ceil "jvm invokestatic:java.lang.Math:ceil:double"] + [floor "jvm invokestatic:java.lang.Math:floor:double"] [root_2 "jvm invokestatic:java.lang.Math:sqrt:double"] [root_3 "jvm invokestatic:java.lang.Math:cbrt:double"] @@ -83,19 +84,19 @@ ("jvm member invoke static" [] "java.lang.Math" []) !frac))] - [cos "cos"] - [sin "sin"] - [tan "tan"] + [cos "cos"] + [sin "sin"] + [tan "tan"] - [acos "acos"] - [asin "asin"] - [atan "atan"] + [acos "acos"] + [asin "asin"] + [atan "atan"] - [exp "exp"] - [log "log"] + [exp "exp"] + [log "log"] - [ceil "ceil"] - [floor "floor"] + [ceil "ceil"] + [floor "floor"] [root_2 "sqrt"] [root_3 "cbrt"] @@ -115,19 +116,19 @@ ("js apply" ("js constant" )) (as Frac)))] - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] - [exp "Math.exp"] - [log "Math.log"] + [exp "Math.exp"] + [log "Math.log"] - [ceil "Math.ceil"] - [floor "Math.floor"] + [ceil "Math.ceil"] + [floor "Math.floor"] [root_2 "Math.sqrt"] [root_3 "Math.cbrt"] @@ -145,19 +146,19 @@ ("python object do" ("python import" "math")) (as Frac)))] - [cos "cos"] - [sin "sin"] - [tan "tan"] + [cos "cos"] + [sin "sin"] + [tan "tan"] - [acos "acos"] - [asin "asin"] - [atan "atan"] + [acos "acos"] + [asin "asin"] + [atan "atan"] - [exp "exp"] - [log "log"] + [exp "exp"] + [log "log"] - [ceil "ceil"] - [floor "floor"] + [ceil "ceil"] + [floor "floor"] [root_2 "sqrt"] ) @@ -184,19 +185,19 @@ ("lua apply" ("lua constant" )) (as Frac)))] - [cos "math.cos"] - [sin "math.sin"] - [tan "math.tan"] + [cos "math.cos"] + [sin "math.sin"] + [tan "math.tan"] - [acos "math.acos"] - [asin "math.asin"] - [atan "math.atan"] + [acos "math.acos"] + [asin "math.asin"] + [atan "math.atan"] - [exp "math.exp"] - [log "math.log"] + [exp "math.exp"] + [log "math.log"] - [ceil "math.ceil"] - [floor "math.floor"] + [ceil "math.ceil"] + [floor "math.floor"] [root_2 "math.sqrt"] ) @@ -223,16 +224,16 @@ ("ruby apply" ("ruby constant" )) (as Frac)))] - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] - [exp "Math.exp"] - [log "Math.log"] + [exp "Math.exp"] + [log "Math.log"] [root_2 "Math.sqrt"] [root_3 "Math.cbrt"] @@ -260,19 +261,19 @@ (|>> ("php apply" ("php constant" )) (as Frac)))] - [cos "cos"] - [sin "sin"] - [tan "tan"] + [cos "cos"] + [sin "sin"] + [tan "tan"] - [acos "acos"] - [asin "asin"] - [atan "atan"] + [acos "acos"] + [asin "asin"] + [atan "atan"] - [exp "exp"] - [log "log"] + [exp "exp"] + [log "log"] - [ceil "ceil"] - [floor "floor"] + [ceil "ceil"] + [floor "floor"] [root_2 "sqrt"] ) @@ -292,19 +293,19 @@ (|>> ("scheme apply" ("scheme constant" )) (as Frac)))] - [cos "cos"] - [sin "sin"] - [tan "tan"] + [cos "cos"] + [sin "sin"] + [tan "tan"] - [acos "acos"] - [asin "asin"] - [atan "atan"] + [acos "acos"] + [asin "asin"] + [atan "atan"] - [exp "exp"] - [log "log"] + [exp "exp"] + [log "log"] - [ceil "ceiling"] - [floor "floor"] + [ceil "ceiling"] + [floor "floor"] [root_2 "sqrt"] ) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 94ea3965e..29fc9d13e 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -8,11 +8,12 @@ [monoid (.only Monoid)] [equivalence (.only Equivalence)] [codec (.only Codec)] - [predicate (.only Predicate)] ["[0]" order (.only Order)]] [control ["[0]" maybe] - ["[0]" try (.only Try)]] + ["[0]" try (.only Try)] + [function + [predicate (.only Predicate)]]] [data [text (.only Char)]] [macro diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 9530cb8dd..d22d74aaf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -4,14 +4,15 @@ ["[0]" ffi (.only import)] ["[0]" meta] [abstract - ["[0]" monad (.only do)] - ["[0]" predicate]] + ["[0]" monad (.only do)]] [control ["<>" parser] ["[0]" pipe] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try) (.use "[1]#[0]" monad)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only exception)] + [function + ["[0]" predicate]]] [data [binary (.only Binary) ["[0]" \\format]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux index 885a3f5d4..801be1619 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux @@ -2,12 +2,13 @@ [library [lux (.except) [abstract - [predicate (.only Predicate)] ["[0]" monad (.only Monad do)]] [control ["[0]" try (.only Try) (.use "[1]#[0]" functor)] [concurrency - ["[0]" async (.only Async)]]] + ["[0]" async (.only Async)]] + [function + [predicate (.only Predicate)]]] [data ["[0]" text (.use "[1]#[0]" equivalence)] [collection diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux index 35b5aaf50..c62eb8345 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -3,14 +3,15 @@ [lux (.except Module Code) ["@" target] [abstract - [predicate (.only Predicate)] ["[0]" monad (.only Monad do)]] [control ["[0]" maybe] ["[0]" try (.only Try)] ["[0]" exception (.only exception)] [concurrency - ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] + ["[0]" async (.only Async) (.use "[1]#[0]" monad)]] + [function + [predicate (.only Predicate)]]] [data [binary (.only Binary)] ["[0]" text (.use "[1]#[0]" hash) diff --git a/stdlib/source/library/lux/type/refinement.lux b/stdlib/source/library/lux/type/refinement.lux index 3a7a2ef85..225edc957 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -1,8 +1,9 @@ (.require [library [lux (.except only type) - [abstract - [predicate (.only Predicate)]] + [control + [function + [predicate (.only Predicate)]]] ["[0]" macro (.only) [syntax (.only syntax)] ["[0]" code diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index e0f253259..d21036caa 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -4,7 +4,6 @@ ["@" target] ["[0]" ffi (.only import)] [abstract - [predicate (.only Predicate)] ["[0]" monad (.only do)]] [control ["[0]" io (.only IO)] @@ -13,7 +12,9 @@ ["[0]" exception (.only exception)] [concurrency ["[0]" async (.only Async)] - ["[0]" stm (.only STM Var)]]] + ["[0]" stm (.only STM Var)]] + [function + [predicate (.only Predicate)]]] [data ["[0]" product] ["[0]" text (.only) -- cgit v1.2.3