Commit 3e5a710a authored by bbr's avatar bbr
Browse files

a module to emulate make

Function make in module Make will traverse import tree and test if update is necessary. If so the given act will be executed.
parent 1fae52d2
-------------------------------------------------------
-- This module provides basic make functionality for
-- curry programs. The provided actions traverse the
-- import tree and execute a given action only if
-- necessary.
-------------------------------------------------------
module Make (
ModuleName,
Path,
FileName,
make, upToDate) where
import FlatCurry
import Distribution
import FiniteMap
import IOExts
import Sort (leqString)
import FileGoodies (dirName)
import Time
import Directory
type ModuleName = String
type Path = String
type FileName = String
type TestAct = Path -> ModuleName -> IO Bool
type ProgAct = Prog -> IO ()
type Done = IORef (FM String ())
--- calls act on each imported module transitevely
--- if test was True.
make :: ModuleName -> TestAct -> ProgAct -> IO ()
make modu test act = do
callFrontend FCY modu
done <- newIORef (emptyFM (\ x y -> not (leqString x y)))
workUpDependence done test act modu
workUpDependence :: Done -> TestAct -> ProgAct -> ModuleName -> IO ()
workUpDependence done test act modu = do
fm <- readIORef done
maybe (process fm done test act modu) (const (return ())) (lookupFM fm modu)
process :: FM String () -> Done -> TestAct -> ProgAct -> ModuleName -> IO ()
process fm done test act modu = do
fn <- findFileInLoadPath (modu++".fint")
writeIORef done (addToFM fm modu ())
imps <- fastReadImports fn
mapIO_ (workUpDependence done test act) imps
let dir = dirName fn++"/"
mk <- test dir modu
if mk then (readFlatCurryFile (dir++modu++".fcy") >>= act) else return ()
--- a standard test if a given filename is new than another
upToDate :: (String -> String) -> (String -> String) -> TestAct
upToDate f1 f2 dir modu = do
let fn1 = dir++f1 modu
fn2 = dir++f2 modu
t1 <- getModificationTime fn1
t2 <- getModificationTime fn2
return (compareClockTime t1 t2/=LT)
fastReadImports :: FileName -> IO [String]
fastReadImports fn = do
cont <- readFile fn
return (strings (takeWhile (/=']') (dropWhile (/='[') cont)))
strings :: String -> [String]
strings [] = []
strings (c:cs) | c=='"' = case break (=='"') cs of
(s,_:rest) -> s : strings rest
| otherwise = strings cs
\ No newline at end of file
Markdown is supported
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