From a28b61be1c28ce82bf00a514b63f53b2652b8d0b Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Thu, 22 May 2008 12:57:33 +0000 Subject: move GF.Devel.Compile and GF.Compile.API to GF.Compile --- src-3.0/GF/Command/Importing.hs | 2 +- src-3.0/GF/Compile.hs | 218 ++++++++++++++++++++++++++++++++++++++++ src-3.0/GF/Compile/API.hs | 21 ---- src-3.0/GF/Devel/Compile.hs | 202 ------------------------------------- src-3.0/GF/Devel/GFC.hs | 2 +- 5 files changed, 220 insertions(+), 225 deletions(-) create mode 100644 src-3.0/GF/Compile.hs delete mode 100644 src-3.0/GF/Compile/API.hs delete mode 100644 src-3.0/GF/Devel/Compile.hs (limited to 'src-3.0') diff --git a/src-3.0/GF/Command/Importing.hs b/src-3.0/GF/Command/Importing.hs index a09ba8de6..bca59048f 100644 --- a/src-3.0/GF/Command/Importing.hs +++ b/src-3.0/GF/Command/Importing.hs @@ -1,6 +1,6 @@ module GF.Command.Importing (importGrammar) where -import GF.Compile.API +import GF.Compile import GF.GFCC.DataGFCC import GF.GFCC.API diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs new file mode 100644 index 000000000..dba6c96cc --- /dev/null +++ b/src-3.0/GF/Compile.hs @@ -0,0 +1,218 @@ +module GF.Compile (batchCompile, compileToGFCC) where + +-- the main compiler passes +import GF.Devel.GetGrammar +import GF.Compile.Extend +import GF.Compile.Rebuild +import GF.Compile.Rename +import GF.Grammar.Refresh +import GF.Devel.CheckGrammar +import GF.Devel.Optimize +import GF.Devel.OptimizeGF +import GF.Devel.GrammarToGFCC + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Option +import GF.Infra.CompactPrint +import GF.Devel.PrGrammar +import GF.Compile.Update +import GF.Grammar.Lookup +import GF.Infra.Modules +import GF.Devel.ReadFiles + +import GF.Source.GrammarToSource +import qualified GF.Source.AbsGF as A +import qualified GF.Source.PrintGF as P + +import GF.Data.Operations +import GF.Devel.UseIO + +import Control.Monad +import System.Directory +import System.FilePath +import System.Time +import qualified Data.Map as Map + +import GF.GFCC.OptimizeGFCC +import GF.GFCC.CheckGFCC +import GF.GFCC.DataGFCC + + +-- | Compiles a number of source files and builds a 'GFCC' structure for them. +compileToGFCC :: Options -> [FilePath] -> IOE GFCC +compileToGFCC opts fs = + do gr <- batchCompile opts fs + let name = justModuleName (last fs) + gc1 <- putPointE opts "linking ... " $ + let (abs,gc0) = mkCanon2gfcc opts name gr + in ioeIO $ checkGFCCio gc0 + let opt = if oElem (iOpt "noopt") opts then id else optGFCC + par = if oElem (iOpt "noparse") opts then id else addParsers + return (par (opt gc1)) + + +batchCompile :: Options -> [FilePath] -> IOE SourceGrammar +batchCompile opts files = do + (_,gr,_) <- foldM (compileModule defOpts) emptyCompileEnv files + return gr + where + defOpts = addOptions opts (options [emitCode]) + +-- to output an intermediate stage +intermOut :: Options -> Option -> String -> IOE () +intermOut opts opt s = if oElem opt opts then + ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s) + else return () + +prMod :: SourceModule -> String +prMod = compactPrint . prModule + + +-- | the environment +type CompileEnv = (Int,SourceGrammar,ModEnv) + +-- | compile with one module as starting point +-- command-line options override options (marked by --#) in the file +-- As for path: if it is read from file, the file path is prepended to each name. +-- If from command line, it is used as it is. + +compileModule :: Options -> CompileEnv -> FilePath -> IOE CompileEnv +compileModule opts1 env file = do + opts0 <- ioeIO $ getOptionsFromFile file + let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList + let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList + let opts = addOptions opts1 opts0 + let fpath = dropFileName file + ps0 <- ioeIO $ pathListOpts opts fpath + + let ps1 = if (useFileOpt && not useLineOpt) + then (ps0 ++ map (combine fpath) ps0) + else ps0 + ps <- ioeIO $ extendPathEnv ps1 + let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ())) + ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- + let (_,sgr,rfs) = env + let file' = if useFileOpt then takeFileName file else file -- to find file itself + files <- getAllFiles opts ps rfs file' + ioeIOIf $ putStrLn $ "files to read:" +++ show files ---- + let names = map justModuleName files + ioeIOIf $ putStrLn $ "modules to include:" +++ show names ---- + foldM (compileOne opts) (0,sgr,rfs) files + + +compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv +compileOne opts env@(_,srcgr,_) file = do + + let putp s = putPointE opts s + let putpp = putPointEsil opts + let putpOpt v m act + | oElem beVerbose opts = putp v act + | oElem beSilent opts = putpp v act + | otherwise = ioeIO (putStrFlush m) >> act + + let gf = takeExtensions file + let path = dropFileName file + let name = dropExtension file + let mos = modules srcgr + + case gf of + + -- for compiled gf, read the file and update environment + -- also undo common subexp optimization, to enable normal computations + ".gfo" -> do + sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file + let sm1 = unsubexpModule sm0 + sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1 + + extendCompileEnv env file sm + + -- for gf source, do full compilation and generate code + _ -> do + + let gfo = gfoFile (dropExtension file) + b1 <- ioeIO $ doesFileExist file + if not b1 + then compileOne opts env $ gfo + else do + + sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ + getSourceModule opts file + (k',sm) <- compileSourceModule opts env sm0 + let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str + cm <- putpp " generating code... " $ generateModuleCode opts gfo sm1 + -- sm is optimized before generation, but not in the env + extendCompileEnvInt env k' gfo sm1 + where + isConcr (_,mi) = case mi of + ModMod m -> isModCnc m && mstatus m /= MSIncomplete + _ -> False + + +compileSourceModule :: Options -> CompileEnv -> + SourceModule -> IOE (Int,SourceModule) +compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do + + let putp = putPointE opts + putpp = putPointEsil opts + mos = modules gr + + mo1 <- ioeErr $ rebuildModule mos mo + intermOut opts (iOpt "show_rebuild") (prMod mo1) + + mo1b <- ioeErr $ extendModule mos mo1 + intermOut opts (iOpt "show_extend") (prMod mo1b) + + case mo1b of + (_,ModMod n) | not (isCompleteModule n) -> do + return (k,mo1b) -- refresh would fail, since not renamed + _ -> do + mo2:_ <- putpp " renaming " $ ioeErr $ renameModule mos mo1b + intermOut opts (iOpt "show_rename") (prMod mo2) + + (mo3:_,warnings) <- putpp " type checking" $ ioeErr $ showCheckModule mos mo2 + if null warnings then return () else putp warnings $ return () + intermOut opts (iOpt "show_typecheck") (prMod mo3) + + + (k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,mos) mo3 + intermOut opts (iOpt "show_refresh") (prMod mo3r) + + let eenv = () --- emptyEEnv + (mo4,eenv') <- + ---- if oElem "check_only" opts + putpp " optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r + return (k',mo4) + where + ---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug + prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo] + +generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule +generateModuleCode opts file minfo = do + let minfo1 = subexpModule minfo + out = prGrammar (MGrammar [minfo1]) + putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out + return minfo1 + where + putp = putPointE opts + putpp = putPointEsil opts + + +-- auxiliaries + +pathListOpts :: Options -> FileName -> IO [InitPath] +pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList + +reverseModules (MGrammar ms) = MGrammar $ reverse ms + +emptyCompileEnv :: CompileEnv +emptyCompileEnv = (0,emptyMGrammar,Map.empty) + +extendCompileEnvInt (_,MGrammar ss,menv) k file sm = do + let (mod,imps) = importsOfModule (trModule sm) + t <- ioeIO $ getModificationTime file + return (k,MGrammar (sm:ss),Map.insert mod (t,imps) menv) --- reverse later + +extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k file sm + + diff --git a/src-3.0/GF/Compile/API.hs b/src-3.0/GF/Compile/API.hs deleted file mode 100644 index 7e852cf7a..000000000 --- a/src-3.0/GF/Compile/API.hs +++ /dev/null @@ -1,21 +0,0 @@ -module GF.Compile.API (batchCompile, compileToGFCC) where - -import GF.Devel.Compile -import GF.Devel.GrammarToGFCC -import GF.GFCC.OptimizeGFCC -import GF.GFCC.CheckGFCC -import GF.GFCC.DataGFCC -import GF.Infra.Option -import GF.Devel.UseIO - --- | Compiles a number of source files and builds a 'GFCC' structure for them. -compileToGFCC :: Options -> [FilePath] -> IOE GFCC -compileToGFCC opts fs = - do gr <- batchCompile opts fs - let name = justModuleName (last fs) - gc1 <- putPointE opts "linking ... " $ - let (abs,gc0) = mkCanon2gfcc opts name gr - in ioeIO $ checkGFCCio gc0 - let opt = if oElem (iOpt "noopt") opts then id else optGFCC - par = if oElem (iOpt "noparse") opts then id else addParsers - return (par (opt gc1)) diff --git a/src-3.0/GF/Devel/Compile.hs b/src-3.0/GF/Devel/Compile.hs deleted file mode 100644 index b746812f7..000000000 --- a/src-3.0/GF/Devel/Compile.hs +++ /dev/null @@ -1,202 +0,0 @@ -module GF.Devel.Compile (batchCompile) where - --- the main compiler passes -import GF.Devel.GetGrammar -import GF.Compile.Extend -import GF.Compile.Rebuild -import GF.Compile.Rename -import GF.Grammar.Refresh -import GF.Devel.CheckGrammar -import GF.Devel.Optimize ---import GF.Compile.Evaluate ---- -import GF.Devel.OptimizeGF ---import GF.Canon.Share ---import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule) - -import GF.Grammar.Grammar -import GF.Infra.Ident -import GF.Infra.Option -import GF.Infra.CompactPrint -import GF.Devel.PrGrammar -import GF.Compile.Update -import GF.Grammar.Lookup -import GF.Infra.Modules -import GF.Devel.ReadFiles - -import GF.Source.GrammarToSource -import qualified GF.Source.AbsGF as A -import qualified GF.Source.PrintGF as P - -import GF.Data.Operations -import GF.Devel.UseIO - -import Control.Monad -import System.Directory -import System.FilePath -import System.Time -import qualified Data.Map as Map - -batchCompile :: Options -> [FilePath] -> IOE SourceGrammar -batchCompile opts files = do - (_,gr,_) <- foldM (compileModule defOpts) emptyCompileEnv files - return gr - where - defOpts = addOptions opts (options [emitCode]) - --- to output an intermediate stage -intermOut :: Options -> Option -> String -> IOE () -intermOut opts opt s = if oElem opt opts then - ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s) - else return () - -prMod :: SourceModule -> String -prMod = compactPrint . prModule - - --- | the environment -type CompileEnv = (Int,SourceGrammar,ModEnv) - --- | compile with one module as starting point --- command-line options override options (marked by --#) in the file --- As for path: if it is read from file, the file path is prepended to each name. --- If from command line, it is used as it is. - -compileModule :: Options -> CompileEnv -> FilePath -> IOE CompileEnv -compileModule opts1 env file = do - opts0 <- ioeIO $ getOptionsFromFile file - let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList - let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList - let opts = addOptions opts1 opts0 - let fpath = dropFileName file - ps0 <- ioeIO $ pathListOpts opts fpath - - let ps1 = if (useFileOpt && not useLineOpt) - then (ps0 ++ map (combine fpath) ps0) - else ps0 - ps <- ioeIO $ extendPathEnv ps1 - let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ())) - ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- - let (_,sgr,rfs) = env - let file' = if useFileOpt then takeFileName file else file -- to find file itself - files <- getAllFiles opts ps rfs file' - ioeIOIf $ putStrLn $ "files to read:" +++ show files ---- - let names = map justModuleName files - ioeIOIf $ putStrLn $ "modules to include:" +++ show names ---- - foldM (compileOne opts) (0,sgr,rfs) files - - -compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv -compileOne opts env@(_,srcgr,_) file = do - - let putp s = putPointE opts s - let putpp = putPointEsil opts - let putpOpt v m act - | oElem beVerbose opts = putp v act - | oElem beSilent opts = putpp v act - | otherwise = ioeIO (putStrFlush m) >> act - - let gf = takeExtensions file - let path = dropFileName file - let name = dropExtension file - let mos = modules srcgr - - case gf of - - -- for compiled gf, read the file and update environment - -- also undo common subexp optimization, to enable normal computations - ".gfo" -> do - sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file - let sm1 = unsubexpModule sm0 - sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1 - - extendCompileEnv env file sm - - -- for gf source, do full compilation and generate code - _ -> do - - let gfo = gfoFile (dropExtension file) - b1 <- ioeIO $ doesFileExist file - if not b1 - then compileOne opts env $ gfo - else do - - sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ - getSourceModule opts file - (k',sm) <- compileSourceModule opts env sm0 - let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str - cm <- putpp " generating code... " $ generateModuleCode opts gfo sm1 - -- sm is optimized before generation, but not in the env - extendCompileEnvInt env k' gfo sm1 - where - isConcr (_,mi) = case mi of - ModMod m -> isModCnc m && mstatus m /= MSIncomplete - _ -> False - - -compileSourceModule :: Options -> CompileEnv -> - SourceModule -> IOE (Int,SourceModule) -compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do - - let putp = putPointE opts - putpp = putPointEsil opts - mos = modules gr - - mo1 <- ioeErr $ rebuildModule mos mo - intermOut opts (iOpt "show_rebuild") (prMod mo1) - - mo1b <- ioeErr $ extendModule mos mo1 - intermOut opts (iOpt "show_extend") (prMod mo1b) - - case mo1b of - (_,ModMod n) | not (isCompleteModule n) -> do - return (k,mo1b) -- refresh would fail, since not renamed - _ -> do - mo2:_ <- putpp " renaming " $ ioeErr $ renameModule mos mo1b - intermOut opts (iOpt "show_rename") (prMod mo2) - - (mo3:_,warnings) <- putpp " type checking" $ ioeErr $ showCheckModule mos mo2 - if null warnings then return () else putp warnings $ return () - intermOut opts (iOpt "show_typecheck") (prMod mo3) - - - (k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,mos) mo3 - intermOut opts (iOpt "show_refresh") (prMod mo3r) - - let eenv = () --- emptyEEnv - (mo4,eenv') <- - ---- if oElem "check_only" opts - putpp " optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r - return (k',mo4) - where - ---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug - prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo] - -generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule -generateModuleCode opts file minfo = do - let minfo1 = subexpModule minfo - out = prGrammar (MGrammar [minfo1]) - putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out - return minfo1 - where - putp = putPointE opts - putpp = putPointEsil opts - - --- auxiliaries - -pathListOpts :: Options -> FileName -> IO [InitPath] -pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList - -reverseModules (MGrammar ms) = MGrammar $ reverse ms - -emptyCompileEnv :: CompileEnv -emptyCompileEnv = (0,emptyMGrammar,Map.empty) - -extendCompileEnvInt (_,MGrammar ss,menv) k file sm = do - let (mod,imps) = importsOfModule (trModule sm) - t <- ioeIO $ getModificationTime file - return (k,MGrammar (sm:ss),Map.insert mod (t,imps) menv) --- reverse later - -extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k file sm - - diff --git a/src-3.0/GF/Devel/GFC.hs b/src-3.0/GF/Devel/GFC.hs index 13e47e788..562570f14 100644 --- a/src-3.0/GF/Devel/GFC.hs +++ b/src-3.0/GF/Devel/GFC.hs @@ -1,7 +1,7 @@ module GF.Devel.GFC (mainGFC) where -- module Main where -import GF.Compile.API +import GF.Compile import GF.Devel.PrintGFCC import GF.GFCC.CId import GF.GFCC.DataGFCC -- cgit v1.2.3