aboutsummaryrefslogtreecommitdiff
path: root/bootstrap/src/BuildModel.hs
diff options
context:
space:
mode:
authorBrad Richardson <everythingfunctional@protonmail.com>2020-10-19 16:13:53 -0500
committerBrad Richardson <everythingfunctional@protonmail.com>2020-10-19 16:13:53 -0500
commit28b00953f12d2fc0de9de75f26fd3c4346a44974 (patch)
tree815db4fcb9b0234695067cbff2bbd87a6c68e3f7 /bootstrap/src/BuildModel.hs
parentf038a093bc0259bf7d72d86fb95f4a2aebf1a8df (diff)
downloadfpm-28b00953f12d2fc0de9de75f26fd3c4346a44974.tar.gz
fpm-28b00953f12d2fc0de9de75f26fd3c4346a44974.zip
Add test for a submodule's name
Diffstat (limited to 'bootstrap/src/BuildModel.hs')
-rw-r--r--bootstrap/src/BuildModel.hs41
1 files changed, 36 insertions, 5 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs
index db00e0d..eba1440 100644
--- a/bootstrap/src/BuildModel.hs
+++ b/bootstrap/src/BuildModel.hs
@@ -30,7 +30,7 @@ data LineContents =
| ModuleDeclaration String
| ModuleUsed String
| ModuleSubprogramDeclaration
- | SubmoduleDeclaration
+ | SubmoduleDeclaration String
| Other
data RawSource = RawSource {
@@ -55,6 +55,7 @@ data Source =
{ submoduleSourceFileName :: FilePath
, submoduleObjectFileName :: FilePath -> FilePath
, submoduleModulesUsed :: [String]
+ , submoduleName :: String
}
processRawSource :: RawSource -> Source
@@ -81,6 +82,7 @@ processRawSource rawSource =
then Submodule { submoduleSourceFileName = sourceFileName
, submoduleObjectFileName = objectFileName
, submoduleModulesUsed = modulesUsed
+ , submoduleName = getSubmoduleName parsedContents
}
else undefined
@@ -117,8 +119,8 @@ hasSubmoduleDeclaration parsedContents = case filter f parsedContents of
_ -> False
where
f lc = case lc of
- SubmoduleDeclaration -> True
- _ -> False
+ SubmoduleDeclaration{} -> True
+ _ -> False
hasModuleSubprogramDeclaration :: [LineContents] -> Bool
hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of
@@ -143,6 +145,13 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc
ModuleDeclaration moduleName -> Just moduleName
_ -> Nothing
+getSubmoduleName :: [LineContents] -> String
+getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc
+ where
+ contentToMaybeModuleName content = case content of
+ SubmoduleDeclaration submoduleName -> Just submoduleName
+ _ -> Nothing
+
readFileLinesIO :: FilePath -> IO [String]
readFileLinesIO file = do
contents <- readFile file
@@ -189,8 +198,30 @@ moduleDeclaration = do
submoduleDeclaration :: ReadP LineContents
submoduleDeclaration = do
skipSpaces
- _ <- string "submodule"
- return $ SubmoduleDeclaration
+ _ <- string "submodule"
+ parents <- submoduleParents
+ skipSpaces
+ name <- validIdentifier
+ skipSpaceCommentOrEnd
+ return $ SubmoduleDeclaration ((intercalate "@" parents) ++ "@" ++ name)
+
+submoduleParents :: ReadP [String]
+submoduleParents = do
+ skipSpaces
+ _ <- char '('
+ skipSpaces
+ firstParent <- validIdentifier
+ remainingParents <- many
+ (do
+ skipSpaces
+ _ <- char ':'
+ skipSpaces
+ name <- validIdentifier
+ return name
+ )
+ skipSpaces
+ _ <- char ')'
+ return $ firstParent : remainingParents
useStatement :: ReadP LineContents
useStatement = do