Proposal: Significant performance improvements for Data.Map

Johan Tibell johan.tibell at gmail.com
Fri Sep 3 12:04:21 EDT 2010


On Fri, Sep 3, 2010 at 5:07 PM, Ian Lynagh <igloo at earth.li> wrote:

> On Sun, Aug 29, 2010 at 06:15:45AM -0700, Donald Bruce Stewart wrote:
> 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.
>

If the proposal is accepted we can -Wall clean the code before submitting.


> > +{-# 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?
>

They were already deprecated in the Haddock comments so I took the liberty
to add a deprecate pragma. If people disagree with this we could remove
them.


> > +{-
> > +-- | /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?
>

These should have been in a separate patch (see separate ticket for adding
those).

-- Johan
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/libraries/attachments/20100903/ce087ea7/attachment.html


More information about the Libraries mailing list