diff --git a/Control/Monad/Queue/Class.hs b/Control/Monad/Queue/Class.hs
--- a/Control/Monad/Queue/Class.hs
+++ b/Control/Monad/Queue/Class.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, TypeOperators #-}
 
 module Control.Monad.Queue.Class ((:->)(..), MonadQueue(..)) where
 
@@ -8,12 +8,11 @@
 import Control.Monad.Reader
 import Control.Monad.Maybe
 import Control.Monad.Array
--- import Control.Monad.ST.Trans
-import Control.Monad.Trans.Operations
 import qualified Control.Monad.Writer.Strict as StrictW
 import qualified Control.Monad.Writer.Lazy as LazyW
-import Data.Monoid(Monoid)
 
+import Data.Monoid
+
 -- | Type that only orders on the key, ignoring the value completely; frequently useful in priority queues, so made available here.
 data e :-> f = e :-> f
 
@@ -23,12 +22,13 @@
 	(_ :-> x) `compare` (_ :-> y)	= compare x y
 
 -- | Typeclass abstraction of a monad with access to a mutable queue.  Minimal implementation: 'queueInsert' or 'queueInsertAll', 'queuePeek', 'queueExtract' or 'queueDelete', 'queueSize'.
-class Monad m => MonadQueue e m | m -> e where
-	queueInsert :: e -> m ()
-	queueInsertAll :: [e] -> m ()
-	queueExtract :: m (Maybe e)
+class Monad m => MonadQueue m where
+	type QKey m
+	queueInsert :: QKey m -> m ()
+	queueInsertAll :: [QKey m] -> m ()
+	queueExtract :: m (Maybe (QKey m))
 	queueDelete :: m ()
-	queuePeek :: m (Maybe e)
+	queuePeek :: m (Maybe (QKey m))
 	queueEmpty :: m Bool
 	queueSize :: m Int
 	queueEmpty = liftM (==0) queueSize
@@ -39,7 +39,7 @@
 				case mx of	Nothing	-> return Nothing
 						Just{}	-> queueDelete >> return mx
 
--- instance (MonadTrans t, MonadQueue e m, Monad (t m)) => MonadQueue e (t m) where
+-- instance (MonadTrans t, MonadQueue m, Monad (t m)) => MonadQueue (t m) where
 -- 	queueInsert = lift . queueInsert
 -- 	queueInsertAll = lift . queueInsertAll
 -- 	queueExtract = lift queueExtract
@@ -49,7 +49,8 @@
 -- 	queueSize = lift queueSize
 	
 	
-instance MonadQueue e m => MonadQueue e (StrictS.StateT s m) where
+instance MonadQueue m => MonadQueue (StrictS.StateT s m) where
+	type QKey (StrictS.StateT s m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -58,7 +59,8 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance MonadQueue e m => MonadQueue e (LazyS.StateT s m) where
+instance MonadQueue m => MonadQueue (LazyS.StateT s m) where
+	type QKey (LazyS.StateT s m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -67,7 +69,8 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance MonadQueue e m => MonadQueue e (ReaderT r m) where
+instance MonadQueue m => MonadQueue (ReaderT r m) where
+	type QKey (ReaderT r m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -76,7 +79,8 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance (Monoid w, MonadQueue e m) => MonadQueue e (StrictW.WriterT w m) where
+instance (Monoid w, MonadQueue m) => MonadQueue (StrictW.WriterT w m) where
+	type QKey (StrictW.WriterT w m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -85,7 +89,8 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance (Monoid w, MonadQueue e m) => MonadQueue e (LazyW.WriterT w m) where
+instance (Monoid w, MonadQueue m) => MonadQueue (LazyW.WriterT w m) where
+	type QKey (LazyW.WriterT w m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -94,7 +99,8 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance MonadQueue e m => MonadQueue e (MaybeT m) where
+instance MonadQueue m => MonadQueue (MaybeT m) where
+	type QKey (MaybeT m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -103,7 +109,8 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance MonadQueue e m => MonadQueue e (ListT m) where
+instance MonadQueue m => MonadQueue (ListT m) where
+	type QKey (ListT m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
@@ -112,7 +119,18 @@
 	queueEmpty = lift queueEmpty
 	queueSize = lift queueSize
 	
-instance MonadQueue e m => MonadQueue e (IntMapT f m) where
+instance MonadQueue m => MonadQueue (IntMapT f m) where
+	type QKey (IntMapT f m) = QKey m
+	queueInsert = lift . queueInsert
+	queueInsertAll = lift . queueInsertAll
+	queueExtract = lift queueExtract
+	queueDelete = lift queueDelete
+	queuePeek = lift queuePeek
+	queueEmpty = lift queueEmpty
+	queueSize = lift queueSize
+
+instance MonadQueue m => MonadQueue (ArrayT f m) where
+	type QKey (ArrayT f m) = QKey m
 	queueInsert = lift . queueInsert
 	queueInsertAll = lift . queueInsertAll
 	queueExtract = lift queueExtract
diff --git a/Control/Monad/Queue/Heap.hs b/Control/Monad/Queue/Heap.hs
--- a/Control/Monad/Queue/Heap.hs
+++ b/Control/Monad/Queue/Heap.hs
@@ -1,12 +1,13 @@
-{-# LANGUAGE RankNTypes, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, UndecidableInstances #-}
+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving, TypeFamilies, UndecidableInstances #-}
 
 module Control.Monad.Queue.Heap (HeapM, HeapT, runHeapM, runHeapMOn, runHeapT, runHeapTOn) where
 
-import Control.Monad.ST
-import Control.Monad.ST.Class
 import Control.Monad.Array.ArrayT
 import Control.Monad.Array.Class
 
+import Control.Monad.ST
+import Control.Monad.ST.Class
+
 import Control.Monad.State.Strict
 import Control.Monad.RWS.Class
 import Control.Monad.Queue.Class
@@ -32,12 +33,6 @@
 runHeapMOn :: Ord e => (forall s . HeapM s e a) -> Int -> [e] -> a
 runHeapMOn m n l = runST $ runHeapTOn m n l
 
--- runHeapMIO :: Ord e => HeapM RealWorld e a -> IO a
--- runHeapMIO m = stToIO $ runHeapT m
--- 
--- runHeapMOnIO :: Ord e => HeapM RealWorld e a -> Int -> [e] -> IO a
--- runHeapMOnIO m n l = stToIO $ runHeapTOn m n l
-
 runHeapT :: (MonadST m, Monad m) => HeapT e m a -> m a
 runHeapT m = runArrayT_ 16 (evalStateT (execHeapT m) 0)
 
@@ -51,18 +46,34 @@
 								mapM_ (\ i -> unsafeReadAt i >>= heapDown n i) [0..n-1]
 								execHeapT m
 
-ensureHeap :: MonadArray e m => Int -> m ()
-ensureHeap n = do	cap <- getSize
+instance (MonadST m, Monad m, Ord e) => MonadQueue (HeapT e m) where
+	type QKey (HeapT e m) = e
+	queuePeek = HeapT $ do	
+		size <- get
+		if size > 0 then liftM Just (unsafeReadAt 0) else return Nothing
+	queueInsert x = HeapT $ do
+		size <- get
+		ensureHeap (size+1)
+		put (size + 1)
+		heapUp size x
+	queueDelete = HeapT $ do
+		size <- get
+		put (size - 1)
+		unsafeReadAt (size - 1) >>= heapDown (size - 1) 0 >> unsafeWriteAt (size-1) undefined
+	queueSize = HeapT get
+
+ensureHeap :: MonadArray m => Int -> m ()
+ensureHeap n = do	cap <- askSize
 			when (n - 1 >= cap) (resize (2 * n))
 
-heapUp :: (MonadArray e m, Ord e) => Int -> e -> m ()
+heapUp :: (MonadArray m, e ~ ArrayElem m, Ord e) => Int -> e -> m ()
 heapUp = let	heapUp' 0 x	= unsafeWriteAt 0 x
 		heapUp' i x	= let j = (i - 1) `quot` 2 in do
 			aj <- unsafeReadAt j
 			if x >= aj then unsafeWriteAt i x else unsafeWriteAt i aj >> heapUp' j x
 		in heapUp'
 
-heapDown :: (MonadArray e m, Ord e) => Int -> Int -> e -> m ()
+heapDown :: (MonadArray m, e ~ ArrayElem m, Ord e) => Int -> Int -> e -> m ()
 heapDown size = heapDown'
 	where	heapDown' i x = let lch = 2 * i + 1; rch = lch + 1 in case compare rch size of
 			LT	-> do	al <- unsafeReadAt lch
@@ -72,18 +83,3 @@
 			EQ	-> do	al <- readAt lch
 					if al < x then unsafeWriteAt i al >> unsafeWriteAt lch x else unsafeWriteAt i x
 			GT	-> unsafeWriteAt i x
-
-instance (MonadST m, Monad m, Ord e) => MonadQueue e (HeapT e m) where
-	queuePeek = HeapT $ do	
-		size <- get
-		if size > 0 then liftM Just (unsafeReadAt 0) else return Nothing
-	queueInsert x = HeapT $ do
-		size <- get
-		ensureHeap (size+1)
-		put (size + 1)
-		heapUp size x
-	queueDelete = HeapT $ do
-		size <- get
-		put (size - 1)
-		unsafeReadAt (size - 1) >>= heapDown (size - 1) 0 >> unsafeWriteAt (size-1) undefined
-	queueSize = HeapT get
diff --git a/Control/Monad/Queue/QueueT.hs b/Control/Monad/Queue/QueueT.hs
--- a/Control/Monad/Queue/QueueT.hs
+++ b/Control/Monad/Queue/QueueT.hs
@@ -1,18 +1,21 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, UndecidableInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}
 
 
 -- | A monad transformer allowing a purely functional queue implementation (specifically, implementing the 'Queuelike' abstraction) to be used in a monadic, single-threaded fashion.
 module Control.Monad.Queue.QueueT where
 
 import Data.Queue
-import Control.Monad.State.Lazy
 import Control.Monad.Queue.Class
-import Control.Monad.RWS.Class
-import Control.Monad.Fix
-import Control.Monad.Trans(MonadIO, MonadTrans(..))
-import Control.Monad.ST.Class(MonadST)
-import Control.Monad(Monad)
+
 import Control.Monad.Trans.Operations
+
+import Control.Monad.State.Lazy
+import Control.Monad.Reader.Class
+import Control.Monad.Writer.Class
+import Control.Monad.Fix
+import Control.Monad.Trans
+import Control.Monad
+
 import Data.Maybe
 
 -- | A monad transformer granting the underlying monad @m@ access to single-threaded actions on a queue.
@@ -23,30 +26,33 @@
 type PQueueM e = QueueM (PQueue e)
 type FibQueueT e = QueueT (FQueue e)
 type FibQueueM e = QueueM (FQueue e)
+type SkewQueueT e = QueueT (SkewQueue e)
+type SkewQueueM e = QueueM (SkewQueue e)
 
 -- | Unwraps a queue transformer, initializing it with an empty queue.
-runQueueT :: (Monad m, Queuelike q e) => QueueT q m a -> m a
+runQueueT :: (Monad m, Queuelike q) => QueueT q m a -> m a
 runQueueT m = evalStateT (runQT m) empty
 
 -- | Unwraps a queue transformer, initializing it with a queue with the specified contents.
-runQueueTOn :: (Monad m, Queuelike q e) => QueueT q m a -> [e] -> m a
+runQueueTOn :: (Monad m, Queuelike q) => QueueT q m a -> [QueueKey q] -> m a
 runQueueTOn m xs = evalStateT (runQT m) (fromList xs)
 
 -- | Executes a computation in a queue monad, starting with an empty queue.
-runQueueM :: Queuelike q e => QueueM q a -> a
+runQueueM :: Queuelike q => QueueM q a -> a
 runQueueM m = evalState (runQM m) empty
 
 -- | Executes a computation in a queue monad, starting with a queue with the specified contents.
-runQueueMOn :: Queuelike q e => QueueM q a -> [e] -> a
+runQueueMOn :: Queuelike q => QueueM q a -> [QueueKey q] -> a
 runQueueMOn m xs = evalState (runQM m) (fromList xs)
 
 instance MonadState s m => MonadState s (QueueT q m) where
 	get = lift get
 	put = lift . put
 
-instance (Monad m, Queuelike q e) => MonadQueue e (QueueT q m) where
-	{-# SPECIALIZE instance (Ord e, Monad m) => MonadQueue e (PQueueT e m) #-}
-	{-# SPECIALIZE instance (Ord e, Monad m) => MonadQueue e (FibQueueT e m) #-}
+instance (Monad m, Queuelike q) => MonadQueue (QueueT q m) where
+	type QKey (QueueT q m) = QueueKey q
+	{-# SPECIALIZE instance (Ord e, Monad m) => MonadQueue (PQueueT e m) #-}
+	{-# SPECIALIZE instance (Ord e, Monad m) => MonadQueue (FibQueueT e m) #-}
 	queueInsert x = QueueT $ modify (insert x)
 	queueInsertAll xs = QueueT $ modify (insertAll xs)
 	queueExtract = QueueT $ statefully (\ q -> maybe (Nothing, q) (\ (x, q') -> (Just x, q')) (extract q))
@@ -55,9 +61,10 @@
 	queuePeek = QueueT $ gets peek
 	queueSize = QueueT $ gets size
 
-instance Queuelike q e => MonadQueue e (QueueM q) where
-	{-# SPECIALIZE instance Ord e => MonadQueue e (PQueueM e) #-}
-	{-# SPECIALIZE instance Ord e => MonadQueue e (FibQueueM e) #-}
+instance Queuelike q => MonadQueue (QueueM q) where
+	type QKey (QueueM q) = QueueKey q
+	{-# SPECIALIZE instance Ord e => MonadQueue (PQueueM e) #-}
+	{-# SPECIALIZE instance Ord e => MonadQueue (FibQueueM e) #-}
 	queueInsert x = QueueM $ modify (insert x)
 	queueInsertAll xs = QueueM $ modify (insertAll xs)
 	queueExtract = QueueM $ statefully (\ q -> maybe (Nothing, q) (\ (x, q') -> (Just x, q')) (extract q))
diff --git a/Data/Queue/Class.hs b/Data/Queue/Class.hs
--- a/Data/Queue/Class.hs
+++ b/Data/Queue/Class.hs
@@ -1,30 +1,29 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
 
 -- | Abstracts the implementation details of a single-insertion, single-extraction queuelike structure.
 module Data.Queue.Class where
 
 import Data.List(unfoldr)
-import Control.Monad
-import Control.Monad.RWS.Class
-import Control.Monad.Trans
-import Control.Monad.State.Strict
 import Data.Maybe
-import Control.Monad.ST.Class
 
+import Control.Monad.Instances()
+import Control.Monad
+
 -- | A generic type class encapsulating a generic queuelike structure, that supports single-insertion and single-extraction; this abstraction includes priority queues, stacks, and FIFO queues.  There are many minimal implementations, so each method lists the prerequisites for its default implementation.  Most implementations will implement 'empty', ('singleton' and 'merge') or 'insert', ('peek' and 'delete') or 'extract', and 'size'.
-class Queuelike q e | q -> e where
+class Queuelike q where
+	type QueueKey q
 	-- | Inserts a single element into the queue.  The default implementation uses 'merge' and 'singleton'.
-	insert :: e -> q -> q
+	insert :: QueueKey q -> q -> q
 	insert = merge . singleton
 	-- | Inserts several elements into the queue.  The default implementation uses 'insert'.  (In some cases, it may be advantageous to override this implementation with @xs \``insertAll`\` q = q \``merge`\` `fromList` xs@.)
 	{-# INLINE insertAll #-}
-	insertAll :: [e] -> q -> q
+	insertAll :: [QueueKey q] -> q -> q
 	insertAll = flip (foldr insert)
 	-- | Attempts to extract an element from the queue; if the queue is empty, returns Nothing.  The default implementation uses 'peek' and 'delete'.
-	extract :: q -> Maybe (e, q)
+	extract :: q -> Maybe (QueueKey q, q)
 	extract = liftM2 (liftM2 (,)) peek delete
 	-- | Gets the element that will next be extracted from the queue, if there is an element available.  The default implementation uses 'extract'.
-	peek ::  q -> Maybe e
+	peek ::  q -> Maybe (QueueKey q)
 	peek = liftM fst . extract
 	-- | Deletes an element from the queue, if the queue is nonempty.  The default implementation uses 'extract'.
 	delete :: q -> Maybe q
@@ -33,11 +32,11 @@
 	empty :: q
 	empty = fromList []
 	-- | Constructs a queue with a single element.  The default implementation uses 'insert' and 'empty'.
-	singleton :: e -> q
+	singleton :: QueueKey q -> q
 	singleton x = insert x empty
 	-- | Constructs a queue with all of the elements in the list.  The default implementation uses 'insertAll' and 'empty'.
 	{-# INLINE fromList #-}
-	fromList :: [e] -> q
+	fromList :: [QueueKey q] -> q
 	fromList xs = insertAll xs empty
 	-- | Gets the size of the queue.  The default implementation uses 'toList_'.
 	size :: q -> Int
@@ -46,15 +45,14 @@
 	isEmpty :: q -> Bool
 	isEmpty = isNothing . peek
 	-- | Extracts every element from the queue.  The default implementation uses 'extract'.
-	toList :: q -> [e]
+	toList :: q -> [QueueKey q]
 	toList = unfoldr extract
 	-- | Extracts every element from the queue, with no guarantees upon order.  The default implementation uses 'toList'.
-	toList_ :: q -> [e]
+	toList_ :: q -> [QueueKey q]
 	toList_ = toList
 	-- | Merges two queues so that the contents of the second queue are inserted into the first queue in extraction order.  The default implementation uses 'toList' and 'insertAll'.
 	{-# INLINE merge #-}
 	merge :: q -> q -> q
 	q1 `merge` q2 = insertAll (toList q2) q1
-
-mergeAll :: Queuelike q e => [q] -> q
-mergeAll = foldr merge empty
+	mergeAll :: [q] -> q
+	mergeAll = foldr merge empty
diff --git a/Data/Queue/FibQueue.hs b/Data/Queue/FibQueue.hs
--- a/Data/Queue/FibQueue.hs
+++ b/Data/Queue/FibQueue.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE RankNTypes, ViewPatterns, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ImpredicativeTypes #-}
-{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
+{-# LANGUAGE MagicHash, BangPatterns, NamedFieldPuns, ViewPatterns, FlexibleInstances, TypeFamilies, FlexibleContexts #-}
+{-# OPTIONS -fno-warn-overlapping-patterns -fno-warn-name-shadowing #-}
 
 {- |
 An alternate implementation of a priority queue based on a /Fibonacci heap/.
@@ -10,65 +10,88 @@
 
 import Data.Queue.Class
 import Control.Monad.Array
-import Data.Tree(Tree(..))
+
+import GHC.Exts
+
+import Data.Bits
 import Data.Maybe
+import Data.Monoid
+import Data.Ord
+
 import Control.Monad
-import GHC.Exts(build)
-import Prelude hiding (getContents)
 
-data Rk e = Rk {rk :: {-# UNPACK #-} !Int, lab :: e}
-type RkTree e = Tree (Rk e)
-data FQueue e = FQueue {elts :: {-# UNPACK #-} !Int, maxRank :: {-# UNPACK #-} !Int, heap :: [RkTree e]}
+data RkTree e = RkT {treeRk :: {-# UNPACK #-} !Int, treeMin :: e, _subForest :: [RkTree e]}
+data FQueue e = FQueue {elts, _maxRank :: {-# UNPACK #-} !Int, heap :: [RkTree e]}
 
-instance Ord e => Queuelike (FQueue e) e where
+instance Ord e => Queuelike (FQueue e) where
+	type QueueKey (FQueue e) = e
 	FQueue n1 r1 h1 `merge` FQueue n2 r2 h2 = FQueue (n1 + n2) (max r1 r2) (case (h1, h2) of
-		((treeMin -> x1):_, (treeMin -> x2):_) -> if x1 <= x2 then h1 ++ h2 else h2 ++ h1
+		(t1:_, t2:_)	| comparing treeMin t1 t2 == LT	-> h1 ++ h2
+				| otherwise			-> h2 ++ h1
 		(_, [])	-> h1
 		([], _)	-> h2)
 	empty = FQueue 0 0 []
-	singleton x = FQueue 1 0 [Node (Rk 0 x) []]
-	toList_ = concatMap (map lab . flatten) . heap
+	singleton x = FQueue 1 0 [RkT 0 x []]
+	toList_ = concatMap flatten . heap
 	size = elts
-	peek = liftM treeMin . listToMaybe . heap
-	delete (FQueue n mR (Node (Rk _ x) ts : tss)) = Just $ rebuild (MA (n-1) mR (mapM_ meld tss >> mapM_ meld ts))
-	delete _ = Nothing
+	peek FQueue{heap} = fmap treeMin (listToMaybe heap)
+	delete q = do	FQueue (n+1) mR (RkT _ _ ts : tss) <- return q
+			return $ uncurry (FQueue n) $ rebuild mR (ts ++ tss)
+	fromList ts = let n = length ts in FQueue n (intLog n) (snd $ findMin $ fromListFQ n ts)
 
-treeMin :: RkTree e -> e
-treeMin (Node (Rk _ x) _) = x
+instance Ord e => Monoid (FQueue e) where
+	mempty = empty
+	mappend = merge
+	mconcat = mergeAll
 
 {-# INLINE flatten #-}
-flatten :: Tree e -> [e]
+flatten :: RkTree e -> [e]
 flatten t = build (\ c n -> flatten' c t n) where
-	flatten' c (Node x ts) n = x `c` foldr (flatten' c) n ts
+	flatten' c (RkT _ x ts) n = x `c` foldr (flatten' c) n ts
 
 meldTree :: Ord e => RkTree e -> RkTree e -> RkTree e
-t1@(Node (Rk d x1) ts1) `meldTree` t2@(Node (Rk _ x2) ts2)
-	| x1 <= x2	= Node (Rk (d+1) x1) (t2:ts1)
-	| otherwise	= Node (Rk (d+1) x2) (t1:ts2)
+t1@(RkT d x1 ts1) `meldTree` t2@(RkT _ x2 ts2)
+	| x1 <= x2	= RkT (d+1) x1 (t2:ts1)
+	| otherwise	= RkT (d+1) x2 (t1:ts2)
 
 -- The use of the ArrayM monad here considerably increases readability and efficiency.
 meld :: Ord e => RkTree e -> ArrayM s (Maybe (RkTree e)) ()
-meld t@(rk . rootLabel -> d) =
-	ensureSize (d+2) >> readAt d >>= maybe (writeAt d (Just t)) (\ t' -> writeAt d Nothing >> meld (t `meldTree` t'))
+meld t@RkT{treeRk} =
+	ensureSize (treeRk+2) >> readAt treeRk >>= maybe (writeAt treeRk (Just t)) (\ t' -> writeAt treeRk Nothing >> meld (t `meldTree` t'))
 
-extractMin :: Ord e => [Maybe (RkTree e)] -> (Int, [RkTree e])
-extractMin ls = case foldr exM (Nothing, 0, []) ls of (mi, rk, ts) -> maybe (0, []) ((,) rk . (:ts)) mi ; where
-	exM Nothing p = p
-	exM (Just t@(Node (Rk d x) _)) (mi, rk, ts) = let rk' = max d rk in maybe (Just t, rk', ts) 
-		(\ t'@(lab . rootLabel -> y) -> if x <= y then (Just t, rk', t':ts) else (Just t', rk', t:ts)) mi
+data MergeAccum e = MA {-# UNPACK #-} !Int [RkTree e]
 
-rebuild :: Ord e => MergeAccum e -> FQueue e
-rebuild (MA n mR melder) = runArrayM mR Nothing $ melder >> liftM ((\ (mR', h') -> FQueue n mR' h') . extractMin) getContents
+{-# INLINE findMin #-}
+findMin :: Ord e => [RkTree e] -> (Int, [RkTree e])
+findMin ts = case foldr (getMin (comparing treeMin)) (MA 0 []) ts of MA d ls -> (d, ls) ; where
+	getMin !cmp t1 (MA d ts) = case ts of
+		[]	-> MA (treeRk t1) [t1]
+		(t:ts)	| cmp t1 t == LT
+				-> MA (max d (treeRk t1)) (t1:t:ts)
+			| otherwise
+				-> MA (max d (treeRk t1)) (t:t1:ts)
 
-data MergeAccum e = MA {-# UNPACK #-} !Int {-# UNPACK #-} !Int (forall s . ArrayM s (Maybe (RkTree e)) ())
+{-# INLINE rebuild #-}
+rebuild :: Ord e => Int -> [RkTree e] -> (Int, [RkTree e])
+rebuild maxRank ts = runArrayM (maxRank + 1) Nothing $ mapM_ meld ts >> liftM (\ ts' -> findMin (catMaybes ts')) askElems
 
-{-# INLINE mergeAllFH #-}
-mergeAllFH :: Ord e => [FQueue e] -> FQueue e
-mergeAllFH qs = rebuild (foldr merger (MA 0 0 (return ())) qs) where
-	merger :: Ord e => FQueue e -> MergeAccum e -> MergeAccum e
-	merger (FQueue n r ts) (MA m mR toMerge) = MA (n+m) (max r mR) (mapM_ meld ts >> toMerge)
-	
+fromPow2List :: Ord e => Int -> [e] -> RkTree e
+fromPow2List n ts = meldList 1 (map (\ x -> RkT 0 x []) ts) where
+	fuse2 (t1:t2:ts) = t1 `meldTree` t2 : fuse2 ts
+	fuse2 ts = ts
+	meldList p ts	| p < n		= meldList (p + p) (fuse2 ts)
+			| otherwise	= head ts
 
-{-# RULES
-	"mergeAll/FibHeap" forall (ts :: Ord e => [FQueue e]) . mergeAll ts = mergeAllFH ts
-	#-}
+fromListFQ :: Ord e => Int -> [e] -> [RkTree e]
+fromListFQ 0 _ = []
+fromListFQ n ts = let p = bit (intLog n); (ts1, ts2) = splitAt p ts in fromPow2List p ts1 : fromListFQ (n-p) ts2
+
+intLog :: Int -> Int
+intLog 0 = 0
+intLog 1 = 0
+intLog (I# x) = {-# SCC "intLog" #-} I# (intLog1 (int2Word# x)) where
+	intLog1 x# = let ans# = uncheckedShiftRL# x# 16# in if ans# `eqWord#` 0## then intLog2 x# else 16# +# intLog2 ans#
+	intLog2 x# = let ans# = uncheckedShiftRL# x# 8# in if ans# `eqWord#` 0## then intLog3 x# else 8# +# intLog3 ans#
+	intLog3 x# = let ans# = uncheckedShiftRL# x# 4# in if ans# `eqWord#` 0## then intLog4 x# else 4# +# intLog4 ans#
+	intLog4 x# = let ans# = uncheckedShiftRL# x# 2# in if ans# `eqWord#` 0## then intLog5 x# else 2# +# intLog5 ans#
+	intLog5 x# = if x# `leWord#` 1## then 0# else 1#
diff --git a/Data/Queue/Instances.hs b/Data/Queue/Instances.hs
--- a/Data/Queue/Instances.hs
+++ b/Data/Queue/Instances.hs
@@ -1,7 +1,8 @@
-module Data.Queue.Instances (module Data.Queue.ReverseQueue, module Data.Queue.PQueue, module Data.Queue.FibQueue, module Data.Queue.Stack, module Data.Queue.Queue) where
+module Data.Queue.Instances (module Data.Queue.ReverseQueue, module Data.Queue.PQueue, module Data.Queue.FibQueue, module Data.Queue.SkewQueue, module Data.Queue.Stack, module Data.Queue.Queue) where
 
 import Data.Queue.PQueue
 import Data.Queue.FibQueue
 import Data.Queue.Stack
 import Data.Queue.Queue
 import Data.Queue.ReverseQueue
+import Data.Queue.SkewQueue
diff --git a/Data/Queue/PQueue.hs b/Data/Queue/PQueue.hs
--- a/Data/Queue/PQueue.hs
+++ b/Data/Queue/PQueue.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE BangPatterns, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns, TypeSynonymInstances, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS -fno-warn-missing-methods -fno-warn-name-shadowing #-}
 {- | An efficient implementation of a priority queue.
 
 The implementation of 'PQueue' is based on a /pairing heap/, a simple and efficient implementation of a general-purpose priority queue.  'PQueue' supports 'insert', 'merge', and 'peek' in constant time, and 'extract' and 'delete' in logarithmic time.
@@ -6,65 +7,46 @@
 
 module Data.Queue.PQueue (PQueue) where
 
-import Data.Monoid
-import Data.Maybe
-import Control.Monad
-import Data.Tree
 import Data.Queue.Class
-import GHC.Exts
+import Data.Queue.QueueHelpers
 
-newtype Heap e = H (Maybe (Tree e)) deriving (Read, Show)
--- data Rk e = Rk {-# UNPACK #-} !Int e deriving (Read, Show)
--- type RkTree e = Tree (Rk e)
-data PQueue e = PQ {-# UNPACK #-} !Int {-# UNPACK #-} !(Heap e) deriving (Read, Show)
+import Data.Maybe
+import Data.Monoid
 
-instance Ord e => Monoid (Heap e) where
-	mempty = H Nothing
-	H (Just t1) `mappend` H (Just t2) = H (Just (t1 `meld` t2))
-	h1 `mappend` H Nothing = h1
-	H Nothing `mappend` h2 = h2
-	mconcat hs = fuse [t | H (Just t) <- hs]
+import Control.Monad
 
-instance Ord e => Monoid (PQueue e) where
-	mempty = PQ 0 mempty
-	PQ n1 h1 `mappend` PQ n2 h2 = PQ (n1 + n2) (h1 `mappend` h2)
-	mconcat qs = let (n, ts) = fuser 0 [] qs in PQ n (fuse ts) where
-		fuser !n ts qs = case qs of
-			[]	-> (n, ts)
-			(PQ m (H h):qs)	-> case h of	Nothing	-> fuser n ts qs
-							Just t	-> fuser (n+m) (t:ts) qs
+data Tree e = T e [Tree e]
+newtype PQueue e = PQ (HeapQ (Tree e)) deriving (Monoid, Queuelike)
 
-{-# INLINE meld #-}
-meld :: Ord e => Tree e -> Tree e -> Tree e
-t1@(Node x1 ts1) `meld` t2@(Node x2 ts2) = 
-	if x1 > x2 then Node x2 (t1:ts2) else Node x1 (t2:ts1)
+single :: e -> HeapQ (Tree e)
+single x = HQ 1 $ Just (T x [])
 
-fuse :: Ord e => [Tree e] -> Heap e
-fuse [] = H Nothing
-fuse [t] = H (Just t)
-fuse ts = fuse (fuser ts) where
-	fuser (x1:x2:xs) = (x1 `meld` x2) : fuser xs
-	fuser xs = xs
+instance Ord e => Monoid (Tree e) where
+	-- no actual mzero instance, but induces a correct Monoid instance for Heap e
+	t1@(T x1 ts1) `mappend` t2@(T x2 ts2) 
+		| x1 <= x2	= T x1 (t2:ts1)
+		| otherwise	= T x2 (t1:ts2)
 
-instance Ord e => Queuelike (PQueue e) e where
-	singleton x = PQ 1 (H (Just (Node x [])))
-	extract (PQ n (H h)) = fmap (\ (Node x ts) -> (x, PQ (n-1) $ fuse ts)) h
-	isEmpty (PQ _ (H h)) = isNothing h
-	size (PQ n _) = n
+instance Ord e => Queuelike (HeapQ (Tree e)) where
 	{-# INLINE fromList #-}
-	fromList xs = mconcat (map singleton xs)
 	{-# INLINE toList_ #-}
-	toList_ (PQ _ (H h)) = maybe [] flatten h
-	merge = mappend
-	empty = mempty
+	{-# INLINE mergeAll #-}
 	{-# INLINE insertAll #-}
-	xs `insertAll` q = q `merge` fromList xs
 
-{-# NOINLINE [0] flattenFB #-}
-flattenFB :: Tree a -> (a -> b -> b) -> b -> b
-flattenFB (Node x ts) c n = x `c` foldr (flip flattenFB c) n ts
+	type QueueKey (HeapQ (Tree e)) = e
 
-{-# RULES
-	"flatten" [~1] forall t . flatten t = build (flattenFB t);
-	"flattenList" [1] forall t . build (flattenFB t) = flatten t;
-	#-}
+	empty = mempty
+	singleton = single
+	fromList ts = mconcat (map single ts)
+
+	x `insert` q = q `mappend` single x
+	xs `insertAll` q = q `mappend` fromList xs
+	merge = mappend
+	mergeAll = mconcat
+	
+	extract (HQ n t) = fmap (\ (T x ts) ->  (x, HQ (n-1) (fusing ts))) t
+	toList_ = maybe [] flatten . heap
+	size = elts
+
+flatten :: Tree e -> [e]
+flatten (T x ts) = [x] ++ concatMap flatten ts
diff --git a/Data/Queue/Queue.hs b/Data/Queue/Queue.hs
--- a/Data/Queue/Queue.hs
+++ b/Data/Queue/Queue.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS -fno-warn-name-shadowing #-}
 
 -- | A basic first-in, first-out queue implementation implementing the 'Queuelike' abstraction.
 module Data.Queue.Queue (Queue) where
@@ -9,7 +11,8 @@
 
 data Queue e = Queue {-# UNPACK #-} !Int [e] [e] [e]
 
-instance Queuelike (Queue e) e where
+instance Queuelike (Queue e) where
+	type QueueKey (Queue e) = e
 	singleton x = Queue 1 [x] [] [x]
 	empty = Queue 0 [] [] []
 	isEmpty = (==0) . size
@@ -20,11 +23,11 @@
 	delete _ = Nothing
 
 mkQ :: Queue e -> Queue e
-mkQ (Queue n l r (a:as)) = Queue n l r as
-mkQ (Queue n l r []) = let	rot ls ~(r:rs) a = case ls of
+mkQ (Queue n l r (_:as)) = Queue n l r as
+mkQ (Queue n ll rr []) = let	rot ls ~(r:rs) a = case ls of
 					[]	-> r:a
 					(l:ls)	-> l:rot ls rs (r:a)
-				l' = rot l r [] in Queue n l' [] l'
+				l' = rot ll rr [] in Queue n l' [] l'
 
 instance Monoid (Queue e) where
 	mempty = empty
diff --git a/Data/Queue/QueueHelpers.hs b/Data/Queue/QueueHelpers.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/QueueHelpers.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS -fno-warn-name-shadowing #-}
+
+{------------------
+
+This module builds structure common to instances of functional heaps, using monoidal structure.
+Functional heaps consist of a size tag and a monoidally structured tree type, probably lacking a true mzero.
+This module brings monoidal stucture from the tree type to the HeapQ, and provides a common mconcat implementation
+that provides balanced, linear-time heap merging.  Then a new heap can work as follows:
+
+data FooHeap e = ...
+newtype FooQueue e = FQ (HeapQ (FooHeap e)) deriving (Monoid)
+
+instance Queuelike (FooQueue e) where
+	empty = mempty
+	merge = mappend
+	mergeAll = mconcat
+	...
+
+-------------------}
+
+module Data.Queue.QueueHelpers (HeapQ(..), endoMaybe, order, fusing) where
+
+import Data.Monoid
+
+data HeapQ m = HQ {elts :: {-# UNPACK #-} !Int, heap :: Maybe m}
+
+instance Monoid m => Monoid (HeapQ m) where
+	{-# INLINE mappend #-}
+	{-# INLINE mconcat #-}
+
+	mempty = HQ 0 mempty
+	HQ n1 h1 `mappend` HQ n2 h2 = HQ (n1 + n2) (h1 `mappend` h2)
+	mconcat qs = uncurry HQ $ fuseMerge [(n, h) | HQ n h <- qs]
+
+{-# INLINE endoMaybe #-}
+endoMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
+endoMaybe f (Just a) (Just b)	= Just (f a b)
+endoMaybe _ ma Nothing		= ma
+endoMaybe _ _ mb		= mb
+
+{-# INLINE fusing #-}
+fusing :: Monoid m => [m] -> Maybe m
+fusing [] = Nothing
+fusing [t] = Just t
+fusing ts = fusing (fuse mappend ts) where
+	fuse !f (t1:t2:ts) = (t1 `f` t2):fuse f ts
+	fuse _ ts = ts
+
+{-# INLINE order #-}
+order :: (e -> e -> Ordering) -> e -> e -> (e, e)
+order cmp x y	| cmp x y == GT	= (y, x)
+		| otherwise	= (x, y)
+
+data IntAcc e = IA {-# UNPACK #-} !Int e
+
+{-# INLINE fuseMerge #-}
+fuseMerge :: Monoid m => [(Int, Maybe m)] -> (Int, Maybe m)
+fuseMerge qs = let IA n ts = foldr merger (IA 0 []) qs in (n, fusing ts) where
+	merger (m, mt) (IA n ts) = case mt of
+		Nothing	-> IA n ts
+		Just t	-> IA (n+m) (t:ts)
diff --git a/Data/Queue/ReverseQueue.hs b/Data/Queue/ReverseQueue.hs
--- a/Data/Queue/ReverseQueue.hs
+++ b/Data/Queue/ReverseQueue.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
 
 -- | Generic queue wrapper to transform a min-queue into a max-queue.
 module Data.Queue.ReverseQueue (Down(..), ReverseQueue) where
 
 import Data.Queue.Class
+import Data.Monoid
 
 newtype Down a = Down {unDown :: a} deriving (Eq)
 
@@ -18,16 +19,17 @@
 	Down x > Down y = x < y
 
 -- | Wrapper around a generic queue that reverses the ordering on its elements.
-newtype ReverseQueue q e = RQ {getQueue :: q (Down e)}
+newtype ReverseQueue q e = RQ (q (Down e))
 
-instance Queuelike (q (Down e)) (Down e) => Queuelike (ReverseQueue q e) e where
+instance (Queuelike (q (Down e)), QueueKey (q (Down e)) ~ Down e) => Queuelike (ReverseQueue q e) where
+	type QueueKey (ReverseQueue q e) = e
 	singleton x = RQ (singleton (Down x))
 	empty = RQ empty
 	fromList xs = RQ (fromList (map Down xs))
 	toList (RQ q) = map unDown (toList q)
 	toList_ (RQ q) = map unDown (toList_ q)
 	x `insert` RQ q = RQ (Down x `insert` q)
-	extract (RQ q) = fmap (\ (Down x, q) -> (x, RQ q)) (extract q)
+	extract (RQ q) = fmap (\ (Down x, q') -> (x, RQ q')) (extract q)
 	peek (RQ q) = fmap unDown (peek q)
 	delete (RQ q) = fmap RQ (delete q)
 	insertAll xs (RQ q) = RQ (insertAll (map Down xs) q)
diff --git a/Data/Queue/Stack.hs b/Data/Queue/Stack.hs
--- a/Data/Queue/Stack.hs
+++ b/Data/Queue/Stack.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | A basic implementation of a stack implementing the 'Queue' abstraction.
 module Data.Queue.Stack (Stack) where
@@ -8,7 +8,8 @@
 
 data Stack e = S {elts :: {-# UNPACK #-} !Int, getS :: [e]}
 
-instance Queuelike (Stack e) e where
+instance Queuelike (Stack e) where
+	type QueueKey (Stack e) = e
 	insert x (S n xs) = S (n+1) (x:xs)
 	extract (S (n+1) (x:xs)) = Just (x, S n xs)
 	extract _ = Nothing
diff --git a/pqueue-mtl.cabal b/pqueue-mtl.cabal
--- a/pqueue-mtl.cabal
+++ b/pqueue-mtl.cabal
@@ -1,6 +1,6 @@
 
 name:		pqueue-mtl
-version:	1.0.3
+version:	1.0.4
 synopsis:	Fully encapsulated monad transformers with queuelike functionality.
 description:	Contains several implementations of data structures implementing a /single-in, single-out/ paradigm, and implements monad transformers for their safe use.  The monad transformer part of the library includes tools to fully encapsulate single-threaded use of a priority queue in a monad, including an array-based heap implementation.
 tested-with:	GHC
@@ -9,7 +9,8 @@
 license-file:	LICENSE
 author:		Louis Wasserman
 maintainer:	wasserman.louis@gmail.com
-build-Depends:	base, ghc-prim, mtl, containers, stateful-mtl == 1.0.3 , MaybeT
+build-Depends:	base, ghc-prim, mtl, containers, stateful-mtl == 1.0.4 , MaybeT
 build-type:	Simple
 Exposed-modules:Control.Monad.Queue, Control.Monad.Queue.Instances, Control.Monad.Queue.Class, Control.Monad.Queue.Heap, Control.Monad.Queue.QueueT, Data.Queue, Data.Queue.PQueue, Data.Queue.FibQueue, Data.Queue.Class, Data.Queue.Instances, Data.Queue.Stack, Data.Queue.Queue, Data.Queue.ReverseQueue
+other-modules: Data.Queue.QueueHelpers
 ghc-options: