
It occurred to me the other day that Haskell (w/ bang patterns) now has 3 prefix operators, all of which are defined independently and follow their own special rules for parsing. we have (-), (!) and (~). It would seem to me that we should somehow be able to unify the mechanism behind parsing these, as in practice, it seems that prefix operators are useful in haskell. We have some similarities, - and ! are both infix and prefix operators, ~ is not. ! and ~ can only be in patterns as prefix, (-) can be in both patterns and expressions. But it seems like we may be able to come up with a common way of parsing them all, prolog has had user defined infix, prefix, and postfix operators (sharing the same name even) and is still able to parse things properly so I don't think there will be a technical issue. My first impulse is to treat application as just another binary operator with a certain precedence and find appropriate precedences for !,~,- in the new framework. note: I am not proposing user defined prefix operators, just musing about whether we can unify the rules behind parsing the current three prefix operators, perhaps folding them into the fixity resolution algorithm. John -- John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/

Yes, I somewhat hacked up the rules for ! in an ad-hoc way. I really wanted to allow f !x !y = (x,y) which meant a bit of fiddling, because LHSs are parsed as terms, so this is parsed as (f ! x) ! y (ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing. Simon | -----Original Message----- | From: haskell-prime-bounces@haskell.org [mailto:haskell-prime- | bounces@haskell.org] On Behalf Of John Meacham | Sent: 08 July 2010 00:59 | To: haskell-prime@haskell.org | Subject: prefix operators | | It occurred to me the other day that Haskell (w/ bang patterns) now has | 3 prefix operators, all of which are defined independently and follow | their own special rules for parsing. we have (-), (!) and (~). | | It would seem to me that we should somehow be able to unify the | mechanism behind parsing these, as in practice, it seems that prefix | operators are useful in haskell. | | We have some similarities, - and ! are both infix and prefix operators, | ~ is not. ! and ~ can only be in patterns as prefix, (-) can be in both | patterns and expressions. | | But it seems like we may be able to come up with a common way of parsing | them all, prolog has had user defined infix, prefix, and postfix | operators (sharing the same name even) and is still able to parse things | properly so I don't think there will be a technical issue. | | My first impulse is to treat application as just another binary operator | with a certain precedence and find appropriate precedences for !,~,- in | the new framework. | | note: I am not proposing user defined prefix operators, just musing | about whether we can unify the rules behind parsing the current three | prefix operators, perhaps folding them into the fixity resolution | algorithm. | | John | | -- | John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/ | _______________________________________________ | Haskell-prime mailing list | Haskell-prime@haskell.org | http://www.haskell.org/mailman/listinfo/haskell-prime

For expressions operator sections will also be difficult to deal with, i.e. the expression (!x) could either be a parenthesized prefix !, or a section for binary !. Some disambiguation mechanism would be required. Currently such disambiguation is hardcoded for - as a special case in the grammar. Atze On 8 Jul, 2010, at 09:09 , Simon Peyton-Jones wrote:
Yes, I somewhat hacked up the rules for ! in an ad-hoc way. I really wanted to allow
f !x !y = (x,y)
which meant a bit of fiddling, because LHSs are parsed as terms, so this is parsed as
(f ! x) ! y
(ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing.
Simon
| -----Original Message----- | From: haskell-prime-bounces@haskell.org [mailto:haskell-prime- | bounces@haskell.org] On Behalf Of John Meacham | Sent: 08 July 2010 00:59 | To: haskell-prime@haskell.org | Subject: prefix operators | | It occurred to me the other day that Haskell (w/ bang patterns) now has | 3 prefix operators, all of which are defined independently and follow | their own special rules for parsing. we have (-), (!) and (~). | | It would seem to me that we should somehow be able to unify the | mechanism behind parsing these, as in practice, it seems that prefix | operators are useful in haskell. | | We have some similarities, - and ! are both infix and prefix operators, | ~ is not. ! and ~ can only be in patterns as prefix, (-) can be in both | patterns and expressions. | | But it seems like we may be able to come up with a common way of parsing | them all, prolog has had user defined infix, prefix, and postfix | operators (sharing the same name even) and is still able to parse things | properly so I don't think there will be a technical issue. | | My first impulse is to treat application as just another binary operator | with a certain precedence and find appropriate precedences for !,~,- in | the new framework. | | note: I am not proposing user defined prefix operators, just musing | about whether we can unify the rules behind parsing the current three | prefix operators, perhaps folding them into the fixity resolution | algorithm. | | John | | -- | John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/ | _______________________________________________ | Haskell-prime mailing list | Haskell-prime@haskell.org | http://www.haskell.org/mailman/listinfo/haskell-prime
_______________________________________________ Haskell-prime mailing list Haskell-prime@haskell.org http://www.haskell.org/mailman/listinfo/haskell-prime
- Atze - Atze Dijkstra, Department of Information and Computing Sciences. /|\ Utrecht University, PO Box 80089, 3508 TB Utrecht, Netherlands. / | \ Tel.: +31-30-2534118/1454 | WWW : http://www.cs.uu.nl/~atze . /--| \ Fax : +31-30-2513971 .... | Email: atze@cs.uu.nl ............ / |___\

On Thu, Jul 08, 2010 at 07:09:29AM +0000, Simon Peyton-Jones wrote:
(ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing.
So, after thinking about it some, I think there may be a somewhat elegant solution. The other day I found myself writing a prolog parser in haskell, an interesting thing about prolog is that it is a pure operator precedence grammar[1]. Meaning that the entire grammar can be defined by a list of symbols, their fixities and their priorities. An example of a definition for a prolog-like language is http://www.mercury.csse.unimelb.edu.au/information/doc-release/mercury_ref/B... Now, a really nice thing about operator precedence grammars is that they admit a very simple linear parsing algorithm[2] and they are quite simple to understand. So, Why not utilize the nice properties of this style of grammar when defining haskell, we already attempt to interpret infix operators in the grammar BNF proper, but then go and refix them anyway in the fixity fixups pass, probably with something very similar to an operator precedence parser. so the idea is basically to get rid of the initial dummy parsing of expressions altogether and parse expressions as a pure operator precedence grammar in the fixups pass. This will allow seamless handling of prefix operators and likely simplify the formal description of the language to boot. So, for the most part the grammar will look like it does now, except when we get to expressions, patterns, and types, we just parse them uniformly as a sequence of atomic nodes. These may be variables, but also may be things like infix operators, or even an entire parenthesized term or case expression. These can be recursive, a parenthesized expression will itself contain a list of nodes. Now, we can simply define the fixity resolution pass as applying the appropriate operator precedence grammar to each list of nodes, producing expressions, types, or patterns. The really nice thing is that we are under no obligation to use the same operator precedence grammar for each context, we can always tell from the parsing context whether we are parsing a type, expression, or pattern, so we just use the appropriate grammar, for instance, we will augment the grammar with the prefix '~' in patterns, and the prefix '!' (for strictness) in types. '!' can be defined as prefix in patterns and infix in expressions simply by using a slightly different precedence table when interpreting them. This also makes very clear how user defined fixities are used, they are simply appended to the precedence table in this pass. Turning on and off bang patterns with a switch is also extremely easy, just omit that prefix operator from the table when they are switched off. no need to mess with the lexer or the parser. I also suspect we can produce much better error messages with this strategy. John [1] http://en.wikipedia.org/wiki/Operator-precedence_parser [2] http://www.engr.mun.ca/~theo/Misc/exp_parsing.htm -- John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/

On 08/07/2010 09:45, John Meacham wrote:
On Thu, Jul 08, 2010 at 07:09:29AM +0000, Simon Peyton-Jones wrote:
(ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing.
So, after thinking about it some, I think there may be a somewhat elegant solution.
I like the sound of it. I put the code for the Haskell 2010 fixity resolver together with a little testing framework in the haskell-prime repo: http://darcs.haskell.org/haskell-prime in the subdirectory "fixity". Cheers, Simon

On Fri, Jul 09, 2010 at 09:33:52AM +0100, Simon Marlow wrote:
On 08/07/2010 09:45, John Meacham wrote:
On Thu, Jul 08, 2010 at 07:09:29AM +0000, Simon Peyton-Jones wrote:
(ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing.
So, after thinking about it some, I think there may be a somewhat elegant solution.
I like the sound of it. I put the code for the Haskell 2010 fixity resolver together with a little testing framework in the haskell-prime repo:
There is also my one-pass layout algorithm that requires no interaction with the parser that I believe still has promise. It was able to properly layout all the wild code I threw at it (all of nofib). With the addition of that, we may achieve the holy grail of fully independent lexing,layout,parsing,and fixing of haskell code, and a specification that has a direct correspondence to an implementable algorithm! I actually just noticed that my layout code is now implemented in ghc: http://hackage.haskell.org/trac/haskell-prime/wiki/AlternativeLayoutRule I am curious what the results will be, I know that adding pattern guards to it would be complicated, I will have to check out how my algorithm was modified. John -- John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/

On 10/07/2010 22:02, John Meacham wrote:
On Fri, Jul 09, 2010 at 09:33:52AM +0100, Simon Marlow wrote:
On 08/07/2010 09:45, John Meacham wrote:
On Thu, Jul 08, 2010 at 07:09:29AM +0000, Simon Peyton-Jones wrote:
(ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing.
So, after thinking about it some, I think there may be a somewhat elegant solution.
I like the sound of it. I put the code for the Haskell 2010 fixity resolver together with a little testing framework in the haskell-prime repo:
There is also my one-pass layout algorithm that requires no interaction with the parser that I believe still has promise. It was able to properly layout all the wild code I threw at it (all of nofib). With the addition of that, we may achieve the holy grail of fully independent lexing,layout,parsing,and fixing of haskell code, and a specification that has a direct correspondence to an implementable algorithm!
I actually just noticed that my layout code is now implemented in ghc: http://hackage.haskell.org/trac/haskell-prime/wiki/AlternativeLayoutRule I am curious what the results will be, I know that adding pattern guards to it would be complicated, I will have to check out how my algorithm was modified.
Yes, Ian Lynagh implemented your algorithm in GHC (with several tweaks to implement some of the darker corner cases, I believe). There's also -XAlternativeLayoutRuleTransitional but I'm not sure what that does. There are cases that you can't reasonably handle this way, e.g. g = (let x, y :: Int; (x,y) = (1,2) in x, 3) f xs = [ do x | x <- xs ] My feeling is that if we were to do layout this way it would have to be a simplified version of the current algorithm, so that it is easy to explain both to users and in the report. Perhaps restricting the tokens that can prematurely end a layout context to just the important ones, like ) ] } 'in'. Cheers, Simon

On Tue, Jul 13, 2010 at 01:52:36PM +0100, Simon Marlow wrote:
Yes, Ian Lynagh implemented your algorithm in GHC (with several tweaks to implement some of the darker corner cases, I believe). There's also -XAlternativeLayoutRuleTransitional but I'm not sure what that does.
It adds a couple of rules to accept (but whine about) the two most common problems with the alternative layout rule: `where' clause at the same depth as implicit layout block `|' at the same depth as implicit layout block
There are cases that you can't reasonably handle this way, e.g.
g = (let x, y :: Int; (x,y) = (1,2) in x, 3) f xs = [ do x | x <- xs ]
My feeling is that if we were to do layout this way it would have to be a simplified version of the current algorithm, so that it is easy to explain both to users and in the report. Perhaps restricting the tokens that can prematurely end a layout context to just the important ones, like ) ] } 'in'.
I think I agree that a simpler rule, but more breakage of existing code, would be better. I don't expect I'll have time to do the necessary experimentation etc in the H2011 timeframe. Thanks Ian

Simon Peyton-Jones schrieb:
Yes, I somewhat hacked up the rules for ! in an ad-hoc way. I really wanted to allow
f !x !y = (x,y)
which meant a bit of fiddling, because LHSs are parsed as terms, so this is parsed as
(f ! x) ! y
(ie as infix operators) and I have to squizzle around to re-interpret them as prefix operators. Not very cool. Something unified would be a Good Thing.
I assume f -x -y = ... is also parsed as (f - x) - y and later rejected as "Parse error in pattern". The (possibly) indented interpretation "f (-x) (-y)" or "f (!x) (!y)" simply contradicts the interpretation as terms with binary operators. With bang patterns the binary operator "!" can no longer be defined as: f !x = http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/bang-patterns.html#b... This case is not mention under http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/syntax-extns.html#sy... One could consider whitespace (which already happens with "$" in template haskell), but that's questionable, too. Since we make a new language spec knowing many extensions, it would be possible to disallow more bits in the standard in order to avoid stolen syntax by extensions. But disallowing infix pattern using "!" is non-orthogonal and making "!" a reserved op like "~" would break some libraries. Should "rec" become a reserved keyword, because I had to rename it when switching on extensions? I would not mind if "forall" (and "exist") became a keyword (although not required, since forall can only occur within types). Should "$" be followed by whitespace (or forbidden), just to allow compilation using template haskell, too? I don't know the impact of -XMagicHash on infix stuff using # or ##. I think, it's unfortunate that the (scanner and) parser depends on extensions. It would be better to parse a language superset and let static analysis deal with (known) extensions. Christian
Simon
| -----Original Message----- | From: haskell-prime-bounces@haskell.org [mailto:haskell-prime- | bounces@haskell.org] On Behalf Of John Meacham | Sent: 08 July 2010 00:59 | To: haskell-prime@haskell.org | Subject: prefix operators | | It occurred to me the other day that Haskell (w/ bang patterns) now has | 3 prefix operators, all of which are defined independently and follow | their own special rules for parsing. we have (-), (!) and (~). | | It would seem to me that we should somehow be able to unify the | mechanism behind parsing these, as in practice, it seems that prefix | operators are useful in haskell. | | We have some similarities, - and ! are both infix and prefix operators, | ~ is not. ! and ~ can only be in patterns as prefix, (-) can be in both | patterns and expressions. | | But it seems like we may be able to come up with a common way of parsing | them all, prolog has had user defined infix, prefix, and postfix | operators (sharing the same name even) and is still able to parse things | properly so I don't think there will be a technical issue. | | My first impulse is to treat application as just another binary operator | with a certain precedence and find appropriate precedences for !,~,- in | the new framework. | | note: I am not proposing user defined prefix operators, just musing | about whether we can unify the rules behind parsing the current three | prefix operators, perhaps folding them into the fixity resolution | algorithm. | | John | | -- | John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/ | _______________________________________________ | Haskell-prime mailing list | Haskell-prime@haskell.org | http://www.haskell.org/mailman/listinfo/haskell-prime
------------------------------------------------------------------------
_______________________________________________ Haskell-prime mailing list Haskell-prime-HC+Z4NTRIlBAfugRpC6u6w@public.gmane.org http://www.haskell.org/mailman/listinfo/haskell-prime
participants (6)
-
Atze Dijkstra
-
Christian Maeder
-
Ian Lynagh
-
John Meacham
-
Simon Marlow
-
Simon Peyton-Jones