summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs4
-rw-r--r--src/compiler/GF/Compile/GetGrammar.hs22
-rw-r--r--src/compiler/GF/Compile/ReadFiles.hs71
3 files changed, 49 insertions, 48 deletions
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index e6067c854..aa22ea412 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -45,7 +45,7 @@ import Control.Monad.Identity
----------------------------------------------------------------------
-- main conversion function
-generatePMCFG :: Options -> SourceGrammar -> Maybe FilePath -> SourceModule -> IOE SourceModule
+--generatePMCFG :: Options -> SourceGrammar -> Maybe FilePath -> SourceModule -> IOE SourceModule
generatePMCFG opts sgr opath cmo@(cm,cmi) = do
(seqs,js) <- mapAccumWithKeyM (addPMCFG opts gr cenv opath am cm) Map.empty (jments cmi)
when (verbAtLeast opts Verbose) $ ePutStrLn ""
@@ -67,7 +67,7 @@ mapAccumWithKeyM f a m = do let xs = Map.toAscList m
return (a,(k,y):kys)
-addPMCFG :: Options -> SourceGrammar -> GlobalEnv -> Maybe FilePath -> Ident -> Ident -> SeqSet -> Ident -> Info -> IOE (SeqSet, Info)
+--addPMCFG :: Options -> SourceGrammar -> GlobalEnv -> Maybe FilePath -> Ident -> Ident -> SeqSet -> Ident -> Info -> IOE (SeqSet, Info)
addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L loc term)) mprn Nothing) = do
--when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id++" ...")
let pres = protoFCat gr res val
diff --git a/src/compiler/GF/Compile/GetGrammar.hs b/src/compiler/GF/Compile/GetGrammar.hs
index e10081cff..b4d2e13ef 100644
--- a/src/compiler/GF/Compile/GetGrammar.hs
+++ b/src/compiler/GF/Compile/GetGrammar.hs
@@ -25,29 +25,29 @@ import GF.Grammar.Parser
import GF.Grammar.Grammar
import GF.Grammar.CFG
import GF.Grammar.EBNF
-import GF.Compile.ReadFiles(parseSource,lift)
+import GF.Compile.ReadFiles(parseSource)
import qualified Data.ByteString.Char8 as BS
import Data.Char(isAscii)
import Control.Monad (foldM,when,unless)
import System.Process (system)
-import System.Directory(removeFile,getCurrentDirectory)
+import GF.System.Directory(removeFile,getCurrentDirectory)
import System.FilePath(makeRelative)
-getSourceModule :: Options -> FilePath -> IOE SourceModule
+--getSourceModule :: Options -> FilePath -> IOE SourceModule
getSourceModule opts file0 =
--errIn file0 $
- do tmp <- lift $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
- raw <- lift $ keepTemp tmp
+ do tmp <- liftIO $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
+ raw <- liftIO $ keepTemp tmp
--ePutStrLn $ "1 "++file0
(optCoding,parsed) <- parseSource opts pModDef raw
case parsed of
- Left (Pn l c,msg) -> do file <- lift $ writeTemp tmp
- cwd <- lift $ getCurrentDirectory
+ Left (Pn l c,msg) -> do file <- liftIO $ writeTemp tmp
+ cwd <- getCurrentDirectory
let location = makeRelative cwd file++":"++show l++":"++show c
raise (location++":\n "++msg)
Right (i,mi0) ->
- do lift $ removeTemp tmp
+ do liftIO $ removeTemp tmp
let mi =mi0 {mflags=mflags mi0 `addOptions` opts, msrc=file0}
optCoding' = renameEncoding `fmap` flag optEncoding (mflags mi0)
case (optCoding,optCoding') of
@@ -59,7 +59,7 @@ getSourceModule opts file0 =
raise $ "Encoding mismatch: "++coding++" /= "++coding'
where coding = maybe defaultEncoding renameEncoding optCoding
_ -> return ()
- --lift $ transcodeModule' (i,mi) -- old lexer
+ --liftIO $ transcodeModule' (i,mi) -- old lexer
return (i,mi) -- new lexer
getCFRules :: Options -> FilePath -> IOE [CFRule]
@@ -67,7 +67,7 @@ getCFRules opts fpath = do
raw <- liftIO (BS.readFile fpath)
(optCoding,parsed) <- parseSource opts pCFRules raw
case parsed of
- Left (Pn l c,msg) -> do cwd <- lift $ getCurrentDirectory
+ Left (Pn l c,msg) -> do cwd <- getCurrentDirectory
let location = makeRelative cwd fpath++":"++show l++":"++show c
raise (location++":\n "++msg)
Right rules -> return rules
@@ -77,7 +77,7 @@ getEBNFRules opts fpath = do
raw <- liftIO (BS.readFile fpath)
(optCoding,parsed) <- parseSource opts pEBNFRules raw
case parsed of
- Left (Pn l c,msg) -> do cwd <- lift $ getCurrentDirectory
+ Left (Pn l c,msg) -> do cwd <- getCurrentDirectory
let location = makeRelative cwd fpath++":"++show l++":"++show c
raise (location++":\n "++msg)
Right rules -> return rules
diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs
index 4e57e5ba4..1523e91f1 100644
--- a/src/compiler/GF/Compile/ReadFiles.hs
+++ b/src/compiler/GF/Compile/ReadFiles.hs
@@ -20,8 +20,8 @@
module GF.Compile.ReadFiles
( getAllFiles,ModName,ModEnv,importsOfModule,
- parseSource,lift,
- getOptionsFromFile,getPragmas) where
+ findFile,gfImports,gfoImports,
+ parseSource,getOptionsFromFile,getPragmas) where
import Prelude hiding (catch)
import GF.System.Catch
@@ -32,15 +32,17 @@ import GF.Data.Operations
import GF.Grammar.Lexer
import GF.Grammar.Parser
import GF.Grammar.Grammar
-import GF.Grammar.Binary
+import GF.Grammar.Binary(decodeModuleHeader)
import System.IO(mkTextEncoding)
-import qualified Data.ByteString.UTF8 as UTF8
import GF.Text.Coding(decodeUnicodeIO)
+import qualified Data.ByteString.UTF8 as UTF8
+import qualified Data.ByteString.Char8 as BS
+
import Control.Monad
import Data.Maybe(isJust)
-import qualified Data.ByteString.Char8 as BS
+import Data.Char(isSpace)
import qualified Data.Map as Map
import Data.Time(UTCTime)
import GF.System.Directory(getModificationTime,doesFileExist,canonicalizePath)
@@ -123,8 +125,8 @@ findFile gfoDir ps name =
maybe noSource haveSource =<< getFilePath ps (gfFile name)
where
haveSource gfFile =
- do gfTime <- modtime gfFile
- mb_gfoTime <- maybeIO $ modtime (gf2gfo' gfoDir gfFile)
+ do gfTime <- getModificationTime gfFile
+ mb_gfoTime <- maybeIO $ getModificationTime (gf2gfo' gfoDir gfFile)
return (gfFile, Just gfTime, mb_gfoTime)
noSource =
@@ -133,14 +135,12 @@ findFile gfoDir ps name =
gfoPath = maybe id (:) gfoDir ps
haveGFO gfoFile =
- do gfoTime <- modtime gfoFile
+ do gfoTime <- getModificationTime gfoFile
return (gfoFile, Nothing, Just gfoTime)
noGFO = raise (render ("File" <+> gfFile name <+> "does not exist." $$
"searched in:" <+> vcat ps))
-modtime path = getModificationTime path
-
gfImports opts file = importsOfModule `fmap` parseModHeader opts file
gfoImports gfo = fmap importsOfModule `fmap` liftIO (decodeModuleHeader gfo)
@@ -216,7 +216,7 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
parseModHeader opts file =
do --ePutStrLn file
- (_,parsed) <- parseSource opts pModHeader =<< lift (BS.readFile file)
+ (_,parsed) <- parseSource opts pModHeader =<< liftIO (BS.readFile file)
case parsed of
Right mo -> return mo
Left (Pn l c,msg) ->
@@ -234,43 +234,44 @@ toUTF8 opts0 raw =
then return raw
else if coding=="CP1252" -- Latin1
then return . UTF8.fromString $ BS.unpack raw -- faster
- else lift $
- do --ePutStrLn $ "toUTF8 from "++coding
- enc <- mkTextEncoding coding
- -- decodeUnicodeIO uses a lot of stack space,
- -- so we need to split the file into smaller pieces
- ls <- mapM (decodeUnicodeIO enc) (BS.lines raw)
- return $ UTF8.fromString (unlines ls)
+ else do --ePutStrLn $ "toUTF8 from "++coding
+ recodeToUTF8 coding raw
return (given,utf8)
---lift io = ioe (fmap Ok io `catch` (return . Bad . show))
-lift io = liftIO io
+recodeToUTF8 coding raw =
+ liftIO $
+ do enc <- mkTextEncoding coding
+ -- decodeUnicodeIO uses a lot of stack space,
+ -- so we need to split the file into smaller pieces
+ ls <- mapM (decodeUnicodeIO enc) (BS.lines raw)
+ return $ UTF8.fromString (unlines ls)
-- | options can be passed to the compiler by comments in @--#@, in the main file
-getOptionsFromFile :: (MonadIO m,ErrorMonad m) => FilePath -> m Options
+--getOptionsFromFile :: (MonadIO m,ErrorMonad m) => FilePath -> m Options
getOptionsFromFile file = do
- s <- either (\_ -> raise $ "File " ++ file ++ " does not exist") return =<<
- liftIO (try $ BS.readFile file)
- opts <- getPragmas s
+ opts <- either failed getPragmas =<< (liftIO $ try $ BS.readFile file)
-- The coding flag should not be inherited by other files
return (addOptions opts (modifyFlags $ \ f -> f{optEncoding=Nothing}))
+ where
+ failed _ = raise $ "File " ++ file ++ " does not exist"
getPragmas :: (ErrorMonad m) => BS.ByteString -> m Options
getPragmas = parseModuleOptions .
map (BS.unpack . BS.unwords . BS.words . BS.drop 3) .
- filter (BS.isPrefixOf (BS.pack "--#")) . BS.lines
+ filter (BS.isPrefixOf (BS.pack "--#")) .
+-- takeWhile (BS.isPrefixOf (BS.pack "--")) .
+-- filter (not . BS.null) .
+ map (BS.dropWhile isSpace) .
+ BS.lines
getFilePath :: MonadIO m => [FilePath] -> String -> m (Maybe FilePath)
-getFilePath paths file =
- liftIO $ do --ePutStrLn $ "getFilePath "++show paths++" "++show file
- get paths
+getFilePath paths file = get paths
where
get [] = return Nothing
- get (p:ps) = do
- let pfile = p </> file
- exist <- doesFileExist pfile
- if not exist
- then get ps
- else do pfile <- canonicalizePath pfile
- return (Just pfile)
+ get (p:ps) = do let pfile = p </> file
+ exist <- doesFileExist pfile
+ if not exist
+ then get ps
+ else do pfile <- canonicalizePath pfile
+ return (Just pfile)
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 05:30:29 +0000