Re: [Haskell-cafe] Increasing Haskell modularity

The issue with local instances is very complicated one. First, they are sorely missed. However, they present quite a problem. Let us assume they are implemented and consider the following function f1 :: Int -> String f1 x = let instance Show Int where show _ = "one" in show x I think we all agree (f1 1) should evaluate to "one". However, given f2 :: Show a => a -> String f2 x = let instance Show Int where show _ = "one" in show x what should (f2 (1::Int)) return? One answer is that it should still return "one" -- that is, local instances should sort of form a closure (like local variables in the real closure). That is a good answer, but may lead to unpleasant surprises because the fact of the closure is not at all reflected in the type of the function. Consider data T = T f3 :: Show a => a -> String f3 x = let instance Show T where show _ = "T" in show x and take the closure semantics. The type says that to make (f3 T) well-typed, there has to be an instance Show T in scope. The user of f3 has no way to know of the private local instance that is closed over (short of examining the source code). Since the user knows there is no global instance T, the user attempts to define in. The user will be quite surprised to discover that (f3 T) is well-typed but their global instance Show T has no effect. Let us assume the opposite of the closure semantics -- local instances are not closed. So, local instances should behave sort of dynamically scoped variables (which are not captured in closures). Therefore, (f2 (1::Int)) should return "1". Such a choice is also problematic. Suppose GHC, seeing our call to f2, notices that the polymorphic f2 is called at type Int and decides, to save time on indirect dictionary calls, to specialize f2 to the type Int. So, GHC will generate a specialized instance of f2: f2_Int :: Int -> String f2_Int x = let instance Show Int where show _ = "one" in show x and we have already decided that (f2_Int 1), should return "one" rather than "1" (since f2_Int looks just like f1). Previously, specialization of a function was easy to understand: GHC may, at will, create a copy of a polymorphic function and instantiate it at a specific type. Then all calls to the polymorphic function at that specific type are replaced with the calls to the specialized function. The user can even do such a specialization themselves. With unclosed local instances, such a specialization changes the program behavior. We have to complicate the matters. Further, what should (f4 (1::Int)) return? f4 :: Show a => a -> String f4 x = let instance Show Int where show _ = "two" in f2 x Stefan Kaes, the person who introduced ``parametric overloading'' (type classes, in modern term) chose the ``closure semantics''. His system and prototype implementation had only local instances (and even local type classes). http://okmij.org/ftp/Computation/typeclass.html#Kaes Perhaps the most comprehensive treatment of local instances is the old paper D. Duggan and J. Ophel. Open and closed scopes for constrained genericity (PDF). Theoretical Computer Science, 275, 215-258, 2002. http://dl.acm.org/citation.cfm?id=570578 They propose a method to have both closure and non-closure semantics, differentiating based on so-called open and closed types. Our HW 2004 paper with Chung-chieh Shan proposed a way to elide the problem by restricting the local instances in such a way that the problem never arises. The `reflection' facility was used to implement such local instances. The idea was that local instances can be thought of as ordinary global instances; however, the scope of the type in their head is restricted. That is, rather than make the instances local we make local the type for which they are defined (or one of the types, for multi-parameter type classes). Local types can be emulated via first-class polymorphism. (BTW, if one can leave with unsafeCoerce, local instances can be much more efficiently implemented.) Gesh wrote:
* Give up on non-associated open type families. This I have researched less well, but it seems to me that these have no use case. Since one can make whatever instances one wishes for these type families, one can't do anything useful with values of their instances.
On the contrary, we found them very useful in defining interpreters that provide their own interpretation of not only primitives but also of types. http://okmij.org/ftp/gengo/NASSLLI10/index.html See, for example, http://okmij.org/ftp/gengo/NASSLLI10/Lambda.hs for partial evaluation and http://okmij.org/ftp/gengo/NASSLLI10/CFG.hs In the latter case, extensibility is particularly important as we do want to add further syntactic categories and their semantic interpretations.

Here's another fun question. The following module is legal in GC, and
does what you would expect.
\begin{code}
{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
module Parametric where
class IsInt a where
isInt :: a -> Bool
instance IsInt a where isInt _ = False
instance IsInt Int where isInt _ = True
myList1 :: IsInt a => a -> [a]
myList1 x = if isInt x then [x] else [x, x]
\end{code}
Would the following module be legal under the proposal? If so,
parametricity is gone, because you can define typecase without any
constraints.
\begin{code}
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, OverlappingInstances, LocalInstances #-}
module NotParametric where
import Parametric
myList2 :: a -> [a]
myList2 (x :: a) =
let instance IsInt a where isInt _ = False in
let instance IsInt Int where isInt _ = True in
myList1 x
-- the IsInt constraint should be discharged by the local instances
\end{code}
The only way I see of avoiding this is if local instances can't
discharge a constraint; that is, a local instance can only shadow an
existing instance. It can't create an instance for a type that didn't
already have one. Or maybe there's just a bad interaction with
flexible/overlapping instances, but the extension seems less useful
without these.
--
Jason McCarty

On 10/2/2014 5:21 PM, oleg@okmij.org wrote:
Given
f2 :: Show a => a -> String f2 x = let instance Show Int where show _ = "one" in show x
what should (f2 (1::Int)) return? One answer is that it should still return "one" -- that is, local instances should sort of form a closure (like local variables in the real closure). That is a good answer, but may lead to unpleasant surprises because the fact of the closure is not at all reflected in the type of the function.
Consider
data T = T f3 :: Show a => a -> String f3 x = let instance Show T where show _ = "T" in show x
and take the closure semantics. The type says that to make (f3 T) well-typed, there has to be an instance Show T in scope. The user of f3 has no way to know of the private local instance that is closed over (short of examining the source code). Since the user knows there is no global instance T, the user attempts to define in. The user will be quite surprised to discover that (f3 T) is well-typed but their global instance Show T has no effect. That is true, but even today one can write overly-constrained expressions that don't actually need these constraints. How is `f3` above any different from foo :: Show a => a -> String foo = const "Fooled you, I didn't need Show after all."
However, one could write a more precise type for `f3` which reflects the fact that a `Show` instance is unnecessary for `T`, as follows
class Foo a where instance Foo T where instance Show a => Foo a where f3 :: Foo a => a -> String
(Of course, this requires OverlappingInstances) In fact, it would be useful to have syntactic sugar for this sort of constraint disjunction, for cases like this. We might even extend GHC's type checker to infer such disjunctions, so that `f3`'s type would be inferred to be `Show a \/ (a ~ T) => a -> String`. Thanks for the in-depth analysis and further reading, Gesh P.S. You might want to change your email client's settings, as you don't seem to be sending In-Reply-To headers, which makes threading horrible.

2014-10-02 16:21 GMT+02:00 Oleg
However, given
f2 :: Show a => a -> String f2 x = let instance Show Int where show _ = "one" in show x
what should (f2 (1::Int)) return?
I haven't studied this in detail (yet :)), but can't we solve this coherence problem by requiring a bit of additional type annotations from the programmer? Specifically, I would expect the problem to go away if we require the user to explicitly state the resulting type of the "let instance" expression. The syntax could look like let instance Show Int where show _ = "one" in show x as Show a => String where the specification "Show a => String" would imply that the Show a instance is propagated outwards and the Show Int instance is unused. If the programmer instead wrote let instance Show Int where show _ = "one" in show x as String That would imply that the compiler should try to resolve the required "Show a" constraint, but I would then expect an error saying that "Show a" cannot be derived from "Show Int", because we don't apply unification to constraints (or at least, GHC doesn't, and it seems like a good idea not to). Such an additional annotation is a bit more work for the programmer, but perhaps that might be acceptable for this indeed sorely missed feature? Regards, Dominique

On Friday, October 3, 2014 1:05:36 PM UTC+2, Dominique Devriese wrote:
2014-10-02 16:21 GMT+02:00 Oleg
javascript:>: However, given
f2 :: Show a => a -> String f2 x = let instance Show Int where show _ = "one" in show x
what should (f2 (1::Int)) return?
I haven't studied this in detail (yet :)), but can't we solve this coherence problem by requiring a bit of additional type annotations from the programmer? Specifically, I would expect the problem to go away if we require the user to explicitly state the resulting type of the "let instance" expression. The syntax could look like
let instance Show Int where show _ = "one" in show x as Show a => String
where the specification "Show a => String" would imply that the Show a instance is propagated outwards and the Show Int instance is unused. If the programmer instead wrote
let instance Show Int where show _ = "one" in show x as String
That would imply that the compiler should try to resolve the required "Show a" constraint, but I would then expect an error saying that "Show a" cannot be derived from "Show Int", because we don't apply unification to constraints (or at least, GHC doesn't, and it seems like a good idea not to).
Such an additional annotation is a bit more work for the programmer, but perhaps that might be acceptable for this indeed sorely missed feature?
FYI, I think that "Modular type classes" [1], Sec. 3.1, discusses what's morally the same point (in a slightly different context, since they start from ML modules). They end up rejecting the annotation overhead, arguing that it ends up being repeated each time you nest a local instance (which is an interesting technical point). However, they don't establish that the nesting is common enough for this to be a problem, hence that argument might just be very insightful handwaving, so I think it's certainly up for discussion. Quoting: Instead, we prefer [...] to put the decision under programmer control,
permitting either outcome [of the two above ones] at her [the programmer's] discretion. We could achieve this by insisting that the scope of a using declaration [which imports a module instance into the implicit scope] be given an explicit signature, so that in the above example the programmer would have to specify whether A.f is to be polymorphic or monomorphic. However, this approach is awkward for nested using declarations, forcing repeated specifications of the same information. Instead we propose that the using declaration be confined to an *outer *(or *top-level*) layer that consists only of module declarations, whose signatures are typically specified in any case. All core-level terms appear in the *inner *layer, where type inference proceeds without restriction, but no using clauses are allowed.
[1] Derek Dreyer, Robert Harper, Manuel M.T. Chakravarty. Modular Type Classes, POPL 2007.

Thanks for the feedback everyone. It appears that I gave a rash and ill-considered solution to a thorny problem, and that what may appear to me to be unnecessary restrictions are, in fact, the very things that allow important parts of the Haskell ecosystem to work. Indeed, it turns out that where necessary, the reflection-extras[1] package gives us enough tools to be able to write local instances easily, so even if we decide in the long run not to support local instances, we have that. Admittedly, the sources that were given in this discussion were publicly available, and if I'd properly searched for prior discussions, I would probably have found them. I apologize for the lack of due diligence. Therefore, I'd like to refocus this discussion on another question I raised. Is there any usecase for open type families that isn't subsumed by closed type families and associated data types? In addition, aren't signatures referring to open type families inherently unsafe due to the lack of control over the instances? Thanks for the thought-provoking discussion, Gesh [1] - https://hackage.haskell.org/package/reflection-extras
participants (6)
-
Dominique Devriese
-
Gesh
-
Gesh hseG
-
Jason McCarty
-
oleg@okmij.org
-
Paolo Giarrusso