[project @ 2000-12-07 08:22:53 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index c630078..8284e2f 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -17,7 +17,7 @@ module HscTypes (
 
        VersionInfo(..), initialVersionInfo,
 
-       TyThing(..), isTyClThing,
+       TyThing(..), isTyClThing, implicitTyThingIds,
 
        TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, 
        typeEnvClasses, typeEnvTyCons,
@@ -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}
 
 
@@ -458,8 +460,7 @@ data PersistentRenamerState
   = PRS { prsOrig  :: OrigNameEnv,
          prsDecls :: DeclsMap,
          prsInsts :: IfaceInsts,
-         prsRules :: IfaceRules,
-         prsNS    :: UniqSupply
+         prsRules :: IfaceRules
     }
 \end{code}
 
@@ -477,7 +478,9 @@ we just store junk.  Then when we find the binding site, we fix it up.
 
 \begin{code}
 data OrigNameEnv
- = Orig { origNames  :: OrigNameNameEnv,
+ = Orig { origNS     :: UniqSupply,
+               -- Supply of uniques
+         origNames  :: OrigNameNameEnv,
                -- Ensures that one original name gets one unique
          origIParam :: OrigNameIParamEnv
                -- Ensures that one implicit parameter name gets one unique