2018-11-12 21:39:12 +03:00
|
|
|
|
2019-03-18 20:42:53 +03:00
|
|
|
use Universal == <
|
2019-03-18 03:05:44 +03:00
|
|
|
|
2021-08-24 21:33:27 +03:00
|
|
|
structural type Future a = Future ('{Remote} a)
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
-- A simple distributed computation ability
|
2021-08-24 21:33:27 +03:00
|
|
|
structural ability Remote where
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
-- 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
|
|
|
|
|
2021-08-24 21:33:27 +03:00
|
|
|
structural type Node = Node Nat -- more realistic would be perhaps a (Hostname, PublicKey) pair
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
force : Future a ->{Remote} a
|
2020-02-22 02:48:12 +03:00
|
|
|
force = cases Future.Future r -> !r
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
-- 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
|
2020-02-22 02:48:12 +03:00
|
|
|
step nid = cases
|
2018-11-12 21:39:12 +03:00
|
|
|
{a} -> a
|
2020-01-18 11:49:15 +03:00
|
|
|
{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)
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
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
|
2019-06-27 16:36:57 +03:00
|
|
|
use List ++
|
2018-11-12 21:39:12 +03:00
|
|
|
|
2019-06-27 16:36:57 +03:00
|
|
|
List.map : (a ->{e} b) -> [a] ->{e} [b]
|
|
|
|
List.map f as =
|
2020-02-07 05:29:43 +03:00
|
|
|
go f acc as i = match List.at i as with
|
2018-11-12 21:39:12 +03:00
|
|
|
None -> acc
|
2021-12-16 02:00:56 +03:00
|
|
|
Some a -> go f (snoc acc (f a)) as (i + 1)
|
2018-11-12 21:39:12 +03:00
|
|
|
go f [] as 0
|
|
|
|
|
|
|
|
merge : (a -> a -> Boolean) -> [a] -> [a] -> [a]
|
|
|
|
merge lte a b =
|
2020-10-21 01:26:46 +03:00
|
|
|
use List at
|
2020-02-07 05:29:43 +03:00
|
|
|
go acc a b = match at 0 a with
|
2018-11-12 21:39:12 +03:00
|
|
|
None -> acc ++ b
|
2020-02-07 05:29:43 +03:00
|
|
|
Some hd1 -> match at 0 b with
|
2018-11-12 21:39:12 +03:00
|
|
|
None -> acc ++ a
|
|
|
|
Some hd2 ->
|
2021-12-16 02:00:56 +03:00
|
|
|
if lte hd1 hd2 then go (snoc acc hd1) (drop 1 a) b
|
|
|
|
else go (snoc acc hd2) a (drop 1 b)
|
2018-11-12 21:39:12 +03:00
|
|
|
go [] a b
|
|
|
|
|
|
|
|
dsort2 : (a -> a -> Boolean) -> [a] ->{Remote} [a]
|
2019-03-08 20:56:02 +03:00
|
|
|
dsort2 lte as =
|
|
|
|
if size as < 2 then as
|
2020-02-07 05:29:43 +03:00
|
|
|
else match halve as with
|
2019-03-08 20:56:02 +03:00
|
|
|
None -> as
|
|
|
|
Some (left, right) ->
|
|
|
|
use Remote forkAt spawn
|
|
|
|
l = forkAt spawn '(dsort2 lte left)
|
|
|
|
r = forkAt spawn '(dsort2 lte right)
|
|
|
|
merge lte (force l) (force r)
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
isEmpty : [a] -> Boolean
|
|
|
|
isEmpty a = size a == 0
|
|
|
|
|
|
|
|
halve : [a] -> Optional ([a], [a])
|
|
|
|
halve as =
|
|
|
|
if isEmpty as then None
|
|
|
|
else Some (take (size as / 2) as, drop (size as / 2) as)
|
|
|
|
|
|
|
|
Node.increment : Node -> Node
|
|
|
|
Node.increment n =
|
2019-07-03 03:18:11 +03:00
|
|
|
use Node Node -- the constructor
|
2020-02-07 05:29:43 +03:00
|
|
|
match n with Node n -> Node (n + 1)
|
2018-11-12 21:39:12 +03:00
|
|
|
|
|
|
|
> Remote.runLocal '(dsort2 (<) [3,2,1,1,2,3,9182,1,2,34,1,23])
|