From david.feuer at gmail.com Thu Aug 10 04:29:27 2017 From: david.feuer at gmail.com (David Feuer) Date: Thu, 10 Aug 2017 00:29:27 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: The (==) type family in Data.Type.Equality was designed largely to calculate structural equality of types. However, limitations of GHC's type system at the type prevented this from being fully realized. Today, with TypeInType, we can actually do it, replacing the boatload of ad hoc instances like so: type (a :: k) == (b :: k) = Equal k a b infix 4 == type family Equal (k :: Type) (a :: k) (b :: k) where Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = Equal (j -> k) f g && Equal j a b Equal k a a = 'True Equal k a b = 'False This == behaves in a much more uniform way than the current one. I see two potential causes for complaint: 1. For types of kind *, the new version will sometimes fail to reduce when the old one succeeded (and vice versa). For example, GHC currently accepts eqeq :: forall (a :: *). proxy a -> (a == a) :~: 'True eqeq _ = Refl while the proposed version does not. 2. Some users may want non-structural equality on their types for some reason. The only example in base is type instance (a :: ()) == (b :: ()) = 'True which consists two types of kind () the same even if they're stuck types. But perhaps someone wants to implement a non-trivial type-level data structure with a special notion of equality. I don't think (1) is really worth worrying too much about. For (2), if users want to have control, we could at least use a mechanism similar to the above to make the obvious instances easier to write. -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Aug 10 04:44:33 2017 From: david.feuer at gmail.com (David Feuer) Date: Thu, 10 Aug 2017 00:44:33 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: To be more specific about the ad hoc equality option, I'm thinking about something like this (if it doesn't compile, I'm sure something similar will): type family (a :: k) == (b :: k) :: Bool infix 4 == type family Equal (k :: Type) (a :: k) (b :: k) where Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = Equal (j -> k) f g && (a == b) Equal k a a = 'True Equal k a b = 'False type instance (a :: Type) == b = Equal Type a b type instance (a :: Maybe k) == b = Equal Type a b .... So for example, we'd get 'Just (x :: k) == 'Just y = Equal (k -> Maybe k) 'Just && x == y = x == y On Aug 10, 2017 12:29 AM, "David Feuer" wrote: The (==) type family in Data.Type.Equality was designed largely to calculate structural equality of types. However, limitations of GHC's type system at the type prevented this from being fully realized. Today, with TypeInType, we can actually do it, replacing the boatload of ad hoc instances like so: type (a :: k) == (b :: k) = Equal k a b infix 4 == type family Equal (k :: Type) (a :: k) (b :: k) where Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = Equal (j -> k) f g && Equal j a b Equal k a a = 'True Equal k a b = 'False This == behaves in a much more uniform way than the current one. I see two potential causes for complaint: 1. For types of kind *, the new version will sometimes fail to reduce when the old one succeeded (and vice versa). For example, GHC currently accepts eqeq :: forall (a :: *). proxy a -> (a == a) :~: 'True eqeq _ = Refl while the proposed version does not. 2. Some users may want non-structural equality on their types for some reason. The only example in base is type instance (a :: ()) == (b :: ()) = 'True which consists two types of kind () the same even if they're stuck types. But perhaps someone wants to implement a non-trivial type-level data structure with a special notion of equality. I don't think (1) is really worth worrying too much about. For (2), if users want to have control, we could at least use a mechanism similar to the above to make the obvious instances easier to write. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivan.miljenovic at gmail.com Thu Aug 10 05:35:20 2017 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Thu, 10 Aug 2017 15:35:20 +1000 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: On 10 August 2017 at 14:44, David Feuer wrote: > To be more specific about the ad hoc equality option, I'm thinking about > something like this (if it doesn't compile, I'm sure something similar > will): > > type family (a :: k) == (b :: k) :: Bool > infix 4 == > > type family Equal (k :: Type) (a :: k) (b :: k) where > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = > Equal (j -> k) f g && (a == b) > Equal k a a = 'True > Equal k a b = 'False > > type instance (a :: Type) == b = Equal Type a b > type instance (a :: Maybe k) == b = Equal Type a b Since this is a closed type family, isn't doing any extra explicit type instances illegal? > .... > > So for example, we'd get > > 'Just (x :: k) == 'Just y > = > Equal (k -> Maybe k) 'Just && x == y > = > x == y > > On Aug 10, 2017 12:29 AM, "David Feuer" wrote: > > The (==) type family in Data.Type.Equality was designed largely to calculate > structural equality of types. However, limitations of GHC's type system at > the type prevented this from being fully realized. Today, with TypeInType, > we can actually do it, replacing the boatload of ad hoc instances like so: > > type (a :: k) == (b :: k) = Equal k a b > infix 4 == > > type family Equal (k :: Type) (a :: k) (b :: k) where > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = > Equal (j -> k) f g && Equal j a b > Equal k a a = 'True > Equal k a b = 'False > > This == behaves in a much more uniform way than the current one. I see two > potential causes for complaint: > > 1. For types of kind *, the new version will sometimes fail to reduce when > the old one succeeded (and vice versa). For example, GHC currently accepts > > eqeq :: forall (a :: *). proxy a -> (a == a) :~: 'True > eqeq _ = Refl > > while the proposed version does not. > > 2. Some users may want non-structural equality on their types for some > reason. The only example in base is > > type instance (a :: ()) == (b :: ()) = 'True > > which consists two types of kind () the same even if they're stuck types. > But perhaps someone wants to implement a non-trivial type-level data > structure with a special notion of equality. > > > I don't think (1) is really worth worrying too much about. For (2), if users > want to have control, we could at least use a mechanism similar to the above > to make the obvious instances easier to write. > > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From david.feuer at gmail.com Thu Aug 10 05:46:14 2017 From: david.feuer at gmail.com (David Feuer) Date: Thu, 10 Aug 2017 01:46:14 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: (==), in that option, is an open type family, and Equal (more likely a synonym dealing with its kind) is a helper function. Note that Equality, in this version, calls == to deal with arguments. type DefaultEq (a :: k) (b :: k) = Equal k a b Then if con1 and con2 are constructors, DefaultEq (con1 a b) (con2 c d) = (con1 exactly equals con2) && a == c && b == d The == for the kinds of a/c and b/d could be anything a user wishes. On Aug 10, 2017 1:35 AM, "Ivan Lazar Miljenovic" wrote: > On 10 August 2017 at 14:44, David Feuer wrote: > > To be more specific about the ad hoc equality option, I'm thinking about > > something like this (if it doesn't compile, I'm sure something similar > > will): > > > > type family (a :: k) == (b :: k) :: Bool > > infix 4 == > > > > type family Equal (k :: Type) (a :: k) (b :: k) where > > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = > > Equal (j -> k) f g && (a == b) > > Equal k a a = 'True > > Equal k a b = 'False > > > > type instance (a :: Type) == b = Equal Type a b > > type instance (a :: Maybe k) == b = Equal Type a b > > Since this is a closed type family, isn't doing any extra explicit > type instances illegal? > > > .... > > > > So for example, we'd get > > > > 'Just (x :: k) == 'Just y > > = > > Equal (k -> Maybe k) 'Just && x == y > > = > > x == y > > > > On Aug 10, 2017 12:29 AM, "David Feuer" wrote: > > > > The (==) type family in Data.Type.Equality was designed largely to > calculate > > structural equality of types. However, limitations of GHC's type system > at > > the type prevented this from being fully realized. Today, with > TypeInType, > > we can actually do it, replacing the boatload of ad hoc instances like > so: > > > > type (a :: k) == (b :: k) = Equal k a b > > infix 4 == > > > > type family Equal (k :: Type) (a :: k) (b :: k) where > > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = > > Equal (j -> k) f g && Equal j a b > > Equal k a a = 'True > > Equal k a b = 'False > > > > This == behaves in a much more uniform way than the current one. I see > two > > potential causes for complaint: > > > > 1. For types of kind *, the new version will sometimes fail to reduce > when > > the old one succeeded (and vice versa). For example, GHC currently > accepts > > > > eqeq :: forall (a :: *). proxy a -> (a == a) :~: 'True > > eqeq _ = Refl > > > > while the proposed version does not. > > > > 2. Some users may want non-structural equality on their types for some > > reason. The only example in base is > > > > type instance (a :: ()) == (b :: ()) = 'True > > > > which consists two types of kind () the same even if they're stuck types. > > But perhaps someone wants to implement a non-trivial type-level data > > structure with a special notion of equality. > > > > > > I don't think (1) is really worth worrying too much about. For (2), if > users > > want to have control, we could at least use a mechanism similar to the > above > > to make the obvious instances easier to write. > > > > > > > > _______________________________________________ > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > > > -- > Ivan Lazar Miljenovic > Ivan.Miljenovic at gmail.com > http://IvanMiljenovic.wordpress.com > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Aug 10 05:57:40 2017 From: david.feuer at gmail.com (David Feuer) Date: Thu, 10 Aug 2017 01:57:40 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: By the way.... the nicest version of the ad hoc equality would probably use a kind class: class TEq (k :: Type) where type (==) (a :: k) (b :: k) :: Bool type a == b = DefaultEq a b So then you could write instance TEq (Maybe k) instance TEq (Either j k) instance TEq [k] instance TEq (j -> k) instance TEq () where type _ == _ = 'True etc. On Aug 10, 2017 1:46 AM, "David Feuer" wrote: > (==), in that option, is an open type family, and Equal (more likely a > synonym dealing with its kind) is a helper function. Note that Equality, in > this version, calls == to deal with arguments. > > type DefaultEq (a :: k) (b :: k) = Equal k a b > > Then if con1 and con2 are constructors, > > DefaultEq (con1 a b) (con2 c d) = > (con1 exactly equals con2) && a == c && b == d > > The == for the kinds of a/c and b/d could be anything a user wishes. > > On Aug 10, 2017 1:35 AM, "Ivan Lazar Miljenovic" < > ivan.miljenovic at gmail.com> wrote: > >> On 10 August 2017 at 14:44, David Feuer wrote: >> > To be more specific about the ad hoc equality option, I'm thinking about >> > something like this (if it doesn't compile, I'm sure something similar >> > will): >> > >> > type family (a :: k) == (b :: k) :: Bool >> > infix 4 == >> > >> > type family Equal (k :: Type) (a :: k) (b :: k) where >> > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = >> > Equal (j -> k) f g && (a == b) >> > Equal k a a = 'True >> > Equal k a b = 'False >> > >> > type instance (a :: Type) == b = Equal Type a b >> > type instance (a :: Maybe k) == b = Equal Type a b >> >> Since this is a closed type family, isn't doing any extra explicit >> type instances illegal? >> >> > .... >> > >> > So for example, we'd get >> > >> > 'Just (x :: k) == 'Just y >> > = >> > Equal (k -> Maybe k) 'Just && x == y >> > = >> > x == y >> > >> > On Aug 10, 2017 12:29 AM, "David Feuer" wrote: >> > >> > The (==) type family in Data.Type.Equality was designed largely to >> calculate >> > structural equality of types. However, limitations of GHC's type system >> at >> > the type prevented this from being fully realized. Today, with >> TypeInType, >> > we can actually do it, replacing the boatload of ad hoc instances like >> so: >> > >> > type (a :: k) == (b :: k) = Equal k a b >> > infix 4 == >> > >> > type family Equal (k :: Type) (a :: k) (b :: k) where >> > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = >> > Equal (j -> k) f g && Equal j a b >> > Equal k a a = 'True >> > Equal k a b = 'False >> > >> > This == behaves in a much more uniform way than the current one. I see >> two >> > potential causes for complaint: >> > >> > 1. For types of kind *, the new version will sometimes fail to reduce >> when >> > the old one succeeded (and vice versa). For example, GHC currently >> accepts >> > >> > eqeq :: forall (a :: *). proxy a -> (a == a) :~: 'True >> > eqeq _ = Refl >> > >> > while the proposed version does not. >> > >> > 2. Some users may want non-structural equality on their types for some >> > reason. The only example in base is >> > >> > type instance (a :: ()) == (b :: ()) = 'True >> > >> > which consists two types of kind () the same even if they're stuck >> types. >> > But perhaps someone wants to implement a non-trivial type-level data >> > structure with a special notion of equality. >> > >> > >> > I don't think (1) is really worth worrying too much about. For (2), if >> users >> > want to have control, we could at least use a mechanism similar to the >> above >> > to make the obvious instances easier to write. >> > >> > >> > >> > _______________________________________________ >> > Libraries mailing list >> > Libraries at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >> > >> >> >> >> -- >> Ivan Lazar Miljenovic >> Ivan.Miljenovic at gmail.com >> http://IvanMiljenovic.wordpress.com >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Aug 10 06:43:21 2017 From: david.feuer at gmail.com (David Feuer) Date: Thu, 10 Aug 2017 02:43:21 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: You can see the two main approaches in https://phabricator.haskell.org/D3835 and https://phabricator.haskell.org/D3837 On Thu, Aug 10, 2017 at 1:57 AM, David Feuer wrote: > By the way.... the nicest version of the ad hoc equality would probably use > a kind class: > > class TEq (k :: Type) where > type (==) (a :: k) (b :: k) :: Bool > type a == b = DefaultEq a b > > So then you could write > > instance TEq (Maybe k) > instance TEq (Either j k) > instance TEq [k] > instance TEq (j -> k) > instance TEq () where > type _ == _ = 'True > > etc. > > On Aug 10, 2017 1:46 AM, "David Feuer" wrote: >> >> (==), in that option, is an open type family, and Equal (more likely a >> synonym dealing with its kind) is a helper function. Note that Equality, in >> this version, calls == to deal with arguments. >> >> type DefaultEq (a :: k) (b :: k) = Equal k a b >> >> Then if con1 and con2 are constructors, >> >> DefaultEq (con1 a b) (con2 c d) = >> (con1 exactly equals con2) && a == c && b == d >> >> The == for the kinds of a/c and b/d could be anything a user wishes. >> >> On Aug 10, 2017 1:35 AM, "Ivan Lazar Miljenovic" >> wrote: >>> >>> On 10 August 2017 at 14:44, David Feuer wrote: >>> > To be more specific about the ad hoc equality option, I'm thinking >>> > about >>> > something like this (if it doesn't compile, I'm sure something similar >>> > will): >>> > >>> > type family (a :: k) == (b :: k) :: Bool >>> > infix 4 == >>> > >>> > type family Equal (k :: Type) (a :: k) (b :: k) where >>> > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = >>> > Equal (j -> k) f g && (a == b) >>> > Equal k a a = 'True >>> > Equal k a b = 'False >>> > >>> > type instance (a :: Type) == b = Equal Type a b >>> > type instance (a :: Maybe k) == b = Equal Type a b >>> >>> Since this is a closed type family, isn't doing any extra explicit >>> type instances illegal? >>> >>> > .... >>> > >>> > So for example, we'd get >>> > >>> > 'Just (x :: k) == 'Just y >>> > = >>> > Equal (k -> Maybe k) 'Just && x == y >>> > = >>> > x == y >>> > >>> > On Aug 10, 2017 12:29 AM, "David Feuer" wrote: >>> > >>> > The (==) type family in Data.Type.Equality was designed largely to >>> > calculate >>> > structural equality of types. However, limitations of GHC's type system >>> > at >>> > the type prevented this from being fully realized. Today, with >>> > TypeInType, >>> > we can actually do it, replacing the boatload of ad hoc instances like >>> > so: >>> > >>> > type (a :: k) == (b :: k) = Equal k a b >>> > infix 4 == >>> > >>> > type family Equal (k :: Type) (a :: k) (b :: k) where >>> > Equal k ((f :: j -> k) (a :: j)) ((g :: j -> k) (b :: j)) = >>> > Equal (j -> k) f g && Equal j a b >>> > Equal k a a = 'True >>> > Equal k a b = 'False >>> > >>> > This == behaves in a much more uniform way than the current one. I see >>> > two >>> > potential causes for complaint: >>> > >>> > 1. For types of kind *, the new version will sometimes fail to reduce >>> > when >>> > the old one succeeded (and vice versa). For example, GHC currently >>> > accepts >>> > >>> > eqeq :: forall (a :: *). proxy a -> (a == a) :~: 'True >>> > eqeq _ = Refl >>> > >>> > while the proposed version does not. >>> > >>> > 2. Some users may want non-structural equality on their types for some >>> > reason. The only example in base is >>> > >>> > type instance (a :: ()) == (b :: ()) = 'True >>> > >>> > which consists two types of kind () the same even if they're stuck >>> > types. >>> > But perhaps someone wants to implement a non-trivial type-level data >>> > structure with a special notion of equality. >>> > >>> > >>> > I don't think (1) is really worth worrying too much about. For (2), if >>> > users >>> > want to have control, we could at least use a mechanism similar to the >>> > above >>> > to make the obvious instances easier to write. >>> > >>> > >>> > >>> > _______________________________________________ >>> > Libraries mailing list >>> > Libraries at haskell.org >>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >>> > >>> >>> >>> >>> -- >>> Ivan Lazar Miljenovic >>> Ivan.Miljenovic at gmail.com >>> http://IvanMiljenovic.wordpress.com From ryan.gl.scott at gmail.com Thu Aug 10 14:59:02 2017 From: ryan.gl.scott at gmail.com (Ryan Scott) Date: Thu, 10 Aug 2017 10:59:02 -0400 Subject: Let's rework Data.Type.Equality.== Message-ID: Personally, I'd be more inclined towards latter approach (in https://phabricator.haskell.org/D3837). After all, one of the key properties of (==) (for which the Haddocks even make a special note) is that it does not attempt to provide an instance that works for every possible kind. Indeed, as you've discovered, there are cases when it doesn't make sense to use DefaultEq, such as for (). I'll tentatively give my support for D3837, although I'd be curious to hear what Richard has to say about this (since I'm reasonably confident he gave (==) its current implementation). Ryan S. From david.feuer at gmail.com Fri Aug 11 01:00:26 2017 From: david.feuer at gmail.com (David Feuer) Date: Thu, 10 Aug 2017 21:00:26 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: I tend to agree with you, although I don't think () is a compelling argument. Rather, it reuses the name == that Haskellers are accustomed to defining flexibly. But for that same reason, as well as the convenience, I do think we should consider using a kind class. That way things at the type level look pretty much like they do at the term level. On Aug 10, 2017 10:59 AM, "Ryan Scott" wrote: > Personally, I'd be more inclined towards latter approach (in > https://phabricator.haskell.org/D3837). After all, one of the key > properties of (==) (for which the Haddocks even make a special note) > is that it does not attempt to provide an instance that works for > every possible kind. Indeed, as you've discovered, there are cases > when it doesn't make sense to use DefaultEq, such as for (). > > I'll tentatively give my support for D3837, although I'd be curious to > hear what Richard has to say about this (since I'm reasonably > confident he gave (==) its current implementation). > > Ryan S. > _______________________________________________ > 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 rae at cs.brynmawr.edu Fri Aug 11 15:39:40 2017 From: rae at cs.brynmawr.edu (Richard Eisenberg) Date: Fri, 11 Aug 2017 11:39:40 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: Message-ID: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> tl;dr: I like David's first version, D3835. There is a fundamental tension in the definition of (==): Should it be reflexive or not? By "reflexive" here, I mean that (a == a) reduces to True, even if you know nothing further about a. The current definition of (==) is reflexive in this way for types of kind Type, but not for any of the other concrete instances (except the one for ()). We can't currently have our cake and it eat, too: as David points out in this thread, (==) is either reflexive or structurally recursive. It can't do both. Possibly a solution to #4259 (https://ghc.haskell.org/trac/ghc/ticket/4259 ) would allow us to have (==) that is both reflexive and structurally recursive, but I have no idea how to do it. I agree that the current choice of implementation for (==) is inconsistent in this regard and is perhaps foolish. I have no principled argument for why it is the way it is. But I wonder if we're better off embracing the distinction between a reflexive (==) and a structurally recursive (==) and provide both, with different names. Or, we could just decide to go with the structurally recursive one, which seems to be more useful, especially as I have become much more skeptical of non-linear patterns (necessary for the reflexive (==)). In particular, I don't have a good story for how they would work in Dependent Haskell. Section 5.13.2 of my thesis (http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf ) contains some technical discussion of the challenges, but that section may not be digestible on its own. The point of difference between David's two proposed changes is extensibility: that is, could someone decide to have a custom equality operator on a user-defined type? This is indeed a reasonable thing to want -- for example, you could imagine a record system that stores names of fields and their types in a type-level list, but that list should really be regarded as a set. However, worms lurk under this stone. If we have a more flexible notion of equality, how can we be sure that this more inclusive equality is always respected? Specifically, you would want this: if (ty1 == ty2) and ty1 is substituted for ty2 in some context, everything still works. Sadly, there is no way to guarantee such a property. If (==) is to be useful in a type system, we would need such a guarantee. (By "useful", I mean that this is implementable: reifyEq :: ((a == b) ~ True, Typeable a, Typeable b) => a :~: b.) This brings us to the doorstep of higher inductive types -- a door that might be fun to enter, but is a long long way off. In sum, I argue for David's first, inextensible version. By the way, nothing about this requires TypeInType. If I had thought of David's version (that splits apart type applications) in 2013, I probably would have implemented (==) that way. Richard > On Aug 10, 2017, at 9:00 PM, David Feuer wrote: > > I tend to agree with you, although I don't think () is a compelling argument. Rather, it reuses the name == that Haskellers are accustomed to defining flexibly. But for that same reason, as well as the convenience, I do think we should consider using a kind class. That way things at the type level look pretty much like they do at the term level. > > On Aug 10, 2017 10:59 AM, "Ryan Scott" > wrote: > Personally, I'd be more inclined towards latter approach (in > https://phabricator.haskell.org/D3837 ). After all, one of the key > properties of (==) (for which the Haddocks even make a special note) > is that it does not attempt to provide an instance that works for > every possible kind. Indeed, as you've discovered, there are cases > when it doesn't make sense to use DefaultEq, such as for (). > > I'll tentatively give my support for D3837, although I'd be curious to > hear what Richard has to say about this (since I'm reasonably > confident he gave (==) its current implementation). > > Ryan S. > _______________________________________________ > 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 carter.schonwald at gmail.com Fri Aug 11 16:00:14 2017 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Fri, 11 Aug 2017 16:00:14 +0000 Subject: Let's rework Data.Type.Equality.== In-Reply-To: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> References: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> Message-ID: The close family with nonlinear matching does seem simpler. Like I can comfortably read it and understand what it does reasonably well and have uniform expectations of what it means. That said, I'm open to be swayed otherwise. The On Fri, Aug 11, 2017 at 11:44 AM Richard Eisenberg wrote: > tl;dr: I like David's first version, D3835. > > There is a fundamental tension in the definition of (==): Should it be > reflexive or not? By "reflexive" here, I mean that (a == a) reduces to > True, even if you know nothing further about a. The current definition of > (==) is reflexive in this way for types of kind Type, but not for any of > the other concrete instances (except the one for ()). > > We can't currently have our cake and it eat, too: as David points out in > this thread, (==) is either reflexive or structurally recursive. It can't > do both. Possibly a solution to #4259 ( > https://ghc.haskell.org/trac/ghc/ticket/4259) would allow us to have (==) > that is both reflexive and structurally recursive, but I have no idea how > to do it. > > I agree that the current choice of implementation for (==) is inconsistent > in this regard and is perhaps foolish. I have no principled argument for > why it is the way it is. But I wonder if we're better off embracing the > distinction between a reflexive (==) and a structurally recursive (==) and > provide both, with different names. Or, we could just decide to go with the > structurally recursive one, which seems to be more useful, especially as I > have become much more skeptical of non-linear patterns (necessary for the > reflexive (==)). In particular, I don't have a good story for how they > would work in Dependent Haskell. Section 5.13.2 of my thesis ( > http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf) > contains some technical discussion of the challenges, but that section may > not be digestible on its own. > > The point of difference between David's two proposed changes is > extensibility: that is, could someone decide to have a custom equality > operator on a user-defined type? This is indeed a reasonable thing to want > -- for example, you could imagine a record system that stores names of > fields and their types in a type-level list, but that list should really be > regarded as a set. However, worms lurk under this stone. If we have a more > flexible notion of equality, how can we be sure that this more inclusive > equality is always respected? Specifically, you would want this: if (ty1 == > ty2) and ty1 is substituted for ty2 in some context, everything still > works. Sadly, there is no way to guarantee such a property. If (==) is to > be useful in a type system, we would need such a guarantee. (By "useful", I > mean that this is implementable: reifyEq :: ((a == b) ~ True, Typeable a, > Typeable b) => a :~: b.) This brings us to the doorstep of higher inductive > types -- a door that might be fun to enter, but is a long long way off. > > In sum, I argue for David's first, inextensible version. > > By the way, nothing about this requires TypeInType. If I had thought of > David's version (that splits apart type applications) in 2013, I probably > would have implemented (==) that way. > > Richard > > On Aug 10, 2017, at 9:00 PM, David Feuer wrote: > > I tend to agree with you, although I don't think () is a compelling > argument. Rather, it reuses the name == that Haskellers are accustomed to > defining flexibly. But for that same reason, as well as the convenience, I > do think we should consider using a kind class. That way things at the type > level look pretty much like they do at the term level. > > On Aug 10, 2017 10:59 AM, "Ryan Scott" wrote: > >> Personally, I'd be more inclined towards latter approach (in >> https://phabricator.haskell.org/D3837). After all, one of the key >> properties of (==) (for which the Haddocks even make a special note) >> is that it does not attempt to provide an instance that works for >> every possible kind. Indeed, as you've discovered, there are cases >> when it doesn't make sense to use DefaultEq, such as for (). >> >> I'll tentatively give my support for D3837, although I'd be curious to >> hear what Richard has to say about this (since I'm reasonably >> confident he gave (==) its current implementation). >> >> Ryan S. >> _______________________________________________ >> 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 > > > _______________________________________________ > 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 rf at rufflewind.com Fri Aug 11 20:37:11 2017 From: rf at rufflewind.com (Phil Ruffwind) Date: Fri, 11 Aug 2017 16:37:11 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> References: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> Message-ID: <1502483831.2733161.1070767336.65252552@webmail.messagingengine.com> On Fri, Aug 11, 2017, at 11:39, Richard Eisenberg wrote: > If we have a more flexible notion of equality, how can we be sure that this > more inclusive equality is always respected? Specifically, you would want > this: if (ty1 == ty2) and ty1 is substituted for ty2 in some context, > everything still works. Not too familiar with this area, but I recall at one point realizing that the only kind of user-defined equality that is consistent with Leibniz equality is when the difference occurs in rigid type variables. That is, whereas you can't make Set (A, B) == Set (B, A) since they are observably different, you can (sometimes) make F a == F b if a and b are existentially quantified variables (no-one would be the wiser). From david.feuer at gmail.com Sat Aug 12 00:28:24 2017 From: david.feuer at gmail.com (David Feuer) Date: Fri, 11 Aug 2017 20:28:24 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> References: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> Message-ID: On Aug 11, 2017 9:39 AM, "Richard Eisenberg" wrote: But I wonder if we're better off dxaa aembracing the distinction between a reflexive (==) and a structurally recursive (==) and provide both, with different names. I don't think it would be bad to offer a canonical reflexive equality test. There are probably situations where having such a thing would be marginally useful. In particular, MyEqual a b ~ 'False isn't quite the same ass Alaska YourEqual a b ~ 'False even if the two type families are defined the same. Or, we could just decide to go with the structurally recursive one, which seems to be more useful, especially as I have become much more skeptical of non-linear patterns (necessary Aziz a a add as ad ahs asf as s for the reflexive (==)). I'm a bit fuzzy on this. Don't *both* of my versions rely essentially on nonlinear patterns to compare constructors? I suppose it might c always xd Hz In particular, I don't have a good story for how they would work in Dependent Haskell. Section 5.13.2 of my thesis (http://cs.brynmawr.edu/~rae/ papers/2016/thesis/eisenberg-thesis.pdf) contains some technical discussion of the challenges, but that section may not be digestible on its own. The point of difference between David's two proposed changes is extensibility: that is, could someone decide to have a custom equality operator on a user-defined type? This is indeed a reasonable thing to want -- for example, you could imagine a record system that stores names of fields and their types in a type-level list, but that list should really be regarded as a set. However, worms lurk under this stone. If we have a more flexible notion of equality, how can we be sure that this more inclusive equality is always respected? Specifically, you would want this: if (ty1 == ty2) and ty1 is substituted for ty2 in some context, everything still works. Sadly, there is no way to guarantee such a property. If (==) is to be useful in a type system, we would need such a guarantee. (By "useful", I mean that this is implementable: reifyEq :: ((a == b) ~ True, Typeable a, Typeable b) => a :~: b.) This brings us to the doorstep of higher inductive types -- a door that might be fun to enter, but is a long long way off. In sum, I argue for David's first, inextensible version. By the way, nothing about this requires TypeInType. If I had thought of David's version (that splits apart type applications) in 2013, I probably would have implemented (==) that way. Richard On Aug 10, 2017, at 9:00 PM, David Feuer wrote: I tend to agree with you, although I don't think () is a compelling argument. Rather, it reuses the name == that Haskellers are accustomed to defining flexibly. But for that same reason, as well as the convenience, I do think we should consider using a kind class. That way things at the type level look pretty much like they do at the term level. On Aug 10, 2017 10:59 AM, "Ryan Scott" wrote: > Personally, I'd be more inclined towards latter approach (in > https://phabricator.haskell.org/D3837). After all, one of the key > properties of (==) (for which the Haddocks even make a special note) > is that it does not attempt to provide an instance that works for > every possible kind. Indeed, as you've discovered, there are cases > when it doesn't make sense to use DefaultEq, such as for (). > > I'll tentatively give my support for D3837, although I'd be curious to > hear what Richard has to say about this (since I'm reasonably > confident he gave (==) its current implementation). > > Ryan S. > _______________________________________________ > 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 rae at cs.brynmawr.edu Sat Aug 12 18:40:07 2017 From: rae at cs.brynmawr.edu (Richard Eisenberg) Date: Sat, 12 Aug 2017 14:40:07 -0400 Subject: Let's rework Data.Type.Equality.== In-Reply-To: References: <081A4914-0EAF-45C3-8C1A-E2DF82D242E4@cs.brynmawr.edu> Message-ID: Oops -- I guess that's true that your versions still rely on a non-linear pattern. I'm still fine with always using structural recursion, though. Richard > On Aug 11, 2017, at 8:28 PM, David Feuer wrote: > > On Aug 11, 2017 9:39 AM, "Richard Eisenberg" > wrote: > > But I wonder if we're better off dxaa aembracing the distinction between a reflexive (==) and a structurally recursive (==) and provide both, with different names. > > I don't think it would be bad to offer a canonical reflexive equality test. There are probably situations where having such a thing would be marginally useful. In particular, > > MyEqual a b ~ 'False > > isn't quite the same ass Alaska > > YourEqual a b ~ 'False > > even if the two type families are defined the same. > > Or, we could just decide to go with the structurally recursive one, which seems to be more useful, especially as I have become much more skeptical of non-linear patterns (necessary Aziz a a add as ad ahs asf as s for the reflexive (==)). > > I'm a bit fuzzy on this. Don't *both* of my versions rely essentially on nonlinear patterns to compare constructors? I suppose it might c always xd Hz > > > In particular, I don't have a good story for how they would work in Dependent Haskell. Section 5.13.2 of my thesis (http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf ) contains some technical discussion of the challenges, but that section may not be digestible on its own. > > The point of difference between David's two proposed changes is extensibility: that is, could someone decide to have a custom equality operator on a user-defined type? This is indeed a reasonable thing to want -- for example, you could imagine a record system that stores names of fields and their types in a type-level list, but that list should really be regarded as a set. However, worms lurk under this stone. If we have a more flexible notion of equality, how can we be sure that this more inclusive equality is always respected? Specifically, you would want this: if (ty1 == ty2) and ty1 is substituted for ty2 in some context, everything still works. Sadly, there is no way to guarantee such a property. If (==) is to be useful in a type system, we would need such a guarantee. (By "useful", I mean that this is implementable: reifyEq :: ((a == b) ~ True, Typeable a, Typeable b) => a :~: b.) This brings us to the doorstep of higher inductive types -- a door that might be fun to enter, but is a long long way off. > > In sum, I argue for David's first, inextensible version. > > By the way, nothing about this requires TypeInType. If I had thought of David's version (that splits apart type applications) in 2013, I probably would have implemented (==) that way. > > Richard > >> On Aug 10, 2017, at 9:00 PM, David Feuer > wrote: >> >> I tend to agree with you, although I don't think () is a compelling argument. Rather, it reuses the name == that Haskellers are accustomed to defining flexibly. But for that same reason, as well as the convenience, I do think we should consider using a kind class. That way things at the type level look pretty much like they do at the term level. >> >> On Aug 10, 2017 10:59 AM, "Ryan Scott" > wrote: >> Personally, I'd be more inclined towards latter approach (in >> https://phabricator.haskell.org/D3837 ). After all, one of the key >> properties of (==) (for which the Haddocks even make a special note) >> is that it does not attempt to provide an instance that works for >> every possible kind. Indeed, as you've discovered, there are cases >> when it doesn't make sense to use DefaultEq, such as for (). >> >> I'll tentatively give my support for D3837, although I'd be curious to >> hear what Richard has to say about this (since I'm reasonably >> confident he gave (==) its current implementation). >> >> Ryan S. >> _______________________________________________ >> 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 zemyla at gmail.com Mon Aug 21 16:34:42 2017 From: zemyla at gmail.com (Zemyla) Date: Mon, 21 Aug 2017 11:34:42 -0500 Subject: Skip for ReadP/ReadPrec Message-ID: It occurs to me that, when it comes to the ReadP/ReadPrec parser combinators in base, that a common use pattern is to use "look", parse the next value and the number of characters taken from the string, and then use "get" repeatedly to skip ahead that number. Something along the lines of: readSkip :: (String -> Maybe (a, Int)) -> ReadP a readSkip prs = do s <- look case prs s of Nothing -> pfail Just (a, n) -> let go i | i <= 0 = return a go i = get >> go (i - 1) in n `seq` go n It's also the sort of thing that munch, munch1, and skipSpaces do a lot, and as skipSpaces at the very least is common, it should be optimized. My thought was adding a constructor to the internal P type, like so: data P a = ... -- existing cases | Skip {-# UNPACK #-} !Int (P a) And a smart constructor, such as: skipP :: Int -> P a -> P a skipP n p | n `seq` p `seq` False = undefined skipP n p | n <= 0 = p skipP _ Fail = Fail skipP n (Skip m p) = Skip (m + n) p skipP n p = Skip n p Skips would be combined in the (>>=) and (<|>) functions: Skip n p >>= f = skipP n (p >>= f) Skip m p <|> Skip n q = case compare m n of LT -> skipP m (p <|> skipP (n - m) q) EQ -> skipP m (p <|> q) GT -> skipP n (skipP (m - n) p <|> q) Skip m p <|> Get f = Get $ \c -> skipP (m - 1) p <|> f c -- and similarly backwards Skip m p <|> Look f = Look $ \s -> Skip m p <|> f s -- and similarly backwards This would also allow for an optimization in the Look + Get case: Look fl <|> Get fg = Look $ \s -> case s of [] -> fl [] c:_ -> fl s <|> skipP 1 (fg c) The only thing that would be exported would be an actual skip function: skip :: Int -> ReadP () skip n | n `seq` False = undefined skip n = R $ \c -> skipP n $ c () And the Skip constructor can be used instead of the "discard"-like functions in munch, munch1, (<++), and skipSpaces. A "skip" function could also be included in Text.ParserCombinators.ReadPrec, but since that module is imported unqualified more often, it might collide with user-defined functions; even if it isn't exported, it can be emulated with skip :: Int -> ReadPrec () skip n = readP_to_Prec $ const $ ReadP.skip n Incidentally, if the invariant of the list in the Final constructor being non-empty is supposed to be enforced, then shouldn't the constructor for it be something along the lines of: Final (a, String) [(a, String)] ? From david.feuer at gmail.com Mon Aug 28 17:32:51 2017 From: david.feuer at gmail.com (David Feuer) Date: Mon, 28 Aug 2017 13:32:51 -0400 Subject: Does the streaming package need a new/additional maintainer? Message-ID: The streaming package has a couple old pull requests that have not been commented on. My recently reported issues and pull requests have also met with silence. It appears that the maintainer, Michael Thompson, was last active on GitHub and Reddit in April. I emailed him a few days ago, but have not yet received a response. I hope he is just on a short break, but if not, someone should probably take over the package. David From andrew.thaddeus at gmail.com Mon Aug 28 18:40:58 2017 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Mon, 28 Aug 2017 14:40:58 -0400 Subject: Does the streaming package need a new/additional maintainer? In-Reply-To: References: Message-ID: If Michael is unreachable, I would be happy to take it over. I use it a lot for work and consequently am interest in getting issues fixed. On Mon, Aug 28, 2017 at 1:32 PM, David Feuer wrote: > The streaming package has a couple old pull requests that have not > been commented on. My recently reported issues and pull requests have > also met with silence. It appears that the maintainer, Michael > Thompson, was last active on GitHub and Reddit in April. I emailed him > a few days ago, but have not yet received a response. I hope he is > just on a short break, but if not, someone should probably take over > the package. > > David > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -- -Andrew Thaddeus Martin -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.thaddeus at gmail.com Mon Aug 28 18:46:00 2017 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Mon, 28 Aug 2017 14:46:00 -0400 Subject: Does the streaming package need a new/additional maintainer? In-Reply-To: References: Message-ID: Also, whoever becomes the maintainer of streaming should also become the maintainer of streaming-bytestring. On Mon, Aug 28, 2017 at 2:40 PM, Andrew Martin wrote: > If Michael is unreachable, I would be happy to take it over. I use it a > lot for work and consequently am interest in getting issues fixed. > > On Mon, Aug 28, 2017 at 1:32 PM, David Feuer > wrote: > >> The streaming package has a couple old pull requests that have not >> been commented on. My recently reported issues and pull requests have >> also met with silence. It appears that the maintainer, Michael >> Thompson, was last active on GitHub and Reddit in April. I emailed him >> a few days ago, but have not yet received a response. I hope he is >> just on a short break, but if not, someone should probably take over >> the package. >> >> David >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >> > > > > -- > -Andrew Thaddeus Martin > -- -Andrew Thaddeus Martin -------------- next part -------------- An HTML attachment was scrubbed... URL: From gale at sefer.org Mon Aug 28 22:56:13 2017 From: gale at sefer.org (Yitzchak Gale) Date: Tue, 29 Aug 2017 01:56:13 +0300 Subject: Reviving strict-concurrency Message-ID: The base library does not provide strict variants for the basic concurrency primitives. Instead, the haddocks for Control.Concurrent.MVar recommend using Don Stewarts's strict-concurrency library: https://hackage.haskell.org/package/strict-concurrency But that library has not been buildable for years. The homepage seems no longer accessible, and there is no source repository link. I created a github repo from the tarball for version 0.2.4.1 (the latest, from 2010), and then made the minor tweaks needed to get it build with modern GHC. The library provides no tests, so I have no idea if what I did still provides the advertised guarantees or even actually works. My repo is here: https://github.com/ygale/strict-concurrency Is the library still as critical as it used to be? Perhaps not in this age of async and STM, but to me it still makes sense to offer strict versions of these primitives. If so, then perhaps this small and simple library should be taken under the wing of libraries as maintainer. In any case, could someone please at least apply my patch and upload to hackage, so that it will be buildable again? I became aware of this because I was hoping to use vacuum for a complex debugging task, but vacuum also hasn't been buildable for several years due to its dependence on strict-concurrency. Whether vacuum will actually work after several years of neglect is a separate question. Thanks, Yitz From gershomb at gmail.com Tue Aug 29 01:32:44 2017 From: gershomb at gmail.com (Gershom B) Date: Mon, 28 Aug 2017 21:32:44 -0400 Subject: Reviving strict-concurrency In-Reply-To: References: Message-ID: Yitz — do you want to request maintainership of strict-concurrency so you can do the takeover yourself? There’s a standing policy for old dons libraries that he’s happy to give maintainership to people who want to step up :-) Just email admin at hackage.haskell.org and I think it can be done in a jif. Cheers, Gershom On August 28, 2017 at 6:57:21 PM, Yitzchak Gale (gale at sefer.org) wrote: > The base library does not provide strict variants for the basic concurrency > primitives. Instead, the haddocks for Control.Concurrent.MVar recommend > using Don Stewarts's strict-concurrency library: > > https://hackage.haskell.org/package/strict-concurrency > > But that library has not been buildable for years. The homepage seems > no longer accessible, and there is no source repository link. > > I created a github repo from the tarball for version 0.2.4.1 (the latest, from > 2010), and then made the minor tweaks needed to get it build with modern > GHC. The library provides no tests, so I have no idea if what I did still > provides the advertised guarantees or even actually works. My repo is here: > > https://github.com/ygale/strict-concurrency > > Is the library still as critical as it used to be? Perhaps not in this age of > async and STM, but to me it still makes sense to offer strict versions of > these primitives. If so, then perhaps this small and simple library should be > taken under the wing of libraries as maintainer. > > In any case, could someone please at least apply my patch and upload to > hackage, so that it will be buildable again? > > I became aware of this because I was hoping to use vacuum for a complex > debugging task, but vacuum also hasn't been buildable for several years due > to its dependence on strict-concurrency. Whether vacuum will actually work > after several years of neglect is a separate question. > > Thanks, > Yitz > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > From gale at sefer.org Tue Aug 29 09:04:26 2017 From: gale at sefer.org (Yitzchak Gale) Date: Tue, 29 Aug 2017 12:04:26 +0300 Subject: Reviving strict-concurrency In-Reply-To: References: Message-ID: Gershom B wrote: > Yitz — do you want to request maintainership of strict-concurrency > so you can do the takeover yourself? I was afraid you were going to say that. :) In my opinion this is basic infrastructure, so the maintainer should be libraries. In fact, it would have been in base to begin with if not for its dependence on deepseq. And I would not be the greatest maintainer for the library. But if libraries refuses to take it and no one else wants it, I'll take it for now. Better that than the current disastrous situation. If anyone else wants to take it over at any time, I'll be happy to relinquish it, subject to informal approval by libraries committee people. Thanks, Yitz From david.feuer at gmail.com Tue Aug 29 09:07:12 2017 From: david.feuer at gmail.com (David Feuer) Date: Tue, 29 Aug 2017 05:07:12 -0400 Subject: Reviving strict-concurrency In-Reply-To: References: Message-ID: The libraries list is always available to advise library maintainers. On Aug 29, 2017 5:05 AM, "Yitzchak Gale" wrote: > Gershom B wrote: > > Yitz — do you want to request maintainership of strict-concurrency > > so you can do the takeover yourself? > > I was afraid you were going to say that. :) In my opinion this is > basic infrastructure, so the maintainer should be libraries. > In fact, it would have been in base to begin with if not for its > dependence on deepseq. And I would not be the greatest maintainer > for the library. > > But if libraries refuses to take it and no one else wants it, I'll take > it for now. Better that than the current disastrous situation. If anyone > else wants to take it over at any time, I'll be happy to relinquish it, > subject to informal approval by libraries committee people. > > Thanks, > Yitz > _______________________________________________ > 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 wolfgang-it at jeltsch.info Wed Aug 30 18:59:19 2017 From: wolfgang-it at jeltsch.info (Wolfgang Jeltsch) Date: Wed, 30 Aug 2017 21:59:19 +0300 Subject: FunctorFix Message-ID: <1504119559.21745.6.camel@jeltsch.info> Hi! There is the MonadFix class with the mfix method. However, there are situations where you need a fixed point operator of type a -> f a for some f, but f is not necessarily a monad. What about adding a FunctorFix class that is identical to MonadFix, except that it has a Functor, not a Monad, superclass constraint? All the best, Wolfgang From david.feuer at gmail.com Wed Aug 30 20:30:09 2017 From: david.feuer at gmail.com (David Feuer) Date: Wed, 30 Aug 2017 16:30:09 -0400 Subject: FunctorFix In-Reply-To: <1504119559.21745.6.camel@jeltsch.info> References: <1504119559.21745.6.camel@jeltsch.info> Message-ID: I assume you want to impose the MonadFix sliding law, ffix (fmap h . f) = fmap h (ffix (f . h)), for strict h. Do you also want the nesting law? ffix (\x -> ffix (\y -> f x y)) = ffix (\x -> f x x) Are there any other laws you'd like to add in place of the seemingly irrelevant purity and left shrinking laws? Can you give some sample instances and how one might use them? On Wed, Aug 30, 2017 at 2:59 PM, Wolfgang Jeltsch wrote: > Hi! > > There is the MonadFix class with the mfix method. However, there are > situations where you need a fixed point operator of type a -> f a for > some f, but f is not necessarily a monad. What about adding a FunctorFix > class that is identical to MonadFix, except that it has a Functor, not a > Monad, superclass constraint? > > All the best, > Wolfgang > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries