[Haskell-cafe] open and closed

Gábor Lehel illissius at gmail.com
Sun Aug 29 13:33:06 EDT 2010


I'm not sure if they're within my own, either. The expression problem
did fleetingly cross my mind while thinking about this. Open ADTs +
open functions might be a very simple solution to it - that is, if
they make sense at all. I haven't thought it through thoroughly
though.*

Another thing I'm wondering about is that there's a fairly intuitive
correspondence between functions at the value level vs. functions at
the type level, and datatypes to classify the value level vs.
datakinds to classify the type level, but what corresponds to type
classes at the value level? There's also all kinds of weird
interactions like whether you could have an open function as the
implementation of a type class method.

* I think this might be some kind of personal record for density of
unique words matching /th[a-z]*ough[a-z]*/ in a single sentence.

2010/8/29 Patrick Browne <patrick.browne at dit.ie>:
> Hi,
> The details of the issues involved in an open and closed facility for
> Haskell are way beyond my current understanding of the language.
> Nonetheless, I was wondering does this have anything to do with the
> expression problem?
>
> Pat
>
>
> 17/08/2010 14:48 Victor Nazarov asviraspossible at gmail.com wrote:
>>> Finally tagless technique seems to solve expression problem using
>>> pretty basic Haskell:
>>>
>>> --------------------------------------------------
>>> module AddExp where
>>> class AddExp e
>>>   where add :: e -> e -> e
>>>            lit :: Int -> e
>>>
>>> -- Type signature is required
>>> -- monomorphism restriction will act otherwise
>>> test :: AddExp e => e
>>> test = add (lit 6) (lit 2)
>>>
>>> -----------------------------------------------------
>>> module MulExp where
>>> class MulExp e
>>>   where mul :: e -> e -> e
>>>
>>> -- Type signature is required
>>> -- monomorphism restriction will act otherwise
>>> test1 :: (AddExp e, MulExp e) => e
>>> test1 = mul test (lit 3)
>>>
>>> -----------------------------------------------------
>>> module Evaluator
>>>
>>> import AddExp where
>>>
>>> newtype Eval = E { eval :: Int }
>>>
>>> instance AddExp Eval
>>>   where lit = E
>>>            add (E a) (E b) = E (a + b)
>>>
>>>
>>> -----------------------------------------------------
>>> module PrettyPrinter where
>>>
>>> import AddExp
>>> import MulExp
>>>
>>> newtype PrettyPrint = P { prettyPrint :: String }
>>>
>>> instance AddExp (PrettyPrint)
>>>   where lit n = show n
>>>            add (P a) (P b) = concat [a, " + ", b]
>>>
>>> instance MulExp (PrettyPrint)
>>>   where mul (P a) (P b) = concat [a, " * ", b]
>>>
>>>
>>> -- Victor Nazarov
>
>
>
>
>
>
> Gábor Lehel wrote:
>> This is pure speculation, inspired in part by Brent Yorgey's blog
>> post[1] from a few weeks ago.
>>
>> I'm wondering if it might be possible, in theory, to have both open
>> and closed variants for each of value-level functions, type functions,
>> and classes, in a fairly analogous way. (Maybe you could even have
>> open (G)ADTs, which you would then need open functions to match on; or
>> maybe a closed one with a case for _ to ensure exhaustiveness.)
>>
>> In each case you'd have the closed variant requiring you to keep all
>> the definitions in the same module, permitting overlap, and trying to
>> match definitions in the order they're listed; whereas the open
>> variant would let you have definitions across modules, would forbid
>> overlap (or would require definitions to be equivalent where they
>> overlap, as with type families), and would always select the uniquely
>> matching definition.
>>
>> Open value-level functions with this scheme would be inherently
>> partial, which is bad. (It's not a problem at the type level because
>> you just get a compile error if nothing matches, but an exception at
>> runtime isn't so nice.) As a solution, perhaps it might be possible to
>> allow a limited form of overlap (or don't even call it overlap) for
>> the open variants: a default "use this is if nothing else matches"
>> definition (which would need to be in the same module as the original
>> class / type family declaration, or whatever ends up being analogous
>> for open value-level functions, maybe the type signature). That way
>> you could use Maybe for open value-level functions and make the
>> default Nothing, among other options. Overlap in type functions
>> allegedly makes typechecking unsound; I don't know if that would also
>> hold in this more limited case. This would definitely break the
>> property where adding or removing an import can't change the behaviour
>> of a program other than whether it compiles, which is considered very
>> important by many [2], so maybe it's not a good solution. (Possibly
>> you could add explicit import/export control for
>> instances/other-open-things to alleviate this, in a way so that
>> definitions for open thingies with default definitions (at least)
>> would always have to imported explicitly, thereby acknowledging that
>> it might change behaviour... or maybe that would be a bandaid too far,
>> I dunno.)
>>
>> (I think this would also cover most (if not all?) of the use cases for
>> OverlappingInstances, which permits overlap and selects the most
>> specific instance in a more general fashion; but maybe that doesn't
>> matter if the two are equally bad, I don't know. I'm not 100% clear on
>> peoples' opinion of OverlappingInstances, but I as far as I know the
>> problems are twofold: both import-unsafeness, and the matter of how
>> you would actually define "most specific" in a way that's both
>> rigorous and intuitive; this would remove at least the latter.)
>>
>> Anyway, thoughts? Is this all completely crazy and way out there?
>>
>> [1] http://byorgey.wordpress.com/2010/08/05/typed-type-level-programming-in-haskell-part-iv-collapsing-types-and-kinds/
>> [2] http://hackage.haskell.org/trac/haskell-prime/wiki/LanguageQualities
>>
>
>
> This message has been scanned for content and viruses by the DIT Information Services E-Mail Scanning Service, and is believed to be clean. http://www.dit.ie
>



-- 
Work is punishment for failing to procrastinate effectively.


More information about the Haskell-Cafe mailing list