CurryDeps.hs 6.95 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1 2 3
{- |
    Module      :  $Header$
    Description :  Computation of module dependencies
Björn Peemöller 's avatar
Björn Peemöller committed
4 5 6
    Copyright   :  (c) 2002 - 2004 Wolfgang Lux
                       2005        Martin Engelke
                       2007        Sebastian Fischer
Björn Peemöller 's avatar
Björn Peemöller committed
7
                       2011 - 2013 Björn Peemöller
Björn Peemöller 's avatar
Björn Peemöller committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21
    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.
-}

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

Björn Peemöller 's avatar
Björn Peemöller committed
22 23
import           Control.Monad   (foldM)
import           Data.List       (isSuffixOf, nub)
Björn Peemöller 's avatar
Björn Peemöller committed
24 25 26
import qualified Data.Map as Map (Map, empty, insert, lookup, toList)

import Curry.Base.Ident
27
import Curry.Base.Monad
Björn Peemöller 's avatar
Björn Peemöller committed
28
import Curry.Base.Pretty
Björn Peemöller 's avatar
Björn Peemöller committed
29 30
import Curry.Files.Filenames
import Curry.Files.PathUtils
Björn Peemöller 's avatar
Björn Peemöller committed
31
import Curry.Syntax
32
  ( Module (..), ModulePragma (..), ImportDecl (..), parseHeader, patchModuleId
33
  , hasLanguageExtension)
Björn Peemöller 's avatar
Björn Peemöller committed
34

Björn Peemöller 's avatar
Björn Peemöller committed
35
import Base.Messages
Björn Peemöller 's avatar
Björn Peemöller committed
36
import Base.SCC (scc)
37
import CompilerOpts (Options (..), KnownExtension (..))
Björn Peemöller 's avatar
Björn Peemöller committed
38 39 40

-- |Different types of source files
data Source
41 42 43 44 45 46 47
    -- ^ A source file with pragmas and module imports
  = Source FilePath [ModulePragma] [ModuleIdent]
    -- ^ An interface file
  | Interface FilePath
    -- ^ An unkonwn file
  | Unknown
    deriving (Eq, Show)
Björn Peemöller 's avatar
Björn Peemöller committed
48 49 50 51 52

type SourceEnv = Map.Map ModuleIdent Source

-- |Retrieve the dependencies of a source file in topological order
-- and possible errors during flattering
Björn Peemöller 's avatar
Björn Peemöller committed
53 54 55 56
flatDeps :: Options -> FilePath -> CYIO [(ModuleIdent, Source)]
flatDeps opts fn = do
  sEnv <- deps opts Map.empty fn
  case flattenDeps sEnv of
57 58
    (env, []  ) -> ok env
    (_  , errs) -> failMessages errs
Björn Peemöller 's avatar
Björn Peemöller committed
59 60

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

-- |Retrieve the dependencies of a given source file
Björn Peemöller 's avatar
Björn Peemöller committed
92
sourceDeps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
Björn Peemöller 's avatar
Björn Peemöller committed
93
sourceDeps opts sEnv fn = readHeader fn >>= moduleDeps opts sEnv fn
Björn Peemöller 's avatar
Björn Peemöller committed
94 95

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

-- |Retrieve the imported modules and add the import of the Prelude
Björn Peemöller 's avatar
Björn Peemöller committed
105
-- according to the compiler options.
106 107 108 109 110 111
imports :: Options -> Module -> [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
Björn Peemöller 's avatar
Björn Peemöller committed
112 113

-- |Retrieve the dependencies for a given 'ModuleIdent'
Björn Peemöller 's avatar
Björn Peemöller committed
114
moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
Björn Peemöller 's avatar
Björn Peemöller committed
115
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 119
    mFile <- liftIO $ lookupCurryModule (optImportPaths opts)
                                        (optLibraryPaths opts) m
Björn Peemöller 's avatar
Björn Peemöller committed
120 121 122
    case mFile of
      Nothing -> return $ Map.insert m Unknown sEnv
      Just fn
Björn Peemöller 's avatar
Björn Peemöller committed
123 124 125
        | icurryExt `isSuffixOf` fn ->
            return $ Map.insert m (Interface fn) sEnv
        | otherwise                 -> do
126
            hdr@(Module _ m' _ _ _) <- readHeader fn
Björn Peemöller 's avatar
Björn Peemöller committed
127
            if (m == m') then moduleDeps opts sEnv fn hdr
128
                         else failMessages [errWrongModule m m']
Björn Peemöller 's avatar
Björn Peemöller committed
129

Björn Peemöller 's avatar
Björn Peemöller committed
130
readHeader :: FilePath -> CYIO Module
Björn Peemöller 's avatar
Björn Peemöller committed
131
readHeader fn = do
Björn Peemöller 's avatar
Björn Peemöller committed
132
  mbFile <- liftIO $ readModule fn
Björn Peemöller 's avatar
Björn Peemöller committed
133
  case mbFile of
134
    Nothing  -> failMessages [errMissingFile fn]
Björn Peemöller 's avatar
Björn Peemöller committed
135
    Just src -> do
136 137
      hdr <- liftCYM $ parseHeader fn src
      return $ patchModuleId fn hdr
Björn Peemöller 's avatar
Björn Peemöller committed
138 139

-- If we want to compile the program instead of generating Makefile
Björn Peemöller 's avatar
Björn Peemöller committed
140
-- dependencies, the environment has to be sorted topologically. Note
Björn Peemöller 's avatar
Björn Peemöller committed
141
-- that the dependency graph should not contain any cycles.
Björn Peemöller 's avatar
Björn Peemöller committed
142
flattenDeps :: SourceEnv -> ([(ModuleIdent, Source)], [Message])
Björn Peemöller 's avatar
Björn Peemöller committed
143 144 145 146 147 148 149
flattenDeps = fdeps . sortDeps
  where
  sortDeps :: SourceEnv -> [[(ModuleIdent, Source)]]
  sortDeps = scc idents imported . Map.toList

  idents (m, _) = [m]

150 151
  imported (_, Source _ _ ms) = ms
  imported (_,             _) = []
Björn Peemöller 's avatar
Björn Peemöller committed
152

Björn Peemöller 's avatar
Björn Peemöller committed
153
  fdeps :: [[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message])
Björn Peemöller 's avatar
Björn Peemöller committed
154 155 156 157 158 159
  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
160

Björn Peemöller 's avatar
Björn Peemöller committed
161 162 163 164 165 166 167
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') ]
168

Björn Peemöller 's avatar
Björn Peemöller committed
169
errCyclicImport :: [ModuleIdent] -> Message
170
errCyclicImport []  = internalError "CurryDeps.errCyclicImport: empty list"
Björn Peemöller 's avatar
Björn Peemöller committed
171 172 173 174 175
errCyclicImport [m] = message $ sep $ map text
  [ "Recursive import for module", moduleName m ]
errCyclicImport ms  = message $ sep $
  text "Cylic import dependency between modules" : punctuate comma inits
  ++ [text "and", lastm]
176
  where
Björn Peemöller 's avatar
Björn Peemöller committed
177 178 179 180
  (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