diff --git a/Data/MQueue/Heap.hs b/Data/MQueue/Heap.hs
--- a/Data/MQueue/Heap.hs
+++ b/Data/MQueue/Heap.hs
@@ -7,8 +7,9 @@
 import Data.MQueue.Class
 import Data.MQueue.MonadHelpers
 
+import Control.Arrow((***))
 import Control.Monad.ST.Class
-import Data.Tuple.HT
+--import Data.Tuple.HT
 
 import Data.Array.Base
 
@@ -42,7 +43,7 @@
 newHeap = liftM H (liftM (STH 0) (newArray_ (0, 15)) >>= newSTRef)
 pushHeap h = onHeap_ h . pusher
 pushAllHeap h ks = onHeap_ h (\ h@STH{size} -> uncurry (with . flip ensureSize h) (foldr accumulator (size, \ _ -> return ()) ks))
-	where	accumulator k = mapPair ((+1), liftM2 (>>) (unsafePusher k))
+	where	accumulator k = ((+1) *** liftM2 (>>) (unsafePusher k))
 popHeap_ h = onHeap_ h popper
 peekHeap h = queryHeap h (\ STH{..} -> if size > 0 then liftM Just (unsafeRead arr 0) else return Nothing)
 getHeapSize h = queryHeap h (return . size)
diff --git a/Data/Queue/Class.hs b/Data/Queue/Class.hs
--- a/Data/Queue/Class.hs
+++ b/Data/Queue/Class.hs
@@ -3,8 +3,10 @@
 -- | Abstracts the implementation details of a single-insertion, single-extraction queuelike structure.
 module Data.Queue.Class where
 
+--import Data.Foldable(Foldable(..))
 import Data.List(unfoldr)
 import Data.Maybe
+import qualified Data.List as Fold
 
 import Control.Monad.Instances()
 import Control.Monad
diff --git a/Data/Queue/PQueue.hs b/Data/Queue/PQueue.hs
--- a/Data/Queue/PQueue.hs
+++ b/Data/Queue/PQueue.hs
@@ -22,6 +22,9 @@
 data Tree e = T e [Tree e]
 newtype PQueue e = PQ (HeapQ (Tree e)) deriving (Monoid)
 
+instance Show e => Show (PQueue e) where
+	show = drawQueue
+
 drawQueue :: Show e => PQueue e -> String
 drawQueue (PQ (HQ _ t)) = maybe "" (T.drawTree . fmap show . T.unfoldTree (\ (T x ts) -> (x, ts))) t
 
@@ -50,6 +53,9 @@
 		where	extract' (T x ts) = (x, fusing ts)
 	toList_ (PQ (HQ _ t)) = maybe [] flatten t
 		where	flatten (T x ts) = x:concatMap flatten ts
+
+	null (PQ (HQ _ Nothing)) = True
+	null _ = False
 	size (PQ (HQ n _)) = n
 
 single :: e -> HeapQ (Tree e)
diff --git a/Data/Queue/Queue.hs b/Data/Queue/Queue.hs
--- a/Data/Queue/Queue.hs
+++ b/Data/Queue/Queue.hs
@@ -2,7 +2,7 @@
 {-# OPTIONS -fno-warn-name-shadowing #-}
 
 -- | A basic first-in, first-out queue implementation implementing the 'Queuelike' abstraction.  Bootstrapped from "Data.Sequence".
-module Data.Queue.Queue (Queue) where
+module Data.Queue.Queue (Queue, cons) where
 
 import Data.Monoid
 import Data.Queue.Class
@@ -11,23 +11,38 @@
 import qualified Data.Foldable as Fold
 import Prelude hiding (null)
 
-newtype Queue e = Queue (Seq e) deriving (Monoid, Fold.Foldable, Functor)
+--newtype Queue e = Queue (Seq e) deriving (Monoid, Fold.Foldable, Functor)
+data Queue e = Queue Int [e] [e] [e]
+	-- we never actually look at the spine of a
+	-- and if we're performing fmap operations, it
+	-- actually helps to existentially quantify the type
 
+instance Functor Queue where
+	fmap f (Queue n l r a) = Queue n (map f l) (map f r) (map f a)
+
 instance IQueue (Queue e) where
 	type QueueKey (Queue e) = e
-	empty = mempty
-	singleton = Queue . Seq.singleton
-	fromList = Queue . Seq.fromList
+	empty = Queue 0 [] [] []
+	singleton x = let l = [x] in Queue 1 l [] l
+	fromList xs = Queue (length xs) xs [] xs
 	
-	null (Queue q) = Seq.null q
-	size (Queue q) = Seq.length q
+	null (Queue _ [] _ _) = True
+	null _ = False
+	size (Queue n _ _ _) = n
 
-	x `insert` Queue q = Queue (q |> x)
-	extract (Queue q) = case viewl q of
-		EmptyL	-> Nothing
-		x :< q'	-> Just (x, Queue q')
+	x `insert` Queue n l r a = rot (n+1) l (x:r) a
+	extract (Queue n (l:ls) r a) = Just (l, rot (n-1) ls r a)
+	extract _ = Nothing
 
-	merge = mappend
-	mergeAll = mconcat
+--	toList (Queue _ l r _) = l ++ reverse r
 
-	toList = Fold.toList
+rot :: Int -> [e] -> [e] -> [e] -> Queue e
+rot n l r (_:as) = Queue n l r as
+rot n l r [] = let	rot' (l:ls) (r:rs) a = l:rot' ls rs (r:a)
+			rot' ls [] a = ls ++ a
+			rot' [] (r:_) a = r:a
+			l' = rot' l r []
+			in Queue n l' [] l'
+
+cons :: e -> Queue e -> Queue e
+cons x (Queue n l r a) = Queue (n+1) (x:l) r a
diff --git a/Data/Queue/QueueHelpers.hs b/Data/Queue/QueueHelpers.hs
--- a/Data/Queue/QueueHelpers.hs
+++ b/Data/Queue/QueueHelpers.hs
@@ -18,16 +18,24 @@
 	...
 
 In particular, this almost immediately yields a correct pairing heap implementation (cf. PQueue)
+
+In general, the fusing function provided by this module implements a balanced
+monoid merging operation used by nearly every priority queue implementation in this package.
 -------------------}
 
-module Data.Queue.QueueHelpers (MonoidQ (..), HeapQ, endoMaybe, order, fusing, fuseMerge, fuseMergeM) where
+module Data.Queue.QueueHelpers (MonoidQ (..), HeapQ, fusing', endoMaybe, order, fusing, fuseMerge, fuseMergeM) where
 
 import Data.Monoid
 import Data.Maybe
+import Data.List(unfoldr)
+import GHC.Exts(build)
 
-data MonoidQ m = HQ {elts :: {-# UNPACK #-} !Int, heap :: m} deriving (Eq, Ord, Show)
+data MonoidQ m = HQ {elts :: Int, heap :: m} deriving (Eq, Ord, Show)
 type HeapQ m = MonoidQ (Maybe m)
 
+instance Functor MonoidQ where
+	fmap f (HQ n m) = HQ n (f m)
+
 instance Monoid m => Monoid (MonoidQ m) where
 	{-# INLINE mappend #-}
 	{-# INLINE mconcat #-}
@@ -53,19 +61,21 @@
 endoMaybe f (Just a) (Just b)	= Just (f a b)
 endoMaybe _ ma mb		= maybe mb Just ma
 
-{-# INLINE fusing #-}
-fusing :: Monoid m => [m] -> Maybe m
-fusing = let	meld = mappend
+fusing' :: (m -> m -> m) -> [m] -> Maybe m
+fusing' (><) = let
 		fuser [] = Nothing
 		fuser [t] = Just t
 		fuser ts = fuser (fuser' ts)
 		fuser' (t1:t2:t3:t4:ts) =
-			(t1 `meld` t2) `meld` (t3 `meld` t4) : fuser' ts
-		fuser' [t1,t2,t3]	= [t1 `meld` t2 `meld` t3]
-		fuser' [t1,t2]		= [t1 `meld` t2]
+			(t1 >< t2) >< (t3 >< t4) : fuser' ts
+		fuser' [t1,t2,t3]	= [t1 >< t2 >< t3]
+		fuser' [t1,t2]		= [t1 >< t2]
 		fuser' ts		= ts
-	in meld `seq` fuser
+	in fuser
 
+fusing :: Monoid m => [m] -> Maybe m
+fusing = fusing' mappend
+
 {-
 fusing [] = Nothing
 fusing [t] = Just t
@@ -95,8 +105,17 @@
 			in case foldr merger (IA 0 []) qs of
 			IA n ts -> HQ n (fusing ts)
 
+{-# INLINE [0] unfoldFB #-}
+unfoldFB :: (b -> Maybe (a, b)) -> b -> (a -> c -> c) -> c -> c
+unfoldFB suc s0 c nil = unfold' s0 where
+	unfold' s = case suc s of
+		Nothing	-> nil
+		Just (x, s') -> x `c` unfold' s'
+
 {-# RULES
 	"[] ++" forall l . [] ++ l = l;
 	"++ []" forall l . l ++ [] = l;
 	"fuseMerge/HeapQ" forall (qs :: Monoid m => [MonoidQ (Maybe m)]) . fuseMerge qs = fuseMergeM qs;
+--	"unfold" [~1] forall suc s0 . unfoldr suc s0 = build (unfoldrFB suc s0)
 	#-}
+
diff --git a/Data/Queue/TrieQueue.hs b/Data/Queue/TrieQueue.hs
--- a/Data/Queue/TrieQueue.hs
+++ b/Data/Queue/TrieQueue.hs
@@ -1,135 +1,132 @@
-{-# LANGUAGE PatternGuards, TypeFamilies, GeneralizedNewtypeDeriving #-}
-{-# OPTIONS -fno-warn-missing-methods #-}
+{-# LANGUAGE TypeFamilies, PatternGuards #-}
 
--- | An experimental trie-based priority queue for lists.
-module Data.Queue.TrieQueue where
--- Data.Sequence-labelled trie implementation, bootstrapping monoid structure to achieve maximum great justice.
+-- | @TrieQueue e@ is a priority queue @IQueue@ instance satisfying @QueueKey (TrieQueue e) ~ [e]@, with the property that this queue frequently performs better than any other queue
+-- implementation in this package for keys of type @[e]@.  
+-- 
+-- This particular implementation is highly experimental and possibly a genuinely new data structure.  See the source code for details.
+-- However, for many cases this priority queue may be used for a heap sort that runs faster than the "Data.List" implementation,
+-- or the vanilla "Data.Queue.PQueue" implementation.
 
-import Data.Queue.Class
-import Data.Queue.QueueHelpers
+module Data.Queue.TrieQueue (TrieQueue) where
 
 import Control.Arrow((***))
-import Control.Monad(liftM2)
-
-import Data.Function
-import Data.Maybe
-import Data.List (sortBy, groupBy)
+import Control.Monad
 import Data.Monoid
-import Data.Ord
-import Data.Sequence (Seq, viewl, ViewL(..), (><), (|>), (<|))
-import qualified Data.Sequence as Seq
-import Data.Map (Map, findMin, minViewWithKey, fromDistinctAscList)
-import qualified Data.Map as Map
-import qualified Data.Foldable as Fold (toList)
+import Data.Maybe
 
+import Data.Queue.Class
+import Data.Queue.QueueHelpers(fusing')
+
+import Data.Queue.TrieQueue.Edge
+import Data.Queue.TrieQueue.MonoidQueue
+import Data.Queue.TrieQueue.TrieLabel
+
 import GHC.Exts
 
-type Label e = Seq e
+import Prelude hiding (null)
 
--- Type of a nonempty trie.
-data Trie e = 	Leaf (Label e) {-# UNPACK #-} !Int 	-- Leaf xs n represents n occurrences of the string xs.  n is always strictly positive.
-	      | Edge (Label e) {-# UNPACK #-} !Int (Map e (Trie e)) -- Edge xs n m represents n occurrences of xs, and xs prepended to each element of the map.
-		deriving (Eq)
-type MTrie e = Maybe (Trie e)
-newtype TrieQueue e = TQ (HeapQ (Trie e)) deriving (Eq, Show, Monoid)
+-- On the back end it uses something called a /monoid queue/,
+-- which takes ordered keys associated with monoid values and returns (k, m') pairs where m' is the concatenation of every monoid value associated with k,
+-- with no guarantees made upon the order of the concatenation.  Essentially, it is a priority queue which internally "merges" values with equal keys.
+-- See Data.Queue.TrieQueue.MonoidQueue for details and a list of alternative implementations.
 
-{-# INLINE mkTQ #-}
-mkTQ :: Int -> Trie e -> TrieQueue e
-mkTQ n t = TQ (HQ n (Just t))
+-- After some experimentation, trie edge labels are currently implemented as vanilla lists; however, the implementation is modularized in
+-- Data.Queue.TrieQueue.EdgeLabel.  (Other possible implementations include mergeable deques and Data.Sequence finger trees.)
 
-mkLab :: [e] -> Label e
-mkLab = Seq.fromList
+-- A trie, now, consists of an edge label xs, the number of strings ending with that label, and a monoid queue associating characters in the string to
+-- tries consisting of strings prefixed by that character.  This is the key variation in this implementation, and it exploits the fact that
+-- random-access string lookup is not required in a priority queue: only extract-min and insert, operations perfectly well suited to a monoid queue.
+-- Note that the monoid values in the monoid queue are themselves tries, which get recursively merged as necessary.
 
-instance Show e => Show (Trie e) where
-	show (Leaf xs xn) = "(" ++ show xn ++ "x" ++ show (Fold.toList xs) ++ ")"
-	show (Edge xs xn m) = "==" ++ show xn ++ "x" ++ show (Fold.toList xs) ++ "==>" ++ show m
+data Trie e = Trie (Label e) {-# UNPACK #-} !Int (MQueue e (Trie e)) deriving (Show)
+data TrieQueue e = TQ Int (Maybe (Trie e)) deriving (Show)
 
+-- This monoid instance can now get exploited for great justice by the monoid queue.
 instance Ord e => Monoid (Trie e) where
-	-- not a true monoid instance; only a semigroup
-	mappend = merger
+	mempty = Trie mempty 0 mempty
+	mappend = mergeTrie
+	mconcat = fromMaybe mempty . mergeTries
 
-instance Ord e => IQueue (TrieQueue e) where
-	type QueueKey (TrieQueue e) = [e]
-	empty = mempty
-	merge = mappend
-	mergeAll = mconcat
+{-# INLINE forceOrd #-}
+forceOrd :: Ord e => Trie e -> x -> x
+forceOrd t x = cmp t `seq` x where
+	cmp :: Ord e => Trie e -> (e -> e -> Ordering)
+	cmp _ = compare
 
-	singleton xs = mkTQ 1 $ Leaf (mkLab xs) 1
---	fromList = TQ . liftM2 HQ length trieFromList
+catTrie :: Ord e => Label e -> Trie e -> Trie e
+xs `catTrie` Trie ys yn yQ = Trie (xs `mappend` ys) yn yQ
 
-	extract (TQ (HQ n t)) = fmap ((Fold.toList *** (TQ . HQ (n-1))) . extractMin') t
-	size (TQ (HQ n _)) = n
+consTrie :: Ord e => e -> Trie e -> Trie e
+x `consTrie` Trie xs xn xQ = Trie (x `cons` xs) xn xQ
 
-catTrie :: Ord e => Label e -> Trie e -> Trie e
-catTrie xs (Leaf ys n) = Leaf (xs >< ys) n
-catTrie xs (Edge ys n m) = compactTrie (Edge (xs >< ys) n m)
+mergeTrie :: Ord e => Trie e -> Trie e -> Trie e
+xT@(Trie xs0 xn xQ) `mergeTrie` yT@(Trie ys0 yn yQ) = merging xs0 ys0 split (tail xT yT) (tail yT xT) xy where
+	end (Trie _ xn xQ) x xs = x :- Trie xs xn xQ
+	split pfx x xs y ys = let xEnd = end xT x xs; yEnd = end yT y ys in Trie pfx 0 (xEnd `insert` singleton yEnd)
+	tail (Trie xs xn xQ) yT y ys = let yEnd = end yT y ys in Trie xs xn (yEnd `insert` xQ)
+	xy = Trie xs0 (xn + yn) (xQ `merge` yQ)
 
-compactTrie :: Ord e => Trie e -> Trie e
-compactTrie = fromJust . compactTrie'
+{-# INLINE compactTrie #-}
+compactTrie :: Ord e => Trie e -> Maybe (Trie e)
+compactTrie (Trie xs 0 xQ)
+	| null xQ	= Nothing
+	| Just (y :- t) <- extractSingle xQ
+			= Just (xs `catTrie` (y `consTrie` t))
+compactTrie t = Just t
 
-compactTrie' :: Ord e => Trie e -> MTrie e
-compactTrie' t@(Edge xs 0 m)
-	| Map.null m	= Nothing
-	| Map.size m == 1, (y, yT) <- findMin m
-			= Just $ catTrie (xs |> y) yT
-	| otherwise	= Just t
-compactTrie' (Edge xs n m)
-	| Map.null m	= Just $ Leaf xs n
-compactTrie' (Leaf _ 0) = Nothing
-compactTrie' t = Just t
+data Acc e = A {-# UNPACK #-} !Int e
 
+-- Note that a monoid queue is built up and (sometimes) torn down for each character.  If every label on every trie being merged matches
+-- on the first character, then the monoid queue simply automatically becomes a singleton, a case handled by compactTrie with a specialized
+-- implementation based on extractSingle.  If the labels do not match, or there are tries being merged with empty labels,
+-- then the monoid queue is exactly what we needed anyway.
+mergeTries :: Ord e => [Trie e] -> Maybe (Trie e)
+mergeTries ts0 = compactTrie (Trie mempty nEmpty ([x :- Trie xs xn xQ | Trie (x:xs) xn xQ <- ts0] `insertAll` mergeAll qs))
+	where	A nEmpty qs = foldr procEmpty (A 0 []) ts0
+		procEmpty (Trie [] n q) (A nEmpty qs) = A (n + nEmpty) (q:qs)
+		procEmpty _ acc = acc 
+--mergeTries = fusing' mergeTrie
 
-extractMin' :: Ord e => Trie e -> (Label e, MTrie e)
-extractMin' (Leaf xs n) = (xs, compactTrie' (Leaf xs (n-1)))
-extractMin' (Edge xs (n+1) m) = (xs, compactTrie' (Edge xs n m))
-extractMin' (Edge xs 0 m)
-	| Just ((y, yT), m') <- minViewWithKey m,
-		(ys, yT') <- extractMin' yT
-	= (xs >< (y <| ys), maybe (compactTrie' (Edge xs 0 m')) (\ yT' -> Just $ Edge xs 0 $ Map.insert y yT' m') yT')
-extractMin' _ = error "Internal failure to note empty queue"
+{-# INLINE fin #-}
+fin :: Ord e => Trie e -> Maybe (Trie e)
+fin (Trie _ 0 q) | null q = Nothing
+fin t = Just t
 
---extractMin :: Ord e => Trie e -> Maybe ([e], Trie e)
---extractMin = fmap (first toList) . extractMin'
+-- If there are strings ending at this label, we obviously process those.  Otherwise, we recurse to the first hanging trie from the monoid queue.
+-- If it is not exhausted, then we can simply replace the value in the monoid queue; if it is exhausted we may possibly compact the trie
+-- (e.g. if there is now only one child trie and we may in fact combine those edges).
+extractTrie :: Ord e => Trie e -> (Label e, Maybe (Trie e))
+extractTrie (Trie xs (n+1) xQ) = (xs, inline compactTrie (Trie xs n xQ))
+extractTrie (Trie xs 0 xQ)
+	| Just (y :- t, xQ') <- extract xQ, (ys, t') <- extractTrie t
+		= (xs `mappend` (y `cons` ys), case t' of
+			Nothing	-> inline compactTrie (Trie xs 0 xQ')
+			Just t'	-> fin (Trie xs 0 $ replace (y :- t') xQ))
+extractTrie _ = error "Failure to detect empty queue"
 
-type TailMaker e = Label e -> Trie e
+instance Ord e => Monoid (TrieQueue e) where
+	mempty = TQ 0 Nothing
+	TQ n1 t1 `mappend` TQ n2 t2 = TQ (n1 + n2) (t1 `mappend` t2)
+	mconcat ts = TQ (sum [n | TQ n _ <- ts]) (mergeTries [t | TQ _ (Just t) <- ts])
 
-{-# INLINE merge' #-}
-merge' :: Ord e => Label e -> Label e -> TailMaker e -> TailMaker e -> (e -> TailMaker e) -> (e -> TailMaker e) -> Trie e -> Trie e
-merge' xs0 ys0 xTail yTail xCons yCons xy = merge'' 0 xs0 ys0 where
-	merge'' n xs ys = case (viewl xs, viewl ys) of
-		(x :< xs1, y :< ys1) -> let pfx = Seq.take n xs0; xT = xTail xs1; yT = yTail ys1; in case x `compare` y of
-			LT	-> Edge pfx 0 $ fromDistinctAscList [(x, xT), (y, yT)]
-			EQ	-> merge'' (n+1) xs1 ys1
-			GT	-> Edge pfx 0 $ fromDistinctAscList [(y, yT), (x, xT)]
-		(x :< xs1, EmptyL)	-> yCons x xs1
-		(EmptyL, y :< ys1)	-> xCons y ys1
-		(EmptyL, EmptyL)	-> xy
+instance Ord e => IQueue (TrieQueue e) where
+	type QueueKey (TrieQueue e) = [e]
+	empty = mempty
+	merge = mappend
+	mergeAll = mconcat
 	
-merger :: Ord e => Trie e -> Trie e -> Trie e	
-Leaf xs0 xn `merger` Leaf ys0 yn =
-	merge' xs0 ys0 (flip Leaf xn) (flip Leaf yn) (edger xs0 xn yn) (edger ys0 yn xn) (Leaf xs0 (xn + yn))
-	where	edger xs xn yn y ys = Edge xs xn $ Map.singleton y (Leaf ys yn)
-Leaf xs0 xn `merger` Edge ys0 yn yM =
-	merge' xs0 ys0 (flip Leaf xn) (\ ys -> Edge ys yn yM) (\ y ys -> Edge xs0 xn $ Map.singleton y (Edge ys yn yM))
-		(\ x xs -> Edge ys0 yn $ Map.insertWith merger x (Leaf xs xn) yM) (Edge xs0 (xn + yn) yM)
-x@Edge{} `merger` y@Leaf{} = merger y x
-Edge xs0 xn xM `merger` Edge ys0 yn yM
-	= merge' xs0 ys0 (edger xn xM) (edger yn yM) (cons xs0 xn yn yM) (cons ys0 yn xn xM)
-			(Edge xs0 (xn + yn) $ Map.unionWith merger xM yM)
-	where	edger n m l = Edge l n m
-		cons xs xn yn yM y = Edge xs xn . Map.singleton y . edger yn yM
+	singleton = TQ 1 . Just . single
+	insertAll = mappend . fromListTrie
+	fromList = fromListTrie
 
-trieFromList :: Ord e => [[e]] -> MTrie e
-trieFromList = extractCommon mempty
-	where	groupHeads = groupBy ((==) `on` listToMaybe) . sortBy (comparing listToMaybe)
-		extractCommon pfx xs = case groupHeads xs of
-			[]			-> Nothing
-			[empties@([]:_)]	-> Just $ Leaf pfx (length empties)
-			(empties@([]:_):xss)	-> Just $ Edge pfx (length empties) (fromGroups xss)
-				-- even if there's only one other group, we end the edge here
-				-- a more optimized implementation might specialize for this case
-			[(y:ys):yss]		-> extractCommon (pfx |> y) (ys:map tail yss)
-				-- if there's but a single group with a shared first character, snoc it onto the accumulated prefix
-				-- and recurse
-			xss			-> Just $ Edge pfx 0 (fromGroups xss)
-		fromGroups xss = fromDistinctAscList [(y, fromJust $ trieFromList $ ys : map tail yss) | ((y:ys):yss) <- xss]
+	extract (TQ n t) = fmap ((labelToList *** TQ (n-1)) . extractTrie) t
+	null (TQ _ Nothing) = True
+	null _ = False
+
+	size (TQ n _) = n
+
+fromListTrie :: Ord e => [[e]] -> TrieQueue e
+fromListTrie = liftM2 TQ length (mergeTries . map single)
+
+single :: Ord e => [e] -> Trie e
+single xs = Trie (labelFromList xs) 1 mempty
diff --git a/Data/Queue/TrieQueue/Edge.hs b/Data/Queue/TrieQueue/Edge.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/TrieQueue/Edge.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE TypeFamilies, TypeOperators #-}
+
+-- | As simple as it looks: an edge type constructor that performs comparisons only on its key.
+module Data.Queue.TrieQueue.Edge ((:-)(..)) where
+
+data k :- m = k :- m deriving (Show)
+
+instance Eq k => Eq (k :- m) where
+	(x :- _) == (y :- _) = x == y
+
+instance Ord k => Ord (k :- m) where
+	(x :- _) `compare` (y :- _) = x `compare` y
+	(x :- _) <= (y :- _) = x <= y
+
diff --git a/Data/Queue/TrieQueue/MonoidQueue.hs b/Data/Queue/TrieQueue/MonoidQueue.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/TrieQueue/MonoidQueue.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE TypeFamilies, TypeOperators, PatternGuards #-}
+{-# OPTIONS -fno-warn-missing-methods #-}
+
+{- |
+This module implements the functionality of a /monoid queue/, which is essentially a priority queue that merges values with equal keys.  Several implementations were considered:
+
+* A pairing heap which, as part of its merging operation, merges any identical-keyed values it encounters.  This may result in partial merging of equal-keyed values for several different keys
+	during a single delete-min operation, decreasing the number of nodes in the queue without costing any additional comparisons.  In addition, it naturally falls out that
+	the values associated with the minimum key are always fully merged.  Disadvantages include no control over the balancedness of complete merges, and possible extra polymorphism overhead.
+* This considerably simpler bootstrap on a vanilla @PQueue@, which keeps the totally merged value associated with its very minimum key and performs no partial merging until a
+	key becomes the minimum. (The fact that no partial merging is performed allows an optimized and balanced 'mconcat' to be used on all the values associated with a key at once.)
+
+The primary difference between these two is the compromise between /performance of the heap itself/ and /performance of the merging of the monoids/:
+	* The first implementation speculatively takes advantage of opportunities to merge nodes with equal keys.  No actual extra work is being done -- the same number of comparisons
+		is made, and the actual merging is performed lazily.  As a result, truly the only disadvantages of this approach are the completely uncontrolled balance of the merges,
+		and possible polymorphism overhead that can be carefully hand-removed.
+	* The second implementation allows an optimized bulk merge operation, which -- in the case of tries, which is what after all the motivation for this structure --
+		has extremely significant advantages.
+
+A version of the second implementation is included with the Cabal distribution in 
+"Data.Queue.TrieQueue.MonoidQueue2", and can serve as a literal drop-in replacement for this module.
+See its implementation notes for further details.
+
+-}
+module Data.Queue.TrieQueue.MonoidQueue (MQueue, extractSingle, replace) where
+
+import Data.Queue.Class
+import Data.Queue.QueueHelpers(fusing')
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Tree as Tree
+
+import Data.Queue.TrieQueue.Edge
+
+-- | A pairing heap node in the monoid queue; nonempty.
+data MNode k m = Node k m (MForest k m)
+type MForest k m = [MNode k m]
+-- | A full-fledged priority queue, including empty queues.
+newtype MQueue k m = MQ (Maybe (MNode k m)) deriving (Show)
+
+instance (Show k, Show m) => Show (MNode k m) where
+	show = Tree.drawTree . Tree.unfoldTree (\ (Node k m ts) -> (show (k :- m), ts))
+
+-- | A @Functor@ instance exploited for great justice in @mergeNodes@.
+instance Functor (MNode k) where
+	fmap f (Node k m ns) = Node k (f m) (map (fmap f) ns)
+
+instance (Ord k, Monoid m) => Monoid (MNode k m) where
+	-- no mempty declaration
+	mappend = mergeMNode $! mappend
+
+instance (Ord k, Monoid m) => Monoid (MQueue k m) where
+	mempty = MQ Nothing
+	MQ n1 `mappend` MQ n2 = MQ (n1 `mappend` n2)
+	 -- This is the straightforward implementation:
+	 -- mconcat qs = MQ $ fusing [n | MQ (Just n) <- qs]
+	 -- This implementation allows optimized mass mconcats rather than just using individual mappends,
+	 -- and exploits the flexible monoid structure.
+	mconcat qs = mergeNodes [n | MQ (Just n) <- qs]
+
+
+mergeMNode :: Ord k => (m -> m -> m) -> MNode k m -> MNode k m -> MNode k m
+mergeMNode (><) n1@(Node k1 m1 ns1) n2@(Node k2 m2 ns2) = case compare k1 k2 of
+	LT	-> Node k1 m1 (n2:ns1)
+	EQ	-> Node k1 (m1 >< m2) (ns1 ++ ns2)
+	GT	-> Node k2 m2 (n1:ns2)
+
+{-# INLINE mergeNodes' #-}
+-- | Merges a collection of nodes by performing a balanced fuse and performing an mconcat on all blocks of equal-keyed monoid values.
+mergeNodes' :: (Ord k) => (k -> k -> Ordering) -> (m -> m -> m) -> MForest k m -> MQueue k m
+--mergeNodes ns = MQ (fmap (fmap mconcat) $ fusing (map (fmap $ \ m -> [m]) ns))
+mergeNodes' _ (><) = MQ . fusing' (mergeMNode (><))
+
+{-# INLINE mergeNodes #-}
+mergeNodes :: (Ord k, Monoid m) => MForest k m -> MQueue k m
+mergeNodes = (mergeNodes' $! compare) $! mappend
+
+instance (Ord k, Monoid m) => IQueue (MQueue k m) where
+	type QueueKey (MQueue k m) = k :- m
+	empty = mempty
+	merge = mappend
+	mergeAll = mconcat
+
+	singleton (k :- m) = MQ (Just (Node k m []))
+	insertAll = merge . fromListMQ
+	fromList = fromListMQ
+	extract = extractMQ
+
+	null (MQ Nothing) = True
+	null _ = False
+
+{-# INLINE single #-}
+single :: k :- m -> MNode k m
+single (k :- m) = Node k m []
+
+extractMQ :: (Ord k, Monoid m) => MQueue k m -> Maybe (k :- m, MQueue k m)
+extractMQ (MQ t) = fmap extract' t where
+	extract' (Node k m ns) = (k :- m, mergeNodes ns)
+
+fromListMQ :: (Ord k, Monoid m) => [k :- m] -> MQueue k m
+fromListMQ ks = mergeNodes $ map single ks
+
+{-# INLINE extractSingle #-}
+extractSingle :: (Ord k, Monoid m) => MQueue k m -> Maybe (k :- m)
+extractSingle (MQ (Just (Node k m []))) = Just (k :- m)
+extractSingle _ = Nothing
+
+-- UNSAFE.  Do not use unless you know the key you're putting in is less than or equal to the minimum key.
+replace :: (Ord k, Monoid m) => (k :- m) -> MQueue k m -> MQueue k m
+replace km@(k :- m) (MQ t) = MQ $ Just (maybe (single km) (\ (Node _ _ ns) -> Node k m ns) t)
+
diff --git a/Data/Queue/TrieQueue/MonoidQueue2.hs b/Data/Queue/TrieQueue/MonoidQueue2.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/TrieQueue/MonoidQueue2.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE TypeFamilies, TypeOperators, PatternGuards #-}
+
+module Data.Queue.TrieQueue.MonoidQueue2 (MQueue, extractSingle, replace) where
+
+import Data.Queue.PQueue
+import Data.Queue.Class
+import Data.Queue.QueueHelpers (fusing, fusing')
+
+import Data.Queue.TrieQueue.Edge
+
+import Data.Maybe
+import Data.Monoid
+import Prelude hiding (null)
+
+data MQueue k m = Nil | MQ {-# UNPACK #-} !(k :- m) {-# UNPACK #-} !(PQueue (k :- m)) deriving (Show)
+
+instance (Ord k, Monoid m) => Monoid (MQueue k m) where
+	mempty = Nil
+	mappend = mergeMQ
+{-
+Here we organize on the queues themselves.  We require that fromList not be defined in terms of mergeAll, of course -- in fact, if it is defined using toQueue as it is below,
+this gives us the best of both worlds -- balanced merging both on the values associated with the minimum key (provided by fromList), and balanced merging on the remaining queues.
+We lose some partial merging opportunities, but this implementation does none, so that's not an issue.
+-}
+	mconcat qs = case mkMQueue [k :- (m, q) | MQ (k :- m) q <- qs] of
+		Nil	-> Nil
+		MQ (k :- (m, pq)) qOfMQs -> 
+			let q' = pq `merge` mergeAll 
+					[(k :- m) `insert` q | k :- (m, q) <- toList_ qOfMQs]
+				in MQ (k :- m) q'
+		where	mkMQueue :: (Ord k, Monoid m) => [k :- m] -> MQueue k m
+			mkMQueue = fromList
+
+--	mconcat = fromMaybe Nil . fusing' mergeMQ
+
+mergeMQ' :: Ord k => (k -> k -> Ordering) -> (m -> m -> m) -> MQueue k m -> MQueue k m -> MQueue k m
+mergeMQ' cmp (><) (MQ x1@(k1 :- m1) q1) (MQ x2@(k2 :- m2) q2) = case cmp k1 k2 of
+	LT	-> MQ x1 (x2 `insert` q)
+	EQ	-> MQ (k1 :- (m1 >< m2)) q
+	GT	-> MQ x2 (x1 `insert` q)
+	where	q = q1 `merge` q2
+mergeMQ' _ _ q Nil = q
+mergeMQ' _ _ Nil q = q
+
+mergeMQ :: (Ord k, Monoid m) => MQueue k m -> MQueue k m -> MQueue k m
+mergeMQ = mergeMQ' compare mappend
+
+instance (Ord k, Monoid m) => IQueue (MQueue k m) where
+	type QueueKey (MQueue k m) = (k :- m)
+	empty = Nil
+	singleton = (`MQ` empty)
+	fromList = toQueue . fromList
+
+	merge = mappend
+	mergeAll = mconcat
+
+	null Nil = True
+	null _ = False
+	
+	extract Nil = Nothing
+	extract (MQ x q) = Just (x, toQueue q)
+
+	toList_ Nil = []
+	toList_ (MQ x q) = x:toList_ q
+
+-- This version ignores balancing and does a totally simple merge on values with the minimal key in common.
+toQueue :: (Ord k, Monoid m) => PQueue (k :- m) -> MQueue k m
+toQueue q = case extract q of
+	Nothing		-> Nil
+	Just (k :- m, q') -> let toQueue' ms q = case extract q of	Just (k' :- m', q')
+										| k == k'	-> toQueue' (m':ms) q'
+--									_			-> MQ (k :- maybe m (mappend m) (fusing ms)) q
+									_	| [] <- ms	-> MQ (k :- m) q
+										| otherwise	-> MQ (k :- (m `mappend` mconcat ms)) q
+					in toQueue' [] q'
+
+extractSingle :: Ord k => MQueue k m -> Maybe (k :- m)
+extractSingle (MQ x q)
+	| null q	= Just x
+extractSingle _ = Nothing
+
+replace :: (Ord k, Monoid m) => (k :- m) -> MQueue k m -> MQueue k m
+replace (k :- m) (MQ _ q) = MQ (k :- m) q
+replace _ Nil = error "Attempt to modify head of an empty queue"
diff --git a/Data/Queue/TrieQueue/TrieLabel.hs b/Data/Queue/TrieQueue/TrieLabel.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/TrieQueue/TrieLabel.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module Data.Queue.TrieQueue.TrieLabel where
+
+import Data.Sequence (Seq, ViewL(..), viewl, (><), (<|), (|>))
+import qualified Data.Sequence as Seq
+import qualified Data.Foldable as Fold
+
+type Split e x = Label e	-- ^ common prefix
+		-> e -> Label e	-- ^ truncated suffix of xs
+		-> e -> Label e	-- ^ truncated suffix of xs
+		-> x		-- ^ split trie
+
+type Tail e x = e -> Label e	-- left over suffix
+		-> x		-- trie
+
+
+{-# INLINE merging #-}
+-- | Performs partial matching of two labels and applies an appropriate function upon completing a partial match.
+merging :: Eq e => Label e		-- ^ A label, @xs@.
+			-> Label e	-- ^ A label, @ys@.
+			-> Split e x	-- ^ A function to be applied when the two strings share some (possibly empty) common prefix and mismatchng tails.
+			-> Tail e x	-- ^ A function to be applied when @xs@ is a prefix of @ys@.
+			-> Tail e x 	-- ^ A function to be applied when @ys@ is a prefix of @xs@.
+			-> x		-- ^ A value to be returned when @xs == ys@.
+			-> x
+
+cons :: e -> Label e -> Label e
+
+labelToList :: Label e -> [e]
+
+labelFromList :: [e] -> Label e
+
+merging xs0 ys0 split xEnd yEnd xy = merging' 0 xs0 ys0 where
+	merging' n xs ys = let pfx = take n xs0 in case (xs, ys) of
+		(x:xs, y:ys)	| x == y	-> merging' (n+1) xs ys
+				| otherwise	-> split pfx x xs y ys
+		(x:xs, [])			-> yEnd x xs
+		([], y:ys)			-> xEnd y ys
+		([], [])			-> xy
+type Label e = [e]
+
+cons = (:)
+labelToList = id
+labelFromList = id
+{-
+
+type Label e = Seq e
+
+merging xs0 ys0 split xEnd yEnd xy = merging' 0 (Fold.toList xs0) (Fold.toList ys0) where
+	merging' n xs ys = let n' = n + 1; (pfx, xT0) = Seq.splitAt n xs0; _ :< xT = viewl xT0; yT = Seq.drop n' ys0 in case (xs, ys) of
+		(x:xs, y:ys)	| x == y	-> merging' n' xs ys
+				| otherwise	-> split pfx x xT y yT
+		(x:xs, [])			-> yEnd x xT
+		([], y:ys)			-> xEnd y yT
+		([], [])			-> xy
+
+cons = (<|)
+
+labelToList = Fold.toList
+
+labelFromList = Seq.fromList
+-}
+
+testMerging :: (Eq e, Show e) => Label e -> Label e -> String
+testMerging xs0 ys0 = merging xs0 ys0 (\ pfx x xs y ys -> "Split " ++ show pfx ++ " (" ++ show x ++ " -> " ++ show xs ++ ") (" ++ show y ++ " -> " ++ show ys ++ ")")
+				(\ y ys -> "Break " ++ show xs0 ++ " = " ++ show y ++ " -> " ++ show ys)
+				(\ x xs -> "Break " ++ show ys0 ++ " = " ++ show x ++ " -> " ++ show xs)
+				("Equal " ++ show xs0)
diff --git a/queuelike.cabal b/queuelike.cabal
--- a/queuelike.cabal
+++ b/queuelike.cabal
@@ -1,7 +1,8 @@
 name:		queuelike
-version:	1.0.5
+version:	1.0.6
 synopsis:	A library of queuelike data structures, both functional and stateful.
 description:	Contains several implementations of data structures implementing a /single-in, single-out/ paradigm.  Intended to be a better, more useful replacement for pqueue-mtl.
+		In particular, includes an experimental and possibly genuinely new trie-based priority queue on strings.  Feedback is appreciated.
 tested-with:	GHC
 category:	Algorithms
 stability:	experimental
@@ -10,7 +11,7 @@
 license-file:	LICENSE
 author:		Louis Wasserman
 maintainer:	wasserman.louis@gmail.com
-build-Depends:	base, containers, mtl, array, stateful-mtl >= 1.0.7, utility-ht
+build-Depends:	base, containers, mtl, array, stateful-mtl >= 1.0.7
 build-type:	Simple
 Exposed-modules:
 	Data.Queue
@@ -20,9 +21,6 @@
 	Data.Queue.Stack
 	Data.Queue.Queue
 	Data.Queue.TrieQueue
---	Data.Queue.SkewQueue
---	Data.Queue.SoftHeap
---	Data.Queue.IntQueue
 	Data.MQueue.Class
 	Data.MQueue.Heap
 	Data.MQueue.SyncQueue
@@ -30,6 +28,10 @@
 	Data.MQueue
 other-modules: 
 	Data.Queue.QueueHelpers
+	Data.Queue.TrieQueue.Edge
+	Data.Queue.TrieQueue.MonoidQueue
+	Data.Queue.TrieQueue.TrieLabel
 	Data.MQueue.MonadHelpers
---	Data.Queue.Numeric
+extra-source-files:
+	Data/Queue/TrieQueue/MonoidQueue2.hs
 ghc-options: