module Sound.SC3.Server.Allocator.SetAllocator (
SetAllocator
, cons
) where
import Control.Failure (Failure, failure)
import qualified Data.BitSet as Set
import Sound.SC3.Server.Allocator (AllocFailure(..), IdAllocator(..), Statistics(..))
import Sound.SC3.Server.Allocator.Range (Range)
import qualified Sound.SC3.Server.Allocator.Range as Range
data SetAllocator i =
SetAllocator
!(Range i)
!(Set.BitSet i)
!i
deriving (Eq, Show)
cons :: Integral i => Range i -> SetAllocator i
cons r = SetAllocator r Set.empty (Range.begin r)
toBit :: Integral i => Range i -> i -> i
toBit r i = i Range.begin r
findNext :: (Integral i) => SetAllocator i -> Maybe i
findNext (SetAllocator r u i)
| fromIntegral (Range.size r) == Set.size u = Nothing
| otherwise = loop i
where
wrap i = if i >= Range.end r
then Range.begin r
else i
loop !i = let i' = wrap (i+1)
in if Set.member (toBit r i') u
then loop i'
else Just i'
_alloc :: (Integral i, Failure AllocFailure m) => SetAllocator i -> m (i, SetAllocator i)
_alloc a@(SetAllocator r u i) =
case findNext a of
Nothing -> failure NoFreeIds
Just i' -> return (i, SetAllocator r (Set.insert (toBit r i) u) i')
_free :: (Integral i, Failure AllocFailure m) => i -> SetAllocator i -> m (SetAllocator i)
_free i (SetAllocator r u n) =
if Set.member (toBit r i) u
then let u' = Set.delete (toBit r i) u
in return (SetAllocator r u' n)
else failure InvalidId
_statistics :: (Integral i) => SetAllocator i -> Statistics
_statistics (SetAllocator r u _) =
let k = fromIntegral (Range.size r)
n = Set.size u
in Statistics {
numAvailable = k
, numFree = k n
, numUsed = n }
instance (Integral i) => IdAllocator (SetAllocator i) where
type Id (SetAllocator i) = i
alloc = _alloc
free = _free
statistics = _statistics