X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=51432bd4ff718ff5d801a3098389a071100590d5;hb=4c719df405e70f6d58c6e351df8bf94a3af6b1fe;hp=56f18ab763fdf31ba998f9bf449375b96801c947;hpb=6c06fdc7ad20682f0f52b5a78e5e3487a2ed047b;p=ghc-hetmet.git

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 56f18ab..51432bd 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -164,6 +164,18 @@ newTopSrcBinder this_mod (L loc rdr_name)
 
 Looking up a name in the RnEnv.
 
+Note [Type and class operator definitions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to reject all of these unless we have -XTypeOperators (Trac #3265)
+   data a :*: b  = ...
+   class a :*: b where ...
+   data (:*:) a b  = ....
+   class (:*:) a b where ...
+The latter two mean that we are not just looking for a
+*syntactically-infix* declaration, but one that uses an operator
+OccName.  We use OccName.isSymOcc to detect that case, which isn't
+terribly efficient, but there seems to be no better way.
+
 \begin{code}
 lookupTopBndrRn :: RdrName -> RnM Name
 lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
@@ -205,7 +217,14 @@ lookupTopBndrRn_maybe rdr_name
         ; return (Just n)}
 
   | otherwise
-  = do	{ mb_gre <- lookupGreLocalRn rdr_name
+  = do	{  -- Check for operators in type or class declarations
+           -- See Note [Type and class operator definitions]
+          let occ = rdrNameOcc rdr_name
+        ; when (isTcOcc occ && isSymOcc occ)
+               (do { op_ok <- doptM Opt_TypeOperators
+	           ; checkM op_ok (addErr (opDeclErr rdr_name)) })
+
+    	; mb_gre <- lookupGreLocalRn rdr_name
 	; case mb_gre of
 		Nothing  -> returnM Nothing
 		Just gre -> returnM (Just $ gre_name gre) }
@@ -309,22 +328,18 @@ lookup_sub_bndr is_good doc rdr_name
 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
 
--- Looking up family names in type instances is a subtle affair.  The family
--- may be imported, in which case we need to lookup the occurence of a global
--- name.  Alternatively, the family may be in the same binding group (and in
--- fact in a declaration processed later), and we need to create a new top
--- source binder.
---
--- So, also this is strictly speaking an occurence, we cannot raise an error
--- message yet for instances without a family declaration.  This will happen
--- during renaming the type instance declaration in RnSource.rnTyClDecl.
+-- If the family is declared locally, it will not yet be in the main
+-- environment; hence, we pass in an extra one here, which we check first.
+-- See "Note [Looking up family names in family instances]" in 'RnNames'.
 --
-lookupFamInstDeclBndr :: Module -> Located RdrName -> RnM Name
-lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name)
-  = do { mb_gre <- lookupGreRn_maybe rdr_name
-       ; case mb_gre of
-           Just gre -> returnM (gre_name gre)
-	   Nothing  -> newTopSrcBinder mod lrdr_name }
+lookupFamInstDeclBndr :: GlobalRdrEnv -> Located RdrName -> RnM Name
+lookupFamInstDeclBndr tyclGroupEnv (L loc rdr_name)
+  = setSrcSpan loc $
+      case lookupGRE_RdrName rdr_name tyclGroupEnv of
+        (gre:_) -> return $ gre_name gre
+          -- if there is more than one, an error will be raised elsewhere
+        []      -> lookupOccRn rdr_name
+
 
 --------------------------------------------------
 --		Occurrences
@@ -904,6 +919,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') }
@@ -1007,7 +1024,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))
 
 -------------------------
 
@@ -1098,4 +1115,9 @@ kindSigErr thing
 badQualBndrErr :: RdrName -> SDoc
 badQualBndrErr rdr_name
   = ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name
+
+opDeclErr :: RdrName -> SDoc
+opDeclErr n 
+  = hang (ptext (sLit "Illegal declaration of a type or class operator") <+> quotes (ppr n))
+       2 (ptext (sLit "Use -XTypeOperators to declare operators in type and declarations"))
 \end{code}