GHC.hs 60.9 KB
Newer Older
1
2
3
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.GHC
Simon Marlow's avatar
Simon Marlow committed
4
-- Copyright   :  Isaac Jones 2003-2007
5
--
Duncan Coutts's avatar
Duncan Coutts committed
6
-- Maintainer  :  cabal-devel@haskell.org
7
8
-- Portability :  portable
--
Duncan Coutts's avatar
Duncan Coutts committed
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
-- This is a fairly large module. It contains most of the GHC-specific code for
-- configuring, building and installing packages. It also exports a function
-- for finding out what packages are already installed. Configuring involves
-- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
-- this version of ghc supports and returning a 'Compiler' value.
--
-- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
-- what packages are installed.
--
-- Building is somewhat complex as there is quite a bit of information to take
-- into account. We have to build libs and programs, possibly for profiling and
-- shared libs. We have to support building libraries that will be usable by
-- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
-- using ghc. Linking, especially for @split-objs@ is remarkably complex,
-- partly because there tend to be 1,000's of @.o@ files and this can often be
-- more than we can pass to the @ld@ or @ar@ programs in one go.
--
-- Installing for libs and exes involves finding the right files and copying
-- them to the right places. One of the more tricky things about this module is
-- remembering the layout of files in the build directory (which is not
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.
31
32
33
34
35

{- Copyright (c) 2003-2005, Isaac Jones
All rights reserved.

Redistribution and use in source and binary forms, with or without
36
modiication, are permitted provided that the following conditions are
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
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

module Distribution.Simple.GHC (
64
        getGhcInfo,
65
        configure, getInstalledPackages, getPackageDBContents,
66
        buildLib, buildExe,
67
        replLib, replExe,
68
        installLib, installExe,
69
        libAbiHash,
70
        initPackageDB,
refold's avatar
refold committed
71
        invokeHcPkg,
72
        registerPackage,
73
        componentGhcOptions,
74
        ghcLibDir,
75
        ghcDynamic,
76
77
 ) where

78
79
import qualified Distribution.Simple.GHC.IPI641 as IPI641
import qualified Distribution.Simple.GHC.IPI642 as IPI642
80
import Distribution.PackageDescription as PD
81
         ( PackageDescription(..), BuildInfo(..), Executable(..)
refold's avatar
refold committed
82
83
         , Library(..), libModules, exeModules, hcOptions
         , usedExtensions, allExtensions )
84
import Distribution.InstalledPackageInfo
85
         ( InstalledPackageInfo )
86
87
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
                                ( InstalledPackageInfo_(..) )
88
import Distribution.Simple.PackageIndex (PackageIndex)
89
import qualified Distribution.Simple.PackageIndex as PackageIndex
90
import Distribution.Simple.LocalBuildInfo
91
         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
92
         , LibraryName(..), absoluteInstallDirs )
93
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
94
import Distribution.Simple.BuildPaths
95
import Distribution.Simple.Utils
96
import Distribution.Package
refold's avatar
refold committed
97
         ( Package(..), PackageName(..) )
98
import qualified Distribution.ModuleName as ModuleName
99
import Distribution.Simple.Program
100
         ( Program(..), ConfiguredProgram(..), ProgramConfiguration
101
         , ProgramLocation(..), ProgramSearchPath, ProgramSearchPathEntry(..)
102
         , rawSystemProgram
103
         , rawSystemProgramStdout, rawSystemProgramStdoutConf
104
105
         , getProgramOutput, getProgramInvocationOutput, suppressOverrideArgs
         , requireProgramVersion, requireProgram
106
         , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
107
108
         , ghcProgram, ghcPkgProgram, hsc2hsProgram
         , arProgram, ranlibProgram, ldProgram
109
         , gccProgram, stripProgram )
110
import qualified Distribution.Simple.Program.HcPkg as HcPkg
111
112
import qualified Distribution.Simple.Program.Ar    as Ar
import qualified Distribution.Simple.Program.Ld    as Ld
113
import Distribution.Simple.Program.GHC
114
115
116
117
import Distribution.Simple.Setup
         ( toFlag, fromFlag, fromFlagOrDefault )
import qualified Distribution.Simple.Setup as Cabal
        ( Flag )
118
import Distribution.Simple.Compiler
119
         ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
120
         , OptimisationLevel(..), PackageDB(..), PackageDBStack
121
         , Flag )
122
import Distribution.Version
123
         ( Version(..), anyVersion, orLaterVersion )
124
import Distribution.System
refold's avatar
refold committed
125
         ( OS(..), buildOS )
126
import Distribution.Verbosity
127
import Distribution.Text
128
         ( display, simpleParse )
refold's avatar
refold committed
129
130
import Language.Haskell.Extension (Language(..), Extension(..)
                                  ,KnownExtension(..))
131

132
import Control.Monad            ( unless, when )
133
import Data.Char                ( isSpace )
134
import Data.List
135
import qualified Data.Map as M  ( Map, fromList, lookup )
136
import Data.Maybe               ( catMaybes, fromMaybe, maybeToList )
137
import Data.Monoid              ( Monoid(..) )
138
import System.Directory
139
         ( getDirectoryContents, doesFileExist, getTemporaryDirectory )
Ross Paterson's avatar
Ross Paterson committed
140
import System.FilePath          ( (</>), (<.>), takeExtension,
refold's avatar
refold committed
141
142
                                  takeDirectory, replaceExtension,
                                  splitExtension )
143
import System.IO (hClose, hPutStrLn)
144
import System.Environment (getEnv)
145
import Distribution.Compat.Exception (catchExit, catchIO)
refold's avatar
refold committed
146
import Distribution.System (Platform, platformFromTriple)
147

148

149
150
151
-- -----------------------------------------------------------------------------
-- Configuring

152
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
refold's avatar
refold committed
153
154
          -> ProgramConfiguration
          -> IO (Compiler, Maybe Platform, ProgramConfiguration)
155
configure verbosity hcPath hcPkgPath conf0 = do
156

157
  (ghcProg, ghcVersion, conf1) <-
158
159
    requireProgramVersion verbosity ghcProgram
      (orLaterVersion (Version [6,4] []))
160
      (userMaybeSpecifyPath "ghc" hcPath conf0)
161
162
163
164

  -- This is slightly tricky, we have to configure ghc first, then we use the
  -- location of ghc to help find ghc-pkg in the case that the user did not
  -- specify the location of ghc-pkg directly:
165
  (ghcPkgProg, ghcPkgVersion, conf2) <-
166
167
168
    requireProgramVersion verbosity ghcPkgProgram {
      programFindLocation = guessGhcPkgFromGhcPath ghcProg
    }
169
    anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf1)
170
171

  when (ghcVersion /= ghcPkgVersion) $ die $
172
       "Version mismatch between ghc and ghc-pkg: "
173
174
    ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " "
    ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion
175

176
177
178
179
180
181
  -- Likewise we try to find the matching hsc2hs program.
  let hsc2hsProgram' = hsc2hsProgram {
                           programFindLocation = guessHsc2hsFromGhcPath ghcProg
                       }
      conf3 = addKnownProgram hsc2hsProgram' conf2

182
183
  languages  <- getLanguages verbosity ghcProg
  extensions <- getExtensions verbosity ghcProg
184

185
  ghcInfo <- getGhcInfo verbosity ghcProg
186
  let ghcInfoMap = M.fromList ghcInfo
187

188
  let comp = Compiler {
189
190
191
192
        compilerId         = CompilerId GHC ghcVersion,
        compilerLanguages  = languages,
        compilerExtensions = extensions,
        compilerProperties = ghcInfoMap
193
      }
194
      compPlatform = targetPlatform ghcInfo
195
      conf4 = configureToolchain ghcProg ghcInfoMap conf3 -- configure gcc and ld
196
197
198
199
  return (comp, compPlatform, conf4)

targetPlatform :: [(String, String)] -> Maybe Platform
targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo
200

201
202
203
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
-- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
-- for a versioned or unversioned ghc-pkg in the same dir, that is:
204
--
205
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
206
207
208
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
209
210
guessToolFromGhcPath :: Program -> ConfiguredProgram
                     -> Verbosity -> ProgramSearchPath
211
                     -> IO (Maybe FilePath)
212
213
214
guessToolFromGhcPath tool ghcProg verbosity searchpath
  = do let toolname          = programName tool
           path              = programPath ghcProg
215
216
           dir               = takeDirectory path
           versionSuffix     = takeVersionSuffix (dropExeExtension path)
217
218
           guessNormal       = dir </> toolname <.> exeExtension
           guessGhcVersioned = dir </> (toolname ++ "-ghc" ++ versionSuffix)
refold's avatar
refold committed
219
                               <.> exeExtension
220
221
           guessVersioned    = dir </> (toolname ++ versionSuffix)
                               <.> exeExtension
222
           guesses | null versionSuffix = [guessNormal]
223
224
225
                   | otherwise          = [guessGhcVersioned,
                                           guessVersioned,
                                           guessNormal]
226
       info verbosity $ "looking for tool " ++ toolname
refold's avatar
refold committed
227
         ++ " near compiler in " ++ dir
228
229
       exists <- mapM doesFileExist guesses
       case [ file | (file, True) <- zip guesses exists ] of
refold's avatar
refold committed
230
231
                   -- If we can't find it near ghc, fall back to the usual
                   -- method.
232
233
         []     -> programFindLocation tool verbosity searchpath
         (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
234
                      return (Just fp)
235
236

  where takeVersionSuffix :: FilePath -> String
refold's avatar
refold committed
237
238
        takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") .
                            reverse
239
240
241
242
243
244
245

        dropExeExtension :: FilePath -> FilePath
        dropExeExtension filepath =
          case splitExtension filepath of
            (filepath', extension) | extension == exeExtension -> filepath'
                                   | otherwise                 -> filepath

246
247
248
249
250
251
252
253
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
-- ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
254
255
256
guessGhcPkgFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
257
258
259
260
261
262
263
264
265

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding hsc2hs, we try looking for both a versioned and unversioned
-- hsc2hs in the same dir, that is:
--
-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs(.exe)
--
266
267
268
guessHsc2hsFromGhcPath :: ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
269

270
271
-- | Adjust the way we find and configure gcc and ld
--
272
configureToolchain :: ConfiguredProgram -> M.Map String String
273
                                        -> ProgramConfiguration
274
                                        -> ProgramConfiguration
275
configureToolchain ghcProg ghcInfo =
276
    addKnownProgram gccProgram {
277
      programFindLocation = findProg gccProgram extraGccPath,
278
      programPostConf     = configureGcc
279
280
    }
  . addKnownProgram ldProgram {
281
      programFindLocation = findProg ldProgram extraLdPath,
282
283
      programPostConf     = configureLd
    }
284
  . addKnownProgram arProgram {
285
      programFindLocation = findProg arProgram extraArPath
286
    }
287
  . addKnownProgram stripProgram {
288
      programFindLocation = findProg stripProgram extraStripPath
289
    }
290
  where
291
    Just ghcVersion = programVersion ghcProg
292
293
    compilerDir = takeDirectory (programPath ghcProg)
    baseDir     = takeDirectory compilerDir
294
    mingwBinDir = baseDir </> "mingw" </> "bin"
295
    libDir      = baseDir </> "gcc-lib"
296
    includeDir  = baseDir </> "include" </> "mingw"
297
    isWindows   = case buildOS of Windows -> True; _ -> False
Ian Lynagh's avatar
Ian Lynagh committed
298
    binPrefix   = ""
299

300
301
302
303
304
305
306
307
308
309
310
    mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath]
    mkExtraPath mbPath mingwPath | isWindows = mbDir ++ [mingwPath]
                                 | otherwise = mbDir
      where
        mbDir = maybeToList . fmap takeDirectory $ mbPath

    extraGccPath   = mkExtraPath mbGccLocation   windowsExtraGccDir
    extraLdPath    = mkExtraPath mbLdLocation    windowsExtraLdDir
    extraArPath    = mkExtraPath mbArLocation    windowsExtraArDir
    extraStripPath = mkExtraPath mbStripLocation windowsExtraStripDir

311
    -- on Windows finding and configuring ghc's gcc & binutils is a bit special
312
313
314
315
316
317
318
319
320
321
322
323
324
325
    windowsExtraGccDir
      | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix
      | otherwise                       = baseDir
    windowsExtraLdDir
      | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix
      | otherwise                       = libDir
    windowsExtraArDir
      | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix
      | otherwise                       = libDir
    windowsExtraStripDir
      | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix
      | otherwise                       = libDir

    findProg :: Program -> [FilePath]
326
327
328
             -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
    findProg prog extraPath v searchpath =
        programFindLocation prog v searchpath'
329
      where
330
331
332
333
334
335
336
337
        searchpath' = (map ProgramSearchPathDir extraPath) ++ searchpath

    -- Read tool locations from the 'ghc --info' output. Useful when
    -- cross-compiling.
    mbGccLocation   = M.lookup "C compiler command" ghcInfo
    mbLdLocation    = M.lookup "ld command" ghcInfo
    mbArLocation    = M.lookup "ar command" ghcInfo
    mbStripLocation = M.lookup "strip command" ghcInfo
338

339
340
341
    ccFlags        = getFlags "C compiler flags"
    gccLinkerFlags = getFlags "Gcc Linker flags"
    ldLinkerFlags  = getFlags "Ld Linker flags"
342

343
    getFlags key = case M.lookup key ghcInfo of
344
345
346
347
348
349
                   Nothing -> []
                   Just flags ->
                       case reads flags of
                       [(args, "")] -> args
                       _ -> [] -- XXX Should should be an error really

350
351
352
353
354
355
356
    configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureGcc v gccProg = do
      gccProg' <- configureGcc' v gccProg
      return gccProg' {
        programDefaultArgs = programDefaultArgs gccProg'
                             ++ ccFlags ++ gccLinkerFlags
      }
357

358
    configureGcc' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
359
    configureGcc'
360
361
362
      | isWindows = \_ gccProg -> case programLocation gccProg of
          -- if it's found on system then it means we're using the result
          -- of programFindLocation above rather than a user-supplied path
363
364
365
366
367
          -- Pre GHC 6.12, that meant we should add these flags to tell
          -- ghc's gcc where it lives and thus where gcc can find its
          -- various files:
          FoundOnSystem {}
           | ghcVersion < Version [6,11] [] ->
368
369
370
371
372
373
374
375
376
377
378
               return gccProg { programDefaultArgs = ["-B" ++ libDir,
                                                      "-I" ++ includeDir] }
          _ -> return gccProg
      | otherwise = \_ gccProg -> return gccProg

    configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
    configureLd v ldProg = do
      ldProg' <- configureLd' v ldProg
      return ldProg' {
        programDefaultArgs = programDefaultArgs ldProg' ++ ldLinkerFlags
      }
379
380

    -- we need to find out if ld supports the -x flag
381
    configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
382
    configureLd' verbosity ldProg = do
383
      tempDir <- getTemporaryDirectory
384
385
      ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->
             withTempFile tempDir ".o" $ \testofile testohnd -> do
386
               hPutStrLn testchnd "int foo() { return 0; }"
387
388
389
               hClose testchnd; hClose testohnd
               rawSystemProgram verbosity ghcProg ["-c", testcfile,
                                                   "-o", testofile]
390
               withTempFile tempDir ".o" $ \testofile' testohnd' ->
391
392
                 do
                   hClose testohnd'
393
                   _ <- rawSystemProgramStdout verbosity ldProg
394
395
396
397
398
                     ["-x", "-r", testofile, "-o", testofile']
                   return True
                 `catchIO`   (\_ -> return False)
                 `catchExit` (\_ -> return False)
      if ldx
399
400
        then return ldProg { programDefaultArgs = ["-x"] }
        else return ldProg
401

402
403
404
405
406
407
408
409
410
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]
getLanguages _ ghcProg
  -- TODO: should be using --supported-languages rather than hard coding
  | ghcVersion >= Version [7] [] = return [(Haskell98,   "-XHaskell98")
                                          ,(Haskell2010, "-XHaskell2010")]
  | otherwise                    = return [(Haskell98,   "")]
  where
    Just ghcVersion = programVersion ghcProg

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg =
    case programVersion ghcProg of
    Just ghcVersion
     | ghcVersion >= Version [6,7] [] ->
        do xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
                 ["--info"]
           case reads xs of
               [(i, ss)]
                | all isSpace ss ->
                   return i
               _ ->
                   die "Can't parse --info output of GHC"
    _ ->
        return []

427
428
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions verbosity ghcProg
429
430
  | ghcVersion >= Version [6,7] [] = do

431
    str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
432
              ["--supported-languages"]
433
434
435
436
437
438
439
440
441
442
443
    let extStrs = if ghcVersion >= Version [7] []
                  then lines str
                  else -- Older GHCs only gave us either Foo or NoFoo,
                       -- so we have to work out the other one ourselves
                       [ extStr''
                       | extStr <- lines str
                       , let extStr' = case extStr of
                                       'N' : 'o' : xs -> xs
                                       _              -> "No" ++ extStr
                       , extStr'' <- [extStr, extStr']
                       ]
444
445
446
    let extensions0 = [ (ext, "-X" ++ display ext)
                      | Just ext <- map simpleParse extStrs ]
        extensions1 = if ghcVersion >= Version [6,8]  [] &&
447
448
449
450
451
452
453
454
455
                         ghcVersion <  Version [6,10] []
                      then -- ghc-6.8 introduced RecordPuns however it
                           -- should have been NamedFieldPuns. We now
                           -- encourage packages to use NamedFieldPuns
                           -- so for compatability we fake support for
                           -- it in ghc-6.8 by making it an alias for
                           -- the old RecordPuns extension.
                           (EnableExtension  NamedFieldPuns, "-XRecordPuns") :
                           (DisableExtension NamedFieldPuns, "-XNoRecordPuns") :
456
457
458
459
460
461
462
463
464
465
466
                           extensions0
                      else extensions0
        extensions2 = if ghcVersion <  Version [7,1] []
                      then -- ghc-7.2 split NondecreasingIndentation off
                           -- into a proper extension. Before that it
                           -- was always on.
                           (EnableExtension  NondecreasingIndentation, "") :
                           (DisableExtension NondecreasingIndentation, "") :
                           extensions1
                      else extensions1
    return extensions2
467
468

  | otherwise = return oldLanguageExtensions
469
470
471
472

  where
    Just ghcVersion = programVersion ghcProg

473
-- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags
474
oldLanguageExtensions :: [(Extension, Flag)]
475
oldLanguageExtensions =
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    let doFlag (f, (enable, disable)) = [(EnableExtension  f, enable),
                                         (DisableExtension f, disable)]
        fglasgowExts = ("-fglasgow-exts",
                        "") -- This is wrong, but we don't want to turn
                            -- all the extensions off when asked to just
                            -- turn one off
        fFlag flag = ("-f" ++ flag, "-fno-" ++ flag)
    in concatMap doFlag
    [(OverlappingInstances       , fFlag "allow-overlapping-instances")
    ,(TypeSynonymInstances       , fglasgowExts)
    ,(TemplateHaskell            , fFlag "th")
    ,(ForeignFunctionInterface   , fFlag "ffi")
    ,(MonomorphismRestriction    , fFlag "monomorphism-restriction")
    ,(MonoPatBinds               , fFlag "mono-pat-binds")
    ,(UndecidableInstances       , fFlag "allow-undecidable-instances")
    ,(IncoherentInstances        , fFlag "allow-incoherent-instances")
    ,(Arrows                     , fFlag "arrows")
    ,(Generics                   , fFlag "generics")
    ,(ImplicitPrelude            , fFlag "implicit-prelude")
    ,(ImplicitParams             , fFlag "implicit-params")
    ,(CPP                        , ("-cpp", ""{- Wrong -}))
    ,(BangPatterns               , fFlag "bang-patterns")
498
499
500
501
502
503
504
505
506
    ,(KindSignatures             , fglasgowExts)
    ,(RecursiveDo                , fglasgowExts)
    ,(ParallelListComp           , fglasgowExts)
    ,(MultiParamTypeClasses      , fglasgowExts)
    ,(FunctionalDependencies     , fglasgowExts)
    ,(Rank2Types                 , fglasgowExts)
    ,(RankNTypes                 , fglasgowExts)
    ,(PolymorphicComponents      , fglasgowExts)
    ,(ExistentialQuantification  , fglasgowExts)
507
    ,(ScopedTypeVariables        , fFlag "scoped-type-variables")
508
509
510
511
512
513
    ,(FlexibleContexts           , fglasgowExts)
    ,(FlexibleInstances          , fglasgowExts)
    ,(EmptyDataDecls             , fglasgowExts)
    ,(PatternGuards              , fglasgowExts)
    ,(GeneralizedNewtypeDeriving , fglasgowExts)
    ,(MagicHash                  , fglasgowExts)
514
515
516
517
518
519
520
    ,(UnicodeSyntax              , fglasgowExts)
    ,(PatternSignatures          , fglasgowExts)
    ,(UnliftedFFITypes           , fglasgowExts)
    ,(LiberalTypeSynonyms        , fglasgowExts)
    ,(TypeOperators              , fglasgowExts)
    ,(GADTs                      , fglasgowExts)
    ,(RelaxedPolyRec             , fglasgowExts)
521
    ,(ExtendedDefaultRules       , fFlag "extended-default-rules")
522
523
524
    ,(UnboxedTuples              , fglasgowExts)
    ,(DeriveDataTypeable         , fglasgowExts)
    ,(ConstrainedClassMethods    , fglasgowExts)
525
    ]
526
527
528
529
530
531
532
533
-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration
                        -> IO PackageIndex
getPackageDBContents verbosity packagedb conf = do
  pkgss <- getInstalledPackages' verbosity [packagedb] conf
  toPackageIndex verbosity pkgss conf

-- | Given a package DB stack, return all installed packages.
534
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
Duncan Coutts's avatar
Duncan Coutts committed
535
                     -> IO PackageIndex
536
getInstalledPackages verbosity packagedbs conf = do
537
  checkPackageDbEnvVar
538
  checkPackageDbStack packagedbs
539
  pkgss <- getInstalledPackages' verbosity packagedbs conf
540
541
  index <- toPackageIndex verbosity pkgss conf
  return $! hackRtsPackage index
542
543
544
545
546
547

  where
    hackRtsPackage index =
      case PackageIndex.lookupPackageName index (PackageName "rts") of
        [(_,[rts])]
           -> PackageIndex.insert (removeMingwIncludeDir rts) index
548
549
        _  -> index -- No (or multiple) ghc rts package is registered!!
                    -- Feh, whatever, the ghc testsuite does some crazy stuff.
550

551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
-- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
-- @PackageIndex@. Helper function used by 'getPackageDBContents' and
-- 'getInstalledPackages'.
toPackageIndex :: Verbosity
               -> [(PackageDB, [InstalledPackageInfo])]
               -> ProgramConfiguration
               -> IO PackageIndex
toPackageIndex verbosity pkgss conf = do
  -- On Windows, various fields have $topdir/foo rather than full
  -- paths. We need to substitute the right value in so that when
  -- we, for example, call gcc, we have proper paths to give it.
  topDir <- ghcLibDir' verbosity ghcProg
  let indices = [ PackageIndex.fromList (map (substTopDir topDir) pkgs)
                | (_, pkgs) <- pkgss ]
  return $! (mconcat indices)

  where
    Just ghcProg = lookupProgram ghcProgram conf

570
571
572
ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
ghcLibDir verbosity lbi =
    (reverse . dropWhile isSpace . reverse) `fmap`
refold's avatar
refold committed
573
574
     rawSystemProgramStdoutConf verbosity ghcProgram
     (withPrograms lbi) ["--print-libdir"]
575
576
577
578
579
580

ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
ghcLibDir' verbosity ghcProg =
    (reverse . dropWhile isSpace . reverse) `fmap`
     rawSystemProgramStdout verbosity ghcProg ["--print-libdir"]

581
582
583
584
585
586
587
588
589
590
591
592
593
-- Cabal does not use the environment variable GHC_PACKAGE_PATH; let users
-- know that this is the case. See ticket #335. Simply ignoring it is not a
-- good idea, since then ghc and cabal are looking at different sets of
-- package dbs and chaos is likely to ensue.
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar = do
    hasGPP <- (getEnv "GHC_PACKAGE_PATH" >> return True)
              `catchIO` (\_ -> return False)
    when hasGPP $
      die $ "Use of GHC's environment variable GHC_PACKAGE_PATH is "
         ++ "incompatible with Cabal. Use the flag --package-db to specify a "
         ++ "package database (it can be used multiple times)."

594
595
596
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
  | GlobalPackageDB `notElem` rest = return ()
597
598
599
600
601
checkPackageDbStack rest
  | GlobalPackageDB `notElem` rest =
  die $ "With current ghc versions the global package db is always used "
     ++ "and must be listed first. This ghc limitation may be lifted in "
     ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977"
602
checkPackageDbStack _ =
603
  die $ "If the global package db is specified, it must be "
604
605
     ++ "specified first and cannot be specified multiple times"

606
607
608
609
610
611
612
613
-- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
-- breaks when you want to use a different gcc, so we need to filter
-- it out.
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir pkg =
    let ids = InstalledPackageInfo.includeDirs pkg
        ids' = filter (not . ("mingw" `isSuffixOf`)) ids
    in pkg { InstalledPackageInfo.includeDirs = ids' }
614

615
616
617
618
619
620
621
-- | Get the packages from specific PackageDBs, not cumulative.
--
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
                     -> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
  | ghcVersion >= Version [6,9] [] =
  sequence
622
623
    [ do pkgs <- HcPkg.dump verbosity ghcPkgProg packagedb
         return (packagedb, pkgs)
624
    | packagedb <- packagedbs ]
625

626
  where
627
628
    Just ghcPkgProg = lookupProgram ghcPkgProgram conf
    Just ghcProg    = lookupProgram ghcProgram conf
629
630
631
632
633
634
    Just ghcVersion = programVersion ghcProg

getInstalledPackages' verbosity packagedbs conf = do
    str <- rawSystemProgramStdoutConf verbosity ghcPkgProgram conf ["list"]
    let pkgFiles = [ init line | line <- lines str, last line == ':' ]
        dbFile packagedb = case (packagedb, pkgFiles) of
635
636
637
638
639
640
          (GlobalPackageDB, global:_)      -> return $ Just global
          (UserPackageDB,  _global:user:_) -> return $ Just user
          (UserPackageDB,  _global:_)      -> return $ Nothing
          (SpecificPackageDB specific, _)  -> return $ Just specific
          _ -> die "cannot read ghc-pkg package listing"
    pkgFiles' <- mapM dbFile packagedbs
641
642
643
    sequence [ withFileContents file $ \content -> do
                  pkgs <- readPackages file content
                  return (db, pkgs)
644
             | (db , Just file) <- zip packagedbs pkgFiles' ]
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
  where
    -- Depending on the version of ghc we use a different type's Read
    -- instance to parse the package file and then convert.
    -- It's a bit yuck. But that's what we get for using Read/Show.
    readPackages
      | ghcVersion >= Version [6,4,2] []
      = \file content -> case reads content of
          [(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
          _           -> failToRead file
      | otherwise
      = \file content -> case reads content of
          [(pkgs, _)] -> return (map IPI641.toCurrent pkgs)
          _           -> failToRead file
    Just ghcProg = lookupProgram ghcProgram conf
    Just ghcVersion = programVersion ghcProg
    failToRead file = die $ "cannot read ghc package database " ++ file
661

662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
 = ipo {
       InstalledPackageInfo.importDirs
           = map f (InstalledPackageInfo.importDirs ipo),
       InstalledPackageInfo.libraryDirs
           = map f (InstalledPackageInfo.libraryDirs ipo),
       InstalledPackageInfo.includeDirs
           = map f (InstalledPackageInfo.includeDirs ipo),
       InstalledPackageInfo.frameworkDirs
           = map f (InstalledPackageInfo.frameworkDirs ipo),
       InstalledPackageInfo.haddockInterfaces
           = map f (InstalledPackageInfo.haddockInterfaces ipo),
       InstalledPackageInfo.haddockHTMLs
           = map f (InstalledPackageInfo.haddockHTMLs ipo)
   }
    where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
          f x = x

681
682
683
-- -----------------------------------------------------------------------------
-- Building

684
685
-- | Build a library with GHC.
--
686
buildLib, replLib :: Verbosity          -> Cabal.Flag (Maybe Int)
687
688
689
690
691
                  -> PackageDescription -> LocalBuildInfo
                  -> Library            -> ComponentLocalBuildInfo -> IO ()
buildLib = buildOrReplLib False
replLib  = buildOrReplLib True

692
buildOrReplLib :: Bool -> Verbosity  -> Cabal.Flag (Maybe Int)
693
694
               -> PackageDescription -> LocalBuildInfo
               -> Library            -> ComponentLocalBuildInfo -> IO ()
695
buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
696
697
698
699
700
  libName <- case componentLibraries clbi of
             [libName] -> return libName
             [] -> die "No library name found when building library"
             _  -> die "Multiple library names found when building library"

701
  let libTargetDir = buildDir lbi
702
      numJobs = fromMaybe 1 $ fromFlagOrDefault Nothing numJobsFlag
703
      pkgid = packageId pkg_descr
704
705
      whenVanillaLib forceVanilla =
        when (not forRepl && (forceVanilla || withVanillaLib lbi))
706
      whenProfLib = when (not forRepl && withProfLib lbi)
707
708
      whenSharedLib forceShared =
        when (not forRepl &&  (forceShared || withSharedLib lbi))
709
710
      whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi)
      ifReplLib = when forRepl
711
      comp = compiler lbi
712
      ghcVersion = compilerVersion comp
713

714
  (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
715
  let runGhcProg = runGHC verbosity ghcProg comp
716

717
  libBi <- hackThreadedFlag verbosity
718
             comp (withProfLib lbi) (libBuildInfo lib)
719

720
721
722
  let isGhcDynamic        = ghcDynamic comp
      dynamicTooSupported = ghcSupportsDynamicToo comp
      doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
refold's avatar
refold committed
723
724
      forceVanillaLib = doingTH && not isGhcDynamic
      forceSharedLib  = doingTH &&     isGhcDynamic
725
      -- TH always needs default libs, even when building for profiling
726
727

  createDirectoryIfMissingVerbose verbosity True libTargetDir
refold's avatar
refold committed
728
729
  -- TODO: do we need to put hs-boot files into place for mutually recursive
  -- modules?
730
731
  let cObjs       = map (`replaceExtension` objExtension) (cSources libBi)
      baseOpts    = componentGhcOptions verbosity lbi libBi clbi libTargetDir
732
      vanillaOpts = baseOpts `mappend` mempty {
733
                      ghcOptMode         = toFlag GhcModeMake,
734
                      ghcOptNumJobs      = toFlag numJobs,
735
736
737
738
                      ghcOptPackageName  = toFlag pkgid,
                      ghcOptInputModules = libModules lib
                    }

739
      profOpts    = vanillaOpts `mappend` mempty {
740
741
742
743
744
745
                      ghcOptProfilingMode = toFlag True,
                      ghcOptHiSuffix      = toFlag "p_hi",
                      ghcOptObjSuffix     = toFlag "p_o",
                      ghcOptExtra         = ghcProfOptions libBi
                    }

746
      sharedOpts  = vanillaOpts `mappend` mempty {
747
748
749
750
751
                      ghcOptDynLinkMode = toFlag GhcDynamicOnly,
                      ghcOptFPic        = toFlag True,
                      ghcOptHiSuffix    = toFlag "dyn_hi",
                      ghcOptObjSuffix   = toFlag "dyn_o",
                      ghcOptExtra       = ghcSharedOptions libBi
752
                    }
753
754
755
756
757
      linkerOpts = mempty {
                      ghcOptLinkOptions    = PD.ldOptions libBi,
                      ghcOptLinkLibs       = extraLibs libBi,
                      ghcOptLinkLibPath    = extraLibDirs libBi,
                      ghcOptLinkFrameworks = PD.frameworks libBi,
758
                      ghcOptInputFiles     = [libTargetDir </> x | x <- cObjs]
759
                   }
760
      replOpts    = vanillaOpts {
761
                      ghcOptExtra        = filterGhciFlags
762
763
                                           (ghcOptExtra vanillaOpts),
                      ghcOptNumJobs      = mempty
764
                    }
765
                    `mappend` linkerOpts
766
                    `mappend` mempty {
767
768
769
                      ghcOptMode         = toFlag GhcModeInteractive,
                      ghcOptOptimisation = toFlag GhcNoOptimisation
                    }
770

771
      vanillaSharedOpts = vanillaOpts `mappend` mempty {
772
773
774
775
                      ghcOptDynLinkMode  = toFlag GhcStaticAndDynamic,
                      ghcOptDynHiSuffix  = toFlag "dyn_hi",
                      ghcOptDynObjSuffix = toFlag "dyn_o"
                    }
776

777
  unless (null (libModules lib)) $
778
779
    do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
           shared  = whenSharedLib  forceSharedLib  (runGhcProg sharedOpts)
780
781
782
783
784
           useDynToo = dynamicTooSupported &&
                       (forceVanillaLib || withVanillaLib lbi) &&
                       (forceSharedLib  || withSharedLib  lbi) &&
                       null (ghcSharedOptions libBi)
       if useDynToo
785
786
787
           then runGhcProg vanillaSharedOpts
           else if isGhcDynamic then do shared;  vanilla
                                else do vanilla; shared
788
       whenProfLib (runGhcProg profOpts)
789
790
791
792

  -- build any C sources
  unless (null (cSources libBi)) $ do
     info verbosity "Building C Sources..."
793
794
     sequence_
       [ do let vanillaCcOpts = (componentCcGhcOptions verbosity lbi
795
                                    libBi clbi libTargetDir filename)
796
797
798
                profCcOpts    = vanillaCcOpts `mappend` mempty {
                                  ghcOptProfilingMode = toFlag True,
                                  ghcOptObjSuffix     = toFlag "p_o"
799
                                }
800
                sharedCcOpts  = vanillaCcOpts `mappend` mempty {
801
802
803
                                  ghcOptFPic        = toFlag True,
                                  ghcOptDynLinkMode = toFlag GhcDynamicOnly,
                                  ghcOptObjSuffix   = toFlag "dyn_o"
804
805
806
807
                                }
                odir          = fromFlag (ghcOptObjDir vanillaCcOpts)
            createDirectoryIfMissingVerbose verbosity True odir
            runGhcProg vanillaCcOpts
808
809
            whenSharedLib forceSharedLib (runGhcProg sharedCcOpts)
            whenProfLib (runGhcProg profCcOpts)
810
       | filename <- cSources libBi]
811

812
813
814
  -- TODO: problem here is we need the .c files built first, so we can load them
  -- with ghci, but .c files can depend on .h files generated by ghc by ffi
  -- exports.
815
816
817
818
  unless (null (libModules lib)) $
     ifReplLib (runGhcProg replOpts)


819
820
  -- link:
  info verbosity "Linking..."
821
  let cProfObjs   = map (`replaceExtension` ("p_" ++ objExtension))
822
823
824
                    (cSources libBi)
      cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
                    (cSources libBi)
825
826
827
828
829
      cid = compilerId (compiler lbi)
      vanillaLibFilePath = libTargetDir </> mkLibName           libName
      profileLibFilePath = libTargetDir </> mkProfLibName       libName
      sharedLibFilePath  = libTargetDir </> mkSharedLibName cid libName
      ghciLibFilePath    = libTargetDir </> mkGHCiLibName       libName
830
      libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest
831
      sharedLibInstallPath = libInstallPath </> mkSharedLibName cid libName
832
833
834
835

  stubObjs <- fmap catMaybes $ sequence
    [ findFileWithExtension [objExtension] [libTargetDir]
        (ModuleName.toFilePath x ++"_stub")
836
837
    | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
    , x <- libModules lib ]
838
839
840
  stubProfObjs <- fmap catMaybes $ sequence
    [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
        (ModuleName.toFilePath x ++"_stub")
841
842
    | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
    , x <- libModules lib ]
843
844
845
  stubSharedObjs <- fmap catMaybes $ sequence
    [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
        (ModuleName.toFilePath x ++"_stub")
846
847
    | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
    , x <- libModules lib ]
848

849
  hObjs     <- getHaskellObjects lib lbi
850
                    libTargetDir objExtension True
851
852
  hProfObjs <-
    if (withProfLib lbi)
853
            then getHaskellObjects lib lbi
854
                    libTargetDir ("p_" ++ objExtension) True
855
856
857
            else return []
  hSharedObjs <-
    if (withSharedLib lbi)
858
            then getHaskellObjects lib lbi
859
                    libTargetDir ("dyn_" ++ objExtension) False
860
861
862
863
            else return []

  unless (null hObjs && null cObjs && null stubObjs) $ do

864
    let staticObjectFiles =
865
               hObjs
866
            ++ map (libTargetDir </>) cObjs
867
            ++ stubObjs
868
        profObjectFiles =
869
               hProfObjs
870
            ++ map (libTargetDir </>) cProfObjs
871
            ++ stubProfObjs
872
        ghciObjFiles =
873
               hObjs
874
            ++ map (libTargetDir </>) cObjs
875
            ++ stubObjs
876
        dynamicObjectFiles =
877
               hSharedObjs
878
            ++ map (libTargetDir </>) cSharedObjs
879
880
881
882
883
            ++ stubSharedObjs
        -- After the relocation lib is created we invoke ghc -shared
        -- with the dependencies spelled out as -package arguments
        -- and ghc invokes the linker with the proper library paths
        ghcSharedLinkArgs =
884
885
            mempty {
              ghcOptShared             = toFlag True,
886
              ghcOptDynLinkMode        = toFlag GhcDynamicOnly,
887
888
889
890
891
892
893
894
895
896
897
898
899
900
              ghcOptInputFiles         = dynamicObjectFiles,
              ghcOptOutputFile         = toFlag sharedLibFilePath,
              -- For dynamic libs, Mac OS/X needs to know the install location
              -- at build time.
              ghcOptDylibName          = if buildOS == OSX
                                          then toFlag sharedLibInstallPath
                                          else mempty,
              ghcOptPackageName        = toFlag pkgid,
              ghcOptNoAutoLinkPackages = toFlag True,
              ghcOptPackageDBs         = withPackageDB lbi,
              ghcOptPackages           = componentPackageDeps clbi,
              ghcOptLinkLibs           = extraLibs libBi,
              ghcOptLinkLibPath        = extraLibDirs libBi
            }
901

902
    whenVanillaLib False $ do
903
904
905
      (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
      Ar.createArLibArchive verbosity arProg
        vanillaLibFilePath staticObjectFiles
906

907
    whenProfLib $ do
908
909
910
      (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
      Ar.createArLibArchive verbosity arProg
        profileLibFilePath profObjectFiles
911

912
    whenGHCiLib $ do
913
914
915
      (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
      Ld.combineObjectFiles verbosity ldProg
        ghciLibFilePath ghciObjFiles
916

917
    whenSharedLib False $
918
      runGhcProg ghcSharedLinkArgs
919
920
921
922


-- | Build an executable with GHC.
--
923
buildExe, replExe :: Verbosity          -> Cabal.Flag (Maybe Int)
924
925
926
927
928
                  -> PackageDescription -> LocalBuildInfo
                  -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe = buildOrReplExe False
replExe  = buildOrReplExe True

929
buildOrReplExe :: Bool -> Verbosity  -> Cabal.Flag (Maybe Int)
930
931
               -> PackageDescription -> LocalBuildInfo
               -> Executable         -> ComponentLocalBuildInfo -> IO ()
932
buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
933
  exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
934
935

  (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
936
  let comp       = compiler lbi
937
938
      numJobs    = fromMaybe 1 $
                   fromFlagOrDefault Nothing numJobsFlag
939
      runGhcProg = runGHC verbosity ghcProg comp
940
941

  exeBi <- hackThreadedFlag verbosity
942
             comp (withProfExe lbi) (buildInfo exe)
943
944
945

  -- exeNameReal, the name that GHC really uses (with .exe on Windows)
  let exeNameReal = exeName' <.>
946
                    (if takeExtension exeName' /= ('.':exeExtension)
947
948
                       then exeExtension
                       else "")
949

950
  let targetDir = (buildDir lbi) </> exeName'
951
952
953
  let exeDir    = targetDir </> (exeName' ++ "-tmp")
  createDirectoryIfMissingVerbose verbosity True targetDir
  createDirectoryIfMissingVerbose verbosity True exeDir
refold's avatar
refold committed
954
955
  -- TODO: do we need to put hs-boot files into place for mutually recursive
  -- modules?  FIX: what about exeName.hi-boot?
956
957
958

  -- build executables

959
  srcMainFile         <- findFile (exeDir : hsSourceDirs exeBi) modPath
960
961
962
  let isGhcDynamic        = ghcDynamic comp
      dynamicTooSupported = ghcSupportsDynamicToo comp
      isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
963
964
965
      cSrcs         = cSources exeBi ++ [srcMainFile | not isHaskellMain]
      cObjs         = map (`replaceExtension` objExtension) cSrcs
      baseOpts   = (componentGhcOptions verbosity lbi exeBi clbi exeDir)
966
                    `mappend` mempty {
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
967
968
969
970
971
                      ghcOptMode         = toFlag GhcModeMake,
                      ghcOptInputFiles   =
                        [ srcMainFile | isHaskellMain],
                      ghcOptInputModules =
                        [ m | not isHaskellMain, m <- exeModules exe]
972
                    }
973
      staticOpts = baseOpts `mappend` mempty {
974
                      ghcOptDynLinkMode    = toFlag GhcStaticOnly
975
976
                   }
      profOpts   = baseOpts `mappend` mempty {
977
978
979
                      ghcOptProfilingMode  = toFlag True,
                      ghcOptHiSuffix       = toFlag "p_hi",
                      ghcOptObjSuffix      = toFlag "p_o",
980
                      ghcOptExtra          = ghcProfOptions exeBi
981
                    }
982
      dynOpts    = baseOpts `mappend` mempty {
983
                      ghcOptDynLinkMode    = toFlag GhcDynamicOnly,
984
985
986
987
                      ghcOptHiSuffix       = toFlag "dyn_hi",
                      ghcOptObjSuffix      = toFlag "dyn_o",
                      ghcOptExtra          = ghcSharedOptions exeBi
                    }
988
      dynTooOpts = staticOpts `mappend` mempty {
989
990
991
                      ghcOptDynLinkMode    = toFlag GhcStaticAndDynamic,
                      ghcOptDynHiSuffix    = toFlag "dyn_hi",
                      ghcOptDynObjSuffix   = toFlag "dyn_o"
992
                    }
993
994
995
996
997
998
999
      linkerOpts = mempty {
                      ghcOptLinkOptions    = PD.ldOptions exeBi,
                      ghcOptLinkLibs       = extraLibs exeBi,
                      ghcOptLinkLibPath    = extraLibDirs exeBi,
                      ghcOptLinkFrameworks = PD.frameworks exeBi,
                      ghcOptInputFiles     = [exeDir </> x | x <- cObjs]
                   }
1000
      replOpts   = baseOpts {
1001
1002
                      ghcOptExtra          = filterGhciFlags
                                             (ghcOptExtra baseOpts)
1003
                   }
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
1004
1005
1006
1007
1008
                   -- For a normal compile we do separate invocations of ghc for
                   -- compiling as for linking. But for repl we have to do just
                   -- the one invocation, so that one has to include all the
                   -- linker stuff too, like -l flags and any .o files from C
                   -- files etc.
1009
                   `mappend` linkerOpts
1010
                   `mappend` mempty {
1011
1012
1013
                      ghcOptMode           = toFlag GhcModeInteractive,
                      ghcOptOptimisation   = toFlag GhcNoOptimisation
                   }
1014
      commonOpts  | withProfExe