aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-12-31 23:51:33 -0400
committerEduardo Julian2017-12-31 23:51:33 -0400
commit232f9e7a167cec04216bdaa2071ecdb20a1fd03c (patch)
treee35ab67eba0c3669f00709355c4cb1bda56791a2 /stdlib
parent8f071917892ac919b91da12c2bf02d5d9b79f81a (diff)
- Added safe (single-threaded) mutation.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/thread.lux78
-rw-r--r--stdlib/test/test/lux/control/thread.lux20
-rw-r--r--stdlib/test/tests.lux3
3 files changed, 100 insertions, 1 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)))
diff --git a/stdlib/test/test/lux/control/thread.lux b/stdlib/test/test/lux/control/thread.lux
new file mode 100644
index 000000000..3dd27d0ad
--- /dev/null
+++ b/stdlib/test/test/lux/control/thread.lux
@@ -0,0 +1,20 @@
+(.module:
+ lux
+ (lux (control [monad #+ do]
+ ["/" thread])))
+
+(def: _test0_
+ Nat
+ (/.run (do /.Monad<Thread>
+ [box (/.box +123)
+ old (/.update (n/* +2) box)
+ new (/.read box)]
+ (wrap (n/+ old new)))))
+
+(def: _test1_
+ (All [!] (/.Thread ! Nat))
+ (do /.Monad<Thread>
+ [box (/.box +123)
+ old (/.update (n/* +2) box)
+ new (/.read box)]
+ (wrap (n/+ old new))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index ecce3d56b..87f9c913d 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -21,7 +21,8 @@
["_." reader]
["_." writer]
["_." state]
- ["_." parser])
+ ["_." parser]
+ ["_." thread])
(data ["_." bit]
["_." bool]
["_." error]