implementing fallback from Simple to Intelligent.
This commit is contained in:
parent
5abd75ea7d
commit
981051a642
@ -8,18 +8,27 @@ import DynFlags (ExtensionFlag(..), xopt)
|
|||||||
import GHC (DynFlags(..), LoadHowMuch(..))
|
import GHC (DynFlags(..), LoadHowMuch(..))
|
||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import Language.Haskell.GhcMod.DynFlags
|
import Language.Haskell.GhcMod.DynFlags
|
||||||
import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
|
import Language.Haskell.GhcMod.Monad
|
||||||
|
|
||||||
-- | Set the files as targets and load them.
|
-- | Set the files as targets and load them.
|
||||||
setTargetFiles :: IOish m => [FilePath] -> GhcModT m ()
|
setTargetFiles :: IOish m => [FilePath] -> GhcModT m ()
|
||||||
setTargetFiles files = do
|
setTargetFiles files = do
|
||||||
targets <- forM files $ \file -> G.guessTarget file Nothing
|
targets <- forM files $ \file -> G.guessTarget file Nothing
|
||||||
G.setTargets targets
|
G.setTargets targets
|
||||||
xs <- G.depanal [] False
|
mode <- getMode
|
||||||
-- FIXME, checking state
|
if mode == Intelligent then
|
||||||
loadTargets $ needsFallback xs
|
loadTargets Intelligent
|
||||||
|
else do
|
||||||
|
mdls <- G.depanal [] False
|
||||||
|
let fallback = needsFallback mdls
|
||||||
|
if fallback then do
|
||||||
|
resetTargets targets
|
||||||
|
setIntelligent
|
||||||
|
loadTargets Intelligent
|
||||||
|
else
|
||||||
|
loadTargets Simple
|
||||||
where
|
where
|
||||||
loadTargets False = do
|
loadTargets Simple = do
|
||||||
-- Reporting error A and error B
|
-- Reporting error A and error B
|
||||||
void $ G.load LoadAllTargets
|
void $ G.load LoadAllTargets
|
||||||
mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
|
mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
|
||||||
@ -27,10 +36,18 @@ setTargetFiles files = do
|
|||||||
mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
|
mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
|
||||||
-- Error B duplicates. But we cannot ignore both error reportings,
|
-- Error B duplicates. But we cannot ignore both error reportings,
|
||||||
-- sigh. So, the logger makes log messages unique by itself.
|
-- sigh. So, the logger makes log messages unique by itself.
|
||||||
loadTargets True = do
|
loadTargets Intelligent = do
|
||||||
df <- G.getSessionDynFlags
|
df <- G.getSessionDynFlags
|
||||||
void $ G.setSessionDynFlags (setModeIntelligent df)
|
void $ G.setSessionDynFlags (setModeIntelligent df)
|
||||||
void $ G.load LoadAllTargets
|
void $ G.load LoadAllTargets
|
||||||
|
resetTargets targets = do
|
||||||
|
G.setTargets []
|
||||||
|
void $ G.load LoadAllTargets
|
||||||
|
G.setTargets targets
|
||||||
|
setIntelligent = do
|
||||||
|
newdf <- setModeIntelligent <$> G.getSessionDynFlags
|
||||||
|
void $ G.setSessionDynFlags newdf
|
||||||
|
setMode Intelligent
|
||||||
|
|
||||||
needsFallback :: G.ModuleGraph -> Bool
|
needsFallback :: G.ModuleGraph -> Bool
|
||||||
needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
|
needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
|
||||||
|
Loading…
Reference in New Issue
Block a user