manually copy the "c-runtime" branch from the old repository.

This commit is contained in:
Krasimir Angelov
2018-11-02 14:38:44 +01:00
parent bf5abe2948
commit 5a2b200948
80 changed files with 2618 additions and 1527 deletions

View File

@@ -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