Proposal: Infix expression keyword: -XInfixExpressions

Ahoy, The idiom discussion brought back to mind a general problem (well, for me) in Haskell syntax which is there is no syntactic sugar for interspersing operators to many arguments. Regarding a solution for this, I wrote up a wee proposal here: https://gist.github.com/chrisdone/d9d33e4770a2fef19ad1 If I go ahead and implement this in GHC as -XInfixExpressions or something (better names welcome), would it be likely to be accepted? I could first do an implementation in haskell-src-exts to demonstrate the concept. Ciao!

This example
infix <op> a b c d → a <op> b <op> c <op> d
makes me thing to the Lisp (+ a b c d) s-expression...
And indeed your infix keyword could be replaced by something like
⟨<op> a b c d⟩ → a <op> b <op> c <op> d
Voilà, s-expressions part of Haskell syntax !
2015-02-19 15:51 GMT+01:00 Christopher Done
Ahoy,
The idiom discussion brought back to mind a general problem (well, for me) in Haskell syntax which is there is no syntactic sugar for interspersing operators to many arguments.
Regarding a solution for this, I wrote up a wee proposal here: https://gist.github.com/chrisdone/d9d33e4770a2fef19ad1
If I go ahead and implement this in GHC as -XInfixExpressions or something (better names welcome), would it be likely to be accepted? I could first do an implementation in haskell-src-exts to demonstrate the concept.
Ciao! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

On 19 February 2015 at 16:07, Vo Minh Thu
And indeed your infix keyword could be replaced by something like
⟨<op> a b c d⟩ → a <op> b <op> c <op> d
Voilà, s-expressions part of Haskell syntax !
This is how it worked in Lisk. :-) But I don't know how on my keyboard to type those characters. ;-)

"infix" for two or more arguments is pretty much just "foldl1".
On Fri, Feb 20, 2015 at 1:51 AM, Christopher Done
Ahoy,
The idiom discussion brought back to mind a general problem (well, for me) in Haskell syntax which is there is no syntactic sugar for interspersing operators to many arguments.
Regarding a solution for this, I wrote up a wee proposal here: https://gist.github.com/chrisdone/d9d33e4770a2fef19ad1
If I go ahead and implement this in GHC as -XInfixExpressions or something (better names welcome), would it be likely to be accepted? I could first do an implementation in haskell-src-exts to demonstrate the concept.
Ciao! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

If I'm reading it correctly, the only example where a fold wouldn't
work is <*>, right? And probably conduits, I don't know the types
there.
Erik
On Thu, Feb 19, 2015 at 4:22 PM, Christopher Done
On 19 February 2015 at 16:15, Clinton Mead
wrote: "infix" for two or more arguments is pretty much just "foldl1".
Please see the proposal. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

On 19 February 2015 at 16:29, Erik Hesselink
If I'm reading it correctly, the only example where a fold wouldn't work is <*>, right? And probably conduits, I don't know the types there.
Right, I see three use-cases: * Some things are foldable cleanly like monoids, so you can just mconcat [x,y,z] and that'll be inlined (I think). * Other things like x <|> y is not the same as asum [x,y] due to the additional mempty being introduced. You can also use foldl1 kind of functions, but they are partial and therefore not desirable. * Finally, things like <*>, $=, $, ., #/:& (e.g. in HList/vinyl) can't be folded at all, because the types are different. The third use-case doesn't have a solution that I'm aware of. So this solves that. It also solves the second use-case, which has only a partial (he he) solution. The first use-case is just a bonus. Should I add this clarification to the proposal?

On Thu, Feb 19, 2015 at 4:42 PM, Christopher Done
On 19 February 2015 at 16:29, Erik Hesselink
wrote: If I'm reading it correctly, the only example where a fold wouldn't work is <*>, right? And probably conduits, I don't know the types there.
Right, I see three use-cases:
* Some things are foldable cleanly like monoids, so you can just mconcat [x,y,z] and that'll be inlined (I think). * Other things like x <|> y is not the same as asum [x,y] due to the additional mempty being introduced. You can also use foldl1 kind of functions, but they are partial and therefore not desirable.
Do you mean execution-wise? Because semantically there should be no difference, I think. Although now that I think of it, there might be for things that carry information in the mempty case, like ErrorT, when they are right biased. It could be argued that this is a bug, and ExceptT fixes it. You could write monoids that do the same thing, e.g. instance Monoid b => Monoid (Either String b) where mempty = Left "" mappend (Right x) _ = Right x mappend _ y = y I have a feeling that `Alternative (f a)` should satisfy the Monoid laws for `Monoid (f a)`, but that doesn't seem to be documented. It does say 'a monoid on applicative functors', so perhaps it's implied.
* Finally, things like <*>, $=, $, ., #/:& (e.g. in HList/vinyl) can't be folded at all, because the types are different.
The third use-case doesn't have a solution that I'm aware of. So this solves that. It also solves the second use-case, which has only a partial (he he) solution. The first use-case is just a bonus. Should I add this clarification to the proposal?
Yes, that sounds good. It wasn't immediately obvious to me in the first paragraph why you would want this, and after the examples, I thought "meh". This list is very clarifying, and the third bullet is much more convincing to me. Erik

Hi, Am Donnerstag, den 19.02.2015, 16:42 +0100 schrieb Christopher Done:
* Some things are foldable cleanly like monoids, so you can just mconcat [x,y,z] and that'll be inlined (I think).
the sufficiently smart compiler might do that, but not this one (GHC 7.8.4). Neither in the generic case of foo :: Monoid a => a -> a -> a -> a -> a -> a foo a b c d e = mconcat [a,b,c,d,e] nor the monomophic case of foo :: String -> String -> String -> String -> String -> String foo a b c d e = mconcat [a,b,c,d,e] BTW, would your proposal extend to types? i.e. foo :: infix (->) String String String String String foo a b c d e = mconcat [a,b,c,d,e] Greetings, Joachim -- Joachim “nomeata” Breitner mail@joachim-breitner.de • http://www.joachim-breitner.de/ Jabber: nomeata@joachim-breitner.de • GPG-Key: 0xF0FBF51F Debian Developer: nomeata@debian.org

On 20 February 2015 at 14:02, Joachim Breitner
the sufficiently smart compiler might do that, but not this one (GHC 7.8.4). Neither in the generic case of
foo :: Monoid a => a -> a -> a -> a -> a -> a foo a b c d e = mconcat [a,b,c,d,e]
nor the monomophic case of
foo :: String -> String -> String -> String -> String -> String foo a b c d e = mconcat [a,b,c,d,e]
Huh, really? Good to know. I'll update the doc. :-)
BTW, would your proposal extend to types? i.e.
foo :: infix (->) String String String String String foo a b c d e = mconcat [a,b,c,d,e]
Could do, that would come in handy for HList kind of constructions too.

On Thu, Feb 19, 2015 at 10:42 AM, Christopher Done
Right, I see three use-cases:
* Some things are foldable cleanly like monoids, so you can just mconcat [x,y,z] and that'll be inlined (I think). * Other things like x <|> y is not the same as asum [x,y] due to the additional mempty being introduced. You can also use foldl1 kind of functions, but they are partial and therefore not desirable. * Finally, things like <*>, $=, $, ., #/:& (e.g. in HList/vinyl) can't be folded at all, because the types are different.
The third use-case doesn't have a solution that I'm aware of. So this solves that. It also solves the second use-case, which has only a partial (he he) solution. The first use-case is just a bonus. Should I add this clarification to the proposal?
I think this is a half-solution to the third option: https://gist.github.com/aavogt/433969cc83548e1f59ea Rather than adding more syntax, maybe it's better to make polymorphic functions/values easier to create. Writing instances of ApplyAB is a pain, but ghc could help, as it does with this quasiquoter http://lpaste.net/114788. Regards, Adam

Because:
1. It's hard to write an ApplyAB instance
2. using AllowAmbiguousTypes means you can't partially apply the iI /
iIwith without giving a type signature (which ghci is quite able to
infer for you). When we get -XDysfunctionalDependencies
(https://phabricator.haskell.org/D69) I think we'll be able to stop
using AllowAmbiguousTypes.
those might not be big problems, but the current solution (use an
infix operator) is a much smaller problem for me.
On Fri, Feb 20, 2015 at 2:25 PM, Christopher Done
On 20 February 2015 at 20:12, adam vogt
wrote: I think this is a half-solution to the third option
Because?

I've been playing around with various implementations like this.
Interestingly, this more general version allows nested "idiom brackets"
whilst a more specific implementation (such as the one on the haskell wiki)
doesn't. Any ideas why?
The two implementations I have been testing this with are
https://gist.github.com/mpickering/e19f6a5590a74fc36752
On Fri, Feb 20, 2015 at 7:12 PM, adam vogt
On Thu, Feb 19, 2015 at 10:42 AM, Christopher Done
wrote: Right, I see three use-cases:
* Some things are foldable cleanly like monoids, so you can just mconcat [x,y,z] and that'll be inlined (I think). * Other things like x <|> y is not the same as asum [x,y] due to the additional mempty being introduced. You can also use foldl1 kind of functions, but they are partial and therefore not desirable. * Finally, things like <*>, $=, $, ., #/:& (e.g. in HList/vinyl) can't be folded at all, because the types are different.
The third use-case doesn't have a solution that I'm aware of. So this solves that. It also solves the second use-case, which has only a partial (he he) solution. The first use-case is just a bonus. Should I add this clarification to the proposal?
I think this is a half-solution to the third option:
https://gist.github.com/aavogt/433969cc83548e1f59ea
Rather than adding more syntax, maybe it's better to make polymorphic functions/values easier to create. Writing instances of ApplyAB is a pain, but ghc could help, as it does with this quasiquoter http://lpaste.net/114788.
Regards, Adam _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

Hi Matthew, Looks like you can nest your version, if you add type annotations specifying the result type of each bracket.
runIdentity $ iI (+) f (iI (+) (Identity 1) (Identity 1) Ii :: Identity Int) Ii :: Int
Changing "i x" to ix in the instance head lets ghc pick the instance
when an Ii shows up, and then decide the result of the bracket is "i
x":
instance (Applicative i, ix ~ i x) => Idiomatic (Ii -> ix) where
type I (Ii -> ix) = GetI ix
type F (Ii -> ix) = GetX ix
idiomatic xi Ii = xi
type family GetI xi :: * -> *
type family GetX xi :: *
type instance GetI (i x) = i
type instance GetX (i x) = x
It seems cleaner to avoid type families for this problem:
https://gist.github.com/aavogt/433969cc83548e1f59ea#file-ii-hs
Regards,
Adam
On Tue, Feb 24, 2015 at 8:44 AM, Matthew Pickering
I've been playing around with various implementations like this. Interestingly, this more general version allows nested "idiom brackets" whilst a more specific implementation (such as the one on the haskell wiki) doesn't. Any ideas why?
The two implementations I have been testing this with are https://gist.github.com/mpickering/e19f6a5590a74fc36752
On Fri, Feb 20, 2015 at 7:12 PM, adam vogt
wrote: On Thu, Feb 19, 2015 at 10:42 AM, Christopher Done
wrote: Right, I see three use-cases:
* Some things are foldable cleanly like monoids, so you can just mconcat [x,y,z] and that'll be inlined (I think). * Other things like x <|> y is not the same as asum [x,y] due to the additional mempty being introduced. You can also use foldl1 kind of functions, but they are partial and therefore not desirable. * Finally, things like <*>, $=, $, ., #/:& (e.g. in HList/vinyl) can't be folded at all, because the types are different.
The third use-case doesn't have a solution that I'm aware of. So this solves that. It also solves the second use-case, which has only a partial (he he) solution. The first use-case is just a bonus. Should I add this clarification to the proposal?
I think this is a half-solution to the third option:
https://gist.github.com/aavogt/433969cc83548e1f59ea
Rather than adding more syntax, maybe it's better to make polymorphic functions/values easier to create. Writing instances of ApplyAB is a pain, but ghc could help, as it does with this quasiquoter http://lpaste.net/114788.
Regards, Adam _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

On Thu, Feb 19, 2015 at 03:51:31PM +0100, Christopher Done wrote:
The idiom discussion brought back to mind a general problem (well, for me) in Haskell syntax which is there is no syntactic sugar for interspersing operators to many arguments.
The goal of reducing duplication like this is a worthy one. I don't like the idea of using what essentially amounts to a macro as it is not first class. However, if a first class way can be found to make such a thing type check (perhaps some cunning use of dependent types) then I will be all for it! Tom

What would be the typing rules for this? What would be the types of
e.g. pointfree written function definitions (`f` in `let f = infix + 5
in f 2 + f 2 3 4`)? Haskell does support variable umber of argument
functions like for instance the `printf` by using type class instances
for arguments, but I don't think that approach would be flexible
enough to ensure type safety in all cases?
On Thu, Feb 19, 2015 at 3:51 PM, Christopher Done
Ahoy,
The idiom discussion brought back to mind a general problem (well, for me) in Haskell syntax which is there is no syntactic sugar for interspersing operators to many arguments.
Regarding a solution for this, I wrote up a wee proposal here: https://gist.github.com/chrisdone/d9d33e4770a2fef19ad1
If I go ahead and implement this in GHC as -XInfixExpressions or something (better names welcome), would it be likely to be accepted? I could first do an implementation in haskell-src-exts to demonstrate the concept.
Ciao! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

On 19 February 2015 at 18:53, Nils Schweinsberg
What would be the typing rules for this? What would be the types of e.g. pointfree written function definitions (`f` in `let f = infix + 5 in f 2 + f 2 3 4`)?
Purely syntactical, the translation I gave was literal: let f = infix + 5 is the same as let f = (5 +). But to avoid confusion it's also possible to disallow unary arguments and mandate at least two arguments.

That's an interesting idea! A few remarks: 1. For consistency it's probably a good idea to either backtick non-operators such as: infix `mappend` x y z or parenthesize operators such as: infix (+) x y z I tend to prefer the latter because my eyes are very accustomed to reading `infix + x y z` as `(infix) + (x y z)`. 2. I think it might be useful to have a multiline version: infix (+) in x y w z * d which the lexer desugars to: infix (+) in { x ; y w ; z * d } and is semantically equivalent to: infix (+) x (y w) (z * d) This provides the additional benefit of not having to parenthesize non-atomic arguments, which can be a source of typos.

If this was used, you could probably also extend it to patterns where the function is a data constructor. Might be handy for vectors too, where OverloadedLists doesn't work. I could see myself using this to make arrow-y types easier to work with; being able to treat sums and products like lists would be much nicer than the type operator route, though that would require (,) not to be handled specially. Christopher Done-2 wrote
On 19 February 2015 at 18:53, Nils Schweinsberg <
mail@
> wrote:
What would be the typing rules for this? What would be the types of e.g. pointfree written function definitions (`f` in `let f = infix + 5 in f 2 + f 2 3 4`)?
Purely syntactical, the translation I gave was literal: let f = infix + 5 is the same as let f = (5 +). But to avoid confusion it's also possible to disallow unary arguments and mandate at least two arguments. _______________________________________________ Haskell-Cafe mailing list
Haskell-Cafe@
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
-- View this message in context: http://haskell.1045720.n5.nabble.com/Proposal-Infix-expression-keyword-XInfi... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

If so, I feel like this would break consistency with the current syntax
since e.g. all these definitions of `f` would be valid but have completely
different type/meaning (even though in "classical" Haskell they would be
identical):
f x y = infix (+) 1 2 x y -- f :: Int -> Int -> Int
f x = infix (+) 1 2 x -- f :: Int -> Int
f = infix (+) 1 2 -- f :: Int
I like the general idea to represent variable argument functions as infix
function applications, but I wouldn't like a purely syntactical solution
that adds no real new functionality and is biased towards non-function
values like strings, integeres, etc.
On Thu, Feb 19, 2015 at 7:11 PM, Christopher Done
On 19 February 2015 at 18:53, Nils Schweinsberg
wrote: What would be the typing rules for this? What would be the types of e.g. pointfree written function definitions (`f` in `let f = infix + 5 in f 2 + f 2 3 4`)?
Purely syntactical, the translation I gave was literal: let f = infix + 5 is the same as let f = (5 +). But to avoid confusion it's also possible to disallow unary arguments and mandate at least two arguments.

On 19 February 2015 at 22:58, Nils Schweinsberg
I like the general idea to represent variable argument functions as infix function applications, but I wouldn't like a purely syntactical solution that adds no real new functionality
Well, it adds the functionality that it adds. Do notation, if/then/else, "where" syntax, bang patterns, etc. are "purely syntactical solutions that add no real new functionality" by this measure. Some of the best language features are made by a simple transformation.

You could always follow the lead of BangPatterns and reserve a character to make the syntax less ambiguous if you're using a function or macro. I think (`idiom f a b) would be much nicer than quasi quoters are currently (with the parentheses optional if the 'idiom' is being called on all the arguments to the end of line). I don't think there are any valid uses of back ticks when the token isn't immediately followed by another back tick. The only real issue is making sure they nest properly. Nils Schweinsberg-2 wrote
If so, I feel like this would break consistency with the current syntax since e.g. all these definitions of `f` would be valid but have completely different type/meaning (even though in "classical" Haskell they would be identical):
f x y = infix (+) 1 2 x y -- f :: Int -> Int -> Int f x = infix (+) 1 2 x -- f :: Int -> Int f = infix (+) 1 2 -- f :: Int
I like the general idea to represent variable argument functions as infix function applications, but I wouldn't like a purely syntactical solution that adds no real new functionality and is biased towards non-function values like strings, integeres, etc.
On Thu, Feb 19, 2015 at 7:11 PM, Christopher Done <
chrisdone@
> wrote:
On 19 February 2015 at 18:53, Nils Schweinsberg <
mail@
> wrote:
What would be the typing rules for this? What would be the types of e.g. pointfree written function definitions (`f` in `let f = infix + 5 in f 2 + f 2 3 4`)?
Purely syntactical, the translation I gave was literal: let f = infix + 5 is the same as let f = (5 +). But to avoid confusion it's also possible to disallow unary arguments and mandate at least two arguments.
_______________________________________________ Haskell-Cafe mailing list
Haskell-Cafe@
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
-- View this message in context: http://haskell.1045720.n5.nabble.com/Proposal-Infix-expression-keyword-XInfi... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

I feel the same about this as I do about idiom brackets. I think
QuasiQuotes need more love. They are a little heavier syntactically, but
are flexible enough to accomplish the same thing.
blah = [ infixQ | (+) foo bar baz quux ]
blarg = [ idiomQ | pureFunc fa fb fc ]
Perhaps the extension that we should be proposing is to make QuasiQuotes
syntactically lighter.
{-# LANGUAGE QQLite #-}
blah = infixQ (+) foo bar baz quux
blarg = idiomQ pureFunc fa fb fc
Obviously some thought needs to be put into multiline/precedence/etc; I
don't think all QuasiQuoters would be suitable for usage in this way, but
Chris's existing ideas for his proposal seems to apply just as well to this
one.
(Also a bikeshedding comment: I think the keyword "infix" is not adequately
descriptive for this particular proposal. I'd prefer "vararg" or something
of the sort.)
-- Dan Burton
On Thu, Feb 19, 2015 at 6:51 AM, Christopher Done
Ahoy,
The idiom discussion brought back to mind a general problem (well, for me) in Haskell syntax which is there is no syntactic sugar for interspersing operators to many arguments.
Regarding a solution for this, I wrote up a wee proposal here: https://gist.github.com/chrisdone/d9d33e4770a2fef19ad1
If I go ahead and implement this in GHC as -XInfixExpressions or something (better names welcome), would it be likely to be accepted? I could first do an implementation in haskell-src-exts to demonstrate the concept.
Ciao! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

On 19 February 2015 at 21:25, Dan Burton
I feel the same about this as I do about idiom brackets. I think QuasiQuotes need more love. They are a little heavier syntactically, but are flexible enough to accomplish the same thing.
Yeah, if quasi quotes were more like Lisp macros that'd make a bunch of these cases easier. It's a general complaint I have with TH, it makes simple rewrites like this too not-worth-it. If I had such macros I would've written an 'idiom' and 'infix' macro ages ago and wouldn't have had to ask for approval from anyone. But true macros seems much harder to slip by Haskellers. $(idiom [|f x y z|]) is too heavy, but idiom f x y z is too implicit.
participants (12)
-
adam vogt
-
Christopher Done
-
Clinton Mead
-
Dan Burton
-
Erik Hesselink
-
htebalaka
-
Joachim Breitner
-
Matthew Pickering
-
Nils Schweinsberg
-
Phil Ruffwind
-
Tom Ellis
-
Vo Minh Thu