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 +- 11 files changed, 566 insertions(+), 669 deletions(-) (limited to 'stdlib/source/documentation') 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.")] [])) -- cgit v1.2.3