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 | ||||
|     loadAndFind = do | ||||
|       setTargetFiles [mdlName] | ||||
|       checkSlowAndSet | ||||
|       void $ load LoadAllTargets | ||||
|       findModule mdlname Nothing | ||||
| 
 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|     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 | ||||
|  | ||||
| @ -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] | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -111,7 +111,6 @@ Test-Suite spec | ||||
|                         BrowseSpec | ||||
|                         CabalApiSpec | ||||
|                         CheckSpec | ||||
|                         DebugSpec | ||||
|                         FlagSpec | ||||
|                         InfoSpec | ||||
|                         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