diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/control/thread.lux | 78 | ||||
-rw-r--r-- | stdlib/test/test/lux/control/thread.lux | 20 | ||||
-rw-r--r-- | stdlib/test/tests.lux | 3 |
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] |