From 6de02ea4700a700c1d5950309242ed4d44e357ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Wed, 16 Dec 2015 00:23:51 +0100 Subject: [PATCH] Cleanup loadTarget logic --- Language/Haskell/GhcMod/DynFlags.hs | 8 ++-- Language/Haskell/GhcMod/Internal.hs | 3 -- Language/Haskell/GhcMod/Monad/Types.hs | 9 ----- Language/Haskell/GhcMod/Target.hs | 52 +++++++++++--------------- Language/Haskell/GhcMod/Types.hs | 5 +-- 5 files changed, 26 insertions(+), 51 deletions(-) diff --git a/Language/Haskell/GhcMod/DynFlags.hs b/Language/Haskell/GhcMod/DynFlags.hs index f335a7c..4d54ae2 100644 --- a/Language/Haskell/GhcMod/DynFlags.hs +++ b/Language/Haskell/GhcMod/DynFlags.hs @@ -25,8 +25,8 @@ setDebugLogger put df = do -- * Friendly to foreign export -- * Not friendly to -XTemplateHaskell and -XPatternSynonyms -- * Uses little memory -setModeSimple :: DynFlags -> DynFlags -setModeSimple df = df { +setHscNothing :: DynFlags -> DynFlags +setHscNothing df = df { ghcMode = CompManager , ghcLink = NoLink , hscTarget = HscNothing @@ -37,8 +37,8 @@ setModeSimple df = df { -- * Not friendly to foreign export -- * Friendly to -XTemplateHaskell and -XPatternSynonyms -- * Uses lots of memory -setModeIntelligent :: DynFlags -> DynFlags -setModeIntelligent df = df { +setHscInterpreted :: DynFlags -> DynFlags +setHscInterpreted df = df { ghcMode = CompManager , ghcLink = LinkInMemory , hscTarget = HscInterpreted diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs index a743768..2aa4e1b 100644 --- a/Language/Haskell/GhcMod/Internal.hs +++ b/Language/Haskell/GhcMod/Internal.hs @@ -17,7 +17,6 @@ module Language.Haskell.GhcMod.Internal ( -- * Environment, state and logging , GhcModEnv(..) , GhcModState - , CompilerMode(..) , GhcModLog , GmLog(..) , GmLogLevel(..) @@ -34,8 +33,6 @@ module Language.Haskell.GhcMod.Internal ( -- ** Accessing 'GhcModEnv' and 'GhcModState' , options , cradle - , getCompilerMode - , setCompilerMode , targetGhcOptions , withOptions -- * 'GhcModError' diff --git a/Language/Haskell/GhcMod/Monad/Types.hs b/Language/Haskell/GhcMod/Monad/Types.hs index 7a51276..eb6baed 100644 --- a/Language/Haskell/GhcMod/Monad/Types.hs +++ b/Language/Haskell/GhcMod/Monad/Types.hs @@ -36,7 +36,6 @@ module Language.Haskell.GhcMod.Monad.Types ( , defaultGhcModState , GmGhcSession(..) , GmComponent(..) - , CompilerMode(..) -- * Accessing 'GhcModEnv', 'GhcModState' and 'GhcModLog' , GmLogLevel(..) , GhcModLog(..) @@ -50,8 +49,6 @@ module Language.Haskell.GhcMod.Monad.Types ( , options , outputOpts , withOptions - , getCompilerMode - , setCompilerMode , getMMappedFiles , setMMappedFiles , addMMappedFile @@ -549,12 +546,6 @@ outputOpts = gmoOptions `liftM` gmoAsk cradle :: GmEnv m => m Cradle cradle = gmCradle `liftM` gmeAsk -getCompilerMode :: GmState m => m CompilerMode -getCompilerMode = gmCompilerMode `liftM` gmsGet - -setCompilerMode :: GmState m => CompilerMode -> m () -setCompilerMode mode = (\s -> gmsPut s { gmCompilerMode = mode } ) =<< gmsGet - getMMappedFiles :: GmState m => m FileMappingMap getMMappedFiles = gmMMappedFiles `liftM` gmsGet diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index e8b36a2..6818ef0 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -143,7 +143,7 @@ runGmlTWith efnmns' mdf wrapper action = do | otherwise = setEmptyLogger initSession opts' $ - setModeSimple >>> setLogger >>> mdf + setHscNothing >>> setLogger >>> mdf mappedStrs <- getMMappedFilePaths let targetStrs = mappedStrs ++ map moduleNameString mns ++ cfns @@ -430,20 +430,24 @@ loadTargets opts targetStrs = do setTargets targets - mode <- getCompilerMode - if mode == Intelligent - then loadTargets' Intelligent - else do - mdls <- depanal [] False - let fallback = needsFallback mdls - if fallback then do - resetTargets targets - setIntelligent - gmLog GmInfo "loadTargets" $ - text "Target needs interpeter, switching to LinkInMemory/HscInterpreted. Perfectly normal if anything is using TemplateHaskell, QuasiQuotes or PatternSynonyms." - loadTargets' Intelligent - else - loadTargets' Simple + mg <- depanal [] False + + let interp = needsHscInterpreted mg + target <- hscTarget <$> getSessionDynFlags + when (interp && target /= HscInterpreted) $ do + resetTargets targets + _ <- setSessionDynFlags . setHscInterpreted =<< getSessionDynFlags + gmLog GmInfo "loadTargets" $ text "Target needs interpeter, switching to LinkInMemory/HscInterpreted. Perfectly normal if anything is using TemplateHaskell, QuasiQuotes or PatternSynonyms." + + target' <- hscTarget <$> getSessionDynFlags + + case target' of + HscNothing -> do + void $ load LoadAllTargets + mapM_ (parseModule >=> typecheckModule >=> desugarModule) mg + HscInterpreted -> do + void $ load LoadAllTargets + _ -> error ("loadTargets: unsupported hscTarget") gmLog GmDebug "loadTargets" $ text "Loading done" @@ -455,30 +459,16 @@ loadTargets opts targetStrs = do return $ Target tid taoc src relativize tgt = return tgt - loadTargets' Simple = do - void $ load LoadAllTargets - mapM_ (parseModule >=> typecheckModule >=> desugarModule) =<< getModuleGraph - - loadTargets' Intelligent = do - df <- getSessionDynFlags - void $ setSessionDynFlags (setModeIntelligent df) - void $ load LoadAllTargets - resetTargets targets' = do setTargets [] void $ load LoadAllTargets setTargets targets' - setIntelligent = do - newdf <- setModeIntelligent <$> getSessionDynFlags - void $ setSessionDynFlags newdf - setCompilerMode Intelligent - showTargetId (Target (TargetModule s) _ _) = moduleNameString s showTargetId (Target (TargetFile s _) _ _) = s -needsFallback :: ModuleGraph -> Bool -needsFallback = any $ \ms -> +needsHscInterpreted :: ModuleGraph -> Bool +needsHscInterpreted = any $ \ms -> let df = ms_hspp_opts ms in Opt_TemplateHaskell `xopt` df || Opt_QuasiQuotes `xopt` df diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 9f77ed3..b22964e 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -199,16 +199,13 @@ data GhcModCaches = GhcModCaches { data GhcModState = GhcModState { gmGhcSession :: !(Maybe GmGhcSession) - , gmCompilerMode :: !CompilerMode , gmCaches :: !GhcModCaches , gmMMappedFiles :: !FileMappingMap } -data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read) - defaultGhcModState :: GhcModState defaultGhcModState = - GhcModState n Simple (GhcModCaches n n n n) Map.empty + GhcModState n (GhcModCaches n n n n) Map.empty where n = Nothing ----------------------------------------------------------------