diff options
author | Brad Richardson <everythingfunctional@protonmail.com> | 2020-10-19 16:13:53 -0500 |
---|---|---|
committer | Brad Richardson <everythingfunctional@protonmail.com> | 2020-10-19 16:13:53 -0500 |
commit | 28b00953f12d2fc0de9de75f26fd3c4346a44974 (patch) | |
tree | 815db4fcb9b0234695067cbff2bbd87a6c68e3f7 /bootstrap/src/BuildModel.hs | |
parent | f038a093bc0259bf7d72d86fb95f4a2aebf1a8df (diff) | |
download | fpm-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.hs | 41 |
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 |