Switched PSQueue to psqueues for strict spine.

1 files changed, 41 insertions, 0 deletions

diff --git a/src/Data/Wrapper/PSQ.hs b/src/Data/Wrapper/PSQ.hs
new file mode 100644
index 00000000..e8fa2d98
--- /dev/null
+++ b/src/Data/Wrapper/PSQ.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE CPP #-}
+module Data.Wrapper.PSQ
+#if 0
+     ( module Data.PSQueue ) where ; import Data.PSQueue
+#else
+    ( module Data.Wrapper.PSQ , module OrdPSQ ) where
+
+import Data.OrdPSQ as OrdPSQ hiding (insert, map, singleton, minView)
+import qualified Data.OrdPSQ as OrdPSQ
+
+type PSQ k p = OrdPSQ k p ()
+type Binding k p = (k,p,())
+
+pattern (:->) :: k -> p -> Binding k p
+pattern k :-> p <- (k,p,()) where k :-> p = (k,p,())
+
+key :: Binding k v -> k
+key (k,p,v) = k
+{-# INLINE key #-}
+
+insert :: (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
+insert k p q = OrdPSQ.insert k p () q
+{-# INLINE insert #-}
+
+insertWith :: (Ord k, Ord p) => (p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
+insertWith f k p0 q = snd $ OrdPSQ.alter f' k q
+ where
+    f' (Just (p,())) = ((),Just (f p0 p, ()))
+    f' Nothing      = ((),Nothing)
+{-# INLINE insertWith #-}
+
+singleton :: (Ord k, Ord p) => k -> p -> PSQ k p
+singleton k p = OrdPSQ.singleton k p ()
+{-# INLINE singleton #-}
+
+minView :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p, PSQ k p)
+minView q = fmap (\(k,p,(),q') -> (k :-> p, q')) $ OrdPSQ.minView q
+{-# INLINE minView #-}
+
+#endif