aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/thread.lux
blob: 99a4050246ffa07e6df6420d394fdd7937715ca9 (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 "*"
   ["@" 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 "*"]
    ["[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])))