aboutsummaryrefslogtreecommitdiff
path: root/bootstrap
diff options
context:
space:
mode:
Diffstat (limited to 'bootstrap')
-rw-r--r--bootstrap/src/BuildModel.hs41
-rw-r--r--bootstrap/unit_test/SubmoduleSourceConstructionTest.hs6
2 files changed, 42 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
diff --git a/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs
index 956d782..577207e 100644
--- a/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs
+++ b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs
@@ -32,6 +32,7 @@ test = return $ givenInput
"its object file name is the 'flattened' path of the source file with '.o' appeneded"
checkSubmoduleObjectFileName
, then' "it knows what modules it uses directly" checkSubmoduleModulesUsed
+ , then' "it knows its name" checkSubmoduleName
]
]
@@ -66,3 +67,8 @@ checkSubmoduleModulesUsed :: Source -> Result
checkSubmoduleModulesUsed s@(Submodule{}) =
assertEquals ["module1", "module2"] $ submoduleModulesUsed s
checkSubmoduleModulesUsed _ = fail' "wasn't a Submodule"
+
+checkSubmoduleName :: Source -> Result
+checkSubmoduleName s@(Submodule{}) =
+ assertEquals "some_module@parent@child" $ submoduleName s
+checkSubmoduleName _ = fail' "wasn't a Submodule"