diff options
| author | Reid Barton <rwbarton@gmail.com> | 2016-01-23 15:30:04 -0500 |
|---|---|---|
| committer | Reid Barton <rwbarton@gmail.com> | 2016-01-23 15:30:04 -0500 |
| commit | ec8778862aeb9c3f6b861bc732045db9f58b9b61 (patch) | |
| tree | f579909150a4df68a6a52ffb37e9c7ca5bed28c6 | |
| parent | b5e52bfc9e331a9ed2b3a30b790cfa331935aebe (diff) | |
| download | haskell-ec8778862aeb9c3f6b861bc732045db9f58b9b61.tar.gz | |
Don't add ticks around type applications (#11329)
Test Plan: validate --slow
Reviewers: austin, bgamari, goldfire
Reviewed By: goldfire
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1824
| -rw-r--r-- | compiler/deSugar/Coverage.hs | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index ae8b6ab86d..b7a578f533 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -515,7 +515,9 @@ addBinTickLHsExpr boxLabel (L pos e0) -- ----------------------------------------------------------------------------- --- Decoarate an HsExpr with ticks +-- Decorate the body of an HsExpr with ticks. +-- (Whether to put a tick around the whole expression was already decided, +-- in the addTickLHsExpr family of functions.) addTickHsExpr :: HsExpr Id -> TM (HsExpr Id) addTickHsExpr e@(HsVar (L _ id)) = do freeVar id; return e @@ -526,7 +528,13 @@ addTickHsExpr e@(HsOverLabel _) = return e addTickHsExpr e@(HsLit _) = return e addTickHsExpr (HsLam matchgroup) = liftM HsLam (addTickMatchGroup True matchgroup) addTickHsExpr (HsLamCase ty mgs) = liftM (HsLamCase ty) (addTickMatchGroup True mgs) -addTickHsExpr (HsApp e1 e2) = liftM2 HsApp (addTickLHsExprNever e1) (addTickLHsExpr e2) +addTickHsExpr (HsApp e1 e2) = liftM2 HsApp (addTickLHsExprNever e1) e2' + -- This might be a type application. Then don't put a tick around e2, + -- or dsExpr won't recognize it as a type application any more (#11329). + -- It doesn't make sense to put a tick on a type anyways. + where e2' + | isLHsTypeExpr e2 = return e2 + | otherwise = addTickLHsExpr e2 addTickHsExpr (OpApp e1 e2 fix e3) = liftM4 OpApp @@ -658,8 +666,6 @@ addTickHsExpr (ExprWithTySigOut e ty) = (addTickLHsExprNever e) -- No need to tick the inner expression (return ty) -- for expressions with signatures -addTickHsExpr e@(HsTypeOut _) = return e - -- Others should never happen in expression content. addTickHsExpr e = pprPanic "addTickHsExpr" (ppr e) |