ModuleGraph, emptyMG,
ModDetails(..), emptyModDetails,
- ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+ ModGuts(..), CoreModule(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+ ImportedMods,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
emptyIfaceDepCache,
- Deprecs(..), IfaceDeprecs,
-
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
implicitTyThings, isImplicitTyThing,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
IfaceExport,
- Deprecations, DeprecTxt, plusDeprecs,
+ Deprecations(..), DeprecTxt, plusDeprecs,
PackageInstEnv, PackageRuleBase,
import Class ( Class, classSelIds, classATs, classTyCon )
import TyCon
-import DataCon ( DataCon, dataConImplicitIds )
+import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import PrelNames ( gHC_PRIM )
import Packages hiding ( Version(..) )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import IfaceSyn
import FiniteMap ( FiniteMap )
import CoreSyn ( CoreRule )
-import Maybes ( orElse, expectJust, catMaybes, seqMaybe )
+import Maybes ( orElse, expectJust, catMaybes )
import Outputable
import BreakArray
import SrcLoc ( SrcSpan, Located )
-import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
+import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
import StringBuffer ( StringBuffer )
+import System.FilePath
import System.Time ( ClockTime )
import Data.IORef
import Data.Array ( Array, array )
import Data.List
+import Control.Monad ( mplus )
\end{code}
-- in the HPT. If it's not from the home package it's wrong to look
-- in the HPT, because the HPT is indexed by *ModuleName* not Module
fmap hm_iface (lookupUFM hpt (moduleName mod))
- `seqMaybe` lookupModuleEnv pit mod
+ `mplus` lookupModuleEnv pit mod
| otherwise = lookupModuleEnv pit mod -- Look in PIT only
-- (a) In OneShot mode, even home-package modules accumulate in the PIT
-- (b) Even in Batch (--make) mode, there is *one* case where a home-package
-- module is in the PIT, namely GHC.Prim when compiling the base package.
--- We could eliminate (b) if we wanted, by making GHC.Prim belong to a packake
+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
-- of its own, but it doesn't seem worth the bother.
\end{code}
-- NOT STRICT! we read this field lazily from the interface file
-- Deprecations
- mi_deprecs :: IfaceDeprecs,
+ mi_deprecs :: Deprecations,
-- NOT STRICT! we read this field lazily from the interface file
-- Type, class and variable declarations
-- being compiled right now. Once it is compiled, a ModIface and
-- ModDetails are extracted and the ModGuts is dicarded.
+type ImportedMods = ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)])
+
data ModGuts
= ModGuts {
mg_module :: !Module,
mg_exports :: ![AvailInfo], -- What it exports
mg_deps :: !Dependencies, -- What is below it, directly or
-- otherwise
- mg_dir_imps :: ![Module], -- Directly-imported modules; used to
+ mg_dir_imps :: !ImportedMods, -- Directly-imported modules; used to
-- generate initialisation code
- mg_usages :: ![Usage], -- Version info for what it needed
+ mg_used_names:: !NameSet, -- What it needed (used in mkIface)
mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment
-- this one); c.f. tcg_fam_inst_env
}
+-- A CoreModule consists of just the fields of a ModGuts that are needed for
+-- the compileToCoreModule interface.
+data CoreModule
+ = CoreModule {
+ -- Module name
+ cm_module :: !Module,
+ -- Type environment for types declared in this module
+ cm_types :: !TypeEnv,
+ -- Declarations
+ cm_binds :: [CoreBind],
+ -- Imports
+ cm_imports :: ![Module]
+ }
+
+instance Outputable CoreModule where
+ ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
+ text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
+
-- The ModGuts takes on several slightly different forms:
--
-- After simplification, the following fields change slightly:
%************************************************************************
\begin{code}
+-- N.B. the set of TyThings returned here *must* match the set of
+-- names returned by LoadIface.ifaceDeclSubBndrs, in the sense that
+-- TyThing.getOccName should define a bijection between the two lists.
+-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
+-- The order of the list does not matter.
implicitTyThings :: TyThing -> [TyThing]
--- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
-
-implicitTyThings (AnId _) = []
- -- For type constructors, add the data cons (and their extras),
- -- and the selectors and generic-programming Ids too
- --
- -- Newtypes don't have a worker Id, so don't generate that?
-implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
- map AnId (tyConSelIds tc) ++
- concatMap (extras_plus . ADataCon)
- (tyConDataCons tc)
+-- For data and newtype declarations:
+implicitTyThings (ATyCon tc) =
+ -- fields (names of selectors)
+ map AnId (tyConSelIds tc) ++
+ -- (possibly) implicit coercion and family coercion
+ -- depending on whether it's a newtype or a family instance or both
+ implicitCoTyCon tc ++
+ -- for each data constructor in order,
+ -- the contructor, worker, and (possibly) wrapper
+ concatMap (extras_plus . ADataCon) (tyConDataCons tc)
- -- For classes, add the class selector Ids, and assoicated TyCons
- -- and the class TyCon too (and its extras)
implicitTyThings (AClass cl)
- = map AnId (classSelIds cl) ++
+ = -- dictionary datatype:
+ -- [extras_plus:]
+ -- type constructor
+ -- [recursive call:]
+ -- (possibly) newtype coercion; definitely no family coercion here
+ -- data constructor
+ -- worker
+ -- (no wrapper by invariant)
+ extras_plus (ATyCon (classTyCon cl)) ++
+ -- associated types
+ -- No extras_plus (recursive call) for the classATs, because they
+ -- are only the family decls; they have no implicit things
map ATyCon (classATs cl) ++
- -- No extras_plus for the classATs, because they
- -- are only the family decls; they have no implicit things
- extras_plus (ATyCon (classTyCon cl))
+ -- superclass and operation selectors
+ map AnId (classSelIds cl)
+
+implicitTyThings (ADataCon dc) =
+ -- For data cons add the worker and (possibly) wrapper
+ map AnId (dataConImplicitIds dc)
+
+implicitTyThings (AnId _) = []
+
+-- add a thing and recursive call
+extras_plus :: TyThing -> [TyThing]
+extras_plus thing = thing : implicitTyThings thing
+
+-- For newtypes and indexed data types (and both),
+-- add the implicit coercion tycon
+implicitCoTyCon :: TyCon -> [TyThing]
+implicitCoTyCon tc
+ = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
+ newTyConCo_maybe tc,
+ -- Just if family instance, Nothing if not
+ tyConFamilyCoercion_maybe tc]
+
+-- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)
- -- For data cons add the worker and wrapper (if any)
-implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
-- | returns 'True' if there should be no interface-file declaration
-- for this thing on its own: either it is built-in, or it is part
isImplicitTyThing (AClass _) = False
isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
- -- For newtypes and indexed data types, add the implicit coercion tycon
-implicitCoTyCon :: TyCon -> [TyThing]
-implicitCoTyCon tc
- = map ATyCon . catMaybes $ [newTyConCo_maybe tc,
- tyConFamilyCoercion_maybe tc]
-
-extras_plus :: TyThing -> [TyThing]
-extras_plus thing = thing : implicitTyThings thing
-
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
= extendNameEnvList env [(getName id, AnId id) | id <- ids]
tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other)
tyThingId :: TyThing -> Id
-tyThingId (AnId id) = id
-tyThingId other = pprPanic "tyThingId" (pprTyThing other)
+tyThingId (AnId id) = id
+tyThingId (ADataCon dc) = dataConWrapId dc
+tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}
%************************************************************************
emptyIfaceVerCache _occ = Nothing
------------------ Deprecations -------------------------
-data Deprecs a
+data Deprecations
= NoDeprecs
- | DeprecAll DeprecTxt -- Whole module deprecated
- | DeprecSome a -- Some specific things deprecated
+ | DeprecAll DeprecTxt -- Whole module deprecated
+ | DeprecSome [(OccName,DeprecTxt)] -- Some specific things deprecated
+ -- Only an OccName is needed because
+ -- (1) a deprecation always applies to a binding
+ -- defined in the module in which the deprecation appears.
+ -- (2) deprecations are only reported outside the defining module.
+ -- this is important because, otherwise, if we saw something like
+ --
+ -- {-# DEPRECATED f "" #-}
+ -- f = ...
+ -- h = f
+ -- g = let f = undefined in f
+ --
+ -- we'd need more information than an OccName to know to say something
+ -- about the use of f in h but not the use of the locally bound f in g
+ --
+ -- however, because we only report about deprecations from the outside,
+ -- and a module can only export one value called f,
+ -- an OccName suffices.
+ --
+ -- this is in contrast with fixity declarations, where we need to map
+ -- a Name to its fixity declaration.
deriving( Eq )
-type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
-type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
- -- Keep the OccName so we can flatten the NameEnv to
- -- get an IfaceDeprecs from a Deprecations
- -- Only an OccName is needed, because a deprecation always
- -- applies to things defined in the module in which the
- -- deprecation appears.
-
-mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
+mkIfaceDepCache :: Deprecations -> Name -> Maybe DeprecTxt
mkIfaceDepCache NoDeprecs = \_ -> Nothing
mkIfaceDepCache (DeprecAll t) = \_ -> Just t
mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
plusDeprecs NoDeprecs d = d
plusDeprecs _ (DeprecAll t) = DeprecAll t
plusDeprecs (DeprecAll t) _ = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
+plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 ++ v2)
\end{code}
type FixityEnv = NameEnv FixItem
-- We keep the OccName in the range so that we can generate an interface from it
-data FixItem = FixItem OccName Fixity SrcSpan
+data FixItem = FixItem OccName Fixity
instance Outputable FixItem where
- ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
+ ppr (FixItem occ fix) = ppr fix <+> ppr occ
emptyFixityEnv :: FixityEnv
emptyFixityEnv = emptyNameEnv
lookupFixity :: FixityEnv -> Name -> Fixity
lookupFixity env n = case lookupNameEnv env n of
- Just (FixItem _ fix _) -> fix
- Nothing -> defaultFixity
+ Just (FixItem _ fix) -> fix
+ Nothing -> defaultFixity
\end{code}
showModMsg :: HscTarget -> Bool -> ModSummary -> String
showModMsg target recomp mod_summary
- = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
- char '(', text (msHsFilePath mod_summary) <> comma,
- case target of
- HscInterpreted | recomp
- -> text "interpreted"
- HscNothing -> text "nothing"
- _other -> text (msObjFilePath mod_summary),
- char ')'])
+ = showSDoc $
+ hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+ char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
+ case target of
+ HscInterpreted | recomp
+ -> text "interpreted"
+ HscNothing -> text "nothing"
+ _ -> text (normalise $ msObjFilePath mod_summary),
+ char ')']
where
mod = moduleName (ms_mod mod_summary)
mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
| BCOs CompiledByteCode ModBreaks
#ifndef GHCI
-data CompiledByteCode
+data CompiledByteCode = CompiledByteCodeUndefined
+_unused :: CompiledByteCode
+_unused = CompiledByteCodeUndefined
#endif
instance Outputable Unlinked where
projects / ghc-hetmet.git / blobdiff