summaryrefslogtreecommitdiff
path: root/src/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Compile')
-rw-r--r--src/GF/Compile/CheckGrammar.hs9
-rw-r--r--src/GF/Compile/GetGrammar.hs38
-rw-r--r--src/GF/Compile/ReadFiles.hs27
3 files changed, 25 insertions, 49 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index e128c3477..61c361199 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -30,12 +30,12 @@ import GF.Infra.Modules
import GF.Compile.TypeCheck
import GF.Compile.Refresh
+import GF.Grammar.Lexer
import GF.Grammar.Grammar
import GF.Grammar.PrGrammar
import GF.Grammar.Lookup
import GF.Grammar.Predef
import GF.Grammar.Macros
-import GF.Grammar.ReservedWords
import GF.Grammar.PatternMatch
import GF.Grammar.AppPredefined
import GF.Grammar.Lockfield (isLockLabel)
@@ -403,10 +403,9 @@ checkPrintname _ _ = return ()
-- | for grammars obtained otherwise than by parsing ---- update!!
checkReservedId :: Ident -> Check ()
-checkReservedId x = let c = prt x in
- if isResWord c
- then checkWarn ("Warning: reserved word used as identifier:" +++ c)
- else return ()
+checkReservedId x
+ | isReservedWord (ident2bs x) = checkWarn ("Warning: reserved word used as identifier:" +++ prt x)
+ | otherwise = return ()
-- to normalize records and record types
labelIndex :: Type -> Label -> Int
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index c2d7a3f8b..c85f9588f 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -18,15 +18,10 @@ import GF.Data.Operations
import GF.Infra.UseIO
import GF.Infra.Modules
-import GF.Grammar.Grammar
-import qualified GF.Source.AbsGF as A
-import GF.Source.SourceToGrammar
----- import Macros
----- import Rename
import GF.Infra.Option
---- import Custom
-import GF.Source.ParGF
-import qualified GF.Source.LexGF as L
+import GF.Grammar.Lexer
+import GF.Grammar.Parser
+import GF.Grammar.Grammar
import GF.Compile.ReadFiles
@@ -37,22 +32,21 @@ import Control.Monad (foldM)
import System.Cmd (system)
getSourceModule :: Options -> FilePath -> IOE SourceModule
-getSourceModule opts file0 = do
- file <- foldM runPreprocessor file0 (flag optPreprocessors opts)
- string <- readFileIOE file
- let tokens = myLexer string
- mo1 <- ioeErr $ errIn file0 $ pModDef tokens
- mo2 <- ioeErr $ transModDef mo1
- return $ addOptionsToModule opts mo2
+getSourceModule opts file0 = ioe $
+ catch (do file <- foldM runPreprocessor file0 (flag optPreprocessors opts)
+ content <- BS.readFile file
+ case runP pModDef content of
+ Left (Pn l c,msg) -> return (Bad (file++":"++show l++":"++show c++": "++msg))
+ Right mo -> return (Ok (addOptionsToModule opts mo)))
+ (\e -> return (Bad (show e)))
addOptionsToModule :: Options -> SourceModule -> SourceModule
addOptionsToModule opts = mapSourceModule (\m -> m { flags = flags m `addOptions` opts })
-- FIXME: should use System.IO.openTempFile
-runPreprocessor :: FilePath -> String -> IOE FilePath
-runPreprocessor file0 p =
- do let tmp = "_gf_preproc.tmp"
- cmd = p +++ file0 ++ ">" ++ tmp
- ioeIO $ system cmd
- -- ioeIO $ putStrLn $ "preproc" +++ cmd
- return tmp
+runPreprocessor :: FilePath -> String -> IO FilePath
+runPreprocessor file0 p = do
+ let tmp = "_gf_preproc.tmp"
+ cmd = p +++ file0 ++ ">" ++ tmp
+ system cmd
+ return tmp
diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs
index 492dbdcf2..fbe1fda0b 100644
--- a/src/GF/Compile/ReadFiles.hs
+++ b/src/GF/Compile/ReadFiles.hs
@@ -29,9 +29,8 @@ import GF.Infra.Ident
import GF.Infra.Modules
import GF.Data.Operations
import qualified GF.Source.AbsGF as S
-import GF.Source.LexGF
-import GF.Source.ParGF
-import GF.Source.SourceToGrammar(transModDef)
+import GF.Grammar.Lexer
+import GF.Grammar.Parser
import GF.Grammar.Grammar
import GF.Grammar.Binary
@@ -109,29 +108,13 @@ getAllFiles opts ps env file = do
CSEnv -> return (name, maybe [] snd mb_envmod)
CSRead -> ioeIO $ fmap importsOfModule (decodeModHeader (replaceExtension file "gfo"))
CSComp -> do s <- ioeIO $ BS.readFile file
- ioeErr ((liftM (importsOfModule . modHeaderToModDef) . pModHeader . myLexer) s)
+ case runP pModHeader s of
+ Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)
+ Right mo -> return (importsOfModule mo)
ioeErr $ testErr (mname == name)
("module name" +++ mname +++ "differs from file name" +++ name)
return (name,st,t,imps,dropFileName file)
--- FIXME: this is pretty ugly, it's just to get around the difference
--- between ModHeader as returned when parsing just the module header
--- when looking for imports, and ModDef, which includes the whole module.
-modHeaderToModDef :: S.ModHeader -> SourceModule
-modHeaderToModDef (S.MModule2 x y z) =
- errVal (error "error in modHeaderToModDef") $ transModDef $ S.MModule x y (modHeaderBodyToModBody z)
- where
- modHeaderBodyToModBody :: S.ModHeaderBody -> S.ModBody
- modHeaderBodyToModBody b = case b of
- S.MBody2 x y -> S.MBody x y []
- S.MNoBody2 x -> S.MNoBody x
- S.MWith2 x y -> S.MWith x y
- S.MWithBody2 x y z -> S.MWithBody x y z []
- S.MWithE2 x y z -> S.MWithE x y z
- S.MWithEBody2 x y z w -> S.MWithEBody x y z w []
- S.MReuse2 x -> S.MReuse x
- S.MUnion2 x -> S.MUnion x
-
isGFO :: FilePath -> Bool
isGFO = (== ".gfo") . takeExtensions