changed names of resource-1.3; added a note on homepage on release

1 files changed, 195 insertions, 0 deletions

diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs
new file mode 100644
index 000000000..cd2faec15
--- /dev/null
+++ b/src/GF/Compile/ReadFiles.hs
@@ -0,0 +1,195 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ReadFiles
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.26 $
+--
+-- Decide what files to read as function of dependencies and time stamps.
+--
+-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
+--
+-- to find all files that have to be read, put them in dependency order, and
+-- decide which files need recompilation. Name @file.gf@ is returned for them,
+-- and @file.gfo@ otherwise.
+-----------------------------------------------------------------------------
+
+module GF.Compile.ReadFiles 
+           ( getAllFiles,ModName,ModEnv,importsOfModule,
+             gfoFile,gfFile,isGFO,
+             getOptionsFromFile) where
+
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Source.AbsGF hiding (FileName)
+import GF.Source.LexGF
+import GF.Source.ParGF
+
+import Control.Monad
+import Data.Char
+import Data.List
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map as Map
+import System.Time
+import System.Directory
+import System.FilePath
+
+type ModName = String
+type ModEnv  = Map.Map ModName (ClockTime,[ModName])
+
+
+-- | Returns a list of all files to be compiled in topological order i.e.
+-- the low level (leaf) modules are first.
+getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles opts ps env file = do
+  -- read module headers from all files recursively
+  ds <- liftM reverse $ get [] [] (justModuleName file)
+  ioeIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds]
+  return $ paths ds
+  where
+    -- construct list of paths to read
+    paths cs = [mk (p </> f) | (f,st,_,_,p) <- cs, mk <- mkFile st]
+      where
+        mkFile CSComp = [gfFile ]
+        mkFile CSRead = [gfoFile]
+        mkFile _      = []
+
+    -- | traverses the dependency graph and returns a topologicaly sorted
+    -- list of ModuleInfo. An error is raised if there is circular dependency
+    get :: [ModName]          -- ^ keeps the current path in the dependency graph to avoid cycles
+        -> [ModuleInfo]       -- ^ a list of already traversed modules
+        -> ModName            -- ^ the current module
+        -> IOE [ModuleInfo]   -- ^ the final 
+    get trc ds name
+      | name `elem` trc = ioeErr $ Bad $ "circular modules" +++ unwords trc
+      | (not . null) [n | (n,_,_,_,_) <- ds, name == n]     --- file already read
+                        = return ds
+      | otherwise       = do
+           (name,st0,t0,imps,p) <- findModule name
+           ds <- foldM (get (name:trc)) ds imps
+           let (st,t) | (not . null) [f | (f,CSComp,_,_,_) <- ds, elem f imps]
+                                  = (CSComp,Nothing)
+                      | otherwise = (st0,t0)
+           return ((name,st,t,imps,p):ds)
+
+    -- searches for module in the search path and if it is found
+    -- returns 'ModuleInfo'. It fails if there is no such module
+    findModule :: ModName -> IOE ModuleInfo
+    findModule name = do
+      (file,gfTime,gfoTime) <- do
+          mb_gfFile <- ioeIO $ getFilePathMsg "" ps (gfFile name)
+          case mb_gfFile of
+            Just gfFile -> do gfTime  <- ioeIO $ getModificationTime gfFile
+                              mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo"))
+                                                        (\_->return Nothing)
+                              return (gfFile, Just gfTime, mb_gfoTime)
+            Nothing     -> do mb_gfoFile <- ioeIO $ getFilePathMsg "" ps (gfoFile name)
+                              case mb_gfoFile of
+                                Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile
+                                                   return (gfoFile, Nothing, Just gfoTime)
+                                Nothing      -> ioeErr $ Bad ("File " ++ gfFile name ++ " does not exist.")
+
+
+      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 . pModHeader . myLexer) s)
+                        ioeErr $ testErr  (mname == name)
+                                          ("module name" +++ mname +++ "differs from file name" +++ name)
+                        return imps
+
+      return (name,st,t,imps,dropFileName file)
+
+
+isGFO :: FilePath -> Bool
+isGFO = (== ".gfo") . takeExtensions
+
+gfoFile :: FilePath -> FilePath
+gfoFile f = addExtension f "gfo"
+
+gfFile :: FilePath -> FilePath
+gfFile f = addExtension f "gf"
+
+
+-- From the given Options and the time stamps computes
+-- whether the module have to be computed, read from .gfo or
+-- the environment version have to be used
+selectFormat :: Options -> Maybe ClockTime -> Maybe ClockTime -> Maybe ClockTime -> (CompStatus,Maybe ClockTime)
+selectFormat opts mtenv mtgf mtgfo =
+  case (mtenv,mtgfo,mtgf) of
+    (_,_,Just tgf)         | fromSrc  -> (CSComp,Nothing)
+    (Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
+    (_,Just tgfo,_)        | fromComp -> (CSRead,Just tgfo)
+    (Just tenv,_,Just tgf) | tenv > tgf -> (CSEnv, Just tenv)
+    (_,Just tgfo,Just tgf) | tgfo > tgf -> (CSRead,Just tgfo)
+    (Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
+    (_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
+    _ -> (CSComp,Nothing)
+  where
+    fromComp = flag optRecomp opts == NeverRecomp
+    fromSrc  = flag optRecomp opts == AlwaysRecomp
+
+
+-- internal module dep information
+
+
+data CompStatus =
+   CSComp -- compile: read gf
+ | CSRead -- read gfo
+ | CSEnv  -- gfo is in env
+  deriving Eq
+
+type ModuleInfo = (ModName,CompStatus,Maybe ClockTime,[ModName],InitPath)
+
+ 
+importsOfModule :: ModDef -> (ModName,[ModName])
+importsOfModule (MModule _ typ body) = modType typ (modBody body [])
+  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
+
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile :: FilePath -> IOE Options
+getOptionsFromFile file = do
+  s <- ioeIO $ readFileIfStrict file
+  let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
+      fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
+  ioeErr $ liftM moduleOptions $ parseModuleOptions fs