Modules.hs 12.7 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
{- |
    Module      :  $Header$
    Description :  Compilation of a single module
    Copyright   :  (c) 1999-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 controls the compilation of modules.
-}

module Modules
  ( compileModule, loadModule, checkModuleHeader, checkModule
  ) where

21
import Control.Monad (unless, when)
22
23
24
25
26
27
28
29
30
import Data.Maybe (fromMaybe)

import Curry.Base.MessageMonad
import Curry.Base.Position
import Curry.Base.Ident
import Curry.ExtendedFlat.InterfaceEquality (eqInterface)
import Curry.Files.Filenames
import Curry.Files.PathUtils

31
import Base.Messages (abortWith, mposErr, putErrsLn)
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

import Env.Eval (evalEnv)

-- source representations
import qualified Curry.AbstractCurry as AC
import qualified Curry.ExtendedFlat.Type as EF
import qualified Curry.Syntax as CS
import qualified IL as IL

import Checks
import CompilerEnv
import CompilerOpts
import Exports
import Generators
import Imports
import Interfaces
import ModuleSummary
import Transformations

-- The function 'compileModule' is the main entry-point of this
-- module for compiling a Curry source module. Depending on the command
-- line options it will emit either C code or FlatCurry code (standard
-- or in XML
-- representation) or AbstractCurry code (typed, untyped or with type
-- signatures) for the module. Usually the first step is to
-- check the module. Then the code is translated into the intermediate
-- language. If necessary, this phase will also update the module's
-- interface file. The resulting code then is either written out (in
-- FlatCurry or XML format) or translated further into C code.
-- The untyped  AbstractCurry representation is written
-- out directly after parsing and simple checking the source file.
-- The typed AbstractCurry code is written out after checking the module.
64
--
65
66
67
-- The compiler automatically loads the prelude when compiling any
-- module, except for the prelude itself, by adding an appropriate import
-- declaration to the module.
68
--
69
70
71
72
73
74
75
-- Since this modified version of the Muenster Curry Compiler is used
-- as a frontend for PAKCS, all functions for evaluating goals and generating
-- C code are obsolete and commented out.

compileModule :: Options -> FilePath -> IO ()
compileModule opts fn = do
  loaded <- loadModule opts fn
76
  case uncurry (checkModule opts) loaded of
77
    CheckFailed errs -> abortWith $ map show errs
78
79
80
81
82
83
84
85
86
87
    CheckSuccess (env, modul) -> do
      showWarnings opts $ uncurry warnCheck loaded
      writeParsed        opts fn     modul
      writeAbstractCurry opts fn env modul
      when withFlat $ do
        -- checkModule checks types, and then transModule introduces new
        -- functions (by lambda lifting in 'desugar'). Consequence: The
        -- types of the newly introduced functions are not inferred (hsi)
        let (env2, il, dumps) = transModule opts env modul
        -- dump intermediate results
Björn Peemöller 's avatar
Björn Peemöller committed
88
        mapM_ (doDump opts) dumps
89
90
91
92
93
        -- generate target code
        let intf = exportInterface env2 modul
        let modSum = summarizeModule (tyConsEnv env2) intf modul
        writeFlat opts fn env2 modSum il
      where
94
95
      withFlat = any (`elem` optTargetTypes opts)
                 [FlatCurry, FlatXml, ExtendedFlatCurry]
96
97
98
99
100
101
102

-- ---------------------------------------------------------------------------
-- Loading a module
-- ---------------------------------------------------------------------------

loadModule :: Options -> FilePath -> IO (CompilerEnv, CS.Module)
loadModule opts fn = do
103
104
105
  -- read module
  mbSrc <- readModule fn
  case mbSrc of
106
    Nothing  -> abortWith ["missing file: " ++ fn] -- TODO
107
108
    Just src -> do
      -- parse module
109
      let parsed = ok $ CS.parseModule True fn src -- TODO
110
111
      -- check module header
      let (mdl, hdrErrs) = checkModuleHeader opts fn parsed
112
      unless (null hdrErrs) $ abortWith $ map show hdrErrs -- TODO
113
114
      -- load the imported interfaces into an InterfaceEnv
      (iEnv, intfErrs) <- loadInterfaces (optImportPaths opts) mdl
115
      unless (null intfErrs) $ abortWith $ map show intfErrs -- TODO
116
117
118
      -- add information of imported modules
      let env = importModules opts mdl iEnv
      return (env, mdl)
119

120
checkModuleHeader :: Options -> FilePath -> CS.Module -> (CS.Module, [Message])
121
122
checkModuleHeader opts fn = checkModuleId fn
                          . importPrelude opts
123
                          . CS.patchModuleId fn
124
125

-- |Check whether the 'ModuleIdent' and the 'FilePath' fit together
126
checkModuleId :: FilePath -> CS.Module -> (CS.Module, [Message])
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
checkModuleId fn m@(CS.Module mid _ _ _)
  | last (moduleQualifiers mid) == takeBaseName fn
  = (m, [])
  | otherwise
  = (m, [errModuleFileMismatch mid])

-- An implicit import of the prelude is added to the declarations of
-- every module, except for the prelude itself, or when the import is disabled
-- by a compiler option. If no explicit import for the prelude is present,
-- the prelude is imported unqualified, otherwise a qualified import is added.

importPrelude :: Options -> CS.Module -> CS.Module
importPrelude opts m@(CS.Module mid es is ds)
    -- the Prelude itself
  | mid == preludeMIdent          = m
    -- disabled by compiler option
  | noImpPrelude                  = m
    -- already imported
  | preludeMIdent `elem` imported = m
    -- let's add it!
  | otherwise                     = CS.Module mid es (preludeImp : is) ds
  where
149
150
151
152
153
154
  noImpPrelude = NoImplicitPrelude `elem` optExtensions opts
  preludeImp   = CS.ImportDecl NoPos preludeMIdent
                  False   -- qualified?
                  Nothing -- no alias
                  Nothing -- no selection of types, functions, etc.
  imported     = [imp | (CS.ImportDecl _ imp _ _ _) <- is]
155
156
157
158
159

-- ---------------------------------------------------------------------------
-- Checking a module
-- ---------------------------------------------------------------------------

160
-- TODO: The order of the checks should be improved!
161
162
163
-- TODO (2012-01-05, bjp): The export specification check for untyped
--   AbstractCurry is deactivated as it requires the value information
--   collected by the type checker.
164
165
166
167
168
checkModule :: Options -> CompilerEnv -> CS.Module
            -> CheckResult (CompilerEnv, CS.Module)
checkModule opts env mdl = kindCheck env mdl -- should be only syntax checking ?
                       >>= uncurry (syntaxCheck opts)
                       >>= uncurry precCheck
169
170
171
                       >>= (if withTypeCheck
                              then \x -> uncurry typeCheck x >>= uncurry exportCheck
                              else return)
172
                       >>= return . (uncurry (qual opts))
173
  where
174
175
  withTypeCheck  = any (`elem` optTargetTypes opts)
                       [FlatCurry, ExtendedFlatCurry, FlatXml, AbstractCurry]
176
177
178
179
180

-- ---------------------------------------------------------------------------
-- Translating a module
-- ---------------------------------------------------------------------------

181
182
type Dump = (DumpLevel, CompilerEnv, String)

183
184
-- |Translate FlatCurry into the intermediate language 'IL'
transModule :: Options -> CompilerEnv -> CS.Module
185
            -> (CompilerEnv, IL.Module, [Dump])
186
187
transModule opts env mdl = (env5, ilCaseComp, dumps)
  where
188
189
190
191
192
193
194
195
196
197
198
199
200
201
  flat' = FlatCurry `elem` optTargetTypes opts
  env0 = env { evalAnnotEnv = evalEnv mdl }
  (desugared , env1) = desugar        mdl        env0
  (simplified, env2) = simplify flat' desugared  env1
  (lifted    , env3) = lift           simplified env2
  (il        , env4) = ilTrans flat'  lifted     env3
  (ilCaseComp, env5) = completeCase   il         env4
  dumps = [ (DumpRenamed   , env , show $ CS.ppModule mdl       )
          , (DumpDesugared , env1, show $ CS.ppModule desugared )
          , (DumpSimplified, env2, show $ CS.ppModule simplified)
          , (DumpLifted    , env3, show $ CS.ppModule lifted    )
          , (DumpIL        , env4, show $ IL.ppModule il        )
          , (DumpCase      , env5, show $ IL.ppModule ilCaseComp)
          ]
202
203
204
205
206
207
208
209
210

-- ---------------------------------------------------------------------------
-- Writing output
-- ---------------------------------------------------------------------------

-- The functions \texttt{genFlat} and \texttt{genAbstract} generate
-- flat and abstract curry representations depending on the specified option.
-- If the interface of a modified Curry module did not change, the
-- corresponding file name will be returned within the result of 'genFlat'
211
-- (depending on the compiler flag "force") and other modules importing this
212
213
214
215
216
217
218
-- module won't be dependent on it any longer.

-- |Output the parsed 'Module' on request
writeParsed :: Options -> FilePath -> CS.Module -> IO ()
writeParsed opts fn modul = when srcTarget $
  writeModule useSubDir targetFile source
  where
219
220
221
222
  srcTarget  = Parsed `elem` optTargetTypes opts
  useSubDir  = optUseSubdir opts
  targetFile = fromMaybe (sourceRepName fn) (optOutput opts)
  source     = CS.showModule modul
223

224
writeFlat :: Options -> FilePath -> CompilerEnv -> ModuleSummary -> IL.Module
225
226
          -> IO ()
writeFlat opts fn env modSum il = do
227
228
229
230
231
232
233
234
  when (extTarget || fcyTarget) $ do
    writeFlatCurry opts fn env modSum il
    writeInterface opts fn env modSum il
  when (xmlTarget) $ writeXML opts fn modSum il
  where
  extTarget    = ExtendedFlatCurry `elem` optTargetTypes opts
  fcyTarget    = FlatCurry         `elem` optTargetTypes opts
  xmlTarget    = FlatXml           `elem` optTargetTypes opts
235
236
237
238
239

-- |Export an 'IL.Module' into a FlatCurry file
writeFlatCurry :: Options -> FilePath -> CompilerEnv -> ModuleSummary
               -> IL.Module -> IO ()
writeFlatCurry opts fn env modSum il = do
240
  showWarnings opts msgs
241
  when extTarget $ EF.writeExtendedFlat useSubDir (extFlatName fn) prog
242
  when fcyTarget $ EF.writeFlatCurry    useSubDir (flatName    fn) prog
243
  where
244
245
246
247
  extTarget    = ExtendedFlatCurry `elem` optTargetTypes opts
  fcyTarget    = FlatCurry         `elem` optTargetTypes opts
  useSubDir    = optUseSubdir opts
  (prog, msgs) = genFlatCurry opts modSum env il
248

249
250
251
252
253
254
255
-- |Export an 'IL.Module' into an XML file
writeXML :: Options -> FilePath -> ModuleSummary -> IL.Module -> IO ()
writeXML opts fn modSum il = writeModule useSubDir (xmlName fn) curryXml
  where
  useSubDir = optUseSubdir opts
  curryXml  = shows (IL.xmlModule (interface modSum) (infixDecls modSum) il) "\n"

256
257
258
259
260
261
262
263
264
265
266
writeInterface :: Options -> FilePath -> CompilerEnv -> ModuleSummary
               -> IL.Module -> IO ()
writeInterface opts fn env modSum il
  | not (optInterface opts) = return ()
  | optForce opts           = outputInterface
  | otherwise               = do
      mfint <- EF.readFlatInterface targetFile
      let oldInterface = fromMaybe emptyIntf mfint
      when (mfint == mfint) $ return () -- necessary to close file -- TODO
      unless (oldInterface `eqInterface` newInterface) $ outputInterface
  where
267
268
269
270
271
272
  targetFile = flatIntName fn
  emptyIntf = EF.Prog "" [] [] [] []
  (newInterface, intMsgs) = genFlatInterface opts modSum env il
  outputInterface = do
    showWarnings opts intMsgs
    EF.writeFlatCurry (optUseSubdir opts) targetFile newInterface
273
274
275
276
277
278
279
280

writeAbstractCurry :: Options -> FilePath -> CompilerEnv -> CS.Module -> IO ()
writeAbstractCurry opts fname env modul = do
  when  acyTarget $ AC.writeCurry useSubDir (acyName fname)
                  $ genTypedAbstractCurry env modul
  when uacyTarget $ AC.writeCurry useSubDir (uacyName fname)
                  $ genUntypedAbstractCurry env modul
  where
281
282
283
  acyTarget  = AbstractCurry        `elem` optTargetTypes opts
  uacyTarget = UntypedAbstractCurry `elem` optTargetTypes opts
  useSubDir  = optUseSubdir opts
284
285
286
287
288

showWarnings :: Options -> [Message] -> IO ()
showWarnings opts msgs = when (optWarn opts)
                       $ putErrsLn $ map showWarning msgs

289
-- |The 'dump' function writes the selected information to standard output.
Björn Peemöller 's avatar
Björn Peemöller committed
290
291
doDump :: Options -> Dump -> IO ()
doDump opts (level, env, dump) = when (level `elem` optDumps opts) $ do
292
293
  when (optDumpEnv opts) $ putStrLn $ showCompilerEnv env
  putStrLn $ unlines [header, replicate (length header) '=', dump]
294
295
296
297
298
299
300
301
302
303
  where header = dumpHeader level

dumpHeader :: DumpLevel -> String
dumpHeader DumpRenamed    = "Module after renaming"
dumpHeader DumpDesugared  = "Source code after desugaring"
dumpHeader DumpSimplified = "Source code after simplification"
dumpHeader DumpLifted     = "Source code after lifting"
dumpHeader DumpIL         = "Intermediate code"
dumpHeader DumpCase       = "Intermediate code after case completion"

304
305
errModuleFileMismatch :: ModuleIdent -> Message
errModuleFileMismatch mid = mposErr mid $ "module \"" ++ moduleName mid
306
  ++ "\" must be in a file \"" ++ moduleName mid ++ ".(l)curry\""