From 0a7eb98dd5083ede9e940a3e9cc424b76968ba4a Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 14 Oct 2020 12:23:03 -0500 Subject: Finish first unit test --- bootstrap/src/BuildModel.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 bootstrap/src/BuildModel.hs (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs new file mode 100644 index 0000000..87c45c7 --- /dev/null +++ b/bootstrap/src/BuildModel.hs @@ -0,0 +1,11 @@ +module BuildModel where + +data RawSource = RawSource { + rawSourceFilename :: FilePath + , rawSourceContents :: String +} + +data Source = Program + +processRawSource :: RawSource -> Source +processRawSource _ = Program -- cgit v1.2.3 From ed529804fc47d64f78bdbd3b4e366ff9f632c8d3 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 14 Oct 2020 12:32:06 -0500 Subject: Add test for Program source file name --- bootstrap/src/BuildModel.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 87c45c7..711f977 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -5,7 +5,7 @@ data RawSource = RawSource { , rawSourceContents :: String } -data Source = Program +data Source = Program { programSourceFileName :: String} processRawSource :: RawSource -> Source -processRawSource _ = Program +processRawSource rawSource = Program $ rawSourceFilename rawSource -- cgit v1.2.3 From 29356ac6da1a94dbcc0c50c157e8dcb353213793 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 14 Oct 2020 12:51:29 -0500 Subject: Add test for program object file name --- bootstrap/src/BuildModel.hs | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 711f977..b8bc122 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -1,11 +1,34 @@ module BuildModel where +import Data.List ( intercalate ) +import System.FilePath ( () + , (<.>) + , splitDirectories + ) + data RawSource = RawSource { rawSourceFilename :: FilePath , rawSourceContents :: String } -data Source = Program { programSourceFileName :: String} +data Source = Program { + programSourceFileName :: FilePath + , programObjectFileName :: FilePath -> FilePath +} processRawSource :: RawSource -> Source -processRawSource rawSource = Program $ rawSourceFilename rawSource +processRawSource rawSource = + let sourceFileName = rawSourceFilename rawSource + in Program + { programSourceFileName = sourceFileName + , programObjectFileName = \buildDirectory -> + buildDirectory + (pathSeparatorsToUnderscores + sourceFileName + ) + <.> "o" + } + +pathSeparatorsToUnderscores :: FilePath -> FilePath +pathSeparatorsToUnderscores fileName = + intercalate "_" (splitDirectories fileName) -- cgit v1.2.3 From d1400eeb1401dee32729d2752b8ca4a072766068 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 14 Oct 2020 13:51:18 -0500 Subject: Add test for modules a program uses --- bootstrap/src/BuildModel.hs | 106 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index b8bc122..dab8aed 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -1,10 +1,31 @@ module BuildModel where +import Control.Applicative ( (<|>) ) +import Data.Char ( isAsciiLower + , isDigit + , toLower + ) +import Data.Maybe ( fromMaybe + , mapMaybe + ) import Data.List ( intercalate ) import System.FilePath ( () , (<.>) , splitDirectories ) +import Text.ParserCombinators.ReadP ( ReadP + , char + , eof + , many + , many1 + , option + , readP_to_S + , satisfy + , skipSpaces + , string + ) + +data LineContents = ModuleUsed String | Other data RawSource = RawSource { rawSourceFilename :: FilePath @@ -14,6 +35,7 @@ data RawSource = RawSource { data Source = Program { programSourceFileName :: FilePath , programObjectFileName :: FilePath -> FilePath + , programModulesUsed :: [String] } processRawSource :: RawSource -> Source @@ -27,8 +49,92 @@ processRawSource rawSource = sourceFileName ) <.> "o" + , programModulesUsed = getModulesUsed rawSource } pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = intercalate "_" (splitDirectories fileName) + +getModulesUsed :: RawSource -> [String] +getModulesUsed rawSource = + let fileLines = lines $ rawSourceContents rawSource + lineContents = map parseFortranLine fileLines + in contentsToModuleNames lineContents + +contentsToModuleNames :: [LineContents] -> [String] +contentsToModuleNames = mapMaybe contentToMaybeModuleName + where + contentToMaybeModuleName content = case content of + ModuleUsed moduleName -> Just moduleName + _ -> Nothing + +readFileLinesIO :: FilePath -> IO [String] +readFileLinesIO file = do + contents <- readFile file + return $ lines contents + +parseFortranLine :: String -> LineContents +parseFortranLine line = + let line' = map toLower line + result = readP_to_S doFortranLineParse line' + in getResult result + where + getResult (_ : (contents, _) : _) = contents + getResult [(contents, _) ] = contents + getResult [] = Other + +doFortranLineParse :: ReadP LineContents +doFortranLineParse = option Other fortranUsefulContents + +fortranUsefulContents :: ReadP LineContents +fortranUsefulContents = useStatement + +useStatement :: ReadP LineContents +useStatement = do + skipSpaces + _ <- string "use" + skipAtLeastOneWhiteSpace + modName <- validIdentifier + skipSpaceCommaOrEnd + return $ ModuleUsed modName + +skipAtLeastOneWhiteSpace :: ReadP () +skipAtLeastOneWhiteSpace = do + _ <- many1 whiteSpace + return () + +skipSpaceOrEnd :: ReadP () +skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace + +skipSpaceCommaOrEnd :: ReadP () +skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace + +skipComma :: ReadP () +skipComma = do + _ <- char ',' + return () + +whiteSpace :: ReadP Char +whiteSpace = satisfy (`elem` " \t") + +validIdentifier :: ReadP String +validIdentifier = do + first <- validFirstCharacter + rest <- many validIdentifierCharacter + return $ first : rest + +validFirstCharacter :: ReadP Char +validFirstCharacter = alphabet + +validIdentifierCharacter :: ReadP Char +validIdentifierCharacter = alphabet <|> digit <|> underscore + +alphabet :: ReadP Char +alphabet = satisfy isAsciiLower + +digit :: ReadP Char +digit = satisfy isDigit + +underscore :: ReadP Char +underscore = char '_' -- cgit v1.2.3 From 3457efd4cbb806118f7893f452bc1dd016e53390 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 14 Oct 2020 15:35:00 -0500 Subject: Refactor parsing process a bit --- bootstrap/src/BuildModel.hs | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index dab8aed..aa720f9 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -41,6 +41,7 @@ data Source = Program { processRawSource :: RawSource -> Source processRawSource rawSource = let sourceFileName = rawSourceFilename rawSource + parsedContents = parseContents rawSource in Program { programSourceFileName = sourceFileName , programObjectFileName = \buildDirectory -> @@ -49,25 +50,25 @@ processRawSource rawSource = sourceFileName ) <.> "o" - , programModulesUsed = getModulesUsed rawSource + , programModulesUsed = getModulesUsed parsedContents } pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = intercalate "_" (splitDirectories fileName) -getModulesUsed :: RawSource -> [String] -getModulesUsed rawSource = - let fileLines = lines $ rawSourceContents rawSource - lineContents = map parseFortranLine fileLines - in contentsToModuleNames lineContents - -contentsToModuleNames :: [LineContents] -> [String] -contentsToModuleNames = mapMaybe contentToMaybeModuleName - where - contentToMaybeModuleName content = case content of - ModuleUsed moduleName -> Just moduleName - _ -> Nothing +parseContents :: RawSource -> [LineContents] +parseContents rawSource = + let fileLines = lines $ rawSourceContents rawSource in + map parseFortranLine fileLines + +getModulesUsed :: [LineContents] -> [String] +getModulesUsed = + mapMaybe contentToMaybeModuleName + where + contentToMaybeModuleName content = case content of + ModuleUsed moduleName -> Just moduleName + _ -> Nothing readFileLinesIO :: FilePath -> IO [String] readFileLinesIO file = do -- cgit v1.2.3 From 06798e8f263ad5a95df00469740945090ff66977 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 14 Oct 2020 15:49:23 -0500 Subject: Add check for program declaration before constructing Program Source --- bootstrap/src/BuildModel.hs | 58 +++++++++++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 20 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index aa720f9..e5291ac 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -25,7 +25,7 @@ import Text.ParserCombinators.ReadP ( ReadP , string ) -data LineContents = ModuleUsed String | Other +data LineContents = ProgramDeclaration | ModuleUsed String | Other data RawSource = RawSource { rawSourceFilename :: FilePath @@ -42,16 +42,18 @@ processRawSource :: RawSource -> Source processRawSource rawSource = let sourceFileName = rawSourceFilename rawSource parsedContents = parseContents rawSource - in Program - { programSourceFileName = sourceFileName - , programObjectFileName = \buildDirectory -> - buildDirectory - (pathSeparatorsToUnderscores - sourceFileName - ) - <.> "o" - , programModulesUsed = getModulesUsed parsedContents - } + in if hasProgramDeclaration parsedContents + then Program + { programSourceFileName = sourceFileName + , programObjectFileName = \buildDirectory -> + buildDirectory + (pathSeparatorsToUnderscores + sourceFileName + ) + <.> "o" + , programModulesUsed = getModulesUsed parsedContents + } + else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = @@ -59,16 +61,24 @@ pathSeparatorsToUnderscores fileName = parseContents :: RawSource -> [LineContents] parseContents rawSource = - let fileLines = lines $ rawSourceContents rawSource in - map parseFortranLine fileLines + let fileLines = lines $ rawSourceContents rawSource + in map parseFortranLine fileLines + +hasProgramDeclaration :: [LineContents] -> Bool +hasProgramDeclaration parsedContents = case filter f parsedContents of + x : _ -> True + _ -> False + where + f lc = case lc of + ProgramDeclaration -> True + _ -> False getModulesUsed :: [LineContents] -> [String] -getModulesUsed = - mapMaybe contentToMaybeModuleName - where - contentToMaybeModuleName content = case content of - ModuleUsed moduleName -> Just moduleName - _ -> Nothing +getModulesUsed = mapMaybe contentToMaybeModuleName + where + contentToMaybeModuleName content = case content of + ModuleUsed moduleName -> Just moduleName + _ -> Nothing readFileLinesIO :: FilePath -> IO [String] readFileLinesIO file = do @@ -89,7 +99,15 @@ doFortranLineParse :: ReadP LineContents doFortranLineParse = option Other fortranUsefulContents fortranUsefulContents :: ReadP LineContents -fortranUsefulContents = useStatement +fortranUsefulContents = programDeclaration <|> useStatement + +programDeclaration :: ReadP LineContents +programDeclaration = do + skipSpaces + _ <- string "program" + skipAtLeastOneWhiteSpace + _ <- validIdentifier + return ProgramDeclaration useStatement :: ReadP LineContents useStatement = do -- cgit v1.2.3 From 4b062f1f275d568099d6ebf4c1c687c50d039b84 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 10:13:35 -0500 Subject: Add constructor for Module Source --- bootstrap/src/BuildModel.hs | 40 ++++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index e5291ac..db44b54 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -25,18 +25,24 @@ import Text.ParserCombinators.ReadP ( ReadP , string ) -data LineContents = ProgramDeclaration | ModuleUsed String | Other +data LineContents = + ProgramDeclaration + | ModuleDeclaration String + | ModuleUsed String + | Other data RawSource = RawSource { rawSourceFilename :: FilePath , rawSourceContents :: String } -data Source = Program { - programSourceFileName :: FilePath - , programObjectFileName :: FilePath -> FilePath - , programModulesUsed :: [String] -} +data Source = + Program + { programSourceFileName :: FilePath + , programObjectFileName :: FilePath -> FilePath + , programModulesUsed :: [String] + } + | Module {} processRawSource :: RawSource -> Source processRawSource rawSource = @@ -53,7 +59,7 @@ processRawSource rawSource = <.> "o" , programModulesUsed = getModulesUsed parsedContents } - else undefined + else if hasModuleDeclaration parsedContents then Module{} else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = @@ -73,6 +79,15 @@ hasProgramDeclaration parsedContents = case filter f parsedContents of ProgramDeclaration -> True _ -> False +hasModuleDeclaration :: [LineContents] -> Bool +hasModuleDeclaration parsedContents = case filter f parsedContents of + x : _ -> True + _ -> False + where + f lc = case lc of + ModuleDeclaration{} -> True + _ -> False + getModulesUsed :: [LineContents] -> [String] getModulesUsed = mapMaybe contentToMaybeModuleName where @@ -99,7 +114,8 @@ doFortranLineParse :: ReadP LineContents doFortranLineParse = option Other fortranUsefulContents fortranUsefulContents :: ReadP LineContents -fortranUsefulContents = programDeclaration <|> useStatement +fortranUsefulContents = + programDeclaration <|> moduleDeclaration <|> useStatement programDeclaration :: ReadP LineContents programDeclaration = do @@ -109,6 +125,14 @@ programDeclaration = do _ <- validIdentifier return ProgramDeclaration +moduleDeclaration :: ReadP LineContents +moduleDeclaration = do + skipSpaces + _ <- string "module" + skipAtLeastOneWhiteSpace + moduleName <- validIdentifier + return $ ModuleDeclaration moduleName + useStatement :: ReadP LineContents useStatement = do skipSpaces -- cgit v1.2.3 From c2638957dd9aca90831e0b434fec9ccc05c77acc Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 10:22:43 -0500 Subject: Add test for module source file name --- bootstrap/src/BuildModel.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index db44b54..043173f 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -42,7 +42,9 @@ data Source = , programObjectFileName :: FilePath -> FilePath , programModulesUsed :: [String] } - | Module {} + | Module + { moduleSourceFileName :: FilePath + } processRawSource :: RawSource -> Source processRawSource rawSource = @@ -59,7 +61,9 @@ processRawSource rawSource = <.> "o" , programModulesUsed = getModulesUsed parsedContents } - else if hasModuleDeclaration parsedContents then Module{} else undefined + else if hasModuleDeclaration parsedContents + then Module { moduleSourceFileName = sourceFileName } + else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = -- cgit v1.2.3 From 84884be16503e506cd5ad7f927297fd7d25de779 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 10:28:02 -0500 Subject: Add test for module object file name --- bootstrap/src/BuildModel.hs | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 043173f..6446a12 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -44,25 +44,24 @@ data Source = } | Module { moduleSourceFileName :: FilePath + , moduleObjectFileName :: FilePath -> FilePath } processRawSource :: RawSource -> Source processRawSource rawSource = let sourceFileName = rawSourceFilename rawSource parsedContents = parseContents rawSource + objectFileName = + \bd -> bd (pathSeparatorsToUnderscores sourceFileName) <.> "o" in if hasProgramDeclaration parsedContents - then Program - { programSourceFileName = sourceFileName - , programObjectFileName = \buildDirectory -> - buildDirectory - (pathSeparatorsToUnderscores - sourceFileName - ) - <.> "o" - , programModulesUsed = getModulesUsed parsedContents - } + then Program { programSourceFileName = sourceFileName + , programObjectFileName = objectFileName + , programModulesUsed = getModulesUsed parsedContents + } else if hasModuleDeclaration parsedContents - then Module { moduleSourceFileName = sourceFileName } + then Module { moduleSourceFileName = sourceFileName + , moduleObjectFileName = objectFileName + } else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath -- cgit v1.2.3 From 134713a6c3620bf5b71ceaa2b6bed3a228d1c297 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 10:36:58 -0500 Subject: Add test for modules a module uses --- bootstrap/src/BuildModel.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 6446a12..1610784 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -45,6 +45,7 @@ data Source = | Module { moduleSourceFileName :: FilePath , moduleObjectFileName :: FilePath -> FilePath + , moduleModulesUsed :: [String] } processRawSource :: RawSource -> Source @@ -53,14 +54,16 @@ processRawSource rawSource = parsedContents = parseContents rawSource objectFileName = \bd -> bd (pathSeparatorsToUnderscores sourceFileName) <.> "o" + modulesUsed = getModulesUsed parsedContents in if hasProgramDeclaration parsedContents then Program { programSourceFileName = sourceFileName , programObjectFileName = objectFileName - , programModulesUsed = getModulesUsed parsedContents + , programModulesUsed = modulesUsed } else if hasModuleDeclaration parsedContents then Module { moduleSourceFileName = sourceFileName , moduleObjectFileName = objectFileName + , moduleModulesUsed = modulesUsed } else undefined -- cgit v1.2.3 From 311c695aa30f63fc1be0ef8b8c56ca372e01a31e Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 10:47:40 -0500 Subject: Add test for a module's name --- bootstrap/src/BuildModel.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 1610784..baefda9 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -46,6 +46,7 @@ data Source = { moduleSourceFileName :: FilePath , moduleObjectFileName :: FilePath -> FilePath , moduleModulesUsed :: [String] + , moduleName :: String } processRawSource :: RawSource -> Source @@ -64,6 +65,7 @@ processRawSource rawSource = then Module { moduleSourceFileName = sourceFileName , moduleObjectFileName = objectFileName , moduleModulesUsed = modulesUsed + , moduleName = getModuleName parsedContents } else undefined @@ -101,6 +103,13 @@ getModulesUsed = mapMaybe contentToMaybeModuleName ModuleUsed moduleName -> Just moduleName _ -> Nothing +getModuleName :: [LineContents] -> String +getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc + where + contentToMaybeModuleName content = case content of + ModuleDeclaration moduleName -> Just moduleName + _ -> Nothing + readFileLinesIO :: FilePath -> IO [String] readFileLinesIO file = do contents <- readFile file @@ -137,6 +146,7 @@ moduleDeclaration = do _ <- string "module" skipAtLeastOneWhiteSpace moduleName <- validIdentifier + skipSpaceCommentOrEnd return $ ModuleDeclaration moduleName useStatement :: ReadP LineContents @@ -159,11 +169,19 @@ skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace skipSpaceCommaOrEnd :: ReadP () skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace +skipSpaceCommentOrEnd :: ReadP () +skipSpaceCommentOrEnd = eof <|> skipComment <|> skipAtLeastOneWhiteSpace + skipComma :: ReadP () skipComma = do _ <- char ',' return () +skipComment :: ReadP () +skipComment = do + _ <- char '!' + return () + whiteSpace :: ReadP Char whiteSpace = satisfy (`elem` " \t") -- cgit v1.2.3 From bd27ae8161860f9a40c3953e20001af1f450d5f4 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 11:07:47 -0500 Subject: Add test for whether a module produces a .smod file --- bootstrap/src/BuildModel.hs | 43 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 37 insertions(+), 6 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') 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") -- cgit v1.2.3 From 29be28f5e7de2d8a3fa405d61ec63e8c8d7ea809 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 11:43:20 -0500 Subject: Add constructor for Submodule Source --- bootstrap/src/BuildModel.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index dc57f81..f784624 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -30,6 +30,7 @@ data LineContents = | ModuleDeclaration String | ModuleUsed String | ModuleSubprogramDeclaration + | SubmoduleDeclaration | Other data RawSource = RawSource { @@ -50,6 +51,7 @@ data Source = , moduleName :: String , moduleProducesSmod :: Bool } + | Submodule processRawSource :: RawSource -> Source processRawSource rawSource = @@ -71,7 +73,9 @@ processRawSource rawSource = , moduleName = getModuleName parsedContents , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents } - else undefined + else if hasSubmoduleDeclaration parsedContents + then Submodule + else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = @@ -100,6 +104,15 @@ hasModuleDeclaration parsedContents = case filter f parsedContents of ModuleDeclaration{} -> True _ -> False +hasSubmoduleDeclaration :: [LineContents] -> Bool +hasSubmoduleDeclaration parsedContents = case filter f parsedContents of + x : _ -> True + _ -> False + where + f lc = case lc of + SubmoduleDeclaration -> True + _ -> False + hasModuleSubprogramDeclaration :: [LineContents] -> Bool hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of x : _ -> True @@ -146,6 +159,7 @@ fortranUsefulContents = programDeclaration <|> moduleSubprogramDeclaration <|> moduleDeclaration + <|> submoduleDeclaration <|> useStatement programDeclaration :: ReadP LineContents @@ -165,6 +179,12 @@ moduleDeclaration = do skipSpaceCommentOrEnd return $ ModuleDeclaration moduleName +submoduleDeclaration :: ReadP LineContents +submoduleDeclaration = do + skipSpaces + _ <- string "submodule" + return $ SubmoduleDeclaration + useStatement :: ReadP LineContents useStatement = do skipSpaces -- cgit v1.2.3 From b927218b5690fe7cd4080af53831311d59db6987 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Oct 2020 11:52:11 -0500 Subject: Add test for submodule source file name --- bootstrap/src/BuildModel.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index f784624..9a9866a 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -52,6 +52,8 @@ data Source = , moduleProducesSmod :: Bool } | Submodule + { submoduleSourceFileName :: FilePath + } processRawSource :: RawSource -> Source processRawSource rawSource = @@ -74,7 +76,7 @@ processRawSource rawSource = , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents } else if hasSubmoduleDeclaration parsedContents - then Submodule + then Submodule { submoduleSourceFileName = sourceFileName } else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath -- cgit v1.2.3 From a981372352e881d1cc7d542628959c0ac501e96e Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 19 Oct 2020 15:42:22 -0500 Subject: Add test for submodule object file name --- bootstrap/src/BuildModel.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 9a9866a..70046d7 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -53,6 +53,7 @@ data Source = } | Submodule { submoduleSourceFileName :: FilePath + , submoduleObjectFileName :: FilePath -> FilePath } processRawSource :: RawSource -> Source @@ -76,7 +77,9 @@ processRawSource rawSource = , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents } else if hasSubmoduleDeclaration parsedContents - then Submodule { submoduleSourceFileName = sourceFileName } + then Submodule { submoduleSourceFileName = sourceFileName + , submoduleObjectFileName = objectFileName + } else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath -- cgit v1.2.3 From f038a093bc0259bf7d72d86fb95f4a2aebf1a8df Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 19 Oct 2020 15:52:45 -0500 Subject: Add test for modules a submodule uses --- bootstrap/src/BuildModel.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 70046d7..db00e0d 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -54,6 +54,7 @@ data Source = | Submodule { submoduleSourceFileName :: FilePath , submoduleObjectFileName :: FilePath -> FilePath + , submoduleModulesUsed :: [String] } processRawSource :: RawSource -> Source @@ -79,6 +80,7 @@ processRawSource rawSource = else if hasSubmoduleDeclaration parsedContents then Submodule { submoduleSourceFileName = sourceFileName , submoduleObjectFileName = objectFileName + , submoduleModulesUsed = modulesUsed } else undefined -- cgit v1.2.3 From 28b00953f12d2fc0de9de75f26fd3c4346a44974 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 19 Oct 2020 16:13:53 -0500 Subject: Add test for a submodule's name --- bootstrap/src/BuildModel.hs | 41 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 36 insertions(+), 5 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') 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 -- cgit v1.2.3 From cfb8b07fcb102573b70f37de9421e14d1300ac58 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 11:06:35 -0500 Subject: Add test for source file name of program's compile time info --- bootstrap/src/BuildModel.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index eba1440..9bc6b48 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -58,6 +58,10 @@ data Source = , submoduleName :: String } +data CompileTimeInfo = CompileTimeInfo { + compileTimeInfoSourceFileName :: FilePath +} + processRawSource :: RawSource -> Source processRawSource rawSource = let sourceFileName = rawSourceFilename rawSource @@ -86,6 +90,13 @@ processRawSource rawSource = } else undefined +constructCompileTimeInfo :: Source -> [Source] -> FilePath -> CompileTimeInfo +constructCompileTimeInfo program@(Program{}) otherSources buildDirectory = + CompileTimeInfo + { compileTimeInfoSourceFileName = programSourceFileName program + } +constructCompileTimeInfo _ otherSources buildDirectory = undefined + pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = intercalate "_" (splitDirectories fileName) -- cgit v1.2.3 From 078f4ca5af387ef39e331f2eb2d7f0df5ce6d720 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 11:13:07 -0500 Subject: Add test for object file of program's compile time info --- bootstrap/src/BuildModel.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 9bc6b48..86dbeab 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -60,6 +60,7 @@ data Source = data CompileTimeInfo = CompileTimeInfo { compileTimeInfoSourceFileName :: FilePath + , compileTimeInfoObjectFileProduced :: FilePath } processRawSource :: RawSource -> Source @@ -93,7 +94,9 @@ processRawSource rawSource = constructCompileTimeInfo :: Source -> [Source] -> FilePath -> CompileTimeInfo constructCompileTimeInfo program@(Program{}) otherSources buildDirectory = CompileTimeInfo - { compileTimeInfoSourceFileName = programSourceFileName program + { compileTimeInfoSourceFileName = programSourceFileName program + , compileTimeInfoObjectFileProduced = (programObjectFileName program) + buildDirectory } constructCompileTimeInfo _ otherSources buildDirectory = undefined -- cgit v1.2.3 From 20ee2333cd86909e21ca5bd88f3d7166e1941c92 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 11:15:25 -0500 Subject: Add test that program produces no other files --- bootstrap/src/BuildModel.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 86dbeab..86df719 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -61,6 +61,7 @@ data Source = data CompileTimeInfo = CompileTimeInfo { compileTimeInfoSourceFileName :: FilePath , compileTimeInfoObjectFileProduced :: FilePath + , compileTimeInfoOtherFilesProduced :: [FilePath] } processRawSource :: RawSource -> Source @@ -97,6 +98,7 @@ constructCompileTimeInfo program@(Program{}) otherSources buildDirectory = { compileTimeInfoSourceFileName = programSourceFileName program , compileTimeInfoObjectFileProduced = (programObjectFileName program) buildDirectory + , compileTimeInfoOtherFilesProduced = [] } constructCompileTimeInfo _ otherSources buildDirectory = undefined -- cgit v1.2.3 From 5db397ddca9ffa5558fb80ebfad73332f8c52cd6 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 11:27:30 -0500 Subject: Add test for program's direct dependencies --- bootstrap/src/BuildModel.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 86df719..f4c809f 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -62,6 +62,7 @@ data CompileTimeInfo = CompileTimeInfo { compileTimeInfoSourceFileName :: FilePath , compileTimeInfoObjectFileProduced :: FilePath , compileTimeInfoOtherFilesProduced :: [FilePath] + , compileTimeInfoDirectDependencies :: [FilePath] } processRawSource :: RawSource -> Source @@ -92,13 +93,16 @@ processRawSource rawSource = } else undefined -constructCompileTimeInfo :: Source -> [Source] -> FilePath -> CompileTimeInfo -constructCompileTimeInfo program@(Program{}) otherSources buildDirectory = +constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo +constructCompileTimeInfo program@(Program{}) availableModules buildDirectory = CompileTimeInfo { compileTimeInfoSourceFileName = programSourceFileName program , compileTimeInfoObjectFileProduced = (programObjectFileName program) buildDirectory , compileTimeInfoOtherFilesProduced = [] + , compileTimeInfoDirectDependencies = map + (\mName -> buildDirectory mName <.> "mod") + (filter (`elem` availableModules) (programModulesUsed program)) } constructCompileTimeInfo _ otherSources buildDirectory = undefined -- cgit v1.2.3 From 55590e78dd6df0eac312eaadfc230533adfe0018 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 14:24:55 -0500 Subject: Add tests for module's compile time info --- bootstrap/src/BuildModel.hs | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index f4c809f..c6e422b 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -94,15 +94,28 @@ processRawSource rawSource = else undefined constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo -constructCompileTimeInfo program@(Program{}) availableModules buildDirectory = +constructCompileTimeInfo p@(Program{}) availableModules buildDirectory = CompileTimeInfo - { compileTimeInfoSourceFileName = programSourceFileName program - , compileTimeInfoObjectFileProduced = (programObjectFileName program) + { compileTimeInfoSourceFileName = programSourceFileName p + , compileTimeInfoObjectFileProduced = (programObjectFileName p) buildDirectory , compileTimeInfoOtherFilesProduced = [] , compileTimeInfoDirectDependencies = map (\mName -> buildDirectory mName <.> "mod") - (filter (`elem` availableModules) (programModulesUsed program)) + (filter (`elem` availableModules) (programModulesUsed p)) + } +constructCompileTimeInfo m@(Module{}) availableModules buildDirectory = + CompileTimeInfo + { compileTimeInfoSourceFileName = moduleSourceFileName m + , compileTimeInfoObjectFileProduced = (moduleObjectFileName m) + buildDirectory + , compileTimeInfoOtherFilesProduced = + (buildDirectory moduleName m <.> "mod") : if moduleProducesSmod m + then [buildDirectory moduleName m <.> "smod"] + else [] + , compileTimeInfoDirectDependencies = map + (\mName -> buildDirectory mName <.> "mod") + (filter (`elem` availableModules) (moduleModulesUsed m)) } constructCompileTimeInfo _ otherSources buildDirectory = undefined -- cgit v1.2.3 From 0799961cdd047005021549c32d8f8d7731f40d27 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 14:36:30 -0500 Subject: Split submodule name into two components --- bootstrap/src/BuildModel.hs | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index c6e422b..b8fc537 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -30,7 +30,7 @@ data LineContents = | ModuleDeclaration String | ModuleUsed String | ModuleSubprogramDeclaration - | SubmoduleDeclaration String + | SubmoduleDeclaration String String | Other data RawSource = RawSource { @@ -55,6 +55,7 @@ data Source = { submoduleSourceFileName :: FilePath , submoduleObjectFileName :: FilePath -> FilePath , submoduleModulesUsed :: [String] + , submoduleParentName :: String , submoduleName :: String } @@ -86,11 +87,13 @@ processRawSource rawSource = , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents } else if hasSubmoduleDeclaration parsedContents - then Submodule { submoduleSourceFileName = sourceFileName - , submoduleObjectFileName = objectFileName - , submoduleModulesUsed = modulesUsed - , submoduleName = getSubmoduleName parsedContents - } + then Submodule + { submoduleSourceFileName = sourceFileName + , submoduleObjectFileName = objectFileName + , submoduleModulesUsed = modulesUsed + , submoduleParentName = getSubmoduleParentName parsedContents + , submoduleName = getSubmoduleName parsedContents + } else undefined constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo @@ -178,11 +181,20 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc ModuleDeclaration moduleName -> Just moduleName _ -> Nothing +getSubmoduleParentName :: [LineContents] -> String +getSubmoduleParentName pc = head $ mapMaybe contentToMaybeModuleName pc + where + contentToMaybeModuleName content = case content of + SubmoduleDeclaration submoduleParentName submoduleName -> + Just submoduleParentName + _ -> Nothing + getSubmoduleName :: [LineContents] -> String getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc where contentToMaybeModuleName content = case content of - SubmoduleDeclaration submoduleName -> Just submoduleName + SubmoduleDeclaration submoduleParentName submoduleName -> + Just submoduleName _ -> Nothing readFileLinesIO :: FilePath -> IO [String] @@ -236,7 +248,7 @@ submoduleDeclaration = do skipSpaces name <- validIdentifier skipSpaceCommentOrEnd - return $ SubmoduleDeclaration ((intercalate "@" parents) ++ "@" ++ name) + return $ SubmoduleDeclaration (intercalate "@" parents) name submoduleParents :: ReadP [String] submoduleParents = do -- cgit v1.2.3 From a42d68ad4386a7a797eaaa35bdf501c0344f60e9 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 14:56:00 -0500 Subject: Add tests for submodule's compile time info --- bootstrap/src/BuildModel.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index b8fc537..dfbab72 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -120,7 +120,23 @@ constructCompileTimeInfo m@(Module{}) availableModules buildDirectory = (\mName -> buildDirectory mName <.> "mod") (filter (`elem` availableModules) (moduleModulesUsed m)) } -constructCompileTimeInfo _ otherSources buildDirectory = undefined +constructCompileTimeInfo s@(Submodule{}) availableModules buildDirectory = + CompileTimeInfo + { compileTimeInfoSourceFileName = submoduleSourceFileName s + , compileTimeInfoObjectFileProduced = (submoduleObjectFileName s) + buildDirectory + , compileTimeInfoOtherFilesProduced = [ buildDirectory + submoduleParentName s + ++ "@" + ++ submoduleName s + <.> "smod" + ] + , compileTimeInfoDirectDependencies = + (buildDirectory submoduleParentName s <.> "smod") + : (map (\mName -> buildDirectory mName <.> "mod") + (filter (`elem` availableModules) (submoduleModulesUsed s)) + ) + } pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = -- cgit v1.2.3 From 1830d3e9bedb9da860de9682b43696fd6172f34f Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Tue, 20 Oct 2020 16:48:19 -0500 Subject: Utilize new model for build process --- bootstrap/src/BuildModel.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index dfbab72..8f4d813 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -96,6 +96,19 @@ processRawSource rawSource = } else undefined +getAvailableModules :: [Source] -> [String] +getAvailableModules = mapMaybe maybeModuleName + where + maybeModuleName m@(Module{}) = Just $ moduleName m + maybeModuleName _ = Nothing + +getAllObjectFiles :: FilePath -> [Source] -> [FilePath] +getAllObjectFiles buildDirectory sources = map getObjectFile sources + where + getObjectFile p@(Program{} ) = (programObjectFileName p) buildDirectory + getObjectFile m@(Module{} ) = (moduleObjectFileName m) buildDirectory + getObjectFile s@(Submodule{}) = (submoduleObjectFileName s) buildDirectory + constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo constructCompileTimeInfo p@(Program{}) availableModules buildDirectory = CompileTimeInfo -- cgit v1.2.3 From bcef4a4789f439934a40709189c1ae9e036cf1d2 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Wed, 21 Oct 2020 10:06:11 -0500 Subject: Make module subprogram declaration detection more explicit/restricted --- bootstrap/src/BuildModel.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 8f4d813..6dc8ddf 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -308,14 +308,24 @@ useStatement = do moduleSubprogramDeclaration :: ReadP LineContents moduleSubprogramDeclaration = do - skipAnything + skipSpaces + skipProcedureQualifiers _ <- string "module" skipAtLeastOneWhiteSpace - skipAnything _ <- string "function" <|> string "subroutine" skipAtLeastOneWhiteSpace return $ ModuleSubprogramDeclaration +skipProcedureQualifiers :: ReadP () +skipProcedureQualifiers = do + many skipPossibleQualifier + return () + +skipPossibleQualifier :: ReadP () +skipPossibleQualifier = do + _ <- string "pure" <|> string "elemental" <|> string "impure" + skipAtLeastOneWhiteSpace + skipAtLeastOneWhiteSpace :: ReadP () skipAtLeastOneWhiteSpace = do _ <- many1 whiteSpace -- cgit v1.2.3 From 5f16555d030ff120d5175477886473de40654659 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 22 Oct 2020 13:42:10 -0500 Subject: Add some debugging code --- bootstrap/src/BuildModel.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index 6dc8ddf..d7b39dc 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -109,6 +109,11 @@ getAllObjectFiles buildDirectory sources = map getObjectFile sources getObjectFile m@(Module{} ) = (moduleObjectFileName m) buildDirectory getObjectFile s@(Submodule{}) = (submoduleObjectFileName s) buildDirectory +getSourceFileName :: Source -> FilePath +getSourceFileName p@(Program{}) = programSourceFileName p +getSourceFileName m@(Module{}) = moduleSourceFileName m +getSourceFileName s@(Submodule{}) = submoduleSourceFileName s + constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo constructCompileTimeInfo p@(Program{}) availableModules buildDirectory = CompileTimeInfo -- cgit v1.2.3 From 03c9efc756568ce9c74fdb9dc9df216975e5cd69 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 22 Oct 2020 16:43:58 -0500 Subject: Add test with submodule example project and fix .smod naming convention --- bootstrap/src/BuildModel.hs | 84 +++++++++++++++++++++++++++------------------ 1 file changed, 51 insertions(+), 33 deletions(-) (limited to 'bootstrap/src/BuildModel.hs') diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index d7b39dc..95d3cac 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -1,6 +1,7 @@ module BuildModel where import Control.Applicative ( (<|>) ) +import Control.Monad ( when ) import Data.Char ( isAsciiLower , isDigit , toLower @@ -30,7 +31,7 @@ data LineContents = | ModuleDeclaration String | ModuleUsed String | ModuleSubprogramDeclaration - | SubmoduleDeclaration String String + | SubmoduleDeclaration String String String | Other data RawSource = RawSource { @@ -55,6 +56,7 @@ data Source = { submoduleSourceFileName :: FilePath , submoduleObjectFileName :: FilePath -> FilePath , submoduleModulesUsed :: [String] + , submoduleBaseModuleName :: String , submoduleParentName :: String , submoduleName :: String } @@ -68,33 +70,37 @@ data CompileTimeInfo = CompileTimeInfo { processRawSource :: RawSource -> Source processRawSource rawSource = - let sourceFileName = rawSourceFilename rawSource - parsedContents = parseContents rawSource - objectFileName = - \bd -> bd (pathSeparatorsToUnderscores sourceFileName) <.> "o" - modulesUsed = getModulesUsed parsedContents - in if hasProgramDeclaration parsedContents - then Program { programSourceFileName = sourceFileName - , programObjectFileName = objectFileName - , programModulesUsed = modulesUsed - } - else if hasModuleDeclaration parsedContents - then Module - { moduleSourceFileName = sourceFileName - , moduleObjectFileName = objectFileName - , moduleModulesUsed = modulesUsed - , moduleName = getModuleName parsedContents - , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents + let + sourceFileName = rawSourceFilename rawSource + parsedContents = parseContents rawSource + objectFileName = + \bd -> bd (pathSeparatorsToUnderscores sourceFileName) <.> "o" + modulesUsed = getModulesUsed parsedContents + in + if hasProgramDeclaration parsedContents + then Program { programSourceFileName = sourceFileName + , programObjectFileName = objectFileName + , programModulesUsed = modulesUsed + } + else if hasModuleDeclaration parsedContents + then Module + { moduleSourceFileName = sourceFileName + , moduleObjectFileName = objectFileName + , moduleModulesUsed = modulesUsed + , moduleName = getModuleName parsedContents + , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents + } + else if hasSubmoduleDeclaration parsedContents + then Submodule + { submoduleSourceFileName = sourceFileName + , submoduleObjectFileName = objectFileName + , submoduleModulesUsed = modulesUsed + , submoduleBaseModuleName = getSubmoduleBaseModuleName + parsedContents + , submoduleParentName = getSubmoduleParentName parsedContents + , submoduleName = getSubmoduleName parsedContents } - else if hasSubmoduleDeclaration parsedContents - then Submodule - { submoduleSourceFileName = sourceFileName - , submoduleObjectFileName = objectFileName - , submoduleModulesUsed = modulesUsed - , submoduleParentName = getSubmoduleParentName parsedContents - , submoduleName = getSubmoduleName parsedContents - } - else undefined + else undefined getAvailableModules :: [Source] -> [String] getAvailableModules = mapMaybe maybeModuleName @@ -110,8 +116,8 @@ getAllObjectFiles buildDirectory sources = map getObjectFile sources getObjectFile s@(Submodule{}) = (submoduleObjectFileName s) buildDirectory getSourceFileName :: Source -> FilePath -getSourceFileName p@(Program{}) = programSourceFileName p -getSourceFileName m@(Module{}) = moduleSourceFileName m +getSourceFileName p@(Program{} ) = programSourceFileName p +getSourceFileName m@(Module{} ) = moduleSourceFileName m getSourceFileName s@(Submodule{}) = submoduleSourceFileName s constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo @@ -144,7 +150,7 @@ constructCompileTimeInfo s@(Submodule{}) availableModules buildDirectory = , compileTimeInfoObjectFileProduced = (submoduleObjectFileName s) buildDirectory , compileTimeInfoOtherFilesProduced = [ buildDirectory - submoduleParentName s + submoduleBaseModuleName s ++ "@" ++ submoduleName s <.> "smod" @@ -215,11 +221,19 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc ModuleDeclaration moduleName -> Just moduleName _ -> Nothing +getSubmoduleBaseModuleName :: [LineContents] -> String +getSubmoduleBaseModuleName pc = head $ mapMaybe contentToMaybeModuleName pc + where + contentToMaybeModuleName content = case content of + SubmoduleDeclaration baseModuleName submoduleParentName submoduleName -> + Just baseModuleName + _ -> Nothing + getSubmoduleParentName :: [LineContents] -> String getSubmoduleParentName pc = head $ mapMaybe contentToMaybeModuleName pc where contentToMaybeModuleName content = case content of - SubmoduleDeclaration submoduleParentName submoduleName -> + SubmoduleDeclaration baseModuleName submoduleParentName submoduleName -> Just submoduleParentName _ -> Nothing @@ -227,7 +241,7 @@ getSubmoduleName :: [LineContents] -> String getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc where contentToMaybeModuleName content = case content of - SubmoduleDeclaration submoduleParentName submoduleName -> + SubmoduleDeclaration baseModuleName submoduleParentName submoduleName -> Just submoduleName _ -> Nothing @@ -271,6 +285,7 @@ moduleDeclaration = do _ <- string "module" skipAtLeastOneWhiteSpace moduleName <- validIdentifier + when (moduleName == "procedure") (fail "") skipSpaceCommentOrEnd return $ ModuleDeclaration moduleName @@ -279,10 +294,13 @@ submoduleDeclaration = do skipSpaces _ <- string "submodule" parents <- submoduleParents + let parentName = case parents of + (baseModule : []) -> baseModule + (multiple ) -> (head multiple) ++ "@" ++ (last multiple) skipSpaces name <- validIdentifier skipSpaceCommentOrEnd - return $ SubmoduleDeclaration (intercalate "@" parents) name + return $ SubmoduleDeclaration (head parents) parentName name submoduleParents :: ReadP [String] submoduleParents = do -- cgit v1.2.3