Functionality to print a dependency list for a Fortran code base

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
@@ -205,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
@@ -328,7 +300,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 +395,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) }

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

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)
@@ -85,16 +85,28 @@ 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
 
+-- Remove duplicates from a list preserving the left most occurrence.
+removeDuplicates :: Eq a => [a] -> [a]
+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
  where
@@ -108,6 +120,18 @@ 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 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)]
 takeNextMods ModGraph { mgModNodeMap = mnmap, mgGraph = gr } = noDepFiles
  where

src/Language/Fortran/Util/Files.hs

@@ -3,18 +3,21 @@ module Language.Fortran.Util.Files
  , runCPP
  , getDirContents
  , rGetDirContents
+ , expandDirs
+ , listFortranFiles
+ , listDirectoryRecursively
  ) where
 
 import qualified Data.Text.Encoding as T
 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.
@@ -36,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
@@ -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]

test-data/module/leaf.f90

@@ -0,0 +1,4 @@
+module leaf
+ implicit none
+ real :: constant = 0.1
+end module

test-data/module/mid1.f90

@@ -0,0 +1,4 @@
+module mid1
+ implicit none
+ use leaf
+end module

test-data/module/mid2.f90

@@ -0,0 +1,4 @@
+module mid2
+ implicit none
+ use leaf
+end module

test-data/module/top.f90

@@ -0,0 +1,5 @@
+module top
+ implicit none
+ use mid1
+ use mid2
+end module

test/Language/Fortran/Analysis/ModGraphSpec.hs

@@ -0,0 +1,26 @@
+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
+import System.FilePath ((</>))
+
+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