Fixity
Christian Maeder
Christian.Maeder at dfki.de
Mon Feb 15 05:38:17 EST 2010
let me try again to fix the issue. Apologies, if you mind.
Christian Maeder schrieb:
> S. Doaitse Swierstra schrieb:
>> weird :: Int -> Int
>> weird = (if True then 3 else 5+)
>>
>> is perfectly correct Haskell?
>
> Yes, this is legal according to the grammar
> http://haskell.org/onlinereport/syntax-iso.html
> but rejected by ghc and hugs, because "5+" is illegal.
"5+" is illegal, but therefore neither ghc nor hugs only parse the "5"
and assume that the if-then-else-expression is finished after this "5"
and leave the "+" to form the section as ((if True then 3 else 5)+)
> The problem is to allow let-, if-, do-, and lambda-expressions
> to the left of operators (qop), because for those the meta rule
> "extend as far as possible" should apply.
Do- and case-expressions do not fall in the same class than let-, if-,
and lambda-expressions. An operator following let, if and lambda should
be impossible because such an operator should belong to the last
expression inside let, if and lambda.
But do- and case- expressions are terminated by a closing brace. The
point is, when this closing brace is inserted.
weird2 m = (do m >>)
Inserting "}" between "m" and ">>" because "m >>" is illegal, leads to
the same problem as above for if-then-else. "}" should be inserted
before the ")". hugs and ghc fail because they expect an fexp following
">>".
> Switching to the new grammar
> http://hackage.haskell.org/trac/haskell-prime/wiki/FixityResolution
>
> infixexp -> exp10 qop infixexp
> | - infixexp
> | exp10
>
> should be replaced by:
>
> infixexp -> fexp qop infixexp
> | exp10
>
> (omitting the negate rule)
>
> or shorter: "infixexp -> { fexp qop } exp10"
>
Assuming that braces are properly inserted, my above (too restrictive)
rule can be extended to include case- and do-expressions to "cdexp" (in
order to allow operators between them):
cdexp -> fexp
| - fexp (negation)
| do { stmts }
| case exp of { alts }
exp10 -> cdexp
| \ apat1 ... apatn -> exp (n>=1)
| let decls in exp
| if exp then exp else exp
infixexp -> cdexp qop infixexp
| exp10
(or: infixexp -> { cdexp qop } exp10")
> Left sections should look like:
>
> ( {fexp qop} fexp qop )
>
> It would be even possible to avoid parenthesis around sections, because
> a leading or trailing operator (or just a single operator) uniquely
> determines the kind of expression.
The need to put sections into parenthesis is one cause for the current
confusion. Inside the parenthesis the following expressions "iexp" are
expected:
iexp -> qop (operator turned to prefix-function)
| infixexp (parenthesized expression)
| infixexp :: [context =>] type (parenthesized typed expression)
| qop infixexp (right section)
| { cdexp qop } cdexp qop (left section)
So another solution would be, to make such expression globally legal in
the grammar and reject a single operator, left-, and right sections
during a separate infix analysis in a similar way as "a == b == c" is
first fully parsed but rejected later, because "==" is non-associative.
In fact any (non-empty) sequence of qop and exp10 expressions could be
made a legal expression (for the parser only) that is further subject to
infix resolution.
(This would for example also allow outfix operators via:
iexp -> qop { cdexp qop }
| ...
if desirable for haskell prime.)
Is this better now?
Cheers Christian
>
> Negation should be added independently to fexp (and possibly to exp10, too)
>
> fexp -> [fexp] aexp (function application)
> minusexp -> fexp | - fexp
>
> infixexp -> minusexp qop infixexp
> | exp10
> | - exp10
>
> (unless some wants the old FORTRAN behaviour of unary "-" to bind weaker
> than infix multiplication and exponentiation.)
>
> Cheers Christian
>
More information about the Haskell-prime
mailing list