Defining checkSlowAndSet.

This commit is contained in:
Kazu Yamamoto 2013-03-15 14:40:36 +09:00
parent 83c6ba3032
commit 8d7b0d365b
3 changed files with 18 additions and 16 deletions

View File

@ -23,12 +23,7 @@ check opt cradle fileName = withGHC fileName $ checkIt `gcatch` handleErrMsg
checkIt = do checkIt = do
readLog <- initializeFlagsWithCradle opt cradle options True readLog <- initializeFlagsWithCradle opt cradle options True
setTargetFile fileName setTargetFile fileName
-- To check TH, a session module graph is necessary. checkSlowAndSet
-- "load" sets a session module graph using "depanal".
-- But we have to set "-fno-code" to DynFlags before "load".
-- So, this is necessary redundancy.
slow <- needsTemplateHaskell <$> depanal [] False
when slow setSlowDynFlags
void $ load LoadAllTargets void $ load LoadAllTargets
liftIO readLog liftIO readLog
options options

View File

@ -5,7 +5,7 @@ module GHCApi (
, initializeFlagsWithCradle , initializeFlagsWithCradle
, setTargetFile , setTargetFile
, getDynamicFlags , getDynamicFlags
, setSlowDynFlags , checkSlowAndSet
) where ) where
import CabalApi import CabalApi
@ -122,6 +122,15 @@ setSlowDynFlags :: Ghc ()
setSlowDynFlags = (flip setFastOrNot False <$> getSessionDynFlags) setSlowDynFlags = (flip setFastOrNot False <$> getSessionDynFlags)
>>= void . setSessionDynFlags >>= 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 :: Ghc ()
checkSlowAndSet = do
slow <- needsTemplateHaskell <$> depanal [] False
when slow setSlowDynFlags
---------------------------------------------------------------- ----------------------------------------------------------------
modifyFlagsWithOpts :: DynFlags -> [String] -> Ghc DynFlags modifyFlagsWithOpts :: DynFlags -> [String] -> Ghc DynFlags

16
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 (when) import Control.Monad (void)
import CoreUtils import CoreUtils
import Data.Function import Data.Function
import Data.Generics import Data.Generics
@ -144,18 +144,16 @@ inModuleContext opt cradle fileName modstr action errmsg =
withGHCDummyFile (valid ||> invalid ||> return errmsg) withGHCDummyFile (valid ||> invalid ||> return errmsg)
where where
valid = do valid = do
_ <- initializeFlagsWithCradle opt cradle ["-w"] False void $ initializeFlagsWithCradle opt cradle ["-w"] False
setTargetFile fileName setTargetFile fileName
slow <- needsTemplateHaskell <$> depanal [] False checkSlowAndSet
when slow setSlowDynFlags void $ load LoadAllTargets
_ <- load LoadAllTargets
doif setContextFromTarget action doif setContextFromTarget action
invalid = do invalid = do
_ <- initializeFlagsWithCradle opt cradle ["-w"] False void $ initializeFlagsWithCradle opt cradle ["-w"] False
setTargetBuffer setTargetBuffer
slow <- needsTemplateHaskell <$> depanal [] False checkSlowAndSet
when slow setSlowDynFlags void $ load LoadAllTargets
_ <- load LoadAllTargets
doif setContextFromTarget action doif setContextFromTarget action
setTargetBuffer = do setTargetBuffer = do
modgraph <- depanal [mkModuleName modstr] True modgraph <- depanal [mkModuleName modstr] True