blob: 13ac32bf5b224251c7171f99a246e4e2f66735cf (
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
98
99
100
101
102
103
|
(.using
[library
[lux (.except)
["@" target]
[abstract
[functor (.only Functor)]
[apply (.only Apply)]
[monad (.only Monad do)]]
[control
["[0]" io (.only IO)]]
[data
[collection
["[0]" array
["[1]" \\unsafe (.only Array)]]]]
[type
[primitive (.except)]
["[0]" variance (.only Mutable)]]]])
(type: .public (Thread ! a)
(-> ! a))
(primitive: .public (Box'' t a)
(Array a)
(type: .public (Box' t r w)
(Box'' t (Mutable r w)))
(type: .public (Box t a)
(Box'' t (Mutable a a)))
(def: .public (box init)
(All (_ a) (-> a (All (_ !) (Thread ! (Box ! a)))))
(function (_ !)
(|> (array.empty 1)
(array.has! 0 (variance.write init))
abstraction)))
(def: .public (read! box)
(All (_ ! r w) (-> (Box' ! r w) (Thread ! r)))
(function (_ !)
(|> box
representation
(array.item 0)
variance.read)))
(def: .public (write! value box)
(All (_ r w) (-> w (All (_ !) (-> (Box' ! r w) (Thread ! Any)))))
(function (_ !)
(|> box
representation
(array.has! 0 (variance.write value))
abstraction)))
)
(def: .public (result thread)
(All (_ a)
(-> (All (_ !) (Thread ! a))
a))
(thread []))
(def: .public io
(All (_ a)
(-> (All (_ !) (Thread ! a))
(IO a)))
(|>> ..result io.io))
(implementation: .public functor
(All (_ !) (Functor (Thread !)))
(def: (each f)
(function (_ fa)
(function (_ !)
(f (fa !))))))
(implementation: .public apply
(All (_ !) (Apply (Thread !)))
(def: functor ..functor)
(def: (on fa ff)
(function (_ !)
((ff !) (fa !)))))
(implementation: .public monad
(All (_ !) (Monad (Thread !)))
(def: functor ..functor)
(def: (in value)
(function (_ !)
value))
(def: (conjoint ffa)
(function (_ !)
((ffa !) !))))
(def: .public (update! f box)
(All (_ ! r w) (-> (-> r w) (Box' ! r w) (Thread ! [r w])))
(do ..monad
[old (read! box)
.let [new (f old)]
_ (write! new box)]
(in [old new])))
|