diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/concurrency/space.lux | 154 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/space.lux | 23 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 2 |
3 files changed, 0 insertions, 179 deletions
diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux deleted file mode 100644 index fb7f199f8..000000000 --- a/stdlib/source/lux/concurrency/space.lux +++ /dev/null @@ -1,154 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - ["p" parser]) - (concurrency ["P" promise] - ["T" task] - ["A" actor #+ actor:]) - (data [product] - (coll [list "L/" Functor<List> Fold<List>])) - [io #- run] - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))))) - -(with-expansions - [<Event> [e (A.Actor Top) (Space e)] - <Action> (as-is (-> <Event> (A.Actor s) (T.Task Bool)))] - (type: #export (Space e) - (A.Actor (List (Ex [s] [(A.Actor s) <Action>])))) - - (type: #export (Event e) - <Event>) - - (type: #export (Action e) - (All [s] <Action>))) - -(exception: #export Closed-Space) - -(def: (send-space message space) - (All [s] (-> (A.Message s) (A.Actor s) (T.Task Unit))) - (P.future (do Monad<IO> - [success? (A.send message space)] - (wrap (if success? - (ex.return []) - (ex.throw Closed-Space "")))))) - -(def: #export (subscribe actor action space) - (All [e s] (-> (A.Actor s) (Action e s) (Space e) (T.Task Unit))) - (send-space (function [subscriptions _] - (T.return (|> subscriptions - (list.filter (|>> product.left (:! []) (is (:! [] actor)) not)) - (#.Cons [actor action])))) - space)) - -(def: #export (un-subscribe actor space) - (All [e s] (-> (A.Actor s) (Space e) (T.Task Unit))) - (send-space (function [subscriptions _] - (T.return (|> subscriptions - (list.filter (|>> product.left (:! []) (is (:! [] actor)) not))))) - space)) - -(def: #export (emit event space sender) - (All [e s] (-> e (Space e) (A.Actor s) (T.Task Unit))) - (send-space (function [subscriptions _] - (exec (do T.Monad<Task> - [verdicts (monad.map @ - (function [(^@ sub [receiver action])] - (if (is (:! [] receiver) (:! [] sender)) - (T.return [true sub]) - (do @ - [sent? (action [event sender space] receiver)] - (wrap [sent? sub])))) - subscriptions)] - (T.return (L/fold (function [[sent? sub] survivors] - (if sent? - (#.Cons sub survivors) - survivors)) - (list) - verdicts))))) - space)) - -(def: #export space - (All [e] (IO (Space e))) - (A.spawn A.default-behavior (list))) - -(type: ActionS - {#action-name Text - #sender-name Text - #space-name Text - #event Code - #state Code - #receiver-name Text}) - -(def: reference^ - (s.Syntax [Ident (List Code)]) - (p.either (s.form (p.seq s.symbol (p.some s.any))) - (p.seq s.symbol (:: p.Monad<Parser> wrap (list))))) - -(def: action^ - (s.Syntax ActionS) - (s.form ($_ p.seq - s.local-symbol - s.local-symbol - s.local-symbol - s.any - s.any - s.local-symbol))) - -(def: type-vars^ - (s.Syntax (List Text)) - (p.either (s.tuple (p.some s.local-symbol)) - (:: p.Monad<Parser> wrap (list)))) - -(syntax: #export (on: [export csr.export] - [t-vars type-vars^] - [[actor-name actor-params] reference^] - eventT - [declaration action^] - [annotations (p.default cs.empty-annotations csr.annotations)] - body) - {#.doc (doc (type: Move - #Ping - #Pong) - - (actor: #export Player {} - {#hits Nat}) - - (on: #export Move (counter move space hits self) - (do @ - [_ (emit (case move - #.Ping #.Pong - #.Pong #.Ping) - space - self)] - (wrap (n/inc hits)))))} - (with-gensyms [g!_] - (do @ - [actor-name (A.resolve-actor actor-name) - #let [stateT (` ((~ (code.symbol (product.both id A.state-name actor-name))) - (~+ actor-params))) - g!actionL (code.local-symbol (get@ #action-name declaration)) - g!senderL (code.local-symbol (get@ #sender-name declaration)) - g!spaceL (code.local-symbol (get@ #space-name declaration)) - g!receiverL (code.local-symbol (get@ #receiver-name declaration)) - g!event (get@ #event declaration) - g!state (get@ #state declaration)]] - (wrap (list (` (def: (~+ (csw.export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL)) - (~ (csw.annotations annotations)) - (All [(~+ (L/map code.local-symbol t-vars))] - (..Action (~ eventT) (~ stateT))) - (T.from-promise - ((~! P.future) - (A.send (function [(~ g!state) (~ g!receiverL)] - (: (T.Task (~ stateT)) - (monad.do T.Monad<Task> - [] - (~ body)))) - (~ g!receiverL)))) - )))) - ))) diff --git a/stdlib/test/test/lux/concurrency/space.lux b/stdlib/test/test/lux/concurrency/space.lux deleted file mode 100644 index dd295501e..000000000 --- a/stdlib/test/test/lux/concurrency/space.lux +++ /dev/null @@ -1,23 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (concurrency ["T" task] - ["A" actor #+ actor:] - ["S" space #+ on:]) - [io])) - -(type: Move - #Ping - #Pong) - -(A.actor: #export Player {} - {#hits Nat}) - -(on: Player Move (reply! who where what state self) - (do @ - [_ (S.emit (case what - #Ping #Pong - #Pong #Ping) - where - self)] - (wrap (update@ #hits n/inc state)))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 9a0fedbb8..899582b54 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -10,7 +10,6 @@ ["_." duration] ["_." date]) (concurrency ["_." actor] - ["_." space] ["_." atom] ["_." frp] ["_." promise] @@ -75,7 +74,6 @@ )) (lux (control [contract] [concatenative]) - (concurrency [space]) (data [env] [trace] [store] |