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
	 Kazu Yamamoto
						Kazu Yamamoto