Misleading strictness annotations in Data.List.NonEmpty
Oleg Grenrus
oleg.grenrus at iki.fi
Fri Jan 8 20:08:52 UTC 2021
Agreed.
But to make discussion more productive I suggest that someone (you,
Keith?) goes through the list and makes concrete suggestion for each
point. It's not that long.
ghc/libraries % git grep ':|' | grep '~'
base/Control/Monad/Fix.hs: ~(x :| _) -> x :| mfix (neTail . f)
base/Control/Monad/Fix.hs: neHead ~(a :| _) = a
base/Control/Monad/Fix.hs: neTail ~(_ :| as) = as
base/Data/Foldable.hs: foldr f z ~(a :| as) = f a (List.foldr f z as)
base/Data/Foldable.hs: foldMap f ~(a :| as) = f a `mappend` foldMap f as
base/Data/Foldable.hs: fold ~(m :| ms) = m `mappend` fold ms
base/Data/Foldable.hs: toList ~(a :| as) = a : as
base/Data/List/NonEmpty.hs:uncons ~(a :| as) = (a, nonEmpty as)
base/Data/List/NonEmpty.hs:head ~(a :| _) = a
base/Data/List/NonEmpty.hs:tail ~(_ :| as) = as
base/Data/List/NonEmpty.hs:last ~(a :| as) = List.last (a : as)
base/Data/List/NonEmpty.hs:init ~(a :| as) = List.init (a : as)
base/Data/List/NonEmpty.hs:a <| ~(b :| bs) = a :| b : bs
base/Data/List/NonEmpty.hs:toList ~(a :| as) = a : as
base/Data/List/NonEmpty.hs:map f ~(a :| as) = f a :| fmap f as
base/Data/List/NonEmpty.hs:scanl1 f ~(a :| as) = fromList (List.scanl f
a as)
base/Data/List/NonEmpty.hs:scanr1 f ~(a :| as) = fromList (List.scanr1 f
(a:as))
base/Data/List/NonEmpty.hs:intersperse a ~(b :| bs) = b :| case bs of
base/Data/List/NonEmpty.hs:(!!) ~(x :| xs) n
base/Data/List/NonEmpty.hs:zip ~(x :| xs) ~(y :| ys) = (x, y) :|
List.zip xs ys
base/Data/List/NonEmpty.hs:zipWith f ~(x :| xs) ~(y :| ys) = f x y :|
List.zipWith f xs ys
base/Data/Traversable.hs: traverse f ~(a :| as) = liftA2 (:|) (f a)
(traverse f as)
base/GHC/Base.hs: (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
base/GHC/Base.hs: fmap f ~(a :| as) = f a :| fmap f as
base/GHC/Base.hs: b <$ ~(_ :| as) = b :| (b <$ as)
base/GHC/Base.hs: ~(a :| as) >>= f = b :| (bs ++ bs')
base/GHC/Base.hs: toList ~(c :| cs) = c : cs
base/GHC/Exts.hs: toList ~(a :| as) = a : as
On 8.1.2021 22.03, David Feuer wrote:
> I think removing the annotations that don't change anything can be
> done in a GHC MR without discussion on this list. I think the
> discussion on things that change strictness can and should continue here.
>
> On Fri, Jan 8, 2021, 2:59 PM Oleg Grenrus <oleg.grenrus at iki.fi
> <mailto:oleg.grenrus at iki.fi>> wrote:
>
> I'd expect that anyone who uses mfix with NonEmpty as result would use
> explicit (and irrefutable) pattern matching.
>
> But yes, changing these might make some code break. I'm not
> confident at
> all it won't make some code less efficient too, by forcing the
> structure
> of NonEmpty too early.
>
> So I would like that this thread is only about changing `head` and
> `tail` and not let scope creep.
> OR we hold this and let Keith come up with more complete NonEmpty
> implementation change.
>
> - Oleg
>
> On 8.1.2021 21.50, Viktor Dukhovni wrote:
> > On Fri, Jan 08, 2021 at 09:44:31PM +0200, Oleg Grenrus wrote:
> >> Note also
> >>
> >> -- | @since 4.9.0.0
> >> instance Foldable NonEmpty where
> >> foldr f z ~(a :| as) = f a (List.foldr f z as)
> >> foldl f z (a :| as) = List.foldl f (f z a) as
> >> foldl1 f (a :| as) = List.foldl f a as
> >>
> >> -- GHC isn't clever enough to transform the default definition
> >> -- into anything like this, so we'd end up shuffling a bunch of
> >> -- Maybes around.
> >> foldr1 f (p :| ps) = foldr go id ps p
> >> where
> >> go x r prev = f prev (r x)
> >>
> >> -- We used to say
> >> --
> >> -- length (_ :| as) = 1 + length as
> >> --
> >> -- but the default definition is better, counting from 1.
> >> --
> >> -- The default definition also works great for null and foldl'.
> >> -- As usual for cons lists, foldr' is basically hopeless.
> >>
> >> foldMap f ~(a :| as) = f a `mappend` foldMap f as
> >> fold ~(m :| ms) = m `mappend` fold ms
> >> toList ~(a :| as) = a : as
> >>
> >> Plenty of irrefutable patterns.
> > Do any of these make "mfix" more usable for NonEmpty? Or are
> they just
> > superfluous? With just one constructor, is there any downside to an
> > irrefutable pattern?
> >
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org <mailto:Libraries at haskell.org>
> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
More information about the Libraries
mailing list