Can it ever happen that the set of notifications is non-empty? Since we are only adding locks, I'd say no.
On Fri, Apr 11, 2014 at 2:55 PM, Petr Pudlák <[email protected]> wrote: > > > > On Fri, Apr 11, 2014 at 12:43 PM, Klaus Aehlig <[email protected]> wrote: > >> Again, this just wraps around updateLocks, sequentially trying >> to obtain all the locks mentioned. >> >> Signed-off-by: Klaus Aehlig <[email protected]> >> --- >> src/Ganeti/Locking/Waiting.hs | 25 ++++++++++++++++++++++++- >> 1 file changed, 24 insertions(+), 1 deletion(-) >> >> diff --git a/src/Ganeti/Locking/Waiting.hs b/src/Ganeti/Locking/Waiting.hs >> index 2d95c6a..d0eba92 100644 >> --- a/src/Ganeti/Locking/Waiting.hs >> +++ b/src/Ganeti/Locking/Waiting.hs >> @@ -39,10 +39,12 @@ module Ganeti.Locking.Waiting >> , freeLocksPredicate >> , downGradeLocksPredicate >> , intersectLocks >> + , opportunisticLockUnion >> ) where >> >> -import Control.Arrow ((&&&), second) >> +import Control.Arrow ((&&&), (***), second) >> import Control.Monad (liftM) >> +import Data.List (sort) >> import qualified Data.Map as M >> import Data.Maybe (fromMaybe) >> import qualified Data.Set as S >> @@ -317,3 +319,24 @@ intersectLocks :: (Lock a, Ord b, Ord c) >> -> b >> -> LockWaiting a b c -> (LockWaiting a b c, S.Set b) >> intersectLocks locks = freeLocksPredicate (not . flip elem locks) >> + >> +-- | Opprotunistically allocate locks for a given user; return the set >> > > I'd suggest s/user/owner/ > > >> +-- of actually acquired locks. >> +opportunisticLockUnion :: (Lock a, Ord b, Ord c) >> + => b >> + -> [(a, L.OwnerState)] >> + -> LockWaiting a b c >> + -> (LockWaiting a b c, ([a], S.Set b)) >> +opportunisticLockUnion owner reqs state = >> + let locks = L.listLocks owner $ getAllocation state >> + reqs' = sort $ filter (uncurry (<) . (flip M.lookup locks *** >> Just)) reqs >> + maybeAllocate (s, (success, notify)) (lock, ownstate) = >> + let (s', (result, notify')) = >> + updateLocks owner >> + [(if ownstate == L.OwnShared >> + then L.requestShared >> + else L.requestExclusive) lock] >> + s >> + in (s', ( if result == Ok S.empty then lock:success else success >> + , notify `S.union` notify')) >> + in foldl maybeAllocate (state, ([], S.empty)) reqs' >> -- >> 1.9.1.423.g4596e3a >> >> > LGTM >
