<div dir="ltr">At the moment, GHC does not support type families over kind #, <div>but if it did, would this code do the trick </div><div><a href="https://gist.github.com/vagarenko/077c6dd73cd610269aa9">https://gist.github.com/vagarenko/077c6dd73cd610269aa9</a> ?<br></div></div><div class="gmail_extra"><br><div class="gmail_quote">2015-11-16 22:32 GMT+05:00 Ömer Sinan Ağacan <span dir="ltr"><<a href="mailto:omeragacan@gmail.com" target="_blank">omeragacan@gmail.com</a>></span>:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">> But I don't see why you'd need quoting at constructor calls. Couldn't you<br>
> just have a type class like `PointFamily`?<br>
<br>
</span>This is exactly right, my memory has failed me. My initial implementation<br>
didn't use the type family trick, I had further attempts that use type families<br>
but honestly I don't remember how good it worked. This was quite a while ago.<br>
<div class="HOEnZb"><div class="h5"><br>
2015-11-15 19:41 GMT-05:00 Richard Eisenberg <<a href="mailto:eir@cis.upenn.edu">eir@cis.upenn.edu</a>>:<br>
> After reading Francesco's original post, I immediately thought of Ömer's proposed approach, of using Template Haskell to produce the right data family instances. But I don't see why you'd need quoting at constructor calls. Couldn't you just have a type class like `PointFamily`? I'd be more interested to see client code in Ömer's version than the TH generation code.<br>
><br>
> The TH approach would seem to require having a fixed set of specializations, which is a downside. But I'm not sure it's so much of a downside that the approach is unusable.<br>
><br>
> Richard<br>
><br>
> On Nov 15, 2015, at 10:08 AM, Ömer Sinan Ağacan <<a href="mailto:omeragacan@gmail.com">omeragacan@gmail.com</a>> wrote:<br>
><br>
>> I had started working on exactly the same thing at some point. I had a<br>
>> TemplateHaskell-based implementation which _almost_ worked.<br>
>><br>
>> The problem was that the syntax was very, very heavy. Because I had to use<br>
>> quotes for _every_ constructor application(with explicitly passed types).<br>
>> (because I had a specialized constructor for every instantiation of this<br>
>> generic type)<br>
>><br>
>> Another problem was that because of how TemplateHaskell quotes evaluated, I<br>
>> couldn't use a `List Int` where `List` is a template without first manually<br>
>> adding a line for generating specialized version of `List` on `Int`.<br>
>><br>
>> When all of these combined it became very hard to use. But it was a<br>
>> proof-of-concept and I think it worked.<br>
>><br>
>> (Code is horrible so I won't share it here :) I had to maintain a state shared<br>
>> with different TH quote evaluations etc.)<br>
>><br>
>> 2015-11-15 5:26 GMT-05:00 Francesco Mazzoli <<a href="mailto:f@mazzo.li">f@mazzo.li</a>>:<br>
>>> (A nicely rendered version of this email can be found at <<a href="https://gist.github.com/bitonic/52cfe54a2dcdbee1b7f3" rel="noreferrer" target="_blank">https://gist.github.com/bitonic/52cfe54a2dcdbee1b7f3</a>>)<br>
>>><br>
>>> ## Macro types<br>
>>><br>
>>> I very often find myself wanting unboxed polymorphic types<br>
>>> (e.g. types that contain `UNPACK`ed type variables). I find<br>
>>> it extremely frustrating that it's easier to write fast _and_<br>
>>> generic code in C++ than in Haskell.<br>
>>><br>
>>> I'd like to submit to the mailing list a very rough proposal<br>
>>> on how this could be achieved in a pretty straightforward way<br>
>>> in GHC.<br>
>>><br>
>>> The proposal is meant to be a proof of concept, just to show that<br>
>>> this could be done rather easily. I did not think about a nice<br>
>>> interface or the implementation details in GHC. My goal is to<br>
>>> check the feasibility of this plan with GHC developers.<br>
>>><br>
>>> I'll call such types "macro types", since their effect is similar<br>
>>> to defining a macro that defines a new type for each type<br>
>>> variable instantiation.<br>
>>><br>
>>> Consider<br>
>>><br>
>>> ```<br>
>>> data #Point a = Point<br>
>>>  { x :: {-# UNPACK #-} !a<br>
>>>  , y :: {-# UNPACK #-} !a<br>
>>>  }<br>
>>> ```<br>
>>><br>
>>> This definition defines the macro type `#Point`, with one parameter<br>
>>> `a`.<br>
>>><br>
>>> Macro types definition would be allowed only for single-constructor<br>
>>> records. The intent is that if we mention `#Point Double`, it will<br>
>>> be equivalent to<br>
>>><br>
>>> ```<br>
>>> data PointDouble = PointDouble<br>
>>>  { x :: {-# UNPACK #-} !Double<br>
>>>  , y :: {-# UNPACK #-} !Double<br>
>>>  }<br>
>>> ```<br>
>>><br>
>>> To use `#Point` generically, the following type class would be<br>
>>> generated:<br>
>>><br>
>>> ```<br>
>>> class PointFamily a where<br>
>>>  data #Point a :: * -- Family of types generated by @data #Point a@.<br>
>>>  #Point :: a -> a -> #Point a -- Constructor.<br>
>>>  #x :: #Point a -> a -- Projection @x@.<br>
>>>  #y :: #Point a -> a -- Projection @y@.<br>
>>> ```<br>
>>><br>
>>> Thi type class lets us work with `#Point`s generically, for example<br>
>>><br>
>>> ```<br>
>>> distance :: (PointFamily a, Fractional a) => #Point a -> #Point a -> a<br>
>>> distance p1 p2 =<br>
>>>  let dx = #x p1 - #x p2<br>
>>>      dy = #y p1 - #y p2<br>
>>>  in sqrt (dx*dx + dy*dy)<br>
>>> ```<br>
>>><br>
>>> Internally, for every type appearing for `a`, e.g. `#Point Double`,<br>
>>> a new type equivalent to the `PointDouble` above would be generated<br>
>>> by GHC, with the corresponding instance<br>
>>><br>
>>> ```<br>
>>> instance PointFamily Double where<br>
>>>  data #Point Double = PointDouble<br>
>>>  #x = x<br>
>>>  #y = x<br>
>>> ```<br>
>>><br>
>>> If it's not possible to instantiate `#Point` with the provided type<br>
>>> (for example because the type is not `UNPACK`able, e.g.<br>
>>> `#Point (Maybe A)`), GHC would throw an error.<br>
>>><br>
>>> Note that we can compile `distance` in its polymorphic version<br>
>>> (as opposed to C++ templates, where template functions _must_ be<br>
>>> instantiated at every use). The polymorphic `distance` would<br>
>>> require a call to "virtual functions" `#x` and `#y`, as provided by<br>
>>> the `PointFamily` dictionary. But if we use<br>
>>> `INLINE` or `SPECIALIZE` pragmas the virtual calls to `#x` and `#y`<br>
>>> would disappear, making this as efficient as if we were to define<br>
>>> `distance` on the manually defined `PointDouble`. Compiler hints<br>
>>> would be put in place to always inline functions using macro types,<br>
>>> if possible.<br>
>>><br>
>>> Note that the inlining is only important so that the `PointFamily`<br>
>>> dictionary disappears, e.g. functions containing recursive<br>
>>> helpers are fine, such as<br>
>>><br>
>>> ```<br>
>>> {-# INLINE leftmost #-}<br>
>>> leftmost :: forall a. (PointFamily a, Ord a) => [#Point a] -> #Point a<br>
>>> leftmost [] = error "leftmost: no points"<br>
>>> leftmost (p0 : ps0) = go p0 ps0<br>
>>>  where<br>
>>>    go :: #Point a -> [#Point a] -> Point# a<br>
>>>    go candidate (p : ps) =<br>
>>>      if #x p < #x candidate<br>
>>>        then go p ps<br>
>>>        else go candidate ps<br>
>>> ```<br>
>>><br>
>>> It might be worth considering throwing a warning when a top-level<br>
>>> definition whose type contains a macro type cannot be inlined, since<br>
>>> the main performance benefit of using macro types would be lost.<br>
>>><br>
>>> We can define instances for these types as normal, for instance<br>
>>><br>
>>> ```<br>
>>> instance (Show a, PointFamily a) => Show (#Point a) where<br>
>>>  {-# INLINE show #-}<br>
>>>  show pt = "Point{x = " ++ #x pt ++ ", y = " ++ #y pt ++ "}"<br>
>>> ```<br>
>>><br>
>>> `deriving` support could also be added.<br>
>>><br>
>>> ## Further ideas<br>
>>><br>
>>> ### Hide or remove `PointFamily` from the user<br>
>>><br>
>>> In the examples above `PointFamily` is manipulated explicitely<br>
>>> (e.g. in the type signature for `distance`).<br>
>>> In most cases the right constraint could be generated<br>
>>> automatically by GHC, although I think direct access to the<br>
>>> type class would be beneficial (history shows that direct<br>
>>> access to these facilities is good, see upcoming explicit<br>
>>> type applications).<br>
>>><br>
>>> Maybe the type class associated to a macro type should not even<br>
>>> exist -- for example we could simply represent `#Point` as a type<br>
>>> family and treat construction and destruction as built-in syntax<br>
>>> (the `#` prefix).<br>
>>><br>
>>> ### Pattern matching<br>
>>><br>
>>> Sugar could be added to pattern match, e.g.<br>
>>><br>
>>> ```<br>
>>> foo :: Point# a -> ...<br>
>>> distance (Point# x1 y1) = ...<br>
>>>  or<br>
>>> dinstance Point#{..} = ... -- #x and #y are available<br>
>>> ```<br>
>>><br>
>>> ### No "record types" limitation<br>
>>><br>
>>> Instead of restricting ourselves to single-constructor records,<br>
>>> we could simply generate<br>
>>><br>
>>> ```<br>
>>> data Point a = Point a<br>
>>>  { x :: !a<br>
>>>  , y :: !a<br>
>>>  }<br>
>>><br>
>>> class PointFamily a where<br>
>>>  data Point# a :: *<br>
>>>  destruct :: Point# a -> Point a<br>
>>>  construct :: Point a -> Point# a<br>
>>> ```<br>
>>><br>
>>> However, I think it would be harder to guarantee the well-behavedness<br>
>>> of the inlined functions if we had this intermediate type. I also<br>
>>> don't think macro types would be very useful beyond polymorphic<br>
>>> unboxed types.<br>
>>> _______________________________________________<br>
>>> ghc-devs mailing list<br>
>>> <a href="mailto:ghc-devs@haskell.org">ghc-devs@haskell.org</a><br>
>>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br>
>> _______________________________________________<br>
>> ghc-devs mailing list<br>
>> <a href="mailto:ghc-devs@haskell.org">ghc-devs@haskell.org</a><br>
>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br>
><br>
_______________________________________________<br>
ghc-devs mailing list<br>
<a href="mailto:ghc-devs@haskell.org">ghc-devs@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br>
</div></div></blockquote></div><br></div>