GF.CompileOne: refactoring to reduce code duplication and improve readability

I prefer small functions with descriptive names over large monilithic chunks
of code, so I grouped the compiler passes called from compileSourceModule
into funcitons named frontend, middle and backend. This also makes decisions
about which passes to run clearly visible up front.

Also made some small changes in GF.Compile.
This commit is contained in:
hallgren
2014-08-20 17:04:15 +00:00
parent 61760e4205
commit 73310add9a
2 changed files with 67 additions and 71 deletions

View File

@@ -14,7 +14,7 @@ import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb,
justModuleName,extendPathEnv,putStrE,putPointE)
import GF.Data.Operations(raise,(+++),err)
import Control.Monad(foldM,when)
import Control.Monad(foldM,when,(<=<))
import GF.System.Directory(doesFileExist,getModificationTime)
import System.FilePath((</>),isRelative,dropFileName)
import qualified Data.Map as Map(empty,insert,elems) --lookup
@@ -69,7 +69,7 @@ compileModule opts1 env@(_,rfs) file =
do file <- getRealFile file
opts0 <- getOptionsFromFile file
let curr_dir = dropFileName file
lib_dir <- liftIO $ getLibraryDirectory (addOptions opts0 opts1)
lib_dir <- getLibraryDirectory (addOptions opts0 opts1)
let opts = addOptions (fixRelativeLibPaths curr_dir lib_dir opts0) opts1
ps0 <- extendPathEnv opts
let ps = nub (curr_dir : ps0)
@@ -85,7 +85,7 @@ compileModule opts1 env@(_,rfs) file =
if exists
then return file
else if isRelative file
then do lib_dir <- liftIO $ getLibraryDirectory opts1
then do lib_dir <- getLibraryDirectory opts1
let file1 = lib_dir </> file
exists <- liftIO $ doesFileExist file1
if exists
@@ -94,24 +94,21 @@ compileModule opts1 env@(_,rfs) file =
else raise (render ("File" <+> file <+> "does not exist."))
compileOne' :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
compileOne' opts env@(srcgr,_) file =
extendCompileEnv env =<< compileOne opts srcgr file
compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr
-- auxiliaries
--reverseModules (MGrammar ms) = MGrammar $ reverse ms
-- | The environment
type CompileEnv = (SourceGrammar,ModEnv)
emptyCompileEnv :: CompileEnv
emptyCompileEnv = (emptySourceGrammar,Map.empty)
extendCompileEnv (gr,menv) (mfile,mo) = do
menv2 <- case mfile of
Just file -> do
let (mod,imps) = importsOfModule mo
t <- liftIO $ getModificationTime file
return $ Map.insert mod (t,imps) menv
_ -> return menv
return (prependModule gr mo,menv2) --- reverse later
extendCompileEnv (gr,menv) (mfile,mo) =
do menv2 <- case mfile of
Just file ->
do let (mod,imps) = importsOfModule mo
t <- liftIO $ getModificationTime file
return $ Map.insert mod (t,imps) menv
_ -> return menv
return (prependModule gr mo,menv2)