summaryrefslogtreecommitdiff
path: root/src/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Compile')
-rw-r--r--src/GF/Compile/Compile.hs49
-rw-r--r--src/GF/Compile/GetGrammar.hs3
-rw-r--r--src/GF/Compile/MkConcrete.hs3
-rw-r--r--src/GF/Compile/Wordlist.hs3
4 files changed, 31 insertions, 27 deletions
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 856544152..58fc91269 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -58,6 +58,7 @@ import GF.System.Arch
import Control.Monad
import System.Directory
+import System.FilePath
-- | environment variable for grammar search path
gfGrammarPathVar = "GF_GRAMMAR_PATH"
@@ -83,20 +84,20 @@ compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
compileModule opts st0 file |
oElem showOld opts ||
- elem suff ["cf","ebnf","gfm"] = do
+ elem suff [".cf",".ebnf",".gfm"] = do
let putp = putPointE opts
let putpp = putPointEsil opts
let path = [] ----
grammar1 <- case suff of
- "cf" -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
- "ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file
- "gfm" -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file
- _ -> putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
+ ".cf" -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
+ ".ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file
+ ".gfm" -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file
+ _ -> putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
let mods = modules grammar1
let env = compileEnvShSt st0 []
foldM (comp putpp path) env mods
where
- suff = fileSuffix file
+ suff = takeExtensions file
comp putpp path env sm0 = do
(k',sm,eenv') <- makeSourceModule opts (fst env) sm0
cm <- putpp " generating code... " $ generateModuleCode opts path sm
@@ -108,18 +109,18 @@ compileModule opts1 st0 file = do
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 = justInitPath file
+ let fpath = dropFileName file
ps0 <- ioeIO $ pathListOpts opts fpath
let ps1 = if (useFileOpt && not useLineOpt)
- then (ps0 ++ map (prefixPathName fpath) ps0)
+ then (ps0 ++ map (combine fpath) ps0)
else ps0
ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
let st = st0 --- if useFileOpt then emptyShellState else st0
let rfs = [(m,t) | (m,(_,t)) <- readFiles st]
- let file' = if useFileOpt then justFileName file else file -- to find file itself
+ 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
@@ -138,13 +139,13 @@ compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
compileEnvShSt st fs = ((0,sgr,cgr,eenv),fts) where
cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i]
sgr = MGrammar [m | m@(i,_) <- modules (srcModules st), notIns i]
- notInc i = notElem (prt i) $ map fileBody fs
- notIns i = notElem (prt i) $ map fileBody fs
+ notInc i = notElem (prt i) $ map dropExtension fs
+ notIns i = notElem (prt i) $ map dropExtension fs
fts = readFiles st
eenv = evalEnv st
pathListOpts :: Options -> FileName -> IO [InitPath]
-pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList
+pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
reverseModules (MGrammar ms) = MGrammar $ reverse ms
@@ -181,20 +182,20 @@ compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do
| oElem beSilent opts = putpp v act
| otherwise = ioeIO (putStrFlush m) >> act
- let gf = fileSuffix file
- let path = justInitPath file
- let name = fileBody file
+ let gf = takeExtensions file
+ let path = dropFileName file
+ let name = dropExtension file
let mos = modules srcgr
case gf of
-- for multilingual canonical gf, just read the file and update environment
- "gfcm" -> do
+ ".gfcm" -> do
cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file
ft <- getReadTimes file
extendCompileEnvCanon env cgr eenv ft
-- for canonical gf, read the file and update environment, also source env
- "gfc" -> do
+ ".gfc" -> do
cm <- putp ("+ reading" +++ file) $ getCanonModule file
let cancgr = updateMGrammar (MGrammar [cm]) cancgr0
sm <- ioeErr $ CG.canon2sourceModule $ unoptimizeCanonMod cancgr $ unSubelimModule cm
@@ -202,7 +203,7 @@ compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do
extendCompileEnv env (sm, cm) eenv ft
-- for compiled resource, parse and organize, then update environment
- "gfr" -> do
+ ".gfr" -> do
sm0 <- putp ("| reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
@@ -219,7 +220,7 @@ compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do
--- hack fix to a bug in ReadFiles with reused concrete
- let modu = unsuffixFile file
+ let modu = dropExtension file
b1 <- ioeIO $ doesFileExist file
b2 <- ioeIO $ doesFileExist $ gfrFile modu
if not b1
@@ -308,7 +309,7 @@ generateModuleCode opts path minfo@(name,info) = do
--- then ioeIO $ putStrLn $ prGrammar2gfcc minfo
--- else return ()
- let pname = prefixPathName path (prt name)
+ let pname = path </> prt name
minfo0 <- ioeErr $ redModInfo minfo
let oopts = addOptions opts (iOpts (flagsModule minfo))
optims = maybe "all_subs" id $ getOptVal oopts useOptimizer
@@ -389,15 +390,15 @@ getGFEFiles opts1 file = useIOE [] $ do
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 = justInitPath file
+ let fpath = dropFileName file
ps0 <- ioeIO $ pathListOpts opts fpath
let ps1 = if (useFileOpt && not useLineOpt)
- then (map (prefixPathName fpath) ps0)
+ then (map (combine fpath) ps0)
else ps0
ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1
- let file' = if useFileOpt then justFileName file else file -- to find file itself
+ let file' = if useFileOpt then takeFileName file else file -- to find file itself
files <- getAllFiles opts ps [] file'
- efiles <- ioeIO $ filterM doesFileExist [suffixFile "gfe" (unsuffixFile f) | f <- files]
+ efiles <- ioeIO $ filterM doesFileExist [replaceExtension f "gfe" | f <- files]
es <- ioeIO $ mapM (uncurry selectLater) [(f, init f) | f <- efiles] -- init gfe == gf
return $ filter ((=='e') . last) es
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index f0cf5d197..294edbf9a 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -46,6 +46,7 @@ import Data.List (nub)
import qualified Data.ByteString.Char8 as BS
import Control.Monad (foldM)
import System (system)
+import System.FilePath
getSourceModule :: Options -> FilePath -> IOE SourceModule
getSourceModule opts file0 = do
@@ -79,7 +80,7 @@ getOldGrammar :: Options -> FilePath -> IOE SourceGrammar
getOldGrammar opts file = do
defs <- parseOldGrammarFiles file
let g = A.OldGr A.NoIncl defs
- let name = justFileName file
+ let name = takeFileName file
ioeErr $ transOldGrammar opts name g
parseOldGrammarFiles :: FilePath -> IOE [A.TopDef]
diff --git a/src/GF/Compile/MkConcrete.hs b/src/GF/Compile/MkConcrete.hs
index 5413d1b79..0124acca6 100644
--- a/src/GF/Compile/MkConcrete.hs
+++ b/src/GF/Compile/MkConcrete.hs
@@ -36,6 +36,7 @@ import GF.System.Arch
import GF.UseGrammar.Treebank
import System.Directory
+import System.FilePath
import Data.Char
import Control.Monad
import Data.List
@@ -111,7 +112,7 @@ mkConcrete :: Parser -> Morpho -> FilePath -> IO ()
mkConcrete parser morpho file = do
src <- appIOE (getSourceModule noOptions file) >>= err error return
let (src',msgs) = mkModule parser morpho src
- let out = suffixFile "gf" $ justModuleName file
+ let out = addExtension (justModuleName file) "gf"
writeFile out $ "-- File generated by GF from " ++ file
appendFile out "\n"
appendFile out (prModule src')
diff --git a/src/GF/Compile/Wordlist.hs b/src/GF/Compile/Wordlist.hs
index d581ed683..3fbc066bd 100644
--- a/src/GF/Compile/Wordlist.hs
+++ b/src/GF/Compile/Wordlist.hs
@@ -18,6 +18,7 @@ import GF.Data.Operations
import GF.Infra.UseIO
import Data.List
import Data.Char
+import System.FilePath
-- read File.gfwl, write File.gf (abstract) and a set of concretes
-- return the names of the concretes
@@ -25,7 +26,7 @@ import Data.Char
mkWordlist :: FilePath -> IO [FilePath]
mkWordlist file = do
s <- readFileIf file
- let abs = fileBody file
+ let abs = dropExtension file
let (cnchs,wlist) = pWordlist abs $ filter notComment $ lines s
let (gr,grs) = mkGrammars abs cnchs wlist
let cncfs = [cnc ++ ".gf" | (cnc,_) <- cnchs]
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 16:25:09 +0000