\begin{code}
-- | Types for the per-module compiler
module HscTypes (
- -- * Sessions and compilation state
- Session(..), withSession, modifySession,
+ -- * compilation state
HscEnv(..), hscEPS,
FinderCache, FindResult(..), ModLocationCache,
Target(..), TargetId(..), pprTarget, pprTargetId,
-- * Information about modules
ModDetails(..), emptyModDetails,
- ModGuts(..), CoreModule(..), CgGuts(..), ForeignStubs(..),
+ ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
-- * State relating to modules in this package
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- hptInstances, hptRules, hptVectInfo,
-
+ hptInstances, hptRules, hptVectInfo,
+ hptObjs,
+
-- * State relating to known packages
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
PackageInstEnv, PackageRuleBase,
+
+ -- * Annotations
+ prepareAnnotations,
+
-- * Interactive context
InteractiveContext(..), emptyInteractiveContext,
- icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
+ icPrintUnqual, extendInteractiveContext,
substInteractiveContext,
+ mkPrintUnqualified, pprModulePrefix,
-- * Interfaces
ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
-- * TyThings and type environments
TyThing(..),
- tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
- implicitTyThings, isImplicitTyThing,
+ tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId, tyThingCoAxiom,
+ implicitTyThings, implicitTyConThings, implicitClassThings, isImplicitTyThing,
TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- typeEnvDataCons,
+ typeEnvDataCons, typeEnvCoAxioms,
-- * MonadThings
MonadThings(..),
Warnings(..), WarningTxt(..), plusWarns,
-- * Linker stuff
- Linkable(..), isObjectLinkable,
+ Linkable(..), isObjectLinkable, linkableObjs,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-- * Vectorisation information
VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
- noIfaceVectInfo
+ noIfaceVectInfo,
+
+ -- * Compilation errors and warnings
+ SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
+ throwOneError, handleSourceError,
+ handleFlagWarnings, printOrThrowWarnings,
) where
#include "HsVersions.h"
#ifdef GHCI
-import ByteCodeAsm ( CompiledByteCode )
+import ByteCodeAsm ( CompiledByteCode )
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
+import HsSyn
import RdrName
-import Name ( Name, NamedThing, getName, nameOccName, nameModule )
+import Name
import NameEnv
-import NameSet
-import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
- extendOccEnv )
+import NameSet
import Module
-import InstEnv ( InstEnv, Instance )
-import FamInstEnv ( FamInstEnv, FamInst )
-import Rules ( RuleBase )
-import CoreSyn ( CoreBind )
+import InstEnv ( InstEnv, Instance )
+import FamInstEnv ( FamInstEnv, FamInst )
+import Rules ( RuleBase )
+import CoreSyn ( CoreBind )
import VarEnv
import VarSet
import Var
import Id
-import Type
+import Type
-import Class ( Class, classSelIds, classATs, classTyCon )
+import Annotations
+import Class ( Class, classAllSelIds, classATs, classTyCon )
import TyCon
import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import PrelNames ( gHC_PRIM )
import Packages hiding ( Version(..) )
-import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
+import DynFlags ( DynFlags(..), isOneShot, HscTarget (..), dopt,
+ DynFlag(..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes ( IPName, Fixity, defaultFixity, WarningTxt(..) )
+import BasicTypes ( IPName, defaultFixity, WarningTxt(..) )
import OptimizationFuel ( OptFuelState )
import IfaceSyn
-import FiniteMap ( FiniteMap )
-import CoreSyn ( CoreRule )
+import CoreSyn ( CoreRule, CoreVect )
import Maybes ( orElse, expectJust, catMaybes )
import Outputable
import BreakArray
-import SrcLoc ( SrcSpan, Located )
-import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
+import SrcLoc
+import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString
import StringBuffer ( StringBuffer )
import Fingerprint
+import MonadUtils
+import Data.Dynamic ( Typeable )
+import qualified Data.Dynamic as Dyn
+import Bag
+import ErrUtils
import System.FilePath
import System.Time ( ClockTime )
import Data.IORef
import Data.Array ( Array, array )
import Data.List
-import Control.Monad ( mplus, guard, liftM )
-\end{code}
+import Data.Map (Map)
+import Control.Monad ( mplus, guard, liftM, when )
+import Exception
+-- -----------------------------------------------------------------------------
+-- Source Errors
-%************************************************************************
-%* *
-\subsection{Compilation environment}
-%* *
-%************************************************************************
+-- When the compiler (HscMain) discovers errors, it throws an
+-- exception in the IO monad.
+mkSrcErr :: ErrorMessages -> SourceError
+srcErrorMessages :: SourceError -> ErrorMessages
+mkApiErr :: SDoc -> GhcApiError
-\begin{code}
--- | The Session is a handle to the complete state of a compilation
--- session. A compilation session consists of a set of modules
--- constituting the current program or library, the context for
--- interactive evaluation, and various caches.
-newtype Session = Session (IORef HscEnv)
+throwOneError :: MonadIO m => ErrMsg -> m ab
+throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
-withSession :: Session -> (HscEnv -> IO a) -> IO a
-withSession (Session ref) f = do h <- readIORef ref; f h
+-- | A source error is an error that is caused by one or more errors in the
+-- source code. A 'SourceError' is thrown by many functions in the
+-- compilation pipeline. Inside GHC these errors are merely printed via
+-- 'log_action', but API clients may treat them differently, for example,
+-- insert them into a list box. If you want the default behaviour, use the
+-- idiom:
+--
+-- > handleSourceError printExceptionAndWarnings $ do
+-- > ... api calls that may fail ...
+--
+-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.
+-- This list may be empty if the compiler failed due to @-Werror@
+-- ('Opt_WarnIsError').
+--
+-- See 'printExceptionAndWarnings' for more information on what to take care
+-- of when writing a custom error handler.
+data SourceError = SourceError ErrorMessages
+
+instance Show SourceError where
+ show (SourceError msgs) = unlines . map show . bagToList $ msgs
+ -- ToDo: is there some nicer way to print this?
+
+sourceErrorTc :: Dyn.TyCon
+sourceErrorTc = Dyn.mkTyCon "SourceError"
+{-# NOINLINE sourceErrorTc #-}
+instance Typeable SourceError where
+ typeOf _ = Dyn.mkTyConApp sourceErrorTc []
+
+instance Exception SourceError
+
+mkSrcErr = SourceError
+
+-- | Perform the given action and call the exception handler if the action
+-- throws a 'SourceError'. See 'SourceError' for more information.
+handleSourceError :: (ExceptionMonad m) =>
+ (SourceError -> m a) -- ^ exception handler
+ -> m a -- ^ action to perform
+ -> m a
+handleSourceError handler act =
+ gcatch act (\(e :: SourceError) -> handler e)
+
+srcErrorMessages (SourceError msgs) = msgs
+
+-- | XXX: what exactly is an API error?
+data GhcApiError = GhcApiError SDoc
+
+instance Show GhcApiError where
+ show (GhcApiError msg) = showSDoc msg
+
+ghcApiErrorTc :: Dyn.TyCon
+ghcApiErrorTc = Dyn.mkTyCon "GhcApiError"
+{-# NOINLINE ghcApiErrorTc #-}
+instance Typeable GhcApiError where
+ typeOf _ = Dyn.mkTyConApp ghcApiErrorTc []
+
+instance Exception GhcApiError
+
+mkApiErr = GhcApiError
+
+-- | Given a bag of warnings, turn them into an exception if
+-- -Werror is enabled, or print them out otherwise.
+printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
+printOrThrowWarnings dflags warns
+ | dopt Opt_WarnIsError dflags
+ = when (not (isEmptyBag warns)) $ do
+ throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg
+ | otherwise
+ = printBagOfWarnings dflags warns
-modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
-modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
+handleFlagWarnings :: DynFlags -> [Located String] -> IO ()
+handleFlagWarnings dflags warns
+ = when (dopt Opt_WarnDeprecatedFlags dflags) $ do
+ -- It would be nicer if warns :: [Located Message], but that
+ -- has circular import problems.
+ let bag = listToBag [ mkPlainWarnMsg loc (text warn)
+ | L loc warn <- warns ]
+
+ printOrThrowWarnings dflags bag
\end{code}
\begin{code}
--- | HscEnv is like 'Session', except that some of the fields are immutable.
+-- | Hscenv is like 'Session', except that some of the fields are immutable.
-- An HscEnv is used to compile a single module from plain Haskell source
-- code (after preprocessing) to either C, assembly or C--. Things like
-- the module graph don't change during a single compilation.
-- by limiting the number of transformations,
-- we can use binary search to help find compiler bugs.
- hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
+ hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
-- ^ Used for one-shot compilation only, to initialise
-- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
-- 'TcRunTypes.TcGblEnv'
-
- hsc_global_rdr_env :: GlobalRdrEnv,
- -- ^ A mapping from 'RdrName's that are in global scope during
- -- the compilation of the current file to more detailed
- -- information about those names. Not necessarily just the
- -- names directly imported by the module being compiled!
-
- hsc_global_type_env :: TypeEnv
- -- ^ Typing information about all those things in global scope.
- -- Not necessarily just the things directly imported by the module
- -- being compiled!
}
hscEPS :: HscEnv -> IO ExternalPackageState
-- module. If so, use this instead of the file contents (this
-- is for use in an IDE where the file hasn't been saved by
-- the user yet).
-data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
+data Target = Target
+ { targetId :: TargetId -- ^ module or filename
+ , targetAllowObjCode :: Bool -- ^ object code allowed?
+ , targetContents :: Maybe (StringBuffer,ClockTime)
+ -- ^ in-memory text buffer?
+ }
data TargetId
= TargetModule ModuleName
deriving Eq
pprTarget :: Target -> SDoc
-pprTarget (Target id _) = pprTargetId id
+pprTarget (Target id obj _) =
+ (if obj then char '*' else empty) <> pprTargetId id
instance Outputable Target where
ppr = pprTarget
-- | Information about modules in the package being compiled
data HomeModInfo
- = HomeModInfo { hm_iface :: !ModIface, -- ^ The basic loaded interface file: every
- -- loaded module has one of these, even if
- -- it is imported from another package
- hm_details :: !ModDetails, -- ^ Extra information that has been created
- -- from the 'ModIface' for the module,
- -- typically during typechecking
- hm_linkable :: !(Maybe Linkable)
- -- ^ The actual artifact we would like to link to access
- -- things in this module.
- --
- -- 'hm_linkable' might be Nothing:
- --
- -- 1. If this is an .hs-boot module
- --
- -- 2. Temporarily during compilation if we pruned away
- -- the old linkable because it was out of date.
- --
- -- After a complete compilation ('GHC.load'), all 'hm_linkable'
- -- fields in the 'HomePackageTable' will be @Just@.
- --
- -- When re-linking a module ('HscMain.HscNoRecomp'), we construct
- -- the 'HomeModInfo' by building a new 'ModDetails' from the
- -- old 'ModIface' (only).
- }
+ = HomeModInfo {
+ hm_iface :: !ModIface,
+ -- ^ The basic loaded interface file: every loaded module has one of
+ -- these, even if it is imported from another package
+ hm_details :: !ModDetails,
+ -- ^ Extra information that has been created from the 'ModIface' for
+ -- the module, typically during typechecking
+ hm_linkable :: !(Maybe Linkable)
+ -- ^ The actual artifact we would like to link to access things in
+ -- this module.
+ --
+ -- 'hm_linkable' might be Nothing:
+ --
+ -- 1. If this is an .hs-boot module
+ --
+ -- 2. Temporarily during compilation if we pruned away
+ -- the old linkable because it was out of date.
+ --
+ -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
+ -- in the 'HomePackageTable' will be @Just@.
+ --
+ -- When re-linking a module ('HscMain.HscNoRecomp'), we construct the
+ -- 'HomeModInfo' by building a new 'ModDetails' from the old
+ -- 'ModIface' (only).
+ }
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
-- ^ Get rules from modules \"below\" this one (in the dependency sense)
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
+
+hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]
+-- ^ Get annotations from modules \"below\" this one (in the dependency sense)
+hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps
+hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env
+
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))
-- And get its dfuns
, thing <- things ]
+hptObjs :: HomePackageTable -> [FilePath]
+hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Dealing with Annotations}
+%* *
+%************************************************************************
+
+\begin{code}
+prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
+-- ^ Deal with gathering annotations in from all possible places
+-- and combining them into a single 'AnnEnv'
+prepareAnnotations hsc_env mb_guts
+ = do { eps <- hscEPS hsc_env
+ ; let -- Extract annotations from the module being compiled if supplied one
+ mb_this_module_anns = fmap (mkAnnEnv . mg_anns) mb_guts
+ -- Extract dependencies of the module if we are supplied one,
+ -- otherwise load annotations from all home package table
+ -- entries regardless of dependency ordering.
+ home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
+ other_pkg_anns = eps_ann_env eps
+ ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
+ Just home_pkg_anns,
+ Just other_pkg_anns]
+
+ ; return ann_env }
\end{code}
%************************************************************************
-- ^ The requested package was not found
| FoundMultiple [PackageId]
-- ^ _Error_: both in multiple packages
- | PackageHidden PackageId
- -- ^ For an explicit source import, the package containing the module is
- -- not exposed.
- | ModuleHidden PackageId
- -- ^ For an explicit source import, the package containing the module is
- -- exposed, but the module itself is hidden.
- | NotFound [FilePath] (Maybe PackageId)
- -- ^ The module was not found, the specified places were searched
- | NotFoundInPackage PackageId
- -- ^ The module was not found in this package
+
+ | NotFound -- Not found
+ { fr_paths :: [FilePath] -- Places where I looked
+
+ , fr_pkg :: Maybe PackageId -- Just p => module is in this package's
+ -- manifest, but couldn't find
+ -- the .hi file
+
+ , fr_mods_hidden :: [PackageId] -- Module is in these packages,
+ -- but the *module* is hidden
+
+ , fr_pkgs_hidden :: [PackageId] -- Module is in these packages,
+ -- but the *package* is hidden
+
+ , fr_suggestions :: [Module] -- Possible mis-spelled modules
+ }
-- | Cache that remembers where we found a particular module. Contains both
-- home modules and package modules. On @:load@, only home modules are
mi_boot :: !IsBootInterface, -- ^ Read from an hi-boot file?
mi_deps :: Dependencies,
- -- ^ The dependencies of the module, consulted for directly
- -- imported modules only
-
- -- This is consulted for directly-imported modules,
- -- but not for anything else (hence lazy)
+ -- ^ The dependencies of the module. This is
+ -- consulted for directly-imported modules, but not
+ -- for anything else (hence lazy)
+
mi_usages :: [Usage],
-- ^ Usages; kept sorted so that it's easy to decide
-- whether to write a new iface file (changing usages
-- NOT STRICT! we read this field lazily from the interface file
+ mi_anns :: [IfaceAnnotation],
+ -- ^ Annotations
+
+ -- NOT STRICT! we read this field lazily from the interface file
+
-- Type, class and variable declarations
-- The hash of an Id changes if its fixity or deprecations change
-- (as well as its type of course)
md_insts :: ![Instance], -- ^ 'DFunId's for the instances in this module
md_fam_insts :: ![FamInst],
md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules
+ md_anns :: ![Annotation], -- ^ Annotations present in this module: currently
+ -- they only annotate things also declared in this module
md_vect_info :: !VectInfo -- ^ Module vectorisation information
}
md_insts = [],
md_rules = [],
md_fam_insts = [],
+ md_anns = [],
md_vect_info = noVectInfo
}
-- | A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
-- being compiled right now. Once it is compiled, a 'ModIface' and
--- 'ModDetails' are extracted and the ModGuts is dicarded.
+-- 'ModDetails' are extracted and the ModGuts is discarded.
data ModGuts
= ModGuts {
mg_module :: !Module, -- ^ Module being compiled
mg_insts :: ![Instance], -- ^ Class instances declared in this module
mg_fam_insts :: ![FamInst], -- ^ Family instances declared in this module
mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains
- -- rules declared in this module. After the core
- -- pipeline starts, it is changed to contain all
- -- known rules for those things imported
+ -- See Note [Overall plumbing for rules] in Rules.lhs
mg_binds :: ![CoreBind], -- ^ Bindings for this module
mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module
mg_warns :: !Warnings, -- ^ Warnings declared in the module
- mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
+ mg_anns :: [Annotation], -- ^ Annotations declared in this module
+ mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
mg_modBreaks :: !ModBreaks, -- ^ Breakpoints for the module
+ mg_vect_decls:: ![CoreVect], -- ^ Vectorisation declarations in this module
+ -- (produced by desugarer & consumed by vectoriser)
mg_vect_info :: !VectInfo, -- ^ Pool of vectorised declarations in the module
-- The next two fields are unusual, because they give instance
-- mg_rules Orphan rules only (local ones now attached to binds)
-- mg_binds With rules attached
--- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
--- the 'GHC.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:
-- data constructor workers; reason: we we regard them
-- as part of the code-gen of tycons
- cg_dir_imps :: ![Module],
- -- ^ Directly-imported modules; used to generate
- -- initialisation code
-
- cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
+ cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
cg_dep_pkgs :: ![PackageId], -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
--
-- 2) C stubs to use when calling
-- "foreign exported" functions
+
+appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
+appendStubC NoStubs c_code = ForeignStubs empty c_code
+appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
\end{code}
\begin{code}
mi_exp_hash = fingerprint0,
mi_fixities = [],
mi_warns = NoWarnings,
+ mi_anns = [],
mi_insts = [],
mi_fam_insts = [],
mi_rules = [],
%************************************************************************
\begin{code}
--- | Interactive context, recording information relevant to GHCi
+-- | Interactive context, recording information about the state of the
+-- context in which statements are executed in a GHC session.
+--
data InteractiveContext
= InteractiveContext {
- ic_toplev_scope :: [Module], -- ^ The context includes the "top-level" scope of
- -- these modules
-
- ic_exports :: [Module], -- ^ The context includes just the exports of these
- -- modules
-
- ic_rn_gbl_env :: GlobalRdrEnv, -- ^ The contexts' cached 'GlobalRdrEnv', built from
- -- 'ic_toplev_scope' and 'ic_exports'
-
- ic_tmp_ids :: [Id], -- ^ Names bound during interaction with the user.
- -- Later Ids shadow earlier ones with the same OccName.
-
- ic_tyvars :: TyVarSet -- ^ Skolem type variables free in
- -- 'ic_tmp_ids'. These arise at
- -- breakpoints in a polymorphic
- -- context, where we have only partial
- -- type information.
+ -- These two fields are only stored here so that the client
+ -- can retrieve them with GHC.getContext. GHC itself doesn't
+ -- use them, but it does reset them to empty sometimes (such
+ -- as before a GHC.load). The context is set with GHC.setContext.
+ ic_toplev_scope :: [Module],
+ -- ^ The context includes the "top-level" scope of
+ -- these modules
+ ic_imports :: [ImportDecl RdrName],
+ -- ^ The context is extended with these import declarations
+
+ ic_rn_gbl_env :: GlobalRdrEnv,
+ -- ^ The contexts' cached 'GlobalRdrEnv', built by
+ -- 'InteractiveEval.setContext'
+
+ ic_tmp_ids :: [Id],
+ -- ^ Names bound during interaction with the user. Later
+ -- Ids shadow earlier ones with the same OccName
+ -- Expressions are typed with these Ids in the envt For
+ -- runtime-debugging, these Ids may have free TcTyVars of
+ -- RuntimUnkSkol flavour, but no free TyVars (because the
+ -- typechecker doesn't expect that)
#ifdef GHCI
- , ic_resume :: [Resume] -- ^ The stack of breakpoint contexts
+ ic_resume :: [Resume],
+ -- ^ The stack of breakpoint contexts
#endif
+
+ ic_cwd :: Maybe FilePath
+ -- virtual CWD of the program
}
emptyInteractiveContext :: InteractiveContext
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
- ic_exports = [],
+ ic_imports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
- ic_tmp_ids = [],
- ic_tyvars = emptyVarSet
+ ic_tmp_ids = []
#ifdef GHCI
, ic_resume = []
#endif
+ , ic_cwd = Nothing
}
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
extendInteractiveContext
:: InteractiveContext
-> [Id]
- -> TyVarSet
-> InteractiveContext
-extendInteractiveContext ictxt ids tyvars
- = ictxt { ic_tmp_ids = ic_tmp_ids ictxt ++ ids,
+extendInteractiveContext ictxt ids
+ = ictxt { ic_tmp_ids = snub ((ic_tmp_ids ictxt \\ ids) ++ ids)
-- NB. must be this way around, because we want
-- new ids to shadow existing bindings.
- ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars }
-
+ }
+ where snub = map head . group . sort
substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
-substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst =
- let ids' = map (\id -> id `setIdType` substTy subst (idType id)) ids
- subst_dom= varEnvKeys$ getTvSubstEnv subst
- subst_ran= varEnvElts$ getTvSubstEnv subst
- new_tvs = [ tv | Just tv <- map getTyVar_maybe subst_ran]
- ic_tyvars'= (`delVarSetListByKey` subst_dom)
- . (`extendVarSetList` new_tvs)
- $ ic_tyvars ictxt
- in ictxt { ic_tmp_ids = ids'
- , ic_tyvars = ic_tyvars' }
-
- where delVarSetListByKey = foldl' delVarSetByKey
+substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst
+ = ictxt { ic_tmp_ids = map subst_ty ids }
+ where
+ subst_ty id = id `setIdType` substTy subst (idType id)
\end{code}
%************************************************************************
%* *
%************************************************************************
+Note [Printing original names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
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.
+ 1. T uniquely maps to P:M.T ---> "T" NameUnqual
+ 2. There is an X for which X.T
+ uniquely maps to P:M.T ---> "X.T" NameQual X
+ 3. There is no binding for "M.T" ---> "M.T" NameNotInScope1
+ 4. Otherwise ---> "P:M.T" NameNotInScope2
+
+(3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at
+all. In these cases we still 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. Instead we write P:M.T.
+
+There's one further subtlety: in case (3), what if there are two
+things around, P1:M.T and P2:M.T? Then we don't want to print both of
+them as M.T! However only one of the modules P1:M and P2:M can be
+exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
+This is handled by the qual_mod component of PrintUnqualified, inside
+the (ppr mod) of case (3), in Name.pprModulePrefix
\begin{code}
-- | Creates some functions that work out the best ways to format
| otherwise = panic "mkPrintUnqualified"
where
- right_name gre = nameModule (gre_name gre) == mod
+ right_name gre = nameModule_maybe (gre_name gre) == Just mod
unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
qual_gres = filter right_name (lookupGlobalRdrEnv env occ)
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
-- The order of the list does not matter.
implicitTyThings :: TyThing -> [TyThing]
-
--- 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)
-
-implicitTyThings (AClass cl)
- = -- dictionary datatype:
+implicitTyThings (AnId _) = []
+implicitTyThings (ACoAxiom _cc) = []
+implicitTyThings (ATyCon tc) = implicitTyConThings tc
+implicitTyThings (AClass cl) = implicitClassThings cl
+implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
+ -- For data cons add the worker and (possibly) wrapper
+
+implicitClassThings :: Class -> [TyThing]
+implicitClassThings cl
+ = -- Does not include default methods, because those Ids may have
+ -- their own pragmas, unfoldings etc, not derived from the Class object
+ -- Dictionary datatype:
-- [extras_plus:]
-- type constructor
-- [recursive call:]
-- are only the family decls; they have no implicit things
map ATyCon (classATs cl) ++
-- superclass and operation selectors
- map AnId (classSelIds cl)
+ map AnId (classAllSelIds cl)
-implicitTyThings (ADataCon dc) =
- -- For data cons add the worker and (possibly) wrapper
- map AnId (dataConImplicitIds dc)
+implicitTyConThings :: TyCon -> [TyThing]
+implicitTyConThings tc
+ = -- fields (names of selectors)
+ -- (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)
-implicitTyThings (AnId _) = []
-- add a thing and recursive call
extras_plus :: TyThing -> [TyThing]
-- add the implicit coercion tycon
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon tc
- = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
- newTyConCo_maybe tc,
+ = map ACoAxiom . catMaybes $ [-- Just if newtype, Nothing if not
+ newTyConCo_maybe tc,
-- Just if family instance, Nothing if not
- tyConFamilyCoercion_maybe tc]
+ tyConFamilyCoercion_maybe tc]
-- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)
-- of some other declaration, or it is generated implicitly by some
-- other declaration.
isImplicitTyThing :: TyThing -> Bool
-isImplicitTyThing (ADataCon _) = True
-isImplicitTyThing (AnId id) = isImplicitId id
-isImplicitTyThing (AClass _) = False
-isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
+isImplicitTyThing (ADataCon {}) = True
+isImplicitTyThing (AnId id) = isImplicitId id
+isImplicitTyThing (AClass {}) = False
+isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
+isImplicitTyThing (ACoAxiom {}) = True
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
typeEnvElts :: TypeEnv -> [TyThing]
typeEnvClasses :: TypeEnv -> [Class]
typeEnvTyCons :: TypeEnv -> [TyCon]
+typeEnvCoAxioms :: TypeEnv -> [CoAxiom]
typeEnvIds :: TypeEnv -> [Id]
typeEnvDataCons :: TypeEnv -> [DataCon]
lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
typeEnvElts env = nameEnvElts env
typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
+typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]
typeEnvIds env = [id | AnId id <- typeEnvElts env]
typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env]
lookupNameEnv (md_types (hm_details hm)) name
| otherwise
= lookupNameEnv pte name
- where mod = nameModule name
+ where mod = ASSERT( isExternalName name ) nameModule name
this_pkg = thisPackage dflags
-- | As 'lookupType', but with a marginally easier-to-use interface
lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
lookupTypeHscEnv hsc_env name = do
eps <- readIORef (hsc_EPS hsc_env)
- return $ lookupType dflags hpt (eps_PTE eps) name
+ return $! lookupType dflags hpt (eps_PTE eps) name
where
dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
tyThingTyCon (ATyCon tc) = tc
tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other)
+-- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
+tyThingCoAxiom :: TyThing -> CoAxiom
+tyThingCoAxiom (ACoAxiom ax) = ax
+tyThingCoAxiom other = pprPanic "tyThingCoAxiom" (pprTyThing other)
+
-- | Get the 'Class' from a 'TyThing' if it is a class thing. Panics otherwise
tyThingClass :: TyThing -> Class
tyThingClass (AClass cls) = cls
type PackageInstEnv = InstEnv
type PackageFamInstEnv = FamInstEnv
type PackageVectInfo = VectInfo
+type PackageAnnEnv = AnnEnv
-- | Information about other packages that we have slurped in by reading
-- their interface files
-- from all the external-package modules
eps_vect_info :: !PackageVectInfo, -- ^ The total 'VectInfo' accumulated
-- from all the external-package modules
+ eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated
+ -- from all the external-package modules
eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external
-- packages, keyed off the module that declared them
type OrigNameCache = ModuleEnv (OccEnv Name)
-- | Module-local cache of implicit parameter 'OccName's given 'Name's
-type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
+type OrigIParamCache = Map (IPName OccName) (IPName Name)
\end{code}
-- There will be a node for each source module, plus a node for each hi-boot
-- module.
--
--- The graph is not necessarily stored in topologically-sorted order.
+-- The graph is not necessarily stored in topologically-sorted order. Use
+-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.
type ModuleGraph = [ModSummary]
emptyMG :: ModuleGraph
ms_location :: ModLocation, -- ^ Location of the various files belonging to the module
ms_hs_date :: ClockTime, -- ^ Timestamp of source file
ms_obj_date :: Maybe ClockTime, -- ^ Timestamp of object, if we have one
- ms_srcimps :: [Located ModuleName], -- ^ Source imports of the module
- ms_imps :: [Located ModuleName], -- ^ Non-source imports of the module
+ ms_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module
+ ms_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module
ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file
ms_hspp_opts :: DynFlags, -- ^ Cached flags from @OPTIONS@, @INCLUDE@
-- and @LANGUAGE@ pragmas in the modules source code
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Vectorisation Support}
-%* *
+%* *
%************************************************************************
The following information is generated and consumed by the vectorisation
on just the OccName easily in a Core pass.
\begin{code}
--- | Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'.
--- All of this information is always tidy, even in ModGuts.
+-- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also
+-- documentation at 'Vectorise.Env.GlobalEnv'.
data VectInfo
- = VectInfo {
- vectInfoVar :: VarEnv (Var , Var ), -- ^ @(f, f_v)@ keyed on @f@
- vectInfoTyCon :: NameEnv (TyCon , TyCon), -- ^ @(T, T_v)@ keyed on @T@
- vectInfoDataCon :: NameEnv (DataCon, DataCon), -- ^ @(C, C_v)@ keyed on @C@
- vectInfoPADFun :: NameEnv (TyCon , Var), -- ^ @(T_v, paT)@ keyed on @T_v@
- vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@
+ = VectInfo
+ { vectInfoVar :: VarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@
+ , vectInfoTyCon :: NameEnv (TyCon , TyCon) -- ^ @(T, T_v)@ keyed on @T@
+ , vectInfoDataCon :: NameEnv (DataCon, DataCon) -- ^ @(C, C_v)@ keyed on @C@
+ , vectInfoPADFun :: NameEnv (TyCon , Var) -- ^ @(T_v, paT)@ keyed on @T_v@
+ , vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@
+ , vectInfoScalarVars :: VarSet -- ^ set of purely scalar variables
+ , vectInfoScalarTyCons :: NameSet -- ^ set of scalar type constructors
}
--- | Vectorisation information for 'ModIface': a slightly less low-level view
+-- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
+-- across module boundaries.
+--
data IfaceVectInfo
- = IfaceVectInfo {
- ifaceVectInfoVar :: [Name],
- -- ^ All variables in here have a vectorised variant
- ifaceVectInfoTyCon :: [Name],
- -- ^ All 'TyCon's in here have a vectorised variant;
- -- the name of the vectorised variant and those of its
- -- data constructors are determined by 'OccName.mkVectTyConOcc'
- -- and 'OccName.mkVectDataConOcc'; the names of
- -- the isomorphisms are determined by 'OccName.mkVectIsoOcc'
- ifaceVectInfoTyConReuse :: [Name]
- -- ^ The vectorised form of all the 'TyCon's in here coincides with
- -- the unconverted form; the name of the isomorphisms is determined
- -- by 'OccName.mkVectIsoOcc'
+ = IfaceVectInfo
+ { ifaceVectInfoVar :: [Name] -- ^ All variables in here have a vectorised variant
+ , ifaceVectInfoTyCon :: [Name] -- ^ All 'TyCon's in here have a vectorised variant;
+ -- the name of the vectorised variant and those of its
+ -- data constructors are determined by
+ -- 'OccName.mkVectTyConOcc' and
+ -- 'OccName.mkVectDataConOcc'; the names of the
+ -- isomorphisms are determined by 'OccName.mkVectIsoOcc'
+ , ifaceVectInfoTyConReuse :: [Name] -- ^ The vectorised form of all the 'TyCon's in here
+ -- coincides with the unconverted form; the name of the
+ -- isomorphisms is determined by 'OccName.mkVectIsoOcc'
+ , ifaceVectInfoScalarVars :: [Name] -- iface version of 'vectInfoScalarVar'
+ , ifaceVectInfoScalarTyCons :: [Name] -- iface version of 'vectInfoScalarTyCon'
}
noVectInfo :: VectInfo
-noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
+noVectInfo
+ = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyVarSet
+ emptyNameSet
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
plusVectInfo vi1 vi2 =
- VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
- (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
- (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
- (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
- (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
+ VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
+ (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
+ (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
+ (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
+ (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
+ (vectInfoScalarVars vi1 `unionVarSet` vectInfoScalarVars vi2)
+ (vectInfoScalarTyCons vi1 `unionNameSets` vectInfoScalarTyCons vi2)
concatVectInfo :: [VectInfo] -> VectInfo
concatVectInfo = foldr plusVectInfo noVectInfo
noIfaceVectInfo :: IfaceVectInfo
-noIfaceVectInfo = IfaceVectInfo [] [] []
+noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
\end{code}
%************************************************************************
-- (i.e. when the bytecodes were produced,
-- or the mod date on the files)
linkableModule :: Module, -- ^ The linkable module itself
- linkableUnlinked :: [Unlinked] -- ^ Those files and chunks of code we have
- -- yet to link
+ linkableUnlinked :: [Unlinked]
+ -- ^ Those files and chunks of code we have yet to link.
+ --
+ -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.
+ -- If this list is empty, the Linkable represents a fake linkable, which
+ -- is generated in HscNothing mode to avoid recompiling modules.
+ --
+ -- XXX: Do items get removed from this list when they get linked?
}
isObjectLinkable :: Linkable -> Bool
-- compiling a module in HscNothing mode, and this choice
-- happens to work well with checkStability in module GHC.
+linkableObjs :: Linkable -> [FilePath]
+linkableObjs l = [ f | DotO f <- linkableUnlinked l ]
+
instance Outputable Linkable where
ppr (LM when_made mod unlinkeds)
= (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
-- ^ An array giving the source span of each breakpoint.
, modBreaks_vars :: !(Array BreakIndex [OccName])
-- ^ An array giving the names of the free variables at each breakpoint.
+ , modBreaks_decls :: !(Array BreakIndex [String])
+ -- ^ An array giving the names of the declarations enclosing each breakpoint.
}
emptyModBreaks :: ModBreaks
emptyModBreaks = ModBreaks
{ modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
-- Todo: can we avoid this?
- , modBreaks_locs = array (0,-1) []
- , modBreaks_vars = array (0,-1) []
+ , modBreaks_locs = array (0,-1) []
+ , modBreaks_vars = array (0,-1) []
+ , modBreaks_decls = array (0,-1) []
}
\end{code}
projects / ghc-hetmet.git / blobdiff