[project @ 2000-04-05 16:25:51 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 0f47641..4bd6122 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -21,7 +21,7 @@ import HsTypes                ( getTyVarName, replaceTyVarName )
 import RnMonad
 import Name            ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
                          ImportReason(..), getSrcLoc, 
-                         mkLocalName, mkImportedLocalName, mkGlobalName,
+                         mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
                          mkIPName, isSystemName,
                          nameOccName, setNameModule, nameModule,
                          pprOccName, isLocallyDefined, nameUnique, nameOccName,
@@ -590,7 +590,7 @@ mkExportAvails mod_name unqual_imp name_env avails
 
 plusExportAvails ::  ExportAvails ->  ExportAvails ->  ExportAvails
 plusExportAvails (m1, e1) (m2, e2)
-  = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
+  = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
        -- ToDo: wasteful: we do this once for each constructor!
 \end{code}
 
@@ -599,12 +599,24 @@ plusExportAvails (m1, e1) (m2, e2)
 
 \begin{code}
 plusAvail (Avail n1)      (Avail n2)       = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
+plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
 -- Added SOF 4/97
 #ifdef DEBUG
 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
 #endif
 
+addAvail :: AvailEnv -> AvailInfo -> AvailEnv
+addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
+
+emptyAvailEnv = emptyNameEnv
+unitAvailEnv :: AvailInfo -> AvailEnv
+unitAvailEnv a = unitNameEnv (availName a) a
+
+plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
+plusAvailEnv = plusNameEnv_C plusAvail
+
+availEnvElts = nameEnvElts
+
 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
 
@@ -619,6 +631,10 @@ availNames :: AvailInfo -> [Name]
 availNames (Avail n)      = [n]
 availNames (AvailTC n ns) = ns
 
+addSysAvails :: AvailInfo -> [Name] -> AvailInfo
+addSysAvails avail          []  = avail
+addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
+
 filterAvail :: RdrNameIE       -- Wanted
            -> AvailInfo        -- Available
            -> Maybe AvailInfo  -- Resulting available; 
@@ -654,20 +670,12 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
 
 filterAvail ie avail = Nothing
 
+pprAvail :: AvailInfo -> SDoc
+pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
+                                       []  -> empty
+                                       ns' -> parens (hsep (punctuate comma (map ppr ns')))
 
--- In interfaces, pprAvail gets given the OccName of the "host" thing
-pprAvail avail = getPprStyle $ \ sty ->
-                if ifaceStyle sty then
-                   ppr_avail (pprOccName . nameOccName) avail
-                else
-                   ppr_avail ppr avail
-
-ppr_avail pp_name (AvailTC n ns) = hsep [
-                                    pp_name n,
-                                    parens  $ hsep $ punctuate comma $
-                                    map pp_name ns
-                                  ]
-ppr_avail pp_name (Avail n) = pp_name n
+pprAvail (Avail n) = ppr n
 \end{code}