WIP: NonEmptySet and NonEmptyMap

containers-tests/benchmarks/LookupGE/LookupGE_Map.hs

@@ -14,11 +14,11 @@ lookupGE2 :: Ord k => k -> Map k a -> Maybe (k,a)
 lookupGE2 = go
   where
     go !_ Tip = Nothing
-    go !k (Bin _ kx x l r) =
+    go !k (NE (Bin' _ kx x l r)) =
         case compare k kx of
             LT -> case go k l of
                     Nothing -> Just (kx,x)
-                    ret -> ret
+                    ret     -> ret
             GT -> go k r
             EQ -> Just (kx,x)
 {-# INLINABLE lookupGE2 #-}
@@ -27,7 +27,7 @@ lookupGE3 :: Ord k => k -> Map k a -> Maybe (k,a)
 lookupGE3 = go Nothing
   where
     go def !_ Tip = def
-    go def !k (Bin _ kx x l r) =
+    go def !k (NE (Bin' _ kx x l r)) =
         case compare k kx of
             LT -> go (Just (kx,x)) k l
             GT -> go def k r
@@ -38,26 +38,26 @@ lookupGE4 :: Ord k => k -> Map k a -> Maybe (k,a)
 lookupGE4 k = k `seq` goNothing
   where
     goNothing Tip = Nothing
-    goNothing (Bin _ kx x l r) = case compare k kx of
-                                   LT -> goJust kx x l
-                                   EQ -> Just (kx, x)
-                                   GT -> goNothing r
+    goNothing (NE (Bin' _ kx x l r)) = case compare k kx of
+        LT -> goJust kx x l
+        EQ -> Just (kx, x)
+        GT -> goNothing r
 
     goJust ky y Tip = Just (ky, y)
-    goJust ky y (Bin _ kx x l r) = case compare k kx of
-                                     LT -> goJust kx x l
-                                     EQ -> Just (kx, x)
-                                     GT -> goJust ky y r
+    goJust ky y (NE (Bin' _ kx x l r)) = case compare k kx of
+        LT -> goJust kx x l
+        EQ -> Just (kx, x)
+        GT -> goJust ky y r
 {-# INLINABLE lookupGE4 #-}
 
 -------------------------------------------------------------------------------
 -- Utilities
 -------------------------------------------------------------------------------
 
 findMinMaybe :: Map k a -> Maybe (k,a)
-findMinMaybe (Bin _ kx x Tip _)  = Just (kx,x)
-findMinMaybe (Bin _ _  _ l _)    = findMinMaybe l
-findMinMaybe Tip                 = Nothing
+findMinMaybe (NE (Bin' _ kx x Tip _)) = Just (kx,x)
+findMinMaybe (NE (Bin' _ _  _ l _))   = findMinMaybe l
+findMinMaybe Tip                      = Nothing
 
 #ifdef TESTING
 -------------------------------------------------------------------------------

containers-tests/tests/map-properties.hs

@@ -7,7 +7,7 @@ import Data.Map.Merge.Strict
 import Data.Map.Lazy as Data.Map hiding (showTree, showTreeWith)
 import Data.Map.Merge.Lazy
 #endif
-import Data.Map.Internal (Map (..), link2, link, bin)
+import Data.Map.Internal (Map (..), NonEmptyMap(..), link2, link, bin)
 import Data.Map.Internal.Debug (showTree, showTreeWith, balanced)
 
 import Control.Applicative (Const(Const, getConst), pure, (<$>), (<*>))
@@ -332,15 +332,15 @@ mkArb step n
      vOuter <- liftGen arbitrary
      vInner <- liftGen arbitrary
      if dir
-       then return (Bin 2 q vOuter (singleton p vInner) Tip)
-       else return (Bin 2 p vOuter Tip (singleton q vInner))
+       then return (NE (Bin' 2 q vOuter (singleton p vInner) Tip))
+       else return (NE (Bin' 2 p vOuter Tip (singleton q vInner)))
   | otherwise = do
       -- This assumes a balance factor of delta = 3
       let upper = (3*(n - 1)) `quot` 4
       let lower = (n + 2) `quot` 4
       ln <- liftGen $ choose (lower, upper)
       let rn = n - ln - 1
-      liftM4 (\lt x v rt -> Bin n x v lt rt) (mkArb step ln) step (liftGen arbitrary) (mkArb step rn)
+      liftM4 (\lt x v rt -> NE (Bin' n x v lt rt)) (mkArb step ln) step (liftGen arbitrary) (mkArb step rn)
 
 -- A type with a peculiar Eq instance designed to make sure keys
 -- come from where they're supposed to.

containers-tests/tests/set-properties.hs

@@ -247,15 +247,15 @@ mkArb step n
      p <- step
      q <- step
      if dir
-       then return (Bin 2 q (singleton p) Tip)
-       else return (Bin 2 p Tip (singleton q))
+       then return (NE $ Bin' 2 q (singleton p) Tip)
+       else return (NE $ Bin' 2 p Tip (singleton q))
   | otherwise = do
       -- This assumes a balance factor of delta = 3
       let upper = (3*(n - 1)) `quot` 4
       let lower = (n + 2) `quot` 4
       ln <- liftGen $ choose (lower, upper)
       let rn = n - ln - 1
-      liftM3 (\lt x rt -> Bin n x lt rt) (mkArb step ln) step (mkArb step rn)
+      liftM3 (\lt x rt -> NE $ Bin' n x lt rt) (mkArb step ln) step (mkArb step rn)
 
 -- | Given a strictly increasing list of elements, produce an arbitrarily
 -- shaped set with exactly those elements.