diff --git a/app/Main.hs b/app/Main.hs index 85e7123f..7d6bad42 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 @@ -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) } 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/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index 297b0dfa..930e1538 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) @@ -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 diff --git a/src/Language/Fortran/Util/Files.hs b/src/Language/Fortran/Util/Files.hs index b4bd1ce2..7cee0325 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. @@ -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] 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..dd2528db --- /dev/null +++ b/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