summaryrefslogtreecommitdiff
path: root/src-3.0/GF/Devel
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@chalmers.se>2008-05-22 12:57:33 +0000
committerkr.angelov <kr.angelov@chalmers.se>2008-05-22 12:57:33 +0000
commita28b61be1c28ce82bf00a514b63f53b2652b8d0b (patch)
tree83387d63a21b949473ba6b067722aa1cd89f10ee /src-3.0/GF/Devel
parent2e49f7f5b15e106f46e6d714b6e91aaf1a303bcd (diff)
move GF.Devel.Compile and GF.Compile.API to GF.Compile
Diffstat (limited to 'src-3.0/GF/Devel')
-rw-r--r--src-3.0/GF/Devel/Compile.hs202
-rw-r--r--src-3.0/GF/Devel/GFC.hs2
2 files changed, 1 insertions, 203 deletions
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