Re: Type operators in GHC

2012-09-19 Thread Conal Elliott
Indeed -- lovely notational tricks, Iavor  Edward! I think I'd be happy
with one of these variations. At least worth experimenting with.

-- Conal

On Mon, Sep 17, 2012 at 8:05 PM, Carter Schonwald 
carter.schonw...@gmail.com wrote:

 1) kudos to iavor and edward on the slick notation invention!

 2)   the key point is that ghc 7.6 does not have support for infix type
  variable notation, and how to encode infix arrow notations nicely subject
 that design choice, right?

 i'm likely just being a tad redundant in this conversation, but it never
 hurts to sanity check :)

 cheers
 -Carter

 On Mon, Sep 17, 2012 at 6:40 PM, Edward Kmett ekm...@gmail.com wrote:

 On Mon, Sep 17, 2012 at 1:02 PM, Sjoerd Visscher sjo...@w3future.comwrote:

 Hi,

 Note that nobody was suggesting two pragmas with incompatible behaviors,
 only to have just one symbol reserved to still be able to have type
 operator variables.


 An issue with reserving a symbol for type operator variables is it
 doesn't help you today.

 7.6.1 is already released.

 This means that any change in behavior would have to be in 7.6.2 at the
 earliest. Assuming the bikeshedding could complete and Simon et al.
 frantically patched the code tomorrow, rushing to release a 7.6.2 before
 the platform release.

 Failing that, you'd have a whole release cycle to wait through, probably
 a platform, before you could go back to your old behavior, and then your
 code would have some strange gap of GHC version numbers over which it
 didn't work.

 Everyone would have to pretend 7.6.1 never happened, or  and break
 anyone's code that was already written for 7.6, so instead of one breaking
 change, we'd now have two.

 For instance, I'm already using ~ in 'github.com/ekmett/indexed.git'
 for natural transformations and I am loving it, and would be sad to lose it
 to the choice of ~ as a herald, similarly it would make the ~c~ trick
 more verbose, and ~ is particularly terrible for operators like ~+~.

 Other herald choices lead to different issues, '.' is slightly better for
 the other operators, but makes kind of ugly arrows, plus some day i'd
 _really_ like to be able to use . as a type constructor for functor
 composition! It is currently reserved at the type level as an almost
 accidental consequence of the way forall gets parsed today.

 I really like Iavor's entirely-in-language way of addressing the issue,
 due in part to it providing even better associativity than the existing
 approach, and honestly, even if GHC HQ was somehow convinced to set aside
 an ad hoc herald for type variables, I'd probably start using it in my
 code. (probably sandwiching between something like :- and : for old GHC
 compatibility). I really like that I can just call the Category c, and just
 get ~c~  or something similar as its arrows. This feels more notationally
 accurate to me.

 It also has two major benefits compared to any proposal for adding
 different heralds:

 1.) It is compatible with old code, code written with 7.6.1 and I suppose
 future code, since (:) is such a remarkably awkward choice of herald for
 the reasons already documented that it seems an unlikely choice.

 2.) I can program with it today.

 I just realized if you don't want to worry about collisions with the type
 naturals from GHC.TypeLits, and didn't care about pre-7.6 compatibility,
 you could strip the notation down all the way to

 cmap :: CFunctor f c d = (x -c y) - f x -d f y

 This is even shorter than the conventional

 cmap :: CFunctor f (~) (~~) = (x ~ y) - f x ~~ f y

 Which turns the but it is longer argument against it on its head. ;)

 -Edward

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-17 Thread Aleksey Khudyakov
On Mon, Sep 17, 2012 at 1:07 AM, Conal Elliott co...@conal.net wrote:
 Hi Simon,

 Yes, I could live with (.-), (.+), etc more easily than `arr`, `plus` etc.

 Better yet would be a LANGUAGE pragma I can add to my libraries to get the
 old behavior back.

What about treating operators as constructs unless they are mentioned
in the forall?

~ is constructor
 foo :: a ~ b

~ is variable
 foo :: forall a b (~). a ~ b

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-17 Thread Iavor Diatchki
Hello,

I think that it would be a mistake to have two pragmas with incompatible
behaviors:  for example, we would not be able to write modules that use
Conal's libraries and, say, the type nats I've been working on.
If the main issue is the notation for arrows, has anoyone played with what
can be done with the current (7.6) system?  I just thought of two
variations that seem to provide a decent notation for writing arrow-ish
programs.  The second one, in particular, mirrors the arrow notation at the
value level, so perhaps that would be enough?

-Iavor


{-# LANGUAGE TypeOperators, KindSignatures #-}
module Test where

import Control.Category

-- Variant 1: Post-fix annotation

type (a --- b) c = c a b

f :: Category c = (x --- y) c - (y --- z) c - (x --- z) c
f = undefined


-- Variant 2: Arrow notation

type a -- (c :: * - * - *) = c a
type c -- b  = c b

infix 2 --
infix 1 --

g :: Category c = (x --c-- y) - (y --c-- z) - (x --c-- z)
g = undefined
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-17 Thread Sjoerd Visscher
Hi,

Note that nobody was suggesting two pragmas with incompatible behaviors, only 
to have just one symbol reserved to still be able to have type operator 
variables.

I do like your suggestion, although --c-- is quite a bit longer than ~.

Sjoerd

On Sep 17, 2012, at 6:28 PM, Iavor Diatchki wrote:

 Hello,
 
 I think that it would be a mistake to have two pragmas with incompatible 
 behaviors:  for example, we would not be able to write modules that use 
 Conal's libraries and, say, the type nats I've been working on.
 If the main issue is the notation for arrows, has anoyone played with what 
 can be done with the current (7.6) system?  I just thought of two variations 
 that seem to provide a decent notation for writing arrow-ish programs.  The 
 second one, in particular, mirrors the arrow notation at the value level, so 
 perhaps that would be enough?
 
 -Iavor
 
 
 {-# LANGUAGE TypeOperators, KindSignatures #-}
 module Test where
 
 import Control.Category 
 
 -- Variant 1: Post-fix annotation
 
 type (a --- b) c = c a b
 
 f :: Category c = (x --- y) c - (y --- z) c - (x --- z) c
 f = undefined
 
 
 -- Variant 2: Arrow notation
 
 type a -- (c :: * - * - *) = c a
 type c -- b  = c b
 
 infix 2 --
 infix 1 --
 
 g :: Category c = (x --c-- y) - (y --c-- z) - (x --c-- z)
 g = undefined
 
 
 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-17 Thread Edward Kmett
Iavor: Wow, I really like the --c-- trick at the type level.

Note: we can shorten that somewhat and improve the fixity to associate
correctly, matching the associativity of (-), which fortunately associates
to the right. (associating to the left can be done with a similar trick,
based on the original version of this hack by Chung-Chieh Shan.)

{-# LANGUAGE TypeOperators, PolyKinds #-}
import Control.Category

infixr 0 ~
infixr 0 ~

type (~) a b = b a
type (~) a b = a b

g :: Category c = (x ~c~ y) - (y ~c~ z) - x ~c~ z
g = undefined

Note, this also has the benefit of picking the correct associativity for
~c~. Unlike naively using a locally bound (~) and avoids the headaches
of picking (--) and (---) or something equally hideous when working with
two categories.

class (Category c, Category d) = CFunctor f c d | f c - d, f d - c where
  cmap :: (a ~c~ b) - f a ~d~ f b

-Edward

On Mon, Sep 17, 2012 at 1:02 PM, Sjoerd Visscher sjo...@w3future.comwrote:

 Hi,

 Note that nobody was suggesting two pragmas with incompatible behaviors,
 only to have just one symbol reserved to still be able to have type
 operator variables.

 I do like your suggestion, although --c-- is quite a bit longer than ~.

 Sjoerd

 On Sep 17, 2012, at 6:28 PM, Iavor Diatchki wrote:

 Hello,

 I think that it would be a mistake to have two pragmas with incompatible
 behaviors:  for example, we would not be able to write modules that use
 Conal's libraries and, say, the type nats I've been working on.
 If the main issue is the notation for arrows, has anoyone played with what
 can be done with the current (7.6) system?  I just thought of two
 variations that seem to provide a decent notation for writing arrow-ish
 programs.  The second one, in particular, mirrors the arrow notation at the
 value level, so perhaps that would be enough?

 -Iavor


 {-# LANGUAGE TypeOperators, KindSignatures #-}
 module Test where

 import Control.Category

 -- Variant 1: Post-fix annotation

 type (a --- b) c = c a b

 f :: Category c = (x --- y) c - (y --- z) c - (x --- z) c
 f = undefined


 -- Variant 2: Arrow notation

 type a -- (c :: * - * - *) = c a
 type c -- b  = c b

 infix 2 --
 infix 1 --

 g :: Category c = (x --c-- y) - (y --c-- z) - (x --c-- z)
 g = undefined


 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-17 Thread Edward Kmett
On Mon, Sep 17, 2012 at 1:02 PM, Sjoerd Visscher sjo...@w3future.comwrote:

 Hi,

 Note that nobody was suggesting two pragmas with incompatible behaviors,
 only to have just one symbol reserved to still be able to have type
 operator variables.


An issue with reserving a symbol for type operator variables is it doesn't
help you today.

7.6.1 is already released.

This means that any change in behavior would have to be in 7.6.2 at the
earliest. Assuming the bikeshedding could complete and Simon et al.
frantically patched the code tomorrow, rushing to release a 7.6.2 before
the platform release.

Failing that, you'd have a whole release cycle to wait through, probably a
platform, before you could go back to your old behavior, and then your code
would have some strange gap of GHC version numbers over which it didn't
work.

Everyone would have to pretend 7.6.1 never happened, or  and break anyone's
code that was already written for 7.6, so instead of one breaking change,
we'd now have two.

For instance, I'm already using ~ in 'github.com/ekmett/indexed.git' for
natural transformations and I am loving it, and would be sad to lose it to
the choice of ~ as a herald, similarly it would make the ~c~ trick more
verbose, and ~ is particularly terrible for operators like ~+~.

Other herald choices lead to different issues, '.' is slightly better for
the other operators, but makes kind of ugly arrows, plus some day i'd
_really_ like to be able to use . as a type constructor for functor
composition! It is currently reserved at the type level as an almost
accidental consequence of the way forall gets parsed today.

I really like Iavor's entirely-in-language way of addressing the issue, due
in part to it providing even better associativity than the existing
approach, and honestly, even if GHC HQ was somehow convinced to set aside
an ad hoc herald for type variables, I'd probably start using it in my
code. (probably sandwiching between something like :- and : for old GHC
compatibility). I really like that I can just call the Category c, and just
get ~c~  or something similar as its arrows. This feels more notationally
accurate to me.

It also has two major benefits compared to any proposal for adding
different heralds:

1.) It is compatible with old code, code written with 7.6.1 and I suppose
future code, since (:) is such a remarkably awkward choice of herald for
the reasons already documented that it seems an unlikely choice.

2.) I can program with it today.

I just realized if you don't want to worry about collisions with the type
naturals from GHC.TypeLits, and didn't care about pre-7.6 compatibility,
you could strip the notation down all the way to

cmap :: CFunctor f c d = (x -c y) - f x -d f y

This is even shorter than the conventional

cmap :: CFunctor f (~) (~~) = (x ~ y) - f x ~~ f y

Which turns the but it is longer argument against it on its head. ;)

-Edward
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-17 Thread Carter Schonwald
1) kudos to iavor and edward on the slick notation invention!

2)   the key point is that ghc 7.6 does not have support for infix type
 variable notation, and how to encode infix arrow notations nicely subject
that design choice, right?

i'm likely just being a tad redundant in this conversation, but it never
hurts to sanity check :)

cheers
-Carter

On Mon, Sep 17, 2012 at 6:40 PM, Edward Kmett ekm...@gmail.com wrote:

 On Mon, Sep 17, 2012 at 1:02 PM, Sjoerd Visscher sjo...@w3future.comwrote:

 Hi,

 Note that nobody was suggesting two pragmas with incompatible behaviors,
 only to have just one symbol reserved to still be able to have type
 operator variables.


 An issue with reserving a symbol for type operator variables is it doesn't
 help you today.

 7.6.1 is already released.

 This means that any change in behavior would have to be in 7.6.2 at the
 earliest. Assuming the bikeshedding could complete and Simon et al.
 frantically patched the code tomorrow, rushing to release a 7.6.2 before
 the platform release.

 Failing that, you'd have a whole release cycle to wait through, probably a
 platform, before you could go back to your old behavior, and then your code
 would have some strange gap of GHC version numbers over which it didn't
 work.

 Everyone would have to pretend 7.6.1 never happened, or  and break
 anyone's code that was already written for 7.6, so instead of one breaking
 change, we'd now have two.

 For instance, I'm already using ~ in 'github.com/ekmett/indexed.git' for
 natural transformations and I am loving it, and would be sad to lose it to
 the choice of ~ as a herald, similarly it would make the ~c~ trick more
 verbose, and ~ is particularly terrible for operators like ~+~.

 Other herald choices lead to different issues, '.' is slightly better for
 the other operators, but makes kind of ugly arrows, plus some day i'd
 _really_ like to be able to use . as a type constructor for functor
 composition! It is currently reserved at the type level as an almost
 accidental consequence of the way forall gets parsed today.

 I really like Iavor's entirely-in-language way of addressing the issue,
 due in part to it providing even better associativity than the existing
 approach, and honestly, even if GHC HQ was somehow convinced to set aside
 an ad hoc herald for type variables, I'd probably start using it in my
 code. (probably sandwiching between something like :- and : for old GHC
 compatibility). I really like that I can just call the Category c, and just
 get ~c~  or something similar as its arrows. This feels more notationally
 accurate to me.

 It also has two major benefits compared to any proposal for adding
 different heralds:

 1.) It is compatible with old code, code written with 7.6.1 and I suppose
 future code, since (:) is such a remarkably awkward choice of herald for
 the reasons already documented that it seems an unlikely choice.

 2.) I can program with it today.

 I just realized if you don't want to worry about collisions with the type
 naturals from GHC.TypeLits, and didn't care about pre-7.6 compatibility,
 you could strip the notation down all the way to

 cmap :: CFunctor f c d = (x -c y) - f x -d f y

 This is even shorter than the conventional

 cmap :: CFunctor f (~) (~~) = (x ~ y) - f x ~~ f y

 Which turns the but it is longer argument against it on its head. ;)

 -Edward

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-16 Thread Conal Elliott
Hm. ~ is a sometimes-fine prefix for abstracting over arrowish things,
but perhaps not so appealing for others doing pairish, sumish etc
abstractions.

-- Conal

On Sat, Sep 15, 2012 at 4:47 AM, Sjoerd Visscher sjo...@w3future.comwrote:

 +1. Making : the signal for type variables would break even more code,
 f.e. fclabels.

 ~ almost means variable, so I'd like that as a prefix.

 Sjoerd

 On Sep 15, 2012, at 2:09 AM, Cale Gibbard cgibb...@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 simo...@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
 
  ---
 
  aTerm variable Type variable
 
  AData constructor Type constructor
 
  +Term variable operator   Type constructor operator
 
  :+  Data constructor operator   Type variable operator
 
 
 
  Any other opinions?
 
 
 
  Simon
 
 
 
  From: conal.elli...@gmail.com [mailto:conal.elli...@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 
 simo...@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@haskell.org
  http

Re: Type operators in GHC

2012-09-16 Thread Conal Elliott
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 cgibb...@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 simo...@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
 
  ---
 
  aTerm variable Type variable
 
  AData constructor Type constructor
 
  +Term variable operator   Type constructor operator
 
  :+  Data constructor operator   Type variable operator
 
 
 
  Any other opinions?
 
 
 
  Simon
 
 
 
  From: conal.elli...@gmail.com [mailto:conal.elli...@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 
 simo...@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@haskell.org
  http://www.haskell.org

Re: Type operators in GHC

2012-09-16 Thread Conal Elliott
Hi Simon,

Yes, I could live with (.-), (.+), etc more easily than `arr`, `plus` etc.

Better yet would be a LANGUAGE pragma I can add to my libraries to get the
old behavior back.

Better still for me personally would be for other libraries to add a
LANGUAGE pragma to get the 7.6.1 behavior. I can live without this option.

Using a : prefix for type ctor variables would break the other half of my
types in these libraries. I use type variables with names like (~), (+),
(--) etc in order to express abstractions, and then I typically use those
abstractions to define concrete type ctors with names like (:-), (:+),
(:--), etc.

My regrets for raising these issues so late in the game.

-- Conal

On Fri, Sep 14, 2012 at 4:26 PM, Simon Peyton-Jones
simo...@microsoft.comwrote:

  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***
 *

 ---***
 *

 aTerm variable Type variable

 AData constructor Type constructor

 +Term variable operator   Type constructor operator***
 *

 :+  Data constructor operator   Type variable operator

 ** **

 Any other opinions?

 ** **

 Simon

 ** **

 *From:* conal.elli...@gmail.com [mailto:conal.elli...@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 simo...@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@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Re: Type operators in GHC

2012-09-15 Thread Sjoerd Visscher
+1. Making : the signal for type variables would break even more code, f.e. 
fclabels.

~ almost means variable, so I'd like that as a prefix.

Sjoerd

On Sep 15, 2012, at 2:09 AM, Cale Gibbard cgibb...@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 simo...@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
 
 ---
 
 aTerm variable Type variable
 
 AData constructor Type constructor
 
 +Term variable operator   Type constructor operator
 
 :+  Data constructor operator   Type variable operator
 
 
 
 Any other opinions?
 
 
 
 Simon
 
 
 
 From: conal.elli...@gmail.com [mailto:conal.elli...@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 simo...@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@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 
 
 
 
 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 
 
 ___
 Glasgow-haskell-users mailing list
 Glasgow

Re: Type operators in GHC

2012-09-15 Thread Edward Kmett
One issue with this proposal is it makes it *completely* impossible to pick
a type constructor operator that works with both older GHCs and 7.6.

It is a fairly elegant choice, but in practice it would force me and many
others to stop using them completely for the next couple of years, as I
wouldn't be able to support any users on older GHCs, or if I did I would
have to export completely different operator names, and then the users
would have to use conditional compilation to do different things with them.
=/

As it is, I can and do at least choose : prefixed names for any type
constructor I want to have be compatible with old GHCs.

Back when the change was initially proposed I think it was Igloo who
suggested that it might be possible to allow the use of symbols as type
variables if they were explicitly quantified by a forall.

Would that be a viable approach?

-Edward

On Fri, Sep 14, 2012 at 7:26 PM, Simon Peyton-Jones
simo...@microsoft.comwrote:

  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***
 *

 ---***
 *

 aTerm variable Type variable

 AData constructor Type constructor

 +Term variable operator   Type constructor operator***
 *

 :+  Data constructor operator   Type variable operator

 ** **

 Any other opinions?

 ** **

 Simon

 ** **

 *From:* conal.elli...@gmail.com [mailto:conal.elli...@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 
 simo...@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

RE: Type operators in GHC

2012-09-14 Thread Simon Peyton-Jones
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
---
aTerm variable Type variable
AData constructor Type constructor
+Term variable operator   Type constructor operator
:+  Data constructor operator   Type variable operator

Any other opinions?

Simon

From: conal.elli...@gmail.com [mailto:conal.elli...@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 
simo...@microsoft.commailto:simo...@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@haskell.orgmailto:Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-14 Thread Cale Gibbard
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 simo...@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

 ---

 aTerm variable Type variable

 AData constructor Type constructor

 +Term variable operator   Type constructor operator

 :+  Data constructor operator   Type variable operator



 Any other opinions?



 Simon



 From: conal.elli...@gmail.com [mailto:conal.elli...@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 simo...@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@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users




 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-09-06 Thread Conal Elliott
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
simo...@microsoft.comwrote:

 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@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-19 Thread Joachim Breitner
Hello,

while I agree that operators are usually more useful als type
constructors than as type variables, I’m wondering if it is future-proof
to completely get rid of a possibility for infix type variables. With
the type class system getting stronger and stronger, would this not mean
that there will be more and more use cases for infix type variables?
Maybe the change should at keep a (small) window open. Maybe, similar to
the current situation, a special character to indicate variables, not
constructors?

(I have no good idea, but here is at least one: A dot '.' as the first
character indicates a type variable; compared to a ':' this is a
non-capitalized character).


Also, is there maybe another way of distinguishing constructors and
variables, besides capitalization, that works equally well for operators
and non-operators? That could also help if a user would like to use
unicode characters in the name of a constructor that are letters but
don’t have a upper or titlecase variant. But then, this has probably
been given thought a long time ago, without a better solution than
capitalization resp. leading ':'.

Greetings,
Joachim

-- 
Joachim nomeata Breitner
  m...@joachim-breitner.de  |  nome...@debian.org  |  GPG: 0x4743206C
  xmpp: nome...@joachim-breitner.de | http://www.joachim-breitner.de/



signature.asc
Description: This is a digitally signed message part
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-19 Thread Matthew Farkas-Dyck
On 19/01/2012, Joachim Breitner m...@joachim-breitner.de wrote:
 (I have no good idea, but here is at least one: A dot '.' as the first
 character indicates a type variable; compared to a ':' this is a
 non-capitalized character).

So that all symbols that start in dot are variables, and all others
are types/constructors?

 Also, is there maybe another way of distinguishing constructors and
 variables, besides capitalization, that works equally well for operators
 and non-operators? That could also help if a user would like to use
 unicode characters in the name of a constructor that are letters but
 don’t have a upper or titlecase variant. But then, this has probably
 been given thought a long time ago, without a better solution than
 capitalization resp. leading ':'.

Sometimes I thought to use ∀ to quantify over type variables, as
over term variables, at least as an option.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-19 Thread Joachim Breitner
Hi,

Am Donnerstag, den 19.01.2012, 07:11 -0500 schrieb Matthew Farkas-Dyck:
 On 19/01/2012, Joachim Breitner m...@joachim-breitner.de wrote:
  (I have no good idea, but here is at least one: A dot '.' as the first
  character indicates a type variable; compared to a ':' this is a
  non-capitalized character).
 
 So that all symbols that start in dot are variables, and all others
 are types/constructors?

exactly, that would be an option to get the benefit of the proposal
(nicer type constructor operator names) without giving up completely on
type variable operators names.

Greetings,
Joachim
-- 
Joachim nomeata Breitner
  m...@joachim-breitner.de  |  nome...@debian.org  |  GPG: 0x4743206C
  xmpp: nome...@joachim-breitner.de | http://www.joachim-breitner.de/



signature.asc
Description: This is a digitally signed message part
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-19 Thread Ian Lynagh
On Thu, Jan 19, 2012 at 07:11:19AM -0500, Matthew Farkas-Dyck wrote:
 
 Sometimes I thought to use ∀ to quantify over type variables, as
 over term variables, at least as an option.

Do you mean that in

f :: (x, X, (+), (:+))

only x would be a type variable and X, (+), (:+) would be type
constructors, but that in

g :: forall y, Y, (*), (:*) .
 (x, X, (+), (:+), y, Y, (*), (:*))

y, Y, (*), (:*) would be type variables and x, X, (+), (:+) would be
whatever is in scope (constructors, unless there is an enclosing forall
that binds them)?

Perhaps we should be heading towards a case-insensitive syntax for type
names.


Thanks
Ian


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-19 Thread Matthew Farkas-Dyck
On 19/01/2012, Ian Lynagh ig...@earth.li wrote:
 Do you mean that in

 f :: (x, X, (+), (:+))

 only x would be a type variable and X, (+), (:+) would be type
 constructors, but that in

 g :: forall y, Y, (*), (:*) .
  (x, X, (+), (:+), y, Y, (*), (:*))

 y, Y, (*), (:*) would be type variables and x, X, (+), (:+) would be
 whatever is in scope (constructors, unless there is an enclosing forall
 that binds them)?

Just so.

 Perhaps we should be heading towards a case-insensitive syntax for type
 names.

I've often had that thought myself, for types and terms both. It would
make it much nicer to do general numeric computations in Haskell (e.g.
fluid mechanics) since one could use upper-case term names, which are
often customary. I actually designed a compiled-to-Haskell language
for just this reason (for fluid mechanics lab), but it's very crude.

That said, for word-names, the case-sensitive system we have is nice and brief.


 Thanks
 Ian


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-18 Thread Brandon Allbery
On Wed, Jan 18, 2012 at 10:42, Brent Yorgey byor...@seas.upenn.edu wrote:

 I'm not sure at this point which way I would lean on the issue.
 Having infix type constructors that don't have to start with : is
 something I would like, too.  But I just thought I would point out
 that code like tc192 is not as esoteric as you seem to think.


I seem to recall @src outputting a Prelude definition for something
(Monoid?) that used (*) as a type variable.

-- 
brandon s allbery  allber...@gmail.com
wandering unix systems administrator (available) (412) 475-9364 vm/sms
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-18 Thread Iavor Diatchki
Hello,

My preference would be to change the behavior of the TypeOperator
flag.  Here is my reasoning:
  * Having two operators with slightly different meanings would be
very confusing, not just for beginners but for everyone.
  * The two behaviors are not compatible in the sense that they can't
co-exist in the same language standard.  So something is bound to
break later on, and it'd be better to update packages now, before we
have grown a bigger code base that uses two incompatible extensions.
  * As I see it, having type-operator variables is useful in (some)
APIs (e.g., the parameters of the arrow classes), while type-operator
constructors are useful in defining concrete types/type-functions
(e.g., concrete implementations of arrows).  I expect that there are a
lot more concrete implementations than APIs (this is the whole point
of abstraction, after all!) so I think that it is a good trade-off to
use the nicer notation for the more common case.

-Iavor
PS: In the interest of fairness, I am also partial to the new notation
because I've been working on support for arithmetic at the type-level,
and seem to have developed a bit of an allergy to typing :+:, :*:, :=
etc all the time :-)


On Wed, Jan 18, 2012 at 9:36 AM, Brandon Allbery allber...@gmail.com wrote:
 On Wed, Jan 18, 2012 at 10:42, Brent Yorgey byor...@seas.upenn.edu wrote:

 I'm not sure at this point which way I would lean on the issue.
 Having infix type constructors that don't have to start with : is
 something I would like, too.  But I just thought I would point out
 that code like tc192 is not as esoteric as you seem to think.


 I seem to recall @src outputting a Prelude definition for something
 (Monoid?) that used (*) as a type variable.

 --
 brandon s allbery                                      allber...@gmail.com
 wandering unix systems administrator (available)     (412) 475-9364 vm/sms


 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Type operators in GHC

2012-01-18 Thread Edward Kmett
I can live with it and I probably have as many packages as anyone that will
be broken by it. =/

Things like

http://hackage.haskell.org/packages/archive/categories/0.58.0.5/doc/html/src/Control-Category-Cartesian-Closed.html


will need a pretty invasive rewrite, but the simplicity is worth it, and it
makes for much better operators at the type level.

I can pre-emptively change the packages so as to be compatible with both,
so I have an upgrade path, which makes it all good.

-Edward

On Wed, Jan 18, 2012 at 9:27 AM, Simon Peyton-Jones
simo...@microsoft.comwrote:

 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@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users