Modules.hs 12.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
{- |
    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
18
  ( compileModule, loadModule, checkModuleHeader, checkModule, writeOutput
19 20
  ) 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 checkModule opts loaded of
77
    CheckFailed errs -> abortWith $ map show errs
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
    CheckSuccess res -> do
      showWarnings opts $ uncurry warnCheck res
      writeOutput opts fn res

writeOutput :: Options -> FilePath -> (CompilerEnv, CS.Module) -> IO ()
writeOutput opts fn (env, modul) = do
  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 intf = exportInterface env2 modul
    let modSum = summarizeModule (tyConsEnv env2) intf modul
    writeFlat opts fn env2 modSum il
  where
  withFlat = any (`elem` optTargetTypes opts)
              [FlatCurry, FlatXml, ExtendedFlatCurry]
100 101 102 103 104 105 106

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

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

124
checkModuleHeader :: Options -> FilePath -> CS.Module -> (CS.Module, [Message])
125
checkModuleHeader opts fn = checkModuleId fn
126
                          . importPrelude opts fn
127
                          . CS.patchModuleId fn
128 129

-- |Check whether the 'ModuleIdent' and the 'FilePath' fit together
130
checkModuleId :: FilePath -> CS.Module -> (CS.Module, [Message])
131
checkModuleId fn m@(CS.Module mid _ _ _)
132
  | last (midQualifiers mid) == takeBaseName fn
133 134 135 136 137 138 139 140 141
  = (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.

142 143
importPrelude :: Options -> FilePath -> CS.Module -> CS.Module
importPrelude opts fn m@(CS.Module mid es is ds)
144 145 146 147 148 149 150 151 152
    -- 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
153
  noImpPrelude = NoImplicitPrelude `elem` optExtensions opts
154
  preludeImp   = CS.ImportDecl (first fn) preludeMIdent
155 156 157 158
                  False   -- qualified?
                  Nothing -- no alias
                  Nothing -- no selection of types, functions, etc.
  imported     = [imp | (CS.ImportDecl _ imp _ _ _) <- is]
159 160 161 162 163

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

164
-- TODO: The order of the checks should be improved!
165 166 167
-- 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.
168
checkModule :: Options -> (CompilerEnv, CS.Module)
169
            -> CheckResult (CompilerEnv, CS.Module)
170 171 172 173 174 175 176 177
checkModule opts (env, mdl)
  =   kindCheck env mdl -- should be only syntax checking ?
  >>= uncurry (syntaxCheck opts)
  >>= uncurry precCheck
  >>= (if withTypeCheck
        then \x -> uncurry typeCheck x >>= uncurry exportCheck
        else return)
  >>= return . (uncurry (qual opts))
178
  where
179 180
  withTypeCheck = any (`elem` optTargetTypes opts)
                      [FlatCurry, ExtendedFlatCurry, FlatXml, AbstractCurry]
181 182 183 184 185

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

186 187
type Dump = (DumpLevel, CompilerEnv, String)

188 189
-- |Translate FlatCurry into the intermediate language 'IL'
transModule :: Options -> CompilerEnv -> CS.Module
190
            -> (CompilerEnv, IL.Module, [Dump])
191 192
transModule opts env mdl = (env5, ilCaseComp, dumps)
  where
193 194 195 196 197 198 199 200 201 202 203 204 205 206
  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)
          ]
207 208 209 210 211 212 213 214 215

-- ---------------------------------------------------------------------------
-- 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'
216
-- (depending on the compiler flag "force") and other modules importing this
217 218 219 220 221 222 223
-- 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
224 225 226 227
  srcTarget  = Parsed `elem` optTargetTypes opts
  useSubDir  = optUseSubdir opts
  targetFile = fromMaybe (sourceRepName fn) (optOutput opts)
  source     = CS.showModule modul
228

229
writeFlat :: Options -> FilePath -> CompilerEnv -> ModuleSummary -> IL.Module
230 231
          -> IO ()
writeFlat opts fn env modSum il = do
232 233 234 235 236 237 238 239
  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
240 241 242 243 244

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

254 255 256 257 258 259 260
-- |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"

261 262 263 264 265 266 267 268 269 270 271
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
272 273 274 275 276 277
  targetFile = flatIntName fn
  emptyIntf = EF.Prog "" [] [] [] []
  (newInterface, intMsgs) = genFlatInterface opts modSum env il
  outputInterface = do
    showWarnings opts intMsgs
    EF.writeFlatCurry (optUseSubdir opts) targetFile newInterface
278 279 280 281 282 283 284 285

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
286 287 288
  acyTarget  = AbstractCurry        `elem` optTargetTypes opts
  uacyTarget = UntypedAbstractCurry `elem` optTargetTypes opts
  useSubDir  = optUseSubdir opts
289 290 291 292 293

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

294
-- |The 'dump' function writes the selected information to standard output.
Björn Peemöller 's avatar
Björn Peemöller committed
295 296
doDump :: Options -> Dump -> IO ()
doDump opts (level, env, dump) = when (level `elem` optDumps opts) $ do
297 298
  when (optDumpEnv opts) $ putStrLn $ showCompilerEnv env
  putStrLn $ unlines [header, replicate (length header) '=', dump]
299 300 301 302 303 304 305 306 307 308
  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"

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