Make.curry 3.44 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,
Bernd Brassel's avatar
Bernd Brassel committed
12
  make, obsolete, unless) 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.
Bernd Brassel's avatar
Bernd Brassel committed
35
36
37
38
39
make :: Bool -> ModuleName -> TestAct a -> ProgAct a -> IO ()
make quiet modu test act = do
  unless quiet $ putStrLn "ensuring existence of fcy/fint files..."
  callFrontendWithParams FCY (setQuiet True defaultParams) modu
  unless quiet $ 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
51
  fn <- findFileInLoadPath (flatCurryFileName modu)
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
--- 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
Bernd Brassel's avatar
Bernd Brassel committed
62
63
64
obsolete :: Bool -> (String -> String) -> [String -> String] 
         -> ([String] -> IO a) -> TestAct a
obsolete quiet f fs action dir modu = do
65
66
67
  let fn  = dir++f modu
      fns = map ((dir++).($modu)) fs
  ex <- doesFileExist fn
bbr's avatar
bbr committed
68
  if ex then do
69
70
71
               t  <- getModificationTime fn
               ns <- mapIO (isNewerThan t) fns
               if or ns
72
                 then do
Bernd Brassel's avatar
Bernd Brassel committed
73
                   unless quiet $ putStrLn $ "obsolete  : " ++ f modu
74
75
                   return Nothing
                 else do
Bernd Brassel's avatar
Bernd Brassel committed
76
                   unless quiet $ putStrLn $ "up-to-date: " ++ f modu   
bbr's avatar
bbr committed
77
                   action fns >>= return . Just
Bernd Brassel's avatar
Bernd Brassel committed
78
79
        else do unless quiet $ putStrLn ("missing   : "++ f modu) 
                return Nothing
80
81
82
83
84
85
 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
86
87
88
89
90
91
92
93
94
95
96

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

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

Bernd Brassel's avatar
Bernd Brassel committed
103
104
105
106
unless :: Bool -> IO () -> IO ()
unless True  _   = return ()
unless False act = act

bbr's avatar
bbr committed
107
108
109
110