diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-03-02 16:16:17 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-03-02 16:53:40 -0500 |
| commit | ffb2738f86c4e4c3f0eaacf0a95d7326fdd2e383 (patch) | |
| tree | a43cb2b490dbaa14ed4ebc0211490050cbd4cc4e /compiler/hsSyn | |
| parent | 68357020b1cf29d4306e769b3366feb9a65ae78c (diff) | |
| download | haskell-ffb2738f86c4e4c3f0eaacf0a95d7326fdd2e383.tar.gz | |
Fix #14838 by marking TH-spliced code as FromSource
Previously, any Template Haskell code that was spliced would
be marked as `Generated`, which would completely suppress pattern-
match coverage warnings for it, which several folks found confusing.
Indeed, Template Haskell-spliced code is "source" code in some sense,
as users specifically request that it be put into their program, so
changing its designation to `FromSource` makes sense from that
perspective.
Test Plan: make test TEST=T14838
Reviewers: goldfire, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14838
Differential Revision: https://phabricator.haskell.org/D4440
Diffstat (limited to 'compiler/hsSyn')
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 4 | ||||
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 14 |
2 files changed, 9 insertions, 9 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index c1cf77b39c..531f146a9d 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -144,7 +144,7 @@ cvtDec (TH.ValD pat body ds) | TH.VarP s <- pat = do { s' <- vNameL s ; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds) - ; returnJustL $ Hs.ValD $ mkFunBind s' [cl'] } + ; returnJustL $ Hs.ValD $ mkFunBind FromSource s' [cl'] } | otherwise = do { pat' <- cvtPat pat @@ -163,7 +163,7 @@ cvtDec (TH.FunD nm cls) | otherwise = do { nm' <- vNameL nm ; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls - ; returnJustL $ Hs.ValD $ mkFunBind nm' cls' } + ; returnJustL $ Hs.ValD $ mkFunBind FromSource nm' cls' } cvtDec (TH.SigD nm typ) = do { nm' <- vNameL nm diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 2937c1a657..55fa0e4a0a 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -768,14 +768,14 @@ l ************************************************************************ -} -mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] +mkFunBind :: Origin -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs -- Not infix, with place holders for coercion and free vars -mkFunBind fn ms = FunBind { fun_id = fn - , fun_matches = mkMatchGroup Generated ms - , fun_co_fn = idHsWrapper - , bind_fvs = placeHolderNames - , fun_tick = [] } +mkFunBind origin fn ms = FunBind { fun_id = fn + , fun_matches = mkMatchGroup origin ms + , fun_co_fn = idHsWrapper + , bind_fvs = placeHolderNames + , fun_tick = [] } mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn @@ -816,7 +816,7 @@ isInfixFunBind _ = False mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs mk_easy_FunBind loc fun pats expr - = L loc $ mkFunBind (L loc fun) + = L loc $ mkFunBind Generated (L loc fun) [mkMatch (mkPrefixFunRhs (L loc fun)) pats expr (noLoc emptyLocalBinds)] |