blob: c865b8e33fe6d8978e642e7158e9d36cdc8521e7 (
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(.using
[library
[lux "*"
["@" target]
["[0]" ffi]
[abstract
[monad {"+" do}]]
[control
["[0]" function]
["[0]" io {"+" IO} ("[1]#[0]" functor)]]
[data
["[0]" product]
[collection
["[0]" array]]]
[type
abstract]]])
(with_expansions [<jvm> (as_is (ffi.import: (java/util/concurrent/atomic/AtomicReference a)
["[1]::[0]"
(new [a])
(get [] a)
(compareAndSet [a a] boolean)]))]
(for [@.old <jvm>
@.jvm <jvm>]
(as_is)))
(with_expansions [<new> (for [@.js "js array new"
@.python "python array new"
@.lua "lua array new"
@.ruby "ruby array new"
@.php "php array new"
@.scheme "scheme array new"]
(as_is))
<write> (for [@.js "js array write"
@.python "python array write"
@.lua "lua array write"
@.ruby "ruby array write"
@.php "php array write"
@.scheme "scheme array write"]
(as_is))
<read> (for [@.js "js array read"
@.python "python array read"
@.lua "lua array read"
@.ruby "ruby array read"
@.php "php array read"
@.scheme "scheme array read"]
(as_is))]
(abstract: .public (Atom a)
(with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)]
(for [@.old <jvm>
@.jvm <jvm>]
(array.Array a)))
(def: .public (atom value)
(All (_ a) (-> a (Atom a)))
(:abstraction (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::new value)]
(for [@.old <jvm>
@.jvm <jvm>]
(<write> 0 value (<new> 1))))))
(def: .public (read! atom)
(All (_ a) (-> (Atom a) (IO a)))
(io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))]
(for [@.old <jvm>
@.jvm <jvm>]
(<read> 0 (:representation atom))))))
(def: .public (compare_and_swap! current new atom)
(All (_ a) (-> a a (Atom a) (IO Bit)))
(io.io (with_expansions [<jvm> (ffi.of_boolean (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)))]
(for [@.old <jvm>
@.jvm <jvm>]
(let [old (<read> 0 (:representation atom))]
(if (same? old current)
(exec
(<write> 0 new (:representation atom))
true)
false))))))
))
(def: .public (update! f atom)
(All (_ a) (-> (-> a a) (Atom a) (IO [a a])))
(loop [_ []]
(do io.monad
[old (read! atom)
.let [new (f old)]
swapped? (compare_and_swap! old new atom)]
(if swapped?
(in [old new])
(again [])))))
(def: .public (write! value atom)
(All (_ a) (-> a (Atom a) (IO a)))
(|> atom
(..update! (function.constant value))
(io#each product.left)))
|
