<div dir="ltr">Hello,<div><br></div><div>how about we simply use two operators: </div><div>  1. ($) which only works for standard types (i.e., not #), which we can use 99% of the time, and</div><div>  2. some other operator which has the levity polymorphic type and would be used in the advanced cases when you are working with unboxed values, etc.   Personally, I use unboxed values rarely enough, that I'd even be OK simply using parens or naming the sub-expression instead of using $</div><div><br></div><div><br></div><div>-Iavor</div><div><br></div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Thu, Feb 4, 2016 at 5:38 PM, Christopher Allen <span dir="ltr"><<a href="mailto:cma@bitemyapp.com" target="_blank">cma@bitemyapp.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr">The sort of pragma you suggest would satisfy me. Pragmas like this don't bother me and make my job a fair bit easier. Too many, "don't worry about this; later" is exhausting. Too many, "don't worry about this; we're not even going to have time to cover it" is demoralizing.</div><div class="HOEnZb"><div class="h5"><div class="gmail_extra"><br><div class="gmail_quote">On Thu, Feb 4, 2016 at 5:31 PM, Edward Z. Yang <span dir="ltr"><<a href="mailto:ezyang@mit.edu" target="_blank">ezyang@mit.edu</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">I'm not really sure how you would change the type of 'id' based on<br>
a language pragma.<br>
<br>
How do people feel about a cosmetic fix, where we introduce a new<br>
pragma, {-# LANGUAGE ShowLevity #-} which controls the display of levity<br>
arguments/TYPE.  It's off by default but gets turned on by some<br>
extensions like MagicHash (i.e. we only show levity if you have<br>
enabled extensions where the distinction matters).<br>
<br>
Edward<br>
<br>
Excerpts from Christopher Allen's message of 2016-02-04 15:20:34 -0800:<br>
<div><div>> This seems worse than FTP IMO. It's considerably noisier, considerably<br>
> rarer a concern for Haskell programmers, and is wayyyy beyond the scope of<br>
> most learning resources.<br>
><br>
> Is there a reason this isn't behind a pragma?<br>
><br>
> On Thu, Feb 4, 2016 at 5:02 PM, Manuel M T Chakravarty <<a href="mailto:chak@justtesting.org" target="_blank">chak@justtesting.org</a><br>
> > wrote:<br>
><br>
> > To be honest, I think, it is quite problematic if an obscure and untested<br>
> > language extension (sorry, but that’s what it is right now) bleeds through<br>
> > into supposedly simple standard functionality. The beauty of most of GHC’s<br>
> > language extensions is that you can ignore them until you need them.<br>
> ><br>
> > Has this ever been discussed more widely? I expect that every single<br>
> > person teaching Haskell is going to be unhappy about it.<br>
> ><br>
> > Manuel<br>
> ><br>
> ><br>
> > > Richard Eisenberg <<a href="mailto:eir@cis.upenn.edu" target="_blank">eir@cis.upenn.edu</a>>:<br>
> > ><br>
> > > I agree with everything that's been said in this thread, including the<br>
> > unstated "that type for ($) is sure ugly".<br>
> > ><br>
> > > Currently, saturated (a -> b) is like a language construct, and it has<br>
> > its own typing rule, independent of the type of the type constructor (->).<br>
> > But reading the comment that Ben linked to, I think that comment is out of<br>
> > date. Now that we have levity polymorphism, we can probably to the Right<br>
> > Thing and make the kind of (->) more flexible.<br>
> > ><br>
> > > Richard<br>
> > ><br>
> > > On Feb 4, 2016, at 3:27 PM, Ryan Scott <<a href="mailto:ryan.gl.scott@gmail.com" target="_blank">ryan.gl.scott@gmail.com</a>> wrote:<br>
> > ><br>
> > >>> My understanding was that the implicitly polymorphic levity, did (->)<br>
> > not change because it's a type constructor?<br>
> > >><br>
> > >> The kind of (->) as GHCi reports it is technically correct. As a kind<br>
> > >> constructor, (->) has precisely the kind * -> * -> *. What's special<br>
> > >> about (->) is that when you have a saturated application of it, it<br>
> > >> takes on a levity-polymorphic kind. For example, this:<br>
> > >><br>
> > >>   :k (->) Int# Int#<br>
> > >><br>
> > >> would yield a kind error, but<br>
> > >><br>
> > >>   :k Int# -> Int#<br>
> > >><br>
> > >> is okay. Now, if you want an explanation as to WHY that's the case, I<br>
> > >> don't think I could give one, as I simply got this information from<br>
> > >> [1] (see the fourth bullet point, for OpenKind). Perhaps SPJ or<br>
> > >> Richard Eisenberg could give a little insight here.<br>
> > >><br>
> > >>> Also does this encapsulate the implicit impredicativity of ($) for<br>
> > making runST $ work? I don't presently see how it would.<br>
> > >><br>
> > >> You're right, the impredicativity hack is a completely different<br>
> > >> thing. So while you won't be able to define your own ($) and be able<br>
> > >> to (runST $ do ...), you can at least define your own ($) and have it<br>
> > >> work with unlifted return types. :)<br>
> > >><br>
> > >> Ryan S.<br>
> > >> -----<br>
> > >> [1] <a href="https://ghc.haskell.org/trac/ghc/wiki/NoSubKinds" rel="noreferrer" target="_blank">https://ghc.haskell.org/trac/ghc/wiki/NoSubKinds</a><br>
> > >><br>
> > >> On Thu, Feb 4, 2016 at 2:53 PM, Christopher Allen <<a href="mailto:cma@bitemyapp.com" target="_blank">cma@bitemyapp.com</a>><br>
> > wrote:<br>
> > >>> My understanding was that the implicitly polymorphic levity, did (->)<br>
> > not<br>
> > >>> change because it's a type constructor?<br>
> > >>><br>
> > >>> Prelude> :info (->)<br>
> > >>> data (->) a b -- Defined in ‘GHC.Prim’<br>
> > >>> Prelude> :k (->)<br>
> > >>> (->) :: * -> * -> *<br>
> > >>><br>
> > >>> Basically I'm asking why ($) changed and (->) did not when (->) had<br>
> > similar<br>
> > >>> properties WRT * and #.<br>
> > >>><br>
> > >>> Also does this encapsulate the implicit impredicativity of ($) for<br>
> > making<br>
> > >>> runST $ work? I don't presently see how it would.<br>
> > >>><br>
> > >>> Worry not about the book, we already hand-wave FTP effectively. One<br>
> > more<br>
> > >>> type shouldn't change much.<br>
> > >>><br>
> > >>> Thank you very much for answering, this has been very helpful already<br>
> > :)<br>
> > >>><br>
> > >>> --- Chris<br>
> > >>><br>
> > >>><br>
> > >>> On Thu, Feb 4, 2016 at 12:52 PM, Ryan Scott <<a href="mailto:ryan.gl.scott@gmail.com" target="_blank">ryan.gl.scott@gmail.com</a>><br>
> > wrote:<br>
> > >>>><br>
> > >>>> Hi Chris,<br>
> > >>>><br>
> > >>>> The change to ($)'s type is indeed intentional. The short answer is<br>
> > >>>> that ($)'s type prior to GHC 8.0 was lying a little bit. If you<br>
> > >>>> defined something like this:<br>
> > >>>><br>
> > >>>>   unwrapInt :: Int -> Int#<br>
> > >>>>   unwrapInt (I# i) = i<br>
> > >>>><br>
> > >>>> You could write an expression like (unwrapInt $ 42), and it would<br>
> > >>>> typecheck. But that technically shouldn't be happening, since ($) ::<br>
> > >>>> (a -> b) -> a -> b, and we all know that polymorphic types have to<br>
> > >>>> live in kind *. But if you look at unwrapInt :: Int -> Int#, the type<br>
> > >>>> Int# certainly doesn't live in *. So why is this happening?<br>
> > >>>><br>
> > >>>> The long answer is that prior to GHC 8.0, in the type signature ($) ::<br>
> > >>>> (a -> b) -> a -> b, b actually wasn't in kind *, but rather OpenKind.<br>
> > >>>> OpenKind is an awful hack that allows both lifted (kind *) and<br>
> > >>>> unlifted (kind #) types to inhabit it, which is why (unwrapInt $ 42)<br>
> > >>>> typechecks. To get rid of the hackiness of OpenKind, Richard Eisenberg<br>
> > >>>> extended the type system with levity polymorphism [1] to indicate in<br>
> > >>>> the type signature where these kind of scenarios are happening.<br>
> > >>>><br>
> > >>>> So in the "new" type signature for ($):<br>
> > >>>><br>
> > >>>>   ($) :: forall (w :: Levity) a (b :: TYPE w). (a -> b) -> a -> b<br>
> > >>>><br>
> > >>>> The type b can either live in kind * (which is now a synonym for TYPE<br>
> > >>>> 'Lifted) or kind # (which is a synonym for TYPE 'Unlifted), which is<br>
> > >>>> indicated by the fact that TYPE w is polymorphic in its levity type w.<br>
> > >>>><br>
> > >>>> Truth be told, there aren't that many Haskell functions that actually<br>
> > >>>> levity polymorphic, since normally having an argument type that could<br>
> > >>>> live in either * or # would wreak havoc with the RTS (otherwise, how<br>
> > >>>> would it know if it's dealing with a pointer or a value on the<br>
> > >>>> stack?). But as it turns out, it's perfectly okay to have a levity<br>
> > >>>> polymorphic type in a non-argument position [2]. Indeed, in the few<br>
> > >>>> levity polymorphic functions that I can think of:<br>
> > >>>><br>
> > >>>>   ($)        :: forall (w :: Levity) a (b :: TYPE w). (a -> b) -> a<br>
> > -> b<br>
> > >>>>   error     :: forall (v :: Levity)  (a :: TYPE v). HasCallStack =><br>
> > >>>> [Char] -> a<br>
> > >>>>   undefined :: forall (v :: Levity) (a :: TYPE v). HasCallStack => a<br>
> > >>>><br>
> > >>>> The levity polymorphic type never appears directly to the left of an<br>
> > >>>> arrow.<br>
> > >>>><br>
> > >>>> The downside of all this is, of course, that the type signature of ($)<br>
> > >>>> might look a lot scarier to beginners. I'm not sure how you'd want to<br>
> > >>>> deal with this, but for 99% of most use cases, it's okay to lie and<br>
> > >>>> state that ($) :: (a -> b) -> a -> b. You might have to include a<br>
> > >>>> disclaimer that if they type :t ($) into GHCi, they should be prepared<br>
> > >>>> for some extra information!<br>
> > >>>><br>
> > >>>> Ryan S.<br>
> > >>>> -----<br>
> > >>>> [1] <a href="https://ghc.haskell.org/trac/ghc/wiki/NoSubKinds" rel="noreferrer" target="_blank">https://ghc.haskell.org/trac/ghc/wiki/NoSubKinds</a><br>
> > >>>> [2] <a href="https://ghc.haskell.org/trac/ghc/ticket/11473" rel="noreferrer" target="_blank">https://ghc.haskell.org/trac/ghc/ticket/11473</a><br>
> > >>>> _______________________________________________<br>
> > >>>> ghc-devs mailing list<br>
> > >>>> <a href="mailto:ghc-devs@haskell.org" target="_blank">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>
> > >>><br>
> > >>><br>
> > >>> --<br>
> > >>> Chris Allen<br>
> > >>> Currently working on <a href="http://haskellbook.com" rel="noreferrer" target="_blank">http://haskellbook.com</a><br>
> > >> _______________________________________________<br>
> > >> ghc-devs mailing list<br>
> > >> <a href="mailto:ghc-devs@haskell.org" target="_blank">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>
> > > _______________________________________________<br>
> > > ghc-devs mailing list<br>
> > > <a href="mailto:ghc-devs@haskell.org" target="_blank">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" target="_blank">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>
</div></div></blockquote></div><br><br clear="all"><div><br></div>-- <br><div><div dir="ltr"><div><div dir="ltr"><div dir="ltr">Chris Allen<br><div><span style="font-size:12.8000001907349px">Currently working on </span><a href="http://haskellbook.com" target="_blank">http://haskellbook.com</a></div></div></div></div></div></div>
</div>
</div></div><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></blockquote></div><br></div>