hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactoring.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-03-04 12:53:28 +09:00
parent a0d5082ac7
commit 6f8b8873e7
1 changed files with 36 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
GHCApi.hs
View File

@ -62,11 +62,9 @@ initSession :: Options
-> Ghc LogReader -> Ghc LogReader
initSession opt cmdOpts idirs mDepPkgs mLangExts logging file = do initSession opt cmdOpts idirs mDepPkgs mLangExts logging file = do
dflags0 <- getSessionDynFlags dflags0 <- getSessionDynFlags
hdrExts <- liftIO $ getHeaderExtension dflags0 file dflags1 <- modifyFlagsWithOpts dflags0 cmdOpts
let th = useTemplateHaskell mLangExts hdrExts fast <- not <$> checkTemplateHaskell dflags0 file mLangExts
opts = map noLoc cmdOpts let dflags2 = modifyFlags dflags1 idirs mDepPkgs fast (expandSplice opt)
(dflags1,_,_) <- parseDynamicFlags dflags0 opts
let dflags2 = modifyFlags opt dflags1 idirs mDepPkgs th
dflags3 <- setGhcFlags opt dflags2 dflags3 <- setGhcFlags opt dflags2
(dflags4,readLog) <- liftIO $ setLogger logging dflags3 (dflags4,readLog) <- liftIO $ setLogger logging dflags3
_ <- setSessionDynFlags dflags4 _ <- setSessionDynFlags dflags4
@ -79,6 +77,11 @@ getHeaderExtension dflags file = map unLoc <$> getOptionsFromFile dflags file
---------------------------------------------------------------- ----------------------------------------------------------------
checkTemplateHaskell :: DynFlags -> FilePath -> Maybe [LangExt] -> Ghc Bool
checkTemplateHaskell dflags file mLangExts = do
hdrExts <- liftIO $ getHeaderExtension dflags file
return $ useTemplateHaskell mLangExts hdrExts
useTemplateHaskell :: Maybe [LangExt] -> [HeaderExt] -> Bool useTemplateHaskell :: Maybe [LangExt] -> [HeaderExt] -> Bool
useTemplateHaskell mLangExts hdrExts = th1 || th2 useTemplateHaskell mLangExts hdrExts = th1 || th2
where where
@ -87,18 +90,35 @@ useTemplateHaskell mLangExts hdrExts = th1 || th2
---------------------------------------------------------------- ----------------------------------------------------------------
modifyFlags :: Options -> DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> DynFlags modifyFlagsWithOpts :: DynFlags -> [String] -> Ghc DynFlags
modifyFlags opt d idirs mDepPkgs th modifyFlagsWithOpts dflags cmdOpts = do
| expandSplice opt = dopt_set d'' Opt_D_dump_splices (dflags',_,_) <- parseDynamicFlags dflags (map noLoc cmdOpts)
| otherwise = d'' return dflags'
----------------------------------------------------------------
-- FIXME removing Options
modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Bool -> DynFlags
modifyFlags d0 idirs mDepPkgs fast splice
| splice = setSplice d3
| otherwise = d3
where where
d' = d { d1 = d0 { importPaths = idirs }
importPaths = idirs d2 = setFastOrNot d1 fast
, ghcLink = if th then LinkInMemory else NoLink d3 = maybe d2 (addDevPkgs d2) mDepPkgs
, hscTarget = if th then HscInterpreted else HscNothing
, flags = flags d setSplice :: DynFlags -> DynFlags
} setSplice dflag = dopt_set dflag Opt_D_dump_splices
d'' = maybe d' (addDevPkgs d') mDepPkgs
setFastOrNot :: DynFlags -> Bool -> DynFlags
setFastOrNot dflags False = dflags {
ghcLink = LinkInMemory
, hscTarget = HscInterpreted
}
setFastOrNot dflags True = dflags {
ghcLink = NoLink
, hscTarget = HscNothing
}
addDevPkgs :: DynFlags -> [Package] -> DynFlags addDevPkgs :: DynFlags -> [Package] -> DynFlags
addDevPkgs df pkgs = df'' addDevPkgs df pkgs = df''