From 260550c791342d574a9fcdc08949f4ed3c153663 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 17:09:58 +0100 Subject: [PATCH 01/11] topological sort of dependency graph --- src/Language/Fortran/Analysis/ModGraph.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index 297b0dfa..f2381dae 100644 --- a/src/Language/Fortran/Analysis/ModGraph.hs +++ b/src/Language/Fortran/Analysis/ModGraph.hs @@ -1,6 +1,6 @@ -- | Generate a module use-graph. module Language.Fortran.Analysis.ModGraph - (genModGraph, ModGraph(..), ModOrigin(..), modGraphToDOT, takeNextMods, delModNodes) + (genModGraph, ModGraph(..), ModOrigin(..), modGraphToList, modGraphToDOT, takeNextMods, delModNodes) where import Language.Fortran.AST hiding (setName) @@ -108,6 +108,16 @@ modGraphToDOT ModGraph { mgGraph = gr } = unlines dot (labNodes gr) ++ [ "}\n" ] +-- Provides a topological sort of the graph, giving a list of filenames +modGraphToList :: ModGraph -> [String] +modGraphToList mg + | nxt <- takeNextMods mg + , not (null nxt) = + let mg' = delModNodes (map fst nxt) mg + in [ fn | (_, Just (MOFile fn)) <- nxt ] ++ modGraphToList mg' +modGraphToList _ = [] + + takeNextMods :: ModGraph -> [(Node, Maybe ModOrigin)] takeNextMods ModGraph { mgModNodeMap = mnmap, mgGraph = gr } = noDepFiles where From 8e285f0548d613bc2dc6b3ed04c857cf2c8f8b4e Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 18:20:02 +0100 Subject: [PATCH 02/11] add command line argument for showing the dependency list --- app/Main.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 85e7123f..89d2b63f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -59,6 +59,10 @@ main = do paths' <- expandDirs paths mg <- genModGraph (fortranVersion opts) (includeDirs opts) (cppOptions opts) paths' putStrLn $ modGraphToDOT mg + (paths, ShowMakeList) -> do + paths' <- expandDirs paths + mg <- genModGraph (fortranVersion opts) (includeDirs opts) (cppOptions opts) paths' + mapM_ putStrLn (modGraphToList mg) -- make: construct a build-dep graph and follow it (paths, Make) -> do let mvers = fortranVersion opts @@ -328,7 +332,7 @@ printTypeErrors = putStrLn . showTypeErrors data Action = Lex | Parse | Typecheck | Rename | BBlocks | SuperGraph | Reprint | DumpModFile | Compile - | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | Make + | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | ShowMakeList | Make deriving Eq instance Read Action where @@ -423,6 +427,10 @@ options = ["show-make-graph"] (NoArg $ \ opts -> opts { action = ShowMakeGraph }) "dump a graph showing the build structure of modules" + , Option [] + ["show-make-list"] + (NoArg $ \ opts -> opts { action = ShowMakeList }) + "dump a list of files in build dependency order (topological sort from the dependency graph)" , Option [] ["show-block-numbers"] (OptArg (\a opts -> opts { action = ShowBlocks (a >>= readMaybe) } From 446f7e976e707941c56e052ddb92cb98b0a6bc07 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 18:20:46 +0100 Subject: [PATCH 03/11] move some useful helper functions from Main to Utils so easier to reuse elsewhere --- app/Main.hs | 32 ------------------------ src/Language/Fortran/Util/Files.hs | 40 ++++++++++++++++++++++++++++-- 2 files changed, 38 insertions(+), 34 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 89d2b63f..7d6bad42 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -209,38 +209,6 @@ main = do _ -> fail $ usageInfo programName options _ -> fail $ usageInfo programName options --- | Expand all paths that are directories into a list of Fortran --- files from a recursive directory listing. -expandDirs :: [FilePath] -> IO [FilePath] -expandDirs = fmap concat . mapM each - where - each path = do - isDir <- doesDirectoryExist path - if isDir - then listFortranFiles path - else pure [path] - --- | Get a list of Fortran files under the given directory. -listFortranFiles :: FilePath -> IO [FilePath] -listFortranFiles dir = filter isFortran <$> listDirectoryRecursively dir - where - -- | True if the file has a valid fortran extension. - isFortran :: FilePath -> Bool - isFortran x = map toLower (takeExtension x) `elem` exts - where exts = [".f", ".f90", ".f77", ".f03"] - -listDirectoryRecursively :: FilePath -> IO [FilePath] -listDirectoryRecursively dir = listDirectoryRec dir "" - where - listDirectoryRec :: FilePath -> FilePath -> IO [FilePath] - listDirectoryRec d f = do - let fullPath = d f - isDir <- doesDirectoryExist fullPath - if isDir - then do - conts <- listDirectory fullPath - concat <$> mapM (listDirectoryRec fullPath) conts - else pure [fullPath] compileFileToMod :: Maybe FortranVersion -> ModFiles -> FilePath -> Maybe FilePath -> IO ModFile compileFileToMod mvers mods path moutfile = do diff --git a/src/Language/Fortran/Util/Files.hs b/src/Language/Fortran/Util/Files.hs index b4bd1ce2..acdd71b1 100644 --- a/src/Language/Fortran/Util/Files.hs +++ b/src/Language/Fortran/Util/Files.hs @@ -3,6 +3,9 @@ module Language.Fortran.Util.Files , runCPP , getDirContents , rGetDirContents + , expandDirs + , listFortranFiles + , listDirectoryRecursively ) where import qualified Data.Text.Encoding as T @@ -10,11 +13,11 @@ import qualified Data.Text.Encoding.Error as T import qualified Data.ByteString.Char8 as B import System.Directory (listDirectory, canonicalizePath, doesDirectoryExist, getDirectoryContents) -import System.FilePath (()) +import System.FilePath ((), takeExtension) import System.IO.Temp (withSystemTempDirectory) import System.Process (callProcess) import Data.List ((\\), foldl') -import Data.Char (isNumber) +import Data.Char (isNumber, toLower) -- | Obtain a UTF-8 safe 'B.ByteString' representation of a file's contents. -- -- Invalid UTF-8 is replaced with the space character. @@ -68,3 +71,36 @@ runCPP (Just cppOpts) path = do let ls = B.lines contents let ls' = reverse . fst $ foldl' processCPPLine ([], 1) ls return $ B.unlines ls' + +-- | Expand all paths that are directories into a list of Fortran +-- files from a recursive directory listing. +expandDirs :: [FilePath] -> IO [FilePath] +expandDirs = fmap concat . mapM each + where + each path = do + isDir <- doesDirectoryExist path + if isDir + then listFortranFiles path + else pure [path] + +-- | Get a list of Fortran files under the given directory. +listFortranFiles :: FilePath -> IO [FilePath] +listFortranFiles dir = filter isFortran <$> listDirectoryRecursively dir + where + -- | True if the file has a valid fortran extension. + isFortran :: FilePath -> Bool + isFortran x = map toLower (takeExtension x) `elem` exts + where exts = [".f", ".f90", ".f77", ".f03"] + +listDirectoryRecursively :: FilePath -> IO [FilePath] +listDirectoryRecursively dir = listDirectoryRec dir "" + where + listDirectoryRec :: FilePath -> FilePath -> IO [FilePath] + listDirectoryRec d f = do + let fullPath = d f + isDir <- doesDirectoryExist fullPath + if isDir + then do + conts <- listDirectory fullPath + concat <$> mapM (listDirectoryRec fullPath) conts + else pure [fullPath] From 8eaa50f25ff6529bfbb33b91225c9631db0d97f9 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 18:22:06 +0100 Subject: [PATCH 04/11] add test for module graph --- fortran-src.cabal | 5 ++++ test-data/module/leaf.f90 | 4 +++ test-data/module/mid1.f90 | 4 +++ test-data/module/mid2.f90 | 4 +++ test-data/module/top.f90 | 5 ++++ .../Language/Fortran/Analysis/ModGraphSpec.hs | 25 +++++++++++++++++++ 6 files changed, 47 insertions(+) create mode 100644 test-data/module/leaf.f90 create mode 100644 test-data/module/mid1.f90 create mode 100644 test-data/module/mid2.f90 create mode 100644 test-data/module/top.f90 create mode 100644 test/Language/Fortran/Analysis/ModGraphSpec.hs diff --git a/fortran-src.cabal b/fortran-src.cabal index 25f8e6fd..647e8d44 100644 --- a/fortran-src.cabal +++ b/fortran-src.cabal @@ -27,6 +27,10 @@ extra-source-files: CHANGELOG.md test-data/f77-include/foo.f test-data/f77-include/no-newline/foo.f + test-data/module/leaf.f90 + test-data/module/mid1.f90 + test-data/module/mid2.f90 + test-data/module/top.f90 test-data/rewriter/replacementsmap-columnlimit/001_foo.f test-data/rewriter/replacementsmap-columnlimit/001_foo.f.expected test-data/rewriter/replacementsmap-columnlimit/002_other.f @@ -276,6 +280,7 @@ test-suite spec other-modules: Language.Fortran.Analysis.BBlocksSpec Language.Fortran.Analysis.DataFlowSpec + Language.Fortran.Analysis.ModGraphSpec Language.Fortran.Analysis.RenamingSpec Language.Fortran.Analysis.SemanticTypesSpec Language.Fortran.Analysis.TypesSpec diff --git a/test-data/module/leaf.f90 b/test-data/module/leaf.f90 new file mode 100644 index 00000000..3a333cac --- /dev/null +++ b/test-data/module/leaf.f90 @@ -0,0 +1,4 @@ +module leaf + implicit none + real :: constant = 0.1 +end module \ No newline at end of file diff --git a/test-data/module/mid1.f90 b/test-data/module/mid1.f90 new file mode 100644 index 00000000..50bad448 --- /dev/null +++ b/test-data/module/mid1.f90 @@ -0,0 +1,4 @@ +module mid1 + implicit none + use leaf +end module \ No newline at end of file diff --git a/test-data/module/mid2.f90 b/test-data/module/mid2.f90 new file mode 100644 index 00000000..b4924aee --- /dev/null +++ b/test-data/module/mid2.f90 @@ -0,0 +1,4 @@ +module mid2 + implicit none + use leaf +end module \ No newline at end of file diff --git a/test-data/module/top.f90 b/test-data/module/top.f90 new file mode 100644 index 00000000..22eba01e --- /dev/null +++ b/test-data/module/top.f90 @@ -0,0 +1,5 @@ +module top + implicit none + use mid1 + use mid2 +end module \ No newline at end of file diff --git a/test/Language/Fortran/Analysis/ModGraphSpec.hs b/test/Language/Fortran/Analysis/ModGraphSpec.hs new file mode 100644 index 00000000..df1f93e5 --- /dev/null +++ b/test/Language/Fortran/Analysis/ModGraphSpec.hs @@ -0,0 +1,25 @@ +module Language.Fortran.Analysis.ModGraphSpec (spec) where + +import Test.Hspec +import TestUtil + +import Language.Fortran.Analysis.ModGraph +import Language.Fortran.Util.Files (expandDirs) +import Language.Fortran.Version + +spec :: Spec +spec = + describe "Modgraph" $ + it "Dependency graph and topological sort on small package" $ + testDependencyList + +-- A simple test on a simple module structure to check that +-- we are understanding this correctly (via the dependency graph +-- and then its topological sort). +testDependencyList = do + paths' <- expandDirs ["test-data/module"] + mg <- genModGraph (Just Fortran90) ["."] Nothing paths' + let list = modGraphToList mg + let files = ["leaf.f90", "mid1.f90", "mid2.f90", "top.f90"] + let filesWithPaths = map ("test-data/module/" ++) files + list `shouldBe` filesWithPaths From 3a2ca1da337800266309e9c1faaac08d6149c630 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 18:22:27 +0100 Subject: [PATCH 05/11] better error handling when there are parsing issues when building make file graph --- src/Language/Fortran/Analysis/ModGraph.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index f2381dae..e9ad1699 100644 --- a/src/Language/Fortran/Analysis/ModGraph.hs +++ b/src/Language/Fortran/Analysis/ModGraph.hs @@ -85,12 +85,16 @@ genModGraph mversion includeDirs cppOpts paths = do let version = fromMaybe (deduceFortranVersion path) mversion mods = map snd fileMods parserF0 = Parser.byVerWithMods mods version - parserF fn bs = fromRight' $ parserF0 fn bs + parserF fn bs = + case parserF0 fn bs of + Right x -> return x + Left err -> do + error $ show err forM_ fileMods $ \ (fileName, mod) -> do forM_ [ name | Named name <- M.keys (combinedModuleMap [mod]) ] $ \ name -> do _ <- maybeAddModName name . Just $ MOFSMod fileName pure () - let pf = parserF path contents + pf <- parserF path contents mapM_ (perModule path) (childrenBi pf :: [ProgramUnit ()]) pure () execStateT (mapM_ iter paths) modGraph0 From 12c3fab67d5fcd35099cea7103c376470d640401 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 19:25:11 +0100 Subject: [PATCH 06/11] make test platform agnostic --- test/Language/Fortran/Analysis/ModGraphSpec.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Language/Fortran/Analysis/ModGraphSpec.hs b/test/Language/Fortran/Analysis/ModGraphSpec.hs index df1f93e5..75e28f5f 100644 --- a/test/Language/Fortran/Analysis/ModGraphSpec.hs +++ b/test/Language/Fortran/Analysis/ModGraphSpec.hs @@ -6,6 +6,7 @@ import TestUtil import Language.Fortran.Analysis.ModGraph import Language.Fortran.Util.Files (expandDirs) import Language.Fortran.Version +import System.FilePath (()) spec :: Spec spec = @@ -21,5 +22,5 @@ testDependencyList = do mg <- genModGraph (Just Fortran90) ["."] Nothing paths' let list = modGraphToList mg let files = ["leaf.f90", "mid1.f90", "mid2.f90", "top.f90"] - let filesWithPaths = map ("test-data/module/" ++) files + let filesWithPaths = map (("test-data" "module") ) files list `shouldBe` filesWithPaths From 2767ef608a1cfe9bb68923c7180cb51fdf4dd4a5 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Thu, 15 Aug 2024 21:37:45 +0100 Subject: [PATCH 07/11] make test platform agnostic (missed a case) --- test/Language/Fortran/Analysis/ModGraphSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Language/Fortran/Analysis/ModGraphSpec.hs b/test/Language/Fortran/Analysis/ModGraphSpec.hs index 75e28f5f..dd2528db 100644 --- a/test/Language/Fortran/Analysis/ModGraphSpec.hs +++ b/test/Language/Fortran/Analysis/ModGraphSpec.hs @@ -18,7 +18,7 @@ spec = -- we are understanding this correctly (via the dependency graph -- and then its topological sort). testDependencyList = do - paths' <- expandDirs ["test-data/module"] + paths' <- expandDirs ["test-data" "module"] mg <- genModGraph (Just Fortran90) ["."] Nothing paths' let list = modGraphToList mg let files = ["leaf.f90", "mid1.f90", "mid2.f90", "top.f90"] From d9ebee959f1a8d2e6216b89f858bdd171ec43317 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Fri, 23 Aug 2024 14:14:16 +0100 Subject: [PATCH 08/11] remove any duplicates --- src/Language/Fortran/Analysis/ModGraph.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index e9ad1699..3ae18500 100644 --- a/src/Language/Fortran/Analysis/ModGraph.hs +++ b/src/Language/Fortran/Analysis/ModGraph.hs @@ -97,7 +97,10 @@ genModGraph mversion includeDirs cppOpts paths = do pf <- parserF path contents mapM_ (perModule path) (childrenBi pf :: [ProgramUnit ()]) pure () - execStateT (mapM_ iter paths) modGraph0 + execStateT (mapM_ iter (removeDuplicates paths)) modGraph0 + +removeDuplicates :: Eq a => [a] -> [a] +removeDuplicates = foldl (\ acc x -> if x `elem` acc then acc else x : acc) [] modGraphToDOT :: ModGraph -> String modGraphToDOT ModGraph { mgGraph = gr } = unlines dot From eb111e7b35f6942093da2c2d499833f5eff68874 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Fri, 23 Aug 2024 14:23:51 +0100 Subject: [PATCH 09/11] keep first occurence when removing duplicates --- src/Language/Fortran/Analysis/ModGraph.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index 3ae18500..a3ef9d60 100644 --- a/src/Language/Fortran/Analysis/ModGraph.hs +++ b/src/Language/Fortran/Analysis/ModGraph.hs @@ -99,8 +99,13 @@ genModGraph mversion includeDirs cppOpts paths = do pure () execStateT (mapM_ iter (removeDuplicates paths)) modGraph0 +-- Remove duplicates from a list preserving the left most occurrence. removeDuplicates :: Eq a => [a] -> [a] -removeDuplicates = foldl (\ acc x -> if x `elem` acc then acc else x : acc) [] +removeDuplicates [] = [] +removeDuplicates (x:xs) = + if x `elem` xs + then x : removeDuplicates (filter (/= x) xs) + else x : removeDuplicates xs modGraphToDOT :: ModGraph -> String modGraphToDOT ModGraph { mgGraph = gr } = unlines dot From d1a4004477a8e47a8caf0403bb5a7d358ab487f2 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Mon, 2 Sep 2024 16:30:19 +0100 Subject: [PATCH 10/11] filepath consistency --- src/Language/Fortran/Util/Files.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Language/Fortran/Util/Files.hs b/src/Language/Fortran/Util/Files.hs index acdd71b1..7cee0325 100644 --- a/src/Language/Fortran/Util/Files.hs +++ b/src/Language/Fortran/Util/Files.hs @@ -39,11 +39,11 @@ rGetDirContents d = canonicalizePath d >>= \d' -> go [d'] d' fmap concat . mapM f $ ds \\ [".", ".."] -- remove '.' and '..' entries where f x = do - path <- canonicalizePath $ d ++ "/" ++ x + path <- canonicalizePath $ d x g <- doesDirectoryExist path if g && notElem path seen then do x' <- go (path : seen) path - return $ map (\ y -> x ++ "/" ++ y) x' + return $ map (\ y -> x y) x' else return [x] -- | Run the C Pre Processor over the file before reading into a bytestring From 921f8f768880a2c3816209d96aa55db950317f93 Mon Sep 17 00:00:00 2001 From: Dominic Orchard Date: Mon, 2 Sep 2024 16:36:26 +0100 Subject: [PATCH 11/11] remove duplicates after processing to a list --- src/Language/Fortran/Analysis/ModGraph.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index a3ef9d60..930e1538 100644 --- a/src/Language/Fortran/Analysis/ModGraph.hs +++ b/src/Language/Fortran/Analysis/ModGraph.hs @@ -97,7 +97,7 @@ genModGraph mversion includeDirs cppOpts paths = do pf <- parserF path contents mapM_ (perModule path) (childrenBi pf :: [ProgramUnit ()]) pure () - execStateT (mapM_ iter (removeDuplicates paths)) modGraph0 + execStateT (mapM_ iter paths) modGraph0 -- Remove duplicates from a list preserving the left most occurrence. removeDuplicates :: Eq a => [a] -> [a] @@ -122,12 +122,14 @@ modGraphToDOT ModGraph { mgGraph = gr } = unlines dot -- Provides a topological sort of the graph, giving a list of filenames modGraphToList :: ModGraph -> [String] -modGraphToList mg - | nxt <- takeNextMods mg - , not (null nxt) = - let mg' = delModNodes (map fst nxt) mg - in [ fn | (_, Just (MOFile fn)) <- nxt ] ++ modGraphToList mg' -modGraphToList _ = [] +modGraphToList m = removeDuplicates $ modGraphToList' m + where + modGraphToList' mg + | nxt <- takeNextMods mg + , not (null nxt) = + let mg' = delModNodes (map fst nxt) mg + in [ fn | (_, Just (MOFile fn)) <- nxt ] ++ modGraphToList' mg' + modGraphToList' _ = [] takeNextMods :: ModGraph -> [(Node, Maybe ModOrigin)]