From gershomb at gmail.com Thu Mar 3 17:54:53 2016 From: gershomb at gmail.com (Gershom B) Date: Thu, 3 Mar 2016 12:54:53 -0500 Subject: Test email Message-ID: Please disregard -- sorry for the noise. Gershom From gabriel439 at gmail.com Tue Mar 8 00:14:54 2016 From: gabriel439 at gmail.com (Gabriel Gonzalez) Date: Mon, 7 Mar 2016 16:14:54 -0800 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` Message-ID: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` and `Data.Set` as originally requested in: https://github.com/haskell/containers/issues/135 The motivation behind this proposal is three-fold: * for convenience - these functions are commonly used to implement pagination or previews of maps/sets * for type accuracy - the public API impose an unnecessary `Ord` constraint * for efficiency - these can be implemented more efficiently using the internal API Currently the only way you can implement this functionality via the public API is to use `lookupIndex`/`elemAt` + `split`. For example, one way to implement `Data.Set.take` is: take :: Ord a => Int -> Set a -> Set a take n m | n < 0 = empty | size m <= n = m | otherwise = lt where (lt, _) = split k m k = elemAt n m {-# INLINE take #-} This implementation incurs an unnecessary `Ord` constraint due to a roundabout way of computing `take`: this extracts the element at the given index and then works backwards from the element?s value to partition the set using O(log N) comparisons. We could eliminate all of the comparisons by using the internal API. Intuitively, we expect that the performance of `Data.Set.take` would benefit from avoiding those unnecessary comparisons and also avoiding traversing the `Set`?s spine twice. So I tested that hypothesis by implementing `take` via the internal API like this: take :: Int -> Set a -> Set a take n0 s0 = go s0 n0 where go s@(Bin sz x l r) n = if sz <= n then s else let sl = size l in if n <= sl then go l n else link x l (go r $! n - sl) go Tip _ = Tip {-# INLINE take #-} I then added the following benchmark to `benchmarks/Set.hs`: diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs index 3a6e8aa..03c99fb 100644 --- a/benchmarks/Set.hs +++ b/benchmarks/Set.hs @@ -31,6 +31,7 @@ main = do , bench "union" $ whnf (S.union s_even) s_odd , bench "difference" $ whnf (S.difference s) s_even , bench "intersection" $ whnf (S.intersection s) s_even + , bench "take" $ whnf (S.take (2^11)) s , bench "fromList" $ whnf S.fromList elems , bench "fromList-desc" $ whnf S.fromList (reverse elems) , bench "fromAscList" $ whnf S.fromAscList elems Here is the performance on my machine when implementing `take` via the public API: benchmarking take time 272.8 ns (266.7 ns .. 278.1 ns) 0.997 R? (0.996 R? .. 0.998 R?) mean 266.3 ns (261.8 ns .. 270.8 ns) std dev 15.44 ns (13.26 ns .. 18.95 ns) variance introduced by outliers: 75% (severely inflated) ? and the performance improved by 61% from using the internal API: benchmarking take time 169.2 ns (166.1 ns .. 172.6 ns) 0.997 R? (0.996 R? .. 0.998 R?) mean 172.1 ns (169.4 ns .. 175.4 ns) std dev 10.68 ns (8.420 ns .. 15.34 ns) variance introduced by outliers: 78% (severely inflated) ? and I?m guessing (but haven?t tested) that the performance gap would only increase the more expensive the comparison function gets. I haven?t performed comparative performance testing for `drop`/`splitAt` nor have I tested `Map` (because the benchmarks take a while for me to build and run) but I can perform those additional comparisons upon requests if people feel they are necessary. I haven?t yet written up a full patch since the maintainer asked me to first run this proposal by the libraries mailing list to assess whether it would be wise to expand the `containers` API to include these utilities. The deadline for discussion is two weeks. -------------- next part -------------- An HTML attachment was scrubbed... URL: From danburton.email at gmail.com Tue Mar 8 00:26:12 2016 From: danburton.email at gmail.com (Dan Burton) Date: Mon, 7 Mar 2016 16:26:12 -0800 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: I would prefer that the Ord constraint be retained in the type signature, even if not used in the implementation. Sets and Maps conceptually do not have an ordering; the Ord constraint indicates in which order one is sequencing the values. -- Dan Burton On Mon, Mar 7, 2016 at 4:14 PM, Gabriel Gonzalez wrote: > I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` > and `Data.Set` as originally requested in: > > https://github.com/haskell/containers/issues/135 > > The motivation behind this proposal is three-fold: > > * for convenience - these functions are commonly used to implement > pagination or previews of maps/sets > * for type accuracy - the public API impose an unnecessary `Ord` constraint > * for efficiency - these can be implemented more efficiently using the > internal API > > Currently the only way you can implement this functionality via the public > API is to use `lookupIndex`/`elemAt` + `split`. For example, one way to > implement `Data.Set.take` is: > > > take :: Ord a => Int -> Set a -> Set a > take n m > | n < 0 = empty > | size m <= n = m > | otherwise = lt > where > (lt, _) = split k m > k = elemAt n m > {-# INLINE take #-} > > > This implementation incurs an unnecessary `Ord` constraint due to a > roundabout way of computing `take`: this extracts the element at the given > index and then works backwards from the element?s value to partition the > set using O(log N) comparisons. We could eliminate all of the comparisons > by using the internal API. > > Intuitively, we expect that the performance of `Data.Set.take` would > benefit from avoiding those unnecessary comparisons and also avoiding > traversing the `Set`?s spine twice. So I tested that hypothesis by > implementing `take` via the internal API like this: > > take :: Int -> Set a -> Set a > take n0 s0 = go s0 n0 > where > go s@(Bin sz x l r) n = > if sz <= n > then s > else > let sl = size l > in if n <= sl > then go l n > else link x l (go r $! n - sl) > go Tip _ = Tip > {-# INLINE take #-} > > > I then added the following benchmark to `benchmarks/Set.hs`: > > *diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs* > *index 3a6e8aa..03c99fb 100644* > *--- a/benchmarks/Set.hs* > *+++ b/benchmarks/Set.hs* > @@ -31,6 +31,7 @@ main = do > , bench "union" $ whnf (S.union s_even) s_odd > , bench "difference" $ whnf (S.difference s) s_even > , bench "intersection" $ whnf (S.intersection s) s_even > + , bench "take" $ whnf (S.take (2^11)) s > , bench "fromList" $ whnf S.fromList elems > , bench "fromList-desc" $ whnf S.fromList (reverse elems) > , bench "fromAscList" $ whnf S.fromAscList elems > > > Here is the performance on my machine when implementing `take` via the > public API: > > benchmarking take > time 272.8 ns (266.7 ns .. 278.1 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 266.3 ns (261.8 ns .. 270.8 ns) > std dev 15.44 ns (13.26 ns .. 18.95 ns) > variance introduced by outliers: 75% (severely inflated) > > > ? and the performance improved by 61% from using the internal API: > > benchmarking take > time 169.2 ns (166.1 ns .. 172.6 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 172.1 ns (169.4 ns .. 175.4 ns) > std dev 10.68 ns (8.420 ns .. 15.34 ns) > variance introduced by outliers: 78% (severely inflated) > > > ? and I?m guessing (but haven?t tested) that the performance gap would > only increase the more expensive the comparison function gets. > > I haven?t performed comparative performance testing for `drop`/`splitAt` > nor have I tested `Map` (because the benchmarks take a while for me to > build and run) but I can perform those additional comparisons upon requests > if people feel they are necessary. > > I haven?t yet written up a full patch since the maintainer asked me to > first run this proposal by the libraries mailing list to assess whether it > would be wise to expand the `containers` API to include these utilities. > > The deadline for discussion is two weeks. > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Tue Mar 8 00:33:46 2016 From: david.feuer at gmail.com (David Feuer) Date: Mon, 7 Mar 2016 19:33:46 -0500 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: Sets and maps don't inherently have orderings, but Set and Map do. I think you could still make an argument for retaining the constraint, but it's a thin one. It is possible to imagine that there could be some *other* Ord-based representation of sets and maps for which having the ordering directly available would lead to more efficient splits. Retaining the constraint could then be seen as forward compatibility with such a hypothetical reimplementation. On Mar 7, 2016 7:26 PM, "Dan Burton" wrote: > I would prefer that the Ord constraint be retained in the type signature, > even if not used in the implementation. Sets and Maps conceptually do not > have an ordering; the Ord constraint indicates in which order one is > sequencing the values. > > -- Dan Burton > > On Mon, Mar 7, 2016 at 4:14 PM, Gabriel Gonzalez > wrote: > >> I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` >> and `Data.Set` as originally requested in: >> >> https://github.com/haskell/containers/issues/135 >> >> The motivation behind this proposal is three-fold: >> >> * for convenience - these functions are commonly used to implement >> pagination or previews of maps/sets >> * for type accuracy - the public API impose an unnecessary `Ord` >> constraint >> * for efficiency - these can be implemented more efficiently using the >> internal API >> >> Currently the only way you can implement this functionality via the >> public API is to use `lookupIndex`/`elemAt` + `split`. For example, one >> way to implement `Data.Set.take` is: >> >> >> take :: Ord a => Int -> Set a -> Set a >> take n m >> | n < 0 = empty >> | size m <= n = m >> | otherwise = lt >> where >> (lt, _) = split k m >> k = elemAt n m >> {-# INLINE take #-} >> >> >> This implementation incurs an unnecessary `Ord` constraint due to a >> roundabout way of computing `take`: this extracts the element at the given >> index and then works backwards from the element?s value to partition the >> set using O(log N) comparisons. We could eliminate all of the comparisons >> by using the internal API. >> >> Intuitively, we expect that the performance of `Data.Set.take` would >> benefit from avoiding those unnecessary comparisons and also avoiding >> traversing the `Set`?s spine twice. So I tested that hypothesis by >> implementing `take` via the internal API like this: >> >> take :: Int -> Set a -> Set a >> take n0 s0 = go s0 n0 >> where >> go s@(Bin sz x l r) n = >> if sz <= n >> then s >> else >> let sl = size l >> in if n <= sl >> then go l n >> else link x l (go r $! n - sl) >> go Tip _ = Tip >> {-# INLINE take #-} >> >> >> I then added the following benchmark to `benchmarks/Set.hs`: >> >> *diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs* >> *index 3a6e8aa..03c99fb 100644* >> *--- a/benchmarks/Set.hs* >> *+++ b/benchmarks/Set.hs* >> @@ -31,6 +31,7 @@ main = do >> , bench "union" $ whnf (S.union s_even) s_odd >> , bench "difference" $ whnf (S.difference s) s_even >> , bench "intersection" $ whnf (S.intersection s) s_even >> + , bench "take" $ whnf (S.take (2^11)) s >> , bench "fromList" $ whnf S.fromList elems >> , bench "fromList-desc" $ whnf S.fromList (reverse elems) >> , bench "fromAscList" $ whnf S.fromAscList elems >> >> >> Here is the performance on my machine when implementing `take` via the >> public API: >> >> benchmarking take >> time 272.8 ns (266.7 ns .. 278.1 ns) >> 0.997 R? (0.996 R? .. 0.998 R?) >> mean 266.3 ns (261.8 ns .. 270.8 ns) >> std dev 15.44 ns (13.26 ns .. 18.95 ns) >> variance introduced by outliers: 75% (severely inflated) >> >> >> ? and the performance improved by 61% from using the internal API: >> >> benchmarking take >> time 169.2 ns (166.1 ns .. 172.6 ns) >> 0.997 R? (0.996 R? .. 0.998 R?) >> mean 172.1 ns (169.4 ns .. 175.4 ns) >> std dev 10.68 ns (8.420 ns .. 15.34 ns) >> variance introduced by outliers: 78% (severely inflated) >> >> >> ? and I?m guessing (but haven?t tested) that the performance gap would >> only increase the more expensive the comparison function gets. >> >> I haven?t performed comparative performance testing for `drop`/`splitAt` >> nor have I tested `Map` (because the benchmarks take a while for me to >> build and run) but I can perform those additional comparisons upon requests >> if people feel they are necessary. >> >> I haven?t yet written up a full patch since the maintainer asked me to >> first run this proposal by the libraries mailing list to assess whether it >> would be wise to expand the `containers` API to include these utilities. >> >> The deadline for discussion is two weeks. >> >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >> >> > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gabriel439 at gmail.com Tue Mar 8 00:34:57 2016 From: gabriel439 at gmail.com (Gabriel Gonzalez) Date: Tue, 08 Mar 2016 00:34:57 +0000 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: I'm fine with keeping the constraint for forwards compatibility reasons On Mon, Mar 7, 2016 at 4:33 PM David Feuer wrote: > Sets and maps don't inherently have orderings, but Set and Map do. I think > you could still make an argument for retaining the constraint, but it's a > thin one. It is possible to imagine that there could be some *other* > Ord-based representation of sets and maps for which having the ordering > directly available would lead to more efficient splits. Retaining the > constraint could then be seen as forward compatibility with such a > hypothetical reimplementation. > On Mar 7, 2016 7:26 PM, "Dan Burton" wrote: > >> I would prefer that the Ord constraint be retained in the type signature, >> even if not used in the implementation. Sets and Maps conceptually do not >> have an ordering; the Ord constraint indicates in which order one is >> sequencing the values. >> >> -- Dan Burton >> >> On Mon, Mar 7, 2016 at 4:14 PM, Gabriel Gonzalez >> wrote: >> >>> I would like to propose adding `take`/`drop`/`splitAt` to both >>> `Data.Map` and `Data.Set` as originally requested in: >>> >>> https://github.com/haskell/containers/issues/135 >>> >>> The motivation behind this proposal is three-fold: >>> >>> * for convenience - these functions are commonly used to implement >>> pagination or previews of maps/sets >>> * for type accuracy - the public API impose an unnecessary `Ord` >>> constraint >>> * for efficiency - these can be implemented more efficiently using the >>> internal API >>> >>> Currently the only way you can implement this functionality via the >>> public API is to use `lookupIndex`/`elemAt` + `split`. For example, one >>> way to implement `Data.Set.take` is: >>> >>> >>> take :: Ord a => Int -> Set a -> Set a >>> take n m >>> | n < 0 = empty >>> | size m <= n = m >>> | otherwise = lt >>> where >>> (lt, _) = split k m >>> k = elemAt n m >>> {-# INLINE take #-} >>> >>> >>> This implementation incurs an unnecessary `Ord` constraint due to a >>> roundabout way of computing `take`: this extracts the element at the given >>> index and then works backwards from the element?s value to partition the >>> set using O(log N) comparisons. We could eliminate all of the comparisons >>> by using the internal API. >>> >>> Intuitively, we expect that the performance of `Data.Set.take` would >>> benefit from avoiding those unnecessary comparisons and also avoiding >>> traversing the `Set`?s spine twice. So I tested that hypothesis by >>> implementing `take` via the internal API like this: >>> >>> take :: Int -> Set a -> Set a >>> take n0 s0 = go s0 n0 >>> where >>> go s@(Bin sz x l r) n = >>> if sz <= n >>> then s >>> else >>> let sl = size l >>> in if n <= sl >>> then go l n >>> else link x l (go r $! n - sl) >>> go Tip _ = Tip >>> {-# INLINE take #-} >>> >>> >>> I then added the following benchmark to `benchmarks/Set.hs`: >>> >>> *diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs* >>> *index 3a6e8aa..03c99fb 100644* >>> *--- a/benchmarks/Set.hs* >>> *+++ b/benchmarks/Set.hs* >>> @@ -31,6 +31,7 @@ main = do >>> , bench "union" $ whnf (S.union s_even) s_odd >>> , bench "difference" $ whnf (S.difference s) s_even >>> , bench "intersection" $ whnf (S.intersection s) s_even >>> + , bench "take" $ whnf (S.take (2^11)) s >>> , bench "fromList" $ whnf S.fromList elems >>> , bench "fromList-desc" $ whnf S.fromList (reverse elems) >>> , bench "fromAscList" $ whnf S.fromAscList elems >>> >>> >>> Here is the performance on my machine when implementing `take` via the >>> public API: >>> >>> benchmarking take >>> time 272.8 ns (266.7 ns .. 278.1 ns) >>> 0.997 R? (0.996 R? .. 0.998 R?) >>> mean 266.3 ns (261.8 ns .. 270.8 ns) >>> std dev 15.44 ns (13.26 ns .. 18.95 ns) >>> variance introduced by outliers: 75% (severely inflated) >>> >>> >>> ? and the performance improved by 61% from using the internal API: >>> >>> benchmarking take >>> time 169.2 ns (166.1 ns .. 172.6 ns) >>> 0.997 R? (0.996 R? .. 0.998 R?) >>> mean 172.1 ns (169.4 ns .. 175.4 ns) >>> std dev 10.68 ns (8.420 ns .. 15.34 ns) >>> variance introduced by outliers: 78% (severely inflated) >>> >>> >>> ? and I?m guessing (but haven?t tested) that the performance gap would >>> only increase the more expensive the comparison function gets. >>> >>> I haven?t performed comparative performance testing for `drop`/`splitAt` >>> nor have I tested `Map` (because the benchmarks take a while for me to >>> build and run) but I can perform those additional comparisons upon requests >>> if people feel they are necessary. >>> >>> I haven?t yet written up a full patch since the maintainer asked me to >>> first run this proposal by the libraries mailing list to assess whether it >>> would be wise to expand the `containers` API to include these utilities. >>> >>> The deadline for discussion is two weeks. >>> >>> _______________________________________________ >>> Libraries mailing list >>> Libraries at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >>> >>> >> >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From spam at scientician.net Tue Mar 8 06:43:06 2016 From: spam at scientician.net (Bardur Arantsson) Date: Tue, 8 Mar 2016 07:43:06 +0100 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: On 03/08/2016 01:14 AM, Gabriel Gonzalez wrote: > I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` and `Data.Set` as originally requested in: > > https://github.com/haskell/containers/issues/135 > > The motivation behind this proposal is three-fold: > > * for convenience - these functions are commonly used to implement pagination or previews of maps/sets > * for type accuracy - the public API impose an unnecessary `Ord` constraint > * for efficiency - these can be implemented more efficiently using the internal API > > Currently the only way you can implement this functionality via the public API is to > use `lookupIndex`/`elemAt` + `split`. For example, one way to implement `Data.Set.take` is: > +1 It also seems like a more idiomatic Haskell API to have "take", "drop", "splitAt" operations rather than[1] "lookupIndex/elemAt" + "split". [1] I realize the latter aren't going away. Regards, From fumiexcel at gmail.com Tue Mar 8 08:43:29 2016 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Tue, 8 Mar 2016 00:43:29 -0800 Subject: Implement traverseMaybe in Data.Map, Data.IntMap, etc Message-ID: As far as I know, the most general form of a function that allows traversing and filtering is: type Filter s t a b = foall f. Applicative f => (a -> f (Maybe b)) -> s -> f t In my witherable[0] package, I defined `Witherable` as a subclass of `Traversable` to provide such operation for various containers. class T.Traversable t => Witherable t where wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b) ... However, the `wither` for `Map` is currently inefficient because it is defined in terms of `traverse` and `mapMaybe`, so it traverses the container twice. Efficient implementation.would have to use the hidden constructors. I would like to propose adding `traverseMaybe` and `traverseMaybeWithKey` for `Data.Map`, `Data.IntMap`, and their strict variants (I'm suggesting more conservative name because wither might sound too unusual or poetic for a standard library. I like 'wither' though). A possible implementation would be like this: traverseMaybeWithKey :: Applicative f => (k -> a -> f (Maybe b)) -> Map k a -> f (Map k b) traverseMaybeWithKey _ Tip = pure Tip traverseMaybeWithKey f (Bin _ kx x l r) = maybe merge (link kx) <$> f kx x <*> traverseMaybeWithKey f l <*> traverseMaybeWithKey f r I think there is potential demand for this function as well as mapMaybe. [0] http://hackage.haskell.org/package/witherable -------------- next part -------------- An HTML attachment was scrubbed... URL: From hvriedel at gmail.com Tue Mar 8 08:52:17 2016 From: hvriedel at gmail.com (Herbert Valerio Riedel) Date: Tue, 08 Mar 2016 09:52:17 +0100 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: (Dan Burton's message of "Mon, 7 Mar 2016 16:26:12 -0800") References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: <87lh5tic72.fsf@gmail.com> On 2016-03-08 at 01:26:12 +0100, Dan Burton wrote: > I would prefer that the Ord constraint be retained in the type signature, > even if not used in the implementation. Just for the record: You'll have to actively suppress the resulting warning if the Ord dictionary is not used by the implementation, as -Wredundant-constraints is part of -Wall starting with GHC 8.0 -- hvr From lemming at henning-thielemann.de Tue Mar 8 08:58:00 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 8 Mar 2016 09:58:00 +0100 (CET) Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: <87lh5tic72.fsf@gmail.com> References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> <87lh5tic72.fsf@gmail.com> Message-ID: On Tue, 8 Mar 2016, Herbert Valerio Riedel wrote: > On 2016-03-08 at 01:26:12 +0100, Dan Burton wrote: >> I would prefer that the Ord constraint be retained in the type signature, >> even if not used in the implementation. > > Just for the record: You'll have to actively suppress the resulting > warning if the Ord dictionary is not used by the implementation, as > -Wredundant-constraints is part of -Wall starting with GHC 8.0 It seems to have changed: https://ghc.haskell.org/trac/ghc/ticket/10635#comment:7 But I had those cases in mind when I asked for removing -Wredundant-constraints from -Wall. From hvriedel at gmail.com Tue Mar 8 09:48:59 2016 From: hvriedel at gmail.com (Herbert Valerio Riedel) Date: Tue, 08 Mar 2016 10:48:59 +0100 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: (Henning Thielemann's message of "Tue, 8 Mar 2016 09:58:00 +0100 (CET)") References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> <87lh5tic72.fsf@gmail.com> Message-ID: <87h9ghi9kk.fsf@gmail.com> On 2016-03-08 at 09:58:00 +0100, Henning Thielemann wrote: >> On 2016-03-08 at 01:26:12 +0100, Dan Burton wrote: >>> I would prefer that the Ord constraint be retained in the type signature, >>> even if not used in the implementation. >> >> Just for the record: You'll have to actively suppress the resulting >> warning if the Ord dictionary is not used by the implementation, as >> -Wredundant-constraints is part of -Wall starting with GHC 8.0 > > It seems to have changed: > https://ghc.haskell.org/trac/ghc/ticket/10635#comment:7 Indeed, see also https://ghc.haskell.org/ticket/11370#comment:32 which was the result of a lengthy debate... Sadly, aspects in the warning design-space such as how to classify/default warnings in combination with the 3-rls-policy tend to drain the living will out of its participants (paraphrasing Simon Marlow)... > But I had those cases in mind when I asked for removing > -Wredundant-constraints from -Wall. From roma at ro-che.info Tue Mar 8 18:54:45 2016 From: roma at ro-che.info (Roman Cheplyaka) Date: Tue, 8 Mar 2016 20:54:45 +0200 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: <56DF1FF5.2090606@ro-che.info> Good idea, +1. On 03/08/2016 02:14 AM, Gabriel Gonzalez wrote: > I would like to propose adding `take`/`drop`/`splitAt` to both > `Data.Map` and `Data.Set` as originally requested in: > > https://github.com/haskell/containers/issues/135 > > The motivation behind this proposal is three-fold: > > * for convenience - these functions are commonly used to implement > pagination or previews of maps/sets > * for type accuracy - the public API impose an unnecessary `Ord` constraint > * for efficiency - these can be implemented more efficiently using the > internal API > > Currently the only way you can implement this functionality via the > public API is to use `lookupIndex`/`elemAt` + `split`. For example, one > way to implement `Data.Set.take` is: > > > take :: Ord a => Int -> Set a -> Set a > take n m > | n < 0 = empty > | size m <= n = m > | otherwise = lt > where > (lt, _) = split k m > k = elemAt n m > {-# INLINE take #-} > > > This implementation incurs an unnecessary `Ord` constraint due to a > roundabout way of computing `take`: this extracts the element at the > given index and then works backwards from the element?s value to > partition the set using O(log N) comparisons. We could eliminate all of > the comparisons by using the internal API. > > Intuitively, we expect that the performance of `Data.Set.take` would > benefit from avoiding those unnecessary comparisons and also avoiding > traversing the `Set`?s spine twice. So I tested that hypothesis by > implementing `take` via the internal API like this: > > take :: Int -> Set a -> Set a > take n0 s0 = go s0 n0 > where > go s@(Bin sz x l r) n = > if sz <= n > then s > else > let sl = size l > in if n <= sl > then go l n > else link x l (go r $! n - sl) > go Tip _ = Tip > {-# INLINE take #-} > > > I then added the following benchmark to `benchmarks/Set.hs`: > > *diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs* > *index 3a6e8aa..03c99fb 100644* > *--- a/benchmarks/Set.hs* > *+++ b/benchmarks/Set.hs* > @@ -31,6 +31,7 @@main = do > , bench "union" $ whnf (S.union s_even) s_odd > , bench "difference" $ whnf (S.difference s) s_even > , bench "intersection" $ whnf (S.intersection s) s_even > + , bench "take" $ whnf (S.take (2^11)) s > , bench "fromList" $ whnf S.fromList elems > , bench "fromList-desc" $ whnf S.fromList (reverse elems) > , bench "fromAscList" $ whnf S.fromAscList elems > > > Here is the performance on my machine when implementing `take` via the > public API: > > benchmarking take > time 272.8 ns (266.7 ns .. 278.1 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 266.3 ns (261.8 ns .. 270.8 ns) > std dev 15.44 ns (13.26 ns .. 18.95 ns) > variance introduced by outliers: 75% (severely inflated) > > > ? and the performance improved by 61% from using the internal API: > > benchmarking take > time 169.2 ns (166.1 ns .. 172.6 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 172.1 ns (169.4 ns .. 175.4 ns) > std dev 10.68 ns (8.420 ns .. 15.34 ns) > variance introduced by outliers: 78% (severely inflated) > > > ? and I?m guessing (but haven?t tested) that the performance gap would > only increase the more expensive the comparison function gets. > > I haven?t performed comparative performance testing for `drop`/`splitAt` > nor have I tested `Map` (because the benchmarks take a while for me to > build and run) but I can perform those additional comparisons upon > requests if people feel they are necessary. > > I haven?t yet written up a full patch since the maintainer asked me to > first run this proposal by the libraries mailing list to assess whether > it would be wise to expand the `containers` API to include these utilities. > > The deadline for discussion is two weeks. > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > From roma at ro-che.info Tue Mar 8 19:00:24 2016 From: roma at ro-che.info (Roman Cheplyaka) Date: Tue, 8 Mar 2016 21:00:24 +0200 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: <56DF2148.5040905@ro-che.info> On 03/08/2016 02:26 AM, Dan Burton wrote: > I would prefer that the Ord constraint be retained in the type > signature, even if not used in the implementation. Sets and Maps > conceptually do not have an ordering; the Ord constraint indicates in > which order one is sequencing the values. I don't quite understand the essence of your argument, but what you're proposing (annotating every function that deals with Sets or Maps with an Ord constraint) sounds like data type contexts[1], which was more or less universally admitted to be a bad idea. Could you explain in more detail why you want that? [1]: https://wiki.haskell.org/Data_declaration_with_constraint Roman From ekmett at gmail.com Tue Mar 8 21:14:34 2016 From: ekmett at gmail.com (Edward Kmett) Date: Tue, 8 Mar 2016 16:14:34 -0500 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: +1 on adding the methods, but I'd really rather see it done without incurring spurious constraints that they don't need. We just went through and cleaned up a few similar unused and unusable constraints in base on various array operations. This seems to beg us to do the same later, and we don't bother to wastefully pass in Ord constraints on any other combinators in Data.Set or Data.Map, so why start now? -Edward On Mon, Mar 7, 2016 at 7:14 PM, Gabriel Gonzalez wrote: > I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` > and `Data.Set` as originally requested in: > > https://github.com/haskell/containers/issues/135 > > The motivation behind this proposal is three-fold: > > * for convenience - these functions are commonly used to implement > pagination or previews of maps/sets > * for type accuracy - the public API impose an unnecessary `Ord` constraint > * for efficiency - these can be implemented more efficiently using the > internal API > > Currently the only way you can implement this functionality via the public > API is to use `lookupIndex`/`elemAt` + `split`. For example, one way to > implement `Data.Set.take` is: > > > take :: Ord a => Int -> Set a -> Set a > take n m > | n < 0 = empty > | size m <= n = m > | otherwise = lt > where > (lt, _) = split k m > k = elemAt n m > {-# INLINE take #-} > > > This implementation incurs an unnecessary `Ord` constraint due to a > roundabout way of computing `take`: this extracts the element at the given > index and then works backwards from the element?s value to partition the > set using O(log N) comparisons. We could eliminate all of the comparisons > by using the internal API. > > Intuitively, we expect that the performance of `Data.Set.take` would > benefit from avoiding those unnecessary comparisons and also avoiding > traversing the `Set`?s spine twice. So I tested that hypothesis by > implementing `take` via the internal API like this: > > take :: Int -> Set a -> Set a > take n0 s0 = go s0 n0 > where > go s@(Bin sz x l r) n = > if sz <= n > then s > else > let sl = size l > in if n <= sl > then go l n > else link x l (go r $! n - sl) > go Tip _ = Tip > {-# INLINE take #-} > > > I then added the following benchmark to `benchmarks/Set.hs`: > > *diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs* > *index 3a6e8aa..03c99fb 100644* > *--- a/benchmarks/Set.hs* > *+++ b/benchmarks/Set.hs* > @@ -31,6 +31,7 @@ main = do > , bench "union" $ whnf (S.union s_even) s_odd > , bench "difference" $ whnf (S.difference s) s_even > , bench "intersection" $ whnf (S.intersection s) s_even > + , bench "take" $ whnf (S.take (2^11)) s > , bench "fromList" $ whnf S.fromList elems > , bench "fromList-desc" $ whnf S.fromList (reverse elems) > , bench "fromAscList" $ whnf S.fromAscList elems > > > Here is the performance on my machine when implementing `take` via the > public API: > > benchmarking take > time 272.8 ns (266.7 ns .. 278.1 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 266.3 ns (261.8 ns .. 270.8 ns) > std dev 15.44 ns (13.26 ns .. 18.95 ns) > variance introduced by outliers: 75% (severely inflated) > > > ? and the performance improved by 61% from using the internal API: > > benchmarking take > time 169.2 ns (166.1 ns .. 172.6 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 172.1 ns (169.4 ns .. 175.4 ns) > std dev 10.68 ns (8.420 ns .. 15.34 ns) > variance introduced by outliers: 78% (severely inflated) > > > ? and I?m guessing (but haven?t tested) that the performance gap would > only increase the more expensive the comparison function gets. > > I haven?t performed comparative performance testing for `drop`/`splitAt` > nor have I tested `Map` (because the benchmarks take a while for me to > build and run) but I can perform those additional comparisons upon requests > if people feel they are necessary. > > I haven?t yet written up a full patch since the maintainer asked me to > first run this proposal by the libraries mailing list to assess whether it > would be wise to expand the `containers` API to include these utilities. > > The deadline for discussion is two weeks. > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Tue Mar 8 21:18:50 2016 From: david.feuer at gmail.com (David Feuer) Date: Tue, 8 Mar 2016 16:18:50 -0500 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: Agreed. I was just playing devil's advocate. On Mar 8, 2016 4:14 PM, "Edward Kmett" wrote: > +1 on adding the methods, but I'd really rather see it done without > incurring spurious constraints that they don't need. > > We just went through and cleaned up a few similar unused and unusable > constraints in base on various array operations. This seems to beg us to do > the same later, and we don't bother to wastefully pass in Ord constraints > on any other combinators in Data.Set or Data.Map, so why start now? > > -Edward > > > > On Mon, Mar 7, 2016 at 7:14 PM, Gabriel Gonzalez > wrote: > >> I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` >> and `Data.Set` as originally requested in: >> >> https://github.com/haskell/containers/issues/135 >> >> The motivation behind this proposal is three-fold: >> >> * for convenience - these functions are commonly used to implement >> pagination or previews of maps/sets >> * for type accuracy - the public API impose an unnecessary `Ord` >> constraint >> * for efficiency - these can be implemented more efficiently using the >> internal API >> >> Currently the only way you can implement this functionality via the >> public API is to use `lookupIndex`/`elemAt` + `split`. For example, one >> way to implement `Data.Set.take` is: >> >> >> take :: Ord a => Int -> Set a -> Set a >> take n m >> | n < 0 = empty >> | size m <= n = m >> | otherwise = lt >> where >> (lt, _) = split k m >> k = elemAt n m >> {-# INLINE take #-} >> >> >> This implementation incurs an unnecessary `Ord` constraint due to a >> roundabout way of computing `take`: this extracts the element at the given >> index and then works backwards from the element?s value to partition the >> set using O(log N) comparisons. We could eliminate all of the comparisons >> by using the internal API. >> >> Intuitively, we expect that the performance of `Data.Set.take` would >> benefit from avoiding those unnecessary comparisons and also avoiding >> traversing the `Set`?s spine twice. So I tested that hypothesis by >> implementing `take` via the internal API like this: >> >> take :: Int -> Set a -> Set a >> take n0 s0 = go s0 n0 >> where >> go s@(Bin sz x l r) n = >> if sz <= n >> then s >> else >> let sl = size l >> in if n <= sl >> then go l n >> else link x l (go r $! n - sl) >> go Tip _ = Tip >> {-# INLINE take #-} >> >> >> I then added the following benchmark to `benchmarks/Set.hs`: >> >> *diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs* >> *index 3a6e8aa..03c99fb 100644* >> *--- a/benchmarks/Set.hs* >> *+++ b/benchmarks/Set.hs* >> @@ -31,6 +31,7 @@ main = do >> , bench "union" $ whnf (S.union s_even) s_odd >> , bench "difference" $ whnf (S.difference s) s_even >> , bench "intersection" $ whnf (S.intersection s) s_even >> + , bench "take" $ whnf (S.take (2^11)) s >> , bench "fromList" $ whnf S.fromList elems >> , bench "fromList-desc" $ whnf S.fromList (reverse elems) >> , bench "fromAscList" $ whnf S.fromAscList elems >> >> >> Here is the performance on my machine when implementing `take` via the >> public API: >> >> benchmarking take >> time 272.8 ns (266.7 ns .. 278.1 ns) >> 0.997 R? (0.996 R? .. 0.998 R?) >> mean 266.3 ns (261.8 ns .. 270.8 ns) >> std dev 15.44 ns (13.26 ns .. 18.95 ns) >> variance introduced by outliers: 75% (severely inflated) >> >> >> ? and the performance improved by 61% from using the internal API: >> >> benchmarking take >> time 169.2 ns (166.1 ns .. 172.6 ns) >> 0.997 R? (0.996 R? .. 0.998 R?) >> mean 172.1 ns (169.4 ns .. 175.4 ns) >> std dev 10.68 ns (8.420 ns .. 15.34 ns) >> variance introduced by outliers: 78% (severely inflated) >> >> >> ? and I?m guessing (but haven?t tested) that the performance gap would >> only increase the more expensive the comparison function gets. >> >> I haven?t performed comparative performance testing for `drop`/`splitAt` >> nor have I tested `Map` (because the benchmarks take a while for me to >> build and run) but I can perform those additional comparisons upon requests >> if people feel they are necessary. >> >> I haven?t yet written up a full patch since the maintainer asked me to >> first run this proposal by the libraries mailing list to assess whether it >> would be wise to expand the `containers` API to include these utilities. >> >> The deadline for discussion is two weeks. >> >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >> >> > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gabriel439 at gmail.com Tue Mar 8 21:58:11 2016 From: gabriel439 at gmail.com (Gabriel Gonzalez) Date: Tue, 8 Mar 2016 13:58:11 -0800 Subject: Add `take`/`drop`/`splitAt` to `Data.Map`/`Data.Set` In-Reply-To: References: <44993E73-5372-4544-BA11-B5222BEDE05D@gmail.com> Message-ID: Alright, so no constraints then, since my reading of this is that nobody is really in favor of them at this point and several people are against. > On Mar 8, 2016, at 1:18 PM, David Feuer wrote: > > Agreed. I was just playing devil's advocate. > > On Mar 8, 2016 4:14 PM, "Edward Kmett" > wrote: > +1 on adding the methods, but I'd really rather see it done without incurring spurious constraints that they don't need. > > We just went through and cleaned up a few similar unused and unusable constraints in base on various array operations. This seems to beg us to do the same later, and we don't bother to wastefully pass in Ord constraints on any other combinators in Data.Set or Data.Map, so why start now? > > -Edward > > > > On Mon, Mar 7, 2016 at 7:14 PM, Gabriel Gonzalez > wrote: > I would like to propose adding `take`/`drop`/`splitAt` to both `Data.Map` and `Data.Set` as originally requested in: > > https://github.com/haskell/containers/issues/135 > > The motivation behind this proposal is three-fold: > > * for convenience - these functions are commonly used to implement pagination or previews of maps/sets > * for type accuracy - the public API impose an unnecessary `Ord` constraint > * for efficiency - these can be implemented more efficiently using the internal API > > Currently the only way you can implement this functionality via the public API is to use `lookupIndex`/`elemAt` + `split`. For example, one way to implement `Data.Set.take` is: > > take :: Ord a => Int -> Set a -> Set a > take n m > | n < 0 = empty > | size m <= n = m > | otherwise = lt > where > (lt, _) = split k m > k = elemAt n m > {-# INLINE take #-} > > This implementation incurs an unnecessary `Ord` constraint due to a roundabout way of computing `take`: this extracts the element at the given index and then works backwards from the element?s value to partition the set using O(log N) comparisons. We could eliminate all of the comparisons by using the internal API. > > Intuitively, we expect that the performance of `Data.Set.take` would benefit from avoiding those unnecessary comparisons and also avoiding traversing the `Set`?s spine twice. So I tested that hypothesis by implementing `take` via the internal API like this: > > take :: Int -> Set a -> Set a > take n0 s0 = go s0 n0 > where > go s@(Bin sz x l r) n = > if sz <= n > then s > else > let sl = size l > in if n <= sl > then go l n > else link x l (go r $! n - sl) > go Tip _ = Tip > {-# INLINE take #-} > > I then added the following benchmark to `benchmarks/Set.hs`: > > diff --git a/benchmarks/Set.hs b/benchmarks/Set.hs > index 3a6e8aa..03c99fb 100644 > --- a/benchmarks/Set.hs > +++ b/benchmarks/Set.hs > @@ -31,6 +31,7 @@ main = do > , bench "union" $ whnf (S.union s_even) s_odd > , bench "difference" $ whnf (S.difference s) s_even > , bench "intersection" $ whnf (S.intersection s) s_even > + , bench "take" $ whnf (S.take (2^11)) s > , bench "fromList" $ whnf S.fromList elems > , bench "fromList-desc" $ whnf S.fromList (reverse elems) > , bench "fromAscList" $ whnf S.fromAscList elems > > Here is the performance on my machine when implementing `take` via the public API: > > benchmarking take > time 272.8 ns (266.7 ns .. 278.1 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 266.3 ns (261.8 ns .. 270.8 ns) > std dev 15.44 ns (13.26 ns .. 18.95 ns) > variance introduced by outliers: 75% (severely inflated) > > ? and the performance improved by 61% from using the internal API: > > benchmarking take > time 169.2 ns (166.1 ns .. 172.6 ns) > 0.997 R? (0.996 R? .. 0.998 R?) > mean 172.1 ns (169.4 ns .. 175.4 ns) > std dev 10.68 ns (8.420 ns .. 15.34 ns) > variance introduced by outliers: 78% (severely inflated) > > ? and I?m guessing (but haven?t tested) that the performance gap would only increase the more expensive the comparison function gets. > > I haven?t performed comparative performance testing for `drop`/`splitAt` nor have I tested `Map` (because the benchmarks take a while for me to build and run) but I can perform those additional comparisons upon requests if people feel they are necessary. > > I haven?t yet written up a full patch since the maintainer asked me to first run this proposal by the libraries mailing list to assess whether it would be wise to expand the `containers` API to include these utilities. > > The deadline for discussion is two weeks. > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fumiexcel at gmail.com Wed Mar 9 22:49:54 2016 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Wed, 9 Mar 2016 14:49:54 -0800 Subject: Alternative Proxy Message-ID: This is the only possible definition...so it should exist instance Alternative Proxy where empty = Proxy _ <|> _ Proxy -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Wed Mar 9 23:12:20 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 9 Mar 2016 18:12:20 -0500 Subject: Alternative Proxy In-Reply-To: References: Message-ID: +1. I see no problem here. On Wed, Mar 9, 2016 at 5:49 PM, Fumiaki Kinoshita wrote: > This is the only possible definition...so it should exist > > instance Alternative Proxy where > empty = Proxy > _ <|> _ Proxy > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at gmail.com Thu Mar 10 00:48:08 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Wed, 9 Mar 2016 19:48:08 -0500 Subject: Alternative Proxy In-Reply-To: References: Message-ID: <44A9C1A3-E7CF-4F9E-BB14-A9C9A377275E@gmail.com> > El 9 mar 2016, a las 17:49, Fumiaki Kinoshita escribi?: > > This is the only possible definition...so it should exist Although I have nothing particularly against an Alternative instance for Proxy, I'd like to say I think "this is the only possible definition, so it should exist" is a nonsequitur. If (again, not specifically speaking about "instance Alternative Proxy" here) there is an instance method with no likely practical use, the fact that the compiler yells when you use it is a *feature*. Tom > instance Alternative Proxy where > empty = Proxy > _ <|> _ Proxy > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From fumiexcel at gmail.com Thu Mar 10 01:28:29 2016 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Wed, 9 Mar 2016 17:28:29 -0800 Subject: Alternative Proxy In-Reply-To: <44A9C1A3-E7CF-4F9E-BB14-A9C9A377275E@gmail.com> References: <44A9C1A3-E7CF-4F9E-BB14-A9C9A377275E@gmail.com> Message-ID: Thinking an instance non-practical does not imply we *never* use the instance. The lack of a uniquely legal instance turns out to be a problem at some point, maybe right now. -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at gmail.com Thu Mar 10 02:12:53 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Wed, 9 Mar 2016 21:12:53 -0500 Subject: Alternative Proxy In-Reply-To: References: <44A9C1A3-E7CF-4F9E-BB14-A9C9A377275E@gmail.com> Message-ID: <76E1702C-BF81-410A-9BC5-4C0FB9BA50D2@gmail.com> My point is that there's a cost to adding instances -- namely that accidental calling of the class functions (e.g. after refactoring) isn't caught by the compiler. Since there's a cost, we need to make sure there's a larger benefit before we add them -- e.g. a hypothetical or real use-case. Tom > El 9 mar 2016, a las 20:28, Fumiaki Kinoshita escribi?: > > Thinking an instance non-practical does not imply we *never* use the instance. The lack of a uniquely legal instance turns out to be a problem at some point, maybe right now. From fumiexcel at gmail.com Thu Mar 10 02:28:02 2016 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Wed, 9 Mar 2016 18:28:02 -0800 Subject: Alternative Proxy In-Reply-To: <76E1702C-BF81-410A-9BC5-4C0FB9BA50D2@gmail.com> References: <44A9C1A3-E7CF-4F9E-BB14-A9C9A377275E@gmail.com> <76E1702C-BF81-410A-9BC5-4C0FB9BA50D2@gmail.com> Message-ID: There's a cost to __not__ adding instances as well, namely that accidental need of the class functions (e.g. after abstraction) doesn't fit the library. Since there's a cost, we need to make sure there's a larger benefit before we decide not to add them -- e.g. a hypothetical or real risk. 2016-03-09 18:12 GMT-08:00 : > My point is that there's a cost to adding instances -- namely that > accidental calling of the class functions (e.g. after refactoring) isn't > caught by the compiler. > > Since there's a cost, we need to make sure there's a larger benefit before > we add them -- e.g. a hypothetical or real use-case. > > Tom > > > > El 9 mar 2016, a las 20:28, Fumiaki Kinoshita > escribi?: > > > > Thinking an instance non-practical does not imply we *never* use the > instance. The lack of a uniquely legal instance turns out to be a problem > at some point, maybe right now. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ekmett at gmail.com Thu Mar 10 03:13:01 2016 From: ekmett at gmail.com (Edward Kmett) Date: Wed, 9 Mar 2016 22:13:01 -0500 Subject: Alternative Proxy In-Reply-To: References: Message-ID: We actually already put in a patch for this about 10 days ago, when the discussion came up around U1: https://ghc.haskell.org/trac/ghc/ticket/11650 -Edward On Wed, Mar 9, 2016 at 5:49 PM, Fumiaki Kinoshita wrote: > This is the only possible definition...so it should exist > > instance Alternative Proxy where > empty = Proxy > _ <|> _ Proxy > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From cheecheeo at gmail.com Thu Mar 10 08:47:00 2016 From: cheecheeo at gmail.com (John Alfred Nathanael Chee) Date: Thu, 10 Mar 2016 00:47:00 -0800 Subject: Implement traverseMaybe in Data.Map, Data.IntMap, etc In-Reply-To: References: Message-ID: +1, I'm a fan of the functionality that witherable provides. Would it be possible to provide benchmarks with and without using the hidden constructors? It might make the case more compelling. On Tue, Mar 8, 2016 at 12:43 AM, Fumiaki Kinoshita wrote: > As far as I know, the most general form of a function that allows > traversing and filtering is: > > type Filter s t a b = foall f. Applicative f => (a -> f (Maybe b)) -> > s -> f t > > In my witherable[0] package, I defined `Witherable` as a subclass of > `Traversable` to provide such operation for various containers. > > class T.Traversable t => Witherable t where wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b) > > ... > > However, the `wither` for `Map` is currently inefficient because it is > defined in terms of `traverse` and `mapMaybe`, so it traverses the > container twice. Efficient implementation.would have to use the hidden > constructors. > > I would like to propose adding `traverseMaybe` and `traverseMaybeWithKey` > for `Data.Map`, `Data.IntMap`, and their strict variants (I'm suggesting > more conservative name because wither might sound too unusual or poetic for > a standard library. I like 'wither' though). A possible implementation > would be like this: > > traverseMaybeWithKey :: Applicative f => (k -> a -> f (Maybe b)) -> Map k > a -> f (Map k b) > traverseMaybeWithKey _ Tip = pure Tip > traverseMaybeWithKey f (Bin _ kx x l r) = maybe merge (link kx) > <$> f kx x > <*> traverseMaybeWithKey f l > <*> traverseMaybeWithKey f r > > I think there is potential demand for this function as well as mapMaybe. > > [0] http://hackage.haskell.org/package/witherable > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > -- Love in Jesus Christ, John Alfred Nathanael Chee http://www.biblegateway.com/ http://web.cecs.pdx.edu/~chee/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From gershomb at gmail.com Tue Mar 22 03:20:45 2016 From: gershomb at gmail.com (Gershom B) Date: Mon, 21 Mar 2016 23:20:45 -0400 Subject: Cabal on Mac OSX EL Capitan - forwarding DYLD_LIBRARY_PATH In-Reply-To: References: <87mvrrcms7.fsf@gmail.com> Message-ID: For the record, there?s now a GHC ticket tracking this issue:?https://ghc.haskell.org/trac/ghc/ticket/11617 As I wrote there, my gut says there?s a reason that Apple made DYLD_LIBRARY_PATH not forward, we shouldn?t try to work around it, we don?t need to work around it for standard usage patterns, and if a user does want to work around it, they should think twice about why. ?gershom On February 7, 2016 at 4:26:14 PM, Carter Schonwald (carter.schonwald at gmail.com) wrote: > theres emphatically OS X support for haskell, by folks such as myself. > > however, my current understanding is that the environment variable passing > issue that arises here is an artifact of STACK doing subprocess invocation. > > if you can show me a build that i can replicate the problem on a vanilla OS > X that hits this issue, that would be appreciated > > then, it becomes a question of how to "simulate"/"emulate" suitable > environment variable inheritance on affected systems. > > Or just make sure that the config for all user / root shells has the right > env variables set, so any sub process will pick up the right paths :) > (i can't tell if thats been explored or not in the affected threads, but > since most OS X machines are effectively single user systems, thats not an > ownerous work around :) > ) > > > > On Sat, Feb 6, 2016 at 8:14 AM, tamarind code > wrote: > > > Hi, > > Reposting my old question. > > Are there anyone with any ideas about a possible resolution to this > > without removing SIP on OSX please? Or is this silence telling me that > > Apple macs aren't very popular in the Haskell community ? > > > > https://github.com/commercialhaskell/stack/issues/1161#issuecomment-158473975 > > > > On 1 February 2016 at 13:30, tamarind code wrote: > > > >> Thanks for the response Herbert Valerio Riedel. > >> Sorry I shouldn't have sued the word 'bug' here as this seems to be a > >> result of something Apple did that breaks backward compatibility. > >> I have just done a quick search and as you said it did seem to break a > >> lot of other software including Posgresql and Oracle drivers and a whole > >> bunch of others that are affected by this. So there is plenty of discussion > >> around this. > >> > >> Before I go any further I must say I am a newbie who doesn't even > >> understand the fully details of the issue so sorry if I am saying something > >> silly, But after a bit of googling I got the impression that some have > >> found ways to get around the issue without having to disable SIP. They > >> seem to remove the dependency on this path - if I understood this correctly. > >> > >> I am posting a few links with the hope that they may be useful for > >> people with more knowledge on this to figure our a similar solution if > >> possible. Sorry if they solutions below don't apply to the issue we are > >> talking about. As Apple is unlikely to do anything about it anytime soon, I > >> do hope the Haskell community will find a better way to avoid this without > >> messing with SIP. > >> > >> > >> https://groups.google.com/d/msg/dealii/NsniOXPvOyo/zHacLvk7DgAJ > >> > >> > >> https://github.com/oracle/node-oracledb/issues/149 > >> > >> > >> https://blogs.oracle.com/taylor22/entry/sqlplus_and_dyld_library_path > >> > >> > >> On 27 January 2016 at 10:57, Herbert Valerio Riedel > >> wrote: > >> > >>> On 2016-01-27 at 11:37:53 +0100, tamarind code wrote: > >>> > There was a discussion in github about stack (see link below) where the > >>> > conclusion seems to be pointing towards a bug in Cabal on Mac OSX EL > >>> > Capitan related to forwarding DYLD_LIBRARY_PATH > >>> > >>> Is this really a bug *in Cabal*? Or is this rather a newly introduced OS > >>> limitation of El Capitan, which may even be in conflict with the POSIX > >>> specs. Quoting[1]: > >>> > >>> > Spawning children processes of processes restricted by System > >>> > Integrity Protection, such as by launching a helper process in a > >>> > bundle with NSTask or calling the exec(2) command, resets the Mach > >>> > special ports of that child process. Any dynamic linker (dyld) > >>> > environment variables, such as DYLD_LIBRARY_PATH, are purged when > >>> > launching protected processes. > >>> > >>> So OSX deliberately interferes with environment-variable inheritance. So > >>> what is Cabal even supposed to do here? This also seems like a rather > >>> radical change, which will have probably broken a lot of other software > >>> projects relying that DYLD_LIBRARY_PATH is inherited throughout process > >>> creations. > >>> > >>> > >>> > >>> [1]: > >>> https://developer.apple.com/library/prerelease/mac/documentation/Security/Conceptual/System_Integrity_Protection_Guide/RuntimeProtections/RuntimeProtections.html#//apple_ref/doc/uid/TP40016462-CH3-SW1 > >>> > >> > >> > > > > _______________________________________________ > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > From lemming at henning-thielemann.de Tue Mar 22 08:39:49 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 09:39:49 +0100 (CET) Subject: Haskell Foldable Wats (Was: Add conspicuously missing Functor instances for tuples) In-Reply-To: References: <56CDAA40.6060504@nottingham.ac.uk> <22B950C955F8AB4196E72698FBD00002D02E4E15@UKWPIPXMB01C.zone1.scb.net> Message-ID: On Wed, 24 Feb 2016, Christopher Allen wrote: > Were any of these objections put forward in 1993 when Mark P. Jones > published on constructor classes [1] ? Everything about this follows > directly and uniquely from that design. > [1]:?http://web.cecs.pdx.edu/~mpj/pubs/fpca93.pdf I don't think so. As I have shown there could have been generalizations of 'length' where 'length (a,b) = 2'. That would not be a generalization via Foldable, though. And again, I do not propose to implement 'length (a,b) = 2'. From lemming at henning-thielemann.de Tue Mar 22 09:19:27 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 10:19:27 +0100 (CET) Subject: Haskell Foldable Wats In-Reply-To: References: <87bn76jfn1.fsf@feelingofgreen.ru> <877fhujffx.fsf@feelingofgreen.ru> <87io1ehydu.fsf@feelingofgreen.ru> <56CDE814.5030708@bitemyapp.com> <40D33418-A3ED-421F-BF15-6E01D39498EA@gmail.com> <22B950C955F8AB4196E72698FBD00002D02E52FF@UKWPIPXMB01C.zone1.scb.net> Message-ID: On Thu, 25 Feb 2016, Mark Roberts wrote: > Perhaps such warnings could be added to a tool like HLint? I do not think they belong in GHC. HLint is intended for simplifying complicated code, but not for finding bugs. It emits several false positives, thus I only run it occassionally. I know I can disable certain HLint warnings, but there are really ones that I respect at one place and ignore at other places. From lemming at henning-thielemann.de Tue Mar 22 09:20:51 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 10:20:51 +0100 (CET) Subject: Haskell Foldable Wats In-Reply-To: <56CDE814.5030708@bitemyapp.com> References: <56CC9454.5010204@stilo.com> <56CD7085.6030309@chalmers.se> <474e8ad724bc436ea7df6278150e1a03@DB4PR30MB030.064d.mgd.msft.net> <87fuwijfu7.fsf@feelingofgreen.ru> <87bn76jfn1.fsf@feelingofgreen.ru> <877fhujffx.fsf@feelingofgreen.ru> <87io1ehydu.fsf@feelingofgreen.ru> <56CDE814.5030708@bitemyapp.com> Message-ID: On Wed, 24 Feb 2016, Chris Allen wrote: > You can't not-include the instances because we'll just end up with orphans so that's not cricket I think. We could define instance Impossible a => Functor ((,,) a b) where where Impossible is a non exported class. From lemming at henning-thielemann.de Tue Mar 22 09:21:28 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 10:21:28 +0100 (CET) Subject: Haskell Foldable Wats In-Reply-To: References: <56CC9454.5010204@stilo.com> <56CD7085.6030309@chalmers.se> <474e8ad724bc436ea7df6278150e1a03@DB4PR30MB030.064d.mgd.msft.net> <87fuwijfu7.fsf@feelingofgreen.ru> <87bn76jfn1.fsf@feelingofgreen.ru> <877fhujffx.fsf@feelingofgreen.ru> <87io1ehydu.fsf@feelingofgreen.ru> <56CDE814.5030708@bitemyapp.com> Message-ID: On Wed, 24 Feb 2016, Manuel G?mez wrote: > To avoid this unhelpful outcome, if the community decided to forbid > these instances, some language extension would have to be designed to > forbid instance definitions. This has been discussed previously. It's possible to achieve this without language extensions. > If the community did this, it would break a lot of code that does use > these instances, and there would be no workaround, The backwards-compatible work-around would be simple: Don't use fmap, but mapThd3 and friends. It would be a good opportunity to cleanup code. From lemming at henning-thielemann.de Tue Mar 22 09:22:09 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 10:22:09 +0100 (CET) Subject: Haskell Foldable Wats In-Reply-To: <40D33418-A3ED-421F-BF15-6E01D39498EA@gmail.com> References: <56CC9454.5010204@stilo.com> <56CD7085.6030309@chalmers.se> <474e8ad724bc436ea7df6278150e1a03@DB4PR30MB030.064d.mgd.msft.net> <87fuwijfu7.fsf@feelingofgreen.ru> <87bn76jfn1.fsf@feelingofgreen.ru> <877fhujffx.fsf@feelingofgreen.ru> <87io1ehydu.fsf@feelingofgreen.ru> <56CDE814.5030708@bitemyapp.com> <40D33418-A3ED-421F-BF15-6E01D39498EA@gmail.com> Message-ID: On Wed, 24 Feb 2016, amindfv at gmail.com wrote: > What happened in the FTP was that the libraries@ had a heated > discussion, the issue was taken to the users and to a vote, and we ended > up with a clear message from users: 80% voted in one direction. And the community as a whole is still not happy. > My suspicion is that on this issue too, libraries@ is more divided > than the community is. I suggest we try to put this issue to bed, and if > ~80% of the community says they don't want these instances, then yes -- > core libraries should use Writer instead of redefining their own > instance for (,). Similarly, if ~80% want the instances, we can grumble > that users are wrong but democracy has spoken. That's not democracy, but majority. I think we need other ways for making decisions. I had already proposed one. From lemming at henning-thielemann.de Tue Mar 22 09:24:27 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 10:24:27 +0100 (CET) Subject: Haskell Foldable Wats In-Reply-To: <22B950C955F8AB4196E72698FBD00002D02E52FF@UKWPIPXMB01C.zone1.scb.net> References: <87fuwijfu7.fsf@feelingofgreen.ru> <87bn76jfn1.fsf@feelingofgreen.ru> <877fhujffx.fsf@feelingofgreen.ru> <87io1ehydu.fsf@feelingofgreen.ru> <56CDE814.5030708@bitemyapp.com> <40D33418-A3ED-421F-BF15-6E01D39498EA@gmail.com> <22B950C955F8AB4196E72698FBD00002D02E52FF@UKWPIPXMB01C.zone1.scb.net> Message-ID: On Thu, 25 Feb 2016, Augustsson, Lennart wrote: > Yes, at this point I think the best we can do is to make sure we get good warnings. > I'd suggest that we can attach a warning to a method in each instance. > So when using length on a tuple we'd get a warning. > I don't even want to upgrade ghc to get the FTP until such a warning is in place (we are still on 7.8). Me too. I have earlier written about the wish for such warnings. A general solution would be close to explicit import of instances and is certainly far away. If we can agree on warnings on 'length' on tuples this would be simpler and might already help. From lemming at henning-thielemann.de Tue Mar 22 09:35:23 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 22 Mar 2016 10:35:23 +0100 (CET) Subject: Haskell Foldable Wats In-Reply-To: References: <56C5D509.9060806@ifi.lmu.de> <56C5DAEA.9060202@ifi.lmu.de> <22B950C955F8AB4196E72698FBD00002D02E4A7F@UKWPIPXMB01C.zone1.scb.net> <56CC9454.5010204@stilo.com> <56CD7085.6030309@chalmers.se> <474e8ad724bc436ea7df6278150e1a03@DB4PR30MB030.064d.mgd.msft.net> <56CE1EDF.5040102@chalmers.se> Message-ID: On Thu, 25 Feb 2016, Edward Kmett wrote: > Re: FTP as a whole > > The FTP on the whole was and remains overwhelmingly popular. Frankly, the vast majority, not all, but most of the users > complaining in this thread are the same people who were complaining about the FTP in the first place, rehashing > precisely the same arguments. The FTP itself passed with an overwhelming 82% majority. If we can't act in the presence > of that large of a public majority, when _can_ we act? It's certainly comfortable to argue this way if your opinion is that of the majority. In the library submissions process [1] it is acknowledged that a majority vote needs not to be the final criterion. I think it would be better to work towards a consensus. The consensus here could be: We acknowledge different styles of programming and therefore different expectations to the compiler. Some programmers consider it a bug if 'length' is defined on tuples, other ones consider it a useful feature. In order to serve both sides we add warnings for those who want them. But these warnings should be bundled together with the instance additions and not deferred indefinitely. [1] https://wiki.haskell.org/Library_submissions From ollie at ocharles.org.uk Tue Mar 22 10:08:03 2016 From: ollie at ocharles.org.uk (Oliver Charles) Date: Tue, 22 Mar 2016 10:08:03 +0000 Subject: Haskell Foldable Wats In-Reply-To: References: <56CC9454.5010204@stilo.com> <56CD7085.6030309@chalmers.se> <474e8ad724bc436ea7df6278150e1a03@DB4PR30MB030.064d.mgd.msft.net> <87fuwijfu7.fsf@feelingofgreen.ru> <87bn76jfn1.fsf@feelingofgreen.ru> <877fhujffx.fsf@feelingofgreen.ru> <87io1ehydu.fsf@feelingofgreen.ru> <56CDE814.5030708@bitemyapp.com> Message-ID: Even better might be to use GHC 8 custom type errors in the constraint head to explain what 'Impossible' means. On Tue, 22 Mar 2016 10:21 am Henning Thielemann, < lemming at henning-thielemann.de> wrote: > > On Wed, 24 Feb 2016, Chris Allen wrote: > > > You can't not-include the instances because we'll just end up with > orphans so that's not cricket I think. > > We could define > > instance Impossible a => Functor ((,,) a b) where > > where Impossible is a non exported class. > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From lemming at henning-thielemann.de Wed Mar 23 13:16:00 2016 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Wed, 23 Mar 2016 14:16:00 +0100 (CET) Subject: Warn about unwanted instances in a modular way Message-ID: I like to propose the following way to warn about instances that are unwanted by some programmers. First step is to mark the instances at their definition site like so: {-# WARN_INSTANCE tuple #-} instance Foldable ((,) a) where ... {-# WARN_INSTANCE tuple #-} instance Functor ((,) a) where ... {-# WARN_INSTANCE tuple #-} instance Foldable ((,,) a b) where ... {-# WARN_INSTANCE tuple #-} instance Functor ((,,) a b) where ... This way, all the above instances are collected in an instance group labelled 'tuple'. At the use sites we introduce a GHC warning option like -fwarn-instance=tuple. This warns about any place where any of the 'tuple' instances is used. We can either place GHC-Options: -fwarn-instance=tuple in a Cabal package description in order to issue warnings in a whole package or we can put {-# OPTIONS_GHC -fwarn-instance=tuple #-} at the top of a module in order to enable the warning per module. Another candidate for an instance group might be 'numeric' for numeric instances of functions and tuples in the NumInstances package. What does it mean to use an instance? I would say, if omitting an instance X Y would lead to a "missing instance" type error at place Z in a module, then instance X Y is used at place Z. There might be an even more restrictive option like: -fforbid-instance=tuple This would not only warn about an instance usage, but it would cause a type error. Essentially it should treat all 'tuple' instances as if they were not defined. (Other instances might depend on 'tuple' instances and if the 'tuple' instances weren't there the compiler would not even reach the current module. I do not know, whether this case needs special treatment. We might require that any instance depending on 'tuple' must be added to the 'tuple' group as well or it might be added automatically.) The advantage of a type error is that we see all problems from 'tuple' instances also in the presence of other type errors. Warnings would only show up after a module is otherwise type correct. This solution requires cooperation of the instance implementor. Would that work in practice? Otherwise we must think about ways to declare instance groups independently from the instance declaration and we get the problem of bringing the instance group names into the scope of the importing module. A separate discussion must be held on whether -fwarn-instance=tuple should be part of -Wall. I think that people should be warned about 'tuple' instances early because they won't expect that there is a trap when using 'length' and 'maximum' and so on. One might also think about generalizations, e.g. whether {-# WARN_INSTANCE tuple, functor #-} should be allowed in order to put an instance in several groups or whether there should be a way to compose a group from subgroups. Another topic would be a form of instance group disambiguation. Instance groups might be qualified with module or package names. I think package names are more appropriate, like so: -fwarn-instance=base:tuple From mle+hs at mega-nerd.com Thu Mar 31 23:21:45 2016 From: mle+hs at mega-nerd.com (Erik de Castro Lopo) Date: Fri, 1 Apr 2016 10:21:45 +1100 Subject: A better type signature for `forM_` Message-ID: <20160401102145.89569849ba63288f9596097e@mega-nerd.com> Hi all, I was recently faced with some unexpected behaviour from a piece of code that type checks and has zero warnings (even with -Wall). The code is below (and depends on the hashtables package). The error was using the <$> operator instead of the =<< operator. Using the former, it just builds up a list of IO actions that never get run. As pointed out to me on IRC (thanks pjdeport), chaning the type signature of `forM_` to forM_' :: (Monad m, Foldable t) => t a -> (a -> m ()) -> m () would have resulted in an error. Yes, this change would break existing code (breaking code would require an explicit `void $` inside the `forM_`) but does anyone else think this is a good idea? Erik import Control.Monad import qualified Data.HashTable.IO as HT type EvenCache = HT.BasicHashTable Int Bool main :: IO () main = do ht <- buildTable xs <- HT.toList ht putStrLn $ "cache: length " ++ show (length xs) buildTable :: IO EvenCache buildTable = do ht <- HT.new forM_ pairs $ \ (k,v) -> maybe (HT.insert ht k v) (const $ abort k) <$> HT.lookup ht k return ht where xs = [1 .. 10] :: [Int] pairs = map (\ i -> (i, even i)) xs abort k = error $ "cache: duplicate key " ++ show k ++ "." -- ---------------------------------------------------------------------- Erik de Castro Lopo http://www.mega-nerd.com/ From yom at artyom.me Thu Mar 31 23:37:26 2016 From: yom at artyom.me (Artyom) Date: Fri, 1 Apr 2016 02:37:26 +0300 Subject: A better type signature for `forM_` In-Reply-To: <20160401102145.89569849ba63288f9596097e@mega-nerd.com> References: <20160401102145.89569849ba63288f9596097e@mega-nerd.com> Message-ID: <56FDB4B6.7040205@artyom.me> For me the convenience of |for_| (without having to use |void|) is more important than increased safety, but I accept that others? needs are different ? sometimes avoiding such nasty surprises is incredibly important, sometimes not so, and it depends both on the developer and the project. In an ideal world it?d probably be an optional warning (which I?d be able to disable, just like I do with |fwarn-unused-do-bind|), but I have no idea how hard it would be to implement and I can't imagine how it might look anyway. Bottom line: if it will result in an error and not a warning (i.e. changing the type of |mapM_|/|forM_|/|for_|, as originally proposed), I?m mildly against this idea. ? -------------- next part -------------- An HTML attachment was scrubbed... URL: