removing fast/slow code.
This commit is contained in:
parent
5aa5d3cbca
commit
16e050439d
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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]
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -111,7 +111,6 @@ Test-Suite spec
|
|||||||
BrowseSpec
|
BrowseSpec
|
||||||
CabalApiSpec
|
CabalApiSpec
|
||||||
CheckSpec
|
CheckSpec
|
||||||
DebugSpec
|
|
||||||
FlagSpec
|
FlagSpec
|
||||||
InfoSpec
|
InfoSpec
|
||||||
LangSpec
|
LangSpec
|
||||||
|
@ -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"
|
|
Loading…
Reference in New Issue
Block a user