reorganize the directories under src, and rescue the JavaScript interpreter from deprecated

src/compiler/GF/Compile/ReadFiles.hs

@@ -0,0 +1,220 @@
+----------------------------------------------------------------------
+-- |
+-- 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,gf2gfo,
+             getOptionsFromFile) where
+
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Data.Operations
+import GF.Grammar.Lexer
+import GF.Grammar.Parser
+import GF.Grammar.Grammar
+import GF.Grammar.Binary
+
+import Control.Monad
+import Data.Char
+import Data.List
+import Data.Maybe(isJust)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map as Map
+import System.Time
+import System.Directory
+import System.FilePath
+import Text.PrettyPrint
+
+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 ds = concatMap mkFile ds
+      where
+        mkFile (f,st,gfTime,gfoTime,p) =
+          case st of 
+            CSComp                 -> [p </> gfFile f]
+            CSRead | isJust gfTime -> [gf2gfo opts (p </> gfFile f)]
+                   | otherwise     -> [p </> gfoFile f]
+            CSEnv                  -> []
+
+    -- | 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,_,t1,_,_) <- ds, elem f imps && liftM2 (>=) t0 t1 /= Just True]
+                                  = (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 $ getFilePath ps (gfFile name)
+          case mb_gfFile of
+            Just gfFile -> do gfTime  <- ioeIO $ getModificationTime gfFile
+                              mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (gf2gfo opts gfFile))
+                                                          (\_->return Nothing)
+                              return (gfFile, Just gfTime, mb_gfoTime)
+            Nothing     -> do mb_gfoFile <- ioeIO $ getFilePath (maybe id (:) (flag optGFODir opts) ps) (gfoFile name)
+                              case mb_gfoFile of
+                                Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile
+                                                   return (gfoFile, Nothing, Just gfoTime)
+                                Nothing      -> ioeErr $ Bad (render (text "File" <+> text (gfFile name) <+> text "does not exist." $$
+                                                                      text "searched in:" <+> vcat (map text ps)))
+
+
+      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))
+                        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)
+      ioeErr $ testErr (mname == name)
+                       ("module name" +++ mname +++ "differs from file name" +++ name)
+      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"
+
+gf2gfo :: Options -> FilePath -> FilePath
+gf2gfo opts file = maybe (gfoFile (dropExtension file))
+                         (\dir -> dir </> gfoFile (dropExtension (takeFileName file)))
+                         (flag optGFODir opts)
+
+-- 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
+    (_,Just tgfo,Nothing) -> (CSRead,Just tgfo)  -- 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 :: SourceModule -> (ModName,[ModName])
+importsOfModule (m,mi) = (modName m,depModInfo mi [])
+  where
+    depModInfo mi =
+      depModType (mtype mi)  .
+      depExtends (extend mi) .
+      depWith    (mwith mi)  .
+      depExDeps  (mexdeps 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
+
+    depExtends es xs = foldr depInclude xs es
+
+    depWith (Just (m,_,is)) xs = modName m : depInsts is xs
+    depWith Nothing         xs = xs
+
+    depExDeps eds xs = map modName eds ++ xs
+
+    depOpens os xs = foldr depOpen xs os
+
+    depInsts is xs = foldr depInst xs is
+
+    depInclude (m,_) xs = modName m:xs
+
+    depOpen (OSimple n  ) xs = modName n:xs
+    depOpen (OQualif _ n) xs = modName n:xs
+
+    depInst (m,n) xs = modName m:modName n:xs
+
+    modName = showIdent
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile :: FilePath -> IOE Options
+getOptionsFromFile file = do
+  s <- ioe $ catch (fmap Ok $ BS.readFile file)
+                   (\_ -> return (Bad $ "File " ++ file ++ " does not exist"))
+  let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
+      fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
+  ioeErr $ parseModuleOptions fs
+
+getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
+getFilePath paths file = get paths
+  where
+    get []     = return Nothing
+    get (p:ps) = do
+      let pfile = p </> file
+      exist <- doesFileExist pfile
+      if not exist
+        then get ps
+        else do pfile <- canonicalizePath pfile
+                return (Just pfile)