CurryDeps.hs 6.81 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
{- |
    Module      :  $Header$
    Description :  Computation of module dependencies
    Copyright   :  (c) 2002-2004, Wolfgang Lux
                       2005, Martin Engelke    (men@informatik.uni-kiel.de)
                       2007, Sebastian Fischer (sebf@informatik.uni-kiel.de)
                       2011, Björn Peemöller   (bjp@informatik.uni-kiel.de)
    License     :  OtherLicense

    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.
-}

-- TODO (bjp): Propagate errors
-- Currently errors during the dependency search (like missing files
-- or errors during parsing a module header) lead to calls of the error
-- function. This dramatically limits the usability as a library.

module CurryDeps
  ( Source (..), flatDeps, deps, flattenDeps, sourceDeps, moduleDeps ) where

import Control.Monad (foldM, liftM, unless)
28
import Data.List (intercalate, isSuffixOf, nub)
Björn Peemöller 's avatar
Björn Peemöller committed
29 30 31
import qualified Data.Map as Map (Map, empty, insert, lookup, toList)

import Curry.Base.Ident
32
import Curry.Base.Message
Björn Peemöller 's avatar
Björn Peemöller committed
33 34
import Curry.Files.Filenames
import Curry.Files.PathUtils
35
import Curry.Syntax (Module (..),  ImportDecl (..), parseHeader, patchModuleId)
Björn Peemöller 's avatar
Björn Peemöller committed
36

37
import Base.Messages (abortWith, internalError)
Björn Peemöller 's avatar
Björn Peemöller committed
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
import Base.SCC (scc)
import CompilerOpts (Options (..), Extension (..))

-- |Different types of source files
data Source
  = Source FilePath [ModuleIdent] -- ^ A source file with module imports
  | Interface FilePath            -- ^ An interface file
  | Unknown                       -- ^ An unkonwn file
    deriving (Eq, Ord, 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 -> IO ([(ModuleIdent, Source)], [String])
Björn Peemöller 's avatar
Björn Peemöller committed
53
flatDeps opts fn = flattenDeps `liftM` deps opts Map.empty fn
Björn Peemöller 's avatar
Björn Peemöller committed
54 55

-- |Retrieve the dependencies of a source file as a 'SourceEnv'
Björn Peemöller 's avatar
Björn Peemöller committed
56 57
deps :: Options -> SourceEnv -> FilePath -> IO SourceEnv
deps opts sEnv fn
Björn Peemöller 's avatar
Björn Peemöller committed
58
  | ext   ==   icurryExt  = return Map.empty
Björn Peemöller 's avatar
Björn Peemöller committed
59 60
  | ext `elem` sourceExts = sourceDeps opts sEnv fn
  | otherwise             = targetDeps opts sEnv fn
Björn Peemöller 's avatar
Björn Peemöller committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
  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
Björn Peemöller 's avatar
Björn Peemöller committed
79 80
targetDeps :: Options -> SourceEnv -> FilePath -> IO SourceEnv
targetDeps opts sEnv fn = do
Björn Peemöller 's avatar
Björn Peemöller committed
81 82 83
  mFile <- lookupFile [""] sourceExts fn
  case mFile of
    Nothing   -> return $ Map.insert (mkMIdent [fn]) Unknown sEnv
Björn Peemöller 's avatar
Björn Peemöller committed
84
    Just file -> sourceDeps opts sEnv file
Björn Peemöller 's avatar
Björn Peemöller committed
85 86

-- |Retrieve the dependencies of a given source file
Björn Peemöller 's avatar
Björn Peemöller committed
87 88
sourceDeps :: Options -> SourceEnv -> FilePath -> IO SourceEnv
sourceDeps opts sEnv fn = do
89 90 91 92 93
  mbFile <- readModule fn
  case mbFile of
    Nothing   -> internalError $ "CurryDeps.sourceDeps: missing file " ++ fn
    Just file -> do
      let hdr = patchModuleId fn $ ok $ parseHeader fn file
Björn Peemöller 's avatar
Björn Peemöller committed
94
      moduleDeps opts sEnv fn hdr
Björn Peemöller 's avatar
Björn Peemöller committed
95 96

-- |Retrieve the dependencies of a given module
Björn Peemöller 's avatar
Björn Peemöller committed
97 98
moduleDeps :: Options -> SourceEnv -> FilePath -> Module -> IO SourceEnv
moduleDeps opts sEnv fn (Module m _ is _) = case Map.lookup m sEnv of
99 100 101 102
  Just  _ -> return sEnv
  Nothing -> do
    let imps  = imports opts m is
        sEnv' = Map.insert m (Source fn imps) sEnv
Björn Peemöller 's avatar
Björn Peemöller committed
103
    foldM (moduleIdentDeps opts) sEnv' imps
Björn Peemöller 's avatar
Björn Peemöller committed
104 105 106

-- |Retrieve the imported modules and add the import of the Prelude
--  according to the compiler options.
107
imports :: Options -> ModuleIdent -> [ImportDecl] -> [ModuleIdent]
Björn Peemöller 's avatar
Björn Peemöller committed
108 109 110 111 112 113
imports opts m ds = nub $
     [preludeMIdent | m /= preludeMIdent && implicitPrelude]
  ++ [m' | ImportDecl _ m' _ _ _ <- ds]
  where implicitPrelude = NoImplicitPrelude `notElem` optExtensions opts

-- |Retrieve the dependencies for a given 'ModuleIdent'
Björn Peemöller 's avatar
Björn Peemöller committed
114 115
moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> IO SourceEnv
moduleIdentDeps opts sEnv m = case Map.lookup m sEnv of
Björn Peemöller 's avatar
Björn Peemöller committed
116 117
  Just _  -> return sEnv
  Nothing -> do
Björn Peemöller 's avatar
Björn Peemöller committed
118
    mFile <- lookupCurryModule (optImportPaths opts) (optLibraryPaths opts) m
Björn Peemöller 's avatar
Björn Peemöller committed
119 120 121 122 123 124
    case mFile of
      Nothing -> return $ Map.insert m Unknown sEnv
      Just fn
        | icurryExt `isSuffixOf` fn -> return $ Map.insert m (Interface fn) sEnv
        | otherwise                 -> checkModuleHeader fn
  where
125 126 127
  checkModuleHeader fn = do
    hdr@(Module m' _ _ _) <- patchModuleId fn `liftM` (ok . parseHeader fn)
                              `liftM` readFile fn
128
    unless (m == m') $ abortWith [errWrongModule m m']
Björn Peemöller 's avatar
Björn Peemöller committed
129
    moduleDeps opts sEnv fn hdr
Björn Peemöller 's avatar
Björn Peemöller committed
130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151

-- 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)], [String])
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)], [String])
  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
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166

errWrongModule :: ModuleIdent -> ModuleIdent -> String
errWrongModule m m' =
  "Expected module for " ++ show m ++ " but found " ++ show m'

errCyclicImport :: [ModuleIdent] -> String
errCyclicImport []  = internalError "CurryDeps.errCyclicImport: empty list"
errCyclicImport [m] = "Recursive import for module " ++ moduleName m
errCyclicImport ms  = "Cylic import dependency between modules "
                      ++ intercalate ", " inits ++ " and " ++ lastm
  where
  (inits, lastm)         = splitLast $ map moduleName ms
  splitLast []           = internalError "CurryDeps.splitLast: empty list"
  splitLast (x : [])     = ([]  , x)
  splitLast (x : y : ys) = (x : xs, z) where (xs, z) = splitLast (y : ys)