prefix minus and infix resolution
Christian Maeder
Christian.Maeder at dfki.de
Tue Jul 13 09:18:56 EDT 2010
Simon Marlow schrieb:
> BTW, here's a related proposal made by Simon PJ earlier this year:
>
> http://hackage.haskell.org/trac/haskell-prime/wiki/NegationBindsTightly
>
> please consider merging the proposals, or at least clearly identifying
> the differences, if any.
Thanks for pointing this out.
The difference lies in:
- 1 ^ 2
which is currently (and by my proposal) resolved to "- (1 ^ 2)" whereas
it would be resolved to "(-1) ^ 2" if negation binds tightly.
Christian
>
> Cheers,
> Simon
>
> On 12/07/2010 08:40, Christian Maeder wrote:
>> Hi Simon and other fixity resolution friends,
>>
>> Fixity resolution starts from a sequence of expressions (lexp)
>> interspersed by operator symbols, where some expressions may be preceded
>> by unary minus signs.
>>
>> Between an operator and a following unary minus sign must be white space
>> for the haskell lexer (as in "x == -1").
>>
>> A binary minus is recognized (by the lexer), because it _follows_ an
>> expression (lexp) unlike an unary minus (that precedes).
>>
>> Conceptually fixity resolution can be divided into two steps:
>>
>> 1. resolve prefix applications of unary minus
>> 2. resolve infix applications
>>
>> There's no doubt how to resolve mere infix applications using
>> precedences and associativity (2. step):
>>
>> A term
>> a `o` b `p` c
>> is uniquely resolve as:
>> 2.a) (a `o` b) `p` c
>> if prec(o)> prec(p)
>> or prec(o) = prec(p) and both operator are left associative
>> 2.b) a `o` (b `p` c)
>> if prec(p)> prec(o)
>> or prec(o) = prec(p) and both operator are right associative
>> 2.c) unresolved otherwise
>>
>> The prefix applications of unary minus is a bit unusual (compared to
>> other prefix applications) in that it binds weaker than multiplication:
>>
>> "- 1 * 2" is to be resolved as "- (1 * 2)"
>>
>> This weak binding is irrelevant for multiplication but essential for
>> exponentiation, ie. "-x^2", and can make a difference for user defined
>> infix operators, that bind strongest by default!
>>
>> Resolution of prefix "-" (1. step) works as follows:
>>
>> Unary minus applications extend as far to the right as _infix_ operators
>> (no unary minus) have higher precedence than "+" or "-".
>>
>> A term like
>> "- a * b ^ c< - d ^ e * f"
>> is resolved as
>> "- (a * b ^ c)< - (d ^ e * f)"
>> or with more parens as
>> "(- (a * b ^ c))< (- (d ^ e * f))"
>> which further resolves by infix resolution (2. step) to
>> "(- (a * (b ^ c)))< (- ((d ^ e) * f))"
>>
>> In fact, this should finish fixity resolution, but the current haskell
>> state unnecessarily restricts resolution further:
>>
>> 3.a) "a * - b" is rejected, because "*" binds stronger than "-"
>> 3.b) "a + - b" is rejected, because "+" and "-" are not both right
>> associative
>>
>> although both terms can be uniquely resolved to "a * (- b)" "a + (- b)".
>>
>> In other words, the operator to the left of an unary minus can be
>> completely ignored for prefix minus resolution, simply because prefix
>> minus does not have a left argument (like the binary minus)!
>>
>> Without this restriction polynomials like
>> "- a + - b * x + - c * - x ^ 2"
>> would uniquely resolve to
>> "((- a) + (- (b * x))) + (- (c * (- (x ^ 2))))"
>>
>> I think hugs handles this correctly!
>>
>> Let us assume a user-defined (non- or) right-associative operator "#"
>> with the same precedence as "+" and "-" (infix[r] 6 #).
>>
>> 3.c) both "- a # b" and "a # - b" are rejected,
>> because "#" is not left-associative (like "-").
>>
>> This unnecessary restriction rules out a (user-defined) polynomial like
>> "- a # - b * x"
>> for two reason (namely the two unary minus signs).
>>
>> Because an operator like "#" is not predefined, this restriction does
>> not hurt as much as it does for "+" (and binary "-").
>>
>> The unrestricted fixity resolution (1. and 2. step only, without
>> restrictions 3.) can be further extended to allow multiple unary minus
>> prefix applications.
>>
>> infixexp -> {-} lexp { op {-} lexp }
>>
>> White space is needed between "-" signs for lexing.
>> Extended cases of 3.a) and 3.b) would be legal:
>> "a * - - b" resolves uniquely to "a * (- (- b))"
>> "a + - - b" resolves uniquely to "a + (- (- b))"
>>
>> It is, however, worth to remark that two consecutive unary "-" sign
>> cannot be simply omitted:
>> "a * - - b * c" resolves to "a * (- (- (b * c)))"
>> whereas "a * b * c" resolves to "(a * b) * c"
>>
>> Even if double negation is the identity the grouping of factors has
>> changed.
>>
>> An (alternative) implementation of the unrestricted fixity resolution
>> can be found at:
>> http://hackage.haskell.org/trac/ghc/ticket/4180
>>
>> In comparison to the current restricted version the guard that checks
>> the left operator before the unary minus can be omitted. Also giving the
>> unary minus the same precedence and associativity than the binary minus
>> makes the algorithm more restrictive. The unary minus needs a higher
>> precedence than the binary "-" and a lower one than "*" or "/":
>>
>> Using http://darcs.haskell.org/haskell-prime it is enough to change:
>>
>> -type Prec = Int
>> +type Prec = Float
>>
>> - = do guard (prec1< 6)
>> - (r, rest')<- parseNeg (Op "-" 6 Leftfix) rest
>> + = do
>> + (r, rest')<- parseNeg (Op "-" 6.5 Leftfix) rest
>>
>> Cheers Christian
>>
>> Relevant literature is:
>>
>> @Article{Aasa95,
>> author = "Annika Aasa",
>> title = "Precedences in Specifications and Implementations of
>> Programming Languages",
>> journal = "Theoret.\ Comput.\ Sci.",
>> year = "1995",
>> volume = "142",
>> pages = "3--26",
>> }
>>
>
More information about the Haskell-prime
mailing list