Interfaces.hs 5.71 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1 2 3
{- |
    Module      :  $Header$
    Description :  Loading interfaces
Björn Peemöller 's avatar
Björn Peemöller committed
4
    Copyright   :  (c) 2000 - 2004, Wolfgang Lux
5
                       2011 - 2013, Björn Peemöller
Björn Peemöller 's avatar
Björn Peemöller committed
6 7 8 9 10 11 12 13 14 15 16 17 18 19
    License     :  OtherLicense

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    The compiler maintains a global environment holding all (directly or
    indirectly) imported interface declarations for a module.

    This module contains a function to load *all* interface declarations
    declared by the (directly or indirectly) imported modules, regardless
    whether they are included by the import specification or not.

    The declarations are later brought into the scope of the module via the
20
    function 'importModules', see module "Imports".
Björn Peemöller 's avatar
Björn Peemöller committed
21

22 23
    Interface files are updated by the Curry builder when necessary,
    see module "CurryBuilder".
Björn Peemöller 's avatar
Björn Peemöller committed
24 25 26
-}
module Interfaces (loadInterfaces) where

27 28 29
import           Control.Monad               (unless)
import qualified Control.Monad.State    as S (StateT, execStateT, gets, modify)
import qualified Data.Map               as M (insert, member)
Björn Peemöller 's avatar
Björn Peemöller committed
30

Björn Peemöller 's avatar
Björn Peemöller committed
31
import           Curry.Base.Ident
32
import           Curry.Base.Monad
Björn Peemöller 's avatar
Björn Peemöller committed
33
import           Curry.Base.Position
Björn Peemöller 's avatar
Björn Peemöller committed
34
import           Curry.Base.Pretty
35
import           Curry.Files.PathUtils
Björn Peemöller 's avatar
Björn Peemöller committed
36
import           Curry.Syntax
Björn Peemöller 's avatar
Björn Peemöller committed
37

Björn Peemöller 's avatar
Björn Peemöller committed
38
import Base.Messages
Björn Peemöller 's avatar
Björn Peemöller committed
39 40
import Env.Interface

41 42
import Checks.InterfaceSyntaxCheck (intfSyntaxCheck)

43 44
-- Interface accumulating monad
type IntfLoader a = S.StateT LoaderState IO a
45

46 47 48 49 50
data LoaderState = LoaderState
  { iEnv   :: InterfaceEnv
  , spaths :: [FilePath]
  , errs   :: [Message]
  }
51

52
-- Report an error.
53 54
report :: [Message] -> IntfLoader ()
report msg = S.modify $ \ s -> s { errs = msg ++ errs s }
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69

-- Check whether a module interface is already loaded.
loaded :: ModuleIdent -> IntfLoader Bool
loaded m = S.gets $ \ s -> m `M.member` iEnv s

-- Retrieve the search paths
searchPaths :: IntfLoader [FilePath]
searchPaths = S.gets spaths

-- Add an interface to the environment.
addInterface :: ModuleIdent -> Interface -> IntfLoader ()
addInterface m intf = S.modify $ \ s -> s { iEnv = M.insert m intf $ iEnv s }

-- |Load the interfaces needed by a given module.
-- This function returns an 'InterfaceEnv' containing the 'Interface's which
70
-- were successfully loaded.
71 72
loadInterfaces :: [FilePath] -- ^ 'FilePath's to search in for interfaces
               -> Module     -- ^ 'Module' header with import declarations
73
               -> CYIO InterfaceEnv
74
loadInterfaces paths (Module _ m _ is _) = do
75
  res <- liftIO $ S.execStateT load (LoaderState initInterfaceEnv paths [])
76
  if null (errs res) then ok (iEnv res) else failMessages (reverse $ errs res)
77
  where load = mapM_ (loadInterface [m]) [(p, m') | ImportDecl p m' _ _ _ <- is]
Björn Peemöller 's avatar
Björn Peemöller committed
78

79
-- |Load an interface into the given environment.
80
--
Björn Peemöller 's avatar
Björn Peemöller committed
81
-- If an import declaration for a module is found, the compiler first
82 83 84 85 86 87 88 89
-- checks whether an import for the module is already pending.
-- In this case the module imports are cyclic which is not allowed in Curry.
-- Therefore, the import will be skipped and an error will be issued.
-- Otherwise, the compiler checks whether the module has already been imported.
-- If so, nothing needs to be done, otherwise the interface will be searched
-- for in the import paths and compiled.
loadInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> IntfLoader ()
loadInterface ctxt imp@(p, m)
90
  | m `elem` ctxt = report [errCyclicImport p (m : takeWhile (/= m) ctxt)]
91 92 93 94 95
  | otherwise     = do
    isLoaded <- loaded m
    unless isLoaded $ do
      paths  <- searchPaths
      mbIntf <- liftIO $ lookupCurryInterface paths m
96
      case mbIntf of
97
        Nothing -> report [errInterfaceNotFound p m]
98
        Just fn -> compileInterface ctxt imp fn
Björn Peemöller 's avatar
Björn Peemöller committed
99

100
-- |Compile an interface by recursively loading its dependencies.
101
--
Björn Peemöller 's avatar
Björn Peemöller committed
102
-- After reading an interface, all imported interfaces are recursively
103 104 105 106 107 108
-- loaded and inserted into the interface's environment.
compileInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> FilePath
                 -> IntfLoader ()
compileInterface ctxt (p, m) fn = do
  mbSrc <- liftIO $ readModule fn
  case mbSrc of
109 110
    Nothing  -> report [errInterfaceNotFound p m]
    Just src -> case runCYM (parseInterface fn src) of
111
      Left err -> report err
112
      Right intf@(Interface n is _) ->
113
        if (m /= n)
114
          then report [errWrongInterface (first fn) m n]
115
          else do
116
            let (intf', intfErrs) = intfSyntaxCheck intf
117
            mapM_ report [intfErrs]
118
            mapM_ (loadInterface (m : ctxt)) [ (q, i) | IImportDecl q i <- is ]
119
            addInterface m intf'
120 121

-- Error message for required interface that could not be found.
122
errInterfaceNotFound :: Position -> ModuleIdent -> Message
123 124
errInterfaceNotFound p m = posMessage p $
  text "Interface for module" <+> text (moduleName m) <+> text "not found"
125

126
-- Error message for an unexpected interface.
127
errWrongInterface :: Position -> ModuleIdent -> ModuleIdent -> Message
128
errWrongInterface p m n = posMessage p $
129
  text "Expected interface for" <+> text (moduleName m)
130
  <> comma <+> text "but found" <+> text (moduleName n)
131

132
-- Error message for a cyclic import.
133 134
errCyclicImport :: Position -> [ModuleIdent] -> Message
errCyclicImport _ []  = internalError "Interfaces.errCyclicImport: empty list"
135 136 137 138
errCyclicImport p [m] = posMessage p $
  text "Recursive import for module" <+> text (moduleName m)
errCyclicImport p ms  = posMessage p $
  text "Cylic import dependency between modules"
139
  <+> hsep (punctuate comma (map text inits)) <+> text "and" <+> text lastm
140 141 142 143 144
  where
  (inits, lastm)         = splitLast $ map moduleName ms
  splitLast []           = internalError "Interfaces.splitLast: empty list"
  splitLast (x : [])     = ([]  , x)
  splitLast (x : y : ys) = (x : xs, z) where (xs, z) = splitLast (y : ys)