aboutsummaryrefslogtreecommitdiff
path: root/bootstrap/src
diff options
context:
space:
mode:
Diffstat (limited to 'bootstrap/src')
-rw-r--r--bootstrap/src/BuildModel.hs43
1 files changed, 37 insertions, 6 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs
index baefda9..dc57f81 100644
--- a/bootstrap/src/BuildModel.hs
+++ b/bootstrap/src/BuildModel.hs
@@ -29,6 +29,7 @@ data LineContents =
ProgramDeclaration
| ModuleDeclaration String
| ModuleUsed String
+ | ModuleSubprogramDeclaration
| Other
data RawSource = RawSource {
@@ -47,6 +48,7 @@ data Source =
, moduleObjectFileName :: FilePath -> FilePath
, moduleModulesUsed :: [String]
, moduleName :: String
+ , moduleProducesSmod :: Bool
}
processRawSource :: RawSource -> Source
@@ -62,11 +64,13 @@ processRawSource rawSource =
, programModulesUsed = modulesUsed
}
else if hasModuleDeclaration parsedContents
- then Module { moduleSourceFileName = sourceFileName
- , moduleObjectFileName = objectFileName
- , moduleModulesUsed = modulesUsed
- , moduleName = getModuleName parsedContents
- }
+ then Module
+ { moduleSourceFileName = sourceFileName
+ , moduleObjectFileName = objectFileName
+ , moduleModulesUsed = modulesUsed
+ , moduleName = getModuleName parsedContents
+ , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents
+ }
else undefined
pathSeparatorsToUnderscores :: FilePath -> FilePath
@@ -96,6 +100,15 @@ hasModuleDeclaration parsedContents = case filter f parsedContents of
ModuleDeclaration{} -> True
_ -> False
+hasModuleSubprogramDeclaration :: [LineContents] -> Bool
+hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of
+ x : _ -> True
+ _ -> False
+ where
+ f lc = case lc of
+ ModuleSubprogramDeclaration -> True
+ _ -> False
+
getModulesUsed :: [LineContents] -> [String]
getModulesUsed = mapMaybe contentToMaybeModuleName
where
@@ -130,7 +143,10 @@ doFortranLineParse = option Other fortranUsefulContents
fortranUsefulContents :: ReadP LineContents
fortranUsefulContents =
- programDeclaration <|> moduleDeclaration <|> useStatement
+ programDeclaration
+ <|> moduleSubprogramDeclaration
+ <|> moduleDeclaration
+ <|> useStatement
programDeclaration :: ReadP LineContents
programDeclaration = do
@@ -158,6 +174,16 @@ useStatement = do
skipSpaceCommaOrEnd
return $ ModuleUsed modName
+moduleSubprogramDeclaration :: ReadP LineContents
+moduleSubprogramDeclaration = do
+ skipAnything
+ _ <- string "module"
+ skipAtLeastOneWhiteSpace
+ skipAnything
+ _ <- string "function" <|> string "subroutine"
+ skipAtLeastOneWhiteSpace
+ return $ ModuleSubprogramDeclaration
+
skipAtLeastOneWhiteSpace :: ReadP ()
skipAtLeastOneWhiteSpace = do
_ <- many1 whiteSpace
@@ -182,6 +208,11 @@ skipComment = do
_ <- char '!'
return ()
+skipAnything :: ReadP ()
+skipAnything = do
+ _ <- many (satisfy (const True))
+ return ()
+
whiteSpace :: ReadP Char
whiteSpace = satisfy (`elem` " \t")