X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnIfaces.lhs;h=543866a79584a72cf6f4623b53688ea17c301e38;hb=301b341806ff4c6ad8e0c947530e0fbe9094caa7;hp=7d7520a93ef347f51752e0431d0c0cacbce832a9;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 7d7520a..543866a 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -25,7 +25,7 @@ import CmdLineOpts	( opt_PruneTyDecls,  opt_PruneInstDecls,
 import HsSyn		( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
 			  HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
 			  FixitySig(..),
-			  hsDeclName, countTyClDecls, isDataDecl
+			  hsDeclName, countTyClDecls, isDataDecl, nonFixitySigs
 			)
 import BasicTypes	( Version, NewOrData(..), IfaceFlavour(..) )
 import RdrHsSyn		( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl,
@@ -270,7 +270,7 @@ loadDecl mod as_source decls_map (version, decl)
 				       [ (name, (version,avail,decl',name==main_name)) 
 				       | name <- sys_bndrs ++ availNames avail]
 	add_decl decls_map (name, stuff)
-	  = ASSERT2( not (name `elemNameEnv` decls_map), ppr name )
+	  = WARN( name `elemNameEnv` decls_map, ppr name )
 	    addToNameEnv decls_map name stuff
     in
     returnRn new_decls_map
@@ -925,7 +925,11 @@ getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc
   = new_name cname src_loc			`thenRn` \ class_name ->
 
 	-- Record the names for the class ops
-    mapRn (getClassOpNames new_name) sigs	`thenRn` \ sub_names ->
+    let
+	-- ignoring fixity declarations
+	nonfix_sigs = nonFixitySigs sigs
+    in
+    mapRn (getClassOpNames new_name) nonfix_sigs	`thenRn` \ sub_names ->
 
     returnRn (AvailTC class_name (class_name : sub_names))
 
@@ -946,10 +950,15 @@ getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
   where
     fields = concat (map fst fielddecls)
 
-getConFieldNames new_name (ConDecl con _ _ _ src_loc : rest)
+getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
   = new_name con src_loc		`thenRn` \ n ->
+    (case condecl of
+      NewCon _ (Just f) -> 
+        new_name f src_loc `thenRn` \ new_f ->
+	returnRn [n,new_f]
+      _ -> returnRn [n])		`thenRn` \ nn ->
     getConFieldNames new_name rest	`thenRn` \ ns -> 
-    returnRn (n:ns)
+    returnRn (nn ++ ns)
 
 getConFieldNames new_name [] = returnRn []