[commit: ghc] wip/T8584: Split tcPatSynDecl into inferring function and general workhorse function (b9f6912)

[git at git.haskell.org]

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

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

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

commit b9f6912ea8d2c8c796c8f363ee2f3ea3630a866a
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sun Jul 27 14:10:34 2014 +0200

    Split tcPatSynDecl into inferring function and general workhorse function


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

b9f6912ea8d2c8c796c8f363ee2f3ea3630a866a
 compiler/typecheck/TcBinds.lhs       |  4 ++--
 compiler/typecheck/TcPatSyn.lhs      | 11 +++++++++--
 compiler/typecheck/TcPatSyn.lhs-boot |  4 ++--
 3 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index e96e0be..a94748f 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -16,7 +16,7 @@ module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds,
 
 import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
-import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynWrapper )
+import {-# SOURCE #-} TcPatSyn ( tcInferPatSynDecl, tcPatSynWrapper )
 
 import DynFlags
 import HsSyn
@@ -419,7 +419,7 @@ tc_single :: forall thing.
           -> LHsBind Name -> TcM thing
           -> TcM (LHsBinds TcId, thing)
 tc_single _top_lvl _sig_fn _prag_fn (L _ (PatSynBind psb)) thing_inside
-  = do { (pat_syn, aux_binds) <- tcPatSynDecl psb
+  = do { (pat_syn, aux_binds) <- tcInferPatSynDecl psb
 
        ; let tything = AConLike (PatSynCon pat_syn)
              implicit_ids = (patSynMatcher pat_syn) :
diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs
index 9b2b511..17ea802 100644
--- a/compiler/typecheck/TcPatSyn.lhs
+++ b/compiler/typecheck/TcPatSyn.lhs
@@ -7,7 +7,7 @@
 \begin{code}
 {-# LANGUAGE CPP #-}
 
-module TcPatSyn (tcPatSynDecl, tcPatSynWrapper) where
+module TcPatSyn (tcInferPatSynDecl, tcPatSynWrapper) where
 
 import HsSyn
 import TcPat
@@ -42,13 +42,20 @@ import TypeRep
 \end{code}
 
 \begin{code}
+tcInferPatSynDecl :: PatSynBind Name Name
+                  -> TcM (PatSyn, LHsBinds Id)
+tcInferPatSynDecl psb
+  = do { pat_ty <- newFlexiTyVarTy openTypeKind
+       ; tcPatSynDecl psb pat_ty }
+
 tcPatSynDecl :: PatSynBind Name Name
+             -> TcType
              -> TcM (PatSyn, LHsBinds Id)
 tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
                   psb_def = lpat, psb_dir = dir }
+             pat_ty
   = do { traceTc "tcPatSynDecl {" $ ppr name $$ ppr lpat
        ; tcCheckPatSynPat lpat
-       ; pat_ty <- newFlexiTyVarTy openTypeKind
 
        ; let (arg_names, is_infix) = case details of
                  PrefixPatSyn names      -> (map unLoc names, False)
diff --git a/compiler/typecheck/TcPatSyn.lhs-boot b/compiler/typecheck/TcPatSyn.lhs-boot
index 700137c..0f77400 100644
--- a/compiler/typecheck/TcPatSyn.lhs-boot
+++ b/compiler/typecheck/TcPatSyn.lhs-boot
@@ -7,8 +7,8 @@ import HsSyn     ( PatSynBind, LHsBinds )
 import TcRnTypes ( TcM )
 import PatSyn    ( PatSyn )
 
-tcPatSynDecl :: PatSynBind Name Name
-             -> TcM (PatSyn, LHsBinds Id)
+tcInferPatSynDecl :: PatSynBind Name Name
+                  -> TcM (PatSyn, LHsBinds Id)
 
 tcPatSynWrapper :: PatSynBind Name Name
                 -> TcM (LHsBinds Id)