X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=1800e84f301d4fd675592537f00a3ce3d55d796b;hb=d9fa58a35fedd36471063e4375ca177632f540e4;hp=ed882397d7e4c31ceb9ad4fa74e6a7293606903f;hpb=92cdc09e48d3410182581f5bd687d1ee7cbe476b;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index ed88239..1800e84 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -21,6 +21,7 @@ module HscTypes (
 	IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
 
 	VersionInfo(..), initialVersionInfo, lookupVersion,
+	FixityEnv, lookupFixity, collectFixities,
 
 	TyThing(..), isTyClThing, implicitTyThingIds,
 
@@ -34,6 +35,7 @@ module HscTypes (
 	NameSupply(..), OrigNameCache, OrigIParamCache,
 	Avails, AvailEnv, emptyAvailEnv,
 	GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
+	ExportItem, RdrExportItem,
 	PersistentCompilerState(..),
 
 	Deprecations(..), lookupDeprec,
@@ -53,32 +55,30 @@ module HscTypes (
 
 #include "HsVersions.h"
 
-import RdrName		( RdrName, RdrNameEnv, addListToRdrEnv, emptyRdrEnv, 
+import RdrName		( RdrName, RdrNameEnv, addListToRdrEnv, 
 			  mkRdrUnqual, rdrEnvToList )
 import Name		( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
 import NameEnv
 import OccName		( OccName )
-import Module		( Module, ModuleName, ModuleEnv,
-			  lookupModuleEnv, lookupModuleEnvByName, 
-			  emptyModuleEnv, moduleUserString
-			)
+import Module
 import InstEnv		( InstEnv, ClsInstEnv, DFunId )
 import Rules		( RuleBase )
 import CoreSyn		( CoreBind )
 import Id		( Id )
 import Class		( Class, classSelIds )
-import TyCon		( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
-import DataCon		( dataConId, dataConWrapId )
+import TyCon		( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
+import DataCon		( dataConWorkId, dataConWrapId )
 
-import BasicTypes	( Version, initialVersion, Fixity, IPName )
+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
@@ -158,7 +158,8 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
 \begin{code}
 data ModIface 
    = ModIface {
-        mi_module   :: !Module,		    -- Complete with package info
+        mi_module   :: !Module,
+	mi_package  :: !PackageName,	    -- Which package the module comes from
         mi_version  :: !VersionInfo,	    -- Module version number
 
         mi_orphan   :: WhetherHasOrphans,   -- Whether this module has orphans
@@ -171,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
 
@@ -179,7 +180,7 @@ data ModIface
 		-- Its top level environment or Nothing if we read this
 		-- interface from a file.
 
-        mi_fixities :: !(NameEnv Fixity),   -- Fixities
+        mi_fixities :: !FixityEnv,	    -- Fixities
 	mi_deprecs  :: !Deprecations,	    -- Deprecations
 
 	mi_decls    :: IfaceDecls	    -- The RnDecls form of ModDetails
@@ -249,6 +250,7 @@ data ModDetails
 emptyModIface :: Module -> ModIface
 emptyModIface mod
   = ModIface { mi_module   = mod,
+	       mi_package  = preludePackage, -- XXX fully bogus
 	       mi_version  = initialVersionInfo,
 	       mi_usages   = [],
 	       mi_orphan   = False,
@@ -371,14 +373,14 @@ implicitTyThingIds things
     go (AClass cl) = classSelIds cl
     go (ATyCon tc) = tyConGenIds tc ++
 		     tyConSelIds tc ++
-		     [ n | dc <- tyConDataConsIfAvailable tc, 
+		     [ n | dc <- tyConDataCons_maybe tc `orElse` [],
 			   n  <- implicitConIds tc dc]
 		-- Synonyms return empty list of constructors and selectors
 
     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
 
@@ -493,6 +498,20 @@ pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
 pprAvail (Avail n) = ppr n
 \end{code}
 
+\begin{code}
+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}
+
 
 %************************************************************************
 %*									*