HomeSymbolTable, emptySymbolTable,
PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
- lookupIface, lookupIfaceByModName,
+ lookupIface, lookupIfaceByModName, moduleNameToModule,
emptyModIface,
InteractiveContext(..),
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo, lookupVersion,
+ FixityEnv, lookupFixity, collectFixities,
TyThing(..), isTyClThing, implicitTyThingIds,
NameSupply(..), OrigNameCache, OrigIParamCache,
Avails, AvailEnv, emptyAvailEnv,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
+ ExportItem, RdrExportItem,
PersistentCompilerState(..),
Deprecations(..), lookupDeprec,
#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 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 Maybes ( seqMaybe, orElse, expectJust )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import Util ( thenCmp, sortLt, unJust )
+import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply )
+import Maybe ( fromJust )
\end{code}
%************************************************************************
showModMsg :: Bool -> Module -> ModuleLocation -> String
showModMsg use_object mod location =
mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
- ++" ( " ++ unJust "showModMsg" (ml_hs_file location) ++ ", "
+ ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", "
++ (if use_object
- then unJust "showModMsg" (ml_obj_file location)
+ then expectJust "showModMsg" (ml_obj_file location)
else "interpreted")
++ " )"
where mod_str = moduleUserString mod
mi_boot :: !IsBootInterface, -- read from an hi-boot file?
- mi_usages :: ![ImportVersion Name],
+ mi_usages :: [ImportVersion Name],
-- Usages; kept sorted so that it's easy to decide
-- whether to write a new iface file (changing usages
-- doesn't affect the version of this module)
+ -- NOT STRICT! we read this field lazilly from the interface file
- mi_exports :: ![(ModuleName,Avails)],
+ mi_exports :: ![ExportItem],
-- What it exports Kept sorted by (mod,occ), to make
-- version comparisons easier
-- Its top level environment or Nothing if we read this
-- interface from a file.
- mi_fixities :: !(NameEnv Fixity), -- Fixities
- mi_deprecs :: !Deprecations, -- Deprecations
+ mi_fixities :: !FixityEnv, -- Fixities
+ mi_deprecs :: Deprecations, -- Deprecations
+ -- NOT STRICT! we read this field lazilly from the interface file
mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
-- NOT STRICT! we fill this field with _|_ sometimes
-- We often have two IfaceTables, and want to do a lookup
lookupIfaceByModName hit pit mod
= lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod
+
+-- Use instead of Finder.findModule if possible: this way doesn't
+-- require filesystem operations, and it is guaranteed not to fail
+-- when the IfaceTables are properly populated (i.e. after the renamer).
+moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName
+ -> Module
+moduleNameToModule hit pit mod
+ = mi_module (fromJust (lookupIfaceByModName hit pit mod))
\end{code}
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}
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
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}
+
%************************************************************************
%* *
-\subsection{ModIface}
+\subsection{WhatsImported}
%* *
%************************************************************************
projects / ghc-hetmet.git / blobdiff