From 5da753fb0a4e220ea29fb3f45c92a69358901c20 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 26 Jul 2022 20:15:22 -0400 Subject: Slightly cleaner application of variance for FRP channels. --- .../library/lux/control/concurrency/async.lux | 14 +++- .../source/library/lux/control/concurrency/frp.lux | 94 +++++++++++----------- .../source/library/lux/data/collection/array.lux | 4 +- stdlib/source/library/lux/ffi.jvm.lux | 2 +- stdlib/source/library/lux/ffi.old.lux | 2 +- stdlib/source/library/lux/meta/type.lux | 4 +- stdlib/source/library/lux/test.lux | 64 ++++++++------- 7 files changed, 99 insertions(+), 85 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 822627610..c492b9b5e 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -22,8 +22,16 @@ ["[0]" thread] ["[0]" atom (.only Atom atom)]]) +(def Value + (template (_ a) + [(Maybe a)])) + +(def Handler + (template (_ a) + [(-> a (IO Any))])) + (primitive .public (Async'' a) - (Atom [(Maybe a) (List (-> a (IO Any)))]) + (Atom [(Value a) (List (Handler a))]) (type .public (Async' r w) (Async'' (Mutable r w))) @@ -65,14 +73,14 @@ [async (..resolver async)])) (def .public value - (All (_ r w) (-> (Async' r w) (IO (Maybe r)))) + (All (_ r w) (-> (Async' r w) (IO (Value r)))) (|>> representation atom.read! (at io.functor each (|>> product.left (maybe#each (|>> variance.read)))))) (def .public (upon! f async) - (All (_ r w) (-> (-> r (IO Any)) (Async' r w) (IO Any))) + (All (_ r w) (-> (Handler r) (Async' r w) (IO Any))) (do [! io.monad] [.let [async (representation async)] (^.let old [_value _observers]) (atom.read! async)] diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index 1311d9b3d..36275bef4 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -12,22 +12,19 @@ ["[0]" exception (.only exception)] ["[0]" io (.only IO io)]] [meta - [type (.only sharing) - ["[0]" variance (.only Mutable)]]]]] + ["[0]" type (.only sharing)]]]] [// ["[0]" atom (.only Atom)] ["[0]" async (.only Async Async') (.use "[1]#[0]" monad)]]) -(type .public (Channel'' a) - (Async (Maybe [a (Channel'' a)]))) - (type .public (Channel' r w) - (Channel'' (Mutable r w))) + (Async' (Maybe [r (Channel' r w)]) + (Maybe [w (Channel' r w)]))) (type .public (Channel a) - (Channel'' (Mutable a a))) + (Channel' a a)) -(exception .public channel_is_already_closed) +(exception .public already_closed) (type .public (Sink w) (Interface @@ -38,7 +35,7 @@ (def (sink resolution) (All (_ a) - (-> (async.Resolver (Maybe [(Mutable a a) (Channel a)])) + (-> (async.Resolver (Maybe [a (Channel a)])) (Sink a))) (let [sink (atom.atom resolution)] (implementation @@ -55,7 +52,7 @@ [latter (atom.read! sink)] (if (same? current latter) ... Someone else closed the sink. - (in (exception.except ..channel_is_already_closed [])) + (in (exception.except ..already_closed [])) ... Someone else fed the sink while I was closing it. (again []))))))) @@ -64,12 +61,12 @@ (do [! io.monad] [current (atom.read! sink) .let [[next resolve_next] (sharing [a] - (is (async.Resolver (Maybe [(Mutable a a) (Channel a)])) + (is (async.Resolver (Maybe [a (Channel a)])) current) (is [(Channel a) - (async.Resolver (Maybe [(Mutable a a) (Channel a)]))] + (async.Resolver (Maybe [a (Channel a)]))] (async.async [])))] - fed? (current {.#Some [(variance.write value) next]})] + fed? (current {.#Some [value next]})] (if fed? ... I fed the sink. (do ! @@ -80,7 +77,7 @@ [latter (atom.read! sink)] (if (same? current latter) ... Someone else closed the sink while I was feeding it. - (in (exception.except ..channel_is_already_closed [])) + (in (exception.except ..already_closed [])) ... Someone else fed the sink. (again [])))))))))) @@ -96,7 +93,7 @@ (async#each (maybe#each (function (_ [head tail]) - [(variance.write (f (variance.read head))) + [(f head) (each f tail)])))))) (def .public apply @@ -110,7 +107,7 @@ item_a fa] (case [item_f item_a] [{.#Some [head_f tail_f]} {.#Some [head_a tail_a]}] - (in {.#Some [(variance.write ((variance.read head_f) (variance.read head_a))) + (in {.#Some [(head_f head_a) (on tail_a tail_f)]}) _ @@ -126,7 +123,7 @@ (def functor ..functor) (def (in a) - (async.resolved {.#Some [(variance.write a) ..empty]})) + (async.resolved {.#Some [a ..empty]})) (def (conjoint mma) (let [[output sink] (sharing [a] @@ -144,12 +141,12 @@ (do ! [_ (loop (again [ma ma]) (do ! - [?ma (variance.read ma)] + [?ma ma] (case ?ma {.#Some [a ma']} (exec - (io.run! (at sink feed (variance.read a))) - (again (variance.write ma'))) + (io.run! (at sink feed a)) + (again ma')) {.#None} (in []))))] @@ -162,16 +159,19 @@ (type .public (Subscriber a) (-> a (IO (Maybe Any)))) -(def .public (subscribe! subscriber channel) +(def .public (subscribe! subscriber it) (All (_ r w) (-> (Subscriber r) (Channel' r w) (IO Any))) (io (exec (is (Async Any) - (loop (again [channel channel]) + (loop (again [it (type.as [r w] + (Channel' r w) + (Channel r) + it)]) (do async.monad - [item channel] + [item it] (case item {.#Some [head tail]} - (case (io.run! (subscriber (variance.read head))) + (case (io.run! (subscriber head)) {.#Some _} (again tail) @@ -182,14 +182,14 @@ (in []))))) []))) -(def .public (only pass? channel) +(def .public (only pass? it) (All (_ a) (-> (-> a Bit) (Channel a) (Channel a))) (do async.monad - [item channel] + [item it] (case item {.#Some [head tail]} (let [tail' (only pass? tail)] - (if (pass? (variance.read head)) + (if (pass? head) (in {.#Some [head tail']}) tail')) @@ -199,40 +199,40 @@ (def .public (of_async async) (All (_ a) (-> (Async a) (Channel a))) (async#each (function (_ value) - {.#Some [(variance.write value) ..empty]}) + {.#Some [value ..empty]}) async)) -(def .public (mix f init channel) +(def .public (mix f init it) (All (_ a b) (-> (-> b a (Async a)) a (Channel b) (Async a))) (do [! async.monad] - [item channel] + [item it] (case item {.#None} (in init) {.#Some [head tail]} (do ! - [init' (f (variance.read head) init)] + [init' (f head init)] (mix f init' tail))))) -(def .public (mixes f init channel) +(def .public (mixes f init it) (All (_ a b) (-> (-> b a (Async a)) a (Channel b) (Channel a))) (<| async#in {.#Some} - [(variance.write init)] + [init] (do [! async.monad] - [item channel] + [item it] (case item {.#None} (in {.#None}) {.#Some [head tail]} (do ! - [init' (f (variance.read head) init)] + [init' (f head init)] (mixes f init' tail)))))) (def .public (poll milli_seconds action) @@ -257,42 +257,42 @@ [?next (f init)] (in (case ?next {.#Some [state output]} - {.#Some [(variance.write output) (iterations f state)]} + {.#Some [output (iterations f state)]} {.#None} {.#None})))) -(def (distinct' equivalence previous channel) +(def (distinct' equivalence previous it) (All (_ a) (-> (Equivalence a) a (Channel a) (Channel a))) (do async.monad - [item channel] + [item it] (case item {.#Some [head tail]} - (if (at equivalence = previous (variance.read head)) + (if (at equivalence = previous head) (distinct' equivalence previous tail) - (in {.#Some [head (distinct' equivalence (variance.read head) tail)]})) + (in {.#Some [head (distinct' equivalence head tail)]})) {.#None} (in {.#None})))) -(def .public (distinct equivalence channel) +(def .public (distinct equivalence it) (All (_ a) (-> (Equivalence a) (Channel a) (Channel a))) (do async.monad - [item channel] + [item it] (in (case item {.#Some [head tail]} - {.#Some [head (distinct' equivalence (variance.read head) tail)]} + {.#Some [head (distinct' equivalence head tail)]} {.#None} {.#None})))) -(def .public (list channel) +(def .public (list it) (All (_ a) (-> (Channel a) (Async (List a)))) (do [! async.monad] - [item channel] + [item it] (case item {.#Some [head tail]} - (at ! each (|>> {.#Item (variance.read head)}) + (at ! each (|>> {.#Item head}) (list tail)) {.#None} @@ -305,7 +305,7 @@ ..empty {.#Item head tail} - (async.resolved {.#Some [(variance.write head) + (async.resolved {.#Some [head (do async.monad [_ (async.delay milli_seconds)] (sequential milli_seconds tail))]}))) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index 40e8c6599..3158b04d6 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -17,9 +17,9 @@ [variance (.only)]]]]] ["!" \\unsafe]) -(def .public type_name +(def .public primitive Text - !.type) + !.primitive) (type .public Array' !.Array') diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 1f40f0d76..f9fd3472a 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -1928,7 +1928,7 @@ [jvm.double] [jvm.char])) - (text#= array.type_name name) + (text#= array.primitive name) (case params {.#Item {.#Apply writeLT {.#Apply readLT _Mutable}} {.#End}} (at meta.monad each jvm.array diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index d0a3132c7..7bcd63ce1 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -1025,7 +1025,7 @@ (format "(" (safe name) " " (spaced (list#each generic_type$ params)) ")") {#GenericArray param} - (format "(" array.type_name " " (generic_type$ param) ")") + (format "(" array.primitive " " (generic_type$ param) ")") {#GenericWildcard {.#None}} "?" diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index b751e9270..f53222cf1 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -390,14 +390,14 @@ _ (|> element_type (array (-- depth)) (list) - {.#Primitive array.type_name}))) + {.#Primitive array.primitive}))) (def .public (flat_array type) (-> Type [Nat Type]) (with_expansions [ [0 type]] (case type {.#Primitive name (list element_type)} - (if (text#= array.type_name name) + (if (text#= array.primitive name) (.let [[depth element_type] (flat_array element_type)] [(++ depth) element_type]) ) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 5c3b9451e..a29acfefe 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -42,28 +42,31 @@ ["[0]" instant] ["[0]" duration (.only Duration)]]]]]) +(type .public Coverage + (Set Symbol)) + (type .public Tally (Record [#successes Nat #failures Nat - #expected_coverage (Set Symbol) - #actual_coverage (Set Symbol)])) + #expected Coverage + #actual Coverage])) (def (total parameter subject) (-> Tally Tally Tally) [#successes (n.+ (the #successes parameter) (the #successes subject)) #failures (n.+ (the #failures parameter) (the #failures subject)) - #expected_coverage (set.union (the #expected_coverage parameter) - (the #expected_coverage subject)) - #actual_coverage (set.union (the #actual_coverage parameter) - (the #actual_coverage subject))]) + #expected (set.union (the #expected parameter) + (the #expected subject)) + #actual (set.union (the #actual parameter) + (the #actual subject))]) (def start Tally [#successes 0 #failures 0 - #expected_coverage (set.empty symbol.hash) - #actual_coverage (set.empty symbol.hash)]) + #expected (set.empty symbol.hash) + #actual (set.empty symbol.hash)]) (with_template [ ] [(def @@ -189,19 +192,19 @@ (-> Duration Tally Text) (let [successes (the #successes tally) failures (the #failures tally) - missing (set.difference (the #actual_coverage tally) - (the #expected_coverage tally)) - unexpected (set.difference (the #expected_coverage tally) - (the #actual_coverage tally)) - report (is (-> (Set Symbol) Text) + missing (set.difference (the #actual tally) + (the #expected tally)) + unexpected (set.difference (the #expected tally) + (the #actual tally)) + report (is (-> Coverage Text) (|>> set.list (list.sorted (at symbol.order <)) (exception.listing %.symbol))) - expected_definitions_to_cover (set.size (the #expected_coverage tally)) - unexpected_definitions_covered (set.size unexpected) - actual_definitions_covered (n.- unexpected_definitions_covered - (set.size (the #actual_coverage tally))) - coverage (case expected_definitions_to_cover + expected_coverage (set.size (the #expected tally)) + unexpected_coverage (set.size unexpected) + actual_coverage (n.- unexpected_coverage + (set.size (the #actual tally))) + coverage (case expected_coverage 0 "N/A" expected (let [missing_ratio (f./ (n.frac expected) (n.frac (set.size missing))) @@ -223,17 +226,20 @@ (text.suffix "%"))))))] (exception.report (list ["Duration" (%.duration duration)] + ["Tests" (%.nat (n.+ successes failures))] ["Successes" (%.nat successes)] ["Failures" (%.nat failures)] - ["Expected definitions to cover" (%.nat expected_definitions_to_cover)] - ["Actual definitions covered" (%.nat actual_definitions_covered)] - ["Pending definitions to cover" (%.nat (n.- actual_definitions_covered - expected_definitions_to_cover))] - ["Unexpected definitions covered" (%.nat unexpected_definitions_covered)] + + ["Expected coverage" (%.nat expected_coverage)] + ["Actual coverage" (%.nat actual_coverage)] + ["Pending coverage" (%.nat (n.- actual_coverage + expected_coverage))] + ["Unexpected coverage" (%.nat unexpected_coverage)] + ["Coverage" coverage] - ["Pending definitions to cover" (report missing)] - ["Unexpected definitions covered" (report unexpected)])))) + ["Pending" (report missing)] + ["Unexpected" (report unexpected)])))) (def failure_exit_code +1) (def success_exit_code +0) @@ -280,7 +286,7 @@ coverage (set.of_list symbol.hash coverage)] (|> (..assertion message condition) (async#each (function (_ [tally documentation]) - [(revised #actual_coverage (set.union coverage) tally) + [(revised #actual (set.union coverage) tally) documentation]))))) (def .public (with_coverage coverage condition) @@ -295,7 +301,7 @@ (text.interposed ..definition_separator)) coverage (set.of_list symbol.hash coverage)] (random#each (async#each (function (_ [tally documentation]) - [(revised #actual_coverage (set.union coverage) tally) + [(revised #actual (set.union coverage) tally) documentation])) (..context' context test)))) @@ -323,7 +329,7 @@ "")) (def (coverage_definitions module encoding) - (-> Text Text (Set Symbol)) + (-> Text Text Coverage) (loop (again [remaining encoding output (set.of_list symbol.hash (list))]) (case (text.split_by ..coverage_separator remaining) @@ -363,7 +369,7 @@ (let [coverage (..coverage_definitions module coverage)] (|> (..context' module test) (random#each (async#each (function (_ [tally documentation]) - [(revised #expected_coverage (set.union coverage) tally) + [(revised #expected (set.union coverage) tally) (|> documentation (text.replaced (format ..clean_up_marker module symbol.separator) "") (text.replaced ..clean_up_marker ""))])))))) -- cgit v1.2.3