Remove fun_infix from Funbind, as it is now in Match

One of the changes D538 introduced is to add `m_fun_id_infix` to `Match`

```lang=hs
data Match id body
  = Match {
        m_fun_id_infix :: (Maybe (Located id,Bool)),
          -- fun_id and fun_infix for functions with multiple equations
          -- only present for a RdrName. See note [fun_id in Match]
        m_pats :: [LPat id], -- The patterns
        m_type :: (Maybe (LHsType id)),
                                 -- A type signature for the result of the match
                                 -- Nothing after typechecking
        m_grhss :: (GRHSs id body)
  } deriving (Typeable)
```

This was done to track the individual locations and fixity of the
`fun_id` for each of the defining equations for a function when there
are more than one.

For example, the function `(&&&)` is defined with some prefix and some
infix equations below.

```lang=hs
    (&&&  ) [] [] =  []
    xs    &&&   [] =  xs
    (  &&&  ) [] ys =  ys
```

This means that the fun_infix is now superfluous in the `FunBind`. This
has not been removed as a potentially risky change just before 7.10 RC2,
and so must be done after.

This ticket captures that task, which includes processing these fields
through the renamer and beyond.

Ticket #9988 introduced these fields into `Match` through renaming, this
ticket it to continue through type checking and then remove it from
`FunBind` completely.

The split happened so that #9988 could land in 7.10

Trac ticket : #10061

Test Plan: ./validate

Reviewers: goldfire, austin, simonpj, bgamari

Reviewed By: bgamari

Subscribers: simonpj, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1285

GHC Trac Issues: #10061

2 files changed, 21 insertions, 19 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index e4ff162181..479fc28435 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2021,7 +2021,7 @@ decl_no_th :: { LHsDecl RdrName }
         | infixexp opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
                                         let { l = comb2 $1 $> };
                                         case r of {
-                                          (FunBind n _ _ _ _ _) ->
+                                          (FunBind n _ _ _ _) ->
                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
                                           (PatBind (L lh _lhs) _rhs _ _ _) ->
                                                 ams (L lh ()) (fst $2) >> return () } ;
@@ -2158,7 +2158,7 @@ infixexp :: { LHsExpr RdrName }
 exp10 :: { LHsExpr RdrName }
         : '\\' apat apats opt_asig '->' exp
                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
-                            [sLL $1 $> $ Match Nothing ($2:$3) (snd $4) (unguardedGRHSs $6)]))
+                            [sLL $1 $> $ Match NonFunBindMatch ($2:$3) (snd $4) (unguardedGRHSs $6)]))
                           (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
                                                (mj AnnLet $1:mj AnnIn $3
@@ -2556,7 +2556,7 @@ alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
         | alt                   { sL1 $1 ([],[$1]) }
 
 alt     :: { LMatch RdrName (LHsExpr RdrName) }
-        : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
+        : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match NonFunBindMatch [$1] (snd $2)
                                                               (snd $ unLoc $3)))
                                          ((fst $2) ++ (fst $ unLoc $3))}
 
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 5aa91ec296..2a5faffdcd 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -387,21 +387,22 @@ getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
 --
 -- No AndMonoBinds or EmptyMonoBinds here; just single equations
 
-getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1), fun_infix = is_infix1,
+getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1),
                                fun_matches = MG { mg_alts = mtchs1 } })) binds
   | has_args mtchs1
-  = go is_infix1 mtchs1 loc1 binds []
+  = go mtchs1 loc1 binds []
   where
-    go is_infix mtchs loc
-       (L loc2 (ValD (FunBind { fun_id = L _ f2, fun_infix = is_infix2,
+    go mtchs loc
+       (L loc2 (ValD (FunBind { fun_id = L _ f2,
                                 fun_matches = MG { mg_alts = mtchs2 } })) : binds) _
-        | f1 == f2 = go (is_infix || is_infix2) (mtchs2 ++ mtchs)
+        | f1 == f2 = go (mtchs2 ++ mtchs)
                         (combineSrcSpans loc loc2) binds []
-    go is_infix mtchs loc (doc_decl@(L loc2 (DocD _)) : binds) doc_decls
+    go mtchs loc (doc_decl@(L loc2 (DocD _)) : binds) doc_decls
         = let doc_decls' = doc_decl : doc_decls
-          in go is_infix mtchs (combineSrcSpans loc loc2) binds doc_decls'
-    go is_infix mtchs loc binds doc_decls
-        = (L loc (makeFunBind fun_id1 is_infix (reverse mtchs)), (reverse doc_decls) ++ binds)
+          in go mtchs (combineSrcSpans loc loc2) binds doc_decls'
+    go mtchs loc binds doc_decls
+        = ( 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
 
@@ -465,9 +466,9 @@ mkPatSynMatchGroup (L _ patsyn_name) (L _ decls) =
         do { unless (name == patsyn_name) $
                wrongNameBindingErr loc decl
            ; match <- case details of
-               PrefixCon pats -> return $ Match Nothing pats Nothing rhs
+               PrefixCon pats -> return $ Match NonFunBindMatch pats Nothing rhs
                InfixCon pat1 pat2 ->
-                         return $ Match Nothing [pat1, pat2] Nothing rhs
+                         return $ Match NonFunBindMatch [pat1, pat2] Nothing rhs
                RecCon{} -> recordPatSynErr loc pat
            ; return $ L loc match }
     fromDecl (L loc decl) = extraDeclErr loc decl
@@ -912,16 +913,17 @@ checkFunBind msg ann lhs_loc fun is_infix pats opt_sig (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 fun is_infix
-                  [L match_span (Match (Just (fun,is_infix)) ps opt_sig grhss)])
+        return (ann,makeFunBind fun
+                  [L match_span (Match (FunBindMatch fun is_infix)
+                                 ps opt_sig grhss)])
         -- The span of the match covers the entire equation.
         -- That isn't quite right, but it'll do for now.
 
-makeFunBind :: Located RdrName -> Bool -> [LMatch RdrName (LHsExpr RdrName)]
+makeFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)]
             -> HsBind RdrName
 -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
-makeFunBind fn is_infix ms
-  = FunBind { fun_id = fn, fun_infix = is_infix,
+makeFunBind fn ms
+  = FunBind { fun_id = fn,
               fun_matches = mkMatchGroup FromSource ms,
               fun_co_fn = idHsWrapper,
               bind_fvs = placeHolderNames,