{- |
Module : $Header$
Description : Computation of module dependencies
Copyright : (c) 2002 - 2004 Wolfgang Lux
2005 Martin Engelke
2007 Sebastian Fischer
2011 - 2013 Björn Peemöller
2016 - 2017 Finn Teegen
License : BSD-3-clause
Maintainer : bjp@informatik.uni-kiel.de
Stability : experimental
Portability : portable
This module implements the functions to compute the dependency
information between Curry modules. This is used to create Makefile
dependencies and to update programs composed of multiple modules.
-}
{-# LANGUAGE CPP #-}
module CurryDeps
( Source (..), flatDeps, deps, flattenDeps, sourceDeps, moduleDeps ) where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
import Control.Monad (foldM)
import Data.List (isSuffixOf, nub)
import qualified Data.Map as Map (Map, empty, insert, lookup, toList)
import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Pretty
import Curry.Files.Filenames
import Curry.Files.PathUtils
import Curry.Syntax
( Module (..), ModulePragma (..), ImportDecl (..), parseHeader, parsePragmas
, patchModuleId, hasLanguageExtension)
import Base.Messages
import Base.SCC (scc)
import CompilerOpts (Options (..), CppOpts (..), KnownExtension (..))
import CondCompile (condCompile)
-- |Different types of source files
data Source
-- | A source file with pragmas and module imports
= Source FilePath [ModulePragma] [ModuleIdent]
-- | An interface file
| Interface FilePath
-- | An unknown file
| Unknown
deriving (Eq, Show)
type SourceEnv = Map.Map ModuleIdent Source
-- |Retrieve the dependencies of a source file in topological order
-- and possible errors during flattering
flatDeps :: Options -> FilePath -> CYIO [(ModuleIdent, Source)]
flatDeps opts fn = do
sEnv <- deps opts Map.empty fn
case flattenDeps sEnv of
(env, [] ) -> ok env
(_ , errs) -> failMessages errs
-- |Retrieve the dependencies of a source file as a 'SourceEnv'
deps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
deps opts sEnv fn
| ext == icurryExt = return sEnv
| ext `elem` sourceExts = sourceDeps opts sEnv fn
| otherwise = targetDeps opts sEnv fn
where ext = takeExtension fn
-- The following functions are used to lookup files related to a given
-- module. Source files for targets are looked up in the current
-- directory only. Two different search paths are used to look up
-- imported modules, the first is used to find source modules, whereas
-- the library path is used only for finding matching interface files. As
-- the compiler does not distinguish these paths, we actually check for
-- interface files in the source paths as well.
-- In order to compute the dependency graph, source files for each module
-- need to be looked up. When a source module is found, its header is
-- parsed in order to determine the modules that it imports, and
-- dependencies for these modules are computed recursively. The prelude
-- is added implicitly to the list of imported modules except for the
-- prelude itself.
-- |Retrieve the dependencies of a given target file
targetDeps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
targetDeps opts sEnv fn = do
mFile <- liftIO $ lookupFile [""] sourceExts fn
case mFile of
Nothing -> return $ Map.insert (mkMIdent [fn]) Unknown sEnv
Just file -> sourceDeps opts sEnv file
-- |Retrieve the dependencies of a given source file
sourceDeps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
sourceDeps opts sEnv fn = readHeader opts fn >>= moduleDeps opts sEnv fn
-- |Retrieve the dependencies of a given module
moduleDeps :: Options -> SourceEnv -> FilePath -> Module a -> CYIO SourceEnv
moduleDeps opts sEnv fn mdl@(Module _ _ ps m _ _ _) = case Map.lookup m sEnv of
Just _ -> return sEnv
Nothing -> do
let imps = imports opts mdl
sEnv' = Map.insert m (Source fn ps imps) sEnv
foldM (moduleIdentDeps opts) sEnv' imps
-- |Retrieve the imported modules and add the import of the Prelude
-- according to the compiler options.
imports :: Options -> Module a -> [ModuleIdent]
imports opts mdl@(Module _ _ _ m _ is _) = nub $
[preludeMIdent | m /= preludeMIdent && not noImplicitPrelude]
++ [m' | ImportDecl _ m' _ _ _ <- is]
where noImplicitPrelude = NoImplicitPrelude `elem` optExtensions opts
|| mdl `hasLanguageExtension` NoImplicitPrelude
-- |Retrieve the dependencies for a given 'ModuleIdent'
moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
moduleIdentDeps opts sEnv m = case Map.lookup m sEnv of
Just _ -> return sEnv
Nothing -> do
mFile <- liftIO $ lookupCurryModule ("." : optImportPaths opts)
(optLibraryPaths opts) m
case mFile of
Nothing -> return $ Map.insert m Unknown sEnv
Just fn
| icurryExt `isSuffixOf` fn ->
return $ Map.insert m (Interface fn) sEnv
| otherwise -> do
hdr@(Module _ _ _ m' _ _ _) <- readHeader opts fn
if m == m' then moduleDeps opts sEnv fn hdr
else failMessages [errWrongModule m m']
readHeader :: Options -> FilePath -> CYIO (Module ())
readHeader opts fn = do
mbFile <- liftIO $ readModule fn
case mbFile of
Nothing -> failMessages [errMissingFile fn]
Just src -> do
prgs <- liftCYM $ parsePragmas fn src
let cppOpts = optCppOpts opts
cppOpts' =
cppOpts { cppRun = cppRun cppOpts || hasLanguageExtension prgs CPP }
condC <- condCompile cppOpts' fn src
hdr <- liftCYM $ parseHeader fn condC
return $ patchModuleId fn hdr
-- If we want to compile the program instead of generating Makefile
-- dependencies, the environment has to be sorted topologically. Note
-- that the dependency graph should not contain any cycles.
flattenDeps :: SourceEnv -> ([(ModuleIdent, Source)], [Message])
flattenDeps = fdeps . sortDeps
where
sortDeps :: SourceEnv -> [[(ModuleIdent, Source)]]
sortDeps = scc idents imported . Map.toList
idents (m, _) = [m]
imported (_, Source _ _ ms) = ms
imported (_, _) = []
fdeps :: [[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message])
fdeps = foldr checkdep ([], [])
checkdep [] (srcs, errs) = (srcs , errs )
checkdep [src] (srcs, errs) = (src : srcs, errs )
checkdep dep (srcs, errs) = (srcs , err : errs)
where err = errCyclicImport $ map fst dep
errMissingFile :: FilePath -> Message
errMissingFile fn = message $ sep $ map text [ "Missing file:", fn ]
errWrongModule :: ModuleIdent -> ModuleIdent -> Message
errWrongModule m m' = message $ sep $
[ text "Expected module for", text (moduleName m) <> comma
, text "but found", text (moduleName m') ]
errCyclicImport :: [ModuleIdent] -> Message
errCyclicImport [] = internalError "CurryDeps.errCyclicImport: empty list"
errCyclicImport [m] = message $ sep $ map text
[ "Recursive import for module", moduleName m ]
errCyclicImport ms = message $ sep $
text "Cyclic import dependency between modules" : punctuate comma inits
++ [text "and", lastm]
where
(inits, lastm) = splitLast $ map (text . moduleName) ms
splitLast [] = internalError "CurryDeps.splitLast: empty list"
splitLast (x : []) = ([] , x)
splitLast (x : xs) = (x : ys, y) where (ys, y) = splitLast xs