fixing "ghc-mod info" for non-export funcs and fast/slow checking.
This commit is contained in:
parent
c0564a2456
commit
8f61f3691f
18
GHCApi.hs
18
GHCApi.hs
@ -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
13
Info.hs
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user