Local evidence and type class instances

Hi GHC users, Now that the Glorious New type checker can handle local evidence seamlessly, is it a big implementation burden to extend it to deal with local *type class instances* in addition to local *equality constraints*? For example, you could write this: """ f :: Bool f = id < id where instance Ord (a -> b) where _ `compare` _ = LT """ Not only would this prevent instances from "leaking" into all importing modules, but you could refer to *lexically scoped variables* in the type class instance. This would let programmers implement e.g. implicit configurations in the style of Kieslyov and Shan (http://okmij.org/ftp/Haskell/types.html#Prepose) without any mad hackery to tunnel pointers through the type system. Of course, it could lead to problems. For example: """ newtype MyInt = MyInt { unMyInt :: Int } f :: [Int] -> S.Set Int f xs = S.map unMyInt $ S.toList (map MyInt xs) where instance Ord MyInt where x `compare` y = unMyInt x `compare` unMyInt y g :: [Int] -> S.Set Int g xs = S.map unMyInt $ S.toList (map MyInt xs) where instance Ord MyInt where x `compare` y = unMyInt y `compare` unMyInt x main = do let s1 = f [1, 2] s2 = g [1, 2] print $ s1 == s2 -- prints False! print $ S.toList s1 == s2 -- prints True! """ I don't think this is a big problem. It would be up to the users of this extension to do the Right Thing. As Kieslyov and Shan point out, this extension also kills the principal types property - but so do GADTs. Just add more type signatures! Are there big theoretical problems with this extension, or is it just a lack of engineering effort that has prevented its implementation? Max

On Sat, Oct 16, 2010 at 7:11 AM, Max Bolingbroke
Hi GHC users,
Now that the Glorious New type checker can handle local evidence seamlessly, is it a big implementation burden to extend it to deal with local *type class instances* in addition to local *equality constraints*?
For example, you could write this:
""" f :: Bool f = id < id where instance Ord (a -> b) where _ `compare` _ = LT """
Along similar lines as my last post, would I be able to write the following type signature: myFunct :: Ord Int => Int -> (...) and have it always use the local instance for Ord Int? Is this the type that the type checker would infer for my function? Antoine

| Now that the Glorious New type checker can handle local evidence | seamlessly, is it a big implementation burden to extend it to deal | with local *type class instances* in addition to local *equality | constraints*? ... | Are there big theoretical problems with this extension, or is it just | a lack of engineering effort that has prevented its implementation? The issues I know about are a) overlap (of course) b) coherence (two different instances in two places) c) if you add associated types, then soundness too d) completeness Concerning (c) you can't define (type instance F Int = Bool) in one place and (type instance F Int = Char) somewhere else, or you'll have seg faults. GHC checks that you don't, but it can only do that because the instances are global. Perhaps most important Concerning (d) we only have a theory for local *constraints*, not for local *constraint schemes* (ie with foralls in them). To get complete inference with assumptions like (F (G x) ~ G x) was tricky enough. Adding schemes would make it harder. But yes, it'd be useful. As well as Oleg and Ken's paper, the "Derivable type classes" paper that Ralf and I wrote some time ago argues for local constraint schemes. Simon

Hello,
Now that the Glorious New type checker can handle local evidence seamlessly, is it a big implementation burden to extend it to deal with local *type class instances* in addition to local *equality constraints*?
For example, you could write this:
""" f :: Bool f = id < id where instance Ord (a -> b) where _ `compare` _ = LT """
I dislike the fact that you can produce incoherent instances with that extension. How about a restricted version that only works on fresh types? f :: Bool -> Bool f b = N id < N id where -- N is a fresh type, unique to a particular application of f. newtype N = N (a -> b) instance Ord N where _ `compare` _ = LT This is sufficient for implicit configurations, and avoids the overlap of the new instances with existing instances. I don't know how much extra burden local type definitions like these would add. Bertram
participants (4)
-
Antoine Latter
-
Bertram Felgenhauer
-
Max Bolingbroke
-
Simon Peyton-Jones