Plain source file: src/compiler/GF/Compile.hs (2015-03-03)

GF.Compile is imported by: ...
module GF.Compile (compileToPGF, link, batchCompile, srcAbsName) where

import GF.Compile.GrammarToPGF(mkCanon2pgf)
import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
import GF.CompileOne(compileOne)

import GF.Grammar.Grammar(Grammar,emptyGrammar,

import GF.Infra.Ident(ModuleName,moduleNameS)--,showIdent
import GF.Infra.Option
import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb,
import GF.Data.Operations(raise,(+++),err)

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
import Data.List(nub)
import Data.Time(UTCTime)
import GF.Text.Pretty(render,($$),(<+>),nest)

import PGF.Internal(optimizePGF)
import PGF(PGF,defaultProbabilities,setProbabilities,readProbabilitiesFromFile)

-- | Compiles a number of source files and builds a 'PGF' structure for them.
-- This is a composition of 'link' and 'batchCompile'.
compileToPGF :: Options -> [FilePath] -> IOE PGF
compileToPGF opts fs = link opts . snd =<< batchCompile opts fs

-- | Link a grammar into a 'PGF' that can be used to 'PGF.linearize' and
-- 'PGF.parse' with the "PGF" run-time system.
link :: Options -> (ModuleName,Grammar) -> IOE PGF
link opts (cnc,gr) =
  putPointE Normal opts "linking ... " $ do
    let abs = srcAbsName gr cnc
    pgf <- mkCanon2pgf opts gr abs
    probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
    when (verbAtLeast opts Normal) $ putStrE "OK"
    return $ setProbabilities probs 
           $ if flag optOptimizePGF opts then optimizePGF pgf else pgf

-- | Returns the name of the abstract syntax corresponding to the named concrete syntax
srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc

-- | Compile the given grammar files and everything they depend on.
-- Compiled modules are stored in @.gfo@ files (unless the @-tags@ option is
-- used, in which case tags files are produced instead).
-- Existing @.gfo@ files are reused if they are up-to-date
-- (unless the option @-src@ aka @-force-recomp@ is used).
batchCompile :: Options -> [FilePath] -> IOE (UTCTime,(ModuleName,Grammar))
batchCompile opts files = do
  (gr,menv) <- foldM (compileModule opts) emptyCompileEnv files
  let cnc = moduleNameS (justModuleName (last files))
      t = maximum . map fst $ Map.elems menv
  return (t,(cnc,gr))
-- to compile a set of modules, e.g. an old GF or a .cf file
compileSourceGrammar :: Options -> Grammar -> IOE Grammar
compileSourceGrammar opts gr = do
  cwd <- getCurrentDirectory
  (_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing)
                     (modules gr)
  return gr'

-- | 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@(_,rfs) file =
  do file <- getRealFile file
     opts0 <- getOptionsFromFile file
     let curr_dir = dropFileName file
     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)
     putIfVerb opts $ "module search path:" +++ show ps ----
     files <- getAllFiles opts ps rfs file
     putIfVerb opts $ "files to read:" +++ show files ----
     let names = map justModuleName files
     putIfVerb opts $ "modules to include:" +++ show names ----
     foldM (compileOne' opts) env files
    getRealFile file = do
      exists <- doesFileExist file
      if exists
        then return file
        else if isRelative file
               then do lib_dir <- getLibraryDirectory opts1
                       let file1 = lib_dir </> file
                       exists <- doesFileExist file1
                       if exists
                         then return file1
                         else raise (render ("None of these files exists:" $$ nest 2 (file $$ file1)))
               else raise (render ("File" <+> file <+> "does not exist."))

compileOne' :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr

-- auxiliaries

-- | The environment
type CompileEnv = (Grammar,ModEnv)

emptyCompileEnv :: CompileEnv
emptyCompileEnv = (emptyGrammar,Map.empty)

extendCompileEnv (gr,menv) (mfile,mo) =
  do menv2 <- case mfile of
                Just file ->
                  do let (mod,imps) = importsOfModule mo
                     t <- getModificationTime file
                     return $ Map.insert mod (t,imps) menv
                _ -> return menv
     return (prependModule gr mo,menv2)


(HTML for this module was generated on 2015-03-03. About the conversion tool.)