[commit: ghc] wip/T11028: Use the HsTyVarBndrs in type checking (0c35b36)

[git at git.haskell.org]

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

On branch  : wip/T11028
Link       : http://ghc.haskell.org/trac/ghc/changeset/0c35b3641b0520df9edda6aae80e77361b315337/ghc

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

commit 0c35b3641b0520df9edda6aae80e77361b315337
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Fri Nov 27 20:18:19 2015 +0200

    Use the HsTyVarBndrs in type checking


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

0c35b3641b0520df9edda6aae80e77361b315337
 compiler/deSugar/DsMeta.hs         | 2 +-
 compiler/parser/RdrHsSyn.hs        | 7 ++++---
 compiler/rename/RnSource.hs        | 2 +-
 compiler/typecheck/TcTyClsDecls.hs | 8 +++-----
 utils/haddock                      | 2 +-
 5 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 176447c..d6699fe 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -659,7 +659,7 @@ repC tvs (L _ (ConDeclGADT { con_names = cons
        ; b <- dsExtendMetaEnv (mkNameEnv binds) $ -- Binds some of the con_tvs
          addTyVarBinds ex_tvs $ \ ex_bndrs ->   -- Binds the remaining con_tvs
     do { cons1     <- mapM lookupLOcc cons -- See Note [Binders and occurrences]
-       ; let (details,_,_) = gadtDeclDetails res_ty
+       ; let (details,_,_,_) = gadtDeclDetails res_ty
        ; c'        <- mapM (\c -> repConstr c details) cons1
        ; ctxt'     <- repContext eq_ctxt
        ; rep2 forallCName ([unC ex_bndrs, unC ctxt'] ++ (map unC c')) }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index baf4bb6..b3175dd 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -542,10 +542,11 @@ mkGadtDecl' names lbody_ty@(L loc body_ty)
 -}
 
 -- AZ:TODO: this probably belongs in a different module
-gadtDeclDetails :: LHsSigType name -> (HsConDeclDetails name,LHsType name,LHsContext name)
-gadtDeclDetails (HsIB {hsib_body = lbody_ty}) = (details,res_ty,cxt)
+gadtDeclDetails :: LHsSigType name
+                -> (HsConDeclDetails name,LHsType name,LHsContext name,[LHsTyVarBndr name])
+gadtDeclDetails (HsIB {hsib_body = lbody_ty}) = (details,res_ty,cxt,tvs)
   where
-    (_tvs, cxt, tau) = splitLHsSigmaTy lbody_ty
+    (tvs, cxt, tau) = splitLHsSigmaTy lbody_ty
     (details, res_ty)           -- See Note [Sorting out the result type]
       = case tau of
           L _ (HsFunTy (L l (HsRecTy flds)) res_ty)
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 3a7e8b8..fce2ed7 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1586,7 +1586,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
         (free_kvs, _) = get_rdr_tvs arg_tys
 
 rnConDecl decl@(ConDeclGADT { con_names = names, con_type = ty
-                        , con_doc = mb_doc })
+                            , con_doc = mb_doc })
   = do  { mapM_ (addLocM checkConName) names
         ; new_names    <- mapM lookupLocatedTopBndrRn names
         ; let doc = ConDeclCtx new_names
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 6bdcc27..c5c7c45 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -513,7 +513,6 @@ kcConDecl (ConDeclGADT { con_names = names
                        , con_type = ty })
   = addErrCtxt (dataConCtxtName names) $
     do { traceTc "kcConDecl:GADT:" (ppr ty)
-       -- ; kcHsSigType names ty
        ; _ <- tcGadtSigType (ppr names) (unLoc $ head names) ty
        ; traceTc "kcConDecl:GADT done:" (ppr ty)
        }
@@ -1401,7 +1400,7 @@ tcConDecl _new_or_data is_prom rep_tycon tmpl_tvs res_tmpl
        ; traceTc "tcConDecl 2" (ppr names $$ ppr field_lbls)
        ; let
            buildOneDataCon (L _ name) = do
-             { let (hs_details,_,_) = gadtDeclDetails ty
+             { let (hs_details,_,_,_tvs) = gadtDeclDetails ty
              ; is_infix <- tcConIsInfixGADT name hs_details
              ; rep_nm   <- newTyConRepName name
 
@@ -1423,10 +1422,9 @@ tcConDecl _new_or_data is_prom rep_tycon tmpl_tvs res_tmpl
 tcGadtSigType :: SDoc -> Name -> LHsSigType Name
               -> TcM ([PredType],[HsSrcBang], [FieldLabel], [Type], Type)
 tcGadtSigType doc name ty@(HsIB { hsib_kvs = kvs, hsib_tvs = tvs, hsib_body = _bty})
-  = do {
-       ; let hs_tvs = HsQTvs { hsq_kvs = kvs, hsq_tvs = map (noLoc . UserTyVar . noLoc) tvs }
-       ; let (hs_details',res_ty',cxt) = gadtDeclDetails ty
+  = do { let (hs_details',res_ty',cxt,gtvs) = gadtDeclDetails ty
        ; (hs_details,res_ty) <- tcUpdateConResult doc hs_details' res_ty'
+       ; let hs_tvs = HsQTvs { hsq_kvs = kvs, hsq_tvs = gtvs ++ map (noLoc . UserTyVar . noLoc) tvs }
        ; (ctxt, arg_tys, res_ty, field_lbls, stricts)
            <- tcHsQTyVars hs_tvs $ \ _ ->
               do { traceTc "tcConDecl" (doc <+> text "tvs:" <+> ppr hs_tvs)
diff --git a/utils/haddock b/utils/haddock
index bb1f980..628c804 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit bb1f9806d88c16ce772f506eff48ae3d5588d173
+Subproject commit 628c80444e55289cfb74823555f80e1dabfa82ee