module Data.Queue.Indexed.Pairing
(Pairing(..)
,HVec(..))
where
import Data.Queue.Indexed.Class
import GHC.TypeLits
import Control.DeepSeq (NFData(rnf))
data Pairing n a where
E :: Pairing 0 a
T :: a -> HVec n a -> Pairing (1 + n) a
type role Pairing nominal nominal
data HVec n a where
HNil :: HVec 0 a
HCons :: Pairing m a -> HVec n a -> HVec (m + n) a
instance Ord a => IndexedQueue Pairing a where
minView (T x hs) = (x, mergePairs hs)
singleton a = T a HNil
empty = E
insert = merge . singleton
minViewMay E b _ = b
minViewMay (T x hs) _ f = f x (mergePairs hs)
instance Ord a => MeldableIndexedQueue Pairing a where
merge E ys = ys
merge xs E = xs
merge h1@(T x xs) h2@(T y ys)
| x <= y = T x (HCons h2 xs)
| otherwise = T y (HCons h1 ys)
mergePairs :: Ord a => HVec n a -> Pairing n a
mergePairs HNil = E
mergePairs (HCons h HNil) = h
mergePairs (HCons h1 (HCons h2 hs)) =
merge (merge h1 h2) (mergePairs hs)
instance NFData a => NFData (Pairing n a) where
rnf E = ()
rnf (T x xs) = rnf x `seq` rnf xs `seq` ()
instance NFData a => NFData (HVec n a) where
rnf HNil = ()
rnf (HCons x xs) = rnf x `seq` rnf xs