msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

.gfo files in binary format

Browse Source
This commit is contained in:
krasimir
2009-01-23 06:15:27 +00:00
parent 3c53194ca9
commit f0718589df
3 changed files with 60 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/GF/Compile.hs
View File

@@ -20,6 +20,7 @@ import GF.Text.UTF8 ----
import GF.Grammar.Grammar
import GF.Grammar.Lookup
import GF.Grammar.PrGrammar
import GF.Grammar.Binary
import GF.Infra.Ident
import GF.Infra.Option
@@ -39,6 +40,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List(nub)
import Data.Maybe (isNothing)
import Data.Binary
import PGF.Check
import PGF.CId
@@ -147,8 +149,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 Normal opts ("+ reading" +++ file) $ getSourceModule opts file
let sm0 = codeSourceModule decodeUTF8 sm00 -- always UTF8 in gfo
sm0 <- putPointE Normal opts ("+ reading" +++ file) $ ioeIO (decodeFile file)
let sm1 = unsubexpModule sm0
sm <- {- putPointE Normal opts "creating indirections" $ -} ioeErr $ extendModule mos sm1
@@ -213,8 +214,10 @@ compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
generateModuleCode opts file minfo = do
let minfo1 = subexpModule minfo
out = codeStringLiterals encodeUTF8 $ prGrammar (MGrammar [minfo1])
putPointE Normal opts (" wrote file" +++ file) $ ioeIO $ writeFile file $ out
minfo2 = case minfo1 of
(m,mi) -> (m,mi{jments=Map.filter (\x -> case x of {AnyInd _ _ -> False; _ -> True}) (jments mi)
, positions=Map.empty})
putPointE Normal opts (" wrote file" +++ file) $ ioeIO $ encodeFile file minfo2
return minfo1
-- auxiliaries
@@ -225,7 +228,7 @@ emptyCompileEnv :: CompileEnv
emptyCompileEnv = (0,emptyMGrammar,Map.empty)
extendCompileEnvInt (_,MGrammar ss,menv) k mfile sm = do
let (mod,imps) = importsOfModule (trModule sm)
let (mod,imps) = importsOfModule sm
menv2 <- case mfile of
Just file -> do
t <- ioeIO $ getModificationTime file

94
src/GF/Compile/ReadFiles.hs
View File

@@ -25,10 +25,15 @@ module GF.Compile.ReadFiles
import GF.Infra.UseIO
import GF.Infra.Option
import GF.Infra.Ident
import GF.Infra.Modules
import GF.Data.Operations
import GF.Source.AbsGF hiding (FileName)
import qualified GF.Source.AbsGF as S
import GF.Source.LexGF
import GF.Source.ParGF
import GF.Source.SourceToGrammar(transModDef)
import GF.Grammar.Grammar
import GF.Grammar.Binary
import Control.Monad
import Data.Char
@@ -100,32 +105,32 @@ getAllFiles opts ps env file = do
let mb_envmod = Map.lookup name env
(st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime
imps <- if st == CSEnv
then return (maybe [] snd mb_envmod)
else do s <- ioeIO $ BS.readFile file
(mname,imps) <- ioeErr ((liftM (importsOfModule . modHeaderToModDef) . pModHeader . myLexer) s)
ioeErr $ testErr (mname == name)
("module name" +++ mname +++ "differs from file name" +++ name)
return imps
(mname,imps) <- case st of
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)
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 :: ModHeader -> ModDef
modHeaderToModDef (MModule2 x y z) = MModule x y (modHeaderBodyToModBody z)
modHeaderToModDef :: S.ModHeader -> SourceModule
modHeaderToModDef (S.MModule2 x y z) =
errVal (error "error in modHeaderToModDef") $ transModDef $ S.MModule x y (modHeaderBodyToModBody z)
where
modHeaderBodyToModBody :: ModHeaderBody -> ModBody
modHeaderBodyToModBody :: S.ModHeaderBody -> S.ModBody
modHeaderBodyToModBody b = case b of
MBody2 x y -> MBody x y []
MNoBody2 x -> MNoBody x
MWith2 x y -> MWith x y
MWithBody2 x y z -> MWithBody x y z []
MWithE2 x y z -> MWithE x y z
MWithEBody2 x y z w -> MWithEBody x y z w []
MReuse2 x -> MReuse x
MUnion2 x -> MUnion x
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
@@ -167,42 +172,35 @@ data CompStatus =
type ModuleInfo = (ModName,CompStatus,Maybe ClockTime,[ModName],InitPath)
importsOfModule :: ModDef -> (ModName,[ModName])
importsOfModule (MModule _ typ body) = modType typ (modBody body [])
importsOfModule :: SourceModule -> (ModName,[ModName])
importsOfModule (m,mi) = (modName m,depModInfo mi [])
where
modType (MTAbstract m) xs = (modName m,xs)
modType (MTResource m) xs = (modName m,xs)
modType (MTInterface m) xs = (modName m,xs)
modType (MTConcrete m m2) xs = (modName m,modName m2:xs)
modType (MTInstance m m2) xs = (modName m,modName m2:xs)
modType (MTTransfer m o1 o2) xs = (modName m,open o1 (open o2 xs))
depModInfo mi =
depModType (mtype mi) .
depExtends (extend mi) .
depWith (mwith mi) .
depOpens (opens mi)
modBody (MBody e o _) xs = extend e (opens o xs)
modBody (MNoBody is) xs = foldr include xs is
modBody (MWith i os) xs = include i (foldr open xs os)
modBody (MWithBody i os o _) xs = include i (foldr open (opens o xs) os)
modBody (MWithE is i os) xs = foldr include (include i (foldr open xs os)) is
modBody (MWithEBody is i os o _) xs = foldr include (include i (foldr open (opens o xs) os)) is
modBody (MReuse m) xs = modName m:xs
modBody (MUnion is) xs = foldr include xs is
depModType (MTAbstract) xs = xs
depModType (MTResource) xs = xs
depModType (MTInterface) xs = xs
depModType (MTConcrete m2) xs = modName m2:xs
depModType (MTInstance m2) xs = modName m2:xs
depModType (MTTransfer o1 o2) xs = depOpen o1 (depOpen o2 xs)
include (IAll m) xs = modName m:xs
include (ISome m _) xs = modName m:xs
include (IMinus m _) xs = modName m:xs
depExtends es xs = foldr depInclude xs es
open (OName n) xs = modName n:xs
open (OQualQO _ n) xs = modName n:xs
open (OQual _ _ n) xs = modName n:xs
depWith (Just (m,_,os)) xs = modName m : depOpens os xs
depWith Nothing xs = xs
extend NoExt xs = xs
extend (Ext is) xs = foldr include xs is
depOpens os xs = foldr depOpen xs os
opens NoOpens xs = xs
opens (OpenIn os) xs = foldr open xs os
depInclude (m,_) xs = modName m:xs
modName (PIdent (_,s)) = BS.unpack s
depOpen (OSimple n ) xs = modName n:xs
depOpen (OQualif _ n) xs = modName n:xs
modName = prIdent
-- | options can be passed to the compiler by comments in @--#@, in the main file
getOptionsFromFile :: FilePath -> IOE Options

6
src/GF/Grammar/Binary.hs
View File

@@ -10,6 +10,7 @@
module GF.Grammar.Binary where
import Data.Binary
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS
import GF.Data.Operations
@@ -260,3 +261,8 @@ instance Binary Label where
instance Binary MetaSymb where
put (MetaSymb m) = put m
get = fmap MetaSymb get
decodeModHeader :: FilePath -> IO SourceModule
decodeModHeader fpath = do
(m,mtype,mstatus,flags,extend,mwith,opens) <- decodeFile fpath
return (m,ModInfo mtype mstatus flags extend mwith opens Map.empty Map.empty)