1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
module FlatCurry.Read
( readFlatCurryInPath
, readFlatCurryWithImports
, readFlatCurryWithImportsInPath
, readFlatCurryIntWithImports
, readFlatCurryIntWithImportsInPath
) where
import Directory ( getModificationTime )
import FileGoodies ( baseName, lookupFileInPath, stripSuffix )
import FilePath ( normalise )
import System.CurryPath ( getLoadPathForModule, lookupModuleSource )
import System.FrontendExec ( FrontendTarget (FCY), callFrontendWithParams
, defaultParams, setQuiet, setFullPath )
import FlatCurry.Types
import FlatCurry.Files
readFlatCurryInPath :: [String] -> String -> IO Prog
readFlatCurryInPath loadpath modname = do
[prog] <- readFlatCurryFileInPath False False loadpath modname [".fcy"]
return prog
readFlatCurryWithImports :: String -> IO [Prog]
readFlatCurryWithImports modname = do
loadpath <- getLoadPathForModule modname
readFlatCurryFileInPath True False loadpath (baseName modname) [".fcy"]
readFlatCurryWithImportsInPath :: [String] -> String -> IO [Prog]
readFlatCurryWithImportsInPath loadpath modname =
readFlatCurryFileInPath True False loadpath modname [".fcy"]
readFlatCurryIntWithImports :: String -> IO [Prog]
readFlatCurryIntWithImports modname = do
loadpath <- getLoadPathForModule modname
readFlatCurryFileInPath True False loadpath (baseName modname)
[".fint",".fcy"]
readFlatCurryIntWithImportsInPath :: [String] -> String -> IO [Prog]
readFlatCurryIntWithImportsInPath loadpath modname =
readFlatCurryFileInPath True False loadpath modname [".fint",".fcy"]
readFlatCurryFileInPath :: Bool -> Bool -> [String] -> String -> [String]
-> IO [Prog]
readFlatCurryFileInPath withImp verb loadpath mod sfxs = do
when verb $ putStr "Reading FlatCurry files "
eiMods <- tryReadFlatCurryFile withImp verb loadpath mod sfxs
either (\_ -> parseFlatCurryFile withImp verb loadpath mod sfxs)
return
eiMods
parseFlatCurryFile :: Bool -> Bool -> [String] -> String -> [String]
-> IO [Prog]
parseFlatCurryFile withImp verb loadpath modname suffixes = do
when verb $
putStrLn $ ">>>>> FlatCurry files not up-to-date, parsing module \""
++ modname ++ "\"..."
callFrontendWithParams FCY
(setQuiet True (setFullPath loadpath defaultParams)) modname
when verb $ putStr "Reading FlatCurry files "
eiMods <- tryReadFlatCurryFile withImp verb loadpath modname suffixes
return (either (error . notFound) id eiMods)
where notFound mods = "FlatCurry file not found for the following module(s): "
++ unwords mods
tryReadFlatCurryFile :: Bool -> Bool -> [String] -> String -> [String]
-> IO (Either [String] [Prog])
tryReadFlatCurryFile withImp verb loadpath modname suffixes =
if withImp
then tryReadFlatCurryFileWithImports verb loadpath modname suffixes
else do mProg <- tryReadFlatCurry verb loadpath modname suffixes
return $ maybe (Left [modname]) (Right . (:[])) mProg
tryReadFlatCurryFileWithImports :: Bool -> [String] -> String -> [String]
-> IO (Either [String] [Prog])
tryReadFlatCurryFileWithImports verb loadpath modname suffixes =
collect [modname] []
where
collect [] _ = when verb (putStrLn "done") >> return (Right [])
collect (mod:mods) implist
| mod `elem` implist = collect mods implist
| otherwise = do
mbProg <- tryReadFlatCurry verb loadpath mod suffixes
case mbProg of
Nothing -> return (Left [mod])
Just prog@(Prog _ is _ _ _) -> do
mbresults <- collect (mods ++ is) (mod:implist)
return (either Left (Right . (prog :)) mbresults)
tryReadFlatCurry :: Bool -> [String] -> String -> [String] -> IO (Maybe Prog)
tryReadFlatCurry verb loadpath modname suffixes = do
mbSrc <- lookupModuleSource loadpath modname
case mbSrc of
Nothing -> lookupFileInPath flatbasename suffixes loadpath >>=
maybe (return Nothing) (liftIO Just . readFlatCurryFile)
Just (_,src) -> do
mbFcy <- lookupFileInPath flatbasename suffixes loadpath
case mbFcy of
Nothing -> return Nothing
Just fcy -> do
ctime <- getModificationTime src
ftime <- getModificationTime fcy
if ctime > ftime
then return Nothing
else do
when verb $ putStr (normalise fcy ++ " ")
Just `liftIO` readFlatCurryFile fcy
where flatbasename = stripSuffix (flatCurryFileName modname)
|