removing fast/slow code.

This commit is contained in:
Kazu Yamamoto 2014-03-17 15:56:00 +09:00
parent 5aa5d3cbca
commit 16e050439d
9 changed files with 8 additions and 78 deletions

View File

@ -53,7 +53,6 @@ browse opt cradle mdlName = do
fallback e = throwGhcException e
loadAndFind = do
setTargetFiles [mdlName]
checkSlowAndSet
void $ load LoadAllTargets
findModule mdlname Nothing

View File

@ -39,7 +39,6 @@ check opt cradle fileNames = checkIt `gcatch` handleErrMsg ls
checkIt = do
(readLog,_) <- initializeFlagsWithCradle opt cradle options True
setTargetFiles fileNames
checkSlowAndSet
void $ load LoadAllTargets
liftIO readLog
options

View File

@ -32,17 +32,14 @@ debug opt cradle fileName = do
liftIO (fromCabalFile ||> return simpleCompilerOption)
else
return simpleCompilerOption
[fast] <- do
void $ initializeFlagsWithCradle opt cradle gopts True
setTargetFiles [fileName]
pure . canCheckFast <$> depanal [] False
void $ initializeFlagsWithCradle opt cradle gopts True
setTargetFiles [fileName]
return [
"Current directory: " ++ currentDir
, "Cabal file: " ++ cabalFile
, "GHC options: " ++ unwords gopts
, "Include directories: " ++ unwords incDir
, "Dependent packages: " ++ (intercalate ", " $ map fst pkgs)
, "Fast check: " ++ if fast then "Yes" else "No"
]
where
currentDir = cradleCurrentDir cradle

View File

@ -7,9 +7,6 @@ module Language.Haskell.GhcMod.GHCApi (
, initializeFlagsWithCradle
, setTargetFiles
, getDynamicFlags
, setSlowDynFlags
, checkSlowAndSet
, canCheckFast
) where
import Control.Applicative
@ -121,7 +118,10 @@ modifyFlags d0 idirs depPkgs splice build
| otherwise = d4
where
d1 = d0 { importPaths = idirs }
d2 = setFastOrNot d1 Fast
d2 = d1 {
ghcLink = LinkInMemory
, hscTarget = HscInterpreted
}
d3 = Gap.addDevPkgs d2 depPkgs
d4 | build == CabalPkg = Gap.setCabalPkg d3
| otherwise = d3
@ -131,31 +131,6 @@ setSplice dflag = dopt_set dflag Opt_D_dump_splices
----------------------------------------------------------------
setFastOrNot :: DynFlags -> CheckSpeed -> DynFlags
setFastOrNot dflags Slow = dflags {
ghcLink = LinkInMemory
, hscTarget = HscInterpreted
}
setFastOrNot dflags Fast = dflags {
ghcLink = NoLink
, hscTarget = HscNothing
}
setSlowDynFlags :: GhcMonad m => m ()
setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags)
>>= void . setSessionDynFlags
-- | To check TH, a session module graph is necessary.
-- "load" sets a session module graph using "depanal".
-- But we have to set "-fno-code" to DynFlags before "load".
-- So, this is necessary redundancy.
checkSlowAndSet :: GhcMonad m => m ()
checkSlowAndSet = do
fast <- canCheckFast <$> depanal [] False
unless fast setSlowDynFlags
----------------------------------------------------------------
modifyFlagsWithOpts :: GhcMonad m => DynFlags -> [GHCOption] -> m DynFlags
modifyFlagsWithOpts dflags cmdOpts =
tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts)
@ -176,11 +151,3 @@ setTargetFiles files = do
-- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags
getDynamicFlags = runGhc (Just libdir) getSessionDynFlags
-- | Checking if Template Haskell or quasi quotes are used.
-- If not, the process can be faster.
canCheckFast :: ModuleGraph -> Bool
canCheckFast = not . any (hasTHorQQ . ms_hspp_opts)
where
hasTHorQQ :: DynFlags -> Bool
hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]

View File

@ -10,7 +10,7 @@ module Language.Haskell.GhcMod.Info (
) where
import Control.Applicative ((<$>))
import Control.Monad (void, when)
import Control.Monad (void)
import CoreUtils (exprType)
import Data.Function (on)
import Data.Generics hiding (typeOf)
@ -135,20 +135,17 @@ pretty dflag = showUnqualifiedOneLine dflag . Gap.typeForUser
----------------------------------------------------------------
inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> Ghc String
inModuleContext cmd opt cradle file modstr action errmsg =
inModuleContext _ opt cradle file modstr action errmsg =
valid ||> invalid ||> return errmsg
where
valid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False
when (cmd == Info) setSlowDynFlags
setTargetFiles [file]
checkSlowAndSet
void $ load LoadAllTargets
doif setContextFromTarget action
invalid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False
setTargetBuffer
checkSlowAndSet
void $ load LoadAllTargets
doif setContextFromTarget action
setTargetBuffer = do

View File

@ -14,8 +14,6 @@ module Language.Haskell.GhcMod.Internal (
, cabalDependPackages
, cabalSourceDirs
, cabalAllTargets
-- * GHC API
, canCheckFast
-- * Getting 'DynFlags'
, getDynamicFlags
-- * Initializing 'DynFlags'
@ -23,7 +21,6 @@ module Language.Haskell.GhcMod.Internal (
, initializeFlagsWithCradle
-- * 'GhcMonad'
, setTargetFiles
, checkSlowAndSet
-- * 'Ghc' Choice
, (||>)
, goNext

View File

@ -113,8 +113,6 @@ type Expression = String
-- | Module name.
type ModuleString = String
data CheckSpeed = Slow | Fast
-- | Option information for GHC
data CompilerOptions = CompilerOptions {
ghcOptions :: [GHCOption] -- ^ Command line options

View File

@ -111,7 +111,6 @@ Test-Suite spec
BrowseSpec
CabalApiSpec
CheckSpec
DebugSpec
FlagSpec
InfoSpec
LangSpec

View File

@ -1,23 +0,0 @@
module DebugSpec where
import Language.Haskell.GhcMod
import Test.Hspec
import Dir
checkFast :: String -> String -> IO ()
checkFast file ans = withDirectory_ "test/data" $ do
let cradle = Cradle "." Nothing Nothing [] []
res <- debugInfo defaultOptions cradle file
lines res `shouldContain` [ans]
spec :: Spec
spec = do
describe "debug" $ do
it "can check TH" $ do
checkFast "Main.hs" "Fast check: No"
checkFast "Foo.hs" "Fast check: Yes"
checkFast "Bar.hs" "Fast check: No"
it "can check QuasiQuotes" $ do
checkFast "Baz.hs" "Fast check: No"