Commit 3dc5da81 authored by Michael Hanus's avatar Michael Hanus
Browse files

CASS: improvements w.r.t. hierarchical module names

parent 289c3b11
......@@ -2,7 +2,7 @@
--- Operations to handle dependencies of analysis files.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version March 2013
--- @version January 2015
-----------------------------------------------------------------------
module AnalysisDependencies(getModulesToAnalyze,reduceDependencies,
......@@ -65,12 +65,15 @@ getModulesToAnalyze enforce analysis moduleName =
where
ananame = analysisName analysis
-- Check whether the analysis file is newer than the source file.
-- Checks whether the analysis file is up-to-date.
-- Returns True if the analysis file is newer than the source file
-- and the FlatCurry file (if is exists).
isAnalysisFileNewer :: String -> String -> IO Bool
isAnalysisFileNewer ananame modname = do
atime <- getAnaFileTime ananame modname
stime <- getSourceFileTime modname
return (snd atime >= Just (snd stime))
ftime <- getFlatCurryFileTime modname
return (snd atime >= Just (snd stime) && snd atime >= snd ftime)
-- Read current import dependencies and checks whether the current analysis
-- file is valud.
......
......@@ -3,17 +3,17 @@
--- and their dependencies.
---
--- @author Michael Hanus
--- @version March 2013
--- @version January 2015
-----------------------------------------------------------------------
module CurryFiles(getImports,findSourceFileInLoadPath,
getSourceFileTime,readNewestFlatCurry) where
module CurryFiles(getImports,findModuleSourceInLoadPath,
getSourceFileTime,getFlatCurryFileTime,
readNewestFlatCurry) where
import FlatCurry
import FlatCurryGoodies(progImports)
import Directory(doesFileExist,getModificationTime)
import Distribution(getLoadPathForFile)
import FileGoodies(getFileInPath,baseName)
import Distribution(lookupFileInLoadPath,lookupModuleSourceInLoadPath)
import Time(ClockTime)
import Configuration(debugMessageLevel)
......@@ -24,30 +24,44 @@ getImports moduleName = do
debugMessageLevel 3 ("Reading interface of module "++moduleName)
readNewestFlatCurryInt moduleName >>= return . progImports
-- Find a source file for a module in the current load path.
findSourceFileInLoadPath modname = do
loadpath <- getLoadPathForFile modname
getFileInPath (baseName modname) [".lcurry",".curry"] loadpath
--- Returns a directory name and the actual source file name for a module
--- by looking up the module source in the current load path.
--- If the module is hierarchical, the directory is the top directory
--- of the hierarchy.
--- An error is raised if there is no corresponding source file.
findModuleSourceInLoadPath :: String -> IO (String,String)
findModuleSourceInLoadPath modname =
lookupModuleSourceInLoadPath modname >>=
maybe (error $ "Source file for module '"++modname++"' not found!")
return
-- Get timestamp of a Curry source file (together with its name)
-- Get timestamp of a Curry source module file (together with the module name)
getSourceFileTime :: String -> IO (String,ClockTime)
getSourceFileTime moduleName = do
fileName <- findSourceFileInLoadPath moduleName
(_,fileName) <- findModuleSourceInLoadPath moduleName
time <- getModificationTime fileName
return (moduleName,time)
--- Returns name of a source file of a module if its FlatCurry file
--- exists and is newer than the source file.
-- Get timestamp of FlatCurry file (together with the module name)
getFlatCurryFileTime :: String -> IO (String,Maybe ClockTime)
getFlatCurryFileTime modname =
lookupFileInLoadPath (flatCurryFileName modname) >>=
maybe (return (modname, Nothing))
(\fcyFileName -> do
ftime <- getModificationTime fcyFileName
return (modname, Just ftime))
--- Returns name of the FlatCurry file of a module if this file exists
--- and is newer than the source file.
flatCurryFileNewer :: String -> IO (Maybe String)
flatCurryFileNewer modname = do
sourceFileName <- findSourceFileInLoadPath modname
(_,sourceFileName) <- findModuleSourceInLoadPath modname
stime <- getModificationTime sourceFileName
let fcyFileName = flatCurryFileName sourceFileName
fcyExists <- doesFileExist fcyFileName
if fcyExists
then do itime <- getModificationTime fcyFileName
return (if itime >= stime then Just sourceFileName else Nothing)
else return Nothing
lookupFileInLoadPath (flatCurryFileName modname) >>=
maybe (return Nothing)
(\fcyFileName -> do
itime <- getModificationTime fcyFileName
return (if itime >= stime then Just fcyFileName else Nothing))
--- Returns the newest FlatCurry program for a module.
--- The source program is parsed if the interface older than the source,
......@@ -57,7 +71,7 @@ flatCurryFileNewer modname = do
readNewestFlatCurry :: String -> IO Prog
readNewestFlatCurry modname =
flatCurryFileNewer modname >>=
maybe (readFlatCurry modname) (readFlatCurryFile . flatCurryFileName)
maybe (readFlatCurry modname) readFlatCurryFile
--- Returns the newest FlatCurry interface for a module.
--- The source program is parsed if the interface older than the source,
......@@ -67,5 +81,9 @@ readNewestFlatCurry modname =
readNewestFlatCurryInt :: String -> IO Prog
readNewestFlatCurryInt modname =
flatCurryFileNewer modname >>=
maybe (readFlatCurryInt modname) (readFlatCurryFile . flatCurryIntName)
maybe (readFlatCurryInt modname) (readFlatCurryFile . flat2intName)
--- Translates FlatCurry file name to corresponding FlatCurry interface
--- file name.
flat2intName :: String -> String
flat2intName fn = reverse ("tnif" ++ drop 3 (reverse fn))
\ No newline at end of file
......@@ -3,7 +3,7 @@
--- persistently in files.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version March 2013
--- @version January 2015
--------------------------------------------------------------------------
module LoadAnalysis where
......@@ -17,8 +17,9 @@ import IO
import FiniteMap
import ReadShowTerm(readQTerm,showQTerm)
import FlatCurry(QName)
import CurryFiles(findSourceFileInLoadPath)
import CurryFiles(findModuleSourceInLoadPath)
debugMessage :: Int -> String -> IO ()
debugMessage n message = debugMessageLevel n ("LoadAnalysis: "++message)
--- Get the file name in which analysis results are stored
......@@ -27,9 +28,8 @@ debugMessage n message = debugMessageLevel n ("LoadAnalysis: "++message)
getAnalysisBaseFile :: String -> String -> IO String
getAnalysisBaseFile moduleName anaName = do
analysisDirectory <- getAnalysisDirectory
fileName <- findSourceFileInLoadPath moduleName
let (fileDir,_) = splitDirectoryBaseName fileName
if fileDir == "."
(fileDir,_) <- findModuleSourceInLoadPath moduleName
if fileDir == "." || fileDir == "./"
then do
currentDir <- getCurrentDirectory
return (analysisDirectory++currentDir++"/"++moduleName++"."++anaName)
......@@ -76,7 +76,7 @@ getInterfaceInfos anaName (mod:mods) =
--- and the second component is an analysis value.
loadDefaultAnalysisValues :: String -> String -> IO [(QName,a)]
loadDefaultAnalysisValues anaName moduleName = do
fileName <- findSourceFileInLoadPath moduleName
(_,fileName) <- findModuleSourceInLoadPath moduleName
let defaultFileName = stripSuffix fileName ++ ".defaults."++anaName
fileExists <- doesFileExist defaultFileName
if fileExists
......@@ -142,6 +142,7 @@ createDirectoryRHelp dirname (dir:restList) = do
-- delete all savefiles of analysis
deleteAnalysisFiles :: String -> IO Int
deleteAnalysisFiles ananame = do
analysisDir <- getAnalysisDirectory
system ("find "++analysisDir++" -name '*."++ananame++"' -type f -delete")
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment