X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=228f12cc4e409da5fec3e8e0cc18dd588eab0c98;hb=0ef29fb878dd6517d2716afb056bcf2536c2562e;hp=c630078d4120e7086f53f6972ea976309a1204b5;hpb=4161ba13916463f8e67259498eacf22744160e1f;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index c630078..228f12c 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -17,15 +17,15 @@ module HscTypes (
 
 	VersionInfo(..), initialVersionInfo,
 
-	TyThing(..), isTyClThing,
+	TyThing(..), isTyClThing, implicitTyThingIds,
 
 	TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, 
 	typeEnvClasses, typeEnvTyCons,
 
-	WhetherHasOrphans, ImportVersion, WhatsImported(..),
+	ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
 	PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
 	IfaceInsts, IfaceRules, GatedDecl, IsExported,
-	OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
+	NameSupply(..), OrigNameCache, OrigIParamCache,
 	AvailEnv, AvailInfo, GenAvailInfo(..),
 	PersistentCompilerState(..),
 
@@ -54,8 +54,9 @@ import Module		( Module, ModuleName, ModuleEnv,
 import InstEnv		( InstEnv, ClsInstEnv, DFunId )
 import Rules		( RuleBase )
 import Id		( Id )
-import Class		( Class )
-import TyCon		( TyCon )
+import Class		( Class, classSelIds )
+import TyCon		( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import DataCon		( dataConId, dataConWrapId )
 
 import BasicTypes	( Version, initialVersion, Fixity )
 
@@ -149,24 +150,8 @@ mkIfaceDecls tycls rules insts
 		 dcl_rules = sortLt lt_rule rules,
 		 dcl_insts = insts }
   where
-    d1 `lt_tycl` d2 = nameOccName (tyClDeclName      d1) < nameOccName (tyClDeclName      d2)
-    r1 `lt_rule` r2 = nameOccName (ifaceRuleDeclName r1) < nameOccName (ifaceRuleDeclName r2)
-
-	-- I wanted to sort just by the Name, but there's a problem: we are comparing
-	-- the old version of an interface with the new version.  The latter will use
-	-- local names like 'lvl23' that were constructed not by the renamer but by
-	-- the simplifier.  So the unqiues aren't going to line up.
-	--
-	-- It's ok to compare by OccName because this comparison only drives the
-	-- computation of new version numbers.
-	--
-	-- Better solutions: 	Compare in a way that is insensitive to the name used
-	--			for local things.  This would decrease the wobbles due
-	--			to 'lvl23' changing to 'lvl24'.
-	--
-	-- NB: there's a related comparision on MkIface.diffDecls!  
-
-
+    d1 `lt_tycl` d2 = tyClDeclName      d1 < tyClDeclName      d2
+    r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
 
 
 -- typechecker should only look at this, not ModIface
@@ -256,9 +241,26 @@ instance NamedThing TyThing where
   getName (ATyCon tc) = getName tc
   getName (AClass cl) = getName cl
 
+instance Outputable TyThing where
+  ppr (AnId   id) = ptext SLIT("AnId")   <+> ppr id
+  ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc
+  ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl
+
 typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
 typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
 
+implicitTyThingIds :: [TyThing] -> [Id]
+-- Add the implicit data cons and selectors etc 
+implicitTyThingIds things
+  = concat (map go things)
+  where
+    go (AnId f)    = []
+    go (AClass cl) = classSelIds cl
+    go (ATyCon tc) = tyConGenIds tc ++
+		     tyConSelIds tc ++
+		     [ n | dc <- tyConDataConsIfAvailable tc, 
+			   n  <- [dataConId dc, dataConWrapId dc] ] 
+		-- Synonyms return empty list of constructors and selectors
 \end{code}
 
 
@@ -455,15 +457,15 @@ type PackageRuleBase = RuleBase
 type PackageInstEnv  = InstEnv
 
 data PersistentRenamerState
-  = PRS { prsOrig  :: OrigNameEnv,
-	  prsDecls :: DeclsMap,
-	  prsInsts :: IfaceInsts,
-	  prsRules :: IfaceRules,
-	  prsNS    :: UniqSupply
+  = PRS { prsOrig    :: NameSupply,
+	  prsImpMods :: ImportedModuleInfo,
+	  prsDecls   :: DeclsMap,
+	  prsInsts   :: IfaceInsts,
+	  prsRules   :: IfaceRules
     }
 \end{code}
 
-The OrigNameEnv makes sure that there is just one Unique assigned for
+The NameSupply makes sure that there is just one Unique assigned for
 each original name; i.e. (module-name, occ-name) pair.  The Name is
 always stored as a Global, and has the SrcLoc of its binding location.
 Actually that's not quite right.  When we first encounter the original
@@ -476,17 +478,29 @@ encounter the occurrence, we may not know the details of the module, so
 we just store junk.  Then when we find the binding site, we fix it up.
 
 \begin{code}
-data OrigNameEnv
- = Orig { origNames  :: OrigNameNameEnv,
+data NameSupply
+ = NameSupply { nsUniqs :: UniqSupply,
+		-- Supply of uniques
+		nsNames :: OrigNameCache,
 		-- Ensures that one original name gets one unique
-	  origIParam :: OrigNameIParamEnv
+		nsIPs   :: OrigIParamCache
 		-- Ensures that one implicit parameter name gets one unique
    }
 
-type OrigNameNameEnv   = FiniteMap (ModuleName,OccName) Name
-type OrigNameIParamEnv = FiniteMap OccName Name
+type OrigNameCache   = FiniteMap (ModuleName,OccName) Name
+type OrigIParamCache = FiniteMap OccName Name
 \end{code}
 
+@ImportedModuleInfo@ contains info ONLY about modules that have not yet 
+been loaded into the iPIT.  These modules are mentioned in interfaces we've
+already read, so we know a tiny bit about them, but we havn't yet looked
+at the interface file for the module itself.  It needs to persist across 
+invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource.
+And there's no harm in it persisting across multiple compilations.
+
+\begin{code}
+type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
+\end{code}
 
 A DeclsMap contains a binding for each Name in the declaration
 including the constructors of a type decl etc.  The Bool is True just