diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Compile/Compile.hs | 15 | ||||
| -rw-r--r-- | src/GF/Infra/ReadFiles.hs | 218 | ||||
| -rw-r--r-- | src/GF/Infra/UseIO.hs | 7 | ||||
| -rw-r--r-- | src/GF/System/Arch.hs | 25 | ||||
| -rw-r--r-- | src/Today.hs | 2 |
5 files changed, 197 insertions, 70 deletions
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index c83d628c7..77d9db11c 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -62,7 +62,7 @@ compileModule opts st0 file | oElem showOld opts = do let env = compileEnvShSt st0 [] (_,sgr,cgr) <- foldM (comp putp path) env mods return $ (reverseModules cgr, -- to preserve dependency order - (reverseModules sgr,[])) + (reverseModules sgr,[])) where comp putp path env sm0 = do (k',sm) <- makeSourceModule opts env sm0 @@ -78,22 +78,23 @@ compileModule opts1 st0 file = do let ps = if useFileOpt then (map (prefixPathName fpath) ps0) else ps0 - ioeIO $ print ps ---- + ioeIO $ putStrLn $ "module search path:" +++ show ps ---- let putp = putPointE opts let st = st0 --- if useFileOpt then emptyShellState else st0 let rfs = readFiles st let file' = if useFileOpt then justFileName file else file -- to find file itself files <- getAllFiles ps rfs file' - ioeIO $ print files ---- - let names = map (fileBody . justFileName) files - ioeIO $ print names ---- + ioeIO $ putStrLn $ "files to read:" +++ show files ---- + let names = map justModuleName files + ioeIO $ putStrLn $ "modules to include:" +++ show names ---- let env0 = compileEnvShSt st names (_,sgr,cgr) <- foldM (compileOne opts) env0 files t <- ioeIO getNowTime return $ (reverseModules cgr, -- to preserve dependency order (reverseModules sgr, --- keepResModules opts sgr, --- keep all so far - [])) ---- (f,t) | f <- files])) -- pass on the time of creation - + [(justModuleName f,t) | f <- files] -- pass on the time of reading + ++ [(resModName (justModuleName f),t) -- also #file if file.(gf|gfr) + | f <- files, not (isGFC f)])) compileEnvShSt :: ShellState -> [ModName] -> CompileEnv compileEnvShSt st fs = (0,sgr,cgr) where cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i] diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs index 285665747..7b95141c7 100644 --- a/src/GF/Infra/ReadFiles.hs +++ b/src/GF/Infra/ReadFiles.hs @@ -1,6 +1,14 @@ -module ReadFiles where +module ReadFiles +--- where -import Arch (selectLater, modifiedFiles, ModTime) +-- +( +-- +getAllFiles,fixNewlines,ModName,getOptionsFromFile, +-- +gfcFile,gfFile,gfrFile,isGFC,resModName) where + +import Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime) import Option import Operations @@ -10,78 +18,121 @@ import Char import Monad import List --- make analysis for GF grammar modules. AR 11/6/2003 +-- 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.gfc or file.gfr otherwise. type ModName = String -type FileName = String -type InitPath = String -type FullPath = String +type ModEnv = [(ModName,ModTime)] -getAllFiles :: [InitPath] -> [(FullPath,ModTime)] -> FileName -> - IOE [FullPath] +getAllFiles :: [InitPath] -> ModEnv -> FileName -> IOE [FullPath] getAllFiles ps env file = do - ds <- getImports ps file - -- print ds ---- debug + + -- read module headers from all files recursively + ds0 <- getImports ps file + let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0] + ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds) + + -- get a topological sorting of files: returns file names --- deletes paths ds1 <- ioeErr $ either return - (\ms -> Bad $ "circular modules" +++ unwords (map show (head ms))) $ - topoTest $ map fst ds + (\ms -> Bad $ "circular modules" +++ + unwords (map show (head ms))) $ topoTest $ map fst ds + + -- associate each file name with its path --- more optimal: save paths in ds1 let paths = [(f,p) | ((f,_),p) <- ds] let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]] - ds2 <- ioeIO $ mapM selectFormat pds1 - -- print ds2 ---- debug - let ds3 = needCompile ds ds2 - ds4 <- ioeIO $ modifiedFiles env ds3 + + + ds2 <- ioeIO $ mapM (selectFormat env) pds1 + + let ds4 = needCompile (map fst ds0) ds2 return ds4 -getImports :: [InitPath] -> FileName -> IOE [((ModName,[ModName]),InitPath)] -getImports ps = get [] where - get ds file = do - let name = fileBody file - (p,s) <- readFileIfPath ps $ file - let imps = importsOfFile s - case imps of - _ | elem name (map (fst . fst) ds) -> return ds --- file already read - [] -> return $ ((name,[]),p):ds - _ -> do - let files = map gfFile imps - foldM get (((name,imps),p):ds) files +-- to decide whether to read gf or gfc, or if in env; returns full file path --- to decide whether to read gf or gfc; returns full file path +data CompStatus = + CSComp -- compile: read gf + | CSRead -- read gfc + | CSEnv -- gfc is in env + | CSEnvR -- also gfr is in env + | CSDont -- don't read at all + | CSRes -- read gfr + deriving (Eq,Show) -selectFormat :: (InitPath,ModName) -> IO (ModName,(FullPath,Bool)) -selectFormat (p,f) = do +selectFormat :: ModEnv -> (InitPath,ModName) -> IO (ModName,(InitPath,CompStatus)) +selectFormat env (p,f) = do let pf = prefixPathName p f - f0 <- selectLater (gfFile pf) (gfcFile pf) - f1 <- selectLater (gfrFile pf) f0 - return $ (f, (f1, f1 == gfFile pf)) -- True if needs compile - -needCompile :: [((ModName,[ModName]),InitPath)] -> [(ModName,(FullPath,Bool))] -> - [FullPath] -needCompile deps sfiles = filt $ mark $ iter changed where + let mtenv = lookup f env -- Nothing if f is not in env + let rtenv = lookup (resModName f) env + mtgfc <- getModTime $ gfcFile pf + mtgf <- getModTime $ gfFile pf + let stat = case (rtenv,mtenv,mtgfc,mtgf) of + (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> CSEnvR + (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> CSEnv + (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> CSRead + _ -> CSComp + return $ (f, (p,stat)) + + +needCompile :: [ModuleHeader] -> [(ModName,(InitPath,CompStatus))] -> [FullPath] +needCompile headers sfiles0 = paths $ res $ mark $ iter changed where + + deps = [(snd m,map fst ms) | (m,ms) <- headers] + typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers] + uses m = [(n,u) | ((_,n),ms) <- headers, (k,u) <- ms, k==m] + stat0 m = maybe CSComp snd $ lookup m sfiles0 + + allDeps = [(m,iterFix add ms) | (m,ms) <- deps] where + add os = [m | o <- os, Just n <- [lookup o deps],m <- n] + + -- only treat reused, interface, or instantiation if needed + sfiles = map relevant sfiles0 + relevant fp@(f,(p,st)) = + let us = uses f in + if not (all noComp us) then + fp else + if (typ f == MTyIncomplete || (not (null us) && all isAux us)) then + (f,(p,CSDont)) else + fp + + isAux = flip elem [MUReuse,MUInstance,MUComplete] . snd + noComp = flip elem [CSRead,CSEnv,CSEnvR] . stat0 . fst -- start with the changed files themselves; returns [ModName] - changed = [f | (f,(_,True)) <- sfiles] + changed = [f | (f,(_,CSComp)) <- sfiles] -- add other files that depend on some changed file; returns [ModName] - iter np = let new = [f | ((f,fs),_) <- deps, + iter np = let new = [f | (f,fs) <- deps, not (elem f np), any (flip elem np) fs] in if null new then np else (iter (new ++ np)) - -- for each module in the full list, choose source file if change is needed + -- for each module in the full list, compile if depends on what needs compile -- returns [FullPath] - mark cs = [f' | (f,(file,_)) <- sfiles, - let f' = if (elem f cs) then gfFile (fileBody file) else file] - - -- if the top file is gfc, only gfc files need be read (could be even better)--- - filt ds = if isGFC (last ds) - then [gfcFile name | f <- ds, - let (name,suff) = nameAndSuffix f, elem suff ["gfc","gfr"]] - else ds + mark cs = [(f,(path,st)) | + (f,(path,st0)) <- sfiles, + let st = if (elem f cs) then CSComp else st0] + + -- if a compilable file depends on a resource, read gfr instead of gfc/env + -- but don't read gfr if already in env (by CSEnvR) + res cs = map mkRes cs where + mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of + MTyResource | not (null [m | (m,(_,CSComp)) <- cs, + Just ms <- [lookup m allDeps], elem f ms]) + -> (f,(path,CSRes)) + _ -> x + mkRes x = x + + -- construct list of paths to read + paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]] + + mkName f p st = mk $ prefixPathName p f where + mk = case st of + CSComp -> gfFile + CSRead -> gfcFile + CSRes -> gfrFile isGFC = (== "gfc") . fileSuffix @@ -89,11 +140,45 @@ gfcFile = suffixFile "gfc" gfrFile = suffixFile "gfr" gfFile = suffixFile "gf" --- to get imports without parsing the file +resModName = ('#':) -importsOfFile :: String -> [FilePath] +-- to get imports without parsing the whole files + +getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)] +getImports ps = get [] where + get ds file = do + let name = fileBody file + (p,s) <- readFileIfPath ps $ file + let ((typ,mname),imps) = importsOfFile s + ioeErr $ testErr (mname == name) $ + "module name differs from file name in" +++ name + case imps of + _ | elem name (map (snd . fst . fst) ds) -> return ds --- file already read + [] -> return $ (((typ,name),[]),p):ds + _ -> do + let files = map (gfFile . fst) imps --- requires there's always .gf file + foldM get ((((typ,name),imps),p):ds) files + +-- internal module dep information + +data ModUse = + MUReuse + | MUInstance + | MUComplete + | MUOther + deriving (Eq,Show) + +data ModTyp = + MTyResource + | MTyIncomplete + | MTyOther + deriving (Eq,Show) + +type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)]) + +importsOfFile :: String -> ModuleHeader importsOfFile = - drop 1 . -- ignore module name itself + getModuleHeader . -- analyse into mod header filter (not . spec) . -- ignore keywords and special symbols unqual . -- take away qualifiers takeWhile (not . term) . -- read until curly or semic @@ -101,14 +186,37 @@ importsOfFile = unComm -- ignore comments before the headed line where term = flip elem ["{",";"] - spec = flip elem ["of", "open","in", ":", "->", "reuse", "=", "(", ")",",","**","with", - "abstract","concrete","resource","transfer","interface","incomplete", - "instance"] + spec = flip elem ["of", "open","in",":", "->","=", "(", ")",",","**"] unqual ws = case ws of "(":q:ws' -> unqual ws' w:ws' -> w:unqual ws' _ -> ws +getModuleHeader :: [String] -> ModuleHeader -- with, reuse +getModuleHeader ws = case ws of + "incomplete":ws2 -> let ((_,name),us) = getModuleHeader ws2 in + ((MTyIncomplete,name),us) + "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in + ((MTyIncomplete,name),us) + + "resource":name:ws2 -> case ws2 of + "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)]) + m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms]) + ms -> ((MTyResource,name),[(n,MUOther) | n <- ms]) + + "instance":name:m:ws2 -> case ws2 of + "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)]) + n:"with":ms -> + ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms]) + ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms]) + + _:name:ws2 -> case ws2 of + "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)]) + m:n:"with":ms -> + ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms]) + m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms]) + ms -> ((MTyOther,name),[(n,MUOther) | n <- ms]) + unComm s = case s of '-':'-':cs -> unComm $ dropWhile (/='\n') cs '{':'-':cs -> dpComm cs diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index bd9d9e22a..347af2adb 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -57,6 +57,10 @@ readFileIf f = catch (readFile f) (\_ -> reportOn f) where putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") return "" +type FileName = String +type InitPath = String +type FullPath = String + getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) getFilePath paths file = get paths where get [] = putStrLnFlush ("file" +++ file +++ "not found") >> return Nothing @@ -104,6 +108,9 @@ justFileName = reverse . takeWhile (/='/') . reverse suffixFile :: String -> FilePath -> FilePath suffixFile suff file = file ++ "." ++ suff +justModuleName :: FilePath -> String +justModuleName = fileBody . justFileName + -- getLineWell :: IO String -> IO String diff --git a/src/GF/System/Arch.hs b/src/GF/System/Arch.hs index 5fb963fec..ce1b78775 100644 --- a/src/GF/System/Arch.hs +++ b/src/GF/System/Arch.hs @@ -1,6 +1,6 @@ module Arch ( myStdGen, prCPU, selectLater, modifiedFiles, ModTime, getModTime,getNowTime, - welcomeArch, fetchCommand) where + welcomeArch, fetchCommand, laterModTime) where import Time import Random @@ -52,20 +52,31 @@ selectLater x y = do ty <- getModificationTime y return $ if tx < ty then y else x --- a file is considered as modified also if it has not been read yet +-- a file is considered modified also if it has not been read yet +-- new 23/2/2004: the environment ofs has just module names modifiedFiles :: [(FilePath,ModTime)] -> [FilePath] -> IO [FilePath] -modifiedFiles ofs fs = print (map fst ofs) >> filterM isModified fs where - isModified file = case lookup file ofs of +modifiedFiles ofs fs = do + filterM isModified fs + where + isModified file = case lookup (justModName file) ofs of Just to -> do - t <- getModTime file + t <- getModificationTime file return $ to < t _ -> return True + justModName = + reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse + type ModTime = ClockTime -getModTime :: FilePath -> IO ModTime -getModTime = getModificationTime +laterModTime :: ModTime -> ModTime -> Bool +laterModTime = (>) + +getModTime :: FilePath -> IO (Maybe ModTime) +getModTime f = do + b <- doesFileExist f + if b then (getModificationTime f >>= return . Just) else return Nothing getNowTime :: IO ModTime getNowTime = getClockTime diff --git a/src/Today.hs b/src/Today.hs index 6184d8036..111c0f8bf 100644 --- a/src/Today.hs +++ b/src/Today.hs @@ -1 +1 @@ -module Today where today = "Thu Jan 29 13:42:01 CET 2004" +module Today where today = "Thu Feb 26 16:08:20 CET 2004" |