From a13cb27960f9bdb0bc9eececf9159f034f113481 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Wed, 25 May 2016 00:09:34 +0200
Subject: Merge MatchFixity and HsMatchContext

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

(cherry picked from commit 306ecad591951521ac3f5888ca8be85bf749d271)
---
 compiler/parser/Parser.y    |  4 ++--
 compiler/parser/RdrHsSyn.hs | 21 +++++++++++----------
 2 files changed, 13 insertions(+), 12 deletions(-)

(limited to 'compiler/parser')

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index e1c8559933..b0b64aea5c 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2131,7 +2131,7 @@ infixexp :: { LHsExpr RdrName }
 exp10 :: { LHsExpr RdrName }
         : '\\' apat apats opt_asig '->' exp
                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
-                            [sLL $1 $> $ Match { m_fixity = NonFunBindMatch
+                            [sLL $1 $> $ Match { m_ctxt = LambdaExpr
                                                , m_pats = $2:$3
                                                , m_type = snd $4
                                                , m_grhss = unguardedGRHSs $6 }]))
@@ -2550,7 +2550,7 @@ alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
         | alt                   { sL1 $1 ([],[$1]) }
 
 alt     :: { LMatch RdrName (LHsExpr RdrName) }
-        : pat opt_asig alt_rhs  {%ams (sLL $1 $> (Match { m_fixity = NonFunBindMatch
+        : pat opt_asig alt_rhs  {%ams (sLL $1 $> (Match { m_ctxt = CaseAlt
                                                         , m_pats = [$1]
                                                         , m_type = snd $2
                                                         , m_grhss = snd $ unLoc $3 }))
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 43ff23092a..af1e53e866 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -502,9 +502,10 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
         do { unless (name == patsyn_name) $
                wrongNameBindingErr loc decl
            ; match <- case details of
-               PrefixCon pats -> return $ Match (FunBindMatch ln False) pats Nothing rhs
+               PrefixCon pats ->
+                        return $ Match (FunRhs ln Prefix) pats Nothing rhs
                InfixCon pat1 pat2 ->
-                         return $ Match (FunBindMatch ln True) [pat1, pat2] Nothing rhs
+                       return $ Match (FunRhs ln Infix) [pat1, pat2] Nothing rhs
                RecCon{} -> recordPatSynErr loc pat
            ; return $ L loc match }
     fromDecl (L loc decl) = extraDeclErr loc decl
@@ -919,7 +920,7 @@ checkFunBind :: SDoc
              -> [AddAnn]
              -> SrcSpan
              -> Located RdrName
-             -> Bool
+             -> FunctionFixity
              -> [LHsExpr RdrName]
              -> Maybe (LHsType RdrName)
              -> Located (GRHSs RdrName (LHsExpr RdrName))
@@ -930,7 +931,7 @@ checkFunBind msg ann lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
         -- Add back the annotations stripped from any HsPar values in the lhs
         -- mapM_ (\a -> a match_span) ann
         return (ann, makeFunBind fun
-                  [L match_span (Match { m_fixity = FunBindMatch fun is_infix
+                  [L match_span (Match { m_ctxt = FunRhs fun is_infix
                                        , m_pats = ps
                                        , m_type = opt_sig
                                        , m_grhss = grhss })])
@@ -1024,7 +1025,7 @@ splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg))
 splitBang _ = Nothing
 
 isFunLhs :: LHsExpr RdrName
-         -> P (Maybe (Located RdrName, Bool, [LHsExpr RdrName],[AddAnn]))
+      -> P (Maybe (Located RdrName, FunctionFixity, [LHsExpr RdrName],[AddAnn]))
 -- A variable binding is parsed as a FunBind.
 -- Just (fun, is_infix, arg_pats) if e is a function LHS
 --
@@ -1040,7 +1041,7 @@ isFunLhs :: LHsExpr RdrName
 isFunLhs e = go e [] []
  where
    go (L loc (HsVar (L _ f))) es ann
-        | not (isRdrDataCon f)       = return (Just (L loc f, False, es, ann))
+        | not (isRdrDataCon f)       = return (Just (L loc f, Prefix, es, ann))
    go (L _ (HsApp f e)) es       ann = go f (e:es) ann
    go (L l (HsPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
 
@@ -1061,15 +1062,15 @@ isFunLhs e = go e [] []
         | Just (e',es') <- splitBang e
         = do { bang_on <- extension bangPatEnabled
              ; if bang_on then go e' (es' ++ es) ann
-               else return (Just (L loc' op, True, (l:r:es), ann)) }
+               else return (Just (L loc' op, Infix, (l:r:es), ann)) }
                 -- No bangs; behave just like the next case
         | not (isRdrDataCon op)         -- We have found the function!
-        = return (Just (L loc' op, True, (l:r:es), ann))
+        = return (Just (L loc' op, Infix, (l:r:es), ann))
         | otherwise                     -- Infix data con; keep going
         = do { mb_l <- go l es ann
              ; case mb_l of
-                 Just (op', True, j : k : es', ann')
-                   -> return (Just (op', True, j : op_app : es', ann'))
+                 Just (op', Infix, j : k : es', ann')
+                   -> return (Just (op', Infix, j : op_app : es', ann'))
                    where
                      op_app = L loc (OpApp k (L loc' (HsVar (L loc' op))) fix r)
                  _ -> return Nothing }
-- 
cgit v1.2.1