Interfaces.hs 5.8 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
6
    License     :  BSD-3-clause
Björn Peemöller 's avatar
Björn Peemöller committed
7
8
9
10
11
12
13
14
15
16
17
18
19

    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
-}
Finn Teegen's avatar
Finn Teegen committed
25
{-# LANGUAGE CPP #-}
Björn Peemöller 's avatar
Björn Peemöller committed
26
27
module Interfaces (loadInterfaces) where

Finn Teegen's avatar
Finn Teegen committed
28
29
30
31
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif

32
33
34
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
35

Björn Peemöller 's avatar
Björn Peemöller committed
36
import           Curry.Base.Ident
37
import           Curry.Base.Monad
Björn Peemöller 's avatar
Björn Peemöller committed
38
import           Curry.Base.Position
Björn Peemöller 's avatar
Björn Peemöller committed
39
import           Curry.Base.Pretty
40
import           Curry.Files.PathUtils
Björn Peemöller 's avatar
Björn Peemöller committed
41
import           Curry.Syntax
Björn Peemöller 's avatar
Björn Peemöller committed
42

Björn Peemöller 's avatar
Björn Peemöller committed
43
import Base.Messages
Björn Peemöller 's avatar
Björn Peemöller committed
44
45
import Env.Interface

46
47
import Checks.InterfaceSyntaxCheck (intfSyntaxCheck)

48
49
-- Interface accumulating monad
type IntfLoader a = S.StateT LoaderState IO a
50

51
52
53
54
55
data LoaderState = LoaderState
  { iEnv   :: InterfaceEnv
  , spaths :: [FilePath]
  , errs   :: [Message]
  }
56

57
-- Report an error.
58
59
report :: [Message] -> IntfLoader ()
report msg = S.modify $ \ s -> s { errs = msg ++ errs s }
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

-- 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
75
-- were successfully loaded.
76
loadInterfaces :: [FilePath] -- ^ 'FilePath's to search in for interfaces
77
               -> Module a   -- ^ 'Module' header with import declarations
78
               -> CYIO InterfaceEnv
79
loadInterfaces paths (Module _ m _ is _) = do
80
  res <- liftIO $ S.execStateT load (LoaderState initInterfaceEnv paths [])
81
  if null (errs res) then ok (iEnv res) else failMessages (reverse $ errs res)
82
  where load = mapM_ (loadInterface [m]) [(p, m') | ImportDecl p m' _ _ _ <- is]
Björn Peemöller 's avatar
Björn Peemöller committed
83

84
-- |Load an interface into the given environment.
85
--
Björn Peemöller 's avatar
Björn Peemöller committed
86
-- If an import declaration for a module is found, the compiler first
87
88
89
90
91
92
93
94
-- 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)
95
  | m `elem` ctxt = report [errCyclicImport p (m : takeWhile (/= m) ctxt)]
96
97
98
99
100
  | otherwise     = do
    isLoaded <- loaded m
    unless isLoaded $ do
      paths  <- searchPaths
      mbIntf <- liftIO $ lookupCurryInterface paths m
101
      case mbIntf of
102
        Nothing -> report [errInterfaceNotFound p m]
103
        Just fn -> compileInterface ctxt imp fn
Björn Peemöller 's avatar
Björn Peemöller committed
104

105
-- |Compile an interface by recursively loading its dependencies.
106
--
Björn Peemöller 's avatar
Björn Peemöller committed
107
-- After reading an interface, all imported interfaces are recursively
108
109
110
111
112
113
-- 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
114
    Nothing  -> report [errInterfaceNotFound p m]
115
    Just src -> case runCYMIgnWarn (parseInterface fn src) of
116
      Left err -> report err
117
      Right intf@(Interface n is _) ->
Björn Peemöller 's avatar
Björn Peemöller committed
118
        if m /= n
119
          then report [errWrongInterface (first fn) m n]
120
          else do
121
            let (intf', intfErrs) = intfSyntaxCheck intf
122
            mapM_ report [intfErrs]
123
            mapM_ (loadInterface (m : ctxt)) [ (q, i) | IImportDecl q i <- is ]
124
            addInterface m intf'
125
126

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

131
-- Error message for an unexpected interface.
132
errWrongInterface :: Position -> ModuleIdent -> ModuleIdent -> Message
133
errWrongInterface p m n = posMessage p $
134
  text "Expected interface for" <+> text (moduleName m)
135
  <> comma <+> text "but found" <+> text (moduleName n)
136

137
-- Error message for a cyclic import.
138
139
errCyclicImport :: Position -> [ModuleIdent] -> Message
errCyclicImport _ []  = internalError "Interfaces.errCyclicImport: empty list"
140
141
142
errCyclicImport p [m] = posMessage p $
  text "Recursive import for module" <+> text (moduleName m)
errCyclicImport p ms  = posMessage p $
143
  text "Cyclic import dependency between modules"
144
  <+> hsep (punctuate comma (map text inits)) <+> text "and" <+> text lastm
145
146
147
148
149
  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)