diff options
| author | krasimir <krasimir@chalmers.se> | 2009-12-13 18:50:29 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-12-13 18:50:29 +0000 |
| commit | f85232947e74ee7ef8c7b0ad2338212e7e68f1be (patch) | |
| tree | 667b886a5e3a4b026a63d4e3597f32497d824761 /src/GF/Compile.hs | |
| parent | d88a865faff59c98fc91556ff8700b10ee5f2df8 (diff) | |
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
Diffstat (limited to 'src/GF/Compile.hs')
| -rw-r--r-- | src/GF/Compile.hs | 252 |
1 files changed, 0 insertions, 252 deletions
diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs deleted file mode 100644 index e0c60178e..000000000 --- a/src/GF/Compile.hs +++ /dev/null @@ -1,252 +0,0 @@ -module GF.Compile (batchCompile, link, compileToPGF, compileSourceGrammar) where - --- the main compiler passes -import GF.Compile.GetGrammar -import GF.Compile.Rename -import GF.Compile.CheckGrammar -import GF.Compile.Optimize -import GF.Compile.SubExOpt -import GF.Compile.OptimizeGFCC -import GF.Compile.GrammarToGFCC -import GF.Compile.ReadFiles -import GF.Compile.Update -import GF.Compile.Refresh - -import GF.Compile.Coding -import GF.Text.UTF8 ---- - -import GF.Grammar.Grammar -import GF.Grammar.Lookup -import GF.Grammar.Printer -import GF.Grammar.Binary - -import GF.Infra.Ident -import GF.Infra.Option -import GF.Infra.Modules -import GF.Infra.UseIO -import GF.Infra.CheckM - -import GF.Data.Operations - -import Control.Monad -import System.IO -import System.Directory -import System.FilePath -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.List(nub) -import Data.Maybe (isNothing) -import Data.Binary -import Text.PrettyPrint - -import PGF.Check -import PGF.CId -import PGF.Data -import PGF.Macros - - --- | Compiles a number of source files and builds a 'PGF' structure for them. -compileToPGF :: Options -> [FilePath] -> IOE PGF -compileToPGF opts fs = - do gr <- batchCompile opts fs - let name = justModuleName (last fs) - link opts name gr - -link :: Options -> String -> SourceGrammar -> IOE PGF -link opts cnc gr = do - let isv = (verbAtLeast opts Normal) - gc1 <- putPointE Normal opts "linking ... " $ - let (abs,gc0) = mkCanon2gfcc opts cnc gr - in case checkPGF gc0 of - Ok (gc,b) -> do - case (isv,b) of - (True, True) -> ioeIO $ putStrLn "OK" - (False,True) -> return () - _ -> ioeIO $ putStrLn $ "Corrupted PGF" - return gc - Bad s -> fail s - ioeIO $ buildParser opts $ optimize opts gc1 - -optimize :: Options -> PGF -> PGF -optimize opts = cse . suf - where os = flag optOptimizations opts - cse = if OptCSE `Set.member` os then cseOptimize else id - suf = if OptStem `Set.member` os then suffixOptimize else id - -buildParser :: Options -> PGF -> IO PGF -buildParser opts = - case flag optBuildParser opts of - BuildParser -> addParsers opts - DontBuildParser -> return - BuildParserOnDemand -> return . mapConcretes (\cnc -> cnc { cflags = Map.insert (mkCId "parser") "ondemand" (cflags cnc) }) - -batchCompile :: Options -> [FilePath] -> IOE SourceGrammar -batchCompile opts files = do - (_,gr,_) <- foldM (compileModule opts) emptyCompileEnv files - return gr - --- to compile a set of modules, e.g. an old GF or a .cf file -compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar -compileSourceGrammar opts gr@(MGrammar ms) = do - (_,gr',_) <- foldM compOne (0,emptySourceGrammar,Map.empty) ms - return gr' - where - compOne env mo = do - (k,mo') <- compileSourceModule opts env mo - extendCompileEnvInt env k Nothing mo' --- file for the same of modif time... - --- to output an intermediate stage -intermOut :: Options -> Dump -> Doc -> IOE () -intermOut opts d doc - | dump opts d = ioeIO (hPutStrLn stderr (encodeUTF8 (render (text "\n\n--#" <+> text (show d) $$ doc)))) - | otherwise = return () - --- | 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 -- ^ Options from program command line and shell command. - -> CompileEnv -> FilePath -> IOE CompileEnv -compileModule opts1 env file = do - file <- getRealFile file - opts0 <- getOptionsFromFile file - curr_dir <- return $ dropFileName file - lib_dir <- ioeIO $ getLibraryDirectory (addOptions opts0 opts1) - let opts = addOptions (fixRelativeLibPaths curr_dir lib_dir opts0) opts1 - ps0 <- ioeIO $ extendPathEnv opts - let ps = nub (curr_dir : ps0) - ioeIO $ putIfVerb opts $ "module search path:" +++ show ps ---- - let (_,sgr,rfs) = env - files <- getAllFiles opts ps rfs file - ioeIO $ putIfVerb opts $ "files to read:" +++ show files ---- - let names = map justModuleName files - ioeIO $ putIfVerb opts $ "modules to include:" +++ show names ---- - foldM (compileOne opts) (0,sgr,rfs) files - where - getRealFile file = do - exists <- ioeIO $ doesFileExist file - if exists - then return file - else if isRelative file - then do lib_dir <- ioeIO $ getLibraryDirectory opts1 - let file1 = lib_dir </> file - exists <- ioeIO $ doesFileExist file1 - if exists - then return file1 - else ioeErr $ Bad (render (text "None of this files exist:" $$ nest 2 (text file $$ text file1))) - else ioeErr $ Bad (render (text "File" <+> text file <+> text "does not exist.")) - -compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv -compileOne opts env@(_,srcgr,_) file = do - - let putpOpt v m act - | verbAtLeast opts Verbose = putPointE Normal opts v act - | verbAtLeast opts Normal = ioeIO (putStrFlush m) >> act - | otherwise = putPointE Verbose opts v act - - let gf = takeExtensions file - let path = dropFileName file - let name = dropExtension file - - case gf of - - -- for compiled gf, read the file and update environment - -- also undo common subexp optimization, to enable normal computations - ".gfo" -> do - sm00 <- putPointE Normal opts ("+ reading" +++ file) $ ioeIO (decodeFile file) - let sm0 = addOptionsToModule opts sm00 - - intermOut opts DumpSource (ppModule Qualified sm0) - - let sm1 = unsubexpModule sm0 - sm <- {- putPointE Normal opts "creating indirections" $ -} ioeErr $ extendModule srcgr sm1 - - extendCompileEnv env file sm - - -- for gf source, do full compilation and generate code - _ -> do - - let gfo = gf2gfo opts file - b1 <- ioeIO $ doesFileExist file - if not b1 - then compileOne opts env $ gfo - else do - - sm00 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ - getSourceModule opts file - let sm0 = decodeStringsInModule sm00 - - intermOut opts DumpSource (ppModule Qualified sm0) - - (k',sm) <- compileSourceModule opts env sm0 - putPointE Verbose opts " generating code... " $ generateModuleCode opts gfo sm - extendCompileEnvInt env k' (Just gfo) sm - where - isConcr (_,m) = isModCnc m && mstatus m /= MSIncomplete - -compileSourceModule :: Options -> CompileEnv -> SourceModule -> IOE (Int,SourceModule) -compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do - - let puts = putPointE Quiet opts - putpp = putPointE Verbose opts - - mo1 <- ioeErr $ rebuildModule gr mo - intermOut opts DumpRebuild (ppModule Qualified mo1) - - mo1b <- ioeErr $ extendModule gr mo1 - intermOut opts DumpExtend (ppModule Qualified mo1b) - - case mo1b of - (_,n) | not (isCompleteModule n) -> do - return (k,mo1b) -- refresh would fail, since not renamed - _ -> do - let mos = modules gr - - (mo2,warnings) <- putpp " renaming " $ ioeErr $ runCheck (renameModule mos mo1b) - if null warnings then return () else puts warnings $ return () - intermOut opts DumpRename (ppModule Qualified mo2) - - (mo3,warnings) <- putpp " type checking" $ ioeErr $ runCheck (checkModule mos mo2) - if null warnings then return () else puts warnings $ return () - intermOut opts DumpTypeCheck (ppModule Qualified mo3) - - (k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,mos) mo3 - intermOut opts DumpRefresh (ppModule Qualified mo3r) - - mo4 <- putpp " optimizing " $ ioeErr $ optimizeModule opts mos mo3r - intermOut opts DumpOptimize (ppModule Qualified mo4) - - return (k',mo4) - -generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule -generateModuleCode opts file minfo = do - let minfo1 = subexpModule minfo - minfo2 = case minfo1 of - (m,mi) -> (m,mi{jments=Map.filter (\x -> case x of {AnyInd _ _ -> False; _ -> True}) (jments mi) - , positions=Map.empty}) - putPointE Normal opts (" wrote file" +++ file) $ ioeIO $ encodeFile file minfo2 - return minfo1 - --- auxiliaries - -reverseModules (MGrammar ms) = MGrammar $ reverse ms - -emptyCompileEnv :: CompileEnv -emptyCompileEnv = (0,emptyMGrammar,Map.empty) - -extendCompileEnvInt (_,MGrammar ss,menv) k mfile sm = do - let (mod,imps) = importsOfModule sm - menv2 <- case mfile of - Just file -> do - t <- ioeIO $ getModificationTime file - return $ Map.insert mod (t,imps) menv - _ -> return menv - return (k,MGrammar (sm:ss),menv2) --- reverse later - -extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k (Just file) sm - - |
