X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnSource.lhs;h=d2bae387f905f91c22f9f0e194a20094eb79a267;hb=7299e42cc5214458ba16034dbfbf58de55f7121b;hp=bf29b64685ef01061e85fd6c0ae5fea393deead9;hpb=6d6ce268aa9ad3524cfd83a344c88431c40b1d00;p=ghc-hetmet.git

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index bf29b64..d2bae38 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -94,13 +94,8 @@ Checks the @(..)@ etc constraints in the export list.
 \begin{code}
 -- Brings the binders of the group into scope in the appropriate places;
 -- does NOT assume that anything is in scope already
---
--- The Bool determines whether (True) names in the group shadow existing
--- Unquals in the global environment (used in Template Haskell) or
--- (False) whether duplicates are reported as an error
-rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-
-rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
+rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
+rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
                                    hs_tyclds = tycl_decls,
                                    hs_instds = inst_decls,
                                    hs_derivds = deriv_decls,
@@ -119,7 +114,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
    -- (B) Bring top level binders (and their fixities) into scope,
    --     *except* for the value bindings, which get brought in below.
    avails <- getLocalNonValBinders group ;
-   tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
+   tc_envs <- extendGlobalRdrEnvRn avails local_fix_env ;
    setEnvs tc_envs $ do {
 
    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
@@ -139,7 +134,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
    let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
          lhs_avails = map Avail lhs_binders
        } ;
-   (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
+   (tcg_env, tcl_env) <- extendGlobalRdrEnvRn lhs_avails local_fix_env ;
    setEnvs (tcg_env, tcl_env) $ do {
 
    --  Now everything is in scope, as the remaining renaming assumes.
@@ -666,23 +661,26 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
         } }
 
   | otherwise	          -- GADT
-  = ASSERT( none typatsMaybe )    -- GADTs cannot have type patterns for now
-    do	{ tycon' <- if isFamInstDecl tydecl
+  = do	{ tycon' <- if isFamInstDecl tydecl
 		    then lookupLocatedOccRn     tycon -- may be imported family
 		    else lookupLocatedTopBndrRn tycon
 	; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
-    	; tyvars' <- bindTyVarsRn data_doc tyvars 
-				  (\ tyvars' -> return tyvars')
+    	; (tyvars', typats')
+		<- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
+		   { typats' <- rnTyPats data_doc typatsMaybe
+		   ; return (tyvars', typats') }
 		-- For GADTs, the type variables in the declaration 
 		-- do not scope over the constructor signatures
 		-- 	data T a where { T1 :: forall b. b-> b }
+
 	; (derivs', deriv_fvs) <- rn_derivs derivs
 	; condecls' <- rnConDecls (unLoc tycon') condecls
 		-- No need to check for duplicate constructor decls
 		-- since that is done by RnNames.extendGlobalRdrEnvRn
+
 	; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], 
 			   tcdLName = tycon', tcdTyVars = tyvars', 
-			   tcdTyPats = Nothing, tcdKindSig = sig,
+			   tcdTyPats = typats', tcdKindSig = sig,
 			   tcdCons = condecls', tcdDerivs = derivs'}, 
 	     	   plusFVs (map conDeclFVs condecls') `plusFV` 
 		   deriv_fvs			      `plusFV`
@@ -696,10 +694,6 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
 		     L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 		     _    		   -> False
 
-    none Nothing   = True
-    none (Just []) = True
-    none _         = False
-
     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 
     rn_derivs Nothing   = returnM (Nothing, emptyFVs)