~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to compiler/main/HscTypes.lhs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
ImportĀ upstreamĀ versionĀ 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%
 
2
% (c) The University of Glasgow, 2006
 
3
%
 
4
\section[HscTypes]{Types for the per-module compiler}
 
5
 
 
6
\begin{code}
 
7
-- | Types for the per-module compiler
 
8
module HscTypes ( 
 
9
        -- * 'Ghc' monad stuff
 
10
        Ghc(..), GhcT(..), liftGhcT,
 
11
        GhcMonad(..), WarnLogMonad(..),
 
12
        liftIO,
 
13
        ioMsgMaybe, ioMsg,
 
14
        logWarnings, clearWarnings, hasWarnings,
 
15
        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
 
16
        throwOneError, handleSourceError,
 
17
        reflectGhc, reifyGhc,
 
18
        handleFlagWarnings,
 
19
 
 
20
        -- * Sessions and compilation state
 
21
        Session(..), withSession, modifySession, withTempSession,
 
22
        HscEnv(..), hscEPS,
 
23
        FinderCache, FindResult(..), ModLocationCache,
 
24
        Target(..), TargetId(..), pprTarget, pprTargetId,
 
25
        ModuleGraph, emptyMG,
 
26
        -- ** Callbacks
 
27
        GhcApiCallbacks(..), withLocalCallbacks,
 
28
 
 
29
        -- * Information about modules
 
30
        ModDetails(..), emptyModDetails,
 
31
        ModGuts(..), CoreModule(..), CgGuts(..), ForeignStubs(..),
 
32
        ImportedMods,
 
33
 
 
34
        ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
 
35
        msHsFilePath, msHiFilePath, msObjFilePath,
 
36
 
 
37
        -- * Information about the module being compiled
 
38
        HscSource(..), isHsBoot, hscSourceString,       -- Re-exported from DriverPhases
 
39
        
 
40
        -- * State relating to modules in this package
 
41
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
 
42
        hptInstances, hptRules, hptVectInfo,
 
43
        
 
44
        -- * State relating to known packages
 
45
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
 
46
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
 
47
        lookupIfaceByModule, emptyModIface,
 
48
        
 
49
        PackageInstEnv, PackageRuleBase,
 
50
 
 
51
 
 
52
        -- * Annotations
 
53
        prepareAnnotations,
 
54
 
 
55
        -- * Interactive context
 
56
        InteractiveContext(..), emptyInteractiveContext, 
 
57
        icPrintUnqual, extendInteractiveContext,
 
58
        substInteractiveContext,
 
59
        mkPrintUnqualified, pprModulePrefix,
 
60
 
 
61
        -- * Interfaces
 
62
        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
 
63
        emptyIfaceWarnCache,
 
64
 
 
65
        -- * Fixity
 
66
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
 
67
 
 
68
        -- * TyThings and type environments
 
69
        TyThing(..),
 
70
        tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
 
71
        implicitTyThings, isImplicitTyThing,
 
72
        
 
73
        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
 
74
        extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
 
75
        typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
76
        typeEnvDataCons,
 
77
 
 
78
        -- * MonadThings
 
79
        MonadThings(..),
 
80
 
 
81
        -- * Information on imports and exports
 
82
        WhetherHasOrphans, IsBootInterface, Usage(..), 
 
83
        Dependencies(..), noDependencies,
 
84
        NameCache(..), OrigNameCache, OrigIParamCache,
 
85
        Avails, availsToNameSet, availsToNameEnv, availName, availNames,
 
86
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
 
87
        IfaceExport,
 
88
 
 
89
        -- * Warnings
 
90
        Warnings(..), WarningTxt(..), plusWarns,
 
91
 
 
92
        -- * Linker stuff
 
93
        Linkable(..), isObjectLinkable,
 
94
        Unlinked(..), CompiledByteCode,
 
95
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
 
96
        
 
97
        -- * Program coverage
 
98
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
 
99
 
 
100
        -- * Breakpoints
 
101
        ModBreaks (..), BreakIndex, emptyModBreaks,
 
102
 
 
103
        -- * Vectorisation information
 
104
        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, 
 
105
        noIfaceVectInfo
 
106
    ) where
 
107
 
 
108
#include "HsVersions.h"
 
109
 
 
110
#ifdef GHCI
 
111
import ByteCodeAsm      ( CompiledByteCode )
 
112
import {-# SOURCE #-}  InteractiveEval ( Resume )
 
113
#endif
 
114
 
 
115
import HsSyn
 
116
import RdrName
 
117
import Name
 
118
import NameEnv
 
119
import NameSet  
 
120
import Module
 
121
import InstEnv          ( InstEnv, Instance )
 
122
import FamInstEnv       ( FamInstEnv, FamInst )
 
123
import Rules            ( RuleBase )
 
124
import CoreSyn          ( CoreBind )
 
125
import VarEnv
 
126
import Var
 
127
import Id
 
128
import Type             
 
129
 
 
130
import Annotations
 
131
import Class            ( Class, classAllSelIds, classATs, classTyCon )
 
132
import TyCon
 
133
import DataCon          ( DataCon, dataConImplicitIds, dataConWrapId )
 
134
import PrelNames        ( gHC_PRIM )
 
135
import Packages hiding ( Version(..) )
 
136
import DynFlags         ( DynFlags(..), isOneShot, HscTarget (..), dopt,
 
137
                          DynFlag(..) )
 
138
import DriverPhases     ( HscSource(..), isHsBoot, hscSourceString, Phase )
 
139
import BasicTypes       ( IPName, defaultFixity, WarningTxt(..) )
 
140
import OptimizationFuel ( OptFuelState )
 
141
import IfaceSyn
 
142
import CoreSyn          ( CoreRule )
 
143
import Maybes           ( orElse, expectJust, catMaybes )
 
144
import Outputable
 
145
import BreakArray
 
146
import SrcLoc           ( SrcSpan, Located(..) )
 
147
import UniqFM           ( lookupUFM, eltsUFM, emptyUFM )
 
148
import UniqSupply       ( UniqSupply )
 
149
import FastString
 
150
import StringBuffer     ( StringBuffer )
 
151
import Fingerprint
 
152
import MonadUtils
 
153
import Data.Dynamic     ( Typeable )
 
154
import qualified Data.Dynamic as Dyn
 
155
import Bag
 
156
import ErrUtils
 
157
 
 
158
import System.FilePath
 
159
import System.Time      ( ClockTime )
 
160
import Data.IORef
 
161
import Data.Array       ( Array, array )
 
162
import Data.List
 
163
import Data.Map (Map)
 
164
import Control.Monad    ( mplus, guard, liftM, when )
 
165
import Exception
 
166
\end{code}
 
167
 
 
168
 
 
169
%************************************************************************
 
170
%*                                                                      *
 
171
\subsection{Compilation environment}
 
172
%*                                                                      *
 
173
%************************************************************************
 
174
 
 
175
 
 
176
\begin{code}
 
177
-- | The Session is a handle to the complete state of a compilation
 
178
-- session.  A compilation session consists of a set of modules
 
179
-- constituting the current program or library, the context for
 
180
-- interactive evaluation, and various caches.
 
181
data Session = Session !(IORef HscEnv) !(IORef WarningMessages)
 
182
 
 
183
mkSrcErr :: ErrorMessages -> SourceError
 
184
srcErrorMessages :: SourceError -> ErrorMessages
 
185
mkApiErr :: SDoc -> GhcApiError
 
186
 
 
187
throwOneError :: MonadIO m => ErrMsg -> m ab
 
188
throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
 
189
 
 
190
-- | A source error is an error that is caused by one or more errors in the
 
191
-- source code.  A 'SourceError' is thrown by many functions in the
 
192
-- compilation pipeline.  Inside GHC these errors are merely printed via
 
193
-- 'log_action', but API clients may treat them differently, for example,
 
194
-- insert them into a list box.  If you want the default behaviour, use the
 
195
-- idiom:
 
196
--
 
197
-- > handleSourceError printExceptionAndWarnings $ do
 
198
-- >   ... api calls that may fail ...
 
199
--
 
200
-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.
 
201
-- This list may be empty if the compiler failed due to @-Werror@
 
202
-- ('Opt_WarnIsError').
 
203
--
 
204
-- See 'printExceptionAndWarnings' for more information on what to take care
 
205
-- of when writing a custom error handler.
 
206
data SourceError = SourceError ErrorMessages
 
207
 
 
208
instance Show SourceError where
 
209
  show (SourceError msgs) = unlines . map show . bagToList $ msgs
 
210
    -- ToDo: is there some nicer way to print this?
 
211
 
 
212
sourceErrorTc :: Dyn.TyCon
 
213
sourceErrorTc = Dyn.mkTyCon "SourceError"
 
214
{-# NOINLINE sourceErrorTc #-}
 
215
instance Typeable SourceError where
 
216
  typeOf _ = Dyn.mkTyConApp sourceErrorTc []
 
217
 
 
218
instance Exception SourceError
 
219
 
 
220
mkSrcErr = SourceError
 
221
 
 
222
-- | Perform the given action and call the exception handler if the action
 
223
-- throws a 'SourceError'.  See 'SourceError' for more information.
 
224
handleSourceError :: (ExceptionMonad m) =>
 
225
                     (SourceError -> m a) -- ^ exception handler
 
226
                  -> m a -- ^ action to perform
 
227
                  -> m a
 
228
handleSourceError handler act =
 
229
  gcatch act (\(e :: SourceError) -> handler e)
 
230
 
 
231
srcErrorMessages (SourceError msgs) = msgs
 
232
 
 
233
-- | XXX: what exactly is an API error?
 
234
data GhcApiError = GhcApiError SDoc
 
235
 
 
236
instance Show GhcApiError where
 
237
  show (GhcApiError msg) = showSDoc msg
 
238
 
 
239
ghcApiErrorTc :: Dyn.TyCon
 
240
ghcApiErrorTc = Dyn.mkTyCon "GhcApiError"
 
241
{-# NOINLINE ghcApiErrorTc #-}
 
242
instance Typeable GhcApiError where
 
243
  typeOf _ = Dyn.mkTyConApp ghcApiErrorTc []
 
244
 
 
245
instance Exception GhcApiError
 
246
 
 
247
mkApiErr = GhcApiError
 
248
 
 
249
-- | A monad that allows logging of warnings.
 
250
class Monad m => WarnLogMonad m where
 
251
  setWarnings  :: WarningMessages -> m ()
 
252
  getWarnings :: m WarningMessages
 
253
 
 
254
logWarnings :: WarnLogMonad m => WarningMessages -> m ()
 
255
logWarnings warns = do
 
256
    warns0 <- getWarnings
 
257
    setWarnings (unionBags warns warns0)
 
258
 
 
259
-- | Clear the log of 'Warnings'.
 
260
clearWarnings :: WarnLogMonad m => m ()
 
261
clearWarnings = setWarnings emptyBag
 
262
 
 
263
-- | Returns true if there were any warnings.
 
264
hasWarnings :: WarnLogMonad m => m Bool
 
265
hasWarnings = getWarnings >>= return . not . isEmptyBag
 
266
 
 
267
-- | A monad that has all the features needed by GHC API calls.
 
268
--
 
269
-- In short, a GHC monad
 
270
--
 
271
--   - allows embedding of IO actions,
 
272
--
 
273
--   - can log warnings,
 
274
--
 
275
--   - allows handling of (extensible) exceptions, and
 
276
--
 
277
--   - maintains a current session.
 
278
--
 
279
-- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
 
280
-- before any call to the GHC API functions can occur.
 
281
--
 
282
class (Functor m, MonadIO m, WarnLogMonad m, ExceptionMonad m)
 
283
    => GhcMonad m where
 
284
  getSession :: m HscEnv
 
285
  setSession :: HscEnv -> m ()
 
286
 
 
287
-- | Call the argument with the current session.
 
288
withSession :: GhcMonad m => (HscEnv -> m a) -> m a
 
289
withSession f = getSession >>= f
 
290
 
 
291
-- | Set the current session to the result of applying the current session to
 
292
-- the argument.
 
293
modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
 
294
modifySession f = do h <- getSession
 
295
                     setSession $! f h
 
296
 
 
297
withSavedSession :: GhcMonad m => m a -> m a
 
298
withSavedSession m = do
 
299
  saved_session <- getSession
 
300
  m `gfinally` setSession saved_session
 
301
 
 
302
-- | Call an action with a temporarily modified Session.
 
303
withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
 
304
withTempSession f m =
 
305
  withSavedSession $ modifySession f >> m
 
306
 
 
307
-- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
 
308
-- e.g., to maintain additional state consider wrapping this monad or using
 
309
-- 'GhcT'.
 
310
newtype Ghc a = Ghc { unGhc :: Session -> IO a }
 
311
 
 
312
instance Functor Ghc where
 
313
  fmap f m = Ghc $ \s -> f `fmap` unGhc m s
 
314
 
 
315
instance Monad Ghc where
 
316
  return a = Ghc $ \_ -> return a
 
317
  m >>= g  = Ghc $ \s -> do a <- unGhc m s; unGhc (g a) s
 
318
 
 
319
instance MonadIO Ghc where
 
320
  liftIO ioA = Ghc $ \_ -> ioA
 
321
 
 
322
instance ExceptionMonad Ghc where
 
323
  gcatch act handle =
 
324
      Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
 
325
  gblock (Ghc m)   = Ghc $ \s -> gblock (m s)
 
326
  gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
 
327
  gmask f =
 
328
      Ghc $ \s -> gmask $ \io_restore ->
 
329
                             let
 
330
                                g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
 
331
                             in
 
332
                                unGhc (f g_restore) s
 
333
 
 
334
instance WarnLogMonad Ghc where
 
335
  setWarnings warns = Ghc $ \(Session _ wref) -> writeIORef wref warns
 
336
  -- | Return 'Warnings' accumulated so far.
 
337
  getWarnings       = Ghc $ \(Session _ wref) -> readIORef wref
 
338
 
 
339
instance GhcMonad Ghc where
 
340
  getSession = Ghc $ \(Session r _) -> readIORef r
 
341
  setSession s' = Ghc $ \(Session r _) -> writeIORef r s'
 
342
 
 
343
-- | A monad transformer to add GHC specific features to another monad.
 
344
--
 
345
-- Note that the wrapped monad must support IO and handling of exceptions.
 
346
newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
 
347
liftGhcT :: Monad m => m a -> GhcT m a
 
348
liftGhcT m = GhcT $ \_ -> m
 
349
 
 
350
instance Functor m => Functor (GhcT m) where
 
351
  fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
 
352
 
 
353
instance Monad m => Monad (GhcT m) where
 
354
  return x = GhcT $ \_ -> return x
 
355
  m >>= k  = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s
 
356
 
 
357
instance MonadIO m => MonadIO (GhcT m) where
 
358
  liftIO ioA = GhcT $ \_ -> liftIO ioA
 
359
 
 
360
instance ExceptionMonad m => ExceptionMonad (GhcT m) where
 
361
  gcatch act handle =
 
362
      GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
 
363
  gblock (GhcT m) = GhcT $ \s -> gblock (m s)
 
364
  gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
 
365
  gmask f =
 
366
      GhcT $ \s -> gmask $ \io_restore ->
 
367
                           let
 
368
                              g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
 
369
                           in
 
370
                              unGhcT (f g_restore) s
 
371
 
 
372
instance MonadIO m => WarnLogMonad (GhcT m) where
 
373
  setWarnings warns = GhcT $ \(Session _ wref) -> liftIO $ writeIORef wref warns
 
374
  -- | Return 'Warnings' accumulated so far.
 
375
  getWarnings       = GhcT $ \(Session _ wref) -> liftIO $ readIORef wref
 
376
 
 
377
instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
 
378
  getSession = GhcT $ \(Session r _) -> liftIO $ readIORef r
 
379
  setSession s' = GhcT $ \(Session r _) -> liftIO $ writeIORef r s'
 
380
 
 
381
-- | Lift an IO action returning errors messages into a 'GhcMonad'.
 
382
--
 
383
-- In order to reduce dependencies to other parts of the compiler, functions
 
384
-- outside the "main" parts of GHC return warnings and errors as a parameter
 
385
-- and signal success via by wrapping the result in a 'Maybe' type.  This
 
386
-- function logs the returned warnings and propagates errors as exceptions
 
387
-- (of type 'SourceError').
 
388
--
 
389
-- This function assumes the following invariants:
 
390
--
 
391
--  1. If the second result indicates success (is of the form 'Just x'),
 
392
--     there must be no error messages in the first result.
 
393
--
 
394
--  2. If there are no error messages, but the second result indicates failure
 
395
--     there should be warnings in the first result.  That is, if the action
 
396
--     failed, it must have been due to the warnings (i.e., @-Werror@).
 
397
ioMsgMaybe :: GhcMonad m =>
 
398
              IO (Messages, Maybe a) -> m a
 
399
ioMsgMaybe ioA = do
 
400
  ((warns,errs), mb_r) <- liftIO ioA
 
401
  logWarnings warns
 
402
  case mb_r of
 
403
    Nothing -> liftIO $ throwIO (mkSrcErr errs)
 
404
    Just r  -> ASSERT( isEmptyBag errs ) return r
 
405
 
 
406
-- | Lift a non-failing IO action into a 'GhcMonad'.
 
407
--
 
408
-- Like 'ioMsgMaybe', but assumes that the action will never return any error
 
409
-- messages.
 
410
ioMsg :: GhcMonad m => IO (Messages, a) -> m a
 
411
ioMsg ioA = do
 
412
    ((warns,errs), r) <- liftIO ioA
 
413
    logWarnings warns
 
414
    ASSERT( isEmptyBag errs ) return r
 
415
 
 
416
-- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
 
417
--
 
418
-- You can use this to call functions returning an action in the 'Ghc' monad
 
419
-- inside an 'IO' action.  This is needed for some (too restrictive) callback
 
420
-- arguments of some library functions:
 
421
--
 
422
-- > libFunc :: String -> (Int -> IO a) -> IO a
 
423
-- > ghcFunc :: Int -> Ghc a
 
424
-- >
 
425
-- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
 
426
-- > ghcFuncUsingLibFunc str =
 
427
-- >   reifyGhc $ \s ->
 
428
-- >     libFunc $ \i -> do
 
429
-- >       reflectGhc (ghcFunc i) s
 
430
--
 
431
reflectGhc :: Ghc a -> Session -> IO a
 
432
reflectGhc m = unGhc m
 
433
 
 
434
-- > Dual to 'reflectGhc'.  See its documentation.
 
435
reifyGhc :: (Session -> IO a) -> Ghc a
 
436
reifyGhc act = Ghc $ act
 
437
 
 
438
handleFlagWarnings :: GhcMonad m => DynFlags -> [Located String] -> m ()
 
439
handleFlagWarnings dflags warns
 
440
 = when (dopt Opt_WarnDeprecatedFlags dflags)
 
441
        (handleFlagWarnings' dflags warns)
 
442
 
 
443
handleFlagWarnings' :: GhcMonad m => DynFlags -> [Located String] -> m ()
 
444
handleFlagWarnings' _ [] = return ()
 
445
handleFlagWarnings' dflags warns
 
446
 = do -- It would be nicer if warns :: [Located Message], but that has circular
 
447
      -- import problems.
 
448
      logWarnings $ listToBag (map mkFlagWarning warns)
 
449
      when (dopt Opt_WarnIsError dflags) $
 
450
        liftIO $ throwIO $ mkSrcErr emptyBag
 
451
 
 
452
mkFlagWarning :: Located String -> WarnMsg
 
453
mkFlagWarning (L loc warn)
 
454
 = mkPlainWarnMsg loc (text warn)
 
455
\end{code}
 
456
 
 
457
\begin{code}
 
458
-- | These functions are called in various places of the GHC API.
 
459
--
 
460
-- API clients can override any of these callbacks to change GHC's default
 
461
-- behaviour.
 
462
data GhcApiCallbacks
 
463
  = GhcApiCallbacks {
 
464
 
 
465
    -- | Called by 'load' after the compilating of each module.
 
466
    --
 
467
    -- The default implementation simply prints all warnings and errors to
 
468
    -- @stderr@.  Don't forget to call 'clearWarnings' when implementing your
 
469
    -- own call.
 
470
    --
 
471
    -- The first argument is the module that was compiled.
 
472
    --
 
473
    -- The second argument is @Nothing@ if no errors occured, but there may
 
474
    -- have been warnings.  If it is @Just err@ at least one error has
 
475
    -- occured.  If 'srcErrorMessages' is empty, compilation failed due to
 
476
    -- @-Werror@.
 
477
    reportModuleCompilationResult :: GhcMonad m =>
 
478
                                     ModSummary -> Maybe SourceError
 
479
                                  -> m ()
 
480
  }
 
481
 
 
482
-- | Temporarily modify the callbacks.  After the action is executed all
 
483
-- callbacks are reset (not, however, any other modifications to the session
 
484
-- state.)
 
485
withLocalCallbacks :: GhcMonad m =>
 
486
                      (GhcApiCallbacks -> GhcApiCallbacks)
 
487
                   -> m a -> m a
 
488
withLocalCallbacks f m = do
 
489
  hsc_env <- getSession
 
490
  let cb0 = hsc_callbacks hsc_env
 
491
  let cb' = f cb0
 
492
  setSession (hsc_env { hsc_callbacks = cb' `seq` cb' })
 
493
  r <- m
 
494
  hsc_env' <- getSession
 
495
  setSession (hsc_env' { hsc_callbacks = cb0 })
 
496
  return r
 
497
 
 
498
\end{code}
 
499
 
 
500
\begin{code}
 
501
-- | Hscenv is like 'Session', except that some of the fields are immutable.
 
502
-- An HscEnv is used to compile a single module from plain Haskell source
 
503
-- code (after preprocessing) to either C, assembly or C--.  Things like
 
504
-- the module graph don't change during a single compilation.
 
505
--
 
506
-- Historical note: \"hsc\" used to be the name of the compiler binary,
 
507
-- when there was a separate driver and compiler.  To compile a single
 
508
-- module, the driver would invoke hsc on the source code... so nowadays
 
509
-- we think of hsc as the layer of the compiler that deals with compiling
 
510
-- a single module.
 
511
data HscEnv 
 
512
  = HscEnv { 
 
513
        hsc_dflags :: DynFlags,
 
514
                -- ^ The dynamic flag settings
 
515
 
 
516
        hsc_callbacks :: GhcApiCallbacks,
 
517
                -- ^ Callbacks for the GHC API.
 
518
 
 
519
        hsc_targets :: [Target],
 
520
                -- ^ The targets (or roots) of the current session
 
521
 
 
522
        hsc_mod_graph :: ModuleGraph,
 
523
                -- ^ The module graph of the current session
 
524
 
 
525
        hsc_IC :: InteractiveContext,
 
526
                -- ^ The context for evaluating interactive statements
 
527
 
 
528
        hsc_HPT    :: HomePackageTable,
 
529
                -- ^ The home package table describes already-compiled
 
530
                -- home-package modules, /excluding/ the module we 
 
531
                -- are compiling right now.
 
532
                -- (In one-shot mode the current module is the only
 
533
                --  home-package module, so hsc_HPT is empty.  All other
 
534
                --  modules count as \"external-package\" modules.
 
535
                --  However, even in GHCi mode, hi-boot interfaces are
 
536
                --  demand-loaded into the external-package table.)
 
537
                --
 
538
                -- 'hsc_HPT' is not mutable because we only demand-load 
 
539
                -- external packages; the home package is eagerly 
 
540
                -- loaded, module by module, by the compilation manager.
 
541
                --      
 
542
                -- The HPT may contain modules compiled earlier by @--make@
 
543
                -- but not actually below the current module in the dependency
 
544
                -- graph.
 
545
 
 
546
                -- (This changes a previous invariant: changed Jan 05.)
 
547
        
 
548
        hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
 
549
                -- ^ Information about the currently loaded external packages.
 
550
                -- This is mutable because packages will be demand-loaded during
 
551
                -- a compilation run as required.
 
552
        
 
553
        hsc_NC  :: {-# UNPACK #-} !(IORef NameCache),
 
554
                -- ^ As with 'hsc_EPS', this is side-effected by compiling to
 
555
                -- reflect sucking in interface files.  They cache the state of
 
556
                -- external interface files, in effect.
 
557
 
 
558
        hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),
 
559
                -- ^ The cached result of performing finding in the file system
 
560
        hsc_MLC  :: {-# UNPACK #-} !(IORef ModLocationCache),
 
561
                -- ^ This caches the location of modules, so we don't have to 
 
562
                -- search the filesystem multiple times. See also 'hsc_FC'.
 
563
 
 
564
        hsc_OptFuel :: OptFuelState,
 
565
                -- ^ Settings to control the use of \"optimization fuel\":
 
566
                -- by limiting the number of transformations,
 
567
                -- we can use binary search to help find compiler bugs.
 
568
 
 
569
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
 
570
                -- ^ Used for one-shot compilation only, to initialise
 
571
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for 
 
572
                -- 'TcRunTypes.TcGblEnv'
 
573
 }
 
574
 
 
575
hscEPS :: HscEnv -> IO ExternalPackageState
 
576
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
 
577
 
 
578
-- | A compilation target.
 
579
--
 
580
-- A target may be supplied with the actual text of the
 
581
-- module.  If so, use this instead of the file contents (this
 
582
-- is for use in an IDE where the file hasn't been saved by
 
583
-- the user yet).
 
584
data Target = Target
 
585
      { targetId           :: TargetId  -- ^ module or filename
 
586
      , targetAllowObjCode :: Bool      -- ^ object code allowed?
 
587
      , targetContents     :: Maybe (StringBuffer,ClockTime)
 
588
                                        -- ^ in-memory text buffer?
 
589
      }
 
590
 
 
591
data TargetId
 
592
  = TargetModule ModuleName
 
593
        -- ^ A module name: search for the file
 
594
  | TargetFile FilePath (Maybe Phase)
 
595
        -- ^ A filename: preprocess & parse it to find the module name.
 
596
        -- If specified, the Phase indicates how to compile this file
 
597
        -- (which phase to start from).  Nothing indicates the starting phase
 
598
        -- should be determined from the suffix of the filename.
 
599
  deriving Eq
 
600
 
 
601
pprTarget :: Target -> SDoc
 
602
pprTarget (Target id obj _) = 
 
603
   (if obj then char '*' else empty) <> pprTargetId id
 
604
 
 
605
instance Outputable Target where
 
606
    ppr = pprTarget
 
607
 
 
608
pprTargetId :: TargetId -> SDoc
 
609
pprTargetId (TargetModule m) = ppr m
 
610
pprTargetId (TargetFile f _) = text f
 
611
 
 
612
instance Outputable TargetId where
 
613
    ppr = pprTargetId
 
614
 
 
615
-- | Helps us find information about modules in the home package
 
616
type HomePackageTable  = ModuleNameEnv HomeModInfo
 
617
        -- Domain = modules in the home package that have been fully compiled
 
618
        -- "home" package name cached here for convenience
 
619
 
 
620
-- | Helps us find information about modules in the imported packages
 
621
type PackageIfaceTable = ModuleEnv ModIface
 
622
        -- Domain = modules in the imported packages
 
623
 
 
624
emptyHomePackageTable :: HomePackageTable
 
625
emptyHomePackageTable  = emptyUFM
 
626
 
 
627
emptyPackageIfaceTable :: PackageIfaceTable
 
628
emptyPackageIfaceTable = emptyModuleEnv
 
629
 
 
630
-- | Information about modules in the package being compiled
 
631
data HomeModInfo 
 
632
  = HomeModInfo {
 
633
      hm_iface    :: !ModIface,
 
634
        -- ^ The basic loaded interface file: every loaded module has one of
 
635
        -- these, even if it is imported from another package
 
636
      hm_details  :: !ModDetails,
 
637
        -- ^ Extra information that has been created from the 'ModIface' for
 
638
        -- the module, typically during typechecking
 
639
      hm_linkable :: !(Maybe Linkable)
 
640
        -- ^ The actual artifact we would like to link to access things in
 
641
        -- this module.
 
642
        --
 
643
        -- 'hm_linkable' might be Nothing:
 
644
        --
 
645
        --   1. If this is an .hs-boot module
 
646
        --
 
647
        --   2. Temporarily during compilation if we pruned away
 
648
        --      the old linkable because it was out of date.
 
649
        --
 
650
        -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
 
651
        -- in the 'HomePackageTable' will be @Just@.
 
652
        --
 
653
        -- When re-linking a module ('HscMain.HscNoRecomp'), we construct the
 
654
        -- 'HomeModInfo' by building a new 'ModDetails' from the old
 
655
        -- 'ModIface' (only).
 
656
    }
 
657
 
 
658
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
 
659
-- and external package module information
 
660
lookupIfaceByModule
 
661
        :: DynFlags
 
662
        -> HomePackageTable
 
663
        -> PackageIfaceTable
 
664
        -> Module
 
665
        -> Maybe ModIface
 
666
lookupIfaceByModule dflags hpt pit mod
 
667
  | modulePackageId mod == thisPackage dflags
 
668
  =     -- The module comes from the home package, so look first
 
669
        -- in the HPT.  If it's not from the home package it's wrong to look
 
670
        -- in the HPT, because the HPT is indexed by *ModuleName* not Module
 
671
    fmap hm_iface (lookupUFM hpt (moduleName mod)) 
 
672
    `mplus` lookupModuleEnv pit mod
 
673
 
 
674
  | otherwise = lookupModuleEnv pit mod         -- Look in PIT only 
 
675
 
 
676
-- If the module does come from the home package, why do we look in the PIT as well?
 
677
-- (a) In OneShot mode, even home-package modules accumulate in the PIT
 
678
-- (b) Even in Batch (--make) mode, there is *one* case where a home-package
 
679
--     module is in the PIT, namely GHC.Prim when compiling the base package.
 
680
-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
 
681
-- of its own, but it doesn't seem worth the bother.
 
682
\end{code}
 
683
 
 
684
 
 
685
\begin{code}
 
686
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
 
687
-- ^ Find all the instance declarations (of classes and families) that are in
 
688
-- modules imported by this one, directly or indirectly, and are in the Home
 
689
-- Package Table.  This ensures that we don't see instances from modules @--make@
 
690
-- compiled before this one, but which are not below this one.
 
691
hptInstances hsc_env want_this_module
 
692
  = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
 
693
                guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
 
694
                let details = hm_details mod_info
 
695
                return (md_insts details, md_fam_insts details)
 
696
    in (concat insts, concat famInsts)
 
697
 
 
698
hptVectInfo :: HscEnv -> VectInfo
 
699
-- ^ Get the combined VectInfo of all modules in the home package table.  In
 
700
-- contrast to instances and rules, we don't care whether the modules are
 
701
-- \"below\" us in the dependency sense.  The VectInfo of those modules not \"below\" 
 
702
-- us does not affect the compilation of the current module.
 
703
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
 
704
 
 
705
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
 
706
-- ^ Get rules from modules \"below\" this one (in the dependency sense)
 
707
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
 
708
 
 
709
 
 
710
hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]
 
711
-- ^ Get annotations from modules \"below\" this one (in the dependency sense)
 
712
hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps
 
713
hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env
 
714
 
 
715
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
 
716
hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))
 
717
 
 
718
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
 
719
-- Get things from modules \"below\" this one (in the dependency sense)
 
720
-- C.f Inst.hptInstances
 
721
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
 
722
 | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
 
723
  | otherwise
 
724
  = let 
 
725
        hpt = hsc_HPT hsc_env
 
726
    in
 
727
    [ thing
 
728
    |   -- Find each non-hi-boot module below me
 
729
      (mod, is_boot_mod) <- deps
 
730
    , include_hi_boot || not is_boot_mod
 
731
 
 
732
        -- unsavoury: when compiling the base package with --make, we
 
733
        -- sometimes try to look up RULES etc for GHC.Prim.  GHC.Prim won't
 
734
        -- be in the HPT, because we never compile it; it's in the EPT
 
735
        -- instead.  ToDo: clean up, and remove this slightly bogus
 
736
        -- filter:
 
737
    , mod /= moduleName gHC_PRIM
 
738
 
 
739
        -- Look it up in the HPT
 
740
    , let things = case lookupUFM hpt mod of
 
741
                    Just info -> extract info
 
742
                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg [] 
 
743
          msg = vcat [ptext (sLit "missing module") <+> ppr mod,
 
744
                      ptext (sLit "Probable cause: out-of-date interface files")]
 
745
                        -- This really shouldn't happen, but see Trac #962
 
746
 
 
747
        -- And get its dfuns
 
748
    , thing <- things ]
 
749
\end{code}
 
750
 
 
751
%************************************************************************
 
752
%*                                                                      *
 
753
\subsection{Dealing with Annotations}
 
754
%*                                                                      *
 
755
%************************************************************************
 
756
 
 
757
\begin{code}
 
758
prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
 
759
-- ^ Deal with gathering annotations in from all possible places 
 
760
--   and combining them into a single 'AnnEnv'
 
761
prepareAnnotations hsc_env mb_guts
 
762
  = do { eps <- hscEPS hsc_env
 
763
       ; let -- Extract annotations from the module being compiled if supplied one
 
764
            mb_this_module_anns = fmap (mkAnnEnv . mg_anns) mb_guts
 
765
        -- Extract dependencies of the module if we are supplied one,
 
766
        -- otherwise load annotations from all home package table
 
767
        -- entries regardless of dependency ordering.
 
768
            home_pkg_anns  = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
 
769
            other_pkg_anns = eps_ann_env eps
 
770
            ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns, 
 
771
                                                             Just home_pkg_anns, 
 
772
                                                             Just other_pkg_anns]
 
773
 
 
774
       ; return ann_env }
 
775
\end{code}
 
776
 
 
777
%************************************************************************
 
778
%*                                                                      *
 
779
\subsection{The Finder cache}
 
780
%*                                                                      *
 
781
%************************************************************************
 
782
 
 
783
\begin{code}
 
784
-- | The 'FinderCache' maps home module names to the result of
 
785
-- searching for that module.  It records the results of searching for
 
786
-- modules along the search path.  On @:load@, we flush the entire
 
787
-- contents of this cache.
 
788
--
 
789
-- Although the @FinderCache@ range is 'FindResult' for convenience ,
 
790
-- in fact it will only ever contain 'Found' or 'NotFound' entries.
 
791
--
 
792
type FinderCache = ModuleNameEnv FindResult
 
793
 
 
794
-- | The result of searching for an imported module.
 
795
data FindResult
 
796
  = Found ModLocation Module
 
797
        -- ^ The module was found
 
798
  | NoPackage PackageId
 
799
        -- ^ The requested package was not found
 
800
  | FoundMultiple [PackageId]
 
801
        -- ^ _Error_: both in multiple packages
 
802
  | NotFound [FilePath] (Maybe PackageId) [PackageId] [PackageId]
 
803
        -- ^ The module was not found, including either
 
804
        --    * the specified places were searched
 
805
        --    * the package that this module should have been in
 
806
        --    * list of packages in which the module was hidden,
 
807
        --    * list of hidden packages containing this module
 
808
  | NotFoundInPackage PackageId
 
809
        -- ^ The module was not found in this package
 
810
 
 
811
-- | Cache that remembers where we found a particular module.  Contains both
 
812
-- home modules and package modules.  On @:load@, only home modules are
 
813
-- purged from this cache.
 
814
type ModLocationCache = ModuleEnv ModLocation
 
815
\end{code}
 
816
 
 
817
%************************************************************************
 
818
%*                                                                      *
 
819
\subsection{Symbol tables and Module details}
 
820
%*                                                                      *
 
821
%************************************************************************
 
822
 
 
823
\begin{code}
 
824
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know 
 
825
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
 
826
-- and can be written out to an interface file. The 'ModDetails is after 
 
827
-- linking and can be completely recovered from just the 'ModIface'.
 
828
-- 
 
829
-- When we read an interface file, we also construct a 'ModIface' from it,
 
830
-- except that we explicitly make the 'mi_decls' and a few other fields empty;
 
831
-- as when reading we consolidate the declarations etc. into a number of indexed
 
832
-- maps and environments in the 'ExternalPackageState'.
 
833
data ModIface 
 
834
   = ModIface {
 
835
        mi_module   :: !Module,             -- ^ Name of the module we are for
 
836
        mi_iface_hash :: !Fingerprint,      -- ^ Hash of the whole interface
 
837
        mi_mod_hash :: !Fingerprint,        -- ^ Hash of the ABI only
 
838
 
 
839
        mi_orphan   :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
 
840
        mi_finsts   :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
 
841
        mi_boot     :: !IsBootInterface,    -- ^ Read from an hi-boot file?
 
842
 
 
843
        mi_deps     :: Dependencies,
 
844
                -- ^ The dependencies of the module.  This is
 
845
                -- consulted for directly-imported modules, but not
 
846
                -- for anything else (hence lazy)
 
847
 
 
848
        mi_usages   :: [Usage],
 
849
                -- ^ Usages; kept sorted so that it's easy to decide
 
850
                -- whether to write a new iface file (changing usages
 
851
                -- doesn't affect the hash of this module)
 
852
        
 
853
                -- NOT STRICT!  we read this field lazily from the interface file
 
854
                -- It is *only* consulted by the recompilation checker
 
855
 
 
856
                -- Exports
 
857
                -- Kept sorted by (mod,occ), to make version comparisons easier
 
858
        mi_exports  :: ![IfaceExport],
 
859
                -- ^ Records the modules that are the declaration points for things
 
860
                -- exported by this module, and the 'OccName's of those things
 
861
        
 
862
        mi_exp_hash :: !Fingerprint,    -- ^ Hash of export list
 
863
 
 
864
        mi_fixities :: [(OccName,Fixity)],
 
865
                -- ^ Fixities
 
866
        
 
867
                -- NOT STRICT!  we read this field lazily from the interface file
 
868
 
 
869
        mi_warns  :: Warnings,
 
870
                -- ^ Warnings
 
871
                
 
872
                -- NOT STRICT!  we read this field lazily from the interface file
 
873
 
 
874
        mi_anns  :: [IfaceAnnotation],
 
875
                -- ^ Annotations
 
876
        
 
877
                -- NOT STRICT!  we read this field lazily from the interface file
 
878
 
 
879
                -- Type, class and variable declarations
 
880
                -- The hash of an Id changes if its fixity or deprecations change
 
881
                --      (as well as its type of course)
 
882
                -- Ditto data constructors, class operations, except that 
 
883
                -- the hash of the parent class/tycon changes
 
884
        mi_decls :: [(Fingerprint,IfaceDecl)],  -- ^ Sorted type, variable, class etc. declarations
 
885
 
 
886
        mi_globals  :: !(Maybe GlobalRdrEnv),
 
887
                -- ^ Binds all the things defined at the top level in
 
888
                -- the /original source/ code for this module. which
 
889
                -- is NOT the same as mi_exports, nor mi_decls (which
 
890
                -- may contains declarations for things not actually
 
891
                -- defined by the user).  Used for GHCi and for inspecting
 
892
                -- the contents of modules via the GHC API only.
 
893
                --
 
894
                -- (We need the source file to figure out the
 
895
                -- top-level environment, if we didn't compile this module
 
896
                -- from source then this field contains @Nothing@).
 
897
                --
 
898
                -- Strictly speaking this field should live in the
 
899
                -- 'HomeModInfo', but that leads to more plumbing.
 
900
 
 
901
                -- Instance declarations and rules
 
902
        mi_insts     :: [IfaceInst],                    -- ^ Sorted class instance
 
903
        mi_fam_insts :: [IfaceFamInst],                 -- ^ Sorted family instances
 
904
        mi_rules     :: [IfaceRule],                    -- ^ Sorted rules
 
905
        mi_orphan_hash :: !Fingerprint, -- ^ Hash for orphan rules and 
 
906
                                        -- class and family instances
 
907
                                        -- combined
 
908
 
 
909
        mi_vect_info :: !IfaceVectInfo, -- ^ Vectorisation information
 
910
 
 
911
                -- Cached environments for easy lookup
 
912
                -- These are computed (lazily) from other fields
 
913
                -- and are not put into the interface file
 
914
        mi_warn_fn  :: Name -> Maybe WarningTxt,        -- ^ Cached lookup for 'mi_warns'
 
915
        mi_fix_fn  :: OccName -> Fixity,                -- ^ Cached lookup for 'mi_fixities'
 
916
        mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
 
917
                        -- ^ Cached lookup for 'mi_decls'.
 
918
                        -- The @Nothing@ in 'mi_hash_fn' means that the thing
 
919
                        -- isn't in decls. It's useful to know that when
 
920
                        -- seeing if we are up to date wrt. the old interface.
 
921
                        -- The 'OccName' is the parent of the name, if it has one.
 
922
        mi_hpc    :: !AnyHpcUsage
 
923
                -- ^ True if this program uses Hpc at any point in the program.
 
924
     }
 
925
 
 
926
-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
 
927
-- for home modules only. Information relating to packages will be loaded into
 
928
-- global environments in 'ExternalPackageState'.
 
929
data ModDetails
 
930
   = ModDetails {
 
931
        -- The next two fields are created by the typechecker
 
932
        md_exports   :: [AvailInfo],
 
933
        md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module
 
934
        md_insts     :: ![Instance],    -- ^ 'DFunId's for the instances in this module
 
935
        md_fam_insts :: ![FamInst],
 
936
        md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules
 
937
        md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently 
 
938
                                        -- they only annotate things also declared in this module
 
939
        md_vect_info :: !VectInfo       -- ^ Module vectorisation information
 
940
     }
 
941
 
 
942
emptyModDetails :: ModDetails
 
943
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
 
944
                               md_exports = [],
 
945
                               md_insts     = [],
 
946
                               md_rules     = [],
 
947
                               md_fam_insts = [],
 
948
                               md_anns      = [],
 
949
                               md_vect_info = noVectInfo
 
950
                             } 
 
951
 
 
952
-- | Records the modules directly imported by a module for extracting e.g. usage information
 
953
type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
 
954
-- TODO: we are not actually using the codomain of this type at all, so it can be
 
955
-- replaced with ModuleEnv ()
 
956
 
 
957
-- | A ModGuts is carried through the compiler, accumulating stuff as it goes
 
958
-- There is only one ModGuts at any time, the one for the module
 
959
-- being compiled right now.  Once it is compiled, a 'ModIface' and 
 
960
-- 'ModDetails' are extracted and the ModGuts is dicarded.
 
961
data ModGuts
 
962
  = ModGuts {
 
963
        mg_module    :: !Module,         -- ^ Module being compiled
 
964
        mg_boot      :: IsBootInterface, -- ^ Whether it's an hs-boot module
 
965
        mg_exports   :: ![AvailInfo],    -- ^ What it exports
 
966
        mg_deps      :: !Dependencies,   -- ^ What it depends on, directly or
 
967
                                         -- otherwise
 
968
        mg_dir_imps  :: !ImportedMods,   -- ^ Directly-imported modules; used to
 
969
                                         -- generate initialisation code
 
970
        mg_used_names:: !NameSet,        -- ^ What the module needed (used in 'MkIface.mkIface')
 
971
 
 
972
        mg_rdr_env   :: !GlobalRdrEnv,   -- ^ Top-level lexical environment
 
973
 
 
974
        -- These fields all describe the things **declared in this module**
 
975
        mg_fix_env   :: !FixityEnv,      -- ^ Fixities declared in this module
 
976
                                         -- TODO: I'm unconvinced this is actually used anywhere
 
977
        mg_types     :: !TypeEnv,        -- ^ Types declared in this module
 
978
        mg_insts     :: ![Instance],     -- ^ Class instances declared in this module
 
979
        mg_fam_insts :: ![FamInst],      -- ^ Family instances declared in this module
 
980
        mg_rules     :: ![CoreRule],     -- ^ Before the core pipeline starts, contains 
 
981
                                         -- See Note [Overall plumbing for rules] in Rules.lhs
 
982
        mg_binds     :: ![CoreBind],     -- ^ Bindings for this module
 
983
        mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module
 
984
        mg_warns     :: !Warnings,       -- ^ Warnings declared in the module
 
985
        mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
 
986
        mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
 
987
        mg_modBreaks :: !ModBreaks,      -- ^ Breakpoints for the module
 
988
        mg_vect_info :: !VectInfo,       -- ^ Pool of vectorised declarations in the module
 
989
 
 
990
        -- The next two fields are unusual, because they give instance
 
991
        -- environments for *all* modules in the home package, including
 
992
        -- this module, rather than for *just* this module.  
 
993
        -- Reason: when looking up an instance we don't want to have to
 
994
        --        look at each module in the home package in turn
 
995
        mg_inst_env     :: InstEnv,
 
996
        -- ^ Class instance environment from /home-package/ modules (including
 
997
        -- this one); c.f. 'tcg_inst_env'
 
998
        mg_fam_inst_env :: FamInstEnv
 
999
        -- ^ Type-family instance enviroment for /home-package/ modules
 
1000
        -- (including this one); c.f. 'tcg_fam_inst_env'
 
1001
    }
 
1002
 
 
1003
-- The ModGuts takes on several slightly different forms:
 
1004
--
 
1005
-- After simplification, the following fields change slightly:
 
1006
--      mg_rules        Orphan rules only (local ones now attached to binds)
 
1007
--      mg_binds        With rules attached
 
1008
 
 
1009
-- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
 
1010
-- the 'GHC.compileToCoreModule' interface.
 
1011
data CoreModule
 
1012
  = CoreModule {
 
1013
      -- | Module name
 
1014
      cm_module   :: !Module,
 
1015
      -- | Type environment for types declared in this module
 
1016
      cm_types    :: !TypeEnv,
 
1017
      -- | Declarations
 
1018
      cm_binds    :: [CoreBind],
 
1019
      -- | Imports
 
1020
      cm_imports  :: ![Module]
 
1021
    }
 
1022
 
 
1023
instance Outputable CoreModule where
 
1024
   ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
 
1025
      text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
 
1026
 
 
1027
-- The ModGuts takes on several slightly different forms:
 
1028
--
 
1029
-- After simplification, the following fields change slightly:
 
1030
--      mg_rules        Orphan rules only (local ones now attached to binds)
 
1031
--      mg_binds        With rules attached
 
1032
 
 
1033
 
 
1034
---------------------------------------------------------
 
1035
-- The Tidy pass forks the information about this module: 
 
1036
--      * one lot goes to interface file generation (ModIface)
 
1037
--        and later compilations (ModDetails)
 
1038
--      * the other lot goes to code generation (CgGuts)
 
1039
 
 
1040
-- | A restricted form of 'ModGuts' for code generation purposes
 
1041
data CgGuts 
 
1042
  = CgGuts {
 
1043
        cg_module   :: !Module, -- ^ Module being compiled
 
1044
 
 
1045
        cg_tycons   :: [TyCon],
 
1046
                -- ^ Algebraic data types (including ones that started
 
1047
                -- life as classes); generate constructors and info
 
1048
                -- tables. Includes newtypes, just for the benefit of
 
1049
                -- External Core
 
1050
 
 
1051
        cg_binds    :: [CoreBind],
 
1052
                -- ^ The tidied main bindings, including
 
1053
                -- previously-implicit bindings for record and class
 
1054
                -- selectors, and data construtor wrappers.  But *not*
 
1055
                -- data constructor workers; reason: we we regard them
 
1056
                -- as part of the code-gen of tycons
 
1057
 
 
1058
        cg_dir_imps :: ![Module],
 
1059
                -- ^ Directly-imported modules; used to generate
 
1060
                -- initialisation code
 
1061
 
 
1062
        cg_foreign  :: !ForeignStubs,   -- ^ Foreign export stubs
 
1063
        cg_dep_pkgs :: ![PackageId],    -- ^ Dependent packages, used to 
 
1064
                                        -- generate #includes for C code gen
 
1065
        cg_hpc_info :: !HpcInfo,        -- ^ Program coverage tick box information
 
1066
        cg_modBreaks :: !ModBreaks      -- ^ Module breakpoints
 
1067
    }
 
1068
 
 
1069
-----------------------------------
 
1070
-- | Foreign export stubs
 
1071
data ForeignStubs = NoStubs             -- ^ We don't have any stubs
 
1072
                  | ForeignStubs
 
1073
                        SDoc            
 
1074
                        SDoc            
 
1075
                   -- ^ There are some stubs. Parameters:
 
1076
                   --
 
1077
                   --  1) Header file prototypes for
 
1078
                   --     "foreign exported" functions
 
1079
                   --
 
1080
                   --  2) C stubs to use when calling
 
1081
                   --     "foreign exported" functions
 
1082
\end{code}
 
1083
 
 
1084
\begin{code}
 
1085
emptyModIface :: Module -> ModIface
 
1086
emptyModIface mod
 
1087
  = ModIface { mi_module   = mod,
 
1088
               mi_iface_hash = fingerprint0,
 
1089
               mi_mod_hash = fingerprint0,
 
1090
               mi_orphan   = False,
 
1091
               mi_finsts   = False,
 
1092
               mi_boot     = False,
 
1093
               mi_deps     = noDependencies,
 
1094
               mi_usages   = [],
 
1095
               mi_exports  = [],
 
1096
               mi_exp_hash = fingerprint0,
 
1097
               mi_fixities = [],
 
1098
               mi_warns    = NoWarnings,
 
1099
               mi_anns     = [],
 
1100
               mi_insts     = [],
 
1101
               mi_fam_insts = [],
 
1102
               mi_rules     = [],
 
1103
               mi_decls     = [],
 
1104
               mi_globals   = Nothing,
 
1105
               mi_orphan_hash = fingerprint0,
 
1106
               mi_vect_info = noIfaceVectInfo,
 
1107
               mi_warn_fn    = emptyIfaceWarnCache,
 
1108
               mi_fix_fn    = emptyIfaceFixCache,
 
1109
               mi_hash_fn   = emptyIfaceHashCache,
 
1110
               mi_hpc       = False
 
1111
    }           
 
1112
\end{code}
 
1113
 
 
1114
 
 
1115
%************************************************************************
 
1116
%*                                                                      *
 
1117
\subsection{The interactive context}
 
1118
%*                                                                      *
 
1119
%************************************************************************
 
1120
 
 
1121
\begin{code}
 
1122
-- | Interactive context, recording information relevant to GHCi
 
1123
data InteractiveContext 
 
1124
  = InteractiveContext { 
 
1125
        ic_toplev_scope :: [Module],    -- ^ The context includes the "top-level" scope of
 
1126
                                        -- these modules
 
1127
 
 
1128
        ic_exports :: [(Module, Maybe (ImportDecl RdrName))],           -- ^ The context includes just the exported parts of these
 
1129
                                        -- modules
 
1130
 
 
1131
        ic_rn_gbl_env :: GlobalRdrEnv,  -- ^ The contexts' cached 'GlobalRdrEnv', built from
 
1132
                                        -- 'ic_toplev_scope' and 'ic_exports'
 
1133
 
 
1134
        ic_tmp_ids :: [Id]              -- ^ Names bound during interaction with the user.
 
1135
                                        -- Later Ids shadow earlier ones with the same OccName.
 
1136
 
 
1137
#ifdef GHCI
 
1138
        , ic_resume :: [Resume]         -- ^ The stack of breakpoint contexts
 
1139
#endif
 
1140
 
 
1141
        , ic_cwd :: Maybe FilePath      -- virtual CWD of the program
 
1142
    }
 
1143
 
 
1144
 
 
1145
emptyInteractiveContext :: InteractiveContext
 
1146
emptyInteractiveContext
 
1147
  = InteractiveContext { ic_toplev_scope = [],
 
1148
                         ic_exports = [],
 
1149
                         ic_rn_gbl_env = emptyGlobalRdrEnv,
 
1150
                         ic_tmp_ids = []
 
1151
#ifdef GHCI
 
1152
                         , ic_resume = []
 
1153
#endif
 
1154
                         , ic_cwd = Nothing
 
1155
                       }
 
1156
 
 
1157
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
 
1158
icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)
 
1159
 
 
1160
 
 
1161
extendInteractiveContext
 
1162
        :: InteractiveContext
 
1163
        -> [Id]
 
1164
        -> InteractiveContext
 
1165
extendInteractiveContext ictxt ids
 
1166
  = ictxt { ic_tmp_ids =  snub ((ic_tmp_ids ictxt \\ ids) ++ ids)
 
1167
                          -- NB. must be this way around, because we want
 
1168
                          -- new ids to shadow existing bindings.
 
1169
          }
 
1170
    where snub = map head . group . sort
 
1171
 
 
1172
substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
 
1173
substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
 
1174
substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst 
 
1175
  = ictxt { ic_tmp_ids = map subst_ty ids }
 
1176
  where
 
1177
   subst_ty id = id `setIdType` substTy subst (idType id)
 
1178
\end{code}
 
1179
 
 
1180
%************************************************************************
 
1181
%*                                                                      *
 
1182
        Building a PrintUnqualified             
 
1183
%*                                                                      *
 
1184
%************************************************************************
 
1185
 
 
1186
Note [Printing original names]
 
1187
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
1188
Deciding how to print names is pretty tricky.  We are given a name
 
1189
P:M.T, where P is the package name, M is the defining module, and T is
 
1190
the occurrence name, and we have to decide in which form to display
 
1191
the name given a GlobalRdrEnv describing the current scope.
 
1192
 
 
1193
Ideally we want to display the name in the form in which it is in
 
1194
scope.  However, the name might not be in scope at all, and that's
 
1195
where it gets tricky.  Here are the cases:
 
1196
 
 
1197
 1. T uniquely maps to  P:M.T      --->  "T"      NameUnqual
 
1198
 2. There is an X for which X.T 
 
1199
       uniquely maps to  P:M.T     --->  "X.T"    NameQual X
 
1200
 3. There is no binding for "M.T"  --->  "M.T"    NameNotInScope1
 
1201
 4. Otherwise                      --->  "P:M.T"  NameNotInScope2
 
1202
 
 
1203
(3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at
 
1204
all. In these cases we still want to refer to the name as "M.T", *but*
 
1205
"M.T" might mean something else in the current scope (e.g. if there's
 
1206
an "import X as M"), so to avoid confusion we avoid using "M.T" if
 
1207
there's already a binding for it.  Instead we write P:M.T.
 
1208
 
 
1209
There's one further subtlety: in case (3), what if there are two
 
1210
things around, P1:M.T and P2:M.T?  Then we don't want to print both of
 
1211
them as M.T!  However only one of the modules P1:M and P2:M can be
 
1212
exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
 
1213
This is handled by the qual_mod component of PrintUnqualified, inside
 
1214
the (ppr mod) of case (3), in Name.pprModulePrefix
 
1215
 
 
1216
\begin{code}
 
1217
-- | Creates some functions that work out the best ways to format
 
1218
-- names for the user according to a set of heuristics
 
1219
mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
 
1220
mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
1221
  where
 
1222
  qual_name mod occ     -- The (mod,occ) pair is the original name of the thing
 
1223
        | [gre] <- unqual_gres, right_name gre = NameUnqual
 
1224
                -- If there's a unique entity that's in scope unqualified with 'occ'
 
1225
                -- AND that entity is the right one, then we can use the unqualified name
 
1226
 
 
1227
        | [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre))
 
1228
 
 
1229
        | null qual_gres = 
 
1230
              if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
 
1231
                   then NameNotInScope1
 
1232
                   else NameNotInScope2
 
1233
 
 
1234
        | otherwise = panic "mkPrintUnqualified"
 
1235
      where
 
1236
        right_name gre = nameModule_maybe (gre_name gre) == Just mod
 
1237
 
 
1238
        unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
 
1239
        qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
 
1240
 
 
1241
        get_qual_mod LocalDef      = moduleName mod
 
1242
        get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
 
1243
 
 
1244
    -- we can mention a module P:M without the P: qualifier iff
 
1245
    -- "import M" would resolve unambiguously to P:M.  (if P is the
 
1246
    -- current package we can just assume it is unqualified).
 
1247
 
 
1248
  qual_mod mod
 
1249
     | modulePackageId mod == thisPackage dflags = False
 
1250
 
 
1251
     | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup, 
 
1252
                             exposed pkg && exposed_module],
 
1253
       packageConfigId pkgconfig == modulePackageId mod
 
1254
        -- this says: we are given a module P:M, is there just one exposed package
 
1255
        -- that exposes a module M, and is it package P?
 
1256
     = False
 
1257
 
 
1258
     | otherwise = True
 
1259
     where lookup = lookupModuleInAllPackages dflags (moduleName mod)
 
1260
\end{code}
 
1261
 
 
1262
 
 
1263
%************************************************************************
 
1264
%*                                                                      *
 
1265
                TyThing
 
1266
%*                                                                      *
 
1267
%************************************************************************
 
1268
 
 
1269
\begin{code}
 
1270
-- | Determine the 'TyThing's brought into scope by another 'TyThing'
 
1271
-- /other/ than itself. For example, Id's don't have any implicit TyThings
 
1272
-- as they just bring themselves into scope, but classes bring their
 
1273
-- dictionary datatype, type constructor and some selector functions into
 
1274
-- scope, just for a start!
 
1275
 
 
1276
-- N.B. the set of TyThings returned here *must* match the set of
 
1277
-- names returned by LoadIface.ifaceDeclSubBndrs, in the sense that
 
1278
-- TyThing.getOccName should define a bijection between the two lists.
 
1279
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 
1280
-- The order of the list does not matter.
 
1281
implicitTyThings :: TyThing -> [TyThing]
 
1282
 
 
1283
-- For data and newtype declarations:
 
1284
implicitTyThings (ATyCon tc)
 
1285
  =   -- fields (names of selectors)
 
1286
      -- (possibly) implicit coercion and family coercion
 
1287
      --   depending on whether it's a newtype or a family instance or both
 
1288
    implicitCoTyCon tc ++
 
1289
      -- for each data constructor in order,
 
1290
      --   the contructor, worker, and (possibly) wrapper
 
1291
    concatMap (extras_plus . ADataCon) (tyConDataCons tc)
 
1292
                     
 
1293
implicitTyThings (AClass cl) 
 
1294
  = -- dictionary datatype:
 
1295
    --    [extras_plus:]
 
1296
    --      type constructor 
 
1297
    --    [recursive call:]
 
1298
    --      (possibly) newtype coercion; definitely no family coercion here
 
1299
    --      data constructor
 
1300
    --      worker
 
1301
    --      (no wrapper by invariant)
 
1302
    extras_plus (ATyCon (classTyCon cl)) ++
 
1303
    -- associated types 
 
1304
    --    No extras_plus (recursive call) for the classATs, because they
 
1305
    --    are only the family decls; they have no implicit things
 
1306
    map ATyCon (classATs cl) ++
 
1307
    -- superclass and operation selectors
 
1308
    map AnId (classAllSelIds cl)
 
1309
 
 
1310
implicitTyThings (ADataCon dc) = 
 
1311
    -- For data cons add the worker and (possibly) wrapper
 
1312
    map AnId (dataConImplicitIds dc)
 
1313
 
 
1314
implicitTyThings (AnId _)   = []
 
1315
 
 
1316
-- add a thing and recursive call
 
1317
extras_plus :: TyThing -> [TyThing]
 
1318
extras_plus thing = thing : implicitTyThings thing
 
1319
 
 
1320
-- For newtypes and indexed data types (and both),
 
1321
-- add the implicit coercion tycon
 
1322
implicitCoTyCon :: TyCon -> [TyThing]
 
1323
implicitCoTyCon tc 
 
1324
  = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
 
1325
                              newTyConCo_maybe tc, 
 
1326
                              -- Just if family instance, Nothing if not
 
1327
                                tyConFamilyCoercion_maybe tc] 
 
1328
 
 
1329
-- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)
 
1330
 
 
1331
 
 
1332
-- | Returns @True@ if there should be no interface-file declaration
 
1333
-- for this thing on its own: either it is built-in, or it is part
 
1334
-- of some other declaration, or it is generated implicitly by some
 
1335
-- other declaration.
 
1336
isImplicitTyThing :: TyThing -> Bool
 
1337
isImplicitTyThing (ADataCon _)  = True
 
1338
isImplicitTyThing (AnId     id) = isImplicitId id
 
1339
isImplicitTyThing (AClass   _)  = False
 
1340
isImplicitTyThing (ATyCon   tc) = isImplicitTyCon tc
 
1341
 
 
1342
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
 
1343
extendTypeEnvWithIds env ids
 
1344
  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
 
1345
\end{code}
 
1346
 
 
1347
%************************************************************************
 
1348
%*                                                                      *
 
1349
                TypeEnv
 
1350
%*                                                                      *
 
1351
%************************************************************************
 
1352
 
 
1353
\begin{code}
 
1354
-- | A map from 'Name's to 'TyThing's, constructed by typechecking
 
1355
-- local declarations or interface files
 
1356
type TypeEnv = NameEnv TyThing
 
1357
 
 
1358
emptyTypeEnv    :: TypeEnv
 
1359
typeEnvElts     :: TypeEnv -> [TyThing]
 
1360
typeEnvClasses  :: TypeEnv -> [Class]
 
1361
typeEnvTyCons   :: TypeEnv -> [TyCon]
 
1362
typeEnvIds      :: TypeEnv -> [Id]
 
1363
typeEnvDataCons :: TypeEnv -> [DataCon]
 
1364
lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing
 
1365
 
 
1366
emptyTypeEnv        = emptyNameEnv
 
1367
typeEnvElts     env = nameEnvElts env
 
1368
typeEnvClasses  env = [cl | AClass cl   <- typeEnvElts env]
 
1369
typeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env] 
 
1370
typeEnvIds      env = [id | AnId id     <- typeEnvElts env] 
 
1371
typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env] 
 
1372
 
 
1373
mkTypeEnv :: [TyThing] -> TypeEnv
 
1374
mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
 
1375
                
 
1376
lookupTypeEnv = lookupNameEnv
 
1377
 
 
1378
-- Extend the type environment
 
1379
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
 
1380
extendTypeEnv env thing = extendNameEnv env (getName thing) thing 
 
1381
 
 
1382
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
 
1383
extendTypeEnvList env things = foldl extendTypeEnv env things
 
1384
\end{code}
 
1385
 
 
1386
\begin{code}
 
1387
-- | Find the 'TyThing' for the given 'Name' by using all the resources
 
1388
-- at our disposal: the compiled modules in the 'HomePackageTable' and the
 
1389
-- compiled modules in other packages that live in 'PackageTypeEnv'. Note
 
1390
-- that this does NOT look up the 'TyThing' in the module being compiled: you
 
1391
-- have to do that yourself, if desired
 
1392
lookupType :: DynFlags
 
1393
           -> HomePackageTable
 
1394
           -> PackageTypeEnv
 
1395
           -> Name
 
1396
           -> Maybe TyThing
 
1397
 
 
1398
lookupType dflags hpt pte name
 
1399
  -- in one-shot, we don't use the HPT
 
1400
  | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg 
 
1401
  = do hm <- lookupUFM hpt (moduleName mod) -- Maybe monad
 
1402
       lookupNameEnv (md_types (hm_details hm)) name
 
1403
  | otherwise
 
1404
  = lookupNameEnv pte name
 
1405
  where mod = ASSERT( isExternalName name ) nameModule name
 
1406
        this_pkg = thisPackage dflags
 
1407
 
 
1408
-- | As 'lookupType', but with a marginally easier-to-use interface
 
1409
-- if you have a 'HscEnv'
 
1410
lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
 
1411
lookupTypeHscEnv hsc_env name = do
 
1412
    eps <- readIORef (hsc_EPS hsc_env)
 
1413
    return $! lookupType dflags hpt (eps_PTE eps) name
 
1414
  where 
 
1415
    dflags = hsc_dflags hsc_env
 
1416
    hpt = hsc_HPT hsc_env
 
1417
\end{code}
 
1418
 
 
1419
\begin{code}
 
1420
-- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
 
1421
tyThingTyCon :: TyThing -> TyCon
 
1422
tyThingTyCon (ATyCon tc) = tc
 
1423
tyThingTyCon other       = pprPanic "tyThingTyCon" (pprTyThing other)
 
1424
 
 
1425
-- | Get the 'Class' from a 'TyThing' if it is a class thing. Panics otherwise
 
1426
tyThingClass :: TyThing -> Class
 
1427
tyThingClass (AClass cls) = cls
 
1428
tyThingClass other        = pprPanic "tyThingClass" (pprTyThing other)
 
1429
 
 
1430
-- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise
 
1431
tyThingDataCon :: TyThing -> DataCon
 
1432
tyThingDataCon (ADataCon dc) = dc
 
1433
tyThingDataCon other         = pprPanic "tyThingDataCon" (pprTyThing other)
 
1434
 
 
1435
-- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
 
1436
tyThingId :: TyThing -> Id
 
1437
tyThingId (AnId id)     = id
 
1438
tyThingId (ADataCon dc) = dataConWrapId dc
 
1439
tyThingId other         = pprPanic "tyThingId" (pprTyThing other)
 
1440
\end{code}
 
1441
 
 
1442
%************************************************************************
 
1443
%*                                                                      *
 
1444
\subsection{MonadThings and friends}
 
1445
%*                                                                      *
 
1446
%************************************************************************
 
1447
 
 
1448
\begin{code}
 
1449
-- | Class that abstracts out the common ability of the monads in GHC
 
1450
-- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides
 
1451
-- a number of related convenience functions for accessing particular
 
1452
-- kinds of 'TyThing'
 
1453
class Monad m => MonadThings m where
 
1454
        lookupThing :: Name -> m TyThing
 
1455
 
 
1456
        lookupId :: Name -> m Id
 
1457
        lookupId = liftM tyThingId . lookupThing
 
1458
 
 
1459
        lookupDataCon :: Name -> m DataCon
 
1460
        lookupDataCon = liftM tyThingDataCon . lookupThing
 
1461
 
 
1462
        lookupTyCon :: Name -> m TyCon
 
1463
        lookupTyCon = liftM tyThingTyCon . lookupThing
 
1464
 
 
1465
        lookupClass :: Name -> m Class
 
1466
        lookupClass = liftM tyThingClass . lookupThing
 
1467
\end{code}
 
1468
 
 
1469
\begin{code}
 
1470
-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
 
1471
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
 
1472
                 -> (OccName -> Maybe (OccName, Fingerprint))
 
1473
mkIfaceHashCache pairs 
 
1474
  = \occ -> lookupOccEnv env occ
 
1475
  where
 
1476
    env = foldr add_decl emptyOccEnv pairs
 
1477
    add_decl (v,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
 
1478
      where
 
1479
          decl_name = ifName d
 
1480
          env1 = extendOccEnv env0 decl_name (decl_name, v)
 
1481
          add_imp bndr env = extendOccEnv env bndr (decl_name, v)
 
1482
 
 
1483
emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
 
1484
emptyIfaceHashCache _occ = Nothing
 
1485
\end{code}
 
1486
 
 
1487
%************************************************************************
 
1488
%*                                                                      *
 
1489
\subsection{Auxiliary types}
 
1490
%*                                                                      *
 
1491
%************************************************************************
 
1492
 
 
1493
These types are defined here because they are mentioned in ModDetails,
 
1494
but they are mostly elaborated elsewhere
 
1495
 
 
1496
\begin{code}
 
1497
------------------ Warnings -------------------------
 
1498
-- | Warning information for a module
 
1499
data Warnings
 
1500
  = NoWarnings                          -- ^ Nothing deprecated
 
1501
  | WarnAll WarningTxt                  -- ^ Whole module deprecated
 
1502
  | WarnSome [(OccName,WarningTxt)]     -- ^ Some specific things deprecated
 
1503
 
 
1504
     -- Only an OccName is needed because
 
1505
     --    (1) a deprecation always applies to a binding
 
1506
     --        defined in the module in which the deprecation appears.
 
1507
     --    (2) deprecations are only reported outside the defining module.
 
1508
     --        this is important because, otherwise, if we saw something like
 
1509
     --
 
1510
     --        {-# DEPRECATED f "" #-}
 
1511
     --        f = ...
 
1512
     --        h = f
 
1513
     --        g = let f = undefined in f
 
1514
     --
 
1515
     --        we'd need more information than an OccName to know to say something
 
1516
     --        about the use of f in h but not the use of the locally bound f in g
 
1517
     --
 
1518
     --        however, because we only report about deprecations from the outside,
 
1519
     --        and a module can only export one value called f,
 
1520
     --        an OccName suffices.
 
1521
     --
 
1522
     --        this is in contrast with fixity declarations, where we need to map
 
1523
     --        a Name to its fixity declaration.
 
1524
  deriving( Eq )
 
1525
 
 
1526
-- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'
 
1527
mkIfaceWarnCache :: Warnings -> Name -> Maybe WarningTxt
 
1528
mkIfaceWarnCache NoWarnings  = \_ -> Nothing
 
1529
mkIfaceWarnCache (WarnAll t) = \_ -> Just t
 
1530
mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
 
1531
 
 
1532
emptyIfaceWarnCache :: Name -> Maybe WarningTxt
 
1533
emptyIfaceWarnCache _ = Nothing
 
1534
 
 
1535
plusWarns :: Warnings -> Warnings -> Warnings
 
1536
plusWarns d NoWarnings = d
 
1537
plusWarns NoWarnings d = d
 
1538
plusWarns _ (WarnAll t) = WarnAll t
 
1539
plusWarns (WarnAll t) _ = WarnAll t
 
1540
plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
 
1541
\end{code}
 
1542
\begin{code}
 
1543
-- | A collection of 'AvailInfo' - several things that are \"available\"
 
1544
type Avails       = [AvailInfo]
 
1545
-- | 'Name'd things that are available
 
1546
type AvailInfo    = GenAvailInfo Name
 
1547
-- | 'RdrName'd things that are available
 
1548
type RdrAvailInfo = GenAvailInfo OccName
 
1549
 
 
1550
-- | Records what things are "available", i.e. in scope
 
1551
data GenAvailInfo name  = Avail name     -- ^ An ordinary identifier in scope
 
1552
                        | AvailTC name
 
1553
                                  [name] -- ^ A type or class in scope. Parameters:
 
1554
                                         --
 
1555
                                         --  1) The name of the type or class
 
1556
                                         --
 
1557
                                         --  2) The available pieces of type or class.
 
1558
                                         --     NB: If the type or class is itself
 
1559
                                         --     to be in scope, it must be in this list.
 
1560
                                         --     Thus, typically: @AvailTC Eq [Eq, ==, \/=]@
 
1561
                        deriving( Eq )
 
1562
                        -- Equality used when deciding if the interface has changed
 
1563
 
 
1564
-- | The original names declared of a certain module that are exported
 
1565
type IfaceExport = (Module, [GenAvailInfo OccName])
 
1566
 
 
1567
availsToNameSet :: [AvailInfo] -> NameSet
 
1568
availsToNameSet avails = foldr add emptyNameSet avails
 
1569
      where add avail set = addListToNameSet set (availNames avail)
 
1570
 
 
1571
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
 
1572
availsToNameEnv avails = foldr add emptyNameEnv avails
 
1573
     where add avail env = extendNameEnvList env
 
1574
                                (zip (availNames avail) (repeat avail))
 
1575
 
 
1576
-- | Just the main name made available, i.e. not the available pieces
 
1577
-- of type or class brought into scope by the 'GenAvailInfo'
 
1578
availName :: GenAvailInfo name -> name
 
1579
availName (Avail n)     = n
 
1580
availName (AvailTC n _) = n
 
1581
 
 
1582
-- | All names made available by the availability information
 
1583
availNames :: GenAvailInfo name -> [name]
 
1584
availNames (Avail n)      = [n]
 
1585
availNames (AvailTC _ ns) = ns
 
1586
 
 
1587
instance Outputable n => Outputable (GenAvailInfo n) where
 
1588
   ppr = pprAvail
 
1589
 
 
1590
pprAvail :: Outputable n => GenAvailInfo n -> SDoc
 
1591
pprAvail (Avail n)      = ppr n
 
1592
pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
 
1593
\end{code}
 
1594
 
 
1595
\begin{code}
 
1596
-- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'
 
1597
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
 
1598
mkIfaceFixCache pairs 
 
1599
  = \n -> lookupOccEnv env n `orElse` defaultFixity
 
1600
  where
 
1601
   env = mkOccEnv pairs
 
1602
 
 
1603
emptyIfaceFixCache :: OccName -> Fixity
 
1604
emptyIfaceFixCache _ = defaultFixity
 
1605
 
 
1606
-- | Fixity environment mapping names to their fixities
 
1607
type FixityEnv = NameEnv FixItem
 
1608
 
 
1609
-- | Fixity information for an 'Name'. We keep the OccName in the range 
 
1610
-- so that we can generate an interface from it
 
1611
data FixItem = FixItem OccName Fixity
 
1612
 
 
1613
instance Outputable FixItem where
 
1614
  ppr (FixItem occ fix) = ppr fix <+> ppr occ
 
1615
 
 
1616
emptyFixityEnv :: FixityEnv
 
1617
emptyFixityEnv = emptyNameEnv
 
1618
 
 
1619
lookupFixity :: FixityEnv -> Name -> Fixity
 
1620
lookupFixity env n = case lookupNameEnv env n of
 
1621
                        Just (FixItem _ fix) -> fix
 
1622
                        Nothing         -> defaultFixity
 
1623
\end{code}
 
1624
 
 
1625
 
 
1626
%************************************************************************
 
1627
%*                                                                      *
 
1628
\subsection{WhatsImported}
 
1629
%*                                                                      *
 
1630
%************************************************************************
 
1631
 
 
1632
\begin{code}
 
1633
-- | Records whether a module has orphans. An \"orphan\" is one of:
 
1634
--
 
1635
-- * An instance declaration in a module other than the definition
 
1636
--   module for one of the type constructors or classes in the instance head
 
1637
--
 
1638
-- * A transformation rule in a module other than the one defining
 
1639
--   the function in the head of the rule
 
1640
type WhetherHasOrphans   = Bool
 
1641
 
 
1642
-- | Does this module define family instances?
 
1643
type WhetherHasFamInst = Bool
 
1644
 
 
1645
-- | Did this module originate from a *-boot file?
 
1646
type IsBootInterface = Bool
 
1647
 
 
1648
-- | Dependency information about modules and packages below this one
 
1649
-- in the import hierarchy.
 
1650
--
 
1651
-- Invariant: the dependencies of a module @M@ never includes @M@.
 
1652
--
 
1653
-- Invariant: none of the lists contain duplicates.
 
1654
data Dependencies
 
1655
  = Deps { dep_mods   :: [(ModuleName, IsBootInterface)]
 
1656
                        -- ^ Home-package module dependencies
 
1657
         , dep_pkgs   :: [PackageId]
 
1658
                        -- ^ External package dependencies
 
1659
         , dep_orphs  :: [Module]           
 
1660
                        -- ^ Orphan modules (whether home or external pkg),
 
1661
                        -- *not* including family instance orphans as they
 
1662
                        -- are anyway included in 'dep_finsts'
 
1663
         , dep_finsts :: [Module]           
 
1664
                        -- ^ Modules that contain family instances (whether the
 
1665
                        -- instances are from the home or an external package)
 
1666
         }
 
1667
  deriving( Eq )
 
1668
        -- Equality used only for old/new comparison in MkIface.addVersionInfo
 
1669
 
 
1670
        -- See 'TcRnTypes.ImportAvails' for details on dependencies.
 
1671
 
 
1672
noDependencies :: Dependencies
 
1673
noDependencies = Deps [] [] [] []
 
1674
 
 
1675
-- | Records modules that we depend on by making a direct import from
 
1676
data Usage
 
1677
  = UsagePackageModule {
 
1678
        usg_mod      :: Module,
 
1679
           -- ^ External package module depended on
 
1680
        usg_mod_hash :: Fingerprint
 
1681
    }                                           -- ^ Module from another package
 
1682
  | UsageHomeModule {
 
1683
        usg_mod_name :: ModuleName,
 
1684
            -- ^ Name of the module
 
1685
        usg_mod_hash :: Fingerprint,
 
1686
            -- ^ Cached module fingerprint
 
1687
        usg_entities :: [(OccName,Fingerprint)],
 
1688
            -- ^ Entities we depend on, sorted by occurrence name and fingerprinted.
 
1689
            -- NB: usages are for parent names only, e.g. type constructors 
 
1690
            -- but not the associated data constructors.
 
1691
        usg_exports  :: Maybe Fingerprint
 
1692
            -- ^ Fingerprint for the export list we used to depend on this module,
 
1693
            -- if we depend on the export list
 
1694
    }                                           -- ^ Module from the current package
 
1695
    deriving( Eq )
 
1696
        -- The export list field is (Just v) if we depend on the export list:
 
1697
        --      i.e. we imported the module directly, whether or not we
 
1698
        --           enumerated the things we imported, or just imported 
 
1699
        --           everything
 
1700
        -- We need to recompile if M's exports change, because 
 
1701
        -- if the import was    import M,       we might now have a name clash
 
1702
        --                                      in the importing module.
 
1703
        -- if the import was    import M(x)     M might no longer export x
 
1704
        -- The only way we don't depend on the export list is if we have
 
1705
        --                      import M()
 
1706
        -- And of course, for modules that aren't imported directly we don't
 
1707
        -- depend on their export lists
 
1708
\end{code}
 
1709
 
 
1710
 
 
1711
%************************************************************************
 
1712
%*                                                                      *
 
1713
                The External Package State
 
1714
%*                                                                      *
 
1715
%************************************************************************
 
1716
 
 
1717
\begin{code}
 
1718
type PackageTypeEnv    = TypeEnv
 
1719
type PackageRuleBase   = RuleBase
 
1720
type PackageInstEnv    = InstEnv
 
1721
type PackageFamInstEnv = FamInstEnv
 
1722
type PackageVectInfo   = VectInfo
 
1723
type PackageAnnEnv     = AnnEnv
 
1724
 
 
1725
-- | Information about other packages that we have slurped in by reading
 
1726
-- their interface files
 
1727
data ExternalPackageState
 
1728
  = EPS {
 
1729
        eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),
 
1730
                -- ^ In OneShot mode (only), home-package modules
 
1731
                -- accumulate in the external package state, and are
 
1732
                -- sucked in lazily.  For these home-pkg modules
 
1733
                -- (only) we need to record which are boot modules.
 
1734
                -- We set this field after loading all the
 
1735
                -- explicitly-imported interfaces, but before doing
 
1736
                -- anything else
 
1737
                --
 
1738
                -- The 'ModuleName' part is not necessary, but it's useful for
 
1739
                -- debug prints, and it's convenient because this field comes
 
1740
                -- direct from 'TcRnTypes.imp_dep_mods'
 
1741
 
 
1742
        eps_PIT :: !PackageIfaceTable,
 
1743
                -- ^ The 'ModIface's for modules in external packages
 
1744
                -- whose interfaces we have opened.
 
1745
                -- The declarations in these interface files are held in the
 
1746
                -- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'
 
1747
                -- fields of this record, not in the 'mi_decls' fields of the 
 
1748
                -- interface we have sucked in.
 
1749
                --
 
1750
                -- What /is/ in the PIT is:
 
1751
                --
 
1752
                -- * The Module
 
1753
                --
 
1754
                -- * Fingerprint info
 
1755
                --
 
1756
                -- * Its exports
 
1757
                --
 
1758
                -- * Fixities
 
1759
                --
 
1760
                -- * Deprecations and warnings
 
1761
 
 
1762
        eps_PTE :: !PackageTypeEnv,        
 
1763
                -- ^ Result of typechecking all the external package
 
1764
                -- interface files we have sucked in. The domain of
 
1765
                -- the mapping is external-package modules
 
1766
                
 
1767
        eps_inst_env     :: !PackageInstEnv,   -- ^ The total 'InstEnv' accumulated
 
1768
                                               -- from all the external-package modules
 
1769
        eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated
 
1770
                                               -- from all the external-package modules
 
1771
        eps_rule_base    :: !PackageRuleBase,  -- ^ The total 'RuleEnv' accumulated
 
1772
                                               -- from all the external-package modules
 
1773
        eps_vect_info    :: !PackageVectInfo,  -- ^ The total 'VectInfo' accumulated
 
1774
                                               -- from all the external-package modules
 
1775
        eps_ann_env      :: !PackageAnnEnv,    -- ^ The total 'AnnEnv' accumulated
 
1776
                                               -- from all the external-package modules
 
1777
 
 
1778
        eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external
 
1779
                                                         -- packages, keyed off the module that declared them
 
1780
 
 
1781
        eps_stats :: !EpsStats                 -- ^ Stastics about what was loaded from external packages
 
1782
  }
 
1783
 
 
1784
-- | Accumulated statistics about what we are putting into the 'ExternalPackageState'.
 
1785
-- \"In\" means stuff that is just /read/ from interface files,
 
1786
-- \"Out\" means actually sucked in and type-checked
 
1787
data EpsStats = EpsStats { n_ifaces_in
 
1788
                         , n_decls_in, n_decls_out 
 
1789
                         , n_rules_in, n_rules_out
 
1790
                         , n_insts_in, n_insts_out :: !Int }
 
1791
 
 
1792
addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
 
1793
-- ^ Add stats for one newly-read interface
 
1794
addEpsInStats stats n_decls n_insts n_rules
 
1795
  = stats { n_ifaces_in = n_ifaces_in stats + 1
 
1796
          , n_decls_in  = n_decls_in stats + n_decls
 
1797
          , n_insts_in  = n_insts_in stats + n_insts
 
1798
          , n_rules_in  = n_rules_in stats + n_rules }
 
1799
\end{code}
 
1800
 
 
1801
Names in a NameCache are always stored as a Global, and have the SrcLoc 
 
1802
of their binding locations.
 
1803
 
 
1804
Actually that's not quite right.  When we first encounter the original
 
1805
name, we might not be at its binding site (e.g. we are reading an
 
1806
interface file); so we give it 'noSrcLoc' then.  Later, when we find
 
1807
its binding site, we fix it up.
 
1808
 
 
1809
\begin{code}
 
1810
-- | The NameCache makes sure that there is just one Unique assigned for
 
1811
-- each original name; i.e. (module-name, occ-name) pair and provides
 
1812
-- something of a lookup mechanism for those names.
 
1813
data NameCache
 
1814
 = NameCache {  nsUniqs :: UniqSupply,
 
1815
                -- ^ Supply of uniques
 
1816
                nsNames :: OrigNameCache,
 
1817
                -- ^ Ensures that one original name gets one unique
 
1818
                nsIPs   :: OrigIParamCache
 
1819
                -- ^ Ensures that one implicit parameter name gets one unique
 
1820
   }
 
1821
 
 
1822
-- | Per-module cache of original 'OccName's given 'Name's
 
1823
type OrigNameCache   = ModuleEnv (OccEnv Name)
 
1824
 
 
1825
-- | Module-local cache of implicit parameter 'OccName's given 'Name's
 
1826
type OrigIParamCache = Map (IPName OccName) (IPName Name)
 
1827
\end{code}
 
1828
 
 
1829
 
 
1830
 
 
1831
%************************************************************************
 
1832
%*                                                                      *
 
1833
                The module graph and ModSummary type
 
1834
        A ModSummary is a node in the compilation manager's
 
1835
        dependency graph, and it's also passed to hscMain
 
1836
%*                                                                      *
 
1837
%************************************************************************
 
1838
 
 
1839
\begin{code}
 
1840
-- | A ModuleGraph contains all the nodes from the home package (only).
 
1841
-- There will be a node for each source module, plus a node for each hi-boot
 
1842
-- module.
 
1843
--
 
1844
-- The graph is not necessarily stored in topologically-sorted order.  Use
 
1845
-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.
 
1846
type ModuleGraph = [ModSummary]
 
1847
 
 
1848
emptyMG :: ModuleGraph
 
1849
emptyMG = []
 
1850
 
 
1851
-- | A single node in a 'ModuleGraph. The nodes of the module graph are one of:
 
1852
--
 
1853
-- * A regular Haskell source module
 
1854
--
 
1855
-- * A hi-boot source module
 
1856
--
 
1857
-- * An external-core source module
 
1858
data ModSummary
 
1859
   = ModSummary {
 
1860
        ms_mod       :: Module,                 -- ^ Identity of the module
 
1861
        ms_hsc_src   :: HscSource,              -- ^ The module source either plain Haskell, hs-boot or external core
 
1862
        ms_location  :: ModLocation,            -- ^ Location of the various files belonging to the module
 
1863
        ms_hs_date   :: ClockTime,              -- ^ Timestamp of source file
 
1864
        ms_obj_date  :: Maybe ClockTime,        -- ^ Timestamp of object, if we have one
 
1865
        ms_srcimps   :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module
 
1866
        ms_imps      :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module
 
1867
        ms_hspp_file :: FilePath,               -- ^ Filename of preprocessed source file
 
1868
        ms_hspp_opts :: DynFlags,               -- ^ Cached flags from @OPTIONS@, @INCLUDE@
 
1869
                                                -- and @LANGUAGE@ pragmas in the modules source code
 
1870
        ms_hspp_buf  :: Maybe StringBuffer      -- ^ The actual preprocessed source, if we have it
 
1871
     }
 
1872
 
 
1873
ms_mod_name :: ModSummary -> ModuleName
 
1874
ms_mod_name = moduleName . ms_mod
 
1875
 
 
1876
-- The ModLocation contains both the original source filename and the
 
1877
-- filename of the cleaned-up source file after all preprocessing has been
 
1878
-- done.  The point is that the summariser will have to cpp/unlit/whatever
 
1879
-- all files anyway, and there's no point in doing this twice -- just 
 
1880
-- park the result in a temp file, put the name of it in the location,
 
1881
-- and let @compile@ read from that file on the way back up.
 
1882
 
 
1883
-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
 
1884
-- the ms_hs_date and imports can, of course, change
 
1885
 
 
1886
msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
 
1887
msHsFilePath  ms = expectJust "msHsFilePath" (ml_hs_file  (ms_location ms))
 
1888
msHiFilePath  ms = ml_hi_file  (ms_location ms)
 
1889
msObjFilePath ms = ml_obj_file (ms_location ms)
 
1890
 
 
1891
-- | Did this 'ModSummary' originate from a hs-boot file?
 
1892
isBootSummary :: ModSummary -> Bool
 
1893
isBootSummary ms = isHsBoot (ms_hsc_src ms)
 
1894
 
 
1895
instance Outputable ModSummary where
 
1896
   ppr ms
 
1897
      = sep [text "ModSummary {",
 
1898
             nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
 
1899
                          text "ms_mod =" <+> ppr (ms_mod ms) 
 
1900
                                <> text (hscSourceString (ms_hsc_src ms)) <> comma,
 
1901
                          text "ms_imps =" <+> ppr (ms_imps ms),
 
1902
                          text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
 
1903
             char '}'
 
1904
            ]
 
1905
 
 
1906
showModMsg :: HscTarget -> Bool -> ModSummary -> String
 
1907
showModMsg target recomp mod_summary
 
1908
  = showSDoc $
 
1909
        hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
 
1910
              char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
 
1911
              case target of
 
1912
                  HscInterpreted | recomp 
 
1913
                             -> text "interpreted"
 
1914
                  HscNothing -> text "nothing"
 
1915
                  _          -> text (normalise $ msObjFilePath mod_summary),
 
1916
              char ')']
 
1917
 where 
 
1918
    mod     = moduleName (ms_mod mod_summary)
 
1919
    mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
 
1920
\end{code}
 
1921
 
 
1922
 
 
1923
%************************************************************************
 
1924
%*                                                                      *
 
1925
\subsection{Hpc Support}
 
1926
%*                                                                      *
 
1927
%************************************************************************
 
1928
 
 
1929
\begin{code}
 
1930
-- | Information about a modules use of Haskell Program Coverage
 
1931
data HpcInfo
 
1932
  = HpcInfo 
 
1933
     { hpcInfoTickCount :: Int
 
1934
     , hpcInfoHash      :: Int
 
1935
     }
 
1936
  | NoHpcInfo 
 
1937
     { hpcUsed          :: AnyHpcUsage  -- ^ Is hpc used anywhere on the module \*tree\*?
 
1938
     }
 
1939
 
 
1940
-- | This is used to signal if one of my imports used HPC instrumentation
 
1941
-- even if there is no module-local HPC usage
 
1942
type AnyHpcUsage = Bool
 
1943
 
 
1944
emptyHpcInfo :: AnyHpcUsage -> HpcInfo
 
1945
emptyHpcInfo = NoHpcInfo 
 
1946
 
 
1947
-- | Find out if HPC is used by this module or any of the modules
 
1948
-- it depends upon
 
1949
isHpcUsed :: HpcInfo -> AnyHpcUsage
 
1950
isHpcUsed (HpcInfo {})                   = True
 
1951
isHpcUsed (NoHpcInfo { hpcUsed = used }) = used
 
1952
\end{code}
 
1953
 
 
1954
%************************************************************************
 
1955
%*                                                                      *
 
1956
\subsection{Vectorisation Support}
 
1957
%*                                                                      *
 
1958
%************************************************************************
 
1959
 
 
1960
The following information is generated and consumed by the vectorisation
 
1961
subsystem.  It communicates the vectorisation status of declarations from one
 
1962
module to another.
 
1963
 
 
1964
Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo
 
1965
below?  We need to know `f' when converting to IfaceVectInfo.  However, during
 
1966
vectorisation, we need to know `f_v', whose `Var' we cannot lookup based
 
1967
on just the OccName easily in a Core pass.
 
1968
 
 
1969
\begin{code}
 
1970
-- | Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'.
 
1971
data VectInfo      
 
1972
  = VectInfo {
 
1973
      vectInfoVar     :: VarEnv  (Var    , Var  ),   -- ^ @(f, f_v)@ keyed on @f@
 
1974
      vectInfoTyCon   :: NameEnv (TyCon  , TyCon),   -- ^ @(T, T_v)@ keyed on @T@
 
1975
      vectInfoDataCon :: NameEnv (DataCon, DataCon), -- ^ @(C, C_v)@ keyed on @C@
 
1976
      vectInfoPADFun  :: NameEnv (TyCon  , Var),     -- ^ @(T_v, paT)@ keyed on @T_v@
 
1977
      vectInfoIso     :: NameEnv (TyCon  , Var)      -- ^ @(T, isoT)@ keyed on @T@
 
1978
    }
 
1979
 
 
1980
-- | Vectorisation information for 'ModIface': a slightly less low-level view
 
1981
data IfaceVectInfo 
 
1982
  = IfaceVectInfo {
 
1983
      ifaceVectInfoVar        :: [Name],
 
1984
        -- ^ All variables in here have a vectorised variant
 
1985
      ifaceVectInfoTyCon      :: [Name],
 
1986
        -- ^ All 'TyCon's in here have a vectorised variant;
 
1987
        -- the name of the vectorised variant and those of its
 
1988
        -- data constructors are determined by 'OccName.mkVectTyConOcc'
 
1989
        -- and 'OccName.mkVectDataConOcc'; the names of
 
1990
        -- the isomorphisms are determined by 'OccName.mkVectIsoOcc'
 
1991
      ifaceVectInfoTyConReuse :: [Name]              
 
1992
        -- ^ The vectorised form of all the 'TyCon's in here coincides with
 
1993
        -- the unconverted form; the name of the isomorphisms is determined
 
1994
        -- by 'OccName.mkVectIsoOcc'
 
1995
    }
 
1996
 
 
1997
noVectInfo :: VectInfo
 
1998
noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
 
1999
 
 
2000
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 
2001
plusVectInfo vi1 vi2 = 
 
2002
  VectInfo (vectInfoVar     vi1 `plusVarEnv`  vectInfoVar     vi2)
 
2003
           (vectInfoTyCon   vi1 `plusNameEnv` vectInfoTyCon   vi2)
 
2004
           (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
 
2005
           (vectInfoPADFun  vi1 `plusNameEnv` vectInfoPADFun  vi2)
 
2006
           (vectInfoIso     vi1 `plusNameEnv` vectInfoIso     vi2)
 
2007
 
 
2008
concatVectInfo :: [VectInfo] -> VectInfo
 
2009
concatVectInfo = foldr plusVectInfo noVectInfo
 
2010
 
 
2011
noIfaceVectInfo :: IfaceVectInfo
 
2012
noIfaceVectInfo = IfaceVectInfo [] [] []
 
2013
\end{code}
 
2014
 
 
2015
%************************************************************************
 
2016
%*                                                                      *
 
2017
\subsection{Linkable stuff}
 
2018
%*                                                                      *
 
2019
%************************************************************************
 
2020
 
 
2021
This stuff is in here, rather than (say) in Linker.lhs, because the Linker.lhs
 
2022
stuff is the *dynamic* linker, and isn't present in a stage-1 compiler
 
2023
 
 
2024
\begin{code}
 
2025
-- | Information we can use to dynamically link modules into the compiler
 
2026
data Linkable = LM {
 
2027
  linkableTime     :: ClockTime,        -- ^ Time at which this linkable was built
 
2028
                                        -- (i.e. when the bytecodes were produced,
 
2029
                                        --       or the mod date on the files)
 
2030
  linkableModule   :: Module,           -- ^ The linkable module itself
 
2031
  linkableUnlinked :: [Unlinked]
 
2032
    -- ^ Those files and chunks of code we have yet to link.
 
2033
    --
 
2034
    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.
 
2035
    -- If this list is empty, the Linkable represents a fake linkable, which
 
2036
    -- is generated in HscNothing mode to avoid recompiling modules.
 
2037
    --
 
2038
    -- XXX: Do items get removed from this list when they get linked?
 
2039
 }
 
2040
 
 
2041
isObjectLinkable :: Linkable -> Bool
 
2042
isObjectLinkable l = not (null unlinked) && all isObject unlinked
 
2043
  where unlinked = linkableUnlinked l
 
2044
        -- A linkable with no Unlinked's is treated as a BCO.  We can
 
2045
        -- generate a linkable with no Unlinked's as a result of
 
2046
        -- compiling a module in HscNothing mode, and this choice
 
2047
        -- happens to work well with checkStability in module GHC.
 
2048
 
 
2049
instance Outputable Linkable where
 
2050
   ppr (LM when_made mod unlinkeds)
 
2051
      = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
 
2052
        $$ nest 3 (ppr unlinkeds)
 
2053
 
 
2054
-------------------------------------------
 
2055
 
 
2056
-- | Objects which have yet to be linked by the compiler
 
2057
data Unlinked
 
2058
   = DotO FilePath      -- ^ An object file (.o)
 
2059
   | DotA FilePath      -- ^ Static archive file (.a)
 
2060
   | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)
 
2061
   | BCOs CompiledByteCode ModBreaks    -- ^ A byte-code object, lives only in memory
 
2062
 
 
2063
#ifndef GHCI
 
2064
data CompiledByteCode = CompiledByteCodeUndefined
 
2065
_unused :: CompiledByteCode
 
2066
_unused = CompiledByteCodeUndefined
 
2067
#endif
 
2068
 
 
2069
instance Outputable Unlinked where
 
2070
   ppr (DotO path)   = text "DotO" <+> text path
 
2071
   ppr (DotA path)   = text "DotA" <+> text path
 
2072
   ppr (DotDLL path) = text "DotDLL" <+> text path
 
2073
#ifdef GHCI
 
2074
   ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
 
2075
#else
 
2076
   ppr (BCOs _ _)    = text "No byte code"
 
2077
#endif
 
2078
 
 
2079
-- | Is this an actual file on disk we can link in somehow?
 
2080
isObject :: Unlinked -> Bool
 
2081
isObject (DotO _)   = True
 
2082
isObject (DotA _)   = True
 
2083
isObject (DotDLL _) = True
 
2084
isObject _          = False
 
2085
 
 
2086
-- | Is this a bytecode linkable with no file on disk?
 
2087
isInterpretable :: Unlinked -> Bool
 
2088
isInterpretable = not . isObject
 
2089
 
 
2090
-- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object
 
2091
nameOfObject :: Unlinked -> FilePath
 
2092
nameOfObject (DotO fn)   = fn
 
2093
nameOfObject (DotA fn)   = fn
 
2094
nameOfObject (DotDLL fn) = fn
 
2095
nameOfObject other       = pprPanic "nameOfObject" (ppr other)
 
2096
 
 
2097
-- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable
 
2098
byteCodeOfObject :: Unlinked -> CompiledByteCode
 
2099
byteCodeOfObject (BCOs bc _) = bc
 
2100
byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)
 
2101
\end{code}
 
2102
 
 
2103
%************************************************************************
 
2104
%*                                                                      *
 
2105
\subsection{Breakpoint Support}
 
2106
%*                                                                      *
 
2107
%************************************************************************
 
2108
 
 
2109
\begin{code}
 
2110
-- | Breakpoint index
 
2111
type BreakIndex = Int
 
2112
 
 
2113
-- | All the information about the breakpoints for a given module
 
2114
data ModBreaks
 
2115
   = ModBreaks
 
2116
   { modBreaks_flags :: BreakArray
 
2117
        -- ^ The array of flags, one per breakpoint, 
 
2118
        -- indicating which breakpoints are enabled.
 
2119
   , modBreaks_locs :: !(Array BreakIndex SrcSpan)
 
2120
        -- ^ An array giving the source span of each breakpoint.
 
2121
   , modBreaks_vars :: !(Array BreakIndex [OccName])
 
2122
        -- ^ An array giving the names of the free variables at each breakpoint.
 
2123
   }
 
2124
 
 
2125
emptyModBreaks :: ModBreaks
 
2126
emptyModBreaks = ModBreaks
 
2127
   { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
 
2128
         -- Todo: can we avoid this? 
 
2129
   , modBreaks_locs = array (0,-1) []
 
2130
   , modBreaks_vars = array (0,-1) []
 
2131
   }
 
2132
\end{code}