diff options
| author | Eduardo Julian | 2023-02-12 02:54:39 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2023-02-12 02:54:39 -0400 |
| commit | 049dcdc0c6dc678786dbf854a20385fb6ef06f9a (patch) | |
| tree | 65188f9d0858116d20051930705aa73b66d2aaa5 /stdlib/source | |
| parent | 6c4c9a8c10950e3244f15451fe18fb768abee924 (diff) | |
Added an abstraction for interest rates.
Diffstat (limited to 'stdlib/source')
46 files changed, 674 insertions, 431 deletions
diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 01614c02b..24ea6295c 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -301,11 +301,6 @@ ($.comment "=>") ($.example #1)) - ($.definition /.type - "Takes a type expression and returns its representation as data-structure." - ($.example (type_literal (All (_ a) - (Maybe (List a)))))) - ($.definition /.is "The type-annotation macro." ($.example (is (List Int) diff --git a/stdlib/source/documentation/lux/meta/type.lux b/stdlib/source/documentation/lux/meta/type.lux index 778298d1f..72d876cb5 100644 --- a/stdlib/source/documentation/lux/meta/type.lux +++ b/stdlib/source/documentation/lux/meta/type.lux @@ -262,13 +262,19 @@ (foo expression))) (Bar a b c)))) ($.comment "=>") - ($.example (.type_literal (Bar Bit Nat Text)))) + ($.example (/.literal (Bar Bit Nat Text)))) ($.definition /.let "Local bindings for types." ($.example (let [side (Either Int Frac)] (List [side side])))) + ($.definition /.literal + "Takes a type expression and returns its representation as data-structure." + ($.example (/.literal + (All (_ of) + (Maybe (List of)))))) + (all list#composite ..\\parser diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index efe42c285..a2eefc83f 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3038,17 +3038,17 @@ (meta#in (list syntax))} syntax)) -(def' .private (normal_type type) - (-> Code +(def' .private (normal_type type#literal' type) + (-> (-> Code ($ Meta Code)) Code ($ Meta Code)) ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] (<| (function' [lux]) - (meta#let lux [parts (monad#each#meta normal_type parts)]) + (meta#let lux [parts (monad#each#meta (normal_type type#literal') parts)]) (meta#return lux (` {(, (symbol$ symbol)) (,* parts)}))) [_ {#Tuple members}] (<| (function' [lux]) - (meta#let lux [members (monad#each#meta normal_type members)]) + (meta#let lux [members (monad#each#meta (normal_type type#literal') members)]) (meta#return lux (` (Tuple (,* members))))) [_ {#Form {#Item [_ {#Symbol ["library/lux" "in_module#"]}] @@ -3056,7 +3056,7 @@ {#Item type' {#End}}}}}] (<| (function' [lux]) - (meta#let lux [type' (normal_type type')]) + (meta#let lux [type' (normal_type type#literal' type')]) (meta#return lux (` (.in_module# (, (text$ module)) (, type'))))) [_ {#Form {#Item [_ {#Symbol ["" ","]}] {#Item expression {#End}}}}] @@ -3066,7 +3066,7 @@ {#Item value {#End}}}}] (<| (function' [lux]) - (meta#let lux [body (normal_type body)]) + (meta#let lux [body (normal_type type#literal' body)]) (meta#return lux [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] {#Item value {#End}}}}])) @@ -3077,17 +3077,25 @@ {#Item body {#End}}}}}}] (<| (function' [lux]) - (meta#let lux [body (normal_type body)]) + (meta#let lux [body (normal_type type#literal' body)]) (meta#return lux [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] {#Item _permission {#Item _level {#Item body {#End}}}}}}])) + [_ {#Form {#Item [_ {#Form {#Item [_ {#Symbol ["library/lux" "in_module#"]}] + {#Item [_ {#Text "library/lux"}] + {#Item [_ {#Symbol ["library/lux" "type#literal"]}] + {#End}}}}}] + {#Item type' + {#End}}}}] + (type#literal' type') + [_ {#Form {#Item type_fn args}}] (<| (function' [lux]) - (meta#let lux [type_fn (normal_type type_fn)]) - (meta#let lux [args (monad#each#meta normal_type args)]) + (meta#let lux [type_fn (normal_type type#literal' type_fn)]) + (meta#let lux [args (monad#each#meta (normal_type type#literal') args)]) (meta#return lux (list#mix (.is# (-> Code Code Code) (function' [arg type_fn] (` {.#Apply (, arg) (, type_fn)}))) type_fn @@ -3164,35 +3172,42 @@ ..#scope_type_vars scope_type_vars/pre ..#eval eval/pre])))) -(def' .public type_literal +(def' .private (type#literal' type) + (-> Code + ($ Meta Code)) + (<| (function' [lux]) + (let' [initialized_quantification? (initialized_quantification? lux)]) + (if initialized_quantification? + (<| (meta#let lux [type+ (total_expansion type)]) + ({{#Item type' {#End}} + (<| (meta#let lux [type'' (normal_type type#literal' type')]) + (meta#return lux type'')) + + _ + (meta#failure "The expansion of the type-syntax had to yield a single element.")} + type+)) + (<| (meta#let lux [it (with_quantification' + (type#literal' type))]) + (meta#return lux (..quantified it)))))) + +(def' .private type#literal Macro - (macro (type_literal tokens) + (macro (type#literal tokens) ({{#Item type {#End}} (<| (function' [lux]) - (let' [initialized_quantification? (initialized_quantification? lux)]) - (if initialized_quantification? - (<| (meta#let lux [type+ (total_expansion type)]) - ({{#Item type' {#End}} - (<| (meta#let lux [type'' (normal_type type')]) - (meta#return lux (list type''))) - - _ - (meta#failure "The expansion of the type-syntax had to yield a single element.")} - type+)) - (<| (meta#let lux [it (with_quantification' - (one_expansion - (type_literal tokens)))]) - (meta#return lux (list (..quantified it)))))) + (meta#let lux [it (type#literal' type)]) + (meta#return lux (list it))) _ - (failure (..wrong_syntax_error (symbol ..type_literal)))} + (failure (..wrong_syntax_error (symbol ..type#literal)))} tokens))) (def' .public is Macro (macro (_ tokens) ({{#Item type {#Item value {#End}}} - (meta#in (list (` (.is# (..type_literal (, type)) + (meta#in (list (` (.is# ((.in_module# (, (text$ ..prelude)) ..type#literal) + (, type)) (, value))))) _ @@ -3203,7 +3218,8 @@ Macro (macro (_ tokens) ({{#Item type {#Item value {#End}}} - (meta#in (list (` (.as# (..type_literal (, type)) + (meta#in (list (` (.as# ((.in_module# (, (text$ ..prelude)) ..type#literal) + (, type)) (, value))))) _ @@ -3248,7 +3264,7 @@ (with_template [<name> <tag>] [(def' .private (<name> type) - (type_literal + (type#literal (-> Type (List Type))) ({{<tag> left right} @@ -3264,7 +3280,7 @@ ) (def' .private (flat_application type) - (type_literal + (type#literal (-> Type [Type (List Type)])) ({{#Apply head func'} @@ -3323,7 +3339,7 @@ type)) (def' .private (meta#try it) - (type_literal + (type#literal (All (_ of) (-> (Meta of) (Meta (Either Text of))))) @@ -3346,7 +3362,7 @@ it)) (def' .private static' - (type_literal + (type#literal (-> Bit Code (Meta Code))) (let' [simple_literal (is (-> Symbol @@ -3446,7 +3462,7 @@ (.as# Macro' it)) (def' .private (when_expansion#macro when_expansion pattern body branches) - (type_literal + (type#literal (-> (-> (List Code) (Meta (List Code))) Code Code (List Code) (Meta (List Code)))) (do meta#monad @@ -3456,7 +3472,7 @@ (in (list#partial pattern body branches)))) (def' .private (when_expansion branches) - (type_literal + (type#literal (-> (List Code) (Meta (List Code)))) ({{#Item [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] @@ -3523,7 +3539,7 @@ (failure "Wrong syntax for pattern#or"))))) (def' .private (symbol? code) - (type_literal + (type#literal (-> Code Bit)) (when code @@ -3586,13 +3602,13 @@ (def' .private Parser Type {#Named [..prelude "Parser"] - (type_literal + (type#literal (All (_ of) (-> (List Code) (Maybe [(List Code) of]))))}) (def' .private (parsed parser tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (List Code) (Maybe of)))) @@ -3604,14 +3620,14 @@ {#None})) (def' .private (inP it tokens) - (type_literal + (type#literal (All (_ of) (-> of (Parser of)))) {#Some [tokens it]}) (def' .private (orP leftP rightP tokens) - (type_literal + (type#literal (All (_ left right) (-> (Parser left) (Parser right) @@ -3629,7 +3645,7 @@ {#None}))) (def' .private (eitherP leftP rightP tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (Parser of) @@ -3642,7 +3658,7 @@ it)) (def' .private (andP leftP rightP tokens) - (type_literal + (type#literal (All (_ left right) (-> (Parser left) (Parser right) @@ -3655,7 +3671,7 @@ (in [tokens [left right]]))) (def' .private (afterP leftP rightP tokens) - (type_literal + (type#literal (All (_ _ of) (-> (Parser _) (Parser of) @@ -3666,7 +3682,7 @@ (rightP tokens))) (def' .private (someP itP tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (Parser (List of))))) @@ -3681,7 +3697,7 @@ {#Some [tokens (list)]})) (def' .private (manyP itP tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (Parser (List of))))) @@ -3693,7 +3709,7 @@ (in [tokens (list#partial head tail)]))) (def' .private (maybeP itP tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (Parser (Maybe of))))) @@ -3705,7 +3721,7 @@ {#Some [tokens {#None}]})) (def' .private (tupleP itP tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (Parser of)))) @@ -3719,7 +3735,7 @@ {#None})) (def' .private (formP itP tokens) - (type_literal + (type#literal (All (_ of) (-> (Parser of) (Parser of)))) @@ -3733,7 +3749,7 @@ {#None})) (def' .private (bindingP tokens) - (type_literal + (type#literal (Parser [Text Code])) (when tokens (list#partial [_ {#Symbol ["" name]}] value &rest) @@ -3743,7 +3759,7 @@ {#None})) (def' .private (endP tokens) - (type_literal + (type#literal (Parser Any)) (when tokens (list) @@ -3753,7 +3769,7 @@ {#None})) (def' .private (anyP tokens) - (type_literal + (type#literal (Parser Code)) (when tokens (list#partial code tokens') @@ -3763,7 +3779,7 @@ {#None})) (def' .private (localP tokens) - (type_literal + (type#literal (-> (List Code) (Maybe [(List Code) Text]))) (when tokens @@ -3774,7 +3790,7 @@ {#None})) (def' .private (symbolP tokens) - (type_literal + (type#literal (-> (List Code) (Maybe [(List Code) Symbol]))) (when tokens @@ -3786,7 +3802,7 @@ (with_template [<parser> <item_type> <item_parser>] [(def' .private (<parser> tokens) - (type_literal + (type#literal (-> (List Code) (Maybe (List <item_type>)))) (when tokens @@ -3806,7 +3822,7 @@ (with_template [<parser> <parameter_type> <parameters_parser>] [(def' .private (<parser> tokens) - (type_literal + (type#literal (Parser [Text (List <parameter_type>)])) (when tokens (list#partial [_ {#Form local_declaration}] tokens') @@ -3827,7 +3843,7 @@ ) (def' .private (export_policyP tokens) - (type_literal + (type#literal (-> (List Code) [(List Code) Code])) (when tokens @@ -3850,7 +3866,7 @@ (with_template [<parser> <parameter_type> <local>] [(def' .private (<parser> tokens) - (type_literal + (type#literal (-> (List Code) (Maybe [(List Code) [Code Text (List <parameter_type>)]]))) @@ -3865,7 +3881,7 @@ ) (def' .private (bodyP tokens) - (type_literal + (type#literal (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]]))) @@ -3882,7 +3898,7 @@ {#None})) (def' .private (definitionP tokens) - (type_literal + (type#literal (-> (List Code) (Maybe [Code Text @@ -4456,9 +4472,11 @@ (, type)))}))]] (when type' {#Some type''} - (let [typeC (` {.#Named [(, (text$ module_name)) - (, (text$ name))] - (..type_literal (, type''))})] + (do meta#monad + [type'' (type#literal' type'') + .let [typeC (` {.#Named [(, (text$ module_name)) + (, (text$ name))] + (, type'')})]] (in (when labels?? {#Some labels} (list#partial (` (def (, export_policy) (, type_name) diff --git a/stdlib/source/library/lux/abstract/equivalence.lux b/stdlib/source/library/lux/abstract/equivalence.lux index 81b3b7d2f..4f0a1f633 100644 --- a/stdlib/source/library/lux/abstract/equivalence.lux +++ b/stdlib/source/library/lux/abstract/equivalence.lux @@ -8,14 +8,16 @@ [functor ["[0]" contravariant]]]) -(type .public (Equivalence a) +(type .public (Equivalence of) (Interface - (is (-> a a Bit) + (is (-> of of + Bit) =))) (def .public (rec sub) - (All (_ a) - (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a))) + (All (_ of) + (-> (-> (Equivalence of) (Equivalence of)) + (Equivalence of))) (implementation (def (= left right) (sub = left right)))) @@ -23,7 +25,7 @@ (def .public functor (contravariant.Functor Equivalence) (implementation - (def (each f equivalence) + (def (each value it) (implementation (def (= reference sample) - (of equivalence = (f reference) (f sample))))))) + (of it = (value reference) (value sample))))))) diff --git a/stdlib/source/library/lux/control/concurrency/event.lux b/stdlib/source/library/lux/control/concurrency/event.lux index 5c53d860a..ebec263d5 100644 --- a/stdlib/source/library/lux/control/concurrency/event.lux +++ b/stdlib/source/library/lux/control/concurrency/event.lux @@ -19,6 +19,8 @@ [math [number ["n" nat]]] + [meta + ["[0]" type]] [world [time ["[0]" instant (.only Instant) (.use "[1]#[0]" order)] @@ -27,7 +29,8 @@ ["[0]" atom (.only Atom)]]) (def Action - (type_literal (IO Any))) + (type.literal + (IO Any))) (type Event (Record @@ -35,10 +38,13 @@ #what Action])) (def Scheduler - (type_literal (-> Nat Action (IO Any)))) + (type.literal + (-> Nat Action + (IO Any)))) (def Loop - (type_literal (IO (Try Nat)))) + (type.literal + (IO (Try Nat)))) (exception.def .public (error_during_execution [loop error]) (Exception [Text Text]) diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux index d746ff944..876fe4aed 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -9,7 +9,7 @@ [apply (.only Apply)] [monad (.only Monad)]] [meta - [type + ["[0]" type (.only) ["[0]" nominal (.except def)]]]]]) (nominal.def .public (Policy brand value label) @@ -58,9 +58,10 @@ (def (of_policy constructor) (-> Type Type) - (type_literal (All (_ brand label) - (constructor (All (_ value) - (Policy brand value label)))))) + (type.literal + (All (_ brand label) + (constructor (All (_ value) + (Policy brand value label)))))) (def .public functor (, (..of_policy Functor)) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 1744821c4..bfaf2ba6d 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -611,7 +611,7 @@ (do [! monad] [lMla MlMla ... TODO: Remove this version ASAP and use one below. - lla (for @.old (is {.#Apply (type_literal (List (List (parameter 1)))) + lla (for @.old (is {.#Apply (List (List (parameter 1))) (parameter 0)} (monad.all ! lMla)) (monad.all ! lMla))] diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 803d2e102..a3addcd5b 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -125,7 +125,8 @@ )) (def Inspector - (.type_literal (Format Any))) + (type.literal + (Format Any))) (for @.lua (def (tuple_array tuple) (-> (array.Array Any) (array.Array Any)) diff --git a/stdlib/source/library/lux/math/number/i32.lux b/stdlib/source/library/lux/math/number/i32.lux index 0ad406465..39c11104a 100644 --- a/stdlib/source/library/lux/math/number/i32.lux +++ b/stdlib/source/library/lux/math/number/i32.lux @@ -27,7 +27,8 @@ Type (when (type_of ..sub) {.#Apply :size: :sub:} - (type_literal (I64 :size:)) + (type.literal + (I64 :size:)) _ (undefined))) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 17e50c28a..af687911a 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -31,7 +31,7 @@ ["[0]" meta (.only) ["[0]" static] ["[0]" configuration (.only Configuration)] - [type (.only sharing) + ["[0]" type (.only sharing) ["[0]" check]] [compiler ["@" target]]] @@ -784,7 +784,7 @@ (def .public Custom Type - (type_literal + (type.literal (-> (List Text) (Try ///.Custom)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux index 640cfdd6c..c43b31555 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux @@ -43,7 +43,7 @@ (do phase.monad [lengthA (analysis/type.expecting Nat (phase archive lengthC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list lengthA)}]))))])) @@ -58,7 +58,7 @@ analysis/type.with_var (function (_ [@write :write:])) (do phase.monad - [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + [arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) _ (analysis/type.inference Nat) @ meta.location] @@ -77,7 +77,7 @@ (do phase.monad [indexA (analysis/type.expecting Nat (phase archive indexC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) _ (analysis/type.inference :read:) @ meta.location] @@ -98,9 +98,9 @@ (phase archive indexC)) valueA (analysis/type.expecting :write: (phase archive valueC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA valueA arrayA)}]))))])) @@ -117,9 +117,9 @@ (do phase.monad [indexA (analysis/type.expecting Nat (phase archive indexC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA arrayA)}]))))])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux index 9e1efe8e2..568caecae 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -246,6 +246,8 @@ (.type Method_Signature (Record [#method .Type + #inputs (List (Type Value)) + #output (Type Return) #deprecated? Bit #throws (List .Type)])) @@ -272,6 +274,15 @@ [primitives_are_not_objects] ) +(def (method_signature_format it) + (%.Format Method_Signature) + (exception.report + (list ["Type" (%.type (the #method it))] + ["Arguments" (exception.listing jvm.format (the #inputs it))] + ["Return" (jvm.format (the #output it))] + ["Deprecated?" (%.bit (the #deprecated? it))] + ["Throws" (exception.listing %.type (the #throws it))]))) + (with_template [<name>] [(exception.def .public (<name> [class_variables class method method_variables inputsJT hints]) (exception.Exception [(List (Type Var)) @@ -286,7 +297,7 @@ ["Method" method] ["Method variables" (exception.listing ..signature method_variables)] ["Arguments" (exception.listing ..signature inputsJT)] - ["Hints" (exception.listing %.type (list#each product.left hints))])))] + ["Hints" (exception.listing ..method_signature_format hints)])))] [no_candidates] [too_many_candidates] @@ -492,11 +503,11 @@ (function (_ [@write :write:])) (do phase.monad [_ (typeA.inference ..int) - arrayA (<| (typeA.expecting (.type_literal (array.Array' :read: :write:))) + arrayA (<| (typeA.expecting (type.literal (array.Array' :read: :write:))) (analyse archive arrayC)) :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) - arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) + arrayJT (jvm_array_type (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] (list (analysis.text @ (..signature arrayJT)) @@ -733,13 +744,13 @@ (function (_ [@write :write:])) (do phase.monad [_ (typeA.inference :read:) - arrayA (<| (typeA.expecting (.type_literal (array.Array' :read: :write:))) + arrayA (<| (typeA.expecting (type.literal (array.Array' :read: :write:))) (analyse archive arrayC)) idxA (<| (typeA.expecting ..int) (analyse archive idxC)) :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) - arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) + arrayJT (jvm_array_type (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] (list (analysis.text @ (..signature arrayJT)) @@ -778,8 +789,8 @@ typeA.with_var (function (_ [@write :write:])) (do phase.monad - [_ (typeA.inference (.type_literal (array.Array' :read: :write:))) - arrayA (<| (typeA.expecting (.type_literal (array.Array' :read: :write:))) + [_ (typeA.inference (type.literal (array.Array' :read: :write:))) + arrayA (<| (typeA.expecting (type.literal (array.Array' :read: :write:))) (analyse archive arrayC)) idxA (<| (typeA.expecting ..int) (analyse archive idxC)) @@ -787,7 +798,7 @@ (analyse archive valueC)) :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) - arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) + arrayJT (jvm_array_type (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] (list (analysis.text @ (..signature arrayJT)) @@ -1239,7 +1250,9 @@ (def index_parameter (-> Nat .Type) - (|>> (n.* 2) ++ {.#Parameter})) + (|>> (n.* 2) + ++ + {.#Parameter})) (def (jvm_type_var_mapping owner_tvars method_tvars) (-> (List Text) (List Text) @@ -1305,16 +1318,14 @@ ffi.of_string))) [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] (do [! phase.monad] - [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) - (array.list {.#None}) - (monad.each ! (|>> reflection!.type phase.of_try)) - (phase#each (monad.each ! (..reflection_type mapping))) - phase#conjoint) - outputT (|> method - ..return_type - phase.of_try - (phase#each (..reflection_return mapping)) - phase#conjoint) + [inputsT' (|> (java/lang/reflect/Method::getGenericParameterTypes method) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.of_try))) + inputsT (monad.each ! (..reflection_type mapping) inputsT') + outputT' (|> method + ..return_type + phase.of_try) + outputT (..reflection_return mapping outputT') .let [concrete_exceptions (..concrete_method_exceptions method)] concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions) generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) @@ -1332,11 +1343,13 @@ owner_tvarsT} inputsT))) outputT)]] - (in [methodT - (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) - (if (list.empty? generic_exceptions) - concrete_exceptions - generic_exceptions)])))) + (in [#method methodT + #inputs inputsT' + #output outputT' + #deprecated? (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) + #throws (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])))) (def (constructor_signature constructor) (-> (java/lang/reflect/Constructor java/lang/Object) @@ -1352,11 +1365,10 @@ ffi.of_string))) [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] (do [! phase.monad] - [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) - (array.list {.#None}) - (monad.each ! (|>> reflection!.type phase.of_try)) - (phase#each (monad.each ! (reflection_type mapping))) - phase#conjoint) + [inputsT' (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) + (array.list {.#None}) + (monad.each ! (|>> reflection!.type phase.of_try))) + inputsT (monad.each ! (reflection_type mapping) inputsT') .let [concrete_exceptions (..concrete_constructor_exceptions constructor)] concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions) generic_exceptions (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) @@ -1369,11 +1381,13 @@ constructorT (<| (type.univ_q (dictionary.size mapping)) (type.function inputsT) objectT)]] - (in [constructorT - (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) - (if (list.empty? generic_exceptions) - concrete_exceptions - generic_exceptions)])))) + (in [#method constructorT + #inputs inputsT' + #output jvm.void + #deprecated? (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) + #throws (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])))) (.type Evaluation (Variant @@ -1554,10 +1568,11 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) .let [argsT (list#each product.left argsTC)] - [methodT deprecated? exceptionsT] (..method_candidate false class_loader class_tvars class method_tvars method {#Static} argsT) - _ (phase.assertion ..deprecated_method [class method methodT] - (not deprecated?)) - [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) + method_candidate (..method_candidate false class_loader class_tvars class method_tvars method {#Static} argsT) + .let [method_type (the #method method_candidate)] + _ (phase.assertion ..deprecated_method [class method method_type] + (not (the #deprecated? method_candidate))) + [outputT argsA] (inference.general archive analyse method_type (list#each product.right argsTC)) outputJT (check_return outputT) @ meta.location] (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] @@ -1575,10 +1590,11 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) .let [argsT (list#each product.left argsTC)] - [methodT deprecated? exceptionsT] (..method_candidate true class_loader class_tvars class method_tvars method {#Virtual} argsT) - _ (phase.assertion ..deprecated_method [class method methodT] - (not deprecated?)) - [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) + method_candidate (..method_candidate true class_loader class_tvars class method_tvars method {#Virtual} argsT) + .let [method_type (the #method method_candidate)] + _ (phase.assertion ..deprecated_method [class method method_type] + (not (the #deprecated? method_candidate))) + [outputT allA] (inference.general archive analyse method_type (list.partial objectC (list#each product.right argsTC))) .let [[objectA argsA] (when allA {.#Item objectA argsA} [objectA argsA] @@ -1603,10 +1619,11 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) .let [argsT (list#each product.left argsTC)] - [methodT deprecated? exceptionsT] (..method_candidate false class_loader class_tvars class method_tvars method {#Special} argsT) - _ (phase.assertion ..deprecated_method [class method methodT] - (not deprecated?)) - [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) + method_candidate (..method_candidate false class_loader class_tvars class method_tvars method {#Special} argsT) + .let [method_type (the #method method_candidate)] + _ (phase.assertion ..deprecated_method [class method method_type] + (not (the #deprecated? method_candidate))) + [outputT allA] (inference.general archive analyse method_type (list.partial objectC (list#each product.right argsTC))) .let [[objectA argsA] (when allA {.#Item objectA argsA} [objectA argsA] @@ -1634,10 +1651,11 @@ class (phase.of_try (reflection!.load class_loader class_name)) _ (phase.assertion non_interface class_name (ffi.of_boolean (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)))) - [methodT deprecated? exceptionsT] (..method_candidate true class_loader class_tvars class_name method_tvars method {#Interface} argsT) - _ (phase.assertion ..deprecated_method [class_name method methodT] - (not deprecated?)) - [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) + method_candidate (..method_candidate true class_loader class_tvars class_name method_tvars method {#Interface} argsT) + .let [method_type (the #method method_candidate)] + _ (phase.assertion ..deprecated_method [class_name method method_type] + (not (the #deprecated? method_candidate))) + [outputT allA] (inference.general archive analyse method_type (list.partial objectC (list#each product.right argsTC))) .let [[objectA argsA] (when allA {.#Item objectA argsA} [objectA argsA] @@ -1662,10 +1680,11 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) .let [argsT (list#each product.left argsTC)] - [methodT deprecated? exceptionsT] (..constructor_candidate class_loader class_tvars class method_tvars argsT) - _ (phase.assertion ..deprecated_method [class ..constructor_method methodT] - (not deprecated?)) - [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) + method_candidate (..constructor_candidate class_loader class_tvars class method_tvars argsT) + .let [method_type (the #method method_candidate)] + _ (phase.assertion ..deprecated_method [class ..constructor_method method_type] + (not (the #deprecated? method_candidate))) + [outputT argsA] (inference.general archive analyse method_type (list#each product.right argsTC)) @ meta.location] (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] (list.partial (analysis.text @ (..signature (jvm.class class (list)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux index 40c6978b1..1c2c5a324 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux @@ -36,7 +36,7 @@ Any)) (def Object - (for @.lua (type_literal (ffi.Object Any)) + (for @.lua (type.literal (ffi.Object Any)) Any)) (def Function @@ -55,7 +55,7 @@ (do phase.monad [lengthA (analysis/type.expecting Nat (phase archive lengthC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list lengthA)}]))))])) @@ -70,7 +70,7 @@ analysis/type.with_var (function (_ [@write :write:])) (do phase.monad - [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + [arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) _ (analysis/type.inference Nat) @ meta.location] @@ -89,7 +89,7 @@ (do phase.monad [indexA (analysis/type.expecting Nat (phase archive indexC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) _ (analysis/type.inference :read:) @ meta.location] @@ -110,9 +110,9 @@ (phase archive indexC)) valueA (analysis/type.expecting :write: (phase archive valueC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA valueA arrayA)}]))))])) @@ -129,9 +129,9 @@ (do phase.monad [indexA (analysis/type.expecting Nat (phase archive indexC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA arrayA)}]))))])) @@ -190,9 +190,9 @@ [<code>.any (function (_ extension phase archive inputC) (do [! phase.monad] - [inputA (analysis/type.expecting (type_literal <fromT>) + [inputA (analysis/type.expecting (type.literal <fromT>) (phase archive inputC)) - _ (analysis/type.inference (type_literal <toT>)) + _ (analysis/type.inference (type.literal <toT>)) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list inputA)}])))]))] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index b7a0df63b..54fa7817a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -26,7 +26,7 @@ ["<[1]>" \\parser (.only Parser)]] [macro ["^" pattern]] - [type + ["[0]" type (.only) ["[0]" check]]]]] ["[0]" /// (.only) ["[0]" synthesis @@ -187,11 +187,11 @@ (<| typeA.with_var (function (_ [@var :var:])) (do [! phase.monad] - [_ (typeA.inference (type_literal (Either Text :var:))) + [_ (typeA.inference (type.literal (Either Text :var:))) @ meta.location] (|> opC (analyse archive) - (typeA.expecting (type_literal (-> .Any :var:))) + (typeA.expecting (type.literal (-> .Any :var:))) (of ! each (|>> list {analysis.#Extension (..translation extension_name)} [@]))))))])) @@ -338,7 +338,7 @@ (install "error#" (unary Text Nothing)))) (def I64* - (type_literal (I64 Any))) + (type.literal (I64 Any))) (def with_i64_extensions (-> Bundle @@ -377,7 +377,7 @@ (install "f64_int#" (unary Frac Int)) (install "f64_encoded#" (unary Frac Text)) - (install "f64_decoded#" (unary Text (type_literal (Maybe Frac)))))) + (install "f64_decoded#" (unary Text (type.literal (Maybe Frac)))))) (def with_text_extensions (-> Bundle @@ -385,7 +385,7 @@ (|>> (install "text_=#" (binary Text Text Bit)) (install "text_<#" (binary Text Text Bit)) (install "text_composite#" (variadic Text Text synthesis.synthesis)) - (install "text_index#" (trinary Nat Text Text (type_literal (Maybe Nat)))) + (install "text_index#" (trinary Nat Text Text (type.literal (Maybe Nat)))) (install "text_size#" (unary Text Nat)) (install "text_char#" (binary Nat Text Nat)) (install "text_clip#" (trinary Nat Nat Text Text)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux index b5e7e22da..058008392 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/php.lux @@ -43,7 +43,7 @@ (do phase.monad [lengthA (analysis/type.with_type Nat (phase archive lengthC)) - _ (analysis/type.infer (type_literal (Array :var:)))] + _ (analysis/type.infer (type.literal (Array :var:)))] (in {analysis.#Extension extension (list lengthA)}))))])) (def array::length @@ -54,7 +54,7 @@ (<| analysis/type.with_var (function (_ [@var :var:])) (do phase.monad - [arrayA (analysis/type.with_type (type_literal (Array :var:)) + [arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) _ (analysis/type.infer Nat)] (in {analysis.#Extension extension (list arrayA)}))))])) @@ -69,7 +69,7 @@ (do phase.monad [indexA (analysis/type.with_type Nat (phase archive indexC)) - arrayA (analysis/type.with_type (type_literal (Array :var:)) + arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) _ (analysis/type.infer :var:)] (in {analysis.#Extension extension (list indexA arrayA)}))))])) @@ -86,9 +86,9 @@ (phase archive indexC)) valueA (analysis/type.with_type :var: (phase archive valueC)) - arrayA (analysis/type.with_type (type_literal (Array :var:)) + arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) - _ (analysis/type.infer (type_literal (Array :var:)))] + _ (analysis/type.infer (type.literal (Array :var:)))] (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) (def array::delete @@ -101,9 +101,9 @@ (do phase.monad [indexA (analysis/type.with_type Nat (phase archive indexC)) - arrayA (analysis/type.with_type (type_literal (Array :var:)) + arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) - _ (analysis/type.infer (type_literal (Array :var:)))] + _ (analysis/type.infer (type.literal (Array :var:)))] (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def bundle::array @@ -122,7 +122,7 @@ Any)) (def Object - (for @.php (type_literal (ffi.Object Any)) + (for @.php (type.literal (ffi.Object Any)) Any)) (def Function @@ -205,7 +205,7 @@ (do [! phase.monad] [formatA (analysis/type.with_type Text (phase archive formatC)) - dataA (analysis/type.with_type (type_literal (Array (I64 Any))) + dataA (analysis/type.with_type (type.literal (Array (I64 Any))) (phase archive dataC)) _ (analysis/type.infer Text)] (in {analysis.#Extension extension (list formatA dataA)})))])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux index 5c69be1ae..6733ce288 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux @@ -42,7 +42,7 @@ (do phase.monad [lengthA (analysis/type.expecting Nat (phase archive lengthC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list lengthA)}]))))])) @@ -57,7 +57,7 @@ analysis/type.with_var (function (_ [@write :write:])) (do phase.monad - [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + [arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) _ (analysis/type.inference Nat) @ meta.location] @@ -76,7 +76,7 @@ (do phase.monad [indexA (analysis/type.expecting Nat (phase archive indexC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) _ (analysis/type.inference :read:) @ meta.location] @@ -97,9 +97,9 @@ (phase archive indexC)) valueA (analysis/type.expecting :write: (phase archive valueC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA valueA arrayA)}]))))])) @@ -116,9 +116,9 @@ (do phase.monad [indexA (analysis/type.expecting Nat (phase archive indexC)) - arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) + arrayA (analysis/type.expecting (type.literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA arrayA)}]))))])) @@ -137,7 +137,7 @@ Any)) (def Object - (for @.python (type_literal (ffi.Object Any)) + (for @.python (type.literal (ffi.Object Any)) Any)) (def Function diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux index 532c98f27..58955a247 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -43,7 +43,7 @@ (do phase.monad [lengthA (<| (analysis/type.expecting Nat) (phase archive lengthC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list lengthA)}]))))])) @@ -58,7 +58,7 @@ analysis/type.with_var (function (_ [@write :write:])) (do phase.monad - [arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + [arrayA (<| (analysis/type.expecting (type.literal (array.Array' :read: :write:))) (phase archive arrayC)) _ (analysis/type.inference Nat) @ meta.location] @@ -77,7 +77,7 @@ (do phase.monad [indexA (<| (analysis/type.expecting Nat) (phase archive indexC)) - arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + arrayA (<| (analysis/type.expecting (type.literal (array.Array' :read: :write:))) (phase archive arrayC)) _ (analysis/type.inference :read:) @ meta.location] @@ -98,9 +98,9 @@ (phase archive indexC)) valueA (<| (analysis/type.expecting :write:) (phase archive valueC)) - arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + arrayA (<| (analysis/type.expecting (type.literal (array.Array' :read: :write:))) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA valueA arrayA)}]))))])) @@ -117,9 +117,9 @@ (do phase.monad [indexA (<| (analysis/type.expecting Nat) (phase archive indexC)) - arrayA (<| (analysis/type.expecting (type_literal (array.Array' :read: :write:))) + arrayA (<| (analysis/type.expecting (type.literal (array.Array' :read: :write:))) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + _ (analysis/type.inference (type.literal (array.Array' :read: :write:))) @ meta.location] (in [@ {analysis.#Extension (/.translation extension) (list indexA arrayA)}]))))])) @@ -138,7 +138,7 @@ Any)) (def Object - (for @.ruby (type_literal (ffi.Object Any)) + (for @.ruby (type.literal (ffi.Object Any)) Any)) (def Function diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux index ea7885eaf..ba54519be 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/scheme.lux @@ -43,7 +43,7 @@ (do phase.monad [lengthA (analysis/type.with_type Nat (phase archive lengthC)) - _ (analysis/type.infer (type_literal (Array :var:)))] + _ (analysis/type.infer (type.literal (Array :var:)))] (in {analysis.#Extension extension (list lengthA)}))))])) (def array::length @@ -54,7 +54,7 @@ (<| analysis/type.with_var (function (_ [@var :var:])) (do phase.monad - [arrayA (analysis/type.with_type (type_literal (Array :var:)) + [arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) _ (analysis/type.infer Nat)] (in {analysis.#Extension extension (list arrayA)}))))])) @@ -69,7 +69,7 @@ (do phase.monad [indexA (analysis/type.with_type Nat (phase archive indexC)) - arrayA (analysis/type.with_type (type_literal (Array :var:)) + arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) _ (analysis/type.infer :var:)] (in {analysis.#Extension extension (list indexA arrayA)}))))])) @@ -86,9 +86,9 @@ (phase archive indexC)) valueA (analysis/type.with_type :var: (phase archive valueC)) - arrayA (analysis/type.with_type (type_literal (Array :var:)) + arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) - _ (analysis/type.infer (type_literal (Array :var:)))] + _ (analysis/type.infer (type.literal (Array :var:)))] (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) (def array::delete @@ -101,9 +101,9 @@ (do phase.monad [indexA (analysis/type.with_type Nat (phase archive indexC)) - arrayA (analysis/type.with_type (type_literal (Array :var:)) + arrayA (analysis/type.with_type (type.literal (Array :var:)) (phase archive arrayC)) - _ (analysis/type.infer (type_literal (Array :var:)))] + _ (analysis/type.infer (type.literal (Array :var:)))] (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def bundle::array diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 1768bdd07..c3dfdce4e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -264,7 +264,7 @@ <anonymous>})))] [Binary|Python (Nominal "bytearray")] - [Binary|DEFAULT (type_literal (array.Array (I64 Any)))] + [Binary|DEFAULT (type.literal (array.Array (I64 Any)))] ) (def (swapped original replacement) diff --git a/stdlib/source/library/lux/meta/compiler/meta/import.lux b/stdlib/source/library/lux/meta/compiler/meta/import.lux index ada895127..4e8264256 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/import.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/import.lux @@ -23,6 +23,7 @@ [format ["[0]" tar]]] [meta + ["[0]" type] [compiler [meta [cli (.only Library Module)]]]] @@ -30,7 +31,9 @@ ["[0]" file]]]]) (def Action - (type_literal (All (_ a) (Async (Try a))))) + (type.literal + (All (_ of) + (Async (Try of))))) (exception.def .public useless_tar_entry) diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/context.lux b/stdlib/source/library/lux/meta/compiler/meta/io/context.lux index 337e13866..171f96cf1 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/context.lux @@ -23,6 +23,8 @@ [collection ["[0]" dictionary (.only Dictionary)] ["[0]" list]]] + [meta + ["[0]" type]] [world ["[0]" file]]]] ["[0]" // (.only Context) @@ -163,7 +165,9 @@ (of ! conjoint)))) (def Action - (type_literal (All (_ a) (Async (Try a))))) + (type.literal + (All (_ of) + (Async (Try of))))) (def (canonical fs context) (-> (file.System Async) Context (Action Context)) diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/type/lux.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/type/lux.lux index a67ec9949..6b3770c85 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/type/lux.lux @@ -19,7 +19,7 @@ ["[0]" array] ["[0]" dictionary (.only Dictionary)]]] [meta - [type + ["[0]" type (.only) [":" nominal] ["[0]" check (.only Check) (.use "[1]#[0]" monad)]]]]] ["[0]" // (.only) @@ -192,10 +192,10 @@ [//reflection.double] [//reflection.char])))) {.#Nominal (|> name //reflection.class //reflection.array //reflection.reflection) {.#End}} - (|> elementT array.Array type_literal)) + (|> elementT array.Array type.literal)) _ - (|> elementT array.Array type_literal))))) + (|> elementT array.Array type.literal))))) (<>.after (<text>.this //descriptor.array_prefix)))) (def .public (type mapping) diff --git a/stdlib/source/library/lux/meta/static.lux b/stdlib/source/library/lux/meta/static.lux index d6fa0ee72..74cd3a66b 100644 --- a/stdlib/source/library/lux/meta/static.lux +++ b/stdlib/source/library/lux/meta/static.lux @@ -15,6 +15,7 @@ [number (.only hex)] ["[0]" random (.only Random)]] ["[0]" meta (.use "[1]#[0]" functor) + ["[0]" type] ["[0]" code (.only) ["<[1]>" \\parser]] [macro @@ -46,7 +47,7 @@ (syntax (_ [format <code>.any expression <code>.any]) (do meta.monad - [pair (meta.eval (.type_literal <type>) + [pair (meta.eval (type.literal <type>) (` [(, format) (, expression)])) .let [[format expression] (as <type> pair)]] (in (list (format expression))))))) @@ -55,7 +56,7 @@ (def .public expansion (syntax (_ [expression <code>.any]) (do meta.monad - [expression (meta.eval (.type_literal <type>) expression)] + [expression (meta.eval (type.literal <type>) expression)] (as <type> expression))))) (with_expansions [<type> (Ex (_ a) @@ -65,7 +66,7 @@ (syntax (_ [format <code>.any expression <code>.any]) (do meta.monad - [pair (meta.eval (.type_literal <type>) + [pair (meta.eval (type.literal <type>) (` [(, format) (, expression)])) .let [[format expression] (as <type> pair)]] (in (list#each format expression)))))) @@ -97,7 +98,7 @@ (syntax (_ [format <code>.any random <code>.any]) (do meta.monad - [pair (meta.eval (type_literal <type>) + [pair (meta.eval (type.literal <type>) (` [(, format) (, random)])) .let [[format random] (as <type> pair)] seed meta.seed @@ -112,7 +113,7 @@ (syntax (_ [format <code>.any random <code>.any]) (do meta.monad - [pair (meta.eval (type_literal <type>) + [pair (meta.eval (type.literal <type>) (` [(, format) (, random)])) .let [[format random] (as <type> pair)] seed meta.seed diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index 7952b99d8..2808ca9e0 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -584,3 +584,10 @@ (list localT (` (.these (, valueT)))))) list#conjoint))] (, bodyT))))))) + +(def .public literal + (syntax (_ [it <code>.any]) + (let [type#literal' (`` (.in_module# (,, (static .prelude)) .type#literal'))] + (do meta.monad + [it (type#literal' it)] + (in (list it)))))) diff --git a/stdlib/source/library/lux/meta/type/dynamic.lux b/stdlib/source/library/lux/meta/type/dynamic.lux index 9d26bf84f..2029fde28 100644 --- a/stdlib/source/library/lux/meta/type/dynamic.lux +++ b/stdlib/source/library/lux/meta/type/dynamic.lux @@ -44,9 +44,10 @@ (as <representation>))] (.is (try.Try (, type)) (.if (.of //.equivalence (,' =) - (.type_literal (, type)) (, g!type)) + (//.literal (, type)) + (, g!type)) {try.#Success (.as (, type) (, g!value))} - (exception.except ..wrong_type [(.type_literal (, type)) (, g!type)])))))))))) + (exception.except ..wrong_type [(//.literal (, type)) (, g!type)])))))))))) (def .public (format value) (-> Dynamic (Try Text)) diff --git a/stdlib/source/library/lux/meta/type/quotient.lux b/stdlib/source/library/lux/meta/type/quotient.lux index 1e9da9c91..92658df93 100644 --- a/stdlib/source/library/lux/meta/type/quotient.lux +++ b/stdlib/source/library/lux/meta/type/quotient.lux @@ -68,9 +68,10 @@ (?//.result (?//.applied (?.after (?//.exactly ..Class) (all ?.and ?//.any ?//.any ?//.any)))) meta.of_try)] - (in (list (` (.type_literal (..Quotient (, (//.code super)) - (, (//.code sub)) - (, (//.code %))))))))))) + (in (list (` (//.literal + (..Quotient (, (//.code super)) + (, (//.code sub)) + (, (//.code %))))))))))) (def .public (equivalence super) (All (_ super sub %) diff --git a/stdlib/source/library/lux/meta/type/refinement.lux b/stdlib/source/library/lux/meta/type/refinement.lux index 5268c943e..928a208c9 100644 --- a/stdlib/source/library/lux/meta/type/refinement.lux +++ b/stdlib/source/library/lux/meta/type/refinement.lux @@ -114,5 +114,6 @@ (?//.result (?//.applied (?.after (?//.exactly ..Refiner) (all ?.and ?//.any ?//.any)))) meta.of_try)] - (in (list (` (.type_literal (..Refined (, (//.code super)) - (, (//.code %))))))))))) + (in (list (` (//.literal + (..Refined (, (//.code super)) + (, (//.code %))))))))))) diff --git a/stdlib/source/library/lux/meta/type/row.lux b/stdlib/source/library/lux/meta/type/row.lux index 3cccb8f91..314159b1e 100644 --- a/stdlib/source/library/lux/meta/type/row.lux +++ b/stdlib/source/library/lux/meta/type/row.lux @@ -122,7 +122,7 @@ {.#Some super} (do ! [super (meta.eval Type - (` (type_literal (, super))))] + (` (type.literal (, super))))] (in {.#Some (as Type super)})) _ diff --git a/stdlib/source/library/lux/world/db/sql.lux b/stdlib/source/library/lux/world/db/sql.lux index aa938d65c..24673eea4 100644 --- a/stdlib/source/library/lux/world/db/sql.lux +++ b/stdlib/source/library/lux/world/db/sql.lux @@ -16,7 +16,7 @@ [meta [macro ["[0]" template]]] - [type + ["[0]" type (.only) ["[0]" nominal (.except def)]]]]) (def parenthesize @@ -101,8 +101,13 @@ [Statement (Statement' Any)] ) - (def Base_Query (.type_literal (Query No_Where No_Having No_Order No_Group No_Limit No_Offset))) - (def Any_Query (.type_literal (Query Any Any Any Any Any Any))) + (def Base_Query + (type.literal + (Query No_Where No_Having No_Order No_Group No_Limit No_Offset))) + + (def Any_Query + (type.literal + (Query Any Any Any Any Any Any))) ... Only use this function for debugging purposes. ... Do not use this function to actually execute SQL code. diff --git a/stdlib/source/library/lux/world/finance/interest/rate.lux b/stdlib/source/library/lux/world/finance/interest/rate.lux new file mode 100644 index 000000000..61fd9f9a5 --- /dev/null +++ b/stdlib/source/library/lux/world/finance/interest/rate.lux @@ -0,0 +1,63 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except) + [abstract + [monoid (.only Monoid)]] + [control + [function + [predicate (.only Predicate)]]] + [data + [text + ["%" \\format]]] + [math + [number + ["n" nat] + ["f" frac]]]]] + [/// + ["[0]" money (.only Money)]]) + +... https://en.wikipedia.org/wiki/Interest_rate +(type .public Rate + Frac) + +... https://en.wikipedia.org/wiki/Break-even +(def .public break_even + Rate + +1.0) + +... https://en.wikipedia.org/wiki/Compound_interest +(def .public compound + (-> Rate Rate + Rate) + f.*) + +(with_template [<order> <name>] + [(def .public <name> + (Predicate Rate) + (<order> ..break_even))] + + [f.< loss?] + [f.> gain?] + [f.= break_even?] + ) + +(def .public monoid + (Monoid Rate) + (implementation + (def identity ..break_even) + (def composite ..compound))) + +(def .public format + (%.Format Rate) + (|>> (f.- ..break_even) + %.percentage)) + +(def .public (rate before after) + (All (_ $) + (-> (Money $) (Money $) + Rate)) + (f./ (n.frac (money.amount before)) + (n.frac (money.amount after)))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 64ac888ac..5597bded0 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -599,35 +599,6 @@ _ false)) - (_.coverage [/.type_literal] - (and (when (/.type_literal [expected/0 expected/1]) - {.#Product actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (when (/.type_literal (/.Or expected/0 expected/1)) - {.#Sum actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (when (/.type_literal (-> expected/0 expected/1)) - {.#Function actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (when (/.type_literal (expected/0 expected/1)) - {.#Apply actual/1 actual/0} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false))) (_.coverage [/.type] (exec (is /.Type ..for_type/variant) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index fb008dc84..cbe1af77c 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -90,15 +90,17 @@ ["[0]" \\format]) (def (equivalence example) - (All (_ a) (-> a (Equivalence (\\format.Format a)))) + (All (_ of) + (-> of + (Equivalence (\\format.Format of)))) (implementation (def (= reference subject) (/#= (reference example) (subject example))))) (def random_contravariant - (Random (Ex (_ a) - [(\\format.Format a) - (Random a)])) + (Random (Ex (_ of) + [(\\format.Format of) + (Random of)])) (all random.either (random#in [\\format.bit random.bit]) (random#in [\\format.nat random.nat]) @@ -153,6 +155,19 @@ [\\format.frac_10 frac.decimal random.frac] [\\format.frac_16 frac.hex random.frac] )) + + (,, (with_template [<format> <type>] + [(do random.monad + [it random.safe_frac] + (_.coverage [<format>] + (/.contains? (\\format.int (frac.int (<type> it))) + (<format> it))))] + + [\\format.degree frac.degree] + [\\format.percentage frac.percentage] + [\\format.permille frac.permille] + [\\format.permyriad frac.permyriad] + )) ))) (def \\format diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 8c89a23b3..fcba3ec1a 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -26,6 +26,7 @@ [number [ratio (.only Ratio)]]] [meta + ["[0]" type] ["[0]" code (.only) ["<[1]>" \\parser]] [macro @@ -86,7 +87,7 @@ [sample_bit random.bit sample_int random.int sample_frac random.frac] - (in (`` (and (when (/.representation (type_literal [Bit Int Frac]) + (in (`` (and (when (/.representation (type.literal [Bit Int Frac]) [sample_bit sample_int sample_frac]) {try.#Success actual} (text#= (format "[" (%.bit sample_bit) @@ -99,7 +100,7 @@ false) ... TODO: Uncomment after switching from the old (tag+last?) to the new (lefts+right?) representation for variants ... (,, (with_template [<lefts> <right?> <value> <format>] - ... [(|> (/.representation (type_literal (Or Bit Int Frac)) + ... [(|> (/.representation (type.literal (Or Bit Int Frac)) ... (is (Or Bit Int Frac) ... (<lefts> <right?> <value>))) ... (try#each (text#= (format "(" (%.nat <lefts>) @@ -181,11 +182,11 @@ (|> (/.representation .Any sample_frac) (try#each (text#= "[]")) (try.else false)) - (|> (/.representation (type_literal (List Nat)) (is (List Nat) (list sample_nat))) + (|> (/.representation (type.literal (List Nat)) (is (List Nat) (list sample_nat))) (try#each (text#= (%.list %.nat (list sample_nat)))) (try.else false)) (,, (with_template [<sample>] - [(|> (/.representation (type_literal (Maybe Nat)) (is (Maybe Nat) <sample>)) + [(|> (/.representation (type.literal (Maybe Nat)) (is (Maybe Nat) <sample>)) (try#each (text#= (%.maybe %.nat <sample>))) (try.else false))] diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux index 87b6530d3..b9749422b 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux @@ -134,7 +134,7 @@ analysis/*)))) (try.else false)) (|> (/.general archive.empty ..analysis - (type_literal (-> type/0 expected)) + (type.literal (-> type/0 expected)) (list term/0)) (//type.expecting expected) (//module.with 0 (product.left name)) @@ -143,7 +143,7 @@ (try#each (|>> product.left (type#= expected))) (try.else false)) (|> (/.general archive.empty ..analysis - (type_literal {.#Named name (-> type/0 expected)}) + (type.literal {.#Named name (-> type/0 expected)}) (list term/0)) (//type.expecting expected) (//module.with 0 (product.left name)) @@ -152,7 +152,7 @@ (try#each (|>> product.left (type#= expected))) (try.else false)) (|> (/.general archive.empty ..analysis - (type_literal (All (_ a) (-> a a))) + (type.literal (All (_ a) (-> a a))) (list term/0)) (//type.expecting type/0) (//module.with 0 (product.left name)) @@ -163,7 +163,7 @@ (try#each (type#= type/0)) (try.else false)) (|> (/.general archive.empty ..analysis - (type_literal ((All (_ a) (-> a a)) type/0)) + (type.literal ((All (_ a) (-> a a)) type/0)) (list term/0)) (//type.expecting type/0) (//module.with 0 (product.left name)) @@ -173,7 +173,7 @@ (try.else false)) (|> (do /phase.monad [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT (type_literal (-> type/0 expected))))] + _ (//type.check (check.check varT (type.literal (-> type/0 expected))))] (/.general archive.empty ..analysis varT (list term/0))) (//type.expecting expected) (//module.with 0 (product.left name)) @@ -184,7 +184,7 @@ (try#each (type#= expected)) (try.else false)) (|> (/.general archive.empty ..analysis - (type_literal (Ex (_ a) (-> a a))) + (type.literal (Ex (_ a) (-> a a))) (list (` (.error# "")))) //type.inferring (//module.with 0 (product.left name)) @@ -207,7 +207,7 @@ (..fails? /.cannot_infer)))) (_.coverage [/.cannot_infer_argument] (|> (/.general archive.empty ..analysis - (type_literal (-> expected expected)) + (type.literal (-> expected expected)) (list term/0)) (//type.expecting expected) (//module.with 0 (product.left name)) @@ -267,11 +267,11 @@ (variant? {.#Named name variantT} lefts right? tagC) cases_independent_of_parameters_conform_to_anything! - (variant? (type_literal (Maybe type/0)) 0 #0 (' [])) + (variant? (type.literal (Maybe type/0)) 0 #0 (' [])) cases_dependent_on_parameters_are_tettered_to_those_parameters! - (and (variant? (type_literal (Maybe type/0)) 0 #1 term/0) - (not (variant? (type_literal (Maybe type/0)) 0 #1 term/1))) + (and (variant? (type.literal (Maybe type/0)) 0 #1 term/0) + (not (variant? (type.literal (Maybe type/0)) 0 #1 term/1))) only_bottom_conforms_to_tags_outside_of_range! (`` (and (,, (with_template [<verdict> <term>] @@ -281,24 +281,24 @@ [#1 (` (.error# ""))])))) can_handle_universal_quantification! - (and (variant?' (type_literal (All (_ a) (Maybe a))) + (and (variant?' (type.literal (All (_ a) (Maybe a))) {.#Some Maybe} 0 #0 (' [])) - (variant?' (type_literal (All (_ a) (Maybe a))) - {.#Some (type_literal (Maybe type/0))} + (variant?' (type.literal (All (_ a) (Maybe a))) + {.#Some (type.literal (Maybe type/0))} 0 #1 term/0) - (not (variant?' (type_literal (All (_ a) (Maybe a))) + (not (variant?' (type.literal (All (_ a) (Maybe a))) {.#Some Maybe} 0 #1 term/0))) existential_types_do_not_affect_independent_cases! - (variant?' (type_literal (Ex (_ a) (Maybe a))) + (variant?' (type.literal (Ex (_ a) (Maybe a))) {.#None} 0 #0 (' [])) existential_types_affect_dependent_cases! (`` (and (,, (with_template [<verdict> <term>] - [(bit#= <verdict> (variant?' (type_literal (Ex (_ a) (Maybe a))) {.#None} 0 #1 <term>))] + [(bit#= <verdict> (variant?' (type.literal (Ex (_ a) (Maybe a))) {.#None} 0 #1 <term>))] [#0 term/0] [#1 (` (.error# ""))]))))] @@ -415,13 +415,13 @@ ..test|variant ..test|record (_.coverage [/.invalid_type_application] - (and (|> (/.general archive.empty ..analysis (type_literal (type/0 type/1)) (list term/0)) + (and (|> (/.general archive.empty ..analysis (type.literal (type/0 type/1)) (list term/0)) (/phase.result state) (..fails? /.invalid_type_application)) - (|> (/.variant lefts right? (type_literal (type/0 type/1))) + (|> (/.variant lefts right? (type.literal (type/0 type/1))) (/phase.result state) (..fails? /.invalid_type_application)) - (|> (/.record lefts (type_literal (type/0 type/1))) + (|> (/.record lefts (type.literal (type/0 type/1))) (/phase.result state) (..fails? /.invalid_type_application)))) )))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis.lux index 9557ff88b..2b97e44dc 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis.lux @@ -232,10 +232,10 @@ (let [state [extension.#bundle (extension/analysis.bundle ..eval) extension.#state lux] :record: {.#Named [module/0 @text] - (type_literal [.Any .Bit .Nat .Int .Rev .Frac .Text])} + (type.literal [.Any .Bit .Nat .Int .Rev .Frac .Text])} slots/* (list @any @bit @nat @int @rev @frac @text) :variant: {.#Named [module/0 @text] - (type_literal (Or .Any .Bit .Nat .Int .Rev .Frac .Text))} + (type.literal (Or .Any .Bit .Nat .Int .Rev .Frac .Text))} tags/* (list @any @bit @nat @int @rev @frac @text) can_analyse_unary! @@ -289,7 +289,7 @@ (|> (do phase.monad [_ (//module.declare_labels true slots/* false :record:) .let [:either: {.#Named [module/0 module/0] - (type_literal (Or .Any :record:))}] + (type.literal (Or .Any :record:))}] _ (//module.declare_labels false (list @left @right) false :either:) [:it: it] (|> (code.variant (list (code.local @left))) (/.phase ..expander archive.empty) @@ -312,7 +312,7 @@ (|> (do phase.monad [_ (//module.declare_labels true slots/* false :record:) .let [:either: {.#Named [module/0 module/0] - (type_literal (Or .Any :record:))}] + (type.literal (Or .Any :record:))}] _ (//module.declare_labels false (list @left @right) false :either:) [:it: it] (|> (code.variant (list (code.local @right) (` []) @@ -366,7 +366,7 @@ (code.text text/0))) (/.phase ..expander archive.empty) //type.inferring)] - (in (and (type#= (type_literal [.Any .Bit .Nat .Int .Rev .Frac .Text]) + (in (and (type#= (type.literal [.Any .Bit .Nat .Int .Rev .Frac .Text]) :it:) (when it (//.tuple (list (//.unit) @@ -396,7 +396,7 @@ (let [state [extension.#bundle (extension/analysis.bundle ..eval) extension.#state lux] :record: {.#Named [module/0 @text] - (type_literal [.Any .Bit .Nat .Int .Rev .Frac .Text])} + (type.literal [.Any .Bit .Nat .Int .Rev .Frac .Text])} slots/* (list @any @bit @nat @int @rev @frac @text)] (|> (do phase.monad [_ (//module.declare_labels true slots/* false :record:) @@ -665,11 +665,11 @@ extension.#state lux] :variant: {.#Named [module/0 module/0] - (type_literal (Or .Any .Bit .Nat .Int .Rev .Frac .Text))} + (type.literal (Or .Any .Bit .Nat .Int .Rev .Frac .Text))} tags/* (list @any @bit @nat @int @rev @frac @text) :record: {.#Named [module/0 module/0] - (type_literal (And .Any .Bit .Nat .Int .Rev .Frac .Text))} + (type.literal (And .Any .Bit .Nat .Int .Rev .Frac .Text))} slots/* (list @any @bit @nat @int @rev @frac @text) simple! diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux index ba524b22b..1bfc8b7a7 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -184,12 +184,12 @@ (//phase#each product.right) (//phase.result state) (try.else false)) - (and (sum? (type_literal (Maybe tagT)) 0 false (` [])) - (sum? (type_literal (Maybe tagT)) 0 true tagC)) - (and (sum? (type_literal (All (_ a) (Maybe a))) 0 false (` [])) - (not (sum? (type_literal (All (_ a) (Maybe a))) 0 true tagC))) - (and (sum? (type_literal (Ex (_ a) (Maybe a))) 0 false (` [])) - (sum? (type_literal (Ex (_ a) (Maybe a))) 0 true tagC))))) + (and (sum? (type.literal (Maybe tagT)) 0 false (` [])) + (sum? (type.literal (Maybe tagT)) 0 true tagC)) + (and (sum? (type.literal (All (_ a) (Maybe a))) 0 false (` [])) + (not (sum? (type.literal (All (_ a) (Maybe a))) 0 true tagC))) + (and (sum? (type.literal (Ex (_ a) (Maybe a))) 0 false (` [])) + (sum? (type.literal (Ex (_ a) (Maybe a))) 0 true tagC))))) ... (_.for [/.cannot_analyse_variant] ... (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) ... (function (_ exception analysis) @@ -204,7 +204,7 @@ ... (|> (do //phase.monad ... [[@var varT] (//type.check check.var)] ... (|> (/.sum ..analysis lefts right? archive.empty tagC) - ... (//type.expecting (type_literal (varT tagT))))) + ... (//type.expecting (type.literal (varT tagT))))) ... (failure? /.invalid_variant_type)))) ... (_.coverage [/.cannot_infer_sum] ... (|> (do //phase.monad @@ -326,9 +326,9 @@ (try.else false))))] (and (product? productT expected) (product? {.#Named name productT} expected) - (product? (type_literal (Ex (_ a) [a a])) (list term/0 term/0)) - (not (product? (type_literal (All (_ a) [a a])) (list term/0 term/0))) - (product? (type_literal (Triple type/0)) (list term/0 term/0 term/0)) + (product? (type.literal (Ex (_ a) [a a])) (list term/0 term/0)) + (not (product? (type.literal (All (_ a) [a a])) (list term/0 term/0))) + (product? (type.literal (Triple type/0)) (list term/0 term/0 term/0)) (|> (do //phase.monad [[@var varT] (//type.check check.var) _ (//type.check (check.check varT productT)) @@ -428,7 +428,7 @@ [[@var varT] (//type.check check.var)] (|> expected (/.product ..analysis archive.empty) - (//type.expecting (type_literal (varT type/0))))) + (//type.expecting (type.literal (varT type/0))))) (failure? /.invalid_tuple_type)))))) ))) @@ -651,13 +651,13 @@ ..test|record (_.coverage [/.not_a_quantified_type] (and (|> (/.sum ..analysis lefts right? archive.empty term/0) - (//type.expecting (type_literal (type/0 type/1))) + (//type.expecting (type.literal (type/0 type/1))) (//phase.result state) (..failure? /.not_a_quantified_type)) (|> types/*,terms/* (list#each product.right) (/.product ..analysis archive.empty) - (//type.expecting (type_literal (type/0 type/1))) + (//type.expecting (type.literal (type/0 type/1))) (//phase.result state) (..failure? /.not_a_quantified_type)))) )))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux index 2472c55e3..2dcfc22ca 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -132,11 +132,11 @@ ... (function? (Ex (_ a) (-> a a)) term/0) ... (function? (Rec self (-> input/0 self)) $function/0) - ... (function? (type_literal ((All (_ a) (-> a a)) output/0)) term/0) - ... (not (function? (type_literal ((All (_ a) (-> a a)) output/1)) term/0)) + ... (function? (type.literal ((All (_ a) (-> a a)) output/0)) term/0) + ... (not (function? (type.literal ((All (_ a) (-> a a)) output/1)) term/0)) - ... (function? (type_literal ((Ex (_ a) (-> a a)) output/0)) term/0) - ... (not (function? (type_literal ((Ex (_ a) (-> a a)) output/1)) term/0)) + ... (function? (type.literal ((Ex (_ a) (-> a a)) output/0)) term/0) + ... (not (function? (type.literal ((Ex (_ a) (-> a a)) output/1)) term/0)) ... (function?' (-> input/0 input/1 input/0) (` ([(, $function/1) (, $argument/1)] (, $argument/0))) ... (function (_ [outer body]) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/when.lux index f23e99dac..e42a02e2c 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/when.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/when.lux @@ -97,12 +97,12 @@ (Tuple (All (_ a b c) input/0) (All (_ a b c) input/1) (All (_ a b c) input/2))) - (tuple? (type_literal ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2)) + (tuple? (type.literal ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2)) (Tuple input/0 input/1 input/2)) (|> (do check.monad [[@var :var:] check.var _ (check.bind (All (_ a b c) (Tuple a b c)) @var)] - (/.tuple (type_literal (:var: input/0 input/1 input/2)))) + (/.tuple (type.literal (:var: input/0 input/1 input/2)))) (check.result check.fresh_context) (try#each (|>> product.right (type#= (Tuple input/0 input/1 input/2)))) (try.else false)) @@ -127,19 +127,19 @@ (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) (|> (do check.monad [[@var :var:] check.var - _ (/.tuple (type_literal (:var: input/0 input/1 input/2)))] + _ (/.tuple (type.literal (:var: input/0 input/1 input/2)))] (in false)) (check.result check.fresh_context) (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) (|> (do check.monad - [_ (/.tuple (type_literal (input/0 input/1 input/2)))] + [_ (/.tuple (type.literal (input/0 input/1 input/2)))] (in false)) (check.result check.fresh_context) (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) (|> (do check.monad [[@var :var:] check.var _ (check.bind input/0 @var) - _ (/.tuple (type_literal (:var: input/1 input/2)))] + _ (/.tuple (type.literal (:var: input/1 input/2)))] (in false)) (check.result check.fresh_context) (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index 66d43c8c6..93ad48d8a 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -73,7 +73,7 @@ (_.test "Can 'try' risky IO computations." (check_success+ (` .try#) (list (` (.error# "YOLO"))) - (type_literal (Either Text primT)))) + (type.literal (Either Text primT)))) ))) (def i64 @@ -149,7 +149,7 @@ (_.test "Can convert frac number to text." (check_success+ (symbol .f64_encoded#) (list subjectC) Text)) (_.test "Can convert text to frac number." - (check_success+ (symbol .f64_decoded#) (list encodedC) (type_literal (Maybe Frac)))) + (check_success+ (symbol .f64_decoded#) (list encodedC) (type.literal (Maybe Frac)))) ))) (def text @@ -168,7 +168,7 @@ (_.test "Can concatenate one text to another." (check_success+ (symbol .text_composite#) (list subjectC paramC) Text)) (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check_success+ (symbol .text_index#) (list fromC paramC subjectC) (type_literal (Maybe Nat)))) + (check_success+ (symbol .text_index#) (list fromC paramC subjectC) (type.literal (Maybe Nat)))) (_.test "Can query the size/length of a text." (check_success+ (symbol .text_size#) (list subjectC) Nat)) (_.test "Can obtain the character code of a text at a given index." diff --git a/stdlib/source/test/lux/meta/compiler/meta/cli/compiler.lux b/stdlib/source/test/lux/meta/compiler/meta/cli/compiler.lux index c8de9bc39..e4164032a 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cli/compiler.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cli/compiler.lux @@ -37,7 +37,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Compiler]) + (_.for [/.Compiler + /.#definition /.#parameters]) (do [! random.monad] [expected ..random] (all _.and diff --git a/stdlib/source/test/lux/meta/type.lux b/stdlib/source/test/lux/meta/type.lux index 4f02f6fe8..c149f2cc5 100644 --- a/stdlib/source/test/lux/meta/type.lux +++ b/stdlib/source/test/lux/meta/type.lux @@ -237,17 +237,17 @@ [expected ..nominal] (all _.and (_.coverage [\\parser.recursive] - (|> (.type_literal (Rec @ expected)) + (|> (/.literal (Rec @ expected)) (\\parser.result (\\parser.recursive \\parser.any)) (!expect (^.multi {try.#Success [@self actual]} (/#= expected actual))))) (_.coverage [\\parser.recursive_self] - (|> (.type_literal (Rec @ @)) + (|> (/.literal (Rec @ @)) (\\parser.result (\\parser.recursive \\parser.recursive_self)) (!expect (^.multi {try.#Success [@expected @actual]} (same? @expected @actual))))) (_.coverage [\\parser.recursive_call] - (|> (.type_literal (All (self input) (self input))) + (|> (/.literal (All (self input) (self input))) (\\parser.result (\\parser.polymorphic \\parser.recursive_call)) (!expect {try.#Success [@self inputs ???]}))) (_.coverage [\\parser.not_recursive] @@ -512,7 +512,7 @@ (_.coverage [/.by_example] (let [example (is (Maybe Nat) {.#None})] - (/#= (.type_literal (List Nat)) + (/#= (/.literal (List Nat)) (/.by_example [a] (is (Maybe a) example) @@ -563,6 +563,35 @@ (bit#= (/#= left right) (text#= (/.absolute_format left) (/.absolute_format right)))) )) + ... (_.coverage [/.literal] + ... (and (when (/.literal [expected/0 expected/1]) + ... {.#Product actual/0 actual/1} + ... (and (same? expected/0 actual/0) + ... (same? expected/1 actual/1)) + + ... _ + ... false) + ... (when (/.literal (/.Or expected/0 expected/1)) + ... {.#Sum actual/0 actual/1} + ... (and (same? expected/0 actual/0) + ... (same? expected/1 actual/1)) + + ... _ + ... false) + ... (when (/.literal (-> expected/0 expected/1)) + ... {.#Function actual/0 actual/1} + ... (and (same? expected/0 actual/0) + ... (same? expected/1 actual/1)) + + ... _ + ... false) + ... (when (/.literal (expected/0 expected/1)) + ... {.#Apply actual/1 actual/0} + ... (and (same? expected/0 actual/0) + ... (same? expected/1 actual/1)) + + ... _ + ... false))) ..\\parser diff --git a/stdlib/source/test/lux/meta/type/check.lux b/stdlib/source/test/lux/meta/type/check.lux index 7bf4c6647..33469b0b0 100644 --- a/stdlib/source/test/lux/meta/type/check.lux +++ b/stdlib/source/test/lux/meta/type/check.lux @@ -582,28 +582,28 @@ (def (handles_quantification! nominal) (-> Type Bit) (let [universals_satisfy_themselves! - (..succeeds? (/.check (.type_literal (All (_ a) (Maybe a))) - (.type_literal (All (_ a) (Maybe a))))) + (..succeeds? (/.check (//.literal (All (_ a) (Maybe a))) + (//.literal (All (_ a) (Maybe a))))) existentials_satisfy_themselves! - (..succeeds? (/.check (.type_literal (Ex (_ a) (Maybe a))) - (.type_literal (Ex (_ a) (Maybe a))))) + (..succeeds? (/.check (//.literal (Ex (_ a) (Maybe a))) + (//.literal (Ex (_ a) (Maybe a))))) universals_satisfy_particulars! - (..succeeds? (/.check (.type_literal (Maybe nominal)) - (.type_literal (All (_ a) (Maybe a))))) + (..succeeds? (/.check (//.literal (Maybe nominal)) + (//.literal (All (_ a) (Maybe a))))) particulars_do_not_satisfy_universals! - (..fails? (/.check (.type_literal (All (_ a) (Maybe a))) - (.type_literal (Maybe nominal)))) + (..fails? (/.check (//.literal (All (_ a) (Maybe a))) + (//.literal (Maybe nominal)))) particulars_satisfy_existentials! - (..succeeds? (/.check (.type_literal (Ex (_ a) (Maybe a))) - (.type_literal (Maybe nominal)))) + (..succeeds? (/.check (//.literal (Ex (_ a) (Maybe a))) + (//.literal (Maybe nominal)))) existentials_do_not_satisfy_particulars! - (..fails? (/.check (.type_literal (Maybe nominal)) - (.type_literal (Ex (_ a) (Maybe a)))))] + (..fails? (/.check (//.literal (Maybe nominal)) + (//.literal (Ex (_ a) (Maybe a)))))] (and universals_satisfy_themselves! existentials_satisfy_themselves! @@ -641,26 +641,26 @@ (def (handles_application! nominal/0 nominal/1) (-> Type Type Bit) (let [types_flow_through! - (and (..succeeds? (/.check (.type_literal ((All (_ a) a) nominal/0)) + (and (..succeeds? (/.check (//.literal ((All (_ a) a) nominal/0)) nominal/0)) (..succeeds? (/.check nominal/0 - (.type_literal ((All (_ a) a) nominal/0)))) + (//.literal ((All (_ a) a) nominal/0)))) - (..succeeds? (/.check (.type_literal ((Ex (_ a) a) nominal/0)) + (..succeeds? (/.check (//.literal ((Ex (_ a) a) nominal/0)) nominal/0)) (..succeeds? (/.check nominal/0 - (.type_literal ((Ex (_ a) a) nominal/0))))) + (//.literal ((Ex (_ a) a) nominal/0))))) multiple_parameters! - (and (..succeeds? (/.check (.type_literal ((All (_ a b) [a b]) nominal/0 nominal/1)) - (.type_literal [nominal/0 nominal/1]))) - (..succeeds? (/.check (.type_literal [nominal/0 nominal/1]) - (.type_literal ((All (_ a b) [a b]) nominal/0 nominal/1)))) + (and (..succeeds? (/.check (//.literal ((All (_ a b) [a b]) nominal/0 nominal/1)) + (//.literal [nominal/0 nominal/1]))) + (..succeeds? (/.check (//.literal [nominal/0 nominal/1]) + (//.literal ((All (_ a b) [a b]) nominal/0 nominal/1)))) - (..succeeds? (/.check (.type_literal ((Ex (_ a b) [a b]) nominal/0 nominal/1)) - (.type_literal [nominal/0 nominal/1]))) - (..succeeds? (/.check (.type_literal [nominal/0 nominal/1]) - (.type_literal ((Ex (_ a b) [a b]) nominal/0 nominal/1)))))] + (..succeeds? (/.check (//.literal ((Ex (_ a b) [a b]) nominal/0 nominal/1)) + (//.literal [nominal/0 nominal/1]))) + (..succeeds? (/.check (//.literal [nominal/0 nominal/1]) + (//.literal ((Ex (_ a b) [a b]) nominal/0 nominal/1)))))] (and types_flow_through! multiple_parameters!))) @@ -843,10 +843,10 @@ (Random Bit) (do random.monad [example ..clean_type] - (in (and (and (/.subsumes? (.type_literal (List example)) (.type_literal (All (_ a) (List a)))) - (not (/.subsumes? (.type_literal (All (_ a) (List a))) (.type_literal (List example))))) - (and (/.subsumes? (.type_literal (Ex (_ a) (List a))) (.type_literal (List example))) - (not (/.subsumes? (.type_literal (List example)) (.type_literal (Ex (_ a) (List a)))))))))) + (in (and (and (/.subsumes? (//.literal (List example)) (//.literal (All (_ a) (List a)))) + (not (/.subsumes? (//.literal (All (_ a) (List a))) (//.literal (List example))))) + (and (/.subsumes? (//.literal (Ex (_ a) (List a))) (//.literal (List example))) + (not (/.subsumes? (//.literal (List example)) (//.literal (Ex (_ a) (List a)))))))))) (def for_subsumption|named (Random Bit) diff --git a/stdlib/source/test/lux/meta/type/variance.lux b/stdlib/source/test/lux/meta/type/variance.lux index 0c6c106f9..b84e6b122 100644 --- a/stdlib/source/test/lux/meta/type/variance.lux +++ b/stdlib/source/test/lux/meta/type/variance.lux @@ -28,16 +28,16 @@ [expected random.nat]) (all _.and (_.coverage [/.Co] - (and (//check.subsumes? (type_literal (/.Co Super)) (type_literal (/.Co Sub))) - (not (//check.subsumes? (type_literal (/.Co Sub)) (type_literal (/.Co Super)))))) + (and (//check.subsumes? (//.literal (/.Co Super)) (//.literal (/.Co Sub))) + (not (//check.subsumes? (//.literal (/.Co Sub)) (//.literal (/.Co Super)))))) (_.coverage [/.Contra] - (and (//check.subsumes? (type_literal (/.Contra Sub)) (type_literal (/.Contra Super))) - (not (//check.subsumes? (type_literal (/.Contra Super)) (type_literal (/.Contra Sub)))))) + (and (//check.subsumes? (//.literal (/.Contra Sub)) (//.literal (/.Contra Super))) + (not (//check.subsumes? (//.literal (/.Contra Super)) (//.literal (/.Contra Sub)))))) (_.coverage [/.In] - (and (//check.subsumes? (type_literal (/.In Super)) (type_literal (/.In Super))) - (//check.subsumes? (type_literal (/.In Sub)) (type_literal (/.In Sub))) - (not (//check.subsumes? (type_literal (/.In Sub)) (type_literal (/.In Super)))) - (not (//check.subsumes? (type_literal (/.In Super)) (type_literal (/.In Sub)))))) + (and (//check.subsumes? (//.literal (/.In Super)) (//.literal (/.In Super))) + (//check.subsumes? (//.literal (/.In Sub)) (//.literal (/.In Sub))) + (not (//check.subsumes? (//.literal (/.In Sub)) (//.literal (/.In Super)))) + (not (//check.subsumes? (//.literal (/.In Super)) (//.literal (/.In Sub)))))) (_.for [/.Mutable] (all _.and (_.coverage [/.write /.read] diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index fe8136b3c..6fd831f0c 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -22,7 +22,9 @@ ["[1]/[0]" session]] ["[1]/[0]" market ["[1]/[0]" price] - ["[1]/[0]" analysis]]] + ["[1]/[0]" analysis]] + ["[1]/[0]" interest + ["[1]/[0]" rate]]] ["[1][0]" net] ["[1][0]" time] ["[1][0]" locale] @@ -43,6 +45,7 @@ /finance/trade/session.test /finance/market/price.test /finance/market/analysis.test + /finance/interest/rate.test /net.test /time.test diff --git a/stdlib/source/test/lux/world/file/extension.lux b/stdlib/source/test/lux/world/file/extension.lux index 5fe5207a6..4c3a957ce 100644 --- a/stdlib/source/test/lux/world/file/extension.lux +++ b/stdlib/source/test/lux/world/file/extension.lux @@ -23,82 +23,110 @@ [\\library ["[0]" /]]) -(with_expansions [<extensions> (these [/.compressed_7z_archive] - - [/.archive] - [/.advanced_audio_coding] - [/.agda_source_code] - [/.android_application_package] - [/.assembler_source_code] - - [/.binary] - [/.bzip2_archive] - [/.blender_project] - - [/.c_source_code] - [/.c++_source_code] - [/.java_class] - [/.dos_program] - [/.c#_source_code] - [/.css] - [/.comma_separated_values] - - [/.d_source_code] - [/.dart_source_code] - - [/.emacs_lisp_source_code] - [/.compiled_emacs_lisp_code] - [/.executable_and_linkable_file] - [/.electronic_publication] - [/.erlang_source_code] - [/.executable_program] - - [/.apophysis_fractal] - - [/.gps_exchange_format] - [/.gzip_compressed_data] - - [/.http_archive_format] - [/.c_header] - [/.html] - - [/.optical_disc_file_system] - - [/.java_archive] - [/.java_source_code] - [/.javascript_source_code] - [/.javascript_object_notation] - - [/.llvm_assembly] - [/.lua_source_code] - [/.lzip_archive] - - [/.markdown] - [/.musical_instrument_digital_interface] - - [/.object_code] - [/.vorbis_audio] - - [/.portable_document_format] - [/.php_source_code] - [/.maven_build_configuration] - [/.postscript_source_code] - [/.python_source_code] - - [/.ruby_source_code] - - [/.scheme_source_code] - [/.unix_shell_script] - [/.structured_query_language] - [/.scalable_vector_graphics] - - [/.tape_archive] - [/.temporary_file] - [/.tab_separated_values] - - [/.yaml] - - [/.zip_archive])] +(with_expansions [<options> (these [%->d + [/.compressed_7z_archive + + /.archive + /.advanced_audio_coding + /.agda_source_code + /.android_application_package + /.assembler_source_code + + /.binary + /.bzip2_archive + /.blender_project + + /.c_source_code + /.c++_source_code + /.java_class + /.dos_program + /.c#_source_code + /.css + /.comma_separated_values + + /.d_source_code + /.dart_source_code]] + + [e->j + [/.emacs_lisp_source_code + /.compiled_emacs_lisp_code + /.executable_and_linkable_file + /.electronic_publication + /.erlang_source_code + /.executable_program + + /.apophysis_fractal + + /.gps_exchange_format + /.gzip_compressed_data + + /.http_archive_format + /.c_header + /.html + + /.optical_disc_file_system + + /.java_archive + /.java_source_code + /.javascript_source_code + /.javascript_object_notation]] + + [l->p + [/.llvm_assembly + /.lua_source_code + /.lzip_archive + + /.markdown + /.musical_instrument_digital_interface + + /.object_code + /.vorbis_audio + + /.portable_document_format + /.php_source_code + /.maven_build_configuration + /.postscript_source_code + /.python_source_code]] + + [r->z + [/.ruby_source_code + + /.scheme_source_code + /.unix_shell_script + /.structured_query_language + /.scalable_vector_graphics + + /.tape_archive + /.temporary_file + /.tab_separated_values + + /.yaml + + /.zip_archive]])] + (def all_options + (list.together (`` (list (,, (with_template [<definition> <by_letter_range>] + [((is (-> Any (List /.Extension)) + (function (_ _) + (`` (list (,, (template.spliced <by_letter_range>)))))) + 123)] + + <options>)))))) + + (def unique_options + (set.of_list text.hash ..all_options)) + + (def verdict + (n.= (list.size ..all_options) + (set.size ..unique_options))) + + (with_template [<definition> <by_letter_range>] + [(def <definition> + Test + (_.coverage <by_letter_range> + ..verdict))] + + <options>) + (def .public test Test (<| (_.covering /._) @@ -106,14 +134,10 @@ []) (_.for [/.Extension]) (`` (all _.and - (_.coverage [(,, (with_template [<extension>] - [<extension>] - - <extensions>))] - (let [options (list <extensions>) - uniques (set.of_list text.hash options)] - (n.= (list.size options) - (set.size uniques)))) + (,, (with_template [<definition> <by_letter_range>] + [<definition>] + + <options>)) (,, (with_template [<original> <aliases>] [(with_expansions [<aliases>' (template.spliced <aliases>)] (`` (_.coverage [(,, (with_template [<extension>] diff --git a/stdlib/source/test/lux/world/finance/interest/rate.lux b/stdlib/source/test/lux/world/finance/interest/rate.lux new file mode 100644 index 000000000..8ee6dac21 --- /dev/null +++ b/stdlib/source/test/lux/world/finance/interest/rate.lux @@ -0,0 +1,64 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + ["[0]" monoid + ["[1]T" \\test]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" functor)] + [number + ["n" nat] + ["f" frac]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + ["[0]" money (.only) + ["[0]" currency]]]]]) + +(def .public random + (Random /.Rate) + (random#each f.abs random.safe_frac)) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [left ..random + right ..random + + money (of ! each (|>> (n.% 1,000) ++) random.nat)]) + (_.for [/.Rate]) + (all _.and + (_.for [/.monoid /.break_even /.compound] + (monoidT.spec f.equivalence /.monoid ..random)) + + (_.coverage [/.format] + (bit#= (f.= left right) + (text#= (/.format left) (/.format right)))) + (_.coverage [/.loss? /.gain? /.break_even?] + (or (and (/.loss? left) + (not (/.gain? left)) + (not (/.break_even? left))) + (and (not (/.loss? left)) + (/.gain? left) + (not (/.break_even? left))) + (and (not (/.loss? left)) + (not (/.gain? left)) + (/.break_even? left)))) + (_.coverage [/.rate] + (and (/.loss? (/.rate (money.money currency.usd money) + (money.money currency.usd (-- money)))) + (/.gain? (/.rate (money.money currency.usd money) + (money.money currency.usd (++ money)))) + (/.break_even? (/.rate (money.money currency.usd money) + (money.money currency.usd money))))) + ))) |