diff options
Diffstat (limited to 'src/compiler/GF')
| -rw-r--r-- | src/compiler/GF/Compile/ReadFiles.hs | 14 | ||||
| -rw-r--r-- | src/compiler/GF/CompileInParallel.hs | 8 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Binary.hs | 35 |
3 files changed, 26 insertions, 31 deletions
diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs index 3182e192c..9396b3a2f 100644 --- a/src/compiler/GF/Compile/ReadFiles.hs +++ b/src/compiler/GF/Compile/ReadFiles.hs @@ -20,7 +20,7 @@ module GF.Compile.ReadFiles ( getAllFiles,ModName,ModEnv,importsOfModule, - findFile,gfImports,gfoImports, + findFile,gfImports,gfoImports,VersionTagged(..), parseSource,getOptionsFromFile,getPragmas) where import Prelude hiding (catch) @@ -32,7 +32,7 @@ import GF.Data.Operations import GF.Grammar.Lexer import GF.Grammar.Parser import GF.Grammar.Grammar -import GF.Grammar.Binary(decodeModuleHeader) +import GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader) import System.IO(mkTextEncoding) import GF.Text.Coding(decodeUnicodeIO) @@ -107,10 +107,10 @@ getAllFiles opts ps env file = do case st of CSEnv -> return (st, (name, maybe [] snd mb_envmod)) CSRead -> do let gfo = if isGFO file then file else gf2gfo opts file - mb_imps <- gfoImports gfo - case mb_imps of - Just imps -> return (st,imps) - Nothing + t_imps <- gfoImports gfo + case t_imps of + Tagged imps -> return (st,imps) + WrongVersion | isGFO file -> raise (file ++ " is compiled with different GF version and I can't find the source file") | otherwise -> do imps <- gfImports opts file return (CSComp,imps) @@ -143,7 +143,7 @@ findFile gfoDir ps name = gfImports opts file = importsOfModule `fmap` parseModHeader opts file -gfoImports gfo = fmap importsOfModule `fmap` liftIO (decodeModuleHeader gfo) +gfoImports gfo = fmap importsOfModule `fmap` decodeModuleHeader gfo -------------------------------------------------------------------------------- diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 4f5c0f76b..07c29febd 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -9,7 +9,7 @@ import qualified GF.System.Directory as D import GF.System.Catch(catch,try) import Data.List(nub,isPrefixOf,intercalate,partition) import qualified Data.Map as M -import GF.Compile.ReadFiles(getOptionsFromFile,findFile,gfImports,gfoImports) +import GF.Compile.ReadFiles(getOptionsFromFile,findFile,gfImports,gfoImports,VersionTagged(..)) import GF.CompileOne(reuseGFO,useTheSource) import GF.Infra.Option import GF.Infra.UseIO @@ -177,8 +177,10 @@ getPathFromFile lib_dir cmdline_opts file = getImports opts file = if isGFO file then gfoImports' file else gfImports opts file where - gfoImports' file = maybe bad return =<< gfoImports file - where bad = raise $ file++": bad .gfo file" + gfoImports' file = check =<< gfoImports file + where + check (Tagged imps) = return imps + check WrongVersion = raise $ file++": .gfo file version mismatch" relativeTo lib_dir cwd path = if length librel<length cwdrel then librel else cwdrel diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs index 5aed63363..725ae9284 100644 --- a/src/compiler/GF/Grammar/Binary.hs +++ b/src/compiler/GF/Grammar/Binary.hs @@ -7,15 +7,13 @@ --
-----------------------------------------------------------------------------
-module GF.Grammar.Binary(decodeModule,decodeModuleHeader,encodeModule) where
+module GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader,decodeModule,encodeModule) where
import Prelude hiding (catch)
import Control.Exception(catch,ErrorCall(..),throwIO)
---import Data.Char
import PGF.Internal(Binary(..),Word8,putWord8,getWord8,encodeFile,decodeFile)
---import Control.Monad
-import qualified Data.Map as Map
+import qualified Data.Map as Map(empty)
import qualified Data.ByteString.Char8 as BS
import GF.Data.Operations
@@ -28,7 +26,7 @@ import PGF() -- Binary instances import PGF.Internal(Literal(..))
-- Please change this every time when the GFO format is changed
-gfoVersion = "GF03"
+gfoVersion = "GF04"
instance Binary Ident where
put id = put (ident2utf8 id)
@@ -315,6 +313,10 @@ instance Binary a => Binary (VersionTagged a) where then fmap Tagged get
else return WrongVersion
+instance Functor VersionTagged where
+ fmap f (Tagged a) = Tagged (f a)
+ fmap f WrongVersion = WrongVersion
+
gfoBinVersion = (b1,b2,b3,b4)
where [b1,b2,b3,b4] = map (toEnum.fromEnum) gfoVersion :: [Word8]
@@ -324,23 +326,14 @@ decodeModule fpath = liftIO $ check =<< decodeFile' fpath where
check (Tagged m) = return m
check _ = fail ".gfo file version mismatch"
-{-
-decodeModuleHeader fpath = decodeFile_ fpath getVersionedMod
- where
- getVersionedMod = do
- ver <- getGFOVersion
- if ver == gfoVersion
- then do (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) <- get
- return (Just (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty))
- else return Nothing
---}
---{-
-decodeModuleHeader fpath = fmap check $ decodeFile' fpath
+
+-- | Read just the module header, the returned 'Module' will have an empty body
+decodeModuleHeader :: MonadIO io => FilePath -> io (VersionTagged Module)
+decodeModuleHeader = liftIO . fmap (fmap conv) . decodeFile'
where
- check (Tagged (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc)) =
- (Just (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty))
- check _ = Nothing
---}
+ conv (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) =
+ (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty)
+
encodeModule :: MonadIO io => FilePath -> SourceModule -> io ()
encodeModule fpath mo = liftIO $ encodeFile fpath (Tagged mo)
|