diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2021-06-12 00:39:31 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-06-19 22:58:33 -0400 |
commit | 3f60a7e59dc5e067a3c764799478645dbc37700d (patch) | |
tree | 19b315b7f95dd99ac2b2f9b6313ee88c32085caa /compiler/GHC/Rename | |
parent | 8838241f7d672a58522b902c89c9149d6197bb72 (diff) | |
download | haskell-3f60a7e59dc5e067a3c764799478645dbc37700d.tar.gz |
Do not reassociate lexical negation (#19838)
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r-- | compiler/GHC/Rename/Expr.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Rename/HsType.hs | 18 |
2 files changed, 15 insertions, 8 deletions
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index a85103d8ed..d6805c2b05 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -294,7 +294,10 @@ rnExpr (OpApp _ e1 op e2) _ -> return (Fixity NoSourceText minPrecedence InfixL) -- c.f. lookupFixity for unbound - ; final_e <- mkOpAppRn e1' op' fixity e2' + ; lexical_negation <- xoptM LangExt.LexicalNegation + ; let negation_handling | lexical_negation = KeepNegationIntact + | otherwise = ReassociateNegation + ; final_e <- mkOpAppRn negation_handling e1' op' fixity e2' ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) } rnExpr (NegApp _ e _) diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index ea4ac365b1..d26a886d11 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -24,6 +24,7 @@ module GHC.Rename.HsType ( rnScaledLHsType, -- Precence related stuff + NegationHandling(..), mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn, checkPrecMatch, checkSectionPrec, @@ -1342,20 +1343,21 @@ mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 --------------------------- -mkOpAppRn :: LHsExpr GhcRn -- Left operand; already rearranged +mkOpAppRn :: NegationHandling + -> LHsExpr GhcRn -- Left operand; already rearranged -> LHsExpr GhcRn -> Fixity -- Operator and fixity -> LHsExpr GhcRn -- Right operand (not an OpApp, but might -- be a NegApp) -> RnM (HsExpr GhcRn) -- (e11 `op1` e12) `op2` e2 -mkOpAppRn e1@(L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2 +mkOpAppRn negation_handling e1@(L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2 | nofix_error = do precParseErr (get_op op1,fix1) (get_op op2,fix2) return (OpApp fix2 e1 op2 e2) | associate_right = do - new_e <- mkOpAppRn e12 op2 fix2 e2 + new_e <- mkOpAppRn negation_handling e12 op2 fix2 e2 return (OpApp fix1 e11 op1 (L loc' new_e)) where loc'= combineLocsA e12 e2 @@ -1363,13 +1365,13 @@ mkOpAppRn e1@(L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2 --------------------------- -- (- neg_arg) `op` e2 -mkOpAppRn e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2 +mkOpAppRn ReassociateNegation e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2 | nofix_error = do precParseErr (NegateOp,negateFixity) (get_op op2,fix2) return (OpApp fix2 e1 op2 e2) | associate_right - = do new_e <- mkOpAppRn neg_arg op2 fix2 e2 + = do new_e <- mkOpAppRn ReassociateNegation neg_arg op2 fix2 e2 return (NegApp noExtField (L loc' new_e) neg_name) where loc' = combineLocsA neg_arg e2 @@ -1377,7 +1379,7 @@ mkOpAppRn e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2 --------------------------- -- e1 `op` - neg_arg -mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp {})) -- NegApp can occur on the right +mkOpAppRn ReassociateNegation e1 op1 fix1 e2@(L _ (NegApp {})) -- NegApp can occur on the right | not associate_right -- We *want* right association = do precParseErr (get_op op1, fix1) (NegateOp, negateFixity) return (OpApp fix1 e1 op1 e2) @@ -1386,11 +1388,13 @@ mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp {})) -- NegApp can occur on the right --------------------------- -- Default case -mkOpAppRn e1 op fix e2 -- Default case, no rearrangment +mkOpAppRn _ e1 op fix e2 -- Default case, no rearrangment = assertPpr (right_op_ok fix (unLoc e2)) (ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2) $ return (OpApp fix e1 op e2) +data NegationHandling = ReassociateNegation | KeepNegationIntact + ---------------------------- -- | Name of an operator in an operator application or section |