if-then-else as rebindable syntax (was Re: Why does Haskell have the if-then-else syntax?)

I would be happy to write up a trac-ticket for this - I could even try
to implement it in GHC. However, I'm surprised that you agree with it
so easily since it breaks some Haskell 98-ish stuff in un-nice ways.
:-)
First of all, programs that import names from the Prelude explicitly
would no longer be able to use if-then-else unless they also added
'cond' to that input list (or redefined it of course). This shouldn't
really be a problem, since the rebindable syntax is turned on by
adding some flag anyway, and if you add that flag you know you're no
longer H98. Still, it's going to break a lot of existing programs.
The second problem is that it would require the addition of the cond
function to the Prelude. This will probably not break too many
existing programs, but still it is a more serious problem since it
will have effect even without any flags to GHC. Or is it possible to
govern the contents of the Prelude based on flags?
I would really like to see this implemented, and I don't think the
above is serious enough that we shouldn't. There may be some that
don't agree though. Speak up now, or forever hold your peace!
Also, is cond the best name for the suggested function? If we don't
expect anyone to really use it without the sugar, we could name it
whatever weird thing so as to break as few existing programs as
possible. It would make explicit import a bit more akward though. But
I suspect that if this function did exist in the Prelude, people would
start using it a lot. Does anyone have any better suggestions, or is
cond the name of the day?
/Niklas
On 7/27/06, Simon Peyton-Jones
GHC does indeed include the notion of "rebindable syntax". It would be straightforward to extend it to include if-then-else. In effect, that would mean that if e1 then e2 else e3 would behave exactly like cond e1 e2 e3 including from the point of view of typing. (You could choose a different name than 'cond'.) Then by importing a 'cond' with (say) type
cond :: MyBool -> b -> b you could use a different kind of Boolean. You could even overload the bool: cond :: Boolean a => a -> b -> b
This could be done with a few hours work. But not a few minutes. Want to put a feature request in Trac?
Simon
| -----Original Message----- | From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Niklas | Broberg | Sent: 27 July 2006 09:01 | To: Haskell-cafe | Subject: Re: [Haskell-cafe] Why does Haskell have the if-then-else syntax? | | I often find myself at odds with this choice. The reason is that I use | Haskell as a host for embedded languages, and these often come with | their own control flows. So I find myself wanting to write my own | definition of the if-then-else construct that works on terms of some | other type, e.g. tests on values of type Exp Bool instead of Bool, and | at the same time make sure that the user doesn't use the built-in | if-then-else. Sure, I can (and do) call my own version if_, ifElse or | something else along those lines, but it's sure to be a constant | source of programmer errors, writing if-then-else instead of if_ by | habit. | | A thought that has crossed my mind on several occasions is, why not | make the syntactic if-then-else construct rebindable, like the do | notation? I think I know the answer already -- the do notation is | syntactic sugar for >>= and company so it's easy to translate it into | non-prelude-qualified versions of functions with those names. This is | not the case for if-then-else. But it could be, the prelude could | define a function if_ (or whatever) that the if-then-else construct is | made to be sugar for, and thus also amenable to rebinding by not | prelude-qualifying. | | /Niklas | | On 7/27/06, Paul Hudak
wrote: | > Mike Gunter wrote: | > | > >I had hoped the "History of Haskell" paper would answer a question | > >I've pondered for some time: why does Haskell have the if-then-else | > >syntax? The paper doesn't address this. What's the story? | > > | > >thanks, | > >-m | > > | > > | > Thanks for asking about this -- it probably should be in the paper. Dan | > Doel's answer is closest to the truth: | > | > I imagine the answer is that having the syntax for it looks nicer/is | > clearer. "if a b c" could be more cryptic than "if a then b else c" | > for some values of a, b and c. | > | > except that there was also the simple desire to conform to convention | > here (I don't recall fewer parentheses being a reason for the choice). | > In considering the alternative, I remember the function "cond" being | > proposed instead of "if", in deference to Scheme and to avoid confusion | > with people's expectations regarding "if". | > | > A related issue is why Haskell does not have a "single arm" conditional | > -- i.e. an "if-then" form, which would evaluate to bottom (i.e. error) | > if the predicate were false. This was actually discussed, but rejected | > as a bad idea for a purely functional language. | > | > -Paul | > | > _______________________________________________ | > Haskell-Cafe mailing list | > Haskell-Cafe@haskell.org | > http://www.haskell.org/mailman/listinfo/haskell-cafe | > | _______________________________________________ | Haskell-Cafe mailing list | Haskell-Cafe@haskell.org | http://www.haskell.org/mailman/listinfo/haskell-cafe

On Jul 27, 2006, at 1:35 PM, Niklas Broberg wrote:
I would really like to see this implemented, and I don't think the above is serious enough that we shouldn't. There may be some that don't agree though. Speak up now, or forever hold your peace!
Given the ever increasing complexity of Haskell as understood by the GHC, I think very few people are looking forward to see further complications that do not really add much. We alreday are at a stage where first year students trying to master haskell get error messages like "Bool is not an instance of the class Num" if they accidently write 1 + True (or something equivalent, but less obvious). If you want to mess around why not call the function "provided" or something similar. In short: you will not make Haskell a lot more popular by attracting category theorists, but by making transitions from Java and C as smooth and surprise-free as possible (and this is already hard enough). So I strongly suggest to leave this to the next major redesign of the language. Doaitse Swierstra

On 7/27/06, Doaitse Swierstra
Given the ever increasing complexity of Haskell as understood by the GHC, I think very few people are looking forward to see further complications that do not really add much.
We alreday are at a stage where first year students trying to master haskell get error messages like
"Bool is not an instance of the class Num"
if they accidently write 1 + True (or something equivalent, but less obvious).
I absolutely agree with you, making Haskell easy to understand for newcomers is a far more important goal than an esoteric feature like this. If this cannot be added in a transparent enough way, then it shouldn't be added. But I don't see why it couldn't be. Have you ever been bitten by the rebinding feature provided for the do-notation (without trying to use it that is)? Why should the if-then-else be any harder?
If you want to mess around why not call the function "provided" or something similar.
Not a bad suggestion.
In short: you will not make Haskell a lot more popular by attracting category theorists, but by making transitions from Java and C as smooth and surprise-free as possible (and this is already hard enough).
Agreed. A feature like this should certainly not be by default, but only for advanced users. There should be no surprises.
So I strongly suggest to leave this to the next major redesign of the language.
Well, if you want to redesign the core language, it is always easier to include features that have been tried out in practice. Hen or egg. I am not convinced that this is too complicated a feature to be added to GHC right now -- provided that it can be added in a transparent way. /Niklas

| We alreday are at a stage where first year students trying to master | haskell get error messages like | | "Bool is not an instance of the class Num" | | if they accidently write 1 + True (or something equivalent, but less | obvious). | | If you want to mess around why not call the function "provided" or | something similar. Just to be clear, to get rebindable syntax in GHC today, you have to ask for it explicitly, via -fno-implicit-prelude If you use that flag, you'd better know what it means. It already means that do-notation uses whatever (>>) and (>>=) are in scope, not Control.Monad.(>>) etc. This if-thing is just another example. No beginner will encounter this complication; they'd have to ask for it. Simon

I'm all for making Haskell easy for beginners, but as Simon points out, this change shouldn't really affect them. Since I'm also a fan of using Haskell as the host for embedded DSL's, I think this would be a good addition, since it provides more flexibility with the syntax. -Paul Simon Peyton-Jones wrote:
Just to be clear, to get rebindable syntax in GHC today, you have to ask for it explicitly, via -fno-implicit-prelude
If you use that flag, you'd better know what it means. It already means that do-notation uses whatever (>>) and (>>=) are in scope, not Control.Monad.(>>) etc. This if-thing is just another example.
No beginner will encounter this complication; they'd have to ask for it.
Simon

On Thu, Jul 27, 2006 at 02:57:20PM +0200, Doaitse Swierstra wrote:
On Jul 27, 2006, at 1:35 PM, Niklas Broberg wrote:
I would really like to see this implemented, and I don't think the above is serious enough that we shouldn't. There may be some that don't agree though. Speak up now, or forever hold your peace!
Me too, this sounds really cool!
We alreday are at a stage where first year students trying to master haskell get error messages like
"Bool is not an instance of the class Num"
if they accidently write 1 + True (or something equivalent, but less obvious).
I think this is not a language issue so much as a compiler issue, and I don't think it's a sound idea to limit the language or libraries based on the existing poor error messages. If the above gave a message like (+) requires an argument of class Num, but "True" is of type Bool, which is not in class Num. I don't think there would be a problem. In general, I think classes should be used more, rather than less, and if that means we need a SoC project to improve the clarity of error messages, then that's what needs to be done. (I'll admit, I'm unlikely to do this...)
If you want to mess around why not call the function "provided" or something similar.
Or perhaps (?:) or something like that, which could be used infix to evoke the idea of C's e1 ? e2 : e3 syntax. "provided" to me is less clear than "cond" since it has other meanings, and isn't borrowed from any language that I'm familiar with, like "cond" is. -- David Roundy

On 27/07/06, David Roundy
Or perhaps (?:) or something like that, which could be used infix to evoke the idea of C's e1 ? e2 : e3 syntax. "provided" to me is less clear than "cond" since it has other meanings, and isn't borrowed from any language that I'm familiar with, like "cond" is.
This has come up a few times on #haskell, and the consensus is that a tertiary (?:) operator isn't possible because of the deep specialness of (:). However, you can simulate it pretty well: infixr 1 ? (?) :: Bool -> (a, a) -> a True ? (t, _) = t False ? (_, t) = t Then you call it like: length "hello" > 4 ? ("yes it is!", "afraid not") -- -David House, dmhouse@gmail.com

"David House"
Or perhaps (?:) or something like that,
This has come up a few times on #haskell, and the consensus is that a tertiary (?:) operator isn't possible because of the deep specialness of (:). However, you can simulate it pretty well:
infixr 1 ? (?) :: Bool -> (a, a) -> a True ? (t, _) = t False ? (_, t) = t
length "hello" > 4 ? ("yes it is!", "afraid not")
HaXml has a lifted version of C's tertiary operator, which matches C's syntax even more closely: data ThenElse a = a :> a infixr 3 ?>, :> (?>) :: (a->Bool) -> ThenElse (a->b) -> (a->b) p ?> (f :> g) = \c-> if p c then f c else g c You can drop it back down to the term level easily enough: (?>) :: Bool -> ThenElse a -> a p ?> (t :> e) = if p then t else e Because the operators are right associative, you don't need parens when you use it: length "hello" == 4 ?> "yes it is!" :> "afraid not" Regards, Malcolm

(Appologies to Malcolm for multiple copies. Say after me, Reply All!)
On 7/28/06, Malcolm Wallace
"David House"
wrote: Or perhaps (?:) or something like that,
This has come up a few times on #haskell, and the consensus is that a tertiary (?:) operator isn't possible because of the deep specialness of (:). However, you can simulate it pretty well:
infixr 1 ? (?) :: Bool -> (a, a) -> a True ? (t, _) = t False ? (_, t) = t
length "hello" > 4 ? ("yes it is!", "afraid not")
HaXml has a lifted version of C's tertiary operator, which matches C's syntax even more closely:
data ThenElse a = a :> a infixr 3 ?>, :>
(?>) :: (a->Bool) -> ThenElse (a->b) -> (a->b) p ?> (f :> g) = \c-> if p c then f c else g c
You can drop it back down to the term level easily enough:
(?>) :: Bool -> ThenElse a -> a p ?> (t :> e) = if p then t else e
Because the operators are right associative, you don't need parens when you use it:
length "hello" == 4 ?> "yes it is!" :> "afraid not"
I've used this trick as well with a ThenElse data constructor, but that's just for aesthetical reasons, wanting the : first. You could just as easily say e.g. (?) :: Bool -> (a,a) -> a (?) p = if p then fst else snd (<:>) :: a -> a -> (a,a) a <:> b = (a,b) and use it like length "hello" == 4 ? "yup" <:> "nope" The benefit over Malcolm's version is that the (?) operator becomes useful in its own right, like David's version. /Niklas

On 7/27/06, Doaitse Swierstra
In short: you will not make Haskell a lot more popular by attracting category theorists, but by making transitions from Java and C as smooth and surprise-free as possible (and this is already hard enough).
Actually, this is exactly my argument for wanting this feature in the language - only exchange Haskell for whatever DSL I want to embed in Haskell. :-) /Niklas

"Doaitse Swierstra"
We alreday are at a stage where first year students trying to master haskell get error messages like "Bool is not an instance of the class Num" if they accidently write 1 + True (or something equivalent, but less obvious).
Good! It will prepare them for C++ error messages of several pages because you forgot to write const next to a member function, thus make the transition from Haskell to something that pays the rent easier.
In short: you will not make Haskell a lot more popular by attracting category theorists, but by making transitions from Java and C as smooth and surprise-free as possible (and this is already hard enough).
Are we talking about the straw that broke the camel's back? Are you serious about making Java/C programmers transition to Haskell? What would be the purpose of that? Immanuel -- *************************************************************************** I can, I can't. Tubbs Tattsyrup -- Immanuel Litzroth Software Development Engineer Enfocus Software Antwerpsesteenweg 41-45 9000 Gent Belgium Voice: +32 9 269 23 90 Fax : +32 9 269 16 91 Email: Immanuell@enfocus.be web : www.enfocus.be ***************************************************************************

On 7/27/06, Niklas Broberg
I would be happy to write up a trac-ticket for this - I could even try to implement it in GHC. However, I'm surprised that you agree with it so easily since it breaks some Haskell 98-ish stuff in un-nice ways. :-)
I have now added a trac ticket for this proposal: http://hackage.haskell.org/trac/ghc/ticket/836 Please update if anyone has something to add or comment. /Niklas

On Thu, 27 Jul 2006, Niklas Broberg wrote:
Also, is cond the best name for the suggested function? If we don't expect anyone to really use it without the sugar, we could name it whatever weird thing so as to break as few existing programs as possible. It would make explicit import a bit more akward though. But I suspect that if this function did exist in the Prelude, people would start using it a lot.
That's true, I would like to use it. I plead for adding it to Prelude, whether the if-syntax becomes rebindable or not. I like to use (zipWith cond) for composing two lists depending on a key, or (uncurry . cond) as a choice between fst and snd, or the already mentioned 'select' command (foldr (uncurry cond)).
Does anyone have any better suggestions, or is cond the name of the day?
I like the similarity to "if". However if_ or if' are too un-preludish. :-) ifElseThen is probably too long. 'cond' is acceptable. 'provided' too.

(Apologies to Niklas for multiple copies, it was a Reply/Reply to all mixup.)
On 27/07/06, Niklas Broberg
First of all, programs that import names from the Prelude explicitly would no longer be able to use if-then-else unless they also added 'cond' to that input list (or redefined it of course). This shouldn't really be a problem, since the rebindable syntax is turned on by adding some flag anyway, and if you add that flag you know you're no longer H98. Still, it's going to break a lot of existing programs. The second problem is that it would require the addition of the cond function to the Prelude. This will probably not break too many existing programs, but still it is a more serious problem since it will have effect even without any flags to GHC. Or is it possible to govern the contents of the Prelude based on flags?
How about we drop the idea of an auxilary cond function, and instead just use a Boolean typeclass? class Boolean b where isTrue :: b -> Bool isFalse :: b -> Bool Then the semantics of if-then-else would change to something like this: if b then t1 else t2 b is required to be of a type which instantiates Boolean If isTrue b is True, then t1 is executed, otherwise if isFalse b is True, then t2 is executed, otherwise _|_ is returned. Then you get the benefit of being able to use arbitrary 'boolean-like' types in actual if statements, without messing around with -fno-implicit-prelude and rebindable syntax. -- -David House, dmhouse@gmail.com

On 7/27/06, David House
How about we drop the idea of an auxilary cond function, and instead just use a Boolean typeclass?
class Boolean b where isTrue :: b -> Bool isFalse :: b -> Bool
Then the semantics of if-then-else would change to something like this:
if b then t1 else t2 b is required to be of a type which instantiates Boolean If isTrue b is True, then t1 is executed, otherwise if isFalse b is True, then t2 is executed, otherwise _|_ is returned.
Then you get the benefit of being able to use arbitrary 'boolean-like' types in actual if statements, without messing around with -fno-implicit-prelude and rebindable syntax.
It would be possible, sure, but I don't want to go in this direction. I don't only want to overload the if-then-else for different kinds of booleans, I would like to be able to change its behavior completely. One particular application of this that I have in mind is the JavaScript "embedding" that Joel Björnson is currently working on as his SoC project. There the "embedding" is actually a set of combinators for constructing an abstract syntax tree, so if-then-else would translate into the data constructor IfThenElse applied to its arguments. /Niklas

On Thu, 27 Jul 2006, David House wrote:
How about we drop the idea of an auxilary cond function, and instead just use a Boolean typeclass?
class Boolean b where isTrue :: b -> Bool isFalse :: b -> Bool
I suspect that then the Int instance for Boolean will quickly arise, http://repetae.net/john/recent/out/Boolean.html which flood us with (if 2+3 then "true" else "false"). This would take us a lot of type safety.

[Henning Thielemann
On Thu, 27 Jul 2006, David House wrote:
How about we drop the idea of an auxilary cond function, and instead just use a Boolean typeclass?
class Boolean b where isTrue :: b -> Bool isFalse :: b -> Bool
I suspect that then the Int instance for Boolean will quickly arise, http://repetae.net/john/recent/out/Boolean.html which flood us with (if 2+3 then "true" else "false"). This would take us a lot of type safety.
No doubt the String instance would be close behind... Matt -- Matt Hellige matt@immute.net

David House wrote:
How about we drop the idea of an auxilary cond function, and instead just use a Boolean typeclass?
class Boolean b where isTrue :: b -> Bool isFalse :: b -> Bool
I don't think this covers embedded languages. If everything lives in some monad it might be useful to rebind the if syntax at a type like DSLMonad Bool -> DSLMonad a -> DSLMonad a -> DSLMonad a Independent of how the if syntax works, an if function would still be handy. Maybe even both argument orders, a -> a -> Bool -> a for transforming booleans, and to follow the standard argument order on catamorphisms, and Bool -> a -> a where the conventional if order is good. Brandon

Niklas Broberg wrote:
Also, is cond the best name for the suggested function? If we don't expect anyone to really use it without the sugar, we could name it whatever weird thing so as to break as few existing programs as possible. It would make explicit import a bit more akward though. But I suspect that if this function did exist in the Prelude, people would start using it a lot. Does anyone have any better suggestions, or is cond the name of the day?
I suggest: if_then_else :: a -> b -> b -> b as the name of the function so that "cond" could be used for the new construct suggested by Tomasz. Regards, Brian. -- Logic empowers us and Love gives us purpose. Yet still phantoms restless for eras long past, congealed in the present in unthought forms, strive mightily unseen to destroy us. http://www.metamilk.com
participants (12)
-
Brandon Moore
-
Brian Hulley
-
David House
-
David Roundy
-
Doaitse Swierstra
-
Henning Thielemann
-
Immanuel Litzroth
-
Malcolm Wallace
-
Matt Hellige
-
Niklas Broberg
-
Paul Hudak
-
Simon Peyton-Jones