unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-11 02:25:39 +03:00
Code Issues Projects Releases Wiki Activity

lots of std lib improvements / fixes to support DIndex

Browse Source
This commit is contained in:
Paul Chiusano 2016-08-24 17:16:26 -04:00
parent 1331400b1d
commit a886c063b8
10 changed files with 296 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
node/src/Unison/Runtime/ExtraBuiltins.hs
View File

@ -13,6 +13,7 @@ import Unison.Type (Type)
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified Unison.Cryptography as C
import qualified Unison.Hash as Hash
import qualified Unison.Eval.Interpreter as I
import qualified Unison.Note as Note
import qualified Unison.Reference as R
@ -82,6 +83,21 @@ makeAPI blockStore crypto = do
op _ = fail "Index.keys# unpossible"
type' = unsafeParseType "forall k . Text -> Vector k"
in (r, Just (I.Primop 1 op), type', prefix "Index.keys#")
, let r = R.Builtin "Index.1st-key#"
op [indexToken] = do
Term.Text' h <- whnf indexToken
Note.lift $ do
(db, cleanup) <- RP.acquire resourcePool . Index.textToId $ h
flip finally cleanup $ do
keyBytes <- atomically $ Index.keys db
case keyBytes of
[] -> pure none
(keyBytes:_) -> case SAH.deserializeTermFromBytes keyBytes of
Left err -> fail ("Index.1st-key# could not deserialize: " ++ err)
Right terms -> pure $ some terms
op _ = fail "Index.1st-key# unpossible"
type' = unsafeParseType "forall k . Text -> Optional k"
in (r, Just (I.Primop 1 op), type', prefix "Index.1st-key#")
, let r = R.Builtin "Index.increment#"
op [key, indexToken] = do
key <- whnf key
@ -125,6 +141,17 @@ makeAPI blockStore crypto = do
op _ = fail "Index.lookup# unpossible"
type' = unsafeParseType "forall k v . k -> Text -> Optional v"
in (r, Just (I.Primop 2 op), type', prefix "Index.lookup#")
, let r = R.Builtin "Index.delete#"
op [key, indexToken] = do
Term.Text' indexToken <- whnf indexToken
key <- whnf key
(db, cleanup) <- Note.lift . RP.acquire resourcePool . Index.textToId $ indexToken
Note.lift . flip finally cleanup $ do
_ <- atomically $ Index.delete (SAH.hash' key) db
pure unitRef
op _ = fail "Index.delete# unpossible"
type' = unsafeParseType "forall k . k -> Text -> Unit"
in (r, Just (I.Primop 2 op), type', prefix "Index.delete#")
, let r = R.Builtin "Index.insert#"
op [k, v, index] = inject g k v index where
inject g k v index = do
@ -190,47 +217,55 @@ makeAPI blockStore crypto = do
, let r = R.Builtin "hash#"
op [e] = do
e <- whnf e
pure $ Term.builtin "Hash" `Term.app` (Term.ref $ SAH.hash e)
let h = Hash.base64 . Hash.fromBytes . SAH.hash' $ e
pure $ Term.builtin "Hash" `Term.app` (Term.text h)
op _ = fail "hash"
t = "forall a . a -> Hash a"
in (r, Just (I.Primop 1 op), unsafeParseType t, prefix "hash#")
, let r = R.Builtin "Hash.base64"
op [e] = do
Term.App' _ (Term.Text' r1) <- whnf e
pure (Term.text r1)
op _ = fail "Hash.base64"
t = "forall a . Hash a -> Text"
in (r, Just (I.Primop 1 op), unsafeParseType t, prefix "Hash.base64")
, let r = R.Builtin "Hash.erase"
op [e] = pure e
op _ = fail "hash"
op _ = fail "Hash.erase"
t = "forall a . Hash a -> Hash Unit"
in (r, Just (I.Primop 1 op), unsafeParseType t, prefix "Hash.erase")
, let r = R.Builtin "Hash.equal"
op [h1,h2] = do
Term.App' _ (Term.Ref' r1) <- whnf h1
Term.App' _ (Term.Ref' r2) <- whnf h2
Term.App' _ (Term.Text' r1) <- whnf h1
Term.App' _ (Term.Text' r2) <- whnf h2
pure $ if r1 == r2 then true else false
op _ = fail "Hash.equal"
in (r, Just (I.Primop 2 op), hashCompareTyp, prefix "Hash.equal")
, let r = R.Builtin "Hash.lessThan"
op [h1,h2] = do
Term.App' _ (Term.Ref' r1) <- whnf h1
Term.App' _ (Term.Ref' r2) <- whnf h2
Term.App' _ (Term.Text' r1) <- whnf h1
Term.App' _ (Term.Text' r2) <- whnf h2
pure $ if r1 < r2 then true else false
op _ = fail "Hash.lessThan"
in (r, Just (I.Primop 2 op), hashCompareTyp, prefix "Hash.lessThan")
, let r = R.Builtin "Hash.lessThanOrEqual"
op [h1,h2] = do
Term.App' _ (Term.Ref' r1) <- whnf h1
Term.App' _ (Term.Ref' r2) <- whnf h2
Term.App' _ (Term.Text' r1) <- whnf h1
Term.App' _ (Term.Text' r2) <- whnf h2
pure $ if r1 <= r2 then true else false
op _ = fail "Hash.lessThanOrEqual"
in (r, Just (I.Primop 2 op), hashCompareTyp, prefix "Hash.lessThanOrEqual")
, let r = R.Builtin "Hash.greaterThan"
op [h1,h2] = do
Term.App' _ (Term.Ref' r1) <- whnf h1
Term.App' _ (Term.Ref' r2) <- whnf h2
Term.App' _ (Term.Text' r1) <- whnf h1
Term.App' _ (Term.Text' r2) <- whnf h2
pure $ if r1 > r2 then true else false
op _ = fail "Hash.greaterThan"
in (r, Just (I.Primop 2 op), hashCompareTyp, prefix "Hash.greaterThan")
, let r = R.Builtin "Hash.greaterThanOrEqual"
op [h1,h2] = do
Term.App' _ (Term.Ref' r1) <- whnf h1
Term.App' _ (Term.Ref' r2) <- whnf h2
Term.App' _ (Term.Text' r1) <- whnf h1
Term.App' _ (Term.Text' r2) <- whnf h2
pure $ if r1 >= r2 then true else false
op _ = fail "Hash.greaterThanOrEqual"
in (r, Just (I.Primop 2 op), hashCompareTyp, prefix "Hash.greaterThanOrEqual")

2
node/src/Unison/Runtime/Remote.hs
View File

@ -120,7 +120,7 @@ server crypto allow env lang p = do
-- guard $ Put.runPutS (serialize peerKey) == publicKey peer
Mux.scope "Remote.server" . Mux.repeatWhile $ do
r <- recv
Mux.info $ "eval " ++ show r
Mux.debug $ "eval " ++ show r
case r of
Nothing -> pure False
Just (r, ackChan) -> do

1
node/src/Worker.hs
View File

@ -41,6 +41,7 @@ main = do
backend <- BasicNode.make SAH.hash store (\whnf -> b0 whnf ++ b1 whnf)
loadDeclarations "unison-src/base.u" backend
loadDeclarations "unison-src/extra.u" backend
loadDeclarations "unison-src/dindex.u" backend
initialized <- STM.atomically $ newTVar False
pure $ go backend initialized
where

49
shared/src/Unison/Node/Builtin.hs
View File

@ -9,6 +9,7 @@ import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Typechecker.Context (remoteSignatureOf)
import Control.Concurrent (threadDelay)
import qualified Data.Vector as Vector
import qualified Data.Text as Text
import qualified Unison.ABT as ABT
@ -89,6 +90,33 @@ makeBuiltins whnf =
in (r, Nothing, Type.builtin "Boolean", prefix "True")
, let r = R.Builtin "False";
in (r, Nothing, Type.builtin "Boolean", prefix "False")
, let r = R.Builtin "Boolean.and";
op [b1,b2] = do
Term.Builtin' b1 <- whnf b1
Term.Builtin' b2 <- whnf b2
pure $ case (b1,b2) of
_ | Text.head b1 /= Text.head b2 -> false
| otherwise -> if Text.head b1 == 'T' then true else false
op _ = error "unpossible"
typ = "Boolean -> Boolean -> Boolean"
in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "and")
, let r = R.Builtin "Boolean.or";
op [b1,b2] = do
Term.Builtin' b1 <- whnf b1
Term.Builtin' b2 <- whnf b2
pure $ case (b1,b2) of
_ | Text.head b1 /= Text.head b2 -> true
| otherwise -> if Text.head b1 == 'F' then false else true
op _ = error "unpossible"
typ = "Boolean -> Boolean -> Boolean"
in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "or")
, let r = R.Builtin "Boolean.not";
op [b1] = do
Term.Builtin' b1 <- whnf b1
pure $ if Text.head b1 == 'T' then false else true
op _ = error "unpossible"
typ = "Boolean -> Boolean"
in (r, Just (I.Primop 1 op), unsafeParseType typ, prefix "not")
, let r = R.Builtin "Boolean.if";
op [cond,t,f] = do
cond <- whnf cond
@ -124,7 +152,22 @@ makeBuiltins whnf =
, let r = R.Builtin "Number.Order"
in (r, Nothing, unsafeParseType "Order Number", prefix "Number.Order")
-- Duration
, let r = R.Builtin "Duration.seconds"
op [n] = do
Term.Number' n <- whnf n
pure $ Term.num n
op _ = fail "Duration.seconds unpossible"
in (r, Just (I.Primop 1 op), unsafeParseType "Number -> Duration", prefix "Duration.seconds")
-- Remote
, let r = R.Builtin "Remote.delay"
op [seconds] = do
Term.Number' seconds <- whnf seconds
N.lift $ threadDelay (floor $ seconds * 1000 * 1000)
pure $ Term.remote (Remote.Step (Remote.Local (Remote.Pure unitRef)))
op _ = fail "Remote.at unpossible"
in (r, Just (I.Primop 1 op), unsafeParseType "Duration -> Remote Unit", prefix "Remote.delay")
, let r = R.Builtin "Remote.at"
op [node,term] = do
Term.Distributed' (Term.Node node) <- whnf node
@ -171,19 +214,19 @@ makeBuiltins whnf =
`Term.app` r
op _ = fail "unpossible"
in (r, Just (I.Primop 2 op), remoteSignatureOf "Remote.map", prefix "map")
, let r = R.Builtin "Remote.receiveAsync"
, let r = R.Builtin "Remote.receive-async"
op [chan, timeout] = do
Term.Number' seconds <- whnf timeout
Term.Distributed' (Term.Channel chan) <- whnf chan
pure $ Term.remote (Remote.Step (Remote.Local (Remote.ReceiveAsync chan (Remote.Seconds seconds))))
op _ = fail "unpossible"
in (r, Just (I.Primop 2 op), remoteSignatureOf "Remote.receiveAsync", prefix "receiveAsync")
in (r, Just (I.Primop 2 op), remoteSignatureOf "Remote.receive-async", prefix "Remote.receive-async")
, let r = R.Builtin "Remote.receive"
op [chan] = do
Term.Distributed' (Term.Channel chan) <- whnf chan
pure $ Term.remote (Remote.Step (Remote.Local (Remote.Receive chan)))
op _ = fail "unpossible"
in (r, Just (I.Primop 1 op), remoteSignatureOf "Remote.receive", prefix "receive")
in (r, Just (I.Primop 1 op), remoteSignatureOf "Remote.receive", prefix "Remote.receive")
, let r = R.Builtin "Remote.fork"
op [r] = do
Term.Distributed' (Term.Remote r) <- whnf r

1
shared/src/Unison/Parsers.hs
View File

@ -129,6 +129,7 @@ typeBuiltins = (Var.named *** Type.lit) <$>
, builtin "Html.Link"
-- distributed
, builtin "Channel"
, builtin "Duration"
, builtin "Future"
, builtin "Remote"
, builtin "Node"

26
shared/src/Unison/Typechecker/Context.hs
View File

@ -594,22 +594,22 @@ remoteSignatureOf k = fromMaybe (error "unknown symbol") (Map.lookup k remoteSig
remoteSignatures :: forall v . Var v => Map.Map Text.Text (Type.Type v)
remoteSignatures = Map.fromList
[ ("Remote.at", Type.forall' ["a"] (Type.builtin "Node" --> v' "a" --> remote' (v' "a")))
, ("Remote.fork", Type.forall' ["a"] (remote' (v' "a") --> remote' unitT))
, ("Remote.here", remote' (Type.builtin "Node"))
, ("Remote.spawn", remote' (Type.builtin "Node"))
, ("Remote.send", Type.forall' ["a"] (channel (v' "a") --> v' "a" --> remote' unitT))
, ("Remote.channel", Type.forall' ["a"] (remote' (channel (v' "a"))))
, ("Remote.map", Type.forall' ["a","b"] ((v' "a" --> v' "b") --> remote' (v' "a") --> remote' (v' "b")))
, ("Remote.bind", Type.forall' ["a","b"] ((v' "a" --> remote' (v' "b")) --> remote' (v' "a") --> remote' (v' "b")))
, ("Remote.pure", Type.forall' ["a"] (v' "a" --> remote' (v' "a")))
, ("Remote.receiveAsync", Type.forall' ["a"] (channel (v' "a") --> timeoutT --> remote' (remote' (v' "a"))))
, ("Remote.receive", Type.forall' ["a"] (channel (v' "a") --> remote' (v' "a"))) ]
[ ("Remote.at", Type.forall' ["a"] (Type.builtin "Node" --> v' "a" --> remote (v' "a")))
, ("Remote.fork", Type.forall' ["a"] (remote (v' "a") --> remote unitT))
, ("Remote.here", remote (Type.builtin "Node"))
, ("Remote.spawn", remote (Type.builtin "Node"))
, ("Remote.send", Type.forall' ["a"] (channel (v' "a") --> v' "a" --> remote unitT))
, ("Remote.channel", Type.forall' ["a"] (remote (channel (v' "a"))))
, ("Remote.map", Type.forall' ["a","b"] ((v' "a" --> v' "b") --> remote (v' "a") --> remote (v' "b")))
, ("Remote.bind", Type.forall' ["a","b"] ((v' "a" --> remote (v' "b")) --> remote (v' "a") --> remote (v' "b")))
, ("Remote.pure", Type.forall' ["a"] (v' "a" --> remote (v' "a")))
, ("Remote.receive-async", Type.forall' ["a"] (channel (v' "a") --> timeoutT --> remote (remote (v' "a"))))
, ("Remote.receive", Type.forall' ["a"] (channel (v' "a") --> remote (v' "a"))) ]
where
v' = Type.v'
timeoutT = Type.builtin "Remote.Timeout"
timeoutT = Type.builtin "Duration"
unitT = Type.builtin "Unit"
remote' t = Type.builtin "Remote" `Type.app` t
remote t = Type.builtin "Remote" `Type.app` t
channel t = Type.builtin "Channel" `Type.app` t
-- | For purposes of typechecking, we translate `[x,y,z]` to the term

14
shared/tests/Unison/Test/Interpreter.hs
View File

@ -23,6 +23,16 @@ tests = withResource Common.node (\_ -> pure ()) $ \node ->
, t "1 < 2" "True"
, t "1 <= 1" "True"
, t "1 >= 1" "True"
, t "True `or` False" "True"
, t "False `or` True" "True"
, t "True `or` True" "True"
, t "False `or` False" "False"
, t "True `and` True" "True"
, t "True `and` False" "False"
, t "False `and` True" "False"
, t "False `and` False" "False"
, t "not False" "True"
, t "not True" "False"
, t "let rec fac n = if (n == 0) 1 (n * fac (n - 1)); fac 5;;" "120"
, t "let rec ping n = if (n >= 10) n (pong (n + 1)); pong n = ping (n + 1); ping 0;;"
"10"
@ -37,6 +47,8 @@ tests = withResource Common.node (\_ -> pure ()) $ \node ->
, t "const 41 0" "41"
, t "1st (1,2,3,4)" "1"
, t "2nd (1,2 + 1,3,4)" "3"
, t "identity <| (1 + 1)" "2"
, t "(1 + 1) |> identity" "2"
, t "if (Text.equal \"hi\" \"hi\") 1 2" "1"
, t "if (Text.lessThan \"hi\" \"hiya\") 1 2" "1"
, t "if (Text.lessThanOrEqual \"hi\" \"hiya\") 1 2" "1"
@ -57,6 +69,8 @@ tests = withResource Common.node (\_ -> pure ()) $ \node ->
, t "Vector.fold-left (+) 0 (Vector.replicate 5 1)" "5"
, t "Vector.sort Number.Order identity [5,2,1,3,4]" "[1,2,3,4,5]"
, t "Vector.bind 2nd (Vector.zip [1,2,3] [[1],[2],[3]])" "[1,2,3]"
, t "Vector.all? identity [True,True,True,True]" "True"
, t "Vector.all? identity [True,False,True,True]" "False"
, t "Optional.getOr 96 (Vector.at 1 [0,1,2,3,4])" "1"
, t "Vector.take 0 [1,2,3]" "[]"
, t "Vector.take 2 [1,2,3]" "[1,2]"

80
unison-src/base.u
View File

@ -6,6 +6,12 @@ const x y = x;
then : ∀ a b c . (a -> b) -> (b -> c) -> a -> c;
then f1 f2 x = f2 (f1 x);
(|>) : ∀ a b . a -> (a -> b) -> b;
a |> f = f a;
(<|) : ∀ a b . (a -> b) -> a -> b;
f <| a = f a;
flip : ∀ a b c . (a -> b -> c) -> b -> a -> c;
flip f b a = f a b;
@ -21,23 +27,14 @@ rest p = Pair.fold (x y -> y) p;
4th = rest `then` (rest `then` (rest `then` first));
5th = rest `then` (rest `then` (rest `then` (rest `then` first)));
Remote.transfer : Node -> Remote Unit;
Remote.transfer node = Remote.at node unit;
Remote.map : ∀ a b . (a -> b) -> Remote a -> Remote b;
Remote.map f = Remote.bind (f `then` Remote.pure);
Vector.replicate : ∀ a . Number -> a -> Vector a;
Vector.replicate n a = Vector.map (const a) (Vector.range 0 n);
Remote.replicate : ∀ a . Number -> Remote a -> Remote (Vector a);
Remote.replicate n r = Remote.sequence (Vector.replicate n r);
Vector.bind : ∀ a b . (a -> Vector b) -> Vector a -> Vector b;
Vector.bind f v = Vector.fold-balanced Vector.concatenate Vector.empty (Vector.map f v);
Vector.pure = Vector.single;
Vector.replicate : ∀ a . Number -> a -> Vector a;
Vector.replicate n a = Vector.map (const a) (Vector.range 0 n);
Vector.fold-right : ∀ a b . (a -> b -> b) -> b -> Vector a -> b;
Vector.fold-right f z vs = Vector.fold-left (flip f) z (Vector.reverse vs);
@ -52,6 +49,38 @@ Vector.fold-balanced plus zero vs =
go plus zero vs;;
;
Vector.all? : ∀ a . (a -> Boolean) -> Vector a -> Boolean;
Vector.all? f vs = Vector.fold-balanced and True (Vector.map f vs);
Remote.transfer : Node -> Remote Unit;
Remote.transfer node = Remote.at node unit;
Remote.map : ∀ a b . (a -> b) -> Remote a -> Remote b;
Remote.map f = Remote.bind (f `then` Remote.pure);
Remote.replicate : ∀ a . Number -> Remote a -> Remote (Vector a);
Remote.replicate n r = Remote.sequence (Vector.replicate n r);
Remote.race : ∀ a . Duration -> Vector (Remote a) -> Remote a;
Remote.race timeout rs = do Remote
here := Remote.here;
c := Remote.channel;
result := Remote.receive-async c timeout;
Remote.traverse
(r -> Remote.fork <| do Remote a := r; Remote.transfer here; Remote.send c a;;)
rs;
result;;
;
-- Returns `None` if no response within the provided `timeout`,
-- which cannot exceed 500 seconds
Remote.timeout : ∀ a . Duration -> Remote a -> Remote (Optional a);
Remote.timeout timeout r =
Remote.race (Duration.seconds 501) [
Remote.map Some r,
do Remote Remote.delay timeout; pure None;;
];
Remote.lift2 : ∀ a b c . (a -> b -> c) -> Remote a -> Remote b -> Remote c;
Remote.lift2 f a b = do Remote
a := a;
@ -59,6 +88,18 @@ Remote.lift2 f a b = do Remote
pure (f a b);;
;
Remote.at' : ∀ a . Node -> Remote a -> Remote a;
Remote.at' node r = do Remote Remote.transfer node; r;;;
Remote.start : ∀ a . Duration -> Remote a -> Remote (Remote a);
Remote.start timeout r = do Remote
here := Remote.here;
c := Remote.channel;
result := Remote.receive-async c timeout;
Remote.fork (Remote.at' here (r |> Remote.bind (Remote.send c)));
pure result;;
;
Remote.traverse : ∀ a b . (a -> Remote b) -> Vector a -> Remote (Vector b);
Remote.traverse f vs =
Vector.fold-balanced (Remote.lift2 Vector.concatenate)
@ -71,6 +112,17 @@ Remote.sequence vs =
(Remote.pure Vector.empty)
(Vector.map (Remote.map Vector.single) vs);
Remote.parallel-traverse : ∀ a b . Duration -> (a -> Remote b) -> Vector a -> Remote (Vector b);
Remote.parallel-traverse timeout f vs = do Remote
futures := Remote.traverse (f `then` Remote.start timeout) vs;
Remote.sequence futures;;
;
-- Run several remote computations in parallel, returning once `n` equivalent
-- replies come back. Equivalence is based on result of `hash!`.
Remote.quorum : ∀ a b . Duration -> Number -> (a -> Remote b) -> Vector a -> Remote b;
Remote.quorum timeout n = _; -- todo
Optional.map : ∀ a b . (a -> b) -> Optional a -> Optional b;
Optional.map f = Optional.fold None (f `then` Some);
@ -83,6 +135,9 @@ Optional.pure = Some;
Optional.getOr : ∀ a . a -> Optional a -> a;
Optional.getOr a = Optional.fold a identity;
Optional.somes : ∀ a . Vector (Optional a) -> Vector a;
Optional.somes = Vector.bind (Optional.fold Vector.empty Vector.single);
Either.map : ∀ a b c . (b -> c) -> Either a b -> Either a c;
Either.map f = Either.fold Left (f `then` Right);
@ -94,4 +149,3 @@ Either.bind = Either.fold Left;
Either.swap : ∀ a b . Either a b -> Either b a;
Either.swap e = Either.fold Right Left e;

97
unison-src/dindex.u Normal file
View File

@ -0,0 +1,97 @@
-- A distributed index, using Highest Random Weight (HRW) hashing
-- to pick which nodes are responsible for which keys. See:
-- https://en.wikipedia.org/wiki/Rendezvous_hashing
DIndex.Replication-Factor = 3;
DIndex.Timeout = Duration.seconds 10;
DIndex.Max-Timeout = Duration.seconds 500;
DIndex.empty : ∀ k v . Remote (Index Node (Index k v));
DIndex.empty = Index.empty;
-- Pick the nodes responsible for a key, using HRW hashing
DIndex.nodesForKey : ∀ k v . k -> Index Node (Index k v) -> Remote (Vector Node);
DIndex.nodesForKey k ind = do Remote
nodes := Index.keys ind;
hashes := Remote.traverse (node -> hash! (node, k)) nodes;
(nodes `Vector.zip` hashes)
|> Vector.sort Hash.Order 2nd
|> Vector.take DIndex.Replication-Factor
|> Vector.map 1st
|> pure;;
;
DIndex.lookup : ∀ k v . k -> Index Node (Index k v) -> Remote (Optional v);
DIndex.lookup k ind = do Remote
nodes := DIndex.nodesForKey k ind;
localLookup = node -> (do Remote
nind := Index.lookup node ind;
-- on slim chance that a Node is removed from the cluster just before
-- we do the lookup, it gets treated like a timeout
Optional.fold (Remote.map (const None) (Remote.delay DIndex.Timeout))
(Index.lookup k)
nind;;)
;
-- todo: use Remote.quorum here
-- Remote.race DIndex.Timeout <| Vector.map localLookup nodes;;
rs := Remote.traverse localLookup nodes;
pure (Vector.at 0 rs |> Optional.bind identity);;
;
DIndex.insert : ∀ k v . k -> v -> Index Node (Index k v) -> Remote Unit;
DIndex.insert k v ind = do Remote
nodes := DIndex.nodesForKey k ind;
localInsert = node -> (do Remote
nind := Index.lookup node ind;
Optional.fold (Remote.map (const Unit) (Remote.delay DIndex.Timeout))
(Index.insert k v)
nind;;)
;
Remote.race DIndex.Timeout <| Vector.map localInsert nodes;;
;
DIndex.join : ∀ k v . Index Node (Index k v) -> Remote Unit;
DIndex.join ind = do Remote
here := Remote.here;
localInd := Index.empty;
Index.insert here localInd ind;;
;
DIndex.indicesForKey : ∀ k v . k -> Index Node (Index k v) -> Remote (Vector (Index k v));
DIndex.indicesForKey k ind = do Remote
nodes := DIndex.nodesForKey k ind;
indices := Remote.traverse (node -> Index.lookup node ind) nodes;
pure (Optional.somes indices);;
;
DIndex.rebalance : ∀ k v . k -> Index Node (Index k v) -> Remote Unit;
DIndex.rebalance k ind = do Remote
indices := DIndex.indicesForKey k ind;
t = DIndex.Timeout;
results := Remote.parallel-traverse DIndex.Max-Timeout (Index.lookup k `then` Remote.timeout t) indices;
resultsHashes := Remote.traverse hash! results;
uh := hash! None;
hd = uh `Optional.getOr` Vector.at 0 resultsHashes;
eq = h1 h2 -> Hash.equal (Hash.erase h1) (Hash.erase h2);
if (Vector.all? (eq hd) resultsHashes)
-- all results matched, we're good
(pure Unit)
-- not all results matched, reinsert
(do Remote
ov := DIndex.lookup k ind;
Optional.fold (pure Unit)
(v -> DIndex.insert k v ind)
ov;;)
;;
;
DIndex.leave : ∀ k v . Node -> Index Node (Index k v) -> Remote Unit;
DIndex.leave node ind = do Remote
local-ind := Index.lookup node ind;
Index.delete node ind;
Optional.fold
(pure Unit)
(local-ind -> do Remote
keys := Index.keys local-ind;
Remote.fork <| Remote.traverse (k -> DIndex.rebalance k ind) keys;;)
local-ind;;
;

11
unison-src/extra.u
View File

@ -5,12 +5,18 @@ Index.empty = Remote.map Index.empty# Remote.here;
Index.keys : ∀ k v . Index k v -> Remote (Vector k);
Index.keys = Index.fromUnsafe Index.keys#;
Index.1st-key : ∀ k v . Index k v -> Remote (Optional k);
Index.1st-key = Index.fromUnsafe Index.1st-key#;
Index.increment : ∀ k v . k -> Index k v -> Remote (Optional k);
Index.increment k = Index.fromUnsafe (Index.increment# k);
Index.lookup : ∀ k v . k -> Index k v -> Remote (Optional v);
Index.lookup k = Index.fromUnsafe (Index.lookup# k);
Index.delete : ∀ k v . k -> Index k v -> Remote Unit;
Index.delete k = Index.fromUnsafe (Index.delete# k);
Index.insert : ∀ k v . k -> v -> Index k v -> Remote Unit;
Index.insert k v = Index.fromUnsafe (Index.insert# k v);
@ -20,7 +26,8 @@ Index.fromUnsafe f ind = let
Remote.map f (Remote.at (1st p) (2nd p));;
;
-- todo: Index.delete
Http.getUrl : Text -> Remote (Either Text Text);
Http.getUrl url = Remote.map Http.getUrl# (Remote.pure url);
hash! : ∀ a . a -> Remote (Hash a);
hash! a = Remote.map hash# (Remote.pure a);