diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2016-02-23 09:51:50 -0500 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2016-03-14 21:44:17 -0400 |
| commit | 972730cc42a419b8cd148abaa927e03415da3a68 (patch) | |
| tree | bcafe558128635cf05f679caf6270e9918dbe74d /compiler/deSugar/Coverage.hs | |
| parent | 35d37ff8a0bb9f64f347c8e4b6a24d49fd08c9dc (diff) | |
| download | haskell-972730cc42a419b8cd148abaa927e03415da3a68.tar.gz | |
Refactor visible type application.
This replaces the old HsType and HsTypeOut constructors
with HsAppType and HsAppTypeOut, leading to some simplification.
(This refactoring addresses #11329.)
This also fixes #11456, which stumbled over HsType (which is
not an expression).
test case: ghci/scripts/T11456
[skip ci]
Diffstat (limited to 'compiler/deSugar/Coverage.hs')
| -rw-r--r-- | compiler/deSugar/Coverage.hs | 23 |
1 files changed, 11 insertions, 12 deletions
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index 479d8cdfe5..c48df8ad4c 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -482,13 +482,15 @@ addTickLHsExprNever (L pos e0) = do -- general heuristic: expressions which do not denote values are good -- break points isGoodBreakExpr :: HsExpr Id -> Bool -isGoodBreakExpr (HsApp {}) = True -isGoodBreakExpr (OpApp {}) = True -isGoodBreakExpr _other = False +isGoodBreakExpr (HsApp {}) = True +isGoodBreakExpr (HsAppTypeOut {}) = True +isGoodBreakExpr (OpApp {}) = True +isGoodBreakExpr _other = False isCallSite :: HsExpr Id -> Bool -isCallSite HsApp{} = True -isCallSite OpApp{} = True +isCallSite HsApp{} = True +isCallSite HsAppTypeOut{} = True +isCallSite OpApp{} = True isCallSite _ = False addTickLHsExprOptAlt :: Bool -> LHsExpr Id -> TM (LHsExpr Id) @@ -518,13 +520,10 @@ 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) 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 (HsApp e1 e2) = liftM2 HsApp (addTickLHsExprNever e1) + (addTickLHsExpr e2) +addTickHsExpr (HsAppTypeOut e ty) = liftM2 HsAppTypeOut (addTickLHsExprNever e) + (return ty) addTickHsExpr (OpApp e1 e2 fix e3) = liftM4 OpApp |