diff options
Diffstat (limited to 'bootstrap')
-rw-r--r-- | bootstrap/src/BuildModel.hs | 41 | ||||
-rw-r--r-- | bootstrap/unit_test/SubmoduleSourceConstructionTest.hs | 6 |
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" |