diff options
Diffstat (limited to '')
10 files changed, 179 insertions, 11 deletions
diff --git a/documentation/bookmark/concurrency/behavioral_programming.md b/documentation/bookmark/concurrency/behavioral_programming.md new file mode 100644 index 000000000..56069ae56 --- /dev/null +++ b/documentation/bookmark/concurrency/behavioral_programming.md @@ -0,0 +1,11 @@ +# Reference + +0. []() +0. [behavioral: Behavioral Programming for JavaScript](https://github.com/lmatteis/behavioral) +0. [Behavioral Programming](https://lmatteis.github.io/react-behavioral/) +0. [Append only development with React — Luca Matteis](https://www.youtube.com/watch?v=cXuvCMG21Ss) +0. [Behavioral Programming](https://www.wisdom.weizmann.ac.il/~harel/papers/Behavioral%20programming.pdf) +0. [Behavioral Programming: Weaving threads into programs](https://www.wisdom.weizmann.ac.il/~bprogram/) +0. [Behavioral Programming](https://jeremywsherman.com/blog/2012/07/23/behavioral-programming/) +0. [Behavioral Programming](https://cacm.acm.org/magazines/2012/7/151241-behavioral-programming/fulltext) + diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 6a4f582de..75bec2d4b 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -30,7 +30,7 @@ (template (_ a) [(-> a (IO Any))])) -(primitive .public (Async'' a) +(primitive (Async'' a) (Atom [(Value a) (List (Handler a))]) (type .public (Async' r w) diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux index 2a7fec64c..f6229b7f0 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -27,7 +27,7 @@ @.jvm <jvm> (these))) -(primitive .public (Atom'' a) +(primitive (Atom'' a) (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)] (for @.old <jvm> @.jvm <jvm> diff --git a/stdlib/source/library/lux/control/concurrency/behavioral.lux b/stdlib/source/library/lux/control/concurrency/behavioral.lux new file mode 100644 index 000000000..1865558aa --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/behavioral.lux @@ -0,0 +1,50 @@ +(.require + [library + [lux (.except)]] + [// + ["[0]" async (.only Async) (.use "[1]#[0]" monad)] + ["[0]" frp (.only Channel)]]) + +(def <Event> + (template (_ Constructor data) + [[(Constructor data) data]])) + +(type .public (Constructor data) + (-> data (<Event> Constructor data))) + +(type .public Event + (Ex (_ data) + (<Event> Constructor data))) + +(def .public (event constructor) + (All (_ data) + (-> (-> data data) + (Constructor data))) + (exec + [] ... This was added to avoid having auto-currying to fuse the "event" and "self" functions. + ... Otherwise, the "same?" comparison done later would fail. + (function (self data) + [self (constructor data)]))) + +(def .public (event? expected it) + (All (_ data) + (-> (Constructor data) Event + (Maybe data))) + (let [[actual data] it] + (if (same? expected actual) + {.#Some (as_expected data)} + {.#None}))) + +(def .public (scenario events expected initial behavior) + (All (_ state data) + (-> (Channel Event) (Constructor data) state (-> data state (Async state)) + (Async state))) + (frp.mix (function (_ event state) + (when (event? expected event) + {.#Some data} + (behavior data state) + + {.#None} + (async#in state))) + initial + events)) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index 280c0dee8..2b6118575 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -27,7 +27,7 @@ (type (Observer a) (-> a (IO Any))) -(primitive .public (Var'' a) +(primitive (Var'' a) (Atom [a (List (Sink a))]) (type .public (Var' r w) diff --git a/stdlib/source/library/lux/control/function/polymorphism/type.lux b/stdlib/source/library/lux/control/function/polymorphism/type.lux index 1159bc488..ffa657330 100644 --- a/stdlib/source/library/lux/control/function/polymorphism/type.lux +++ b/stdlib/source/library/lux/control/function/polymorphism/type.lux @@ -6,13 +6,14 @@ [control ["?" parser (.use "[1]#[0]" monad)]] [data - ["[0]" text (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format]] [collection ["[0]" list (.use "[1]#[0]" functor)]]] ["[0]" meta (.only) ["[0]" code (.only) ["?[1]" \\parser (.only Parser)]] - [macro (.only with_symbols) + ["[0]" macro (.only with_symbols) ["[0]" context] [syntax (.only syntax) ["[0]" export]]] @@ -22,6 +23,7 @@ (type Polymorphism (Record [#name Text + #export_policy Code #interface Code #method Code])) @@ -35,8 +37,12 @@ (?code.tuple (?.many ?code.local)) ?code.any (?.many ?code.any)))]) - (<| (with_symbols [g!_ g!interface g!method g!inputs]) - (..declaration [#name name #interface g!interface #method g!method]) + (<| (do meta.monad + [@ meta.current_module_name + g!interface (macro.symbol (%.symbol [@ name])) + g!method (macro.symbol (%.symbol [@ name]))]) + (with_symbols [g!_ g!inputs]) + (..declaration [#name name #export_policy export_policy #interface g!interface #method g!method]) (let [name (code.local name) parameters (list#each code.local parameters)]) (` (these (type (, export_policy) (, g!interface) @@ -65,7 +71,7 @@ [it (context.search (|>> (the #name) (text#= name)) ..stack) .let [name (code.local name)]] (with_symbols [g!self] - (in (list (` (.def .public (, g!self) + (in (list (` (.def (, (the #export_policy it)) (, g!self) ((, (the #interface it)) (,* specialization)) (implementation (.def ((, (the #method it)) (,* inputs)) diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index 665db5232..dd7b6208c 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -20,7 +20,7 @@ (type .public (Thread ! a) (-> ! a)) -(primitive .public (Box'' t a) +(primitive (Box'' t a) (Array a) (type .public (Box' t r w) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 18ab1d19d..a53c174d5 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -17,7 +17,8 @@ ["[1]/[0]" event] ["[1]/[0]" cps] ["[1]/[0]" incremental] - ["[1]/[0]" structured]] + ["[1]/[0]" structured] + ["[1]/[0]" behavioral]] ["[1][0]" continuation] ["[1][0]" exception] ["[1][0]" function] @@ -52,6 +53,7 @@ /concurrency/cps.test /concurrency/incremental.test /concurrency/structured.test + /concurrency/behavioral.test )) (def security diff --git a/stdlib/source/test/lux/control/concurrency/behavioral.lux b/stdlib/source/test/lux/control/concurrency/behavioral.lux new file mode 100644 index 000000000..6728ad266 --- /dev/null +++ b/stdlib/source/test/lux/control/concurrency/behavioral.lux @@ -0,0 +1,85 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["|" pipe] + ["[0]" maybe (.use "[1]#[0]" functor)]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)] + ["[0]" unit]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" atom (.only Atom)] + ["[0]" async] + ["[0]" frp]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected random.nat + shift (random.only (n.> 0) random.nat)]) + (all _.and + (_.coverage [/.Constructor /.event] + (let [left (is (/.Constructor Nat) + (/.event (|>>))) + right (is (/.Constructor Nat) + (/.event (|>>)))] + (not (same? left right)))) + (_.coverage [/.Event /.event?] + (let [left (is (/.Constructor Nat) + (/.event (|>>))) + right (is (/.Constructor Nat) + (/.event (|>>)))] + (`` (and (,, (with_template [<correct> <incorrect>] + [(|> (<correct> expected) + (/.event? <correct>) + (maybe#each (same? expected)) + (maybe.else false)) + (|> (<correct> expected) + (/.event? <incorrect>) + (|.when + {.#None} true + {.#Some _} false))] + + [left right] + [right left] + )))))) + (in (let [increase (is (/.Constructor Any) + (/.event (|>>))) + decrease (is (/.Constructor Any) + (/.event (|>>))) + counter (is (Atom Nat) + (atom.atom expected)) + [events feed!] (is [(frp.Channel /.Event) (frp.Sink /.Event)] + (frp.channel [])) + scenario/+ (<| (/.scenario events increase expected) + (function (_ _ so_far) + (do async.monad + [[old new] (async.future (atom.update! (n.+ shift) counter))] + (in new)))) + scenario/- (<| (/.scenario events decrease expected) + (function (_ _ so_far) + (do async.monad + [[old new] (async.future (atom.update! (n.- shift) counter))] + (in new))))] + (do async.monad + [_ (async.future (at feed! feed (increase []))) + _ (async.future (at feed! feed (increase []))) + _ (async.future (at feed! feed (decrease []))) + _ (async.future (at feed! close)) + scenario/+ scenario/+ + scenario/- scenario/- + count (async.future (atom.read! counter))] + (unit.coverage [/.scenario] + (and (n.= (all n.+ shift expected) count) + (n.= (all n.+ shift shift expected) scenario/+) + (n.= (all n.+ shift expected) scenario/-)))))) + ))) diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux index 44666a08d..e24d6f52f 100644 --- a/stdlib/source/test/lux/control/function/contract.lux +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -21,7 +21,8 @@ Test (<| (_.covering /._) (do [! random.monad] - [expected random.nat]) + [expected random.nat + error_message (random.upper_case 5)]) (all _.and (_.coverage [/.pre /.pre_condition_failed] (when (try (/.pre (n.even? expected) @@ -43,4 +44,17 @@ (and (text.contains? (the exception.#label /.post_condition_failed) error) (not (n.odd? expected))))) + (_.coverage [/.assert!] + (and (when (try (/.assert! error_message true)) + {try.#Success actual} + true + + {try.#Failure error} + false) + (when (try (/.assert! error_message false)) + {try.#Success actual} + false + + {try.#Failure error} + (text.contains? error_message error)))) ))) |