aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/concurrency/stm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/concurrency/stm.lux')
-rw-r--r--stdlib/source/lux/concurrency/stm.lux43
1 files changed, 9 insertions, 34 deletions
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux
index 9b1cabe01..cc609a055 100644
--- a/stdlib/source/lux/concurrency/stm.lux
+++ b/stdlib/source/lux/concurrency/stm.lux
@@ -6,10 +6,7 @@
[io #+ IO io]
(data [product]
[maybe]
- [number "nat/" Codec<Text,Nat>]
- [text]
- (coll [list "list/" Functor<List> Fold<List>]
- [dict #+ Dict]))
+ (coll [list "list/" Functor<List> Fold<List>]))
(concurrency [atom #+ Atom atom]
[promise #+ Promise promise]
[frp "frp/" Functor<Channel>])
@@ -17,12 +14,12 @@
(abstract: #export (Var a)
{#.doc "A mutable cell containing a value, and observers that will be alerted of any change to it."}
- (Atom [a (Dict Text (-> a (IO Unit)))])
+ (Atom [a (List (-> a (IO Unit)))])
(def: #export (var value)
{#.doc "Creates a new STM var, with a default value."}
(All [a] (-> a (Var a)))
- (@abstraction (atom.atom [value (dict.new text.Hash<Text>)])))
+ (@abstraction (atom.atom [value (list)])))
(def: read!!
(All [a] (-> (Var a) a))
@@ -42,43 +39,21 @@
succeeded? (atom.compare-and-swap old [new-value _observers] var)]
(if succeeded?
(do @
- [_ (|> _observers
- dict.values
- (monad.map @ (function [f] (f new-value))))]
+ [_ (monad.map @ (function [f] (f new-value)) _observers)]
(wrap []))
(write! new-value (@abstraction var)))))
(def: #export (follow (^@representation target))
{#.doc "Creates a channel that will receive all changes to the value of the given var."}
(All [a] (-> (Var a) (IO (frp.Channel a))))
- (let [head (: (frp.Channel ($ +0)) (frp.channel))
- ## head (frp.channel)
- channel-var (var head)
- observer (function [label value]
- (case (io.run (|> channel-var read!! (frp.write value)))
- #.None
- ## By closing the output Channel, the
- ## observer becomes obsolete.
- (atom.update (function [[value observers]]
- [value (dict.remove label observers)])
- target)
-
- (#.Some tail')
- (write! tail' channel-var)))]
+ (let [channel (: (frp.Channel ($ +0)) (frp.channel []))
+ ## channel (frp.channel)
+ ]
(do io.Monad<IO>
[_ (atom.update (function [[value observers]]
- (let [label (nat/encode (list/fold (function [key base]
- (case (nat/decode key)
- (#.Left _)
- base
-
- (#.Right key-num)
- (n/max key-num base)))
- +0
- (dict.keys observers)))]
- [value (dict.put label (observer label) observers)]))
+ [value (#.Cons (frp.publish channel) observers)])
target)]
- (wrap head))))
+ (wrap channel))))
)
(type: (Tx-Frame a)