diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs index 01679f727..a52167450 100644 --- a/src/compiler/GF/Compile.hs +++ b/src/compiler/GF/Compile.hs @@ -33,7 +33,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Data.List(nub) import Data.Maybe (isNothing) -import Data.Binary import qualified Data.ByteString.Char8 as BS import Text.PrettyPrint @@ -144,7 +143,7 @@ compileOne opts env@(_,srcgr,_) file = do -- for compiled gf, read the file and update environment -- also undo common subexp optimization, to enable normal computations ".gfo" -> do - sm00 <- putPointE Verbose opts ("+ reading" +++ file) $ ioeIO (decodeFile file) + sm00 <- putPointE Verbose opts ("+ reading" +++ file) $ ioeIO (decodeModule file) let sm0 = (fst sm00, (snd sm00) {mflags = mflags (snd sm00) `addOptions` opts}) intermOut opts DumpSource (ppModule Internal sm0) @@ -243,7 +242,7 @@ writeGFO opts file mo = do let mo1 = subexpModule mo mo2 = case mo1 of (m,mi) -> (m,mi{jments=Map.filter (\x -> case x of {AnyInd _ _ -> False; _ -> True}) (jments mi)}) - putPointE Normal opts (" write file" +++ file) $ ioeIO $ encodeFile file mo2 + putPointE Normal opts (" write file" +++ file) $ ioeIO $ encodeModule file mo2 -- auxiliaries diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs index 5c3ac660d..a64bb2a06 100644 --- a/src/compiler/GF/Compile/ReadFiles.hs +++ b/src/compiler/GF/Compile/ReadFiles.hs @@ -108,13 +108,22 @@ getAllFiles opts ps env file = do let mb_envmod = Map.lookup name env (st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime - (mname,imps) <- case st of - CSEnv -> return (name, maybe [] snd mb_envmod) - CSRead -> ioeIO $ fmap importsOfModule (decodeModHeader ((if isGFO file then id else gf2gfo opts) file)) + (st,(mname,imps)) <- + case st of + CSEnv -> return (st, (name, maybe [] snd mb_envmod)) + CSRead -> do mb_mo <- ioeIO $ decodeModuleHeader ((if isGFO file then id else gf2gfo opts) file) + case mb_mo of + Just mo -> return (st,importsOfModule mo) + Nothing + | isGFO file -> ioeErr $ Bad (file ++ " is compiled with different GF version and I cannot find the source file") + | otherwise -> do s <- ioeIO $ BS.readFile file + case runP pModHeader s of + Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg) + Right mo -> return (CSComp,importsOfModule mo) CSComp -> do s <- ioeIO $ BS.readFile file case runP pModHeader s of Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg) - Right mo -> return (importsOfModule mo) + Right mo -> return (st,importsOfModule mo) ioeErr $ testErr (mname == name) ("module name" +++ mname +++ "differs from file name" +++ name) return (name,st,t,isJust gfTime,imps,dropFileName file) diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs index d1a3ac413..20adf3c48 100644 --- a/src/compiler/GF/Grammar/Binary.hs +++ b/src/compiler/GF/Grammar/Binary.hs @@ -9,7 +9,9 @@ module GF.Grammar.Binary where +import Data.Char import Data.Binary +import Control.Monad import qualified Data.Map as Map import qualified Data.ByteString.Char8 as BS @@ -18,7 +20,11 @@ import GF.Infra.Ident import GF.Infra.Option import GF.Grammar.Grammar -import PGF.Binary hiding (decodingError) +import PGF.Binary + +-- Please change this every time when the GFO format is changed +gfoVersion = "GF01" + instance Binary Ident where put id = put (ident2bs id) @@ -274,9 +280,24 @@ instance Binary Label where 1 -> fmap LVar get _ -> decodingError -decodeModHeader :: FilePath -> IO SourceModule -decodeModHeader fpath = do - (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) <- decodeFile fpath + +putGFOVersion = mapM_ (putWord8 . fromIntegral . ord) gfoVersion +getGFOVersion = replicateM (length gfoVersion) (fmap (chr . fromIntegral) getWord8) + +decodeModule :: FilePath -> IO SourceModule +decodeModule fpath = do + (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) <- decodeFile_ fpath (getGFOVersion >> get) return (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty) -decodingError = fail "This GFO file was compiled with different version of GF" +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 + +encodeModule :: FilePath -> SourceModule -> IO () +encodeModule fpath mo = + encodeFile_ fpath (putGFOVersion >> put mo) diff --git a/src/runtime/haskell/Data/Binary.hs b/src/runtime/haskell/Data/Binary.hs index ab6fcc2a3..2bebaf148 100644 --- a/src/runtime/haskell/Data/Binary.hs +++ b/src/runtime/haskell/Data/Binary.hs @@ -48,6 +48,9 @@ module Data.Binary ( , encodeFile -- :: Binary a => FilePath -> a -> IO () , decodeFile -- :: Binary a => FilePath -> IO a + , encodeFile_ -- :: FilePath -> Put -> IO () + , decodeFile_ -- :: FilePath -> Get a -> IO a + -- Lazy put and get -- , lazyPut -- , lazyGet @@ -254,6 +257,9 @@ decode = runGet get encodeFile :: Binary a => FilePath -> a -> IO () encodeFile f v = L.writeFile f (encode v) +encodeFile_ :: FilePath -> Put -> IO () +encodeFile_ f m = L.writeFile f (runPut m) + -- | Lazily reconstruct a value previously written to a file. -- -- This is just a convenience function, it's defined simply as: @@ -269,6 +275,11 @@ decodeFile f = bracket (openBinaryFile f ReadMode) hClose $ \h -> do s <- L.hGetContents h evaluate $ runGet get s +decodeFile_ :: FilePath -> Get a -> IO a +decodeFile_ f m = bracket (openBinaryFile f ReadMode) hClose $ \h -> do + s <- L.hGetContents h + evaluate $ runGet m s + -- needs bytestring 0.9.1.x to work ------------------------------------------------------------------------ diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs index 32b751159..22a6ef464 100644 --- a/src/runtime/haskell/PGF/Binary.hs +++ b/src/runtime/haskell/PGF/Binary.hs @@ -200,4 +200,4 @@ getArray2 = do n <- get -- read the length xs <- replicateM n getArray -- now the elems. return (listArray (0,n-1) xs) -decodingError = fail "This PGF file was compiled with different version of GF" +decodingError = fail "This file was compiled with different version of GF"