Proposal: Add mapWithIndex to Data.List
David Feuer
david.feuer at gmail.com
Sun Feb 1 16:19:42 UTC 2015
Ah, I see. The problem with Traversable from this perspective is that
it offers only one-sided list fusion. Specifically,
instance Traversable [] where
{-# INLINE traverse #-} -- so that traverse can fuse
traverse f = List.foldr cons_f (pure [])
where cons_f x ys = (:) <$> f x <*> ys
This is potentially a good consumer, but not a good producer. In fact,
it can't be one in general. However, it's possible to write a couple
of different crosses between scanl and mapAccumL that should work for
this. The ExtraLazy version seems unlikely to be much use in practice.
mapWithStateExtraLazy :: (s -> a -> (b, s)) -> s -> [a] -> [b]
mapWithStateExtraLazy f s0 as = build $ \c n ->
let go a cont s = b `c` cont s'
where (b, s') = f s a
in foldr go (const n) as s0
mapWithStateFairlyLazy :: (s -> a -> (b, s)) -> s -> [a] -> [b]
mapWithStateFairlyLazy f s0 as = build $ \c n ->
let go a cont s = case f s a of
(b, s') -> b `c` cont s'
in foldr go (const n) as s0
mapWithStateRatherStrict :: (s -> a -> (b, s)) -> s -> [a] -> [b]
mapWithStateRatherStrict f s0 as = build $ \c n ->
let go a cont s = case f s a of
(b, s') -> s' `seq` b `c` cont s'
in foldr go (`seq` n) as s0
On Sun, Feb 1, 2015 at 9:19 AM, Henning Thielemann
<lemming at henning-thielemann.de> wrote:
>
> On Sun, 1 Feb 2015, David Feuer wrote:
>
>> What is a Stream in this context?
>
>
> I meant this one:
> https://hackage.haskell.org/package/Stream
>
> It's not necessary in this context, you can just replace it by a function
> that increments a counter.
More information about the Libraries
mailing list