aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/thread.lux
blob: c0a8c59553afd1231b14b337446f98d07b1ba50d (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
104
105
106
107
108
109
110
111
112
113
(.module:
  [library
   [lux #*
    ["@" target]
    [abstract
     [functor (#+ Functor)]
     [apply (#+ Apply)]
     [monad (#+ Monad do)]]
    [control
     ["." io (#+ IO)]]
    [data
     [collection
      ["." array (#+ Array)]]]
    [type
     abstract]]])

(type: .public (Thread ! a)
  {#.doc (example "An imperative process with access to mutable values.")}
  (-> ! a))

(abstract: .public (Box t v)
  {#.doc "A mutable box holding a value."}

  (Array v)

  (def: .public (box init)
    {#.doc (example "A brand-new box initialized to the given value.")}
    (All [a] (-> a (All [!] (Thread ! (Box ! a)))))
    (function (_ !)
      (|> (array.empty 1)
          (array.write! 0 init)
          :abstraction)))

  (def: .public (read box)
    {#.doc (example "Reads the current value in the box.")}
    (All [! a] (-> (Box ! a) (Thread ! a)))
    (function (_ !)
      (for {@.old
            ("jvm aaload" (:representation box) 0)

            @.jvm
            ("jvm array read object"
             (|> 0
                 (:as (primitive "java.lang.Long"))
                 "jvm object cast"
                 "jvm conversion long-to-int")
             (:representation box))

            @.js ("js array read" 0 (:representation box))
            @.python ("python array read" 0 (:representation box))
            @.lua ("lua array read" 0 (:representation box))
            @.ruby ("ruby array read" 0 (:representation box))
            @.php ("php array read" 0 (:representation box))
            @.scheme ("scheme array read" 0 (:representation box))})))

  (def: .public (write value box)
    {#.doc (example "Mutates the value in the box.")}
    (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
    (function (_ !)
      (|> box :representation (array.write! 0 value) :abstraction)))
  )

(def: .public (result thread)
  {#.doc (example "Executes the imperative thread in a self-contained way.")}
  (All [a]
    (-> (All [!] (Thread ! a))
        a))
  (thread []))

(def: .public io
  {#.doc (example "Transforms the imperative thread into an I/O computation.")}
  (All [a]
    (-> (All [!] (Thread ! a))
        (IO a)))
  (|>> ..result io.io))

(implementation: .public functor
  (All [!] (Functor (Thread !)))

  (def: (map f)
    (function (_ fa)
      (function (_ !)
        (f (fa !))))))

(implementation: .public apply
  (All [!] (Apply (Thread !)))

  (def: &functor ..functor)

  (def: (apply ff fa)
    (function (_ !)
      ((ff !) (fa !)))))

(implementation: .public monad
  (All [!] (Monad (Thread !)))

  (def: &functor ..functor)

  (def: (in value)
    (function (_ !)
      value))

  (def: (join ffa)
    (function (_ !)
      ((ffa !) !))))

(def: .public (update f box)
  {#.doc (example "Update a box's value by applying a function to it.")}
  (All [a !] (-> (-> a a) (Box ! a) (Thread ! a)))
  (do ..monad
    [old (read box)
     _ (write (f old) box)]
    (in old)))