diff options
author | Ben Gamari <bgamari.foss@gmail.com> | 2018-04-07 13:32:58 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-04-10 11:36:00 -0400 |
commit | c054162ae151ff82d43e504836784a7bc7827d9f (patch) | |
tree | 12624f0772507a0eb299fbbac6f0cd1893837d0c /compiler | |
parent | 2534164aefd346c7c51b70e8e8c49aa881dd9f85 (diff) | |
download | haskell-c054162ae151ff82d43e504836784a7bc7827d9f.tar.gz |
Revert "Fix #14838 by marking TH-spliced code as FromSource"
This reverts commit ffb2738f86c4e4c3f0eaacf0a95d7326fdd2e383.
Due to #14987.
Reviewers: goldfire, RyanGlScott
Reviewed By: RyanGlScott
Subscribers: RyanGlScott, thomie, carter
GHC Trac Issues: #14987, #14838
Differential Revision: https://phabricator.haskell.org/D4545
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/hsSyn/Convert.hs | 4 | ||||
-rw-r--r-- | compiler/hsSyn/HsUtils.hs | 14 | ||||
-rw-r--r-- | compiler/parser/RdrHsSyn.hs | 10 | ||||
-rw-r--r-- | compiler/typecheck/TcGenDeriv.hs | 8 |
4 files changed, 17 insertions, 19 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index f766074ef3..285d2e936e 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -145,7 +145,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 FromSource s' [cl'] } + ; returnJustL $ Hs.ValD $ mkFunBind s' [cl'] } | otherwise = do { pat' <- cvtPat pat @@ -164,7 +164,7 @@ cvtDec (TH.FunD nm cls) | otherwise = do { nm' <- vNameL nm ; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls - ; returnJustL $ Hs.ValD $ mkFunBind FromSource nm' cls' } + ; returnJustL $ Hs.ValD $ mkFunBind nm' cls' } cvtDec (TH.SigD nm typ) = do { nm' <- vNameL nm diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index aa40ad65fa..756cdbf423 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -782,14 +782,14 @@ l ************************************************************************ -} -mkFunBind :: Origin -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] +mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs -- Not infix, with place holders for coercion and free vars -mkFunBind origin fn ms = FunBind { fun_id = fn - , fun_matches = mkMatchGroup origin ms - , fun_co_fn = idHsWrapper - , bind_fvs = placeHolderNames - , fun_tick = [] } +mkFunBind fn ms = FunBind { fun_id = fn + , fun_matches = mkMatchGroup Generated ms + , fun_co_fn = idHsWrapper + , bind_fvs = placeHolderNames + , fun_tick = [] } mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn @@ -830,7 +830,7 @@ isInfixFunBind _ = False mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs mk_easy_FunBind loc fun pats expr - = L loc $ mkFunBind Generated (L loc fun) + = L loc $ mkFunBind (L loc fun) [mkMatch (mkPrefixFunRhs (L loc fun)) pats expr (noLoc emptyLocalBinds)] diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 68d152e62e..a976d08558 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -422,7 +422,7 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1), = let doc_decls' = doc_decl : doc_decls in go mtchs (combineSrcSpans loc loc2) binds doc_decls' go mtchs loc binds doc_decls - = ( L loc (makeFunBind FromSource fun_id1 (reverse mtchs)) + = ( L loc (makeFunBind fun_id1 (reverse mtchs)) , (reverse doc_decls) ++ binds) -- Reverse the final matches, to get it back in the right order -- Do the same thing with the trailing doc comments @@ -1077,7 +1077,7 @@ checkFunBind msg strictness ann lhs_loc fun is_infix pats (L rhs_span grhss) let match_span = combineSrcSpans lhs_loc rhs_span -- Add back the annotations stripped from any HsPar values in the lhs -- mapM_ (\a -> a match_span) ann - return (ann, makeFunBind FromSource fun + return (ann, makeFunBind fun [L match_span (Match { m_ctxt = FunRhs { mc_fun = fun , mc_fixity = is_infix , mc_strictness = strictness } @@ -1086,12 +1086,12 @@ checkFunBind msg strictness ann lhs_loc fun is_infix pats (L rhs_span grhss) -- The span of the match covers the entire equation. -- That isn't quite right, but it'll do for now. -makeFunBind :: Origin -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] +makeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too -makeFunBind origin fn ms +makeFunBind fn ms = FunBind { fun_id = fn, - fun_matches = mkMatchGroup origin ms, + fun_matches = mkMatchGroup FromSource ms, fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames, fun_tick = [] } diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 383b580aa5..57549c67ef 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1862,7 +1862,7 @@ mkFunBindSE arity loc fun pats_and_exprs mkRdrFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs mkRdrFunBind fun@(L loc _fun_rdr) matches - = L loc (mkFunBind Generated fun matches) + = L loc (mkFunBind fun matches) -- | Make a function binding. If no equations are given, produce a function -- with the given arity that uses an empty case expression for the last @@ -1890,8 +1890,7 @@ mkRdrFunBindEC :: Arity -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs mkRdrFunBindEC arity catch_all - fun@(L loc _fun_rdr) matches - = L loc (mkFunBind Generated fun matches') + fun@(L loc _fun_rdr) matches = L loc (mkFunBind fun matches') where -- Catch-all eqn looks like -- fmap _ z = case z of {} @@ -1915,8 +1914,7 @@ mkRdrFunBindEC arity catch_all mkRdrFunBindSE :: Arity -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs mkRdrFunBindSE arity - fun@(L loc fun_rdr) matches - = L loc (mkFunBind Generated fun matches') + fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches') where -- Catch-all eqn looks like -- compare _ _ = error "Void compare" |