Modules.lhs 13.1 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
> {- |
>     Module      :  $Header$
>     Description :  Cumputation of export interface
>     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 provides the computation of the exported interface of a
>     compiled module.
> -}

Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
18
19
20
21
22
23
\nwfilename{Modules.lhs}
\section{Modules}
This module controls the compilation of modules.
\begin{verbatim}

> module Modules
Björn Peemöller 's avatar
Björn Peemöller committed
24
>   ( compileModule, loadModule, checkModuleHeader, checkModule
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
25
26
>   ) where

Björn Peemöller 's avatar
Björn Peemöller committed
27
> import Control.Monad (liftM, unless, when)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
28
> import Data.Maybe (fromMaybe)
29
> import Text.PrettyPrint (Doc)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
30
31
32
33

> import Curry.Base.MessageMonad
> import Curry.Base.Position
> import Curry.Base.Ident
Björn Peemöller 's avatar
Björn Peemöller committed
34
> import Curry.ExtendedFlat.InterfaceEquality (eqInterface)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
35
36
37
> import Curry.Files.Filenames
> import Curry.Files.PathUtils

Björn Peemöller 's avatar
Björn Peemöller committed
38
39
> import Base.ErrorMessages (errModuleFileMismatch)
> import Base.Messages (abortWith, putErrsLn)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
40

Björn Peemöller 's avatar
Björn Peemöller committed
41
> import Env.Eval (evalEnv)
42
43
44
45
46
47
48
> import Env.Value (ppTypes)

> -- 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
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
49

Björn Peemöller 's avatar
Björn Peemöller committed
50
51
52
> import Checks
> import CompilerEnv
> import CompilerOpts
53
54
55
56
> import Exports
> import Generators
> import Imports
> import Interfaces
Björn Peemöller 's avatar
Björn Peemöller committed
57
58
> import ModuleSummary
> import Transformations
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

\end{verbatim}
The function \texttt{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.

The compiler automatically loads the prelude when compiling any
module, except for the prelude itself, by adding an appropriate import
declaration to the module.

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.
\begin{verbatim}

84
> compileModule :: Options -> FilePath -> IO ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
85
> compileModule opts fn = do
Björn Peemöller 's avatar
Björn Peemöller committed
86
87
88
89
90
91
92
93
94
95
96
97
98
99
>   (env, modul, intf, warnings) <- uncurry (checkModule opts) `liftM` loadModule opts fn
>   showWarnings opts $ warnings
>   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
>     mapM_ (doDump opts) dumps
>     -- generate target code
>     let modSum = summarizeModule (tyConsEnv env2) intf modul
>     writeFlat opts fn env2 modSum il
Björn Peemöller 's avatar
Björn Peemöller committed
100
>   where
Björn Peemöller 's avatar
Björn Peemöller committed
101
102
>     withFlat = any (`elem` optTargetTypes opts)
>                    [FlatCurry, FlatXml, ExtendedFlatCurry]
103

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
-- ---------------------------------------------------------------------------
-- Loading a module
-- ---------------------------------------------------------------------------

> loadModule :: Options -> FilePath -> IO (CompilerEnv, CS.Module)
> loadModule opts fn = do
>   -- read and parse module
>   parsed <- (ok . CS.parseModule (not extTarget) fn) `liftM` readModule fn
>   -- check module header
>   let (mdl, hdrErrs) = checkModuleHeader opts fn parsed
>   unless (null hdrErrs) $ abortWith hdrErrs
>   -- load the imported interfaces into an InterfaceEnv
>   iEnv <- loadInterfaces (optImportPaths opts) mdl
>   -- add information of imported modules
>   let env = importModules opts mdl iEnv
>   return (env, mdl)
>   where extTarget = ExtendedFlatCurry `elem` optTargetTypes opts

> checkModuleHeader :: Options -> FilePath -> CS.Module -> (CS.Module, [String])
Björn Peemöller 's avatar
Björn Peemöller committed
123
124
125
126
127
> checkModuleHeader opts fn = checkModuleId fn
>                           . importPrelude opts
>                           . patchModuleId fn

> -- |Check whether the 'ModuleIdent' and the 'FilePath' fit together
128
129
> checkModuleId :: FilePath -> CS.Module -> (CS.Module, [String])
> checkModuleId fn m@(CS.Module mid _ _ _)
Björn Peemöller 's avatar
Björn Peemöller committed
130
131
132
>   | last (moduleQualifiers mid) == takeBaseName fn
>   = (m, [])
>   | otherwise
Björn Peemöller 's avatar
Björn Peemöller committed
133
>   = (m, [errModuleFileMismatch mid])
Björn Peemöller 's avatar
Björn Peemöller committed
134

135
136
137
138
139
140
141
\end{verbatim}
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.
\begin{verbatim}

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

Björn Peemöller 's avatar
Björn Peemöller committed
160
161
162
163
164
165
\end{verbatim}
A module which doesn't contain a \texttt{module ... where} declaration
obtains its filename as module identifier (unlike the definition in
Haskell and original MCC where a module obtains \texttt{main}).
\begin{verbatim}

166
167
> patchModuleId :: FilePath -> CS.Module -> CS.Module
> patchModuleId fn m@(CS.Module mid es is ds)
168
>   | mid == mainMIdent
169
>     = CS.Module (mkMIdent [takeBaseName fn]) es is ds
Björn Peemöller 's avatar
Björn Peemöller committed
170
171
>   | otherwise
>     = m
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
172

173
174
175
176
177
178
-- ---------------------------------------------------------------------------
-- Checking a module
-- ---------------------------------------------------------------------------

> checkModule :: Options -> CompilerEnv -> CS.Module
>             -> (CompilerEnv, CS.Module, CS.Interface, [Message])
Björn Peemöller 's avatar
Björn Peemöller committed
179
> checkModule opts env mdl = (env', mdl', intf, warnings)
Björn Peemöller 's avatar
Björn Peemöller committed
180
>   where
Björn Peemöller 's avatar
Björn Peemöller committed
181
182
183
184
>     warnings = warnCheck env mdl
>     intf = exportInterface env' mdl'
>     (env', mdl') = qualifyE $ expand $ uncurry qual
>                  $ (if withFlat then uncurry typeCheck else id)
185
186
187
>                  $ uncurry precCheck
>                  $ uncurry (syntaxCheck opts)
>                  $ uncurry kindCheck
Björn Peemöller 's avatar
Björn Peemöller committed
188
189
190
191
192
>                    (env, mdl)
>     expand   (e, m) = if withFlat then (e, expandInterface e m) else (e, m)
>     qualifyE (e, m) = (qualifyEnv opts e, m)
>     withFlat = any (`elem` optTargetTypes opts)
>                [FlatCurry, FlatXml, ExtendedFlatCurry]
193
194
195
196

-- ---------------------------------------------------------------------------
-- Translating a module
-- ---------------------------------------------------------------------------
Björn Peemöller 's avatar
Björn Peemöller committed
197

Björn Peemöller 's avatar
Björn Peemöller committed
198
> -- |Translate FlatCurry into the intermediate language 'IL'
199
> transModule :: Options -> CompilerEnv -> CS.Module
Björn Peemöller 's avatar
Björn Peemöller committed
200
>             -> (CompilerEnv, IL.Module, [(DumpLevel, Doc)])
201
> transModule opts env mdl = (env5, ilCaseComp, dumps)
Björn Peemöller 's avatar
Björn Peemöller committed
202
>   where
203
204
205
206
207
208
209
210
211
212
213
214
>     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   , CS.ppModule    mdl         )
>             , (DumpTypes     , ppTypes     (moduleIdent env) (valueEnv env))
>             , (DumpDesugared , CS.ppModule    desugared   )
>             , (DumpSimplified, CS.ppModule    simplified  )
>             , (DumpLifted    , CS.ppModule    lifted    )
Björn Peemöller 's avatar
Björn Peemöller committed
215
216
>             , (DumpIL        , IL.ppModule il        )
>             , (DumpCase      , IL.ppModule ilCaseComp)
Björn Peemöller 's avatar
Björn Peemöller committed
217
>             ]
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
218

219
220
221
222
-- ---------------------------------------------------------------------------
-- Writing output
-- ---------------------------------------------------------------------------

Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
223
\end{verbatim}
Björn Peemöller 's avatar
Björn Peemöller committed
224
225
226
227
228
229
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 \texttt{genFlat} (depending
on the compiler flag "force") and other modules importing this module won't
be dependent on it any longer.
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
230
231
\begin{verbatim}

Björn Peemöller 's avatar
Björn Peemöller committed
232
233
234
235
> -- |Output the parsed 'Module' on request
> writeParsed :: Options -> FilePath -> CS.Module -> IO ()
> writeParsed opts fn modul = when srcTarget $
>   writeModule useSubDir targetFile source
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
236
>   where
Björn Peemöller 's avatar
Björn Peemöller committed
237
238
239
240
>     srcTarget  = Parsed `elem` optTargetTypes opts
>     useSubDir  = optUseSubdir opts
>     targetFile = fromMaybe (sourceRepName fn) (optOutput opts)
>     source     = CS.showModule modul
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
241

Björn Peemöller 's avatar
Björn Peemöller committed
242
> writeFlat :: Options -> FilePath -> CompilerEnv -> ModuleSummary -> IL.Module -> IO ()
Björn Peemöller 's avatar
Björn Peemöller committed
243
244
245
246
> writeFlat opts fn env modSum il = do
>   writeFlatCurry opts fn env modSum il
>   writeInterface opts fn env modSum il
>   writeXML       opts fn     modSum il
Björn Peemöller 's avatar
Björn Peemöller committed
247

Björn Peemöller 's avatar
Björn Peemöller committed
248
> -- |Export an 'IL.Module' into a FlatCurry file
Björn Peemöller 's avatar
Björn Peemöller committed
249
250
> writeFlatCurry :: Options -> FilePath -> CompilerEnv -> ModuleSummary
>                -> IL.Module -> IO ()
Björn Peemöller 's avatar
Björn Peemöller committed
251
252
> writeFlatCurry opts fn env modSum il = do
>   when (extTarget || fcyTarget) $ showWarnings opts msgs
Björn Peemöller 's avatar
Björn Peemöller committed
253
254
>   when extTarget $ EF.writeExtendedFlat useSubDir (extFlatName fn) prog
>   when fcyTarget $ EF.writeFlatCurry    useSubDir (flatName fn)    prog
Björn Peemöller 's avatar
Björn Peemöller committed
255
>   where
Björn Peemöller 's avatar
Björn Peemöller committed
256
257
258
>     extTarget    = ExtendedFlatCurry `elem` optTargetTypes opts
>     fcyTarget    = FlatCurry         `elem` optTargetTypes opts
>     useSubDir    = optUseSubdir opts
259
>     (prog, msgs) = genFlatCurry opts modSum env il
Björn Peemöller 's avatar
Björn Peemöller committed
260

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

Björn Peemöller 's avatar
Björn Peemöller committed
279
280
281
282
283
284
285
286
287
288
> -- |Export an 'IL.Module' into an XML file
> writeXML :: Options -> FilePath -> ModuleSummary -> IL.Module -> IO ()
> writeXML opts fn modSum il = when xmlTarget $
>   writeModule useSubDir targetFile curryXml
>   where
>     xmlTarget  = FlatXml `elem` optTargetTypes opts
>     useSubDir  = optUseSubdir opts
>     targetFile = fromMaybe (xmlName fn) (optOutput opts)
>     curryXml   = shows (IL.xmlModule modSum il) "\n"

289
> writeAbstractCurry :: Options -> FilePath -> CompilerEnv -> CS.Module -> IO ()
Björn Peemöller 's avatar
Björn Peemöller committed
290
> writeAbstractCurry opts fname env modul = do
Björn Peemöller 's avatar
Björn Peemöller committed
291
>   when  acyTarget $ AC.writeCurry useSubDir (acyName fname)
292
>                   $ genTypedAbstractCurry env modul
Björn Peemöller 's avatar
Björn Peemöller committed
293
>   when uacyTarget $ AC.writeCurry useSubDir (uacyName fname)
294
>                   $ genUntypedAbstractCurry env modul
Björn Peemöller 's avatar
Björn Peemöller committed
295
296
297
298
>   where
>     acyTarget  = AbstractCurry        `elem` optTargetTypes opts
>     uacyTarget = UntypedAbstractCurry `elem` optTargetTypes opts
>     useSubDir  = optUseSubdir opts
Björn Peemöller 's avatar
Björn Peemöller committed
299

Björn Peemöller 's avatar
Björn Peemöller committed
300
301
302
303
> showWarnings :: Options -> [Message] -> IO ()
> showWarnings opts msgs = when (optWarn opts)
>                        $ putErrsLn $ map showWarning msgs

Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
304
305
306
307
308
\end{verbatim}
The \texttt{doDump} function writes the selected information to the
standard output.
\begin{verbatim}

309
> doDump :: Options -> (DumpLevel, Doc) -> IO ()
310
311
312
> doDump opts (level, dump) = when (level `elem` optDumps opts) $ putStrLn $
>   unlines [header, replicate (length header) '=', show dump]
>   where header = dumpHeader level
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
313

314
315
316
317
> dumpHeader :: DumpLevel -> String
> dumpHeader DumpRenamed    = "Module after renaming"
> dumpHeader DumpTypes      = "Types"
> dumpHeader DumpDesugared  = "Source code after desugaring"
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
318
> dumpHeader DumpSimplified = "Source code after simplification"
319
320
> dumpHeader DumpLifted     = "Source code after lifting"
> dumpHeader DumpIL         = "Intermediate code"
Björn Peemöller 's avatar
Björn Peemöller committed
321
> dumpHeader DumpCase       = "Intermediate code after case completion"
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
322
323

\end{verbatim}