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/documentation/lux/type.lux | 316 ++++++++--------- stdlib/source/documentation/lux/type/check.lux | 120 +++---- stdlib/source/documentation/lux/type/dynamic.lux | 35 +- stdlib/source/documentation/lux/type/implicit.lux | 78 ++-- stdlib/source/documentation/lux/type/poly.lux | 13 +- stdlib/source/documentation/lux/type/primitive.lux | 219 ++++++------ stdlib/source/documentation/lux/type/quotient.lux | 58 ++- .../source/documentation/lux/type/refinement.lux | 73 ++-- stdlib/source/documentation/lux/type/resource.lux | 178 +++++----- stdlib/source/documentation/lux/type/unit.lux | 123 +++---- stdlib/source/documentation/lux/type/variance.lux | 22 +- 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 +- stdlib/source/specification/lux/world/file.lux | 7 +- stdlib/source/test/lux/abstract.lux | 4 +- stdlib/source/test/lux/abstract/predicate.lux | 91 ----- stdlib/source/test/lux/control/function.lux | 4 +- stdlib/source/test/lux/control/function/mixin.lux | 5 +- .../source/test/lux/control/function/predicate.lux | 91 +++++ stdlib/source/test/lux/data/binary.lux | 5 +- stdlib/source/test/lux/data/collection/bits.lux | 4 +- .../source/test/lux/data/collection/set/multi.lux | 4 +- stdlib/source/test/lux/ffi.jvm.lux | 22 +- stdlib/source/test/lux/math/modular.lux | 5 +- stdlib/source/test/lux/time/day.lux | 5 +- stdlib/source/test/lux/time/month.lux | 5 +- .../compiler/language/lux/analysis/coverage.lux | 5 +- stdlib/source/test/lux/type/refinement.lux | 5 +- stdlib/source/test/lux/world/file/watch.lux | 5 +- 46 files changed, 1083 insertions(+), 1175 deletions(-) delete mode 100644 stdlib/source/library/lux/abstract/predicate.lux create mode 100644 stdlib/source/library/lux/control/function/predicate.lux delete mode 100644 stdlib/source/test/lux/abstract/predicate.lux create mode 100644 stdlib/source/test/lux/control/function/predicate.lux (limited to 'stdlib') diff --git a/stdlib/source/documentation/lux/type.lux b/stdlib/source/documentation/lux/type.lux index 37322e9c0..a458db5d3 100644 --- a/stdlib/source/documentation/lux/type.lux +++ b/stdlib/source/documentation/lux/type.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except function as let) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format]]] @@ -21,173 +21,147 @@ ["[1][0]" unit] ["[1][0]" variance]]) -(with_template [] - [(documentation: - "The number of parameters, and the body, of a quantified type.")] - - [/.flat_univ_q] - [/.flat_ex_q] - ) - -(documentation: /.flat_function - "The input, and the output of a function type." - [(flat_function type)]) - -(documentation: /.flat_application - "The quantified type, and its parameters, for a type-application." - [(flat_application type)]) - -(with_template [] - [(documentation: - "The members of a composite type.")] - - [/.flat_variant] - [/.flat_tuple] - ) - -(documentation: /.format - "A (readable) textual representable of a type." - [(format type)]) - -(documentation: /.applied - "To the extend possible, applies a quantified type to the given parameters." - [(applied params func)]) - -(documentation: /.code - (%.format "A representation of a type as code." - \n "The code is such that evaluating it would yield the type value.") - [(code type)]) - -(documentation: /.de_aliased - "A (potentially named) type that does not have its name shadowed by other names." - [(de_aliased type)]) - -(documentation: /.anonymous - "A type without any names covering it." - [(anonymous type)]) - -(with_template [] - [(documentation: - "A composite type, constituted by the given member types.")] - - [/.variant] - [/.tuple] - ) - -(documentation: /.function - "A function type, with the given inputs and output." - [(function inputs output)]) - -(documentation: /.application - "An un-evaluated type application, with the given quantified type, and parameters." - [(application params quant)]) - -(with_template [] - [(documentation: - "A quantified type, with the given number of parameters, and body.")] - - [/.univ_q] - [/.ex_q] - ) - -(documentation: /.quantified? - "Only yields #1 for universally or existentially quantified types." - [(quantified? type)]) - -(documentation: /.array - "An array type, with the given level of nesting/depth, and the given element type." - [(array depth element_type)]) - -(documentation: /.flat_array - "The level of nesting/depth and element type for an array type." - [(flat_array type)]) - -(documentation: /.array? - "Is a type an array type?") - -(documentation: /.log! - "Logs to the console/terminal the type of an expression." - [(log! (is Foo (foo expression))) - "=>" - "Expression: (foo expression)" - " Type: Foo" - (foo expression)]) - -(documentation: /.as - (%.format "Casts a value to a specific type." - \n "The specified type can depend on type variables of the original type of the value." - \n "NOTE: Careless use of type-casts is an easy way to introduce bugs. USE WITH CAUTION.") - [(is (Bar Bit Nat Text) - (as [a b c] - (Foo a [b c]) - (Bar a b c) - (is (Foo Bit [Nat Text]) - (foo expression))))]) - -(documentation: /.sharing - "Allows specifing the type of an expression as sharing type-variables with the type of another expression." - [(is (Bar Bit Nat Text) - (sharing [a b c] - (is (Foo a [b c]) - (is (Foo Bit [Nat Text]) - (foo expression))) - (is (Bar a b c) - (bar expression))))]) - -(documentation: /.by_example - "Constructs a type that shares type-variables with an expression of some other type." - [(is Type - (by_example [a b c] - (is (Foo a [b c]) - (is (Foo Bit [Nat Text]) - (foo expression))) - (Bar a b c))) - "=>" - (.type_literal (Bar Bit Nat Text))]) - -(documentation: /.let - "Local bindings for types." - [(let [side (Either Int Frac)] - (List [side side]))]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "Basic functionality for working with types." - [..flat_univ_q - ..flat_ex_q - ..flat_function - ..flat_application - ..flat_variant - ..flat_tuple - ..format - ..applied - ..code - ..de_aliased - ..anonymous - ..variant - ..tuple - ..function - ..application - ..univ_q - ..ex_q - ..quantified? - ..array - ..flat_array - ..array? - ..log! - ..as - ..sharing - ..by_example - ..let - ($.default /.equivalence)] - [/primitive.documentation - /check.documentation - /dynamic.documentation - /implicit.documentation - /poly.documentation - /quotient.documentation - /refinement.documentation - /resource.documentation - /unit.documentation - /variance.documentation])) +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "Basic functionality for working with types." + [($.default /.equivalence) + + (~~ (with_template [] + [($.documentation + "The number of parameters, and the body, of a quantified type.")] + + [/.flat_univ_q] + [/.flat_ex_q] + )) + + ($.documentation /.flat_function + "The input, and the output of a function type." + [(flat_function type)]) + + ($.documentation /.flat_application + "The quantified type, and its parameters, for a type-application." + [(flat_application type)]) + + (~~ (with_template [] + [($.documentation + "The members of a composite type.")] + + [/.flat_variant] + [/.flat_tuple] + )) + + ($.documentation /.format + "A (readable) textual representable of a type." + [(format type)]) + + ($.documentation /.applied + "To the extend possible, applies a quantified type to the given parameters." + [(applied params func)]) + + ($.documentation /.code + (%.format "A representation of a type as code." + \n "The code is such that evaluating it would yield the type value.") + [(code type)]) + + ($.documentation /.de_aliased + "A (potentially named) type that does not have its name shadowed by other names." + [(de_aliased type)]) + + ($.documentation /.anonymous + "A type without any names covering it." + [(anonymous type)]) + + (~~ (with_template [] + [($.documentation + "A composite type, constituted by the given member types.")] + + [/.variant] + [/.tuple] + )) + + ($.documentation /.function + "A function type, with the given inputs and output." + [(function inputs output)]) + + ($.documentation /.application + "An un-evaluated type application, with the given quantified type, and parameters." + [(application params quant)]) + + (~~ (with_template [] + [($.documentation + "A quantified type, with the given number of parameters, and body.")] + + [/.univ_q] + [/.ex_q] + )) + + ($.documentation /.quantified? + "Only yields #1 for universally or existentially quantified types." + [(quantified? type)]) + + ($.documentation /.array + "An array type, with the given level of nesting/depth, and the given element type." + [(array depth element_type)]) + + ($.documentation /.flat_array + "The level of nesting/depth and element type for an array type." + [(flat_array type)]) + + ($.documentation /.array? + "Is a type an array type?") + + ($.documentation /.log! + "Logs to the console/terminal the type of an expression." + [(log! (is Foo (foo expression))) + "=>" + "Expression: (foo expression)" + " Type: Foo" + (foo expression)]) + + ($.documentation /.as + (%.format "Casts a value to a specific type." + \n "The specified type can depend on type variables of the original type of the value." + \n "NOTE: Careless use of type-casts is an easy way to introduce bugs. USE WITH CAUTION.") + [(is (Bar Bit Nat Text) + (as [a b c] + (Foo a [b c]) + (Bar a b c) + (is (Foo Bit [Nat Text]) + (foo expression))))]) + + ($.documentation /.sharing + "Allows specifing the type of an expression as sharing type-variables with the type of another expression." + [(is (Bar Bit Nat Text) + (sharing [a b c] + (is (Foo a [b c]) + (is (Foo Bit [Nat Text]) + (foo expression))) + (is (Bar a b c) + (bar expression))))]) + + ($.documentation /.by_example + "Constructs a type that shares type-variables with an expression of some other type." + [(is Type + (by_example [a b c] + (is (Foo a [b c]) + (is (Foo Bit [Nat Text]) + (foo expression))) + (Bar a b c))) + "=>" + (.type_literal (Bar Bit Nat Text))]) + + ($.documentation /.let + "Local bindings for types." + [(let [side (Either Int Frac)] + (List [side side]))])] + [/primitive.documentation + /check.documentation + /dynamic.documentation + /implicit.documentation + /poly.documentation + /quotient.documentation + /refinement.documentation + /resource.documentation + /unit.documentation + /variance.documentation]))) diff --git a/stdlib/source/documentation/lux/type/check.lux b/stdlib/source/documentation/lux/type/check.lux index 959cda6a4..e5a7130cf 100644 --- a/stdlib/source/documentation/lux/type/check.lux +++ b/stdlib/source/documentation/lux/type/check.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,84 +10,70 @@ [\\library ["[0]" /]]) -(documentation: /.Var - "The ID for a type-variable in a type-checking context.") +(.def .public documentation + (.List $.Module) + ($.module /._ + "Type-checking functionality." + [($.default /.unknown_type_var) + ($.default /.unbound_type_var) + ($.default /.invalid_type_application) + ($.default /.cannot_rebind_var) + ($.default /.type_check_failed) + ($.default /.functor) + ($.default /.apply) + ($.default /.monad) + ($.default /.bound?) + ($.default /.peek) + ($.default /.read) -(documentation: (/.Check it) - "A type-checking computation which may fail or yield a value.") + ($.documentation /.Var + "The ID for a type-variable in a type-checking context.") -(documentation: /.result - "" - [(result context proc)]) + ($.documentation (/.Check it) + "A type-checking computation which may fail or yield a value.") -(documentation: /.failure - "" - [(failure message)]) + ($.documentation /.result + "" + [(result context proc)]) -(documentation: /.assertion - "" - [(assertion message test)]) + ($.documentation /.failure + "" + [(failure message)]) -(documentation: /.except - "" - [(except exception message)]) + ($.documentation /.assertion + "" + [(assertion message test)]) -(documentation: /.existential - "A brand-new existential type.") + ($.documentation /.except + "" + [(except exception message)]) -(documentation: /.bind - (format "Attemmpts to buy a type-variable." - \n "Fails if the variable has been bound already.") - [(bind type id)]) + ($.documentation /.existential + "A brand-new existential type.") -(documentation: /.var - "A brand-new (unbound) type-variable.") + ($.documentation /.bind + (format "Attemmpts to buy a type-variable." + \n "Fails if the variable has been bound already.") + [(bind type id)]) -(documentation: /.fresh_context - "An empty/un-used type-checking context.") + ($.documentation /.var + "A brand-new (unbound) type-variable.") -(documentation: /.check - "Type-check to ensure that the 'expected' type subsumes the 'actual' type." - [(check expected actual)]) + ($.documentation /.fresh_context + "An empty/un-used type-checking context.") -(documentation: /.subsumes? - "A simple type-checking function that just returns a yes/no answer." - [(subsumes? expected actual)]) + ($.documentation /.check + "Type-check to ensure that the 'expected' type subsumes the 'actual' type." + [(check expected actual)]) -(documentation: /.context - "The current state of the type-checking context.") + ($.documentation /.subsumes? + "A simple type-checking function that just returns a yes/no answer." + [(subsumes? expected actual)]) -(documentation: /.clean - "Resolves every bound type-variable to yield a new type that is as resolved as possible." - [(clean inputT)]) + ($.documentation /.context + "The current state of the type-checking context.") -(.def .public documentation - (.List $.Module) - ($.module /._ - "Type-checking functionality." - [..Var - ..Check - ..result - ..failure - ..assertion - ..except - ..existential - ..bind - ..var - ..fresh_context - ..check - ..subsumes? - ..context - ..clean - ($.default /.unknown_type_var) - ($.default /.unbound_type_var) - ($.default /.invalid_type_application) - ($.default /.cannot_rebind_var) - ($.default /.type_check_failed) - ($.default /.functor) - ($.default /.apply) - ($.default /.monad) - ($.default /.bound?) - ($.default /.peek) - ($.default /.read)] + ($.documentation /.clean + "Resolves every bound type-variable to yield a new type that is as resolved as possible." + [(clean inputT)])] [])) diff --git a/stdlib/source/documentation/lux/type/dynamic.lux b/stdlib/source/documentation/lux/type/dynamic.lux index d6930a245..861d7143f 100644 --- a/stdlib/source/documentation/lux/type/dynamic.lux +++ b/stdlib/source/documentation/lux/type/dynamic.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except static) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,26 +10,23 @@ [\\library ["[0]" /]]) -(documentation: /.Dynamic - "A value coupled with its type, so it can be checked later.") - -(documentation: /.dynamic - "" - [(is Dynamic - (dynamic 123))]) - -(documentation: /.static - "" - [(is (try.Try Nat) - (static Nat (dynamic 123)))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Dynamic - ..dynamic - ..static - ($.default /.wrong_type) - ($.default /.format)] + [($.default /.wrong_type) + ($.default /.format) + + ($.documentation /.Dynamic + "A value coupled with its type, so it can be checked later.") + + ($.documentation /.dynamic + "" + [(is Dynamic + (dynamic 123))]) + + ($.documentation /.static + "" + [(is (try.Try Nat) + (static Nat (dynamic 123)))])] [])) diff --git a/stdlib/source/documentation/lux/type/implicit.lux b/stdlib/source/documentation/lux/type/implicit.lux index 713ad788c..9490d4aee 100644 --- a/stdlib/source/documentation/lux/type/implicit.lux +++ b/stdlib/source/documentation/lux/type/implicit.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,48 +10,44 @@ [\\library ["[0]" /]]) -(documentation: /.a/an - (format "Automatic implementation selection (for type-class style polymorphism)." - \n "This feature layers type-class style polymorphism on top of Lux's signatures and implementations." - \n "When calling a polymorphic function, or using a polymorphic constant," - \n "this macro will check the types of the arguments, and the expected type for the whole expression" - \n "and it will search in the local scope, the module's scope and the imports' scope" - \n "in order to find suitable implementations to satisfy those requirements." - \n "If a single alternative is found, that one will be used automatically." - \n "If no alternative is found, or if more than one alternative is found (ambiguity)" - \n "a compile-time error will be raised, to alert the user." - \n \n "Caveat emptor: You need to make sure to import the module of any implementation you want to use." - \n "Otherwise, this macro will not find it.") - ["Nat equivalence" - (at number.equivalence = x y) - (a/an = x y)] - ["Can optionally add the prefix of the module where the signature was defined." - (a/an equivalence.= x y)] - ["(List Nat) equivalence" - (a/an = - (list.indices 10) - (list.indices 10))] - ["(Functor List) each" - (a/an each ++ (list.indices 10))]) - -(documentation: /.with - "Establish lexical bindings for implementations that will be prioritized over non-lexically-bound implementations." - [(with [n.addition] - (n.= (at n.addition composite left right) - (a/an composite left right)))]) - -(documentation: /.implicitly - "Establish local definitions for implementations that will be prioritized over foreign definitions." - [(implicitly n.multiplication) - - (n.= (at n.multiplication composite left right) - (a/an composite left right))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..a/an - ..with - ..implicitly] + [($.documentation /.a/an + (format "Automatic implementation selection (for type-class style polymorphism)." + \n "This feature layers type-class style polymorphism on top of Lux's signatures and implementations." + \n "When calling a polymorphic function, or using a polymorphic constant," + \n "this macro will check the types of the arguments, and the expected type for the whole expression" + \n "and it will search in the local scope, the module's scope and the imports' scope" + \n "in order to find suitable implementations to satisfy those requirements." + \n "If a single alternative is found, that one will be used automatically." + \n "If no alternative is found, or if more than one alternative is found (ambiguity)" + \n "a compile-time error will be raised, to alert the user." + \n \n "Caveat emptor: You need to make sure to import the module of any implementation you want to use." + \n "Otherwise, this macro will not find it.") + ["Nat equivalence" + (at number.equivalence = x y) + (a/an = x y)] + ["Can optionally add the prefix of the module where the signature was defined." + (a/an equivalence.= x y)] + ["(List Nat) equivalence" + (a/an = + (list.indices 10) + (list.indices 10))] + ["(Functor List) each" + (a/an each ++ (list.indices 10))]) + + ($.documentation /.with + "Establish lexical bindings for implementations that will be prioritized over non-lexically-bound implementations." + [(with [n.addition] + (n.= (at n.addition composite left right) + (a/an composite left right)))]) + + ($.documentation /.implicitly + "Establish local definitions for implementations that will be prioritized over foreign definitions." + [(implicitly n.multiplication) + + (n.= (at n.multiplication composite left right) + (a/an composite left right))])] [])) diff --git a/stdlib/source/documentation/lux/type/poly.lux b/stdlib/source/documentation/lux/type/poly.lux index 31159c6a5..979ae2899 100644 --- a/stdlib/source/documentation/lux/type/poly.lux +++ b/stdlib/source/documentation/lux/type/poly.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and) - ["$" documentation (.only documentation:)] + ["$" documentation] [abstract [\\specification ["$[0]" equivalence] @@ -14,14 +14,13 @@ [\\library ["[0]" /]]) -(documentation: /.code - "" - [(code env type)]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..code - ($.default /.polytypic)] + [($.default /.polytypic) + + ($.documentation /.code + "" + [(code env type)])] [])) diff --git a/stdlib/source/documentation/lux/type/primitive.lux b/stdlib/source/documentation/lux/type/primitive.lux index 252891761..f91104900 100644 --- a/stdlib/source/documentation/lux/type/primitive.lux +++ b/stdlib/source/documentation/lux/type/primitive.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,120 +10,113 @@ [\\library ["[0]" /]]) -(documentation: /.Frame - "Meta-data about an abstract/nominal type in a stack of them.") - -(documentation: /.current - "The currently-being-defined abstract/nominal type.") - -(documentation: /.specific - "A specific abstract/nominal type still being defined somewhere in the scope." - [(specific name)]) - -(with_template [ <$> ] - [(documentation: - "Type-casting macro for abstract/nominal types." - [(|> value - (is ) - <$> - (is ))])] - - [/.abstraction Representation abstraction Abstraction] - [/.representation Abstraction representation Representation] - ) - -(documentation: /.primitive - (format "Define abstract/nominal types which hide their representation details." - \n "You can convert between the abstraction and its representation selectively to access the value, while hiding it from others.") - [(primitive String - Text - - (def (string value) - (-> Text String) - (abstraction value)) - - (def (text value) - (-> String Text) - (representation value)))] - ["Type-parameters are optional." - (primitive (Duplicate a) - [a a] - - (def (duplicate value) - (All (_ a) (-> a (Duplicate a))) - (abstraction [value value])))] - ["Definitions can be nested." - (primitive (Single a) - a - - (def (single value) - (All (_ a) (-> a (Single a))) - (abstraction value)) - - (primitive (Double a) - [a a] - - (def (double value) - (All (_ a) (-> a (Double a))) - (abstraction [value value])) - - (def (single' value) - (All (_ a) (-> a (Single a))) - (abstraction Single [value value])) - - (let [value 0123] - (same? value - (|> value - single' - (representation Single) - double - representation)))))] - ["Type-parameters do not necessarily have to be used in the representation type." - "If they are not used, they become phantom types and can be used to customize types without changing the representation." - (primitive (JavaScript a) - Text - - (primitive Expression Any) - (primitive Statement Any) - - (def (+ x y) - (-> (JavaScript Expression) (JavaScript Expression) (JavaScript Expression)) - (abstraction - (format "(" (representation x) "+" (representation y) ")"))) - - (def (while test body) - (-> (JavaScript Expression) (JavaScript Statement) (JavaScript Statement)) - (abstraction - (format "while(" (representation test) ") {" - (representation body) - "}"))))]) - -(documentation: /.transmutation - "Transmutes an abstract/nominal type's phantom types." - [(primitive (JavaScript a) - Text - - (primitive Expression Any) - (primitive Statement Any) - - (def (statement expression) - (-> (JavaScript Expression) (JavaScript Statement)) - (transmutation expression)) - - (def (statement' expression) - (-> (JavaScript Expression) (JavaScript Statement)) - (transmutation JavaScript expression)))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Frame - ..current - ..specific - ..abstraction - ..representation - ..primitive - ..transmutation - ($.default /.no_active_frames)] + [($.default /.no_active_frames) + + ($.documentation /.Frame + "Meta-data about an abstract/nominal type in a stack of them.") + + ($.documentation /.current + "The currently-being-defined abstract/nominal type.") + + ($.documentation /.specific + "A specific abstract/nominal type still being defined somewhere in the scope." + [(specific name)]) + + (~~ (with_template [ <$> ] + [($.documentation + "Type-casting macro for abstract/nominal types." + [(|> value + (is ) + <$> + (is ))])] + + [/.abstraction Representation abstraction Abstraction] + [/.representation Abstraction representation Representation] + )) + + ($.documentation /.primitive + (format "Define abstract/nominal types which hide their representation details." + \n "You can convert between the abstraction and its representation selectively to access the value, while hiding it from others.") + [(primitive String + Text + + (def (string value) + (-> Text String) + (abstraction value)) + + (def (text value) + (-> String Text) + (representation value)))] + ["Type-parameters are optional." + (primitive (Duplicate a) + [a a] + + (def (duplicate value) + (All (_ a) (-> a (Duplicate a))) + (abstraction [value value])))] + ["Definitions can be nested." + (primitive (Single a) + a + + (def (single value) + (All (_ a) (-> a (Single a))) + (abstraction value)) + + (primitive (Double a) + [a a] + + (def (double value) + (All (_ a) (-> a (Double a))) + (abstraction [value value])) + + (def (single' value) + (All (_ a) (-> a (Single a))) + (abstraction Single [value value])) + + (let [value 0123] + (same? value + (|> value + single' + (representation Single) + double + representation)))))] + ["Type-parameters do not necessarily have to be used in the representation type." + "If they are not used, they become phantom types and can be used to customize types without changing the representation." + (primitive (JavaScript a) + Text + + (primitive Expression Any) + (primitive Statement Any) + + (def (+ x y) + (-> (JavaScript Expression) (JavaScript Expression) (JavaScript Expression)) + (abstraction + (format "(" (representation x) "+" (representation y) ")"))) + + (def (while test body) + (-> (JavaScript Expression) (JavaScript Statement) (JavaScript Statement)) + (abstraction + (format "while(" (representation test) ") {" + (representation body) + "}"))))]) + + ($.documentation /.transmutation + "Transmutes an abstract/nominal type's phantom types." + [(primitive (JavaScript a) + Text + + (primitive Expression Any) + (primitive Statement Any) + + (def (statement expression) + (-> (JavaScript Expression) (JavaScript Statement)) + (transmutation expression)) + + (def (statement' expression) + (-> (JavaScript Expression) (JavaScript Statement)) + (transmutation JavaScript expression)))])] [])) diff --git a/stdlib/source/documentation/lux/type/quotient.lux b/stdlib/source/documentation/lux/type/quotient.lux index c0185b109..1451674e6 100644 --- a/stdlib/source/documentation/lux/type/quotient.lux +++ b/stdlib/source/documentation/lux/type/quotient.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,40 +10,36 @@ [\\library ["[0]" /]]) -(documentation: (/.Class value label) - "The class knows how to classify/label values that are meant to be equivalent to one another.") - -(documentation: (/.Quotient value label) - (format "A quotient value has been labeled with a class." - \n "All equivalent values will belong to the same class." - \n "This means all equivalent values possess the same label.")) - -(documentation: /.quotient - "" - [(quotient class value)]) - -(documentation: /.type - "The Quotient type associated with a Class type." - [(def even - (class even?)) - - (def Even - Type - (type even)) - - (is Even - (quotient even 123))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Class - ..Quotient - ..quotient - ..type - ($.default /.class) + [($.default /.class) ($.default /.value) ($.default /.label) - ($.default /.equivalence)] + ($.default /.equivalence) + + ($.documentation (/.Class value label) + "The class knows how to classify/label values that are meant to be equivalent to one another.") + + ($.documentation (/.Quotient value label) + (format "A quotient value has been labeled with a class." + \n "All equivalent values will belong to the same class." + \n "This means all equivalent values possess the same label.")) + + ($.documentation /.quotient + "" + [(quotient class value)]) + + ($.documentation /.type + "The Quotient type associated with a Class type." + [(def even + (class even?)) + + (def Even + Type + (type even)) + + (is Even + (quotient even 123))])] [])) diff --git a/stdlib/source/documentation/lux/type/refinement.lux b/stdlib/source/documentation/lux/type/refinement.lux index 083dd523e..304b4b266 100644 --- a/stdlib/source/documentation/lux/type/refinement.lux +++ b/stdlib/source/documentation/lux/type/refinement.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,52 +10,45 @@ [\\library ["[0]" /]]) -(documentation: (/.Refined it) - "A refined version of another type, using a predicate to select valid instances.") +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.value) + ($.default /.predicate) -(documentation: (/.Refiner it) - "A selection mechanism for refined instances of a type.") + ($.documentation (/.Refined it) + "A refined version of another type, using a predicate to select valid instances.") -(documentation: /.refiner - "" - [(refiner predicate)]) + ($.documentation (/.Refiner it) + "A selection mechanism for refined instances of a type.") -(documentation: /.lifted - (format "Yields a function that can work on refined values." - \n "Respects the constraints of the refinement.") - [(lifted transform)]) + ($.documentation /.refiner + "" + [(refiner predicate)]) -(documentation: /.only - "" - [(only refiner values)]) + ($.documentation /.lifted + (format "Yields a function that can work on refined values." + \n "Respects the constraints of the refinement.") + [(lifted transform)]) -(documentation: /.partition - "Separates refined values from the un-refined ones." - [(partition refiner values)]) + ($.documentation /.only + "" + [(only refiner values)]) -(documentation: /.type - "The Refined type associated with a Refiner type." - [(def even - (refiner even?)) + ($.documentation /.partition + "Separates refined values from the un-refined ones." + [(partition refiner values)]) - (def Even - Type - (type even)) + ($.documentation /.type + "The Refined type associated with a Refiner type." + [(def even + (refiner even?)) - (is (Maybe Even) - (even 123))]) + (def Even + Type + (type even)) -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..Refined - ..Refiner - ..refiner - ..lifted - ..only - ..partition - ..type - ($.default /.value) - ($.default /.predicate)] + (is (Maybe Even) + (even 123))])] [])) diff --git a/stdlib/source/documentation/lux/type/resource.lux b/stdlib/source/documentation/lux/type/resource.lux index e6f964b9b..d5615d0dc 100644 --- a/stdlib/source/documentation/lux/type/resource.lux +++ b/stdlib/source/documentation/lux/type/resource.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,105 +10,89 @@ [\\library ["[0]" /]]) -(documentation: (/.Procedure monad input output value) - (format "A computation that takes a sequence of resource access rights as inputs and yields a different sequence as outputs." - \n "A procedure yields a result value." - \n "A procedure can make use of monadic effects.")) - -(documentation: (/.Linear monad value) - (format "A procedure that is constant with regards to resource access rights." - \n "This means no additional resources will be available after the computation is over." - \n "This also means no previously available resources will have been consumed.")) - -(documentation: (/.Affine monad permissions value) - "A procedure which expands the number of available resources.") - -(documentation: (/.Relevant monad permissions value) - "A procedure which reduces the number of available resources.") - -(documentation: /.run! - "" - [(run! monad procedure)]) - -(documentation: /.lifted - "" - [(lifted monad procedure)]) - -(documentation: /.Ordered - "The mode of keys which CANNOT be swapped, and for whom order of release/consumption matters.") - -(documentation: /.Commutative - "The mode of keys which CAN be swapped, and for whom order of release/consumption DOES NOT matters.") - -(documentation: (/.Key mode key) - (format "The access right for a resource." - \n "Without the key for a resource existing somewhere among the available ambient rights, one cannot use a resource.")) - -(documentation: (/.Res key value) - (format "A resource locked by a key." - \n "The 'key' represents the right to access/consume a resource.")) - -(with_template [] - [(documentation: - "Makes a value into a resource and adds the key/access-right to it to the ambient keyring for future use.")] - - [/.ordered] - [/.commutative] - ) - -(documentation: /.read - "Access the value of a resource, so long as its key is available." - [(read monad resource)]) - -(documentation: /.exchange - (format "A function that can exchange the keys for resource, so long as they are commutative." - \n "This keys will be placed at the front of the keyring in the order they are specified." - \n "The specific keys must be specified based of their index into the current keyring.") - [(do (monad !) - [res|left (commutative ! pre) - res|right (commutative ! post) - _ ((exchange [1 0]) !) - left (read ! res|left) - right (read ! res|right)] - (in (format left right)))]) - -(with_template [] - [(documentation: - "Group/un-group keys in the keyring into/out-of tuples." - [(do (monad !) - [res|left (commutative ! pre) - res|right (commutative ! post) - _ ((group 2) !) - _ ((un_group 2) !) - right (read ! res|right) - left (read ! res|left)] - (in (format left right)))])] - - [/.group] - [/.un_group] - ) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Procedure - ..Linear - ..Affine - ..Relevant - ..run! - ..lifted - ..Ordered - ..Commutative - ..Key - ..Res - ..ordered - ..commutative - ..read - ..exchange - ..group - ..un_group - ($.default /.monad) + [($.default /.monad) ($.default /.index_cannot_be_repeated) - ($.default /.amount_cannot_be_zero)] + ($.default /.amount_cannot_be_zero) + + ($.documentation (/.Procedure monad input output value) + (format "A computation that takes a sequence of resource access rights as inputs and yields a different sequence as outputs." + \n "A procedure yields a result value." + \n "A procedure can make use of monadic effects.")) + + ($.documentation (/.Linear monad value) + (format "A procedure that is constant with regards to resource access rights." + \n "This means no additional resources will be available after the computation is over." + \n "This also means no previously available resources will have been consumed.")) + + ($.documentation (/.Affine monad permissions value) + "A procedure which expands the number of available resources.") + + ($.documentation (/.Relevant monad permissions value) + "A procedure which reduces the number of available resources.") + + ($.documentation /.run! + "" + [(run! monad procedure)]) + + ($.documentation /.lifted + "" + [(lifted monad procedure)]) + + ($.documentation /.Ordered + "The mode of keys which CANNOT be swapped, and for whom order of release/consumption matters.") + + ($.documentation /.Commutative + "The mode of keys which CAN be swapped, and for whom order of release/consumption DOES NOT matters.") + + ($.documentation (/.Key mode key) + (format "The access right for a resource." + \n "Without the key for a resource existing somewhere among the available ambient rights, one cannot use a resource.")) + + ($.documentation (/.Res key value) + (format "A resource locked by a key." + \n "The 'key' represents the right to access/consume a resource.")) + + (~~ (with_template [] + [($.documentation + "Makes a value into a resource and adds the key/access-right to it to the ambient keyring for future use.")] + + [/.ordered] + [/.commutative] + )) + + ($.documentation /.read + "Access the value of a resource, so long as its key is available." + [(read monad resource)]) + + ($.documentation /.exchange + (format "A function that can exchange the keys for resource, so long as they are commutative." + \n "This keys will be placed at the front of the keyring in the order they are specified." + \n "The specific keys must be specified based of their index into the current keyring.") + [(do (monad !) + [res|left (commutative ! pre) + res|right (commutative ! post) + _ ((exchange [1 0]) !) + left (read ! res|left) + right (read ! res|right)] + (in (format left right)))]) + + (~~ (with_template [] + [($.documentation + "Group/un-group keys in the keyring into/out-of tuples." + [(do (monad !) + [res|left (commutative ! pre) + res|right (commutative ! post) + _ ((group 2) !) + _ ((un_group 2) !) + right (read ! res|right) + left (read ! res|left)] + (in (format left right)))])] + + [/.group] + [/.un_group] + ))] [])) diff --git a/stdlib/source/documentation/lux/type/unit.lux b/stdlib/source/documentation/lux/type/unit.lux index edfd3340b..204154496 100644 --- a/stdlib/source/documentation/lux/type/unit.lux +++ b/stdlib/source/documentation/lux/type/unit.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -13,78 +13,11 @@ [\\library ["[0]" /]]) -(documentation: (/.Qty unit) - "A quantity with an associated unit of measurement.") - -(documentation: (/.Unit unit) - "A unit of measurement, to qualify numbers with.") - -(documentation: (/.Scale scale) - "A scale of magnitude.") - -(documentation: /.Pure - "A pure, unit-less quantity.") - -(documentation: /.unit - (format "Define a unit of measurement." - \n "Both the name of the type, and the name of the Unit implementation must be specified.") - [(def feet (unit []))]) - -(documentation: /.scale - "Define a scale of magnitude." - [(def bajillion (scale [1 1,234,567,890]))]) - -(documentation: /.re_scaled - "" - [(re_scaled from to quantity)]) - -(with_template [ ] - [(`` (documentation: - (let [numerator (the [/.ratio ratio.#numerator] ) - denominator (the [/.ratio ratio.#denominator] )] - (format "The '" (~~ (template.text [])) "' scale, from " (%.nat numerator) " to " (%.nat denominator) "."))))] - - [/.Kilo /.kilo] - [/.Mega /.mega] - [/.Giga /.giga] - - [/.Milli /.milli] - [/.Micro /.micro] - [/.Nano /.nano] - ) - -(with_template [] - [(`` (documentation: - (format "The '" (~~ (template.text [])) "' unit of meaurement.")))] - - [/.gram] - [/.meter] - [/.litre] - [/.second] - ) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Qty - ..Unit - ..Scale - ..Pure - ..unit - ..scale - ..re_scaled - ..kilo - ..mega - ..giga - ..milli - ..micro - ..nano - ..gram - ..meter - ..litre - ..second - ($.default /.Gram) + [($.default /.Gram) ($.default /.Meter) ($.default /.Litre) ($.default /.Second) @@ -102,5 +35,55 @@ ($.default /.+) ($.default /.-) ($.default /.*) - ($.default /./)] + ($.default /./) + + ($.documentation (/.Qty unit) + "A quantity with an associated unit of measurement.") + + ($.documentation (/.Unit unit) + "A unit of measurement, to qualify numbers with.") + + ($.documentation (/.Scale scale) + "A scale of magnitude.") + + ($.documentation /.Pure + "A pure, unit-less quantity.") + + ($.documentation /.unit + (format "Define a unit of measurement." + \n "Both the name of the type, and the name of the Unit implementation must be specified.") + [(def feet (unit []))]) + + ($.documentation /.scale + "Define a scale of magnitude." + [(def bajillion (scale [1 1,234,567,890]))]) + + ($.documentation /.re_scaled + "" + [(re_scaled from to quantity)]) + + (~~ (with_template [ ] + [(`` ($.documentation + (let [numerator (the [/.ratio ratio.#numerator] ) + denominator (the [/.ratio ratio.#denominator] )] + (format "The '" (~~ (template.text [])) "' scale, from " (%.nat numerator) " to " (%.nat denominator) "."))))] + + [/.Kilo /.kilo] + [/.Mega /.mega] + [/.Giga /.giga] + + [/.Milli /.milli] + [/.Micro /.micro] + [/.Nano /.nano] + )) + + (~~ (with_template [] + [(`` ($.documentation + (format "The '" (~~ (template.text [])) "' unit of meaurement.")))] + + [/.gram] + [/.meter] + [/.litre] + [/.second] + ))] [])) diff --git a/stdlib/source/documentation/lux/type/variance.lux b/stdlib/source/documentation/lux/type/variance.lux index d4a1052d3..e3b377fea 100644 --- a/stdlib/source/documentation/lux/type/variance.lux +++ b/stdlib/source/documentation/lux/type/variance.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,20 +10,16 @@ [\\library ["[0]" /]]) -(documentation: (/.Co it) - "A constraint for covariant types.") - -(documentation: (/.Contra it) - "A constraint for contravariant types.") - -(documentation: (/.In it) - "A constraint for invariant types.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Co - ..Contra - ..In] + [($.documentation (/.Co it) + "A constraint for covariant types.") + + ($.documentation (/.Contra it) + "A constraint for contravariant types.") + + ($.documentation (/.In it) + "A constraint for invariant types.")] [])) 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) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index 8e938dcfe..607e7e2f6 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -3,15 +3,16 @@ [lux (.except) ["_" test (.only Test)] [abstract - [monad (.only do)] - ["[0]" predicate]] + [monad (.only do)]] [control [io (.only IO)] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.use "[1]#[0]" functor)] ["[0]" exception] [concurrency - ["[0]" async (.only Async)]]] + ["[0]" async (.only Async)]] + [function + ["[0]" predicate]]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)] diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index eac73fa40..9a4c8d3ce 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -17,8 +17,7 @@ ["[1][0]" monad (.only) ["[1]/[0]" free]] ["[1][0]" monoid] - ["[1][0]" order] - ["[1][0]" predicate]]) + ["[1][0]" order]]) (def functor Test @@ -53,7 +52,6 @@ /interval.test /monoid.test /order.test - /predicate.test ..functor ..monad ..comonad diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux deleted file mode 100644 index 28d0eed16..000000000 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ /dev/null @@ -1,91 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [equivalence (.only Equivalence)] - [monad (.only do)] - [\\specification - ["$[0]" monoid] - [functor - ["$[0]" contravariant]]]] - [control - ["[0]" function]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)] - [collection - ["[0]" list]]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) - -(def (multiple? factor) - (-> Nat (/.Predicate Nat)) - (case factor - 0 (function.constant false) - _ (|>> (n.% factor) (n.= 0)))) - -(def .public test - Test - (<| (_.covering /._) - (do [! random.monad] - [sample random.nat - samples (random.list 10 random.nat) - .let [equivalence (is (Equivalence (/.Predicate Nat)) - (implementation - (def (= left right) - (bit#= (left sample) - (right sample)))))]]) - (_.for [/.Predicate]) - (all _.and - (_.for [/.functor] - ($contravariant.spec equivalence (multiple? 2) /.functor)) - (let [generator (is (Random (/.Predicate Nat)) - (|> random.nat - (random.only (|>> (n.= 0) not)) - (at ! each multiple?)))] - (all _.and - (_.for [/.union] - ($monoid.spec equivalence /.union generator)) - (_.for [/.intersection] - ($monoid.spec equivalence /.intersection generator)))) - - (_.coverage [/.none] - (bit#= false (/.none sample))) - (_.coverage [/.all] - (bit#= true (/.all sample))) - (_.coverage [/.or] - (bit#= (/.all sample) - ((/.or /.none /.all) sample))) - (_.coverage [/.and] - (bit#= (/.none sample) - ((/.and /.none /.all) sample))) - (_.coverage [/.complement] - (and (not (bit#= (/.none sample) - ((/.complement /.none) sample))) - (not (bit#= (/.all sample) - ((/.complement /.all) sample))))) - (_.coverage [/.difference] - (let [/2? (multiple? 2) - /3? (multiple? 3)] - (bit#= (and (/2? sample) - (not (/3? sample))) - ((/.difference /3? /2?) sample)))) - (_.coverage [/.rec] - (let [even? (multiple? 2) - any_even? (is (/.Predicate (List Nat)) - (/.rec (function (_ again) - (function (_ values) - (case values - {.#End} - false - - {.#Item head tail} - (or (even? head) - (again tail)))))))] - (bit#= (list.any? even? samples) - (any_even? samples)))) - ))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index bb688959f..a3e9c5440 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -18,7 +18,8 @@ ["[1][0]" memo] ["[1][0]" mixin] ["[1][0]" mutual] - ["[1][0]" inline]]) + ["[1][0]" inline] + ["[1][0]" predicate]]) (def .public test Test @@ -64,4 +65,5 @@ /mixin.test /mutual.test /inline.test + /predicate.test )))) diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index e84f4293a..3ed034a69 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -4,12 +4,13 @@ ["_" test (.only Test)] [abstract [equivalence (.only Equivalence)] - [predicate (.only Predicate)] [monad (.only do)] [\\specification ["$[0]" monoid]]] [control - ["[0]" state (.only State)]] + ["[0]" state (.only State)] + [function + [predicate (.only Predicate)]]] [data ["[0]" product] [collection diff --git a/stdlib/source/test/lux/control/function/predicate.lux b/stdlib/source/test/lux/control/function/predicate.lux new file mode 100644 index 000000000..28d0eed16 --- /dev/null +++ b/stdlib/source/test/lux/control/function/predicate.lux @@ -0,0 +1,91 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [equivalence (.only Equivalence)] + [monad (.only do)] + [\\specification + ["$[0]" monoid] + [functor + ["$[0]" contravariant]]]] + [control + ["[0]" function]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def (multiple? factor) + (-> Nat (/.Predicate Nat)) + (case factor + 0 (function.constant false) + _ (|>> (n.% factor) (n.= 0)))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [sample random.nat + samples (random.list 10 random.nat) + .let [equivalence (is (Equivalence (/.Predicate Nat)) + (implementation + (def (= left right) + (bit#= (left sample) + (right sample)))))]]) + (_.for [/.Predicate]) + (all _.and + (_.for [/.functor] + ($contravariant.spec equivalence (multiple? 2) /.functor)) + (let [generator (is (Random (/.Predicate Nat)) + (|> random.nat + (random.only (|>> (n.= 0) not)) + (at ! each multiple?)))] + (all _.and + (_.for [/.union] + ($monoid.spec equivalence /.union generator)) + (_.for [/.intersection] + ($monoid.spec equivalence /.intersection generator)))) + + (_.coverage [/.none] + (bit#= false (/.none sample))) + (_.coverage [/.all] + (bit#= true (/.all sample))) + (_.coverage [/.or] + (bit#= (/.all sample) + ((/.or /.none /.all) sample))) + (_.coverage [/.and] + (bit#= (/.none sample) + ((/.and /.none /.all) sample))) + (_.coverage [/.complement] + (and (not (bit#= (/.none sample) + ((/.complement /.none) sample))) + (not (bit#= (/.all sample) + ((/.complement /.all) sample))))) + (_.coverage [/.difference] + (let [/2? (multiple? 2) + /3? (multiple? 3)] + (bit#= (and (/2? sample) + (not (/3? sample))) + ((/.difference /3? /2?) sample)))) + (_.coverage [/.rec] + (let [even? (multiple? 2) + any_even? (is (/.Predicate (List Nat)) + (/.rec (function (_ again) + (function (_ values) + (case values + {.#End} + false + + {.#Item head tail} + (or (even? head) + (again tail)))))))] + (bit#= (list.any? even? samples) + (any_even? samples)))) + ))) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 1389e4620..52fa6519a 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -6,7 +6,6 @@ ["[0]" type] [abstract [equivalence (.only Equivalence)] - [predicate (.only Predicate)] ["[0]" monad (.only do)] ["[0]" enum] [\\specification @@ -17,7 +16,9 @@ ["[0]" pipe] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only Exception)]] + ["[0]" exception (.only Exception)] + [function + [predicate (.only Predicate)]]] [data ["[0]" sum] ["[0]" bit] diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index a96aff9cc..98d288dc5 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -4,9 +4,11 @@ ["_" test (.only Test)] [abstract [monad (.only do)] - ["[0]" predicate] [\\specification ["$[0]" equivalence]]] + [control + [function + ["[0]" predicate]]] [math ["[0]" random (.only Random)] [number diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 1b48f0fd0..a0dd01e06 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -5,10 +5,12 @@ [abstract [hash (.only Hash)] [monad (.only do)] - ["[0]" predicate] [\\specification ["$[0]" equivalence] ["$[0]" hash]]] + [control + [function + ["[0]" predicate]]] [data ["[0]" bit (.use "[1]#[0]" equivalence)] [collection diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 6edf7e3ac..581d89f2d 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -381,11 +381,11 @@ ("private" value java/lang/Long) ... Constructors ("public" [] (new self [value java/lang/Long]) [] - (/.set value value)) + (/.set value value self)) ... Methods (test/TestInterface0 [] (actual0 self []) java/lang/Long - (/.get value))) + (/.get value self))) (/.import test/TestClass0 "[1]::[0]" @@ -396,13 +396,13 @@ ("private" value java/lang/Long) ... Constructors ("public" [] (new self [value java/lang/Long]) [] - (/.set value value)) + (/.set value value self)) ... Methods (test/TestInterface1 [] (actual1 self [throw? java/lang/Boolean]) java/lang/Long "throws" [java/lang/Throwable] (if (not (/.of_boolean throw?)) - (/.get value) + (/.get value self) (panic! "YOLO")))) (/.import test/TestClass1 @@ -428,12 +428,12 @@ ("private" value a) ... Constructors ("public" [] (new self [value a]) [] - (/.set value value)) + (/.set value value self)) ... Methods ((test/TestInterface3 a) [] (actual3 self []) a - (/.get value))) + (/.get value self))) (/.import (test/TestClass3 a) "[1]::[0]" @@ -513,12 +513,12 @@ ("private" value9 a) ... Constructors ("public" [] (new self [value a]) [] - (/.set value9 value)) + (/.set value9 value self)) ... Methods ("public" (set_actual9 self [value a]) void - (/.set value9 value)) + (/.set value9 value self)) ("public" (get_actual9 self []) a - (/.get value9))) + (/.get value9 self))) (/.import (test/TestClass9 a) "[1]::[0]" @@ -531,7 +531,7 @@ ("public" value10 a) ... Constructors ("public" [] (new self [init a]) [] - (/.set value10 init))) + (/.set value10 init self))) (/.import (test/TestClass10 a) "[1]::[0]" @@ -543,7 +543,7 @@ ("public" value11 a) ... Constructors ("public" [] (new self [init a]) [] - (/.set value11 init))) + (/.set value11 init self))) (/.import (test/TestClass11 a) "[1]::[0]" diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index b3a516885..c3a1b8f53 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -5,7 +5,6 @@ ["[0]" type (.use "[1]#[0]" equivalence)] [abstract [monad (.only do)] - ["[0]" predicate] [\\specification ["$[0]" equivalence] ["$[0]" order] @@ -13,7 +12,9 @@ ["$[0]" codec]]] [control ["[0]" try] - ["[0]" exception]] + ["[0]" exception] + [function + ["[0]" predicate]]] [data ["[0]" product] ["[0]" bit (.use "[1]#[0]" equivalence)]] diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index 53271cc96..eecc8a0fb 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -4,7 +4,6 @@ ["_" test (.only Test)] [abstract [monad (.only do)] - ["[0]" predicate] [\\specification ["$[0]" equivalence] ["$[0]" hash] @@ -13,7 +12,9 @@ ["$[0]" codec]]] [control ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception]] + ["[0]" exception] + [function + ["[0]" predicate]]] [data [collection ["[0]" list] diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index 751d0f3f7..c87a956cd 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -4,7 +4,6 @@ ["_" test (.only Test)] [abstract [monad (.only do)] - ["[0]" predicate] [\\specification ["$[0]" equivalence] ["$[0]" hash] @@ -13,7 +12,9 @@ ["$[0]" codec]]] [control ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception]] + ["[0]" exception] + [function + ["[0]" predicate]]] [data [collection ["[0]" set] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux index 9f3d0b5ac..e6eb4333c 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux @@ -4,13 +4,14 @@ ["_" test (.only Test)] [abstract ["[0]" monad (.only do)] - ["[0]" predicate] [\\specification ["$[0]" equivalence]]] [control ["[0]" pipe] ["[0]" try (.only Try) (.use "[1]#[0]" functor)] - ["[0]" exception (.only Exception)]] + ["[0]" exception (.only Exception)] + [function + ["[0]" predicate]]] [data ["[0]" product] ["[0]" bit (.use "[1]#[0]" equivalence)] diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux index ce23ba709..711d0401f 100644 --- a/stdlib/source/test/lux/type/refinement.lux +++ b/stdlib/source/test/lux/type/refinement.lux @@ -3,10 +3,11 @@ [lux (.except) ["_" test (.only Test)] [abstract - [predicate (.only Predicate)] [monad (.only do)]] [control - ["[0]" maybe (.use "[1]#[0]" monad)]] + ["[0]" maybe (.use "[1]#[0]" monad)] + [function + [predicate (.only Predicate)]]] [data [collection ["[0]" list (.use "[1]#[0]" functor)]]] diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index 21e653751..36f1f444b 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -3,13 +3,14 @@ [lux (.except) ["_" test (.only Test)] [abstract - [predicate (.only Predicate)] [monad (.only do)]] [control ["[0]" try (.only Try)] ["[0]" exception] [concurrency - ["[0]" async (.only Async)]]] + ["[0]" async (.only Async)]] + [function + [predicate (.only Predicate)]]] [data ["[0]" binary (.only Binary) (.use "[1]#[0]" equivalence)] ["[0]" text (.use "[1]#[0]" equivalence) -- cgit v1.2.3