mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-17 13:27:30 +03:00
126 lines
3.5 KiB
Plaintext
126 lines
3.5 KiB
Plaintext
|
|
use Universal == <
|
|
|
|
structural type Future a = Future ('{Remote} a)
|
|
|
|
-- A simple distributed computation ability
|
|
structural ability Remote where
|
|
|
|
-- Spawn a new node
|
|
spawn : {Remote} Node
|
|
|
|
-- Sequentially evaluate the given thunk on another node
|
|
-- then return to the current node when it completes
|
|
at : n -> '{Remote} a -> {Remote} a
|
|
|
|
-- Start a computation running, returning an `r` that can be forced to
|
|
-- await the result of the computation
|
|
fork : '{Remote} a ->{Remote} Future a
|
|
|
|
structural type Node = Node Nat -- more realistic would be perhaps a (Hostname, PublicKey) pair
|
|
|
|
force : Future a ->{Remote} a
|
|
force = cases Future.Future r -> !r
|
|
|
|
-- Let's test out this beast! do we need to deploy our code to some EC2 instances??
|
|
-- Gak, no not yet, we just want to test locally, let's write a handler
|
|
-- for the `Remote` ability that simulates everything locally!
|
|
|
|
Remote.runLocal : '{Remote} a -> a
|
|
Remote.runLocal r =
|
|
use Future Future
|
|
step nid = cases
|
|
{a} -> a
|
|
{Remote.fork t -> k} -> handle k (Future t) with step nid
|
|
{Remote.spawn -> k} -> handle k nid with step (Node.increment nid)
|
|
{Remote.at _ t -> k} -> handle k !t with step nid
|
|
handle !r with step (Node.Node 0)
|
|
|
|
Remote.forkAt : Node -> '{Remote} a ->{Remote} (Future a)
|
|
Remote.forkAt node r = Remote.fork '(Remote.at node r)
|
|
|
|
use Optional None Some
|
|
use Monoid Monoid
|
|
use List ++
|
|
|
|
List.map : (a ->{e} b) -> [a] ->{e} [b]
|
|
List.map f as =
|
|
go f acc as i = match List.at i as with
|
|
None -> acc
|
|
Some a -> go f (snoc acc (f a)) as (i + 1)
|
|
go f [] as 0
|
|
|
|
structural type Monoid a = Monoid (a -> a -> a) a
|
|
|
|
Monoid.zero = cases Monoid.Monoid op z -> z
|
|
Monoid.op = cases Monoid.Monoid op z -> op
|
|
|
|
Monoid.orElse m = cases
|
|
None -> Monoid.zero m
|
|
Some a -> a
|
|
|
|
merge : (a -> a -> Boolean) -> [a] -> [a] -> [a]
|
|
merge lte a b =
|
|
use List at
|
|
go acc a b = match at 0 a with
|
|
None -> acc ++ b
|
|
Some hd1 -> match at 0 b with
|
|
None -> acc ++ a
|
|
Some hd2 ->
|
|
if lte hd1 hd2 then go (snoc acc hd1) (drop 1 a) b
|
|
else go (snoc acc hd2) a (drop 1 b)
|
|
go [] a b
|
|
|
|
dmap : (a ->{Remote} b) -> [a] ->{Remote} [b]
|
|
dmap f as =
|
|
bs = List.map (a -> Remote.forkAt Remote.spawn '(f a)) as
|
|
List.map force bs
|
|
|
|
dreduce : Monoid a -> [a] ->{Remote} a
|
|
dreduce m a =
|
|
if size a < 2 then Monoid.orElse m (List.at 0 a)
|
|
else
|
|
l = Remote.forkAt Remote.spawn '(dreduce m (take (size a / 2) a))
|
|
r = Remote.forkAt Remote.spawn '(dreduce m (drop (size a / 2) a))
|
|
Monoid.op m (force l) (force r)
|
|
|
|
dmapReduce : (a ->{Remote} b) -> Monoid b -> [a] ->{Remote} b
|
|
dmapReduce f m as = dreduce m (List.map f as)
|
|
|
|
dsort : (a -> a -> Boolean) -> [a] ->{Remote} [a]
|
|
dsort lte a =
|
|
dmapReduce (a -> [a]) (Monoid (merge lte) []) a
|
|
|
|
sort : (a -> a -> Boolean) -> [a] -> [a]
|
|
sort lte a =
|
|
if List.size a < 2 then a
|
|
else
|
|
l = sort lte (take (size a / 2) a)
|
|
r = sort lte (drop (size a / 2) a)
|
|
merge lte l r
|
|
|
|
Node.increment : Node -> Node
|
|
Node.increment n =
|
|
use Node Node -- the constructor
|
|
match n with Node n -> Node (n + 1)
|
|
|
|
> Remote.runLocal '(dsort (<) [3,2,1,1,2,3,9182,1,2,34,1,23])
|
|
|
|
halve : [a] -> Optional ([a], [a])
|
|
halve a =
|
|
if size a == 0 then None
|
|
else Some (take (size a / 2) a, drop (size a / 2) a)
|
|
|
|
foldMap : (a -> b) -> Monoid b -> [a] -> b
|
|
foldMap f m a =
|
|
base a = match List.at 0 a with
|
|
None -> zero m
|
|
Some a -> f a
|
|
if size a < 2 then base a
|
|
else match halve a with
|
|
None -> zero m
|
|
Some (l, r) -> op m (foldMap f m l) (foldMap f m r)
|
|
|
|
> foldMap (x -> x) (Monoid (+) 0) [1]
|
|
> Remote.runLocal '(dmap (x -> x + 1) [1,2,3,4])
|