fixing "ghc-mod info" for non-export funcs and fast/slow checking.

This commit is contained in:
Kazu Yamamoto 2013-04-01 14:16:34 +09:00
parent c0564a2456
commit 8f61f3691f
3 changed files with 19 additions and 14 deletions

View File

@ -5,6 +5,7 @@ module GHCApi (
, initializeFlagsWithCradle , initializeFlagsWithCradle
, setTargetFile , setTargetFile
, getDynamicFlags , getDynamicFlags
, setSlowDynFlags
, checkSlowAndSet , checkSlowAndSet
) where ) where
@ -70,8 +71,7 @@ initSession opt cmdOpts idirs mDepPkgs logging = do
where where
setupDynamicFlags df0 = do setupDynamicFlags df0 = do
df1 <- modifyFlagsWithOpts df0 cmdOpts df1 <- modifyFlagsWithOpts df0 cmdOpts
let fast = False let df2 = modifyFlags df1 idirs mDepPkgs (expandSplice opt)
let df2 = modifyFlags df1 idirs mDepPkgs fast (expandSplice opt)
df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt
liftIO $ setLogger logging df3 liftIO $ setLogger logging df3
@ -86,13 +86,13 @@ initializeFlags opt = do
---------------------------------------------------------------- ----------------------------------------------------------------
-- FIXME removing Options -- FIXME removing Options
modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Bool -> DynFlags modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> DynFlags
modifyFlags d0 idirs mDepPkgs fast splice modifyFlags d0 idirs mDepPkgs splice
| splice = setSplice d3 | splice = setSplice d3
| otherwise = d3 | otherwise = d3
where where
d1 = d0 { importPaths = idirs } d1 = d0 { importPaths = idirs }
d2 = setFastOrNot d1 fast d2 = setFastOrNot d1 Fast
d3 = maybe d2 (addDevPkgs d2) mDepPkgs d3 = maybe d2 (addDevPkgs d2) mDepPkgs
setSplice :: DynFlags -> DynFlags setSplice :: DynFlags -> DynFlags
@ -108,18 +108,18 @@ addDevPkgs df pkgs = df''
---------------------------------------------------------------- ----------------------------------------------------------------
setFastOrNot :: DynFlags -> Bool -> DynFlags setFastOrNot :: DynFlags -> CheckSpeed -> DynFlags
setFastOrNot dflags False = dflags { setFastOrNot dflags Slow = dflags {
ghcLink = LinkInMemory ghcLink = LinkInMemory
, hscTarget = HscInterpreted , hscTarget = HscInterpreted
} }
setFastOrNot dflags True = dflags { setFastOrNot dflags Fast = dflags {
ghcLink = NoLink ghcLink = NoLink
, hscTarget = HscNothing , hscTarget = HscNothing
} }
setSlowDynFlags :: Ghc () setSlowDynFlags :: Ghc ()
setSlowDynFlags = (flip setFastOrNot False <$> getSessionDynFlags) setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags)
>>= void . setSessionDynFlags >>= void . setSessionDynFlags
-- To check TH, a session module graph is necessary. -- To check TH, a session module graph is necessary.

13
Info.hs
View File

@ -4,7 +4,7 @@
module Info (infoExpr, typeExpr) where module Info (infoExpr, typeExpr) where
import Control.Applicative import Control.Applicative
import Control.Monad (void) import Control.Monad (void, when)
import CoreUtils import CoreUtils
import Data.Function import Data.Function
import Data.Generics import Data.Generics
@ -32,6 +32,8 @@ import Types
type Expression = String type Expression = String
type ModuleString = String type ModuleString = String
data Cmd = Info | Type deriving Eq
---------------------------------------------------------------- ----------------------------------------------------------------
infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String 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 :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> IO String
info opt cradle fileName modstr expr = 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 where
exprToInfo = infoThing expr 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 :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> IO String
typeOf opt cradle fileName modstr lineNo colNo = typeOf opt cradle fileName modstr lineNo colNo =
inModuleContext opt cradle fileName modstr exprToType errmsg inModuleContext Type opt cradle fileName modstr exprToType errmsg
where where
exprToType = do exprToType = do
modSum <- getModSummary $ mkModuleName modstr modSum <- getModSummary $ mkModuleName modstr
@ -139,12 +141,13 @@ pprInfo pefas (thing, fixity, insts)
---------------------------------------------------------------- ----------------------------------------------------------------
inModuleContext :: Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String
inModuleContext opt cradle fileName modstr action errmsg = inModuleContext cmd opt cradle fileName modstr action errmsg =
withGHCDummyFile (valid ||> invalid ||> return errmsg) withGHCDummyFile (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
setTargetFile fileName setTargetFile fileName
checkSlowAndSet checkSlowAndSet
void $ load LoadAllTargets void $ load LoadAllTargets

View File

@ -76,3 +76,5 @@ data Cradle = Cradle {
type GHCOption = String type GHCOption = String
type IncludeDir = FilePath type IncludeDir = FilePath
type Package = String type Package = String
data CheckSpeed = Slow | Fast