diff options
| -rw-r--r-- | src/GF/Compile.hs | 13 | ||||
| -rw-r--r-- | src/GF/Compile/ReadFiles.hs | 106 | ||||
| -rw-r--r-- | src/GF/Grammar/Binary.hs | 6 |
3 files changed, 66 insertions, 59 deletions
diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs index 72dedec50..c00b1bd67 100644 --- a/src/GF/Compile.hs +++ b/src/GF/Compile.hs @@ -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 diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs index 19bcc013b..de61d5e42 100644 --- a/src/GF/Compile/ReadFiles.hs +++ b/src/GF/Compile/ReadFiles.hs @@ -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)) - - 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 - - include (IAll m) xs = modName m:xs - include (ISome m _) xs = modName m:xs - include (IMinus m _) xs = modName m:xs - - open (OName n) xs = modName n:xs - open (OQualQO _ n) xs = modName n:xs - open (OQual _ _ n) xs = modName n:xs - - extend NoExt xs = xs - extend (Ext is) xs = foldr include xs is - - opens NoOpens xs = xs - opens (OpenIn os) xs = foldr open xs os - - modName (PIdent (_,s)) = BS.unpack s + depModInfo mi = + depModType (mtype mi) . + depExtends (extend mi) . + depWith (mwith mi) . + depOpens (opens mi) + + 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) + + depExtends es xs = foldr depInclude xs es + + depWith (Just (m,_,os)) xs = modName m : depOpens os xs + depWith Nothing xs = xs + + depOpens os xs = foldr depOpen xs os + + depInclude (m,_) xs = modName m:xs + + 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 diff --git a/src/GF/Grammar/Binary.hs b/src/GF/Grammar/Binary.hs index 46069d7c3..cb2690425 100644 --- a/src/GF/Grammar/Binary.hs +++ b/src/GF/Grammar/Binary.hs @@ -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)
|