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 fallback e = throwGhcException e
loadAndFind = do loadAndFind = do
setTargetFiles [mdlName] setTargetFiles [mdlName]
checkSlowAndSet
void $ load LoadAllTargets void $ load LoadAllTargets
findModule mdlname Nothing findModule mdlname Nothing

View File

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

View File

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

View File

@ -7,9 +7,6 @@ module Language.Haskell.GhcMod.GHCApi (
, initializeFlagsWithCradle , initializeFlagsWithCradle
, setTargetFiles , setTargetFiles
, getDynamicFlags , getDynamicFlags
, setSlowDynFlags
, checkSlowAndSet
, canCheckFast
) where ) where
import Control.Applicative import Control.Applicative
@ -121,7 +118,10 @@ modifyFlags d0 idirs depPkgs splice build
| otherwise = d4 | otherwise = d4
where where
d1 = d0 { importPaths = idirs } d1 = d0 { importPaths = idirs }
d2 = setFastOrNot d1 Fast d2 = d1 {
ghcLink = LinkInMemory
, hscTarget = HscInterpreted
}
d3 = Gap.addDevPkgs d2 depPkgs d3 = Gap.addDevPkgs d2 depPkgs
d4 | build == CabalPkg = Gap.setCabalPkg d3 d4 | build == CabalPkg = Gap.setCabalPkg d3
| otherwise = 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 :: GhcMonad m => DynFlags -> [GHCOption] -> m DynFlags
modifyFlagsWithOpts dflags cmdOpts = modifyFlagsWithOpts dflags cmdOpts =
tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts) tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts)
@ -176,11 +151,3 @@ setTargetFiles files = do
-- | Return the 'DynFlags' currently in use in the GHC session. -- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags getDynamicFlags :: IO DynFlags
getDynamicFlags = runGhc (Just libdir) getSessionDynFlags 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 ) where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Monad (void, when) import Control.Monad (void)
import CoreUtils (exprType) import CoreUtils (exprType)
import Data.Function (on) import Data.Function (on)
import Data.Generics hiding (typeOf) 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 -> 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 valid ||> invalid ||> return errmsg
where where
valid = do valid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False void $ initializeFlagsWithCradle opt cradle ["-w:"] False
when (cmd == Info) setSlowDynFlags
setTargetFiles [file] setTargetFiles [file]
checkSlowAndSet
void $ load LoadAllTargets void $ load LoadAllTargets
doif setContextFromTarget action doif setContextFromTarget action
invalid = do invalid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False void $ initializeFlagsWithCradle opt cradle ["-w:"] False
setTargetBuffer setTargetBuffer
checkSlowAndSet
void $ load LoadAllTargets void $ load LoadAllTargets
doif setContextFromTarget action doif setContextFromTarget action
setTargetBuffer = do setTargetBuffer = do

View File

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

View File

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

View File

@ -111,7 +111,6 @@ Test-Suite spec
BrowseSpec BrowseSpec
CabalApiSpec CabalApiSpec
CheckSpec CheckSpec
DebugSpec
FlagSpec FlagSpec
InfoSpec InfoSpec
LangSpec 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"