Re: [Haskell-cafe] [ghc-proposals/cafe] Partially applied type families

On Mon May 15 16:20:09 UTC 2017, Richard Eisenberg wrote:
Lots to respond to!
Thanks Richard, phew! yes. Let's break it down a bit.
I do think think there's one overarching question/theme here: Do we want functional dependencies or type-level functions? Behind AntC's arguments, I see a thrust toward functional dependencies. (Not necessarily their *syntax*, but the idea of type improvement and flexible -- that is, multidirectional -- type-level reasoning.) My dependent types work pushes me toward type-level functions.
Yes there is an overarching question. I don't think it's specifically FunDeps vs Type Functions. (Although I disagree the **Functional** Dependencies are somehow not "functional". Yes Mark Jones got the idea from Relational database theory. Where did Ted Codd get the idea from? Mathematical (binary) "relations", which are a set-theoretic account of, um, functions.) "Multidirectional type-level reasoning" is what all functional languages do: from Robinson's unification to Hindley-Milner to OutsideIn(X) to System F-subscript-superscript. There's been an example in Haskell's Prelude since ~1991: the `read` method's return type is 'demand-pulled' from context, not 'supply-pushed' from its parameter. Similarly if I write:
x :: Int x = a + (b * c)
We infer a, b, c must all be Int. Perhaps in another universe, Haskell had explicit type application from day 1, and insisted on giving type signatures for all vars (like nearly all procedural/OO languages). But we aren't in that universe, and I love Haskell/FP for being both type-safe and not pernickety in that way.
... [big snip - I'll reply separately]
I expect AntC would prefer disequality guards over closed classes.
Oh yes! I was about to say (repeating my earlier message): if we're going to ground type family instances in classes, then we need a way to distribute type instances as associated types, unless ... you're going to suggest something daft like closed classes. And then you did.
I would be interested to hear more from the community on this choice -- they're really the same as ordered equations under the hood, and it's just a choice of syntax. Maybe we can even have both.
Yes please all chip in. There were strong views expressed 5~8 years ago. My two-penn'orth: I think we can mechanically translate closed equations to guards (equality and 'apart' tests). The example in my earlier post tried to show how. For class instances (with overlaps), I think there's also a mechanical translation, but only for 'well-behaved' sets of instances. (For Incoherent sets we don't have a chance.) And of course as soon as some imported instance overlaps, we have to start again to assess well-behavedness.
Now, on to individual points:
...the Hard Thought in order to be backward compatible. (This backward compatibility necessity is one of the reasons I love working with Haskell. When adding a feature to the language, we just can't take easy ways out!)
The backwards-compatibility I particularly want to preserve is "distributed instances". That is, putting the instance code close to type decls and other functions that build or consume that type. I also want to put explicitly *in the instance decl* the restraints on what types that instance applies for. Not implicit from where it appears in a closed but lengthy/voluminous sequence of equations. Yes there must be global coherence for the class/type instances. That's a mechanical check which compilers are good at, but humans not so much.
... it was awkward to describe the overlap between two branched instances. AntC might argue that, if we just had disequality guards, it would all be much simpler. He might be right.
I'd argue it's simpler to understand each instance on its own grounds. Although a bunch of guards can get quite complex. (There was Andy A-M's example back in 2013.) The cumulative effect of the preceeding equations in the closed family is more complex. IMO.
In retrospect, it would have been nice to have the proposals process active when designing closed type families; we might have come up with a better design.
There was a huge and rather repetitive (unfortunately) discussion in several rounds 2009~2012, somewhat prompted by trying to 'fix' the Haskell 2010 standard. So that we could include MPTCs in the standard. But you can't have MPTCs without FunDeps or Type Families, or without agreeing a position on overlaps. (good luck with that!) So although MPTCs were in both GHC and Hugs before 1998, they're still not 'official' >sigh<. MPTC's omission for Haskell2010 is what I meant by:
we've lost 7~8 years of opportunity.
My recollection at the time [of developing closed Families] is that other approaches were more functional-dependency-like in character. (To wit: instance chains.)
I wish Martin Sulzmann could have been more active at the time. (He occasionally expresses the intention of getting back into Haskell.) Instance guards are really a continuation of the CHR approach. So fit nicely into whole-of-program inference with type improvement. [I dislike the non-distributivity of instance chains for the same reason I dislike closed families. Although instance chains do have some nice features. Instance guards give me that feature more directly. Whereas closed type families don't give that feature at all.]
When I did the closed type family work, I was thinking that type families were better than functional dependencies; now, my view is much more nuanced (leaning strongly toward fundeps instead of partial type families).
I'm a little unsure what you mean at the top of the post about the "idea" of FunDeps vs their specific syntax. I can simulate FunDeps with superclass constraints using Type Funs and Equality constraints. This even achieves multi-directional improvement. Is that what you want to include? It took me a long time to realise this works out better than the FunDeps arrow business, especially with overlaps. The dreaded "Instances inconsistent with FunDeps" error is a devil to fiddle with. And often ends up breaking the coverage condition. [As Iavor frequently points out.] Martin pointed out that breaking coverage (using UndecidableInstances) is not as 'safe' as SPJ had been assuming.
I don't see what's so hard [about non-unifiability].
It's not nearly as hard from a fundep point of view. ...
... [another big snip: thanks for the pointer to the
paper.]
I do have to say all this talk has made me think more about apartness constraints in FC, at least. They might be a touch simpler than the current story.
I think apartness is the criterion that's always applied to resolve instance selection under overlaps. The trouble is that the semantics for overlap has never been spelled out. (Nor, I suspect the criterion for a 'well-behaved' set of instances. I can volunteer that for you.) Apartness does not intrude inside constraints in the class/instance contexts, nor inside the body of a class instance/methods. It might help with instance selection wrt the rhs of type instance equations. AntC

On May 15, 2017, at 9:26 PM, Anthony Clayden
wrote: "Multidirectional type-level reasoning" is what all functional languages do: from Robinson's unification to Hindley-Milner to OutsideIn(X) to System F-subscript-superscript.
I disagree here: the dependently typed languages don't quite do this. For them, a type-level function is just that: it has an input that determines the output. These languages still do multi-directional type inference, but not all parts of their type system play so nicely with the multi-directional part.
I think we can mechanically translate closed equations to guards (equality and 'apart' tests). The example in my earlier post tried to show how.
Agreed.
For class instances (with overlaps), I think there's also a mechanical translation, but only for 'well-behaved' sets of instances. (For Incoherent sets we don't have a chance.) And of course as soon as some imported instance overlaps, we have to start again to assess well-behavedness.
Agreed.
The backwards-compatibility I particularly want to preserve is "distributed instances". That is, putting the instance code close to type decls and other functions that build or consume that type.
I think one other key difference between our viewpoints is that I view the whole idea of "type instance" to be a bit backward: I view type families as type-level functions. Like other functions, I want the defining equations to be all in one place. Of course, class methods are distributed in exactly the same way as type instances, but most of my work with type families has not needed the distributed aspect of them. This isn't to argue that my viewpoint is right or that other viewpoints are wrong. It's just a way to understand why we both see things the way we do.
I'd argue it's simpler to understand each instance on its own grounds.
Permit me to rewrite your sentence to something that resonates better with me:
I'd argue it's simpler to understand each *equation* on its own grounds.
I agree here, but it's a bit subtler. We aren't confused when we see
f [] = False f _ = True
even though the meaning of the second equation crucially depends on it appearing after the first. Functional programmers are used to ordering like this. But when things get more complicated, perhaps you're right.
There was a huge and rather repetitive (unfortunately) discussion in several rounds 2009~2012,
These dates might help to explain why I may be repeating old arguments. I became active in the community somewhere in 2012.
I'm a little unsure what you mean at the top of the post about the "idea" of FunDeps vs their specific syntax.
By "idea", I mean traits like multidirectionality and attachment to classes. I maintain that the function-application syntax of type families is better than the relational syntax of fundeps.
A set of instances is well-behaved wrt overlap iff for each pairing of instances, one of:
Thanks for this analysis. I agree.
Rules for guards: a) The guards are a comma-sep list of equal (~) or apart (/~) comparisons. b) The comparands must be same-kinded. (I'll leave the poly kinded case for Richard ;-) c) Can only use type vars from the head. (I.e. not introduce extra vars, which contexts can do.) d) No type functions -- too hard, and not injective. e) Can use wildcard `_` as a type place-holder. f) Can use Type constructors to arbitrary nesting.
I agree here, too, though I'm not sure we need to allow ~ guards. (I think allowing them would cause confusion, with many people asking about the difference between an equality constraint and an equality guard. They're different, but I think the equality guard is useless [except as a type-level "let", I suppose].)
The key observation is this: partiality in types is bizarre, and we don't want it. ...
Huh? Nearly all type families (and class instances) are partial. You perhaps mean "don't want it" as purist type-theoreticians(?)
Partial type families (including non-terminating ones) are bizarre because they cause wrinkles in the fabric of type families. Some of the strangeness of closed type families (Section 6 of the original Closed Type Families paper) and all of the strangeness of injective type families are caused by partiality. So I dislike partial type families for very practical reasons. Of course, when you protect a partial type family by a class constraint, then it's not troublesome: that's the point of the Constrained Type Families paper.
Sometimes I deliberately want there to be no instance for some specific pattern.
Indeed yes. And now you can, with TypeError (https://ghc.haskell.org/trac/ghc/wiki/Proposal/CustomTypeErrors, which is now available in GHC 8). The problem with instance chains is their backtracking capability, but we can have failure without backtracking.
Errk I see a fly in the ointment with these 'closed classes'/associated types. Suppose:
A class with two assoc types * One assoc type needs the instances in a specific sequence. * The other assoc type needs the instances in a different sequence.
Here's a simple (as in daft!) example:
Hm. Interesting, illustrative example. Bottom line: You win. I'm convinced. Apartness guards (feel free to fight me on the name here -- I don't feel strongly, but somehow I like "apartness guards" more than "disequality guards") subsume OverlappingInstances (when the author of the instances has a particular desired way to resolve overlap) and closed type families. I think that the syntax of closed type families is often what the user wants, but I admit that CTFs don't cover all scenarios, especially in the context of Constrained Type Families. So I think we should keep CTFs (for now -- until Dependent Haskell is here) but add this new syntax as well, which would subsume the newly-proposed closed type classes. Even better, I think apartness guards would be very easy to implement. All the plumbing is already installed: we basically just have to add a switch. Next step: write a ghc-proposal. I'll support it. If I had the time, I'd even implement it. Thanks for getting me to think about all this in a new way! Richard

I know I am just jumping in the middle of an already long discussion.
Bottom line: You win. I'm convinced. Apartness guards (feel free to fight me on the name here -- I don't feel strongly, but somehow I like "apartness guards" more than "disequality guards") subsume OverlappingInstances (when the author of the instances has a particular desired way to resolve overlap) and closed type families. I think that the syntax of closed type families is often what the user wants, but I admit that CTFs don't cover all scenarios, especially in the context of Constrained Type Families. So I think we should keep CTFs (for now -- until Dependent Haskell is here) but add this new syntax as well, which would subsume the newly-proposed closed type classes.
Even better, I think apartness guards would be very easy to implement. All the plumbing is already installed: we basically just have to add a switch.
I would like to advise against this idea of apartness guards. I've tried myself some years ago, and I remember them being quite complicated to describe. The main problem is that apartness may end up introducing some sort of backtracking in the type checking process -- something completely undesirable. Furthermore, they make the work of the overlapping checks much harder. Alejandro

On May 24, 2017, at 3:57 AM, Alejandro Serrano Mena
wrote: I would like to advise against this idea of apartness guards. I've tried myself some years ago, and I remember them being quite complicated to describe. The main problem is that apartness may end up introducing some sort of backtracking in the type checking process -- something completely undesirable. Furthermore, they make the work of the overlapping checks much harder.
Do you recall an example of where things went wrong? It seems to me that GHC does this today. If I have
instance C (Maybe a) where ... instance {-# OVERLAPPING #-} C (Maybe Int) where ...
then GHC won't choose the first instance unless it knows that `a` is apart from Int. Indeed, it is possible to write a program that is accepted with only the first instance in scope but is rejected when the second one is, too. Under instance guards, this could be written
instance C (Maybe a) | a /~ Int where ... instance C (Maybe Int) where ...
and then both instances stand alone and make sense independent of one another. Richard
participants (3)
-
Alejandro Serrano Mena
-
Anthony Clayden
-
Richard Eisenberg