SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
throwOneError, handleSourceError,
reflectGhc, reifyGhc,
+ handleFlagWarnings,
-- * Sessions and compilation state
- Session(..), withSession, modifySession,
+ Session(..), withSession, modifySession, withTempSession,
HscEnv(..), hscEPS,
FinderCache, FindResult(..), ModLocationCache,
Target(..), TargetId(..), pprTarget, pprTargetId,
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 OptimizationFuel ( OptFuelState )
import Maybes ( orElse, expectJust, catMaybes )
import Outputable
import BreakArray
-import SrcLoc ( SrcSpan, Located )
+import SrcLoc ( SrcSpan, Located(..) )
import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString
import Data.IORef
import Data.Array ( Array, array )
import Data.List
-import Control.Monad ( mplus, guard, liftM )
+import Control.Monad ( mplus, guard, liftM, when )
import Exception
\end{code}
modifySession f = do h <- getSession
setSession $! f h
+withSavedSession :: GhcMonad m => m a -> m a
+withSavedSession m = do
+ saved_session <- getSession
+ m `gfinally` setSession saved_session
+
+-- | Call an action with a temporarily modified Session.
+withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
+withTempSession f m =
+ withSavedSession $ modifySession f >> m
+
-- | A minimal implementation of a 'GhcMonad'. If you need a custom monad,
-- e.g., to maintain additional state consider wrapping this monad or using
-- 'GhcT'.
-- > Dual to 'reflectGhc'. See its documentation.
reifyGhc :: (Session -> IO a) -> Ghc a
reifyGhc act = Ghc $ act
+
+handleFlagWarnings :: GhcMonad m => DynFlags -> [Located String] -> m ()
+handleFlagWarnings dflags warns
+ = when (dopt Opt_WarnDeprecatedFlags dflags)
+ (handleFlagWarnings' dflags warns)
+
+handleFlagWarnings' :: GhcMonad m => DynFlags -> [Located String] -> m ()
+handleFlagWarnings' _ [] = return ()
+handleFlagWarnings' dflags warns
+ = do -- It would be nicer if warns :: [Located Message], but that has circular
+ -- import problems.
+ logWarnings $ listToBag (map mkFlagWarning warns)
+ when (dopt Opt_WarnIsError dflags) $
+ liftIO $ throwIO $ mkSrcErr emptyBag
+
+mkFlagWarning :: Located String -> WarnMsg
+mkFlagWarning (L loc warn)
+ = mkPlainWarnMsg loc (text warn)
\end{code}
\begin{code}
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
-- (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