Type operators in GHC

Conal Elliott conal at conal.net
Sun Sep 16 23:01:06 CEST 2012


I also have quite a lot of code (growing daily) that uses (~>) as a type
variable. It's not the only such type variable, because some abstractions
are about combining multiple arrowish things, e.g., more CT variations on
Functor and Foldable that allow valuable flexibility missing in the
standard library. In those cases, I typically use (+>) and (-->) as well.

-- Conal

On Fri, Sep 14, 2012 at 5:09 PM, Cale Gibbard <cgibbard at gmail.com> wrote:

> There's a fair amount of code out there which uses (~>) as a type
> variable (we have ~10k lines of heavy arrow code at iPwn). It would be
> *really* nice if that could be accommodated somehow. But the proposal
> you just gave at least would allow for a textual substitution, so not
> quite so bad as having to change everything to prefix notation.
>
> On 14 September 2012 19:26, Simon Peyton-Jones <simonpj at microsoft.com>
> wrote:
> > Fair point.  So you are saying it’d be ok to say
> >
> >
> >
> >   data T (.->)  = MkT (Int .-> Int)
> >
> >
> >
> > where (.+) is a type variable?   Leaving ordinary (+) available for type
> > constructors.
> >
> >
> >
> > If we are inverting the convention I wonder whether we might invert it
> > completely and use “:” as the “I’m different” herald as we do for
> > *constructor* operators in terms.  Thus
> >
> >
> >
> >   data T (:->)  = MkT (Int :-> Int)
> >
> >
> >
> > That seems symmetrical, and perhaps nicer than having a new notation.
> >
> >
> >
> >          In terms                                      In types
> >
> > -----------------------------------------------------------------------
> >
> > a        Term variable                             Type variable
> >
> > A        Data constructor                         Type constructor
> >
> > +        Term variable operator               Type constructor operator
> >
> > :+      Data constructor operator           Type variable operator
> >
> >
> >
> > Any other opinions?
> >
> >
> >
> > Simon
> >
> >
> >
> > From: conal.elliott at gmail.com [mailto:conal.elliott at gmail.com] On
> Behalf Of
> > Conal Elliott
> > Sent: 06 September 2012 23:59
> > To: Simon Peyton-Jones
> > Cc: GHC users
> > Subject: Re: Type operators in GHC
> >
> >
> >
> > Oh dear. I'm very sorry to have missed this discussion back in January.
> I'd
> > be awfully sad to lose pretty infix notation for type variables of kind
> * ->
> > * -> *. I use them extensively in my libraries and projects, and pretty
> > notation matters.
> >
> > I'd be okay switching to some convention other than lack of leading ':'
> for
> > signaling that a symbol is a type variable rather than constructor, e.g.,
> > the *presence* of a leading character such as '.'.
> >
> > Given the increasing use of arrow-ish techniques and of type-level
> > programming, I would not classify the up-to-7.4 behavior as a "foolish
> > consistency", especially going forward.
> >
> > -- Conal
> >
> > On Wed, Jan 18, 2012 at 6:27 AM, Simon Peyton-Jones <
> simonpj at microsoft.com>
> > wrote:
> >
> > Dear GHC users
> >
> > As part of beefing up the kind system, we plan to implement the "Type
> > operators" proposal for Haskell Prime
> > http://hackage.haskell.org/trac/haskell-prime/wiki/InfixTypeConstructors
> >
> > GHC has had type operators for some kind, so you can say
> >         data a :+: b = Left a | Right b
> > but you can only do that for operators which start with ":".
> >
> > As part of the above wiki page you can see the proposal to broaden this
> to
> > ALL operators, allowing
> >         data a + b = Left a | Right b
> >
> > Although this technically inconsistent the value page (as the wiki page
> > discussed), I think the payoff is huge. (And "A foolish consistency is
> the
> > hobgoblin of little minds", Emerson)
> >
> >
> > This email is (a) to highlight the plan, and (b) to ask about flags.  Our
> > preferred approach is to *change* what -XTypeOperators does, to allow
> type
> > operators that do not start with :.  But that will mean that *some*
> > (strange) programs will stop working. The only example I have seen in
> tc192
> > of GHC's test suite
> >         {-# LANGUAGE TypeOperators #-}
> >         comp :: Arrow (~>) => (b~>c, c~>d)~>(b~>d)
> >       comp = arr (uncurry (>>>))
> >
> > Written more conventionally, the signature would look like
> >         comp :: Arrow arr => arr (arr b c, arr c d) (arr b d)
> >       comp = arr (uncurry (>>>))
> > or, in infix notation
> >         {-# LANGUAGE TypeOperators #-}
> >         comp :: Arrow arr => (b `arr` c, c `arr` d) `arr` (b `arr` d)
> >       comp = arr (uncurry (>>>))
> >
> > But tc192 as it stands would become ILLEGAL, because (~>) would be a type
> > *constructor* rather than (as now) a type *variable*.  Of course it's
> easily
> > fixed, as above, but still a breakage is a breakage.
> >
> > It would be possible to have two flags, so as to get
> >   - Haskell 98 behaviour
> >   - Current TypeOperator behaviuor
> >   - New TypeOperator behaviour
> > but it turns out to be Quite Tiresome to do so, and I would much rather
> not.
> > Can you live with that?
> >
> >
> >
> http://chrisdone.com/posts/2010-10-07-haskelldb-and-typeoperator-madness.html
> >
> >
> > _______________________________________________
> > Glasgow-haskell-users mailing list
> > Glasgow-haskell-users at haskell.org
> > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
> >
> >
> >
> >
> > _______________________________________________
> > Glasgow-haskell-users mailing list
> > Glasgow-haskell-users at haskell.org
> > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
> >
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20120916/7d008222/attachment.htm>


More information about the Glasgow-haskell-users mailing list