- Added safe (single-threaded) mutation.

1 files changed, 78 insertions, 0 deletions

diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux
new file mode 100644
index 000000000..daee09900
--- /dev/null
+++ b/stdlib/source/lux/control/thread.lux
@@ -0,0 +1,78 @@
+(.module:
+  lux
+  (lux (control [functor #+ Functor]
+                [applicative #+ Applicative]
+                [monad #+ Monad do])
+       [io #+ IO]))
+
+(type: #export (Thread ! a)
+  (-> ! a))
+
+(type: #export (Box t v)
+  {#.doc "A mutable box holding a value."}
+  (#.Primitive "#Box" (~ (list t v))))
+
+(def: #export (box init)
+  (All [a] (-> a (All [!] (Thread ! (Box ! a)))))
+  (function [!]
+    ("lux box new" init)))
+
+(def: #export (read box)
+  (All [! a] (-> (Box ! a) (Thread ! a)))
+  (function [!]
+    ("lux box read" box)))
+
+(def: #export (write value box)
+  (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Unit)))))
+  (function [!]
+    ("lux box write" value box)))
+
+(def: #export (run thread)
+  (All [a]
+    (-> (All [!] (Thread ! a))
+        a))
+  (thread []))
+
+(struct: #export Functor<Thread>
+  (All [!] (Functor (Thread !)))
+
+  (def: (map f)
+    (function [fa]
+      (function [!]
+        (f (fa !))))))
+
+(struct: #export Applicative<Thread>
+  (All [!] (Applicative (Thread !)))
+
+  (def: functor Functor<Thread>)
+
+  (def: (wrap value)
+    (function [!]
+      value))
+  
+  (def: (apply ff fa)
+    (function [!]
+      ((ff !) (fa !)))))
+
+(struct: #export Monad<Thread>
+  (All [!] (Monad (Thread !)))
+
+  (def: applicative Applicative<Thread>)
+
+  (def: (join ffa)
+    (function [!]
+      ((ffa !) !))))
+
+(def: #export (update f box)
+  (All [a] (-> (-> a a) (All [!] (-> (Box ! a) (Thread ! a)))))
+  (do Monad<Thread>
+    [old (read box)
+     _ (write (f old) box)]
+    (wrap old)))
+
+(def: #export (io thread)
+  (All [a]
+    (-> (All [!] (Thread ! a))
+        (IO a)))
+  (function [void]
+    (thread void)))