ioMsgMaybe, ioMsg,
logWarnings, clearWarnings, hasWarnings,
SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
- handleSourceError,
+ throwOneError, handleSourceError,
reflectGhc, reifyGhc,
-- * Sessions and compilation state
PackageInstEnv, PackageRuleBase,
+
+ -- * Annotations
+ prepareAnnotations,
+
-- * Interactive context
InteractiveContext(..), emptyInteractiveContext,
icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
import Id
import Type
+import Annotations
import Class ( Class, classSelIds, classATs, classTyCon )
import TyCon
import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import StringBuffer ( StringBuffer )
import Fingerprint
import MonadUtils
-import Bag ( emptyBag, unionBags, isEmptyBag )
import Data.Dynamic ( Typeable )
import qualified Data.Dynamic as Dyn
-import Bag ( bagToList )
-import ErrUtils ( ErrorMessages, WarningMessages, Messages )
+import Bag
+import ErrUtils
import System.FilePath
import System.Time ( ClockTime )
srcErrorMessages :: SourceError -> ErrorMessages
mkApiErr :: SDoc -> GhcApiError
+throwOneError :: MonadIO m => ErrMsg -> m ab
+throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
+
-- | 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
instance ExceptionMonad Ghc where
gcatch act handle =
Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
+ gblock (Ghc m) = Ghc $ \s -> gblock (m s)
+ gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
+
instance WarnLogMonad Ghc where
setWarnings warns = Ghc $ \(Session _ wref) -> writeIORef wref warns
-- | Return 'Warnings' accumulated so far.
instance ExceptionMonad m => ExceptionMonad (GhcT m) where
gcatch act handle =
GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
+ gblock (GhcT m) = GhcT $ \s -> gblock (m s)
+ gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
instance MonadIO m => WarnLogMonad (GhcT m) where
setWarnings warns = GhcT $ \(Session _ wref) -> liftIO $ writeIORef wref warns
((warns,errs), mb_r) <- liftIO ioA
logWarnings warns
case mb_r of
- Nothing -> throw (mkSrcErr errs)
+ Nothing -> liftIO $ throwIO (mkSrcErr errs)
Just r -> ASSERT( isEmptyBag errs ) return r
-- | Lift a non-failing IO action into a 'GhcMonad'.
-- is for use in an IDE where the file hasn't been saved by
-- the user yet).
data Target = Target
- TargetId -- module or filename
- Bool -- object code allowed?
- (Maybe (StringBuffer,ClockTime)) -- in-memory text buffer?
+ { targetId :: TargetId -- ^ module or filename
+ , targetAllowObjCode :: Bool -- ^ object code allowed?
+ , targetContents :: Maybe (StringBuffer,ClockTime)
+ -- ^ in-memory text buffer?
+ }
data TargetId
= TargetModule ModuleName
-- | 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 ]
+\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}
%************************************************************************
-- 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
}
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_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_info :: !VectInfo, -- ^ Pool of vectorised declarations in the module
mi_exp_hash = fingerprint0,
mi_fixities = [],
mi_warns = NoWarnings,
+ mi_anns = [],
mi_insts = [],
mi_fam_insts = [],
mi_rules = [],
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
projects / ghc-hetmet.git / blobdiff