mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-01 23:32:51 -06:00
manually copy the "c-runtime" branch from the old repository.
This commit is contained in:
@@ -1,6 +1,6 @@
|
||||
module GF.Compile (compileToPGF, link, batchCompile, srcAbsName) where
|
||||
|
||||
import GF.Compile.GrammarToPGF(mkCanon2pgf)
|
||||
import GF.Compile.GrammarToPGF(grammar2PGF)
|
||||
import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
|
||||
importsOfModule)
|
||||
import GF.CompileOne(compileOne)
|
||||
@@ -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,(<=<),filterM,liftM)
|
||||
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
|
||||
@@ -22,8 +22,7 @@ import Data.List(nub)
|
||||
import Data.Time(UTCTime)
|
||||
import GF.Text.Pretty(render,($$),(<+>),nest)
|
||||
|
||||
import PGF.Internal(optimizePGF)
|
||||
import PGF(PGF,defaultProbabilities,setProbabilities,readProbabilitiesFromFile)
|
||||
import PGF(PGF,readProbabilitiesFromFile)
|
||||
|
||||
-- | Compiles a number of source files and builds a 'PGF' structure for them.
|
||||
-- This is a composition of 'link' and 'batchCompile'.
|
||||
@@ -36,11 +35,10 @@ 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)
|
||||
probs <- liftIO (maybe (return Map.empty) readProbabilitiesFromFile (flag optProbsFile opts))
|
||||
pgf <- grammar2PGF opts gr abs probs
|
||||
when (verbAtLeast opts Normal) $ putStrE "OK"
|
||||
return $ setProbabilities probs
|
||||
$ if flag optOptimizePGF opts then optimizePGF pgf else pgf
|
||||
return pgf
|
||||
|
||||
-- | Returns the name of the abstract syntax corresponding to the named concrete syntax
|
||||
srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc
|
||||
@@ -78,14 +76,10 @@ compileModule opts1 env@(_,rfs) file =
|
||||
do file <- getRealFile file
|
||||
opts0 <- getOptionsFromFile file
|
||||
let curr_dir = dropFileName file
|
||||
lib_dirs <- getLibraryDirectory (addOptions opts0 opts1)
|
||||
let opts = addOptions (fixRelativeLibPaths curr_dir lib_dirs opts0) opts1
|
||||
-- putIfVerb opts $ "curr_dir:" +++ show curr_dir ----
|
||||
-- putIfVerb opts $ "lib_dir:" +++ show lib_dirs ----
|
||||
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 $ "options from file: " ++ show opts0
|
||||
-- putIfVerb opts $ "augmented options: " ++ show opts
|
||||
putIfVerb opts $ "module search path:" +++ show ps ----
|
||||
files <- getAllFiles opts ps rfs file
|
||||
putIfVerb opts $ "files to read:" +++ show files ----
|
||||
@@ -98,17 +92,13 @@ compileModule opts1 env@(_,rfs) file =
|
||||
if exists
|
||||
then return file
|
||||
else if isRelative file
|
||||
then do
|
||||
lib_dirs <- getLibraryDirectory opts1
|
||||
let candidates = [ lib_dir </> file | lib_dir <- lib_dirs ]
|
||||
putIfVerb opts1 (render ("looking for: " $$ nest 2 candidates))
|
||||
file1s <- filterM doesFileExist candidates
|
||||
case length file1s of
|
||||
0 -> raise (render ("Unable to find: " $$ nest 2 candidates))
|
||||
1 -> do return $ head file1s
|
||||
_ -> do putIfVerb opts1 ("matched multiple candidates: " +++ show file1s)
|
||||
return $ head file1s
|
||||
else raise (render ("File" <+> file <+> "does not exist"))
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user