-\subsubsection{Precedence Parsing}
-%* *
-%************************************************************************
-
-@mkOpAppRn@ deals with operator fixities. The argument expressions
-are assumed to be already correctly arranged. It needs the fixities
-recorded in the OpApp nodes, because fixity info applies to the things
-the programmer actually wrote, so you can't find it out from the Name.
-
-Furthermore, the second argument is guaranteed not to be another
-operator application. Why? Because the parser parses all
-operator appications left-associatively, EXCEPT negation, which
-we need to handle specially.
-
-\begin{code}
-mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
- -> RenamedHsExpr -> Fixity -- Operator and fixity
- -> RenamedHsExpr -- Right operand (not an OpApp, but might
- -- be a NegApp)
- -> RnM RenamedHsExpr
-
----------------------------
--- (e11 `op1` e12) `op2` e2
-mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
- | nofix_error
- = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
- returnM (OpApp e1 op2 fix2 e2)
-
- | associate_right
- = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
- returnM (OpApp e11 op1 fix1 new_e)
- where
- (nofix_error, associate_right) = compareFixity fix1 fix2
-
----------------------------
--- (- neg_arg) `op` e2
-mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
- | nofix_error
- = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
- returnM (OpApp e1 op2 fix2 e2)
-
- | associate_right
- = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
- returnM (NegApp new_e neg_name)
- where
- (nofix_error, associate_right) = compareFixity negateFixity fix2
-
----------------------------
--- e1 `op` - neg_arg
-mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _) -- NegApp can occur on the right
- | not associate_right -- We *want* right association
- = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
- returnM (OpApp e1 op1 fix1 e2)
- where
- (_, associate_right) = compareFixity fix1 negateFixity
-
----------------------------
--- Default case
-mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
- = ASSERT2( right_op_ok fix e2,
- ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
- )
- returnM (OpApp e1 op fix e2)
-
--- Parser left-associates everything, but
--- derived instances may have correctly-associated things to
--- in the right operarand. So we just check that the right operand is OK
-right_op_ok fix1 (OpApp _ _ fix2 _)
- = not error_please && associate_right
- where
- (error_please, associate_right) = compareFixity fix1 fix2
-right_op_ok fix1 other
- = True
-
--- Parser initially makes negation bind more tightly than any other operator
-mkNegAppRn neg_arg neg_name
- =
-#ifdef DEBUG
- getModeRn `thenM` \ mode ->
- ASSERT( not_op_app mode neg_arg )
-#endif
- returnM (NegApp neg_arg neg_name)
-
-not_op_app SourceMode (OpApp _ _ _ _) = False
-not_op_app mode other = True
-\end{code}
-
-\begin{code}
-checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnM ()
-
-checkPrecMatch False fn match
- = returnM ()
-
-checkPrecMatch True op (Match (p1:p2:_) _ _)
- -- True indicates an infix lhs
- = getModeRn `thenM` \ mode ->
- -- See comments with rnExpr (OpApp ...)
- if isInterfaceMode mode
- then returnM ()
- else checkPrec op p1 False `thenM_`
- checkPrec op p2 True
-
-checkPrecMatch True op _ = panic "checkPrecMatch"
-
-checkPrec op (ConPatIn op1 (InfixCon _ _)) right
- = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
- lookupFixityRn op1 `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
- let
- inf_ok = op1_prec > op_prec ||
- (op1_prec == op_prec &&
- (op1_dir == InfixR && op_dir == InfixR && right ||
- op1_dir == InfixL && op_dir == InfixL && not right))
-
- info = (ppr_op op, op_fix)
- info1 = (ppr_op op1, op1_fix)
- (infol, infor) = if right then (info, info1) else (info1, info)
- in
- checkErr inf_ok (precParseErr infol infor)
-
-checkPrec op pat right
- = returnM ()
-
--- Check precedence of (arg op) or (op arg) respectively
--- If arg is itself an operator application, then either
--- (a) its precedence must be higher than that of op
--- (b) its precedency & associativity must be the same as that of op
-checkSectionPrec direction section op arg
- = case arg of
- OpApp _ op fix _ -> go_for_it (ppr_op op) fix
- NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
- other -> returnM ()
- where
- HsVar op_name = op
- go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
- = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
- checkErr (op_prec < arg_prec
- || op_prec == arg_prec && direction == assoc)
- (sectionPrecErr (ppr_op op_name, op_fix)
- (pp_arg_op, arg_fix) section)
-\end{code}
-
-
-%************************************************************************
-%* *