X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=1800e84f301d4fd675592537f00a3ce3d55d796b;hb=ef3da13ba529e1f0202709bec93a2b5ba7f3e1b8;hp=6077dda10cbf8aaec04043c760c86b1a47fcf16f;hpb=711e4d7a4d65472a3a1fb35bcad8e1c9a109c728;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 6077dda..1800e84 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -21,7 +21,7 @@ module HscTypes (
 	IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
 
 	VersionInfo(..), initialVersionInfo, lookupVersion,
-	FixityEnv, lookupFixity,
+	FixityEnv, lookupFixity, collectFixities,
 
 	TyThing(..), isTyClThing, implicitTyThingIds,
 
@@ -35,6 +35,7 @@ module HscTypes (
 	NameSupply(..), OrigNameCache, OrigIParamCache,
 	Avails, AvailEnv, emptyAvailEnv,
 	GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
+	ExportItem, RdrExportItem,
 	PersistentCompilerState(..),
 
 	Deprecations(..), lookupDeprec,
@@ -66,17 +67,18 @@ import CoreSyn		( CoreBind )
 import Id		( Id )
 import Class		( Class, classSelIds )
 import TyCon		( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
-import DataCon		( dataConId, dataConWrapId )
+import DataCon		( dataConWorkId, dataConWrapId )
 
 import BasicTypes	( Version, initialVersion, Fixity, defaultFixity, IPName )
 
-import HsSyn		( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
+import HsSyn		( DeprecTxt, TyClDecl, tyClDeclName, ifaceRuleDeclName,
+			  tyClDeclNames )
 import RdrHsSyn		( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
 import RnHsSyn		( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
 
 import CoreSyn		( IdCoreRule )
 
-import FiniteMap	( FiniteMap )
+import FiniteMap
 import Bag		( Bag )
 import Maybes		( seqMaybe, orElse )
 import Outputable
@@ -170,7 +172,7 @@ data ModIface
 		-- whether to write a new iface file (changing usages
 		-- doesn't affect the version of this module)
 
-        mi_exports  :: ![(ModuleName,Avails)],
+        mi_exports  :: ![ExportItem],
 		-- What it exports Kept sorted by (mod,occ), to make
 		-- version comparisons easier
 
@@ -378,7 +380,7 @@ implicitTyThingIds things
     implicitConIds tc dc	-- Newtypes have a constructor wrapper,
 				-- but no worker
 	| isNewTyCon tc = [dataConWrapId dc]
-	| otherwise     = [dataConId dc, dataConWrapId dc]
+	| otherwise     = [dataConWorkId dc, dataConWrapId dc]
 \end{code}
 
 
@@ -477,11 +479,14 @@ data GenAvailInfo name	= Avail name	 -- An ordinary identifier
 			deriving( Eq )
 			-- Equality used when deciding if the interface has changed
 
+type RdrExportItem = (ModuleName, [RdrAvailInfo])
+type ExportItem    = (ModuleName, [AvailInfo])
+
 type AvailEnv = NameEnv AvailInfo	-- Maps a Name to the AvailInfo that contains it
 
 emptyAvailEnv :: AvailEnv
 emptyAvailEnv = emptyNameEnv
-				
+
 instance Outputable n => Outputable (GenAvailInfo n) where
    ppr = pprAvail
 
@@ -498,6 +503,13 @@ type FixityEnv = NameEnv Fixity
 
 lookupFixity :: FixityEnv -> Name -> Fixity
 lookupFixity env n = lookupNameEnv env n `orElse` defaultFixity
+
+collectFixities :: FixityEnv -> [TyClDecl Name pat] -> [(Name,Fixity)]
+collectFixities env decls
+  = [ (n, fix) 
+    | d <- decls, (n,_) <- tyClDeclNames d,
+      Just fix <- [lookupNameEnv env n]
+    ]
 \end{code}