From 549cb9623c560fec165b9e88f112a406614f598e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 12 Dec 2022 18:55:00 -0400 Subject: Added accumulation/distribution oscillator. --- stdlib/source/library/lux/control/aspect.lux | 2 +- stdlib/source/library/lux/data/color.lux | 86 ------------------- stdlib/source/library/lux/data/color/hsl.lux | 36 -------- stdlib/source/library/lux/data/color/scheme.lux | 98 ++++++++++++++++++++++ stdlib/source/library/lux/data/color/terminal.lux | 24 +++--- .../language/lux/phase/translation/js/function.lux | 6 +- .../language/lux/phase/translation/js/loop.lux | 10 +-- .../language/lux/phase/translation/js/runtime.lux | 6 +- .../lux/phase/translation/js/structure.lux | 15 ++-- .../language/lux/phase/translation/js/when.lux | 54 ++++++------ .../lux/phase/translation/jvm/function.lux | 2 +- .../phase/translation/jvm/function/method/new.lux | 4 +- .../language/lux/phase/translation/jvm/loop.lux | 2 +- .../lux/phase/translation/jvm/reference.lux | 8 +- .../language/lux/phase/translation/jvm/runtime.lux | 10 +-- .../lux/phase/translation/jvm/structure.lux | 5 +- .../language/lux/phase/translation/jvm/when.lux | 2 +- .../lux/phase/translation/lua/function.lux | 6 +- .../language/lux/phase/translation/lua/loop.lux | 12 +-- .../language/lux/phase/translation/lua/runtime.lux | 4 +- .../lux/phase/translation/lua/structure.lux | 15 ++-- .../language/lux/phase/translation/lua/when.lux | 50 +++++------ .../market/analysis/accumulation_distribution.lux | 23 +++++ stdlib/source/specification/lux/abstract/apply.lux | 68 --------------- .../source/specification/lux/abstract/comonad.lux | 10 +-- .../source/specification/lux/abstract/functor.lux | 59 ------------- stdlib/source/specification/lux/abstract/mix.lux | 6 +- stdlib/source/specification/lux/abstract/monad.lux | 7 +- stdlib/source/test/lux/abstract/apply.lux | 63 +++++++++++++- stdlib/source/test/lux/abstract/comonad/free.lux | 6 +- stdlib/source/test/lux/abstract/functor.lux | 50 ++++++++++- stdlib/source/test/lux/abstract/monad/free.lux | 10 ++- .../source/test/lux/control/concurrency/async.lux | 10 ++- stdlib/source/test/lux/control/concurrency/csp.lux | 5 +- stdlib/source/test/lux/control/concurrency/frp.lux | 10 ++- .../test/lux/control/concurrency/incremental.lux | 5 +- stdlib/source/test/lux/control/concurrency/stm.lux | 10 ++- .../test/lux/control/concurrency/structured.lux | 5 +- stdlib/source/test/lux/control/continuation.lux | 10 ++- .../test/lux/control/function/trampoline.lux | 5 +- stdlib/source/test/lux/control/io.lux | 10 ++- stdlib/source/test/lux/control/lazy.lux | 10 ++- stdlib/source/test/lux/control/maybe.lux | 10 ++- stdlib/source/test/lux/control/parser.lux | 10 ++- stdlib/source/test/lux/control/reader.lux | 10 ++- stdlib/source/test/lux/control/region.lux | 10 ++- stdlib/source/test/lux/control/security/policy.lux | 10 ++- stdlib/source/test/lux/control/state.lux | 10 ++- stdlib/source/test/lux/control/thread.lux | 10 ++- stdlib/source/test/lux/control/try.lux | 10 ++- stdlib/source/test/lux/control/writer.lux | 10 ++- stdlib/source/test/lux/data.lux | 20 ++++- stdlib/source/test/lux/data/collection/array.lux | 9 +- .../source/test/lux/data/collection/dictionary.lux | 7 +- stdlib/source/test/lux/data/collection/list.lux | 10 ++- stdlib/source/test/lux/data/collection/queue.lux | 7 +- .../source/test/lux/data/collection/sequence.lux | 10 ++- stdlib/source/test/lux/data/collection/stack.lux | 7 +- stdlib/source/test/lux/data/collection/stream.lux | 5 +- stdlib/source/test/lux/data/collection/tree.lux | 10 ++- .../test/lux/data/collection/tree/zipper.lux | 5 +- stdlib/source/test/lux/data/color.lux | 82 ------------------ stdlib/source/test/lux/data/color/hsl.lux | 29 +------ stdlib/source/test/lux/data/color/scheme.lux | 80 ++++++++++++++++++ stdlib/source/test/lux/data/color/terminal.lux | 9 +- stdlib/source/test/lux/data/identity.lux | 10 ++- stdlib/source/test/lux/math/random.lux | 10 ++- stdlib/source/test/lux/meta.lux | 10 ++- stdlib/source/test/lux/meta/compiler/phase.lux | 5 +- stdlib/source/test/lux/meta/type/check.lux | 10 ++- stdlib/source/test/lux/world.lux | 6 +- .../market/analysis/accumulation_distribution.lux | 31 +++++++ stdlib/source/test/lux/world/time/series.lux | 7 +- 73 files changed, 680 insertions(+), 628 deletions(-) delete mode 100644 stdlib/source/library/lux/data/color.lux create mode 100644 stdlib/source/library/lux/data/color/scheme.lux create mode 100644 stdlib/source/library/lux/world/finance/market/analysis/accumulation_distribution.lux delete mode 100644 stdlib/source/specification/lux/abstract/apply.lux delete mode 100644 stdlib/source/specification/lux/abstract/functor.lux delete mode 100644 stdlib/source/test/lux/data/color.lux create mode 100644 stdlib/source/test/lux/data/color/scheme.lux create mode 100644 stdlib/source/test/lux/world/finance/market/analysis/accumulation_distribution.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux/control/aspect.lux b/stdlib/source/library/lux/control/aspect.lux index f117ded5e..e730f03bd 100644 --- a/stdlib/source/library/lux/control/aspect.lux +++ b/stdlib/source/library/lux/control/aspect.lux @@ -24,9 +24,9 @@ [type ["[0]" check]] [compiler - ["[0]" phase] [language [lux + ["[0]" phase] ["[0]" declaration] ["[0]" analysis (.only) ["[0]" module] diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux deleted file mode 100644 index b65249c33..000000000 --- a/stdlib/source/library/lux/data/color.lux +++ /dev/null @@ -1,86 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monoid (.only Monoid)] - ["[0]" equivalence (.only Equivalence)] - ["[0]" hash (.only Hash)]] - [data - [collection - ["[0]" list (.use "[1]#[0]" functor)]]] - [math - [number - ["n" nat] - ["f" frac] - ["[0]" int] - ["[0]" rev (.use "[1]#[0]" interval)] - ["[0]" i64]]] - [meta - [type - ["[0]" nominal]]]]] - [/ - ["[0]" rgb (.only RGB)] - ["[0]" hsl] - ["[0]" hsb]]) - -(nominal.def .public Color - RGB - - (def .public of_rgb - (-> RGB Color) - (|>> nominal.abstraction)) - - (def .public rgb - (-> Color RGB) - (|>> nominal.representation)) - ) - -(def (ratio it) - (-> Frac - Frac) - (cond (f.> +1.0 it) - (f.% +1.0 it) - - (f.< +0.0 it) - (|> it (f.% +1.0) (f.+ +1.0)) - - ... else - it)) - -(type .public Spread - Frac) - -... https://en.wikipedia.org/wiki/Color_scheme -(type .public Palette - (-> Spread Nat Color (List Color))) - -(def .public (analogous spread variations it) - Palette - (let [it (hsl.of_rgb (..rgb it)) - hue (the hsl.#hue it) - saturation (the hsl.#saturation it) - luminance (the hsl.#luminance it) - spread (..ratio spread)] - (list#each (function (_ idx) - (|> (hsl.hsl (|> idx ++ .int int.frac (f.* spread) (f.+ hue) ..ratio) - saturation - luminance) - hsl.rgb - ..of_rgb)) - (list.indices variations)))) - -(def .public (monochromatic spread variations it) - Palette - (let [it (hsb.of_rgb (..rgb it)) - hue (hsb.hue it) - saturation (hsb.saturation it) - brightness (hsb.brightness it) - spread (..ratio spread)] - (|> (list.indices variations) - (list#each (|>> ++ .int int.frac - (f.* spread) - (f.+ brightness) - ..ratio - (hsb.hsb hue saturation) - hsb.rgb - ..of_rgb))))) diff --git a/stdlib/source/library/lux/data/color/hsl.lux b/stdlib/source/library/lux/data/color/hsl.lux index 835864b26..df8fb8a82 100644 --- a/stdlib/source/library/lux/data/color/hsl.lux +++ b/stdlib/source/library/lux/data/color/hsl.lux @@ -184,39 +184,3 @@ (|>> (the #luminance) (..hsl +0.0 +0.0))) - -(with_template [ <1> <2>] - [(`` (def .public ( it) - (-> HSL - [HSL HSL HSL]) - (let [(open "/[0]") it] - [it - (..hsl (|> /#hue (f.+ <1>) ..ratio) - /#saturation - /#luminance) - (..hsl (|> /#hue (f.+ <2>) ..ratio) - /#saturation - /#luminance)])))] - - [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] - [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] - [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] - ) - -(with_template [ <1> <2> <3>] - [(`` (def .public ( it) - (-> HSL - [HSL HSL HSL HSL]) - (let [(open "/[0]") it - of_hue (is (-> Value - HSL) - (function (_ hue) - (..hsl hue /#saturation /#luminance)))] - [it - (|> /#hue (f.+ <1>) ..ratio of_hue) - (|> /#hue (f.+ <2>) ..ratio of_hue) - (|> /#hue (f.+ <3>) ..ratio of_hue)])))] - - [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] - [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] - ) diff --git a/stdlib/source/library/lux/data/color/scheme.lux b/stdlib/source/library/lux/data/color/scheme.lux new file mode 100644 index 000000000..380502eb3 --- /dev/null +++ b/stdlib/source/library/lux/data/color/scheme.lux @@ -0,0 +1,98 @@ +(.require + [library + [lux (.except) + [data + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + [number + ["i" int] + ["f" frac]]]]] + [// + [rgb (.only RGB)] + ["[0]" hsl] + ["[0]" hsb]]) + +(def (ratio it) + (-> Frac + Frac) + (cond (f.> +1.0 it) + (f.% +1.0 it) + + (f.< +0.0 it) + (|> it (f.% +1.0) (f.+ +1.0)) + + ... else + it)) + +(with_template [ <1> <2>] + [(`` (def .public ( it) + (-> RGB + [RGB RGB RGB]) + (let [(open "/[0]") (hsl.of_rgb it)] + [it + (hsl.rgb (hsl.hsl (|> /#hue (f.+ <1>) ..ratio) + /#saturation + /#luminance)) + (hsl.rgb (hsl.hsl (|> /#hue (f.+ <2>) ..ratio) + /#saturation + /#luminance))])))] + + [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] + [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] + [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] + ) + +(with_template [ <1> <2> <3>] + [(`` (def .public ( it) + (-> RGB + [RGB RGB RGB RGB]) + (let [(open "/[0]") (hsl.of_rgb it) + of_hue (is (-> hsl.Value + RGB) + (function (_ hue) + (hsl.rgb (hsl.hsl hue /#saturation /#luminance))))] + [it + (|> /#hue (f.+ <1>) ..ratio of_hue) + (|> /#hue (f.+ <2>) ..ratio of_hue) + (|> /#hue (f.+ <3>) ..ratio of_hue)])))] + + [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] + [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] + ) + +(type .public Spread + Frac) + +... https://en.wikipedia.org/wiki/Color_scheme +(type .public Scheme + (-> Spread Nat RGB + (List RGB))) + +(def .public (analogous spread variations it) + Scheme + (let [it (hsl.of_rgb it) + hue (the hsl.#hue it) + saturation (the hsl.#saturation it) + luminance (the hsl.#luminance it) + spread (..ratio spread)] + (list#each (function (_ idx) + (hsl.rgb (hsl.hsl (|> idx ++ .int i.frac (f.* spread) (f.+ hue) ..ratio) + saturation + luminance))) + (list.indices variations)))) + +(def .public (monochromatic spread variations it) + Scheme + (let [it (hsb.of_rgb it) + hue (hsb.hue it) + saturation (hsb.saturation it) + brightness (hsb.brightness it) + spread (..ratio spread)] + (|> (list.indices variations) + (list#each (|>> ++ .int i.frac + (f.* spread) + (f.+ brightness) + ..ratio + (hsb.hsb hue saturation) + hsb.rgb))))) diff --git a/stdlib/source/library/lux/data/color/terminal.lux b/stdlib/source/library/lux/data/color/terminal.lux index 06c23c6b3..715e30961 100644 --- a/stdlib/source/library/lux/data/color/terminal.lux +++ b/stdlib/source/library/lux/data/color/terminal.lux @@ -16,8 +16,8 @@ ["[0]" template]] [type ["[0]" nominal]]]]] - ["[0]" // (.only Color) - ["[0]" rgb]]) + [// + ["[0]" rgb (.only RGB)]]) (nominal.def .public Command [Text Text] @@ -86,16 +86,16 @@ (with_template [ ] [(def .public ( it) - (-> Color Command) - (let [it (//.rgb it)] - (|> [(%.format ..command - - ";" (%.nat (the rgb.#red it)) - ";" (%.nat (the rgb.#green it)) - ";" (%.nat (the rgb.#blue it)) - "m") - ] - (nominal.abstraction Command))))] + (-> RGB + Command) + (|> [(%.format ..command + + ";" (%.nat (the rgb.#red it)) + ";" (%.nat (the rgb.#green it)) + ";" (%.nat (the rgb.#blue it)) + "m") + ] + (nominal.abstraction Command)))] ["38;2" foreground ..default_foreground_color] ["48;2" background ..default_background_color] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux index 7d1d3434b..dadd86f24 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux @@ -21,10 +21,10 @@ ["//[1]" /// [analysis (.only Abstraction Reification Analysis)] [synthesis (.only Synthesis)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" translation] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase (.use "[1]#[0]" monad)] [reference [variable (.only Register Variable)]] [meta @@ -36,7 +36,7 @@ (def .public (apply expression archive [functionS argsS+]) (Translator (Reification Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] (in (_.apply functionO argsO+)))) @@ -74,7 +74,7 @@ (def .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Translator (Abstraction Synthesis))) - (do [! ///////phase.monad] + (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [function_name body!] (/////translation.with_new_context archive dependencies (do ! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux index 6bb799c5e..012c47d7e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux @@ -20,9 +20,9 @@ ["[1][0]" when] ["///[1]" //// [synthesis (.only Scope Synthesis)] + ["[0]" phase] ["[1][0]" translation] - ["//[1]" /// - ["[1][0]" phase] + [/// [reference [variable (.only Register)]]]]]) @@ -70,7 +70,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [@scope (of ! each ..@scope /////translation.next) initsO+ (monad.each ! (expression archive) initsS+) body! (/////translation.with_anchor [start @scope] @@ -92,7 +92,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [loop! (scope! statement expression archive [start initsS+ bodyS])] (in (_.apply (_.closure (list) loop!) (list)))))) @@ -101,7 +101,7 @@ (def .public (again! statement expression archive argsS+) (Translator! (List Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [[offset @scope] /////translation.anchor argsO+ (monad.each ! (expression archive) argsS+) $iteration (of ! each ..$iteration /////translation.next)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux index 30ce82b9d..dbd9f5c45 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux @@ -28,10 +28,10 @@ ["[0]" /// ["[1][0]" reference] ["//[1]" /// + ["[0]" phase] ["[1][0]" synthesis (.only Synthesis)] ["[1][0]" translation] - ["//[1]" /// (.only) - ["[1][0]" phase] + [/// [reference [variable (.only Register)]] [meta @@ -825,7 +825,7 @@ (def .public translate (Operation [Registry Output]) - (do ///////phase.monad + (do phase.monad [_ (/////translation.execute! ..full) _ (/////translation.save! ..module_id {.#None} ..full)] (in [(|> registry.empty diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux index 32e0a9034..081afea98 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux @@ -10,28 +10,27 @@ ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" primitive] ["///[1]" //// + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" synthesis (.only Synthesis)] [analysis - [complex (.only Variant Tuple)]] - ["//[1]" /// (.only) - ["[1][0]" phase (.use "[1]#[0]" monad)]]]]) + [complex (.only Variant Tuple)]]]]) (def .public (tuple translate archive elemsS+) (Translator (Tuple Synthesis)) (when elemsS+ {.#End} - (///////phase#in //runtime.unit) + (phase#in //runtime.unit) {.#Item singletonS {.#End}} (translate archive singletonS) _ - (do [! ///////phase.monad] + (do [! phase.monad] [elemsT+ (monad.each ! (translate archive) elemsS+)] (in (_.array elemsT+))))) (def .public (variant translate archive [lefts right? valueS]) (Translator (Variant Synthesis)) - (///////phase#each (//runtime.variant (_.i32 (.int lefts)) - (//runtime.flag right?)) - (translate archive valueS))) + (phase#each (//runtime.variant (_.i32 (.int lefts)) + (//runtime.flag right?)) + (translate archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux index ff635a3de..a8fc6674f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux @@ -27,13 +27,13 @@ ["[1][0]" synthesis ["[1]/[0]" when]] ["/[1]" // + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" synthesis (.only Synthesis Path) [access ["[0]" member (.only Member)]]] ["//[1]" /// [reference [variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) @@ -43,7 +43,7 @@ (def .public (exec expression archive [this that]) (Translator [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [this (expression archive this) that (expression archive that)] (in (|> (_.array (list this that)) @@ -51,7 +51,7 @@ (def .public (exec! statement expression archive [this that]) (Translator! [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [this (expression archive this) that (statement expression archive that)] (in (all _.then @@ -60,7 +60,7 @@ (def .public (let expression archive [valueS register bodyS]) (Translator [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. @@ -70,7 +70,7 @@ (def .public (let! statement expression archive [valueS register bodyS]) (Translator! [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] (in (all _.then @@ -79,7 +79,7 @@ (def .public (if expression archive [testS thenS elseS]) (Translator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] @@ -87,7 +87,7 @@ (def .public (if! statement expression archive [testS thenS elseS]) (Translator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [testO (expression archive testS) thenO (statement expression archive thenS) elseO (statement expression archive elseS)] @@ -97,7 +97,7 @@ (def .public (get expression archive [pathP valueS]) (Translator [(List Member) Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) (.let [method (.if (the member.#right? side) @@ -186,18 +186,18 @@ [( idx nextP) (|> nextP again - (of ///////phase.monad each (|>> (_.then ( true idx)) {.#Some})))]) + (of phase.monad each (|>> (_.then ( true idx)) {.#Some})))]) ([/////synthesis.simple_left_side ..left_choice] [/////synthesis.simple_right_side ..right_choice]) (/////synthesis.member/left 0) - (///////phase#in {.#Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor))}) + (phase#in {.#Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor))}) ... Extra optimization (/////synthesis.path/seq (/////synthesis.member/left 0) (/////synthesis.!bind_top register thenP)) - (do ///////phase.monad + (do phase.monad [then! (again thenP)] (in {.#Some (all _.then (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) @@ -208,7 +208,7 @@ [(/////synthesis.path/seq ( lefts) (/////synthesis.!bind_top register thenP)) - (do ///////phase.monad + (do phase.monad [then! (again thenP)] (in {.#Some (all _.then (_.define (..register register) ( (_.i32 (.int lefts)) ..peek_cursor)) @@ -217,7 +217,7 @@ [/////synthesis.member/right //runtime.tuple//right]) (/////synthesis.!bind_top register thenP) - (do ///////phase.monad + (do phase.monad [then! (again thenP)] (in {.#Some (all _.then (_.define (..register register) ..peek_and_pop_cursor) @@ -225,20 +225,20 @@ (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (////synthesis/when.count_pops nextP)] - (do ///////phase.monad + (do phase.monad [next! (again nextP')] (in {.#Some (all _.then (multi_pop_cursor! (n.+ 2 extra_pops)) next!)}))) _ - (///////phase#in {.#None}))) + (phase#in {.#None}))) (def (pattern_matching' statement expression archive) (-> Phase! Phase Archive (-> Path (Operation Statement))) (function (again pathP) - (do ///////phase.monad + (do phase.monad [outcome (optimized_pattern_matching again pathP)] (.when outcome {.#Some outcome} @@ -250,13 +250,13 @@ (statement expression archive bodyS) {/////synthesis.#Pop} - (///////phase#in pop_cursor!) + (phase#in pop_cursor!) {/////synthesis.#Bind register} - (///////phase#in (_.define (..register register) ..peek_cursor)) + (phase#in (_.define (..register register) ..peek_cursor)) {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] + (do [! phase.monad] [then! (again thenP) else! (.when elseP {.#Some elseP} @@ -273,7 +273,7 @@ then!)))) {/////synthesis.#I64_Fork item} - (do [! ///////phase.monad] + (do [! phase.monad] [clauses (monad.each ! (function (_ [match then]) (do ! [then! (again then)] @@ -288,7 +288,7 @@ (^.with_template [ ] [{ item} - (do [! ///////phase.monad] + (do [! phase.monad] [cases (monad.each ! (function (_ [match then]) (of ! each (|>> [(list ( match))]) (again then))) {.#Item item})] @@ -300,19 +300,19 @@ (^.with_template [ ] [( idx) - (///////phase#in ( false idx))]) + (phase#in ( false idx))]) ([/////synthesis.side/left ..left_choice] [/////synthesis.side/right ..right_choice]) (^.with_template [ ] [( lefts) - (///////phase#in (push_cursor! ( (_.i32 (.int lefts)) ..peek_cursor)))]) + (phase#in (push_cursor! ( (_.i32 (.int lefts)) ..peek_cursor)))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^.with_template [ ] [( leftP rightP) - (do ///////phase.monad + (do phase.monad [left! (again leftP) right! (again rightP)] (in ( left! right!)))]) @@ -321,7 +321,7 @@ (def (pattern_matching statement expression archive pathP) (-> Phase! Phase Archive Path (Operation Statement)) - (do ///////phase.monad + (do phase.monad [pattern_matching! (pattern_matching' statement expression archive pathP)] (in (all _.then (_.do_while (_.boolean false) @@ -330,7 +330,7 @@ (def .public (when! statement expression archive [valueS pathP]) (Translator! [Synthesis Path]) - (do ///////phase.monad + (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] (in (all _.then @@ -341,6 +341,6 @@ (def .public (when statement expression archive [valueS pathP]) (-> Phase! (Translator [Synthesis Path])) - (do ///////phase.monad + (do phase.monad [pattern_matching! (..when! statement expression archive [valueS pathP])] (in (_.apply (_.closure (list) pattern_matching!) (list))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux index 33135b11a..ec4ad62bf 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux @@ -59,11 +59,11 @@ ["[1][0]" reference] [//// [analysis (.only Environment)] + ["[0]" phase] ["[0]" synthesis (.only Synthesis Abstraction Apply)] ["[0]" translation] [/// ["[0]" arity (.only Arity)] - ["[0]" phase] [meta [archive ["[0]" unit]]] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux index 822c3b9eb..5429d603f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux @@ -39,9 +39,9 @@ [//// [analysis (.only Environment)] [synthesis (.only Synthesis)] + ["[0]" phase] [/// - ["[0]" arity (.only Arity)] - ["[0]" phase]]]]]]) + ["[0]" arity (.only Arity)]]]]]]) (def .public (instance' foreign_setup class environment arity) (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux index edfc2c7d7..98a58a08d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux @@ -20,10 +20,10 @@ ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" value] [//// + ["[0]" phase] ["[0]" synthesis (.only Path Synthesis)] ["[0]" translation] [/// - ["[0]" phase] [reference [variable (.only Register)]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux index beb60ebc4..ac72e04a1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux @@ -19,9 +19,9 @@ ["[1][0]" type] ["//[1]" /// [// + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" translation] [/// - ["[1]" phase (.use "operation#[0]" monad)] [reference ["[0]" variable (.only Register Variable)]] [meta @@ -42,7 +42,7 @@ (def (foreign archive variable) (-> Archive Register (Operation (Bytecode Any))) - (do [! ////.monad] + (do [! phase.monad] [bytecode_name (of ! each //runtime.class_name (translation.context archive))] (in (all _.composite @@ -55,14 +55,14 @@ (-> Archive Variable (Operation (Bytecode Any))) (when variable {variable.#Local variable} - (operation#in (_.aload variable)) + (phase#in (_.aload variable)) {variable.#Foreign variable} (..foreign archive variable))) (def .public (constant archive name) (-> Archive Symbol (Operation (Bytecode Any))) - (do ////.monad + (do phase.monad [[@definition |abstraction|] (translation.definition archive name) .let [:definition: (type.class (//runtime.class_name @definition) (list))]] (in (when |abstraction| diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux index 6e2414d50..b0273f3f3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux @@ -49,10 +49,10 @@ ["[1]/[0]" count]]]] ["//[1]" /// [// + ["[0]" phase] ["[0]" synthesis] ["[0]" translation] [/// - ["[1]" phase] [arity (.only Arity)] [reference [variable (.only Register)]] @@ -587,7 +587,7 @@ ..try::method ..throw::method)) (list)))] - (do ////.monad + (do phase.monad [_ (translation.execute! [class bytecode]) _ (translation.save! ..artifact_id {.#None} [class bytecode])] (in [..artifact_id {.#None} bytecode])))) @@ -649,7 +649,7 @@ (list partial_count) (list.partial ::method apply::method+) (list)))] - (do ////.monad + (do phase.monad [_ (translation.execute! [class bytecode]) ... _ (translation.save! //function.artifact_id {.#None} [class bytecode]) ] @@ -657,7 +657,7 @@ (def .public translate (Operation [Registry Output]) - (do ////.monad + (do phase.monad [runtime_payload ..translate_runtime ... _ ..translate_function ] @@ -677,4 +677,4 @@ ... This shift is done to avoid the possibility of forged labels ... to be in the range of the labels that are generated automatically ... during the evaluation of Bytecode expressions. - (of ////.monad each (|>> ++ (i64.left_shifted shift)) translation.next))) + (of phase.monad each (|>> ++ (i64.left_shifted shift)) translation.next))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux index 502fcdd3c..d9bca3484 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux @@ -23,11 +23,10 @@ ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" primitive] ["///[1]" //// + ["[0]" phase] ["[1][0]" synthesis (.only Synthesis)] [analysis - [complex (.only Variant Tuple)]] - [/// - ["[0]" phase]]]]) + [complex (.only Variant Tuple)]]]]) (def .public (tuple phase archive membersS) (Translator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux index 9601f8751..4be90b358 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux @@ -31,12 +31,12 @@ ["[1][0]" value] ["[1][0]" structure] [//// + ["[0]" phase (.use "operation#[0]" monad)] ["[0]" translation] ["[0]" synthesis (.only Path Fork Synthesis) [access ["[0]" member (.only Member)]]] [/// - ["[0]" phase (.use "operation#[0]" monad)] [reference [variable (.only Register)]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux index 66e19f510..8a0b43ac5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux @@ -21,10 +21,10 @@ ["//[1]" /// [analysis (.only Abstraction Reification Analysis)] [synthesis (.only Synthesis)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" translation] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase (.use "[1]#[0]" monad)] [meta [archive ["[0]" unit]] @@ -36,7 +36,7 @@ (def .public (apply expression archive [functionS argsS+]) (Translator (Reification Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] (in (_.apply argsO+ functionO)))) @@ -70,7 +70,7 @@ (def .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Translator (Abstraction Synthesis))) - (do [! ///////phase.monad] + (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [function_name body!] (/////translation.with_new_context archive dependencies (do ! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux index e5c201528..6b008d307 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux @@ -22,10 +22,10 @@ ["/[1]" // ["[1][0]" reference] ["//[1]" /// - ["[0]"synthesis (.only Scope Synthesis)] + ["[0]" phase] + ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" translation] ["//[1]" /// - ["[1][0]" phase] [meta [archive (.only Archive)] ["[0]" cache @@ -60,11 +60,11 @@ {.#End} (|> bodyS (statement expression archive) - (of ///////phase.monad each (|>> [(list)]))) + (of phase.monad each (|>> [(list)]))) ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [@scope (of ! each ..@scope /////translation.next) initsO+ (monad.each ! (expression archive) initsS+) body! (/////translation.with_anchor [start @scope] @@ -84,7 +84,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [[artifact_module artifact_id] [initsO+ scope!]] (/////translation.with_new_context archive dependencies (scope! statement expression archive true [start initsS+ bodyS])) @@ -118,7 +118,7 @@ (def .public (again! statement expression archive argsS+) (Translator! (List Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [[offset @scope] /////translation.anchor argsO+ (monad.each ! (expression archive) argsS+)] (in (..setup false offset argsO+ false (_.go_to @scope))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux index f3089d34f..2ff224e3b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux @@ -28,10 +28,10 @@ ["[0]" /// ["[1][0]" reference] ["//[1]" /// + ["[0]" phase] ["[1][0]" synthesis (.only Synthesis)] ["[1][0]" translation] ["//[1]" /// (.only) - ["[1][0]" phase] [reference [variable (.only Register)]] [meta @@ -448,7 +448,7 @@ (def .public translate (Operation [Registry Output]) - (do ///////phase.monad + (do phase.monad [_ (/////translation.execute! ..full) _ (/////translation.save! ..module_id {.#None} ..full)] (in [(|> registry.empty diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux index 9d8068bde..a15f0833a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux @@ -10,27 +10,26 @@ ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" primitive] ["///[1]" //// + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" synthesis (.only Synthesis)] [analysis - [complex (.only Variant Tuple)]] - ["//[1]" /// - ["[1][0]" phase (.use "[1]#[0]" monad)]]]]) + [complex (.only Variant Tuple)]]]]) (def .public (tuple phase archive elemsS+) (Translator (Tuple Synthesis)) (when elemsS+ {.#End} - (///////phase#in (//primitive.text /////synthesis.unit)) + (phase#in (//primitive.text /////synthesis.unit)) {.#Item singletonS {.#End}} (phase archive singletonS) _ (|> elemsS+ - (monad.each ///////phase.monad (phase archive)) - (///////phase#each _.array)))) + (monad.each phase.monad (phase archive)) + (phase#each _.array)))) (def .public (variant phase archive [lefts right? valueS]) (Translator (Variant Synthesis)) - (///////phase#each (//runtime.variant lefts right?) - (phase archive valueS))) + (phase#each (//runtime.variant lefts right?) + (phase archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux index 5d8f9546d..1bb6d979f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux @@ -24,14 +24,14 @@ ["[1][0]" synthesis ["[1]/[0]" when]] ["/[1]" // + ["[0]" phase (.use "[1]#[0]" monad)] + ["[1][0]" translation] ["[1][0]" synthesis (.only Synthesis Path) [access ["[0]" member (.only Member)]]] - ["[1][0]" translation] ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) @@ -45,7 +45,7 @@ (def .public (exec expression archive [this that]) (Translator [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [this (expression archive this) that (expression archive that)] (in (|> (_.array (list this that)) @@ -53,7 +53,7 @@ (def .public (exec! statement expression archive [this that]) (Translator! [Synthesis Synthesis]) - (do [! ///////phase.monad] + (do [! phase.monad] [this (expression archive this) that (statement expression archive that) $dummy (of ! each _.var (/////translation.symbol "_exec"))] @@ -63,7 +63,7 @@ (def .public (let expression archive [valueS register bodyS]) (Translator [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. @@ -74,7 +74,7 @@ (def .public (let! statement expression archive [valueS register bodyS]) (Translator! [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] (in (all _.then @@ -83,7 +83,7 @@ (def .public (get expression archive [pathP valueS]) (Translator [(List Member) Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) (.let [method (.if (the member.#right? side) @@ -95,7 +95,7 @@ (def .public (if expression archive [testS thenS elseS]) (Translator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] @@ -107,7 +107,7 @@ (def .public (if! statement expression archive [testS thenS elseS]) (Translator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [testO (expression archive testS) thenO (statement expression archive thenS) elseO (statement expression archive elseS)] @@ -188,13 +188,13 @@ (statement expression archive bodyS) {/////synthesis.#Pop} - (///////phase#in ..pop!) + (phase#in ..pop!) {/////synthesis.#Bind register} - (///////phase#in (_.local/1 (..register register) ..peek)) + (phase#in (_.local/1 (..register register) ..peek)) {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] + (do [! phase.monad] [then! (again thenP) else! (.when elseP {.#Some elseP} @@ -212,7 +212,7 @@ (^.with_template [ ] [{ item} - (do [! ///////phase.monad] + (do [! phase.monad] [clauses (monad.each ! (function (_ [match then]) (do ! [then! (again then)] @@ -230,32 +230,32 @@ (^.with_template [ ] [( idx) - (///////phase#in ( false idx)) + (phase#in ( false idx)) ( idx nextP) - (///////phase#each (_.then ( true idx)) (again nextP))]) + (phase#each (_.then ( true idx)) (again nextP))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +1)) ..push!)) + (phase#in (|> ..peek (_.item (_.int +1)) ..push!)) (^.with_template [ ] [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) + (phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (/////synthesis.!bind_top register thenP) - (do ///////phase.monad + (do phase.monad [then! (again thenP)] - (///////phase#in (all _.then - (_.local/1 (..register register) ..peek_and_pop) - then!))) + (phase#in (all _.then + (_.local/1 (..register register) ..peek_and_pop) + then!))) (^.with_template [ ] [( preP postP) - (do ///////phase.monad + (do phase.monad [pre! (again preP) post! (again postP)] (in ( pre! post!)))]) @@ -264,7 +264,7 @@ (def (pattern_matching statement expression archive pathP) (-> Phase! Phase Archive Path (Operation Statement)) - (do ///////phase.monad + (do phase.monad [pattern_matching! (pattern_matching' statement expression archive pathP)] (in (all _.then (_.while (_.boolean true) @@ -286,7 +286,7 @@ (def .public (when! statement expression archive [valueS pathP]) (Translator! [Synthesis Path]) - (do ///////phase.monad + (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] (in (all _.then @@ -299,6 +299,6 @@ (-> Phase! (Translator [Synthesis Path])) (|> [valueS pathP] (..when! statement expression archive) - (of ///////phase.monad each + (of phase.monad each (|>> (_.closure (list)) (_.apply (list)))))) diff --git a/stdlib/source/library/lux/world/finance/market/analysis/accumulation_distribution.lux b/stdlib/source/library/lux/world/finance/market/analysis/accumulation_distribution.lux new file mode 100644 index 000000000..59fe58faf --- /dev/null +++ b/stdlib/source/library/lux/world/finance/market/analysis/accumulation_distribution.lux @@ -0,0 +1,23 @@ +... https://en.wikipedia.org/wiki/Accumulation/distribution_index +(.require + [library + [lux (.except) + [math + [number + ["n" nat] + ["f" frac]]]]] + [//// + ["[0]" money] + [trade + ["[0]" session (.only Session)]]]) + +(def .public (oscillation it) + (All (_ $) + (-> (Session $) + Frac)) + (let [high (money.amount (the session.#high it)) + low (money.amount (the session.#low it)) + close (money.amount (the session.#close it))] + (f./ (n.frac (n.- low high)) + (n.frac (n.- (n.- close high) + (n.- low close)))))) diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux deleted file mode 100644 index 1b9c0c941..000000000 --- a/stdlib/source/specification/lux/abstract/apply.lux +++ /dev/null @@ -1,68 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" function]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat]]] - [meta - ["[0]" type]] - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" / (.only Apply)]] - [// - ["[0]S" functor (.only Injection Comparison)]]) - -(def .public (spec injection comparison it) - (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) - (<| (_.for [/.Apply]) - (type.let [:$/1: (-> Nat Nat)]) - (do [! random.monad] - [sample random.nat - increase (is (Random :$/1:) - (of ! each n.+ random.nat)) - decrease (is (Random :$/1:) - (of ! each n.- random.nat))]) - (all _.and - (_.for [/.functor] - (functorS.spec injection comparison (the /.functor it))) - - (_.coverage [/.on] - (let [(open "/#[0]") it - - identity! - ((comparison n.=) - (/#on (injection sample) - (injection function.identity)) - (injection sample)) - - homomorphism! - ((comparison n.=) - (/#on (injection sample) (injection increase)) - (injection (increase sample))) - - interchange! - ((comparison n.=) (/#on (injection sample) (injection increase)) - (/#on (injection increase) (injection (is (-> (-> Nat Nat) Nat) - (function (_ f) (f sample)))))) - - composition! - ((comparison n.=) - (|> (injection (is (-> :$/1: :$/1: :$/1:) - function.composite)) - (/#on (injection increase)) - (/#on (injection decrease)) - (/#on (injection sample))) - (/#on (/#on (injection sample) - (injection increase)) - (injection decrease)))] - (and identity! - homomorphism! - interchange! - composition!))) - ))) diff --git a/stdlib/source/specification/lux/abstract/comonad.lux b/stdlib/source/specification/lux/abstract/comonad.lux index 536970182..2b89691ec 100644 --- a/stdlib/source/specification/lux/abstract/comonad.lux +++ b/stdlib/source/specification/lux/abstract/comonad.lux @@ -2,7 +2,9 @@ [library [lux (.except) [abstract - [monad (.only do)]] + [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]]] [math ["[0]" random] [number @@ -10,9 +12,7 @@ [test ["_" property (.only Test)]]]] [\\library - ["[0]" / (.only CoMonad)]] - [// - ["[0]S" functor (.only Injection Comparison)]]) + ["[0]" / (.only CoMonad)]]) (def .public (spec injection comparison it) (All (_ f) (-> (Injection f) (Comparison f) (CoMonad f) Test)) @@ -33,7 +33,7 @@ == (comparison n.=)]]) (all _.and (_.for [/.functor] - (functorS.spec injection comparison (the /.functor it))) + (functorT.spec injection comparison (the /.functor it))) (_.coverage [/.disjoint /.out] (let [left_identity! diff --git a/stdlib/source/specification/lux/abstract/functor.lux b/stdlib/source/specification/lux/abstract/functor.lux deleted file mode 100644 index c64be9401..000000000 --- a/stdlib/source/specification/lux/abstract/functor.lux +++ /dev/null @@ -1,59 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [equivalence (.only Equivalence)] - [monad (.only do)]] - [control - ["[0]" function]] - [math - ["[0]" random] - [number - ["n" nat]]] - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" / (.only Functor)]]) - -(type .public (Injection !) - (All (_ of) - (-> of - (! of)))) - -(type .public (Comparison !) - (All (_ of) - (-> (Equivalence of) - (Equivalence (! of))))) - -(def .public (spec injection comparison functor) - (All (_ !) - (-> (Injection !) (Comparison !) (Functor !) - Test)) - (<| (do [! random.monad] - [sample random.nat - increase (of ! each n.+ random.nat) - decrease (of ! each n.- random.nat)]) - (_.for [/.Functor]) - (_.coverage [/.each] - (let [(open "/#[0]") functor - - identity! - ((comparison n.=) - (/#each function.identity (injection sample)) - (injection sample)) - - homomorphism! - ((comparison n.=) - (/#each increase (injection sample)) - (injection (increase sample))) - - composition! - ((comparison n.=) - (|> (injection sample) - (/#each increase) - (/#each decrease)) - (|> (injection sample) - (/#each (|>> increase decrease))))] - (and identity! - homomorphism! - composition!))))) diff --git a/stdlib/source/specification/lux/abstract/mix.lux b/stdlib/source/specification/lux/abstract/mix.lux index 51c2d5d71..614b7439f 100644 --- a/stdlib/source/specification/lux/abstract/mix.lux +++ b/stdlib/source/specification/lux/abstract/mix.lux @@ -2,15 +2,15 @@ [library [lux (.except) [abstract - [monad (.only do)]] + [monad (.only do)] + [functor + [\\test (.only Injection Comparison)]]] [math ["[0]" random] [number ["n" nat]]] [test ["_" property (.only Test)]]]] - [// - [functor (.only Injection Comparison)]] [\\library ["[0]" /]]) diff --git a/stdlib/source/specification/lux/abstract/monad.lux b/stdlib/source/specification/lux/abstract/monad.lux index 82a7ff55b..48db743b8 100644 --- a/stdlib/source/specification/lux/abstract/monad.lux +++ b/stdlib/source/specification/lux/abstract/monad.lux @@ -1,6 +1,9 @@ (.require [library [lux (.except) + [abstract + [functor + [\\test (.only Injection Comparison)]]] [math ["[0]" random] [number @@ -8,9 +11,7 @@ [test ["_" property (.only Test)]]]] [\\library - ["[0]" / (.only do)]] - [// - [functor (.only Injection Comparison)]]) + ["[0]" / (.only do)]]) (def (left_identity injection comparison (open "_//[0]")) (All (_ f) (-> (Injection f) (Comparison f) (/.Monad f) Test)) diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index 1f315c131..0dea85553 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -4,18 +4,23 @@ [abstract [monad (.only do)]] [control - ["[0]" maybe]] + ["[0]" maybe] + ["[0]" function]] [data [collection ["[0]" list]]] [math - ["[0]" random] + ["[0]" random (.only Random)] [number ["n" nat]]] + [meta + ["[0]" type]] [test ["_" property (.only Test)]]]] [\\library - ["[0]" / (.only Apply)]]) + ["[0]" /]] + [// + ["[0]T" functor (.only Injection Comparison)]]) (def .public test Test @@ -35,3 +40,55 @@ _ false))) )))) + +(def .public (spec injection comparison it) + (All (_ !) + (-> (Injection !) (Comparison !) (/.Apply !) + Test)) + (<| (_.for [/.Apply]) + (type.let [:$/1: (-> Nat Nat)]) + (do [! random.monad] + [sample random.nat + increase (is (Random :$/1:) + (of ! each n.+ random.nat)) + decrease (is (Random :$/1:) + (of ! each n.- random.nat))]) + (all _.and + (_.for [/.functor] + (functorT.spec injection comparison (the /.functor it))) + + (_.coverage [/.on] + (let [(open "/#[0]") it + + identity! + ((comparison n.=) + (/#on (injection sample) + (injection function.identity)) + (injection sample)) + + homomorphism! + ((comparison n.=) + (/#on (injection sample) (injection increase)) + (injection (increase sample))) + + interchange! + ((comparison n.=) (/#on (injection sample) (injection increase)) + (/#on (injection increase) (injection (is (-> (-> Nat Nat) + Nat) + (function (_ f) (f sample)))))) + + composition! + ((comparison n.=) + (|> (injection (is (-> :$/1: :$/1: :$/1:) + function.composite)) + (/#on (injection increase)) + (/#on (injection decrease)) + (/#on (injection sample))) + (/#on (/#on (injection sample) + (injection increase)) + (injection decrease)))] + (and identity! + homomorphism! + interchange! + composition!))) + ))) diff --git a/stdlib/source/test/lux/abstract/comonad/free.lux b/stdlib/source/test/lux/abstract/comonad/free.lux index bd7c6df5d..8e9d67122 100644 --- a/stdlib/source/test/lux/abstract/comonad/free.lux +++ b/stdlib/source/test/lux/abstract/comonad/free.lux @@ -2,10 +2,10 @@ [library [lux (.except) [abstract - [functor (.only Functor)] [comonad (.only CoMonad)] + ["[0]" functor (.only Functor) + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor (.only Injection Comparison)] ["$[0]" comonad]]] [control ["//" continuation]] @@ -44,7 +44,7 @@ (_.for [/.Free]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison (is (Functor (/.Free Stream)) + (functorT.spec ..injection ..comparison (is (Functor (/.Free Stream)) (/.functor stream.functor)))) (_.for [/.comonad] ($comonad.spec ..injection ..comparison (is (CoMonad (/.Free Stream)) diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 99e8ac055..da06b6eaf 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -2,10 +2,12 @@ [library [lux (.except) [abstract + [equivalence (.only Equivalence)] [monad (.only do)]] [control ["[0]" maybe] - ["[0]" state]] + ["[0]" state] + ["[0]" function]] [data ["[0]" identity] [collection @@ -32,7 +34,8 @@ (\\polytypic.functor .List)) (def state_functor - (All (_ s) (Functor (state.State s))) + (All (_ state) + (Functor (state.State state))) (\\polytypic.functor state.State)) (def identity_functor @@ -92,3 +95,46 @@ ..\\polytypic )))) + +(type .public (Injection !) + (All (_ of) + (-> of + (! of)))) + +(type .public (Comparison !) + (All (_ of) + (-> (Equivalence of) + (Equivalence (! of))))) + +(def .public (spec injection comparison functor) + (All (_ !) + (-> (Injection !) (Comparison !) (Functor !) + Test)) + (<| (do [! random.monad] + [sample random.nat + increase (of ! each n.+ random.nat) + decrease (of ! each n.- random.nat)]) + (_.for [/.Functor]) + (_.coverage [/.each] + (let [(open "/#[0]") functor + + identity! + ((comparison n.=) + (/#each function.identity (injection sample)) + (injection sample)) + + homomorphism! + ((comparison n.=) + (/#each increase (injection sample)) + (injection (increase sample))) + + composition! + ((comparison n.=) + (|> (injection sample) + (/#each increase) + (/#each decrease)) + (|> (injection sample) + (/#each (|>> increase decrease))))] + (and identity! + homomorphism! + composition!))))) diff --git a/stdlib/source/test/lux/abstract/monad/free.lux b/stdlib/source/test/lux/abstract/monad/free.lux index 26b035c75..5d786ae19 100644 --- a/stdlib/source/test/lux/abstract/monad/free.lux +++ b/stdlib/source/test/lux/abstract/monad/free.lux @@ -5,9 +5,11 @@ [functor (.only Functor)] [apply (.only Apply)] [monad (.only Monad do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [data [collection @@ -47,10 +49,10 @@ (_.for [/.Free]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison (is (Functor (/.Free List)) + (functorT.spec ..injection ..comparison (is (Functor (/.Free List)) (/.functor list.functor)))) (_.for [/.apply] - ($apply.spec ..injection ..comparison (is (Apply (/.Free List)) + (applyT.spec ..injection ..comparison (is (Apply (/.Free List)) (/.apply list.functor)))) (_.for [/.monad] ($monad.spec ..injection ..comparison (is (Monad (/.Free List)) diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux index 1dd85aaaa..64bc1e119 100644 --- a/stdlib/source/test/lux/control/concurrency/async.lux +++ b/stdlib/source/test/lux/control/concurrency/async.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" io]] @@ -64,9 +66,9 @@ rightE not_dummy] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/concurrency/csp.lux b/stdlib/source/test/lux/control/concurrency/csp.lux index 502648def..057ff60c8 100644 --- a/stdlib/source/test/lux/control/concurrency/csp.lux +++ b/stdlib/source/test/lux/control/concurrency/csp.lux @@ -3,8 +3,9 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor (.only Injection Comparison)] ["$[0]" monad]]] [control ["[0]" io] @@ -48,7 +49,7 @@ (_.for [/.Process] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) )) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index edfcc24aa..d2d43363c 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" try] @@ -79,9 +81,9 @@ shift random.nat] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/concurrency/incremental.lux b/stdlib/source/test/lux/control/concurrency/incremental.lux index c606cec28..380da6f50 100644 --- a/stdlib/source/test/lux/control/concurrency/incremental.lux +++ b/stdlib/source/test/lux/control/concurrency/incremental.lux @@ -3,8 +3,9 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor (.only Injection Comparison)] ["$[0]" monad]]] [control ["[0]" io] @@ -65,7 +66,7 @@ (_.for [/.Computation] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.coverage [/.or] (let [left (/.var dummy) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index e39ff2ec8..1db0c216d 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract ["[0]" monad (.only Monad do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" io (.only IO)]] @@ -46,9 +48,9 @@ iterations_per_process (|> random.nat (of ! each (n.% 100)))] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/concurrency/structured.lux b/stdlib/source/test/lux/control/concurrency/structured.lux index 2af3d8550..93b62c414 100644 --- a/stdlib/source/test/lux/control/concurrency/structured.lux +++ b/stdlib/source/test/lux/control/concurrency/structured.lux @@ -3,8 +3,9 @@ [lux (.except) [abstract ["[0]" monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor (.only Injection Comparison)] ["$[0]" monad]]] [control ["[0]" maybe (.use "[1]#[0]" functor)] @@ -72,7 +73,7 @@ (_.for [/.Async]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index ce7b9d985..28f834949 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [data [collection @@ -39,9 +41,9 @@ (_.for [/.Cont]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/function/trampoline.lux b/stdlib/source/test/lux/control/function/trampoline.lux index bba85385a..c9ab584a4 100644 --- a/stdlib/source/test/lux/control/function/trampoline.lux +++ b/stdlib/source/test/lux/control/function/trampoline.lux @@ -3,8 +3,9 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor (.only Injection Comparison)] ["$[0]" monad]]] [math ["[0]" random] @@ -34,7 +35,7 @@ right random.nat]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux index cfcd17ee2..b280ca903 100644 --- a/stdlib/source/test/lux/control/io.lux +++ b/stdlib/source/test/lux/control/io.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [math ["[0]" random] @@ -36,9 +38,9 @@ exit_code random.int] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/lazy.lux b/stdlib/source/test/lux/control/lazy.lux index 4e4267810..9bb545a40 100644 --- a/stdlib/source/test/lux/control/lazy.lux +++ b/stdlib/source/test/lux/control/lazy.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad] ["$[0]" equivalence]]] [data @@ -47,9 +49,9 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux index ca86ab509..9e22f6be7 100644 --- a/stdlib/source/test/lux/control/maybe.lux +++ b/stdlib/source/test/lux/control/maybe.lux @@ -3,12 +3,14 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test]] + ["[0]" apply + ["[1]T" \\test]] [\\specification ["$[0]" equivalence] ["$[0]" hash] ["$[0]" monoid] - ["$[0]" functor] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" io (.use "[1]#[0]" monad)] @@ -41,9 +43,9 @@ (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) + (functorT.spec /#in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) + (applyT.spec /#in /.equivalence /.apply)) (_.for [/.monad] ($monad.spec /#in /.equivalence /.monad)) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index e62b889e0..3b145cec8 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -4,9 +4,11 @@ [abstract [monad (.only do)] [equivalence (.only Equivalence)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" try (.only Try)]] @@ -344,9 +346,9 @@ (_.for [/.Parser]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 6a1185b55..7213c78aa 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [math ["[0]" random] @@ -37,9 +39,9 @@ factor random.nat] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 2bbb8e0cb..32eed407b 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -7,9 +7,11 @@ [apply (.only Apply)] ["[0]" monad (.only Monad do)] ["[0]" enum] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" try (.only Try)]] @@ -84,11 +86,11 @@ [expected_clean_ups (|> random.nat (of ! each (|>> (n.% 100) (n.max 1))))] (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison (is (All (_ ! r) + (functorT.spec ..injection ..comparison (is (All (_ ! r) (Functor (Region r (thread.Thread !)))) (/.functor thread.functor)))) (_.for [/.apply] - ($apply.spec ..injection ..comparison (is (All (_ ! r) + (applyT.spec ..injection ..comparison (is (All (_ ! r) (Apply (Region r (thread.Thread !)))) (/.apply thread.monad)))) (_.for [/.monad] diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 82fb4c96a..014ec5104 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -4,9 +4,11 @@ [abstract [hash (.only Hash)] [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [data ["[0]" text (.use "[1]#[0]" equivalence)]] @@ -85,9 +87,9 @@ /.Safety /.Safe /.Can_Trust /.Can_Distrust] (all _.and (_.for [/.functor] - ($functor.spec (..injection (of policy_0 #can_upgrade)) (..comparison (of policy_0 #can_downgrade)) /.functor)) + (functorT.spec (..injection (of policy_0 #can_upgrade)) (..comparison (of policy_0 #can_downgrade)) /.functor)) (_.for [/.apply] - ($apply.spec (..injection (of policy_0 #can_upgrade)) (..comparison (of policy_0 #can_downgrade)) /.apply)) + (applyT.spec (..injection (of policy_0 #can_upgrade)) (..comparison (of policy_0 #can_downgrade)) /.apply)) (_.for [/.monad] ($monad.spec (..injection (of policy_0 #can_upgrade)) (..comparison (of policy_0 #can_downgrade)) /.monad)))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 98023b1f4..e66466eb0 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" pipe] @@ -72,9 +74,9 @@ [state random.nat] (all _.and (_.for [/.functor] - ($functor.spec ..injection (..comparison state) /.functor)) + (functorT.spec ..injection (..comparison state) /.functor)) (_.for [/.apply] - ($apply.spec ..injection (..comparison state) /.apply)) + (applyT.spec ..injection (..comparison state) /.apply)) (_.for [/.monad] ($monad.spec ..injection (..comparison state) /.monad)) ))) diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index 8996a2382..ac265c742 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [math ["[0]" random] @@ -49,9 +51,9 @@ io.run!))) (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) )) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index f6f000cc1..159fcfd7f 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad] ["$[0]" equivalence]]] [control @@ -51,9 +53,9 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..attempt random.nat))) (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index 4fda216e3..288859d4a 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -5,9 +5,11 @@ [equivalence (.only Equivalence)] [monoid (.only Monoid)] [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" io]] @@ -42,9 +44,9 @@ /.#log /.#value]) (all _.and (_.for [/.functor] - ($functor.spec (..injection text.monoid) ..comparison /.functor)) + (functorT.spec (..injection text.monoid) ..comparison /.functor)) (_.for [/.apply] - ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid))) + (applyT.spec (..injection text.monoid) ..comparison (/.apply text.monoid))) (_.for [/.monad] ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 74432550a..ec160d576 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -10,7 +10,15 @@ ["[0]" / ["[1][0]" binary] ["[1][0]" bit] - ["[1][0]" color] + ["[1][0]" color + ["[1]/[0]" rgb] + ["[1]/[0]" cmyk] + ["[1]/[0]" hsl] + ["[1]/[0]" hsb] + ["[1]/[0]" pigment] + ["[1]/[0]" named] + ["[1]/[0]" terminal] + ["[1]/[0]" scheme]] ["[1][0]" identity] ["[1][0]" product] ["[1][0]" sum] @@ -42,7 +50,6 @@ (all _.and /binary.test /bit.test - /color.test )) (def test/1 @@ -66,4 +73,13 @@ (!bundle test/2) (!bundle ..format) (!bundle /collection.test) + + /color/rgb.test + /color/cmyk.test + /color/hsl.test + /color/hsb.test + /color/pigment.test + /color/named.test + /color/terminal.test + /color/scheme.test )) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 68ba9480c..cec353635 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -8,9 +8,10 @@ ["$[1]" \\specification]] ["[0]" mix (.only Mix) ["$[1]" \\specification]] + ["[0]" functor + ["[1]T" \\test (.only Injection)]] [\\specification - ["$[0]" equivalence] - ["$[0]" functor (.only Injection)]]] + ["$[0]" equivalence]]] [control ["[0]" maybe (.use "[1]#[0]" functor)]] [data @@ -48,7 +49,7 @@ (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (functorT.spec ..injection /.equivalence /.functor)) (_.for [/.mix] ($mix.spec ..injection /.equivalence /.mix)) ))) @@ -140,7 +141,7 @@ (!.composite left right))) (random.array size random.nat))) (_.for [!.each] - ($functor.spec ..injection /.equivalence + (functorT.spec ..injection /.equivalence (function (_ $ it) (!.each $ it)))) (_.for [!.mix] diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 121fefce2..e0757bc7a 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -4,9 +4,10 @@ [abstract [hash (.only Hash)] [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection)]] [\\specification - ["$[0]" equivalence] - ["$[0]" functor (.only Injection)]]] + ["$[0]" equivalence]]] [control ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try] @@ -267,7 +268,7 @@ (random.dictionary n.hash size random.nat random.nat))) (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (functorT.spec ..injection /.equivalence /.functor)) ..for_dictionaries ..for_entries diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 93af39185..52e2a3183 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -4,13 +4,15 @@ [abstract [monad (.only do)] ["[0]" enum] + ["[0]" functor + ["[1]T" \\test]] + ["[0]" apply + ["[1]T" \\test]] [\\specification ["$[0]" equivalence] ["$[0]" hash] ["$[0]" monoid] ["$[0]" mix] - ["$[0]" functor] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" pipe] @@ -60,9 +62,9 @@ (_.for [/.mix] ($mix.spec /#in /.equivalence /.mix)) (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) + (functorT.spec /#in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) + (applyT.spec /#in /.equivalence /.apply)) (_.for [/.monad] ($monad.spec /#in /.equivalence /.monad)) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 2a99ba497..56656e44a 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -3,9 +3,10 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection)]] [\\specification - ["$[0]" equivalence] - ["$[0]" functor (.only Injection)]]] + ["$[0]" equivalence]]] [data ["[0]" bit (.use "[1]#[0]" equivalence)] [collection @@ -40,7 +41,7 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (functorT.spec ..injection /.equivalence /.functor)) (_.coverage [/.of_list /.list] (|> members /.of_list /.list diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index ad34204aa..2d9703523 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -3,12 +3,14 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification ["$[0]" equivalence] ["$[0]" monoid] ["$[0]" mix] - ["$[0]" functor (.only Injection)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" try (.only Try)] @@ -40,9 +42,9 @@ (_.for [/.mix] ($mix.spec /#in /.equivalence /.mix)) (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) + (functorT.spec /#in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) + (applyT.spec /#in /.equivalence /.apply)) (_.for [/.monad] ($monad.spec /#in /.equivalence /.monad)) ))) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index fab3b7d91..e18c44196 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -3,9 +3,10 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection)]] [\\specification - ["$[0]" equivalence] - ["$[0]" functor (.only Injection)]]] + ["$[0]" equivalence]]] [control ["[0]" maybe]] [data @@ -35,7 +36,7 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (functorT.spec ..injection /.equivalence /.functor)) (_.coverage [/.size] (n.= size (/.size sample))) diff --git a/stdlib/source/test/lux/data/collection/stream.lux b/stdlib/source/test/lux/data/collection/stream.lux index f14f53131..75c03aa36 100644 --- a/stdlib/source/test/lux/data/collection/stream.lux +++ b/stdlib/source/test/lux/data/collection/stream.lux @@ -5,8 +5,9 @@ [monad (.only do)] [equivalence (.only Equivalence)] ["[0]" enum] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor] ["$[0]" comonad]]] [data ["[0]" text (.only) @@ -53,7 +54,7 @@ cycle_next (random.list size random.nat)] (all _.and (_.for [/.functor] - ($functor.spec /.repeated ..equivalence /.functor)) + (functorT.spec /.repeated ..equivalence /.functor)) (_.for [/.comonad] ($comonad.spec /.repeated ..equivalence /.comonad)) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index eef32ee7d..66cdcfd6f 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -3,10 +3,11 @@ [lux (.except) [abstract ["[0]" monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification ["$[0]" equivalence] - ["$[0]" mix] - ["$[0]" functor]]] + ["$[0]" mix]]] [control ["//" parser] ["[0]" try] @@ -200,7 +201,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Tree]) + (_.for [/.Tree + /.#value /.#children]) (all _.and (_.for [/.equivalence] (|> (..tree random.nat) @@ -209,7 +211,7 @@ (_.for [/.mix] ($mix.spec /.leaf /.equivalence /.mix)) (_.for [/.functor] - ($functor.spec /.leaf /.equivalence /.functor)) + (functorT.spec /.leaf /.equivalence /.functor)) (do random.monad [[size sample] (..tree random.nat)] diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 4325a30ef..577862dc9 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -3,9 +3,10 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification ["$[0]" equivalence] - ["$[0]" functor] ["$[0]" comonad]]] [control ["[0]" pipe] @@ -167,7 +168,7 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (of ! each (|>> product.right /.zipper) (//.tree random.nat)))) (_.for [/.functor] - ($functor.spec (|>> tree.leaf /.zipper) /.equivalence /.functor)) + (functorT.spec (|>> tree.leaf /.zipper) /.equivalence /.functor)) (_.for [/.comonad] ($comonad.spec (|>> tree.leaf /.zipper) /.equivalence /.comonad)) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux deleted file mode 100644 index 25c041fd7..000000000 --- a/stdlib/source/test/lux/data/color.lux +++ /dev/null @@ -1,82 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" monoid]]] - [data - [collection - ["[0]" list]]] - [math - ["[0]" random (.only Random) (.use "[1]#[0]" functor)] - [number - ["n" nat] - ["f" frac] - ["r" rev] - ["[0]" int]]] - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" / (.only) - ["[0]" rgb] - ["[0]" hsl]]] - ["[0]" / - ["[1][0]" rgb] - ["[1][0]" cmyk] - ["[1][0]" hsl] - ["[1][0]" hsb] - ["[1][0]" pigment] - ["[1][0]" named] - ["[1][0]" terminal]]) - -(def .public random - (Random /.Color) - (random#each /.of_rgb /rgb.random)) - -... (def palette -... Test -... (_.for [/.Spread /.Palette] -... (do [! random.monad] -... [eH (of ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) -... random.safe_frac) -... .let [eS +0.5] -... variations (of ! each (|>> (n.% 3) (n.+ 2)) random.nat) -... .let [max_spread (f./ (|> variations ++ .int int.frac) -... +1.0) -... min_spread (f./ +2.0 max_spread) -... spread_space (f.- min_spread max_spread)] -... spread (of ! each (|>> f.abs (f.% spread_space) (f.+ min_spread)) -... random.safe_frac)] -... (`` (all _.and -... (,, (with_template [ ] -... [(_.coverage [] -... (let [eB -... expected (/.of_hsb [eH eS eB]) -... palette ( spread variations expected)] -... (and (n.= variations (list.size palette)) -... (not (list.any? (of /.equivalence = expected) palette)))))] -... [+1.0 /.analogous] -... [+0.5 /.monochromatic] -... )) -... ))))) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Color]) - (do [! random.monad] - [expected ..random] - (all _.and - ... ..palette - - /rgb.test - /cmyk.test - /hsl.test - /hsb.test - /pigment.test - /named.test - /terminal.test - )))) diff --git a/stdlib/source/test/lux/data/color/hsl.lux b/stdlib/source/test/lux/data/color/hsl.lux index de9c3ef8a..8563aa77b 100644 --- a/stdlib/source/test/lux/data/color/hsl.lux +++ b/stdlib/source/test/lux/data/color/hsl.lux @@ -49,11 +49,7 @@ ((function (_ it) (and (f.>= +0.25 it) (f.<= +0.75 it))))))) - ratio (|> random.safe_frac (random.only (f.>= +0.5))) - - eH (of ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) - random.safe_frac) - .let [eS +0.5]]) + ratio (|> random.safe_frac (random.only (f.>= +0.5)))]) (all _.and (_.for [/.Value] (all _.and @@ -116,28 +112,5 @@ (f.- (the /.#luminance mediocre)) f.abs (f.<= ..rgb_error_margin))))) - - (,, (with_template [] - [(_.coverage [] - (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5))) - [c0 c1 c2] ( expected)] - (and (of /.equivalence = expected c0) - (not (of /.equivalence = expected c1)) - (not (of /.equivalence = expected c2)))))] - - [/.triad] - [/.clash] - [/.split_complement])) - (,, (with_template [] - [(_.coverage [] - (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5))) - [c0 c1 c2 c3] ( expected)] - (and (of /.equivalence = expected c0) - (not (of /.equivalence = expected c1)) - (not (of /.equivalence = expected c2)) - (not (of /.equivalence = expected c3)))))] - - [/.square] - [/.tetradic])) ))) ))) diff --git a/stdlib/source/test/lux/data/color/scheme.lux b/stdlib/source/test/lux/data/color/scheme.lux new file mode 100644 index 000000000..0a66b7fc8 --- /dev/null +++ b/stdlib/source/test/lux/data/color/scheme.lux @@ -0,0 +1,80 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" monoid]]] + [data + [collection + ["[0]" list]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" functor)] + [number + ["n" nat] + ["f" frac] + ["r" rev] + ["[0]" int]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" rgb (.use "[1]#[0]" equivalence)] + ["[0]" hsl] + ["[0]" hsb]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected_hue (of ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) + random.safe_frac) + .let [expected_saturation +0.5] + variations (of ! each (|>> (n.% 3) (n.+ 2)) random.nat) + .let [max_spread (f./ (|> variations ++ .int int.frac) + +1.0) + min_spread (f./ +2.0 max_spread) + spread_space (f.- min_spread max_spread)] + spread (of ! each (|>> f.abs (f.% spread_space) (f.+ min_spread)) + random.safe_frac)]) + (`` (all _.and + (,, (with_template [] + [(_.coverage [] + (let [expected (hsb.rgb (hsb.hsb expected_hue expected_saturation +0.5)) + [c0 c1 c2] ( expected)] + (and (rgb#= expected c0) + (not (rgb#= expected c1)) + (not (rgb#= expected c2)))))] + + [/.triad] + [/.clash] + [/.split_complement])) + (,, (with_template [] + [(_.coverage [] + (let [expected (hsb.rgb (hsb.hsb expected_hue expected_saturation +0.5)) + [c0 c1 c2 c3] ( expected)] + (and (rgb#= expected c0) + (not (rgb#= expected c1)) + (not (rgb#= expected c2)) + (not (rgb#= expected c3)))))] + + [/.square] + [/.tetradic])) + (_.for [/.Spread /.Scheme] + (all _.and + (,, (with_template [expected_brightness ] + [(_.coverage [] + (let [expected (hsb.rgb (hsb.hsb expected_hue + expected_saturation + expected_brightness)) + palette ( spread variations expected)] + (and (n.= variations (list.size palette)) + (not (list.any? (rgb#= expected) palette)))))] + [+1.0 /.analogous] + [+0.5 /.monochromatic] + )) + )) + )))) diff --git a/stdlib/source/test/lux/data/color/terminal.lux b/stdlib/source/test/lux/data/color/terminal.lux index 9b734041d..bcc080a1c 100644 --- a/stdlib/source/test/lux/data/color/terminal.lux +++ b/stdlib/source/test/lux/data/color/terminal.lux @@ -14,8 +14,7 @@ [test ["_" property (.only Test)]]]] [\\library - ["[0]" / (.only) - ["/[1]" //]]] + ["[0]" /]] [// ["[0]T" rgb]]) @@ -56,8 +55,8 @@ (def .public random (Random /.Command) (`` (all random.either - (random#each (|>> //.of_rgb /.foreground) rgbT.random) - (random#each (|>> //.of_rgb /.background) rgbT.random) + (random#each /.foreground rgbT.random) + (random#each /.background rgbT.random) (,, (with_template [] [(random#in )] @@ -69,7 +68,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [color (random#each //.of_rgb rgbT.random) + [color rgbT.random command ..random expected_text (random.upper_cased 3)]) (_.for [/.Command]) diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index a27cc32f7..f18f69c41 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -3,9 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad] ["$[0]" comonad]]] [test @@ -28,9 +30,9 @@ (_.for [/.Identity]) (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) (_.for [/.comonad] diff --git a/stdlib/source/test/lux/math/random.lux b/stdlib/source/test/lux/math/random.lux index e559a9c85..8f125bd7e 100644 --- a/stdlib/source/test/lux/math/random.lux +++ b/stdlib/source/test/lux/math/random.lux @@ -4,9 +4,11 @@ [abstract [equivalence (.only Equivalence)] [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" maybe]] @@ -80,9 +82,9 @@ (_.for [/.Random]) (`` (all _.and (_.for [/.functor] - ($functor.spec ..injection (..comparison increase,seed) /.functor)) + (functorT.spec ..injection (..comparison increase,seed) /.functor)) (_.for [/.apply] - ($apply.spec ..injection (..comparison increase,seed) /.apply)) + (applyT.spec ..injection (..comparison increase,seed) /.apply)) (_.for [/.monad] ($monad.spec ..injection (..comparison increase,seed) /.monad)) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 97eb1e7f4..2a2787429 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -4,9 +4,11 @@ [abstract [equivalence (.only Equivalence)] [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" maybe] @@ -1018,9 +1020,9 @@ ... .#host []]]] ... (all _.and ... (_.for [/.functor] - ... ($functor.spec ..injection (..comparison expected_lux) /.functor)) + ... (functorT.spec ..injection (..comparison expected_lux) /.functor)) ... (_.for [/.apply] - ... ($apply.spec ..injection (..comparison expected_lux) /.apply)) + ... (applyT.spec ..injection (..comparison expected_lux) /.apply)) ... (_.for [/.monad] ... ($monad.spec ..injection (..comparison expected_lux) /.monad)) diff --git a/stdlib/source/test/lux/meta/compiler/phase.lux b/stdlib/source/test/lux/meta/compiler/phase.lux index 355f02299..692058872 100644 --- a/stdlib/source/test/lux/meta/compiler/phase.lux +++ b/stdlib/source/test/lux/meta/compiler/phase.lux @@ -3,8 +3,9 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] [\\specification - ["$[0]" functor (.only Injection Comparison)] ["$[0]" monad]]] [control ["[0]" pipe] @@ -141,7 +142,7 @@ expected random.int] (all _.and (_.for [/.functor] - ($functor.spec ..injection (..comparison state) /.functor)) + (functorT.spec ..injection (..comparison state) /.functor)) (_.for [/.monad] ($monad.spec ..injection (..comparison state) /.monad)) diff --git a/stdlib/source/test/lux/meta/type/check.lux b/stdlib/source/test/lux/meta/type/check.lux index f82d5b74e..18aef928a 100644 --- a/stdlib/source/test/lux/meta/type/check.lux +++ b/stdlib/source/test/lux/meta/type/check.lux @@ -3,9 +3,11 @@ [lux (.except symbol type) [abstract ["[0]" monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection Comparison)]] + ["[0]" apply + ["[1]T" \\test]] [\\specification - ["$[0]" functor (.only Injection Comparison)] - ["$[0]" apply] ["$[0]" monad]]] [control ["[0]" pipe] @@ -111,9 +113,9 @@ Test (all _.and (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) + (functorT.spec ..injection ..comparison /.functor)) (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) + (applyT.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) )) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index bf9ff3c7f..3793d49ee 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -16,7 +16,10 @@ ["[1][0]" finance ["[1]/[0]" money] ["[1]/[0]" trade - ["[1]/[0]" session]]] + ["[1]/[0]" session]] + ["[1]/[0]" market + ["[1]/[0]" analysis + ["[1]/[0]" accumulation_distribution]]]] ["[1][0]" net] ["[1][0]" time] ["[1][0]" locale] @@ -35,6 +38,7 @@ /finance/money.test /finance/trade/session.test + /finance/market/analysis/accumulation_distribution.test /net.test /time.test diff --git a/stdlib/source/test/lux/world/finance/market/analysis/accumulation_distribution.lux b/stdlib/source/test/lux/world/finance/market/analysis/accumulation_distribution.lux new file mode 100644 index 000000000..74b502140 --- /dev/null +++ b/stdlib/source/test/lux/world/finance/market/analysis/accumulation_distribution.lux @@ -0,0 +1,31 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [math + ["[0]" random (.only Random)] + [number + ["f" frac]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [//// + [money + ["[0]" currency]]]]] + [//// + [trade + ["[0]T" session]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [session (sessionT.random currency.usd)]) + (all _.and + (_.coverage [/.oscillation] + (let [it (/.oscillation session)] + (and (f.<= +1.0 it) + (f.>= -1.0 it)))) + ))) diff --git a/stdlib/source/test/lux/world/time/series.lux b/stdlib/source/test/lux/world/time/series.lux index 47432df08..ef42a994e 100644 --- a/stdlib/source/test/lux/world/time/series.lux +++ b/stdlib/source/test/lux/world/time/series.lux @@ -3,10 +3,11 @@ [lux (.except) [abstract [monad (.only do)] + ["[0]" functor + ["[1]T" \\test (.only Injection)]] [\\specification ["[0]S" equivalence] - ["[0]S" mix] - ["[0]S" functor (.only Injection)]]] + ["[0]S" mix]]] [control ["|" pipe] ["[0]" try (.use "[1]#[0]" functor)] @@ -79,7 +80,7 @@ (_.for [/.mix] (mixS.spec (..injection expected_start expected_interval) /.equivalence /.mix)) (_.for [/.functor] - (functorS.spec (..injection expected_start expected_interval) /.equivalence /.functor)) + (functorT.spec (..injection expected_start expected_interval) /.equivalence /.functor)) (_.coverage [/.size] (n.= expected_size -- cgit v1.2.3