diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2016-05-25 00:09:34 +0200 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2016-06-06 20:04:43 +0200 |
| commit | 306ecad591951521ac3f5888ca8be85bf749d271 (patch) | |
| tree | 1f6d154698f022b76042b1b796ca0ed959a2b201 /compiler/rename | |
| parent | 1937ef1c506b538f0f93cd290fa4a42fc85ab769 (diff) | |
| download | haskell-wip/T12105.tar.gz | |
Merge MatchFixity and HsMatchContextwip/T12105
Summary:
MatchFixity was introduced to facilitate use of API Annotations.
HsMatchContext does the same thing with more detail, but is chased
through all over the place to provide context when processing a Match.
Since we already have MatchFixity in the Match, it may as well provide
the full context.
updates submodule haddock
Test Plan: ./validate
Reviewers: austin, goldfire, bgamari
Subscribers: thomie, mpickering
Differential Revision: https://phabricator.haskell.org/D2271
GHC Trac Issues: #12105
Diffstat (limited to 'compiler/rename')
| -rw-r--r-- | compiler/rename/RnBinds.hs | 27 |
1 files changed, 14 insertions, 13 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 61f4dd8a3e..0466de375e 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -467,7 +467,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ -- bindSigTyVars tests for LangExt.ScopedTyVars - rnMatchGroup (FunRhs plain_name) + rnMatchGroup (FunRhs name Prefix) rnLExpr matches ; let is_infix = isInfixFunBind bind ; when is_infix $ checkPrecMatch plain_name matches' @@ -612,7 +612,7 @@ dupFixityDecl loc rdr_name rnPatSynBind :: (Name -> [Name]) -- Signature tyvar function -> PatSynBind Name RdrName -> RnM (PatSynBind Name Name, [Name], Uses) -rnPatSynBind sig_fn bind@(PSB { psb_id = L _ name +rnPatSynBind sig_fn bind@(PSB { psb_id = L l name , psb_args = details , psb_def = pat , psb_dir = dir }) @@ -657,7 +657,8 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L _ name ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) ExplicitBidirectional mg -> do { (mg', fvs) <- bindSigTyVarsFV sig_tvs $ - rnMatchGroup PatSyn rnLExpr mg + rnMatchGroup (FunRhs (L l name) Prefix) + rnLExpr mg ; return (ExplicitBidirectional mg', fvs) } ; mod <- getModule @@ -1031,23 +1032,23 @@ rnMatch' :: Outputable (body RdrName) => HsMatchContext Name -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars)) -> Match RdrName (Located (body RdrName)) -> RnM (Match Name (Located (body Name)), FreeVars) -rnMatch' ctxt rnBody match@(Match { m_fixity = mf, m_pats = pats +rnMatch' ctxt rnBody match@(Match { m_ctxt = mf, m_pats = pats , m_type = maybe_rhs_sig, m_grhss = grhss }) = do { -- Result type signatures are no longer supported case maybe_rhs_sig of Nothing -> return () - Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty) + Just (L loc ty) -> addErrAt loc (resSigErr match ty) - ; let isinfix = isInfixMatch match + ; let fixity = if isInfixMatch match then Infix else Prefix -- Now the main event -- Note that there are no local fixity decls for matches ; rnPats ctxt pats $ \ pats' -> do { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss ; let mf' = case (ctxt,mf) of - (FunRhs funid,FunBindMatch (L lf _) _) - -> FunBindMatch (L lf funid) isinfix - _ -> NonFunBindMatch - ; return (Match { m_fixity = mf', m_pats = pats' + (FunRhs (L _ funid) _,FunRhs (L lf _) _) + -> FunRhs (L lf funid) fixity + _ -> ctxt + ; return (Match { m_ctxt = mf', m_pats = pats' , m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }} emptyCaseErr :: HsMatchContext Name -> SDoc @@ -1061,12 +1062,12 @@ emptyCaseErr ctxt = hang (text "Empty list of alternatives in" <+> pp_ctxt) resSigErr :: Outputable body - => HsMatchContext Name -> Match RdrName body -> HsType RdrName -> SDoc -resSigErr ctxt match ty + => Match RdrName body -> HsType RdrName -> SDoc +resSigErr match ty = vcat [ text "Illegal result type signature" <+> quotes (ppr ty) , nest 2 $ ptext (sLit "Result signatures are no longer supported in pattern matches") - , pprMatchInCtxt ctxt match ] + , pprMatchInCtxt match ] {- ************************************************************************ |