diff --git a/GHCApi.hs b/GHCApi.hs index 52a430b..35d2529 100644 --- a/GHCApi.hs +++ b/GHCApi.hs @@ -5,6 +5,7 @@ module GHCApi ( , initializeFlagsWithCradle , setTargetFile , getDynamicFlags + , setSlowDynFlags , checkSlowAndSet ) where @@ -70,8 +71,7 @@ initSession opt cmdOpts idirs mDepPkgs logging = do where setupDynamicFlags df0 = do df1 <- modifyFlagsWithOpts df0 cmdOpts - let fast = False - let df2 = modifyFlags df1 idirs mDepPkgs fast (expandSplice opt) + let df2 = modifyFlags df1 idirs mDepPkgs (expandSplice opt) df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt liftIO $ setLogger logging df3 @@ -86,13 +86,13 @@ initializeFlags opt = do ---------------------------------------------------------------- -- FIXME removing Options -modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Bool -> DynFlags -modifyFlags d0 idirs mDepPkgs fast splice +modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> DynFlags +modifyFlags d0 idirs mDepPkgs splice | splice = setSplice d3 | otherwise = d3 where d1 = d0 { importPaths = idirs } - d2 = setFastOrNot d1 fast + d2 = setFastOrNot d1 Fast d3 = maybe d2 (addDevPkgs d2) mDepPkgs setSplice :: DynFlags -> DynFlags @@ -108,18 +108,18 @@ addDevPkgs df pkgs = df'' ---------------------------------------------------------------- -setFastOrNot :: DynFlags -> Bool -> DynFlags -setFastOrNot dflags False = dflags { +setFastOrNot :: DynFlags -> CheckSpeed -> DynFlags +setFastOrNot dflags Slow = dflags { ghcLink = LinkInMemory , hscTarget = HscInterpreted } -setFastOrNot dflags True = dflags { +setFastOrNot dflags Fast = dflags { ghcLink = NoLink , hscTarget = HscNothing } setSlowDynFlags :: Ghc () -setSlowDynFlags = (flip setFastOrNot False <$> getSessionDynFlags) +setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags) >>= void . setSessionDynFlags -- To check TH, a session module graph is necessary. diff --git a/Info.hs b/Info.hs index 65fc0d0..79c27ab 100644 --- a/Info.hs +++ b/Info.hs @@ -4,7 +4,7 @@ module Info (infoExpr, typeExpr) where import Control.Applicative -import Control.Monad (void) +import Control.Monad (void, when) import CoreUtils import Data.Function import Data.Generics @@ -32,6 +32,8 @@ import Types type Expression = String type ModuleString = String +data Cmd = Info | Type deriving Eq + ---------------------------------------------------------------- infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String @@ -39,7 +41,7 @@ infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> IO String info opt cradle fileName modstr expr = - inModuleContext opt cradle fileName modstr exprToInfo "Cannot show info" + inModuleContext Info opt cradle fileName modstr exprToInfo "Cannot show info" where exprToInfo = infoThing expr @@ -70,7 +72,7 @@ typeExpr opt cradle modstr lineNo colNo file = Info.typeOf opt cradle file modst typeOf :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> IO String typeOf opt cradle fileName modstr lineNo colNo = - inModuleContext opt cradle fileName modstr exprToType errmsg + inModuleContext Type opt cradle fileName modstr exprToType errmsg where exprToType = do modSum <- getModSummary $ mkModuleName modstr @@ -139,12 +141,13 @@ pprInfo pefas (thing, fixity, insts) ---------------------------------------------------------------- -inModuleContext :: Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String -inModuleContext opt cradle fileName modstr action errmsg = +inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String +inModuleContext cmd opt cradle fileName modstr action errmsg = withGHCDummyFile (valid ||> invalid ||> return errmsg) where valid = do void $ initializeFlagsWithCradle opt cradle ["-w:"] False + when (cmd == Info) $ setSlowDynFlags setTargetFile fileName checkSlowAndSet void $ load LoadAllTargets diff --git a/Types.hs b/Types.hs index d9944a6..71d1284 100644 --- a/Types.hs +++ b/Types.hs @@ -76,3 +76,5 @@ data Cradle = Cradle { type GHCOption = String type IncludeDir = FilePath type Package = String + +data CheckSpeed = Slow | Fast