X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnSource.lhs;h=6ee9f8a7dd9c7afebb534daf299726289b0a153c;hb=a8eecb891f9ca609b1ca96dee520124b00ece40f;hp=7d3d308d3e8a501caddeb4c586f38f174f4928ce;hpb=23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 7d3d308..6ee9f8a 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -35,7 +35,7 @@ import BasicTypes	( TopLevelFlag(..)  )
 import HscTypes		( FixityEnv, FixItem(..),
 			  Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
 import Class		( FunDep )
-import Name		( Name )
+import Name		( Name, nameOccName )
 import NameSet
 import NameEnv
 import Outputable
@@ -121,9 +121,14 @@ rnSrcDecls (HsGroup { hs_valds  = [HsBindGroup binds sigs _],
 	   other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, 
 				src_fvs4, src_fvs5] ;
 	   src_dus = bind_dus `plusDU` usesOnly other_fvs 
+		-- Note: src_dus will contain *uses* for locally-defined types
+		-- and classes, but no *defs* for them.  (Because rnTyClDecl 
+		-- returns only the uses.)  This is a little 
+		-- surprising but it doesn't actually matter at all.
 	} ;
 
 	traceRn (text "finish rnSrc" <+> ppr rn_group) ;
+	traceRn (text "finish Dus" <+> ppr src_dus ) ;
 	tcg_env <- getGblEnv ;
 	return (tcg_env `addTcgDUs` src_dus, rn_group)
     }}}
@@ -174,8 +179,7 @@ rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
     		     returnM fix_env
     	  Nothing -> returnM (extendNameEnv fix_env name fix_item)
       where
-	fix_item = FixItem (rdrNameOcc (unLoc rdr_name)) fixity
-			 (getLoc rdr_name)
+	fix_item = FixItem (nameOccName name) fixity (getLoc rdr_name)
 
 pprFixEnv :: FixityEnv -> SDoc
 pprFixEnv env 
@@ -487,16 +491,18 @@ rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_
 
 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
 		    tcdTyVars = tyvars, tcdCons = condecls, 
-		    tcdDerivs = derivs})
+		    tcdKindSig = sig, tcdDerivs = derivs})
   | is_vanilla	-- Normal Haskell data type decl
-  = bindTyVarsRn data_doc tyvars		$ \ tyvars' ->
+  = ASSERT( isNothing sig )	-- In normal H98 form, kind signature on the 
+				-- data type is syntactically illegal
+    bindTyVarsRn data_doc tyvars		$ \ tyvars' ->
     do	{ tycon' <- lookupLocatedTopBndrRn tycon
 	; context' <- rnContext data_doc context
 	; (derivs', deriv_fvs) <- rn_derivs derivs
 	; checkDupNames data_doc con_names
 	; condecls' <- rnConDecls (unLoc tycon') condecls
 	; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
-			   tcdTyVars = tyvars', tcdCons = condecls', 
+			   tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls', 
 			   tcdDerivs = derivs'}, 
 		   delFVs (map hsLTyVarName tyvars')	$
 	     	   extractHsCtxtTyNames context'	`plusFV`
@@ -515,7 +521,7 @@ rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
 	; checkDupNames data_doc con_names
 	; condecls' <- rnConDecls (unLoc tycon') condecls
 	; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
-			   tcdTyVars = tyvars', tcdCons = condecls', 
+			   tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
 			   tcdDerivs = derivs'}, 
 	     	   plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }