blob: a8fd975b221786b54f9eeb1bb9bfb64510c5ba5f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
(.module:
[lux #*
[control
[monad (#+ do)]]
["." function]
["." io (#- run)]
[type
abstract]
[tool
[compiler
["." host]]]
[host (#+ import:)]])
(`` (for {(~~ (static host.jvm))
(import: (java/util/concurrent/atomic/AtomicReference a)
(new [a])
(get [] a)
(compareAndSet [a a] boolean))}))
(`` (abstract: #export (Atom a)
{#.doc "Atomic references that are safe to mutate concurrently."}
(for {(~~ (static host.jvm))
(AtomicReference a)})
(def: #export (atom value)
(All [a] (-> a (Atom a)))
(:abstraction (for {(~~ (static host.jvm))
(AtomicReference::new value)})))
(def: #export (read atom)
(All [a] (-> (Atom a) (IO a)))
(io (for {(~~ (static host.jvm))
(AtomicReference::get (:representation atom))})))
(def: #export (compare-and-swap current new atom)
{#.doc (doc "Only mutates an atom if you can present it's current value."
"That guarantees that atom was not updated since you last read from it.")}
(All [a] (-> a a (Atom a) (IO Bit)))
(io (AtomicReference::compareAndSet current new (:representation atom))))
))
(def: #export (update f atom)
{#.doc (doc "Updates an atom by applying a function to its current value."
"If it fails to update it (because some other process wrote to it first), it will retry until it succeeds."
"The retries will be done with the new values of the atom, as they show up.")}
(All [a] (-> (-> a a) (Atom a) (IO a)))
(loop [_ []]
(do io.monad
[old (read atom)
#let [new (f old)]
swapped? (compare-and-swap old new atom)]
(if swapped?
(wrap new)
(recur [])))))
(def: #export (write value atom)
(All [a] (-> a (Atom a) (IO Any)))
(update (function.constant value) atom))
|
