Proposal: Significant performance improvements for Data.Map

Ian Lynagh igloo at earth.li
Fri Sep 3 11:07:35 EDT 2010


On Sun, Aug 29, 2010 at 06:15:45AM -0700, Donald Bruce Stewart wrote:
> 
> +#if !defined(TESTING)
>                Map          -- instance Eq,Show,Read
> hunk ./Data/Map.hs 45
> +#else
> +              Map(..)          -- instance Eq,Show,Read
> +#endif

I think it would be cleaner, and more standard, to move the type (and
any other internals necessary) into a Data.Map.Internals module which
exports the constructors, to export it abstractly from Data.Map, and
have the tests import the Internals module.

> +test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]

Is there something special about this, or is it just random?

> +    --         , testProperty "insert then delete"   prop_insertDelete
> +    --         , testProperty "insert then delete2"  prop_insertDelete2

Why are some tests, such as those above, commented out?

Also, could the tests module be made -Wall clean, and compiled with
-Wall? That way it is harder to accidentally not run a test, by defining
it but not adding it to the list of tests.

> +{-# DEPRECATED fold "Use foldrWithKey instead" #-}
> +{-# DEPRECATED foldWithKey "Use foldrWithKey instead" #-}

I didn't expect to see DEPRECATED pragmas being added in the middle of a
patch called "Performance improvements to Data.Map"!

Why have these been deprecated?

> +{-
> +-- | /O(log n)/. A strict version of 'insertLookupWithKey'.
> +insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k
> a
> +                     -> (Maybe a, Map k a)
> +insertLookupWithKey' f kx x = kx `seq` go
> +  where
> +    go Tip = x `seq` (Nothing, singleton kx x)
> +    go (Bin sy ky y l r) =
> +        case compare kx ky of
> +            LT -> let (found, l') = go l
> +                  in (found, balance ky y l' r)
> +            GT -> let (found, r') = go r
> +                  in (found, balance ky y l r')
> +            EQ -> let x' = f kx x y in x' `seq` (Just y, Bin sy kx x' l
> r)
> +{-# INLINE insertLookupWithKey' #-}
> +-}

Why has this new function been added, but commented out?

> +{-
> +-- | /O(n)/. A strict version of 'foldlWithKey'.
> +foldlWithKey' :: (b -> k -> a -> b) -> b -> Map k a -> b
> +foldlWithKey' f = go
> +  where
> +    go z Tip              = z
> +    go z (Bin _ kx x l r) = z `seq` go (f (go z l) kx x) r
> +{-# INLINE foldlWithKey' #-}
> +-}

Ditto.


Thanks
Ian



More information about the Libraries mailing list