[commit: ghc] wip/T8584: Add TcPatSynInfo as a separate type (same pattern as PatSynBind being a separate type) (bba5041)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T8584
Link       : http://ghc.haskell.org/trac/ghc/changeset/bba5041c19e067a316195354474ddb405137a37c/ghc

>---------------------------------------------------------------

commit bba5041c19e067a316195354474ddb405137a37c
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sun Aug 31 19:04:17 2014 +0800

    Add TcPatSynInfo as a separate type (same pattern as PatSynBind being a separate type)


>---------------------------------------------------------------

bba5041c19e067a316195354474ddb405137a37c
 compiler/typecheck/TcBinds.lhs       | 19 ++++++++++---------
 compiler/typecheck/TcPat.lhs         | 22 ++++++++++++++++------
 compiler/typecheck/TcPatSyn.lhs      | 11 ++++++-----
 compiler/typecheck/TcPatSyn.lhs-boot |  6 ++----
 4 files changed, 34 insertions(+), 24 deletions(-)

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 8ee53db..86f3cb5 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -431,11 +431,9 @@ tc_single _top_lvl sig_fn _prag_fn (L _ (PatSynBind psb at PSB{ psb_id = L _ name }
        }
   where
     tc_pat_syn_decl = case sig_fn name of
-        Nothing ->
-            tcInferPatSynDecl psb
-        Just TcPatSynInfo{ patsig_tau = tau, patsig_prov = prov, patsig_req = req } ->
-            tcCheckPatSynDecl psb tau prov req
-        Just _ -> panic "tc_single"
+        Nothing -> tcInferPatSynDecl psb
+        Just (TcPatSynInfo tpsi) -> tcCheckPatSynDecl psb tpsi
+        Just _  -> panic "tc_single"
             
 tc_single top_lvl sig_fn prag_fn lbind thing_inside
   = do { (binds1, ids, closed) <- tcPolyBinds top_lvl sig_fn prag_fn
@@ -1318,10 +1316,13 @@ tcTySig (L loc (PatSynSig (L _ name) args ty (_, ex_tvs, prov) (_, univ_tvs, req
            InfixPatSyn ty1 ty2 -> [ty1, ty2]
        ; prov' <- tcHsContext prov
        ; traceTc "tcTySig" $ ppr ty' $$ ppr args' $$ ppr (ex_tvs', prov') $$ ppr (univ_tvs', req')
-       ; return [TcPatSynInfo{ patsig_name = name,
-                               patsig_tau = mkFunTys args' ty',
-                               patsig_prov = (ex_tvs', prov'),
-                               patsig_req = (univ_tvs', req') }]}}}
+       ; let tpsi = TPSI{ patsig_name = name,
+                          patsig_tau = mkFunTys args' ty',
+                          patsig_ex = ex_tvs',
+                          patsig_prov = prov',
+                          patsig_univ = univ_tvs',
+                          patsig_req = req' }
+       ; return [TcPatSynInfo tpsi]}}}
 tcTySig _ = return []
 
 instTcTySigFromId :: SrcSpan -> Id -> TcM TcSigInfo
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index c044e31..7ca4fdb 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -15,7 +15,8 @@ TcPat: Typechecking patterns
 -- for details
 
 module TcPat ( tcLetPat, TcSigFun, TcPragFun
-             , TcSigInfo(..), findScopedTyVars
+             , TcSigInfo(..), TcPatSynInfo(..)
+             , findScopedTyVars
              , LetBndrSpec(..), addInlinePrags, warnPrags
              , tcPat, tcPats, newNoSigLetBndr
 	     , addDataConStupidTheta, badFieldCon, polyPatSig ) where
@@ -158,11 +159,16 @@ data TcSigInfo
 
         sig_loc    :: SrcSpan       -- The location of the signature
     }
-  | TcPatSynInfo {
+  | TcPatSynInfo TcPatSynInfo
+
+data TcPatSynInfo
+  = TPSI {
         patsig_name  :: Name,
         patsig_tau   :: TcSigmaType,
-        patsig_prov  :: ([TcTyVar], TcThetaType),
-        patsig_req   :: ([TcTyVar], TcThetaType)
+        patsig_ex    :: [TcTyVar],
+        patsig_prov  :: TcThetaType,
+        patsig_univ  :: [TcTyVar],
+        patsig_req   :: TcThetaType
     }
 
 findScopedTyVars  -- See Note [Binding scoped type variables]
@@ -185,13 +191,17 @@ findScopedTyVars hs_ty sig_ty inst_tvs
 
 instance NamedThing TcSigInfo where
     getName TcSigInfo{ sig_id = id } = idName id
-    getName TcPatSynInfo { patsig_name = name } = name
+    getName (TcPatSynInfo tpsi) = patsig_name tpsi
 
 instance Outputable TcSigInfo where
     ppr (TcSigInfo { sig_id = id, sig_tvs = tyvars, sig_theta = theta, sig_tau = tau})
         = ppr id <+> dcolon <+> vcat [ pprSigmaType (mkSigmaTy (map snd tyvars) theta tau)
                                      , ppr (map fst tyvars) ]
-    ppr (TcPatSynInfo { patsig_name = name}) = text "TcPatSynInfo" <+> ppr name
+    ppr (TcPatSynInfo tpsi) = text "TcPatSynInfo" <+> ppr tpsi
+
+instance Outputable TcPatSynInfo where
+    ppr (TPSI{ patsig_name = name}) = ppr name
+
 \end{code}
 
 Note [Binding scoped type variables]
diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs
index 3ae6303..e60cfb6 100644
--- a/compiler/typecheck/TcPatSyn.lhs
+++ b/compiler/typecheck/TcPatSyn.lhs
@@ -92,14 +92,15 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
        ; return (patSyn, matcher_bind) }
 
 tcCheckPatSynDecl :: PatSynBind Name Name
-                  -> TcType
-                  -> ([TyVar], ThetaType) -> ([TyVar], ThetaType)
+                  -> TcPatSynInfo
                   -> TcM (PatSyn, LHsBinds Id)
 tcCheckPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details,
                        psb_def = lpat, psb_dir = dir }
-                  tau (ex_tvs, prov_theta) (univ_tvs, req_theta)
-  = do { tcCheckPatSynPat lpat
-
+                  TPSI{ patsig_tau = tau,
+                        patsig_ex = ex_tvs, patsig_univ = univ_tvs,
+                        patsig_prov = prov_theta, patsig_req = req_theta }
+  = setSrcSpan loc $
+    do { tcCheckPatSynPat lpat
        ; prov_dicts <- newEvVars prov_theta
        ; req_dicts <- newEvVars req_theta
 
diff --git a/compiler/typecheck/TcPatSyn.lhs-boot b/compiler/typecheck/TcPatSyn.lhs-boot
index 2129c33..1b2356a 100644
--- a/compiler/typecheck/TcPatSyn.lhs-boot
+++ b/compiler/typecheck/TcPatSyn.lhs-boot
@@ -6,15 +6,13 @@ import Id        ( Id )
 import HsSyn     ( PatSynBind, LHsBinds )
 import TcRnTypes ( TcM )
 import PatSyn    ( PatSyn )
-import TcType    ( TcType, ThetaType )
-import Var       ( TyVar )
+import TcPat     ( TcPatSynInfo )
 
 tcInferPatSynDecl :: PatSynBind Name Name
                   -> TcM (PatSyn, LHsBinds Id)
 
 tcCheckPatSynDecl :: PatSynBind Name Name
-                  -> TcType
-                  -> ([TyVar], ThetaType) -> ([TyVar], ThetaType)
+                  -> TcPatSynInfo
                   -> TcM (PatSyn, LHsBinds Id)
 
 tcPatSynWrapper :: PatSynBind Name Name