Make.curry 3.18 KB
Newer Older
bbr's avatar
bbr committed
1
2
3
4
5
6
7
8
9
10
11
-------------------------------------------------------
-- 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,
bbr's avatar
bbr committed
12
  make, obsolete) where
bbr's avatar
bbr committed
13
14

import FlatCurry
15
import FlatCurryGoodies (progImports)
bbr's avatar
bbr committed
16
17
18
19
20
21
22
23
24
25
26
27
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

28
29
type TestAct a = Path -> ModuleName -> IO (Maybe a)
type ProgAct a = Path -> [a] -> Prog -> IO a
bbr's avatar
bbr committed
30

31
type Done a = IORef (FM String a)
bbr's avatar
bbr committed
32

bbr's avatar
bbr committed
33
34
--- calls act on each imported module transitively
--- if test returns Nothing.
35
make :: ModuleName -> TestAct a -> ProgAct a -> IO ()
bbr's avatar
bbr committed
36
make modu test act = do
bbr's avatar
bbr committed
37
  putStrLn "ensuring existence of fcy/fint files..."
bbr's avatar
bbr committed
38
  callFrontend FCY modu
bbr's avatar
bbr committed
39
  putStrLn "...ensured"
bbr's avatar
bbr committed
40
41
  done <- newIORef (emptyFM (\ x y -> not (leqString x y)))
  workUpDependence done test act modu
42
  return ()
bbr's avatar
bbr committed
43

44
workUpDependence ::  Done a -> TestAct a -> ProgAct a -> ModuleName -> IO a
bbr's avatar
bbr committed
45
46
workUpDependence done test act modu = do
  fm <- readIORef done
47
  maybe (process done test act modu) return (lookupFM fm modu)
bbr's avatar
bbr committed
48

49
50
process ::  Done a -> TestAct a -> ProgAct a ->  ModuleName -> IO a
process done test act modu = do
bbr's avatar
bbr committed
51
  fn <- findFileInLoadPath (modu++".fcy")
52
  imps <- fastReadImports fn >>= mapIO (workUpDependence done test act)
bbr's avatar
bbr committed
53
  let dir = dirName fn++"/"
54
55
56
57
  result <- test dir modu >>= 
            maybe (readFlatCurryFile fn >>= act dir imps) return 
  updateIORef done (\fm -> addToFM fm modu result)
  return result
bbr's avatar
bbr committed
58

59
60
61
62
63
64
65
66
--- a standard test if a given file is newer than a list of other files
--- if other files do not exist, the given file is assumed to be up-to-date
--- on up-to-date files a given action is performed
obsolete :: (String -> String) -> [String -> String] -> (String -> IO a) -> TestAct a
obsolete f fs action dir modu = do
  let fn  = dir++f modu
      fns = map ((dir++).($modu)) fs
  ex <- doesFileExist fn
bbr's avatar
bbr committed
67
  if ex then do
68
69
70
               t  <- getModificationTime fn
               ns <- mapIO (isNewerThan t) fns
               if or ns
71
                 then do
72
                   putStrLn $ "obsolete  : " ++ f modu
73
74
                   return Nothing
                 else do
75
76
77
                   putStrLn $ "up-to-date: " ++ f modu   
                   action fn >>= return . Just
        else putStrLn ("missing   : "++ f modu) >>
78
             return Nothing
79
80
81
82
83
84
 where
   isNewerThan t file = do 
     ex <- doesFileExist file
     if not ex then return False else do
      t' <- getModificationTime file
      return (compareClockTime t t'/=GT)
bbr's avatar
bbr committed
85
86
87
88
89
90
91
92
93
94
95

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
96
97
98
99
100
101

updateIORef :: IORef a -> (a -> a) -> IO ()
updateIORef ref f = do
  x <- readIORef ref
  writeIORef ref (f x)

bbr's avatar
bbr committed
102
103
104
105