diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile.hs | 5 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/ReadFiles.hs | 17 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Binary.hs | 31 | ||||
| -rw-r--r-- | src/runtime/haskell/Data/Binary.hs | 11 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Binary.hs | 2 |
5 files changed, 53 insertions, 13 deletions
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"
|