X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=b4dafd35486a57805a31e40e4c5f6ddc78ac5cdb;hb=46f02d59813499ba2aa44e7831e0b69ec6d8f25d;hp=fa151362afa1b2373624b1854ec80a67faa114e2;hpb=04c3bfc687db82659a7fe5a8b0fa4244c52560b7;p=ghc-hetmet.git

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index fa15136..b4dafd3 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -30,7 +30,9 @@ module RnEnv (
 	mapFvRn, mapFvRnCPS,
 	warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
 	warnUnusedTopBinds, warnUnusedLocalBinds,
-	dataTcOccs, unknownNameErr, perhapsForallMsg
+	dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg,
+
+	checkM
     ) where
 
 #include "HsVersions.h"
@@ -822,13 +824,15 @@ bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
 	      -> RnM a
 -- Haskell-98 binding of type variables; e.g. within a data type decl
 bindTyVarsRn doc_str tyvar_names enclosed_scope
-  = let
-	located_tyvars = hsLTyVarLocNames tyvar_names
-    in
-    bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
-    enclosed_scope (zipWith replace tyvar_names names)
-    where 
-	replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
+  = bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
+    do { kind_sigs_ok <- doptM Opt_KindSignatures
+       ; checkM (null kinded_tyvars || kind_sigs_ok) 
+       	 	(mapM_ (addErr . kindSigErr) kinded_tyvars)
+       ; enclosed_scope (zipWith replace tyvar_names names) }
+  where 
+    replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
+    located_tyvars = hsLTyVarLocNames tyvar_names
+    kinded_tyvars  = [n | L _ (KindedTyVar n _) <- tyvar_names]
 
 bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
   -- Find the type variables in the pattern type 
@@ -900,6 +904,8 @@ checkShadowedNames doc_str (global_env,local_env) loc_rdr_names
 	; mappM_ check_shadow loc_rdr_names }
   where
     check_shadow (loc, occ)
+        | startsWithUnderscore occ = return ()	-- Do not report shadowing for "_x"
+	  		       	     	    	-- See Trac #3262
 	| Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
 	| otherwise = do { gres' <- filterM is_shadowed_gre gres
 			 ; complain (map pprNameProvenance gres') }
@@ -1003,7 +1009,7 @@ warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 	| isWiredInName name = False	-- Don't report unused wired-in names
 					-- Otherwise we get a zillion warnings
 					-- from Data.Tuple
-	| otherwise = reportIfUnused (nameOccName name)
+	| otherwise = not (startsWithUnderscore (nameOccName name))
 
 -------------------------
 
@@ -1085,6 +1091,12 @@ dupNamesErr get_loc descriptor names
 	      | otherwise = ptext (sLit "Bound at:") <+> 
 			    vcat (map ppr (sortLe (<=) locs))
 
+kindSigErr :: Outputable a => a -> SDoc
+kindSigErr thing
+  = hang (ptext (sLit "Illegal kind signature for") <+> quotes (ppr thing))
+       2 (ptext (sLit "Perhaps you intended to use -XKindSignatures"))
+
+
 badQualBndrErr :: RdrName -> SDoc
 badQualBndrErr rdr_name
   = ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name