[project @ 2002-02-13 15:19:17 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 dd5e350..6077dda 100644 (file)
--- 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,
 
        TyThing(..), isTyClThing, implicitTyThingIds,
 
@@ -53,7 +54,7 @@ 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
@@ -64,10 +65,10 @@ import Rules                ( RuleBase )
 import CoreSyn         ( CoreBind )
 import Id              ( Id )
 import Class           ( Class, classSelIds )
-import TyCon           ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import TyCon           ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
 import DataCon         ( dataConId, dataConWrapId )
 
-import BasicTypes      ( Version, initialVersion, Fixity, IPName )
+import BasicTypes      ( Version, initialVersion, Fixity, defaultFixity, IPName )
 
 import HsSyn           ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
 import RdrHsSyn                ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
@@ -177,7 +178,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
@@ -370,7 +371,7 @@ 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
 
@@ -492,6 +493,13 @@ 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
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *