\section[HscTypes]{Types for the per-module compiler}
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module HscTypes (
-- * Sessions and compilation state
Session(..), withSession, modifySession,
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 {-# SOURCE #-} InteractiveEval ( Resume )
#endif
-import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..),
- mkRdrUnqual, ImpDeclSpec(..), Provenance(..),
- ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName )
+import RdrName
import Name ( Name, NamedThing, getName, nameOccName, nameModule )
import NameEnv
import NameSet
import TyCon
import DataCon ( DataCon, dataConImplicitIds )
import PrelNames ( gHC_PRIM )
-import Packages ( PackageId )
+import Packages hiding ( Version(..) )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
instance Outputable Target where
ppr = pprTarget
+pprTargetId :: TargetId -> SDoc
pprTargetId (TargetModule m) = ppr m
pprTargetId (TargetFile f _) = text f
type PackageIfaceTable = ModuleEnv ModIface
-- Domain = modules in the imported packages
+emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable = emptyUFM
+
+emptyPackageIfaceTable :: PackageIfaceTable
emptyPackageIfaceTable = emptyModuleEnv
data HomeModInfo
-- 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
md_vect_info :: !VectInfo -- Vectorisation information
}
+emptyModDetails :: ModDetails
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_exports = [],
md_insts = [],
}
+emptyInteractiveContext :: InteractiveContext
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
#endif
}
-icPrintUnqual :: InteractiveContext -> PrintUnqualified
-icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
+icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
+icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)
extendInteractiveContext
%* *
%************************************************************************
+Deciding how to print names is pretty tricky. We are given a name
+P:M.T, where P is the package name, M is the defining module, and T is
+the occurrence name, and we have to decide in which form to display
+the name given a GlobalRdrEnv describing the current scope.
+
+Ideally we want to display the name in the form in which it is in
+scope. However, the name might not be in scope at all, and that's
+where it gets tricky. Here are the cases:
+
+ 1. T uniquely maps to P:M.T ---> "T"
+ 2. there is an X for which X.T uniquely maps to P:M.T ---> "X.T"
+ 3. there is no binding for "M.T" ---> "M.T"
+ 4. otherwise ---> "P:M.T"
+
+3 and 4 apply when P:M.T is not in scope. In these cases we want to
+refer to the name as "M.T", but "M.T" might mean something else in the
+current scope (e.g. if there's an "import X as M"), so to avoid
+confusion we avoid using "M.T" if there's already a binding for it.
+
+There's one further subtlety: if the module M cannot be imported
+because it is not exposed by any package, then we must refer to it as
+"P:M". This is handled by the qual_mod component of PrintUnqualified.
+
\begin{code}
-mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
-mkPrintUnqualified env = (qual_name, qual_mod)
+mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
+mkPrintUnqualified dflags env = (qual_name, qual_mod)
where
qual_name mod occ -- The (mod,occ) pair is the original name of the thing
- | [gre] <- unqual_gres, right_name gre = Nothing
+ | [gre] <- unqual_gres, right_name gre = NameUnqual
-- If there's a unique entity that's in scope unqualified with 'occ'
-- AND that entity is the right one, then we can use the unqualified name
- | [gre] <- qual_gres = Just (get_qual_mod (gre_prov gre))
+ | [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre))
- | null qual_gres = Just (moduleName mod)
- -- it isn't in scope at all, this probably shouldn't happen,
- -- but we'll qualify it by the original module anyway.
+ | null qual_gres =
+ if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
+ then NameNotInScope1
+ else NameNotInScope2
| otherwise = panic "mkPrintUnqualified"
where
get_qual_mod LocalDef = moduleName mod
get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
- qual_mod mod = Nothing -- For now, we never qualify module names with their packages
+ -- we can mention a module P:M without the P: qualifier iff
+ -- "import M" would resolve unambiguously to P:M. (if P is the
+ -- current package we can just assume it is unqualified).
+
+ qual_mod mod
+ | modulePackageId mod == thisPackage dflags = False
+
+ | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup,
+ exposed pkg && exposed_module],
+ packageConfigId pkgconfig == modulePackageId mod
+ -- this says: we are given a module P:M, is there just one exposed package
+ -- that exposes a module M, and is it package P?
+ = False
+
+ | otherwise = True
+ where lookup = lookupModuleInAllPackages dflags (moduleName mod)
\end{code}
%************************************************************************
\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 id) = []
-
- -- 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 tc
- = map ATyCon . catMaybes $ [newTyConCo_maybe tc,
- tyConFamilyCoercion_maybe tc]
-
-extras_plus thing = thing : implicitTyThings thing
-
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
= extendNameEnvList env [(getName id, AnId id) | id <- ids]
\end{code}
\begin{code}
+tyThingTyCon :: TyThing -> TyCon
tyThingTyCon (ATyCon tc) = tc
-tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other)
+tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other)
+tyThingClass :: TyThing -> Class
tyThingClass (AClass cls) = cls
-tyThingClass other = pprPanic "tyThingClass" (ppr other)
+tyThingClass other = pprPanic "tyThingClass" (pprTyThing other)
+tyThingDataCon :: TyThing -> DataCon
tyThingDataCon (ADataCon dc) = dc
-tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other)
+tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other)
+tyThingId :: TyThing -> Id
tyThingId (AnId id) = id
-tyThingId other = pprPanic "tyThingId" (ppr other)
+tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}
%************************************************************************
add_imp bndr env = extendOccEnv env bndr (decl_name, v)
emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
-emptyIfaceVerCache occ = Nothing
+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 NoDeprecs = \n -> Nothing
-mkIfaceDepCache (DeprecAll t) = \n -> Just t
+mkIfaceDepCache :: Deprecations -> Name -> Maybe DeprecTxt
+mkIfaceDepCache NoDeprecs = \_ -> Nothing
+mkIfaceDepCache (DeprecAll t) = \_ -> Just t
mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
emptyIfaceDepCache :: Name -> Maybe DeprecTxt
-emptyIfaceDepCache n = Nothing
+emptyIfaceDepCache _ = Nothing
plusDeprecs :: Deprecations -> Deprecations -> Deprecations
plusDeprecs d NoDeprecs = d
plusDeprecs NoDeprecs d = d
-plusDeprecs d (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) d = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
+plusDeprecs _ (DeprecAll t) = DeprecAll t
+plusDeprecs (DeprecAll t) _ = DeprecAll t
+plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 ++ v2)
\end{code}
availNames :: GenAvailInfo name -> [name]
availNames (Avail n) = [n]
-availNames (AvailTC n ns) = ns
+availNames (AvailTC _ ns) = ns
instance Outputable n => Outputable (GenAvailInfo n) where
ppr = pprAvail
env = mkOccEnv pairs
emptyIfaceFixCache :: OccName -> Fixity
-emptyIfaceFixCache n = defaultFixity
+emptyIfaceFixCache _ = defaultFixity
-- This fixity environment is for source code only
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}
| BCOs CompiledByteCode ModBreaks
#ifndef GHCI
-data CompiledByteCode = NoByteCode
+data CompiledByteCode
#endif
instance Outputable Unlinked where
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
#ifdef GHCI
- ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
+ ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
#else
- ppr (BCOs bcos _) = text "No byte code"
+ ppr (BCOs _ _) = text "No byte code"
#endif
+isObject :: Unlinked -> Bool
isObject (DotO _) = True
isObject (DotA _) = True
isObject (DotDLL _) = True
isObject _ = False
+isInterpretable :: Unlinked -> Bool
isInterpretable = not . isObject
+nameOfObject :: Unlinked -> FilePath
nameOfObject (DotO fn) = fn
nameOfObject (DotA fn) = fn
nameOfObject (DotDLL fn) = fn
nameOfObject other = pprPanic "nameOfObject" (ppr other)
+byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject (BCOs bc _) = bc
byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
\end{code}
projects / ghc-hetmet.git / blobdiff