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
|
module BuildModel where
import Control.Applicative ( (<|>) )
import Data.Char ( isAsciiLower
, isDigit
, toLower
)
import Data.Maybe ( fromMaybe
, mapMaybe
)
import Data.List ( intercalate )
import System.FilePath ( (</>)
, (<.>)
, splitDirectories
)
import Text.ParserCombinators.ReadP ( ReadP
, char
, eof
, many
, many1
, option
, readP_to_S
, satisfy
, skipSpaces
, string
)
data LineContents = ModuleUsed String | Other
data RawSource = RawSource {
rawSourceFilename :: FilePath
, rawSourceContents :: String
}
data Source = Program {
programSourceFileName :: FilePath
, programObjectFileName :: FilePath -> FilePath
, programModulesUsed :: [String]
}
processRawSource :: RawSource -> Source
processRawSource rawSource =
let sourceFileName = rawSourceFilename rawSource
parsedContents = parseContents rawSource
in Program
{ programSourceFileName = sourceFileName
, programObjectFileName = \buildDirectory ->
buildDirectory
</> (pathSeparatorsToUnderscores
sourceFileName
)
<.> "o"
, programModulesUsed = getModulesUsed parsedContents
}
pathSeparatorsToUnderscores :: FilePath -> FilePath
pathSeparatorsToUnderscores fileName =
intercalate "_" (splitDirectories fileName)
parseContents :: RawSource -> [LineContents]
parseContents rawSource =
let fileLines = lines $ rawSourceContents rawSource in
map parseFortranLine fileLines
getModulesUsed :: [LineContents] -> [String]
getModulesUsed =
mapMaybe contentToMaybeModuleName
where
contentToMaybeModuleName content = case content of
ModuleUsed moduleName -> Just moduleName
_ -> Nothing
readFileLinesIO :: FilePath -> IO [String]
readFileLinesIO file = do
contents <- readFile file
return $ lines contents
parseFortranLine :: String -> LineContents
parseFortranLine line =
let line' = map toLower line
result = readP_to_S doFortranLineParse line'
in getResult result
where
getResult (_ : (contents, _) : _) = contents
getResult [(contents, _) ] = contents
getResult [] = Other
doFortranLineParse :: ReadP LineContents
doFortranLineParse = option Other fortranUsefulContents
fortranUsefulContents :: ReadP LineContents
fortranUsefulContents = useStatement
useStatement :: ReadP LineContents
useStatement = do
skipSpaces
_ <- string "use"
skipAtLeastOneWhiteSpace
modName <- validIdentifier
skipSpaceCommaOrEnd
return $ ModuleUsed modName
skipAtLeastOneWhiteSpace :: ReadP ()
skipAtLeastOneWhiteSpace = do
_ <- many1 whiteSpace
return ()
skipSpaceOrEnd :: ReadP ()
skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace
skipSpaceCommaOrEnd :: ReadP ()
skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace
skipComma :: ReadP ()
skipComma = do
_ <- char ','
return ()
whiteSpace :: ReadP Char
whiteSpace = satisfy (`elem` " \t")
validIdentifier :: ReadP String
validIdentifier = do
first <- validFirstCharacter
rest <- many validIdentifierCharacter
return $ first : rest
validFirstCharacter :: ReadP Char
validFirstCharacter = alphabet
validIdentifierCharacter :: ReadP Char
validIdentifierCharacter = alphabet <|> digit <|> underscore
alphabet :: ReadP Char
alphabet = satisfy isAsciiLower
digit :: ReadP Char
digit = satisfy isDigit
underscore :: ReadP Char
underscore = char '_'
|
