LoadIface.lhs 34.1 KB
Newer Older
Simon Marlow's avatar
Simon Marlow committed
1 2
%
% (c) The University of Glasgow 2006
3 4
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
Simon Marlow's avatar
Simon Marlow committed
5 6

Loading interface files
7 8

\begin{code}
9
{-# OPTIONS_GHC -fno-warn-orphans #-}
10
module LoadIface (
11 12 13 14 15
        -- RnM/TcM functions
        loadModuleInterface, loadModuleInterfaces, 
        loadSrcInterface, loadInterfaceForName, 

        -- IfM functions
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
16 17 18 19 20
        loadInterface, loadWiredInHomeIface, 
        loadSysInterface, loadUserInterface, 
        findAndReadIface, readIface,    -- Used when reading the module's old interface
        loadDecls,      -- Should move to TcIface and be renamed
        initExternalPackageState,
21

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
22
        ifaceStats, pprModIface, showIface
23 24 25 26
   ) where

#include "HsVersions.h"

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
27 28
import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, 
                                 tcIfaceFamInst, tcIfaceVectInfo, tcIfaceAnnotations )
29

Simon Marlow's avatar
Simon Marlow committed
30
import DynFlags
31
import IfaceSyn
Simon Marlow's avatar
Simon Marlow committed
32 33 34 35
import IfaceEnv
import HscTypes

import BasicTypes hiding (SuccessFlag(..))
36
import TcRnMonad
Simon Marlow's avatar
Simon Marlow committed
37

Ian Lynagh's avatar
Ian Lynagh committed
38
import Constants
Simon Marlow's avatar
Simon Marlow committed
39 40
import PrelNames
import PrelInfo
41
import PrimOp   ( allThePrimOps, primOpFixity, primOpOcc )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
42
import MkId     ( seqId )
Simon Marlow's avatar
Simon Marlow committed
43
import Rules
44
import Annotations
Simon Marlow's avatar
Simon Marlow committed
45 46 47
import InstEnv
import FamInstEnv
import Name
48
import NameEnv
49
import Avail
Simon Marlow's avatar
Simon Marlow committed
50
import Module
Simon Marlow's avatar
Simon Marlow committed
51 52 53
import Maybes
import ErrUtils
import Finder
54
import UniqFM
55
import SrcLoc
56
import Outputable
Simon Marlow's avatar
Simon Marlow committed
57 58
import BinIface
import Panic
Ian Lynagh's avatar
Ian Lynagh committed
59
import Util
60
import FastString
61
import Fingerprint
Simon Marlow's avatar
Simon Marlow committed
62

Ian Lynagh's avatar
Ian Lynagh committed
63
import Control.Monad
64 65 66 67
\end{code}


%************************************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
68
%*                                                                      *
69
        loadSrcInterface, loadOrphanModules, loadInterfaceForName
70

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
71 72
                These three are called from TcM-land    
%*                                                                      *
73 74 75
%************************************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
76 77
-- | Load the interface corresponding to an @import@ directive in 
-- source code.  On a failure, fail in the monad with an error message.
78 79 80 81 82 83 84
loadSrcInterface :: SDoc
                 -> ModuleName
                 -> IsBootInterface     -- {-# SOURCE #-} ?
                 -> Maybe FastString    -- "package", if any
                 -> RnM ModIface

loadSrcInterface doc mod want_boot maybe_pkg  = do
Simon Marlow's avatar
Simon Marlow committed
85 86 87 88 89 90
  -- We must first find which Module this import refers to.  This involves
  -- calling the Finder, which as a side effect will search the filesystem
  -- and create a ModLocation.  If successful, loadIface will read the
  -- interface; it will call the Finder again, but the ModLocation will be
  -- cached from the first search.
  hsc_env <- getTopEnv
91
  res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
Simon Marlow's avatar
Simon Marlow committed
92 93 94 95
  case res of
    Found _ mod -> do
      mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
      case mb_iface of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
96 97
        Failed err      -> failWithTc err
        Succeeded iface -> return iface
Simon Marlow's avatar
Simon Marlow committed
98 99
    err ->
        let dflags = hsc_dflags hsc_env in
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
100
        failWithTc (cannotFindInterface dflags mod err)
101

102 103 104 105 106 107 108
-- | Load interface for a module.
loadModuleInterface :: SDoc -> Module -> TcM ModIface
loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod)

-- | Load interfaces for a collection of modules.
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces doc mods
109
  | null mods = return ()
110
  | otherwise = initIfaceTcRn (mapM_ load mods)
111
  where
112
    load mod = loadSysInterface (doc <+> parens (ppr mod)) mod
113

Simon Marlow's avatar
Simon Marlow committed
114 115 116
-- | Loads the interface for a given Name.
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
loadInterfaceForName doc name
Ian Lynagh's avatar
Ian Lynagh committed
117 118 119 120 121 122
  = do { 
    when debugIsOn $ do
        -- Should not be called with a name from the module being compiled
        { this_mod <- getModule
        ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
        }
123 124
  ; ASSERT2( isExternalName name, ppr name ) 
    initIfaceTcRn $ loadSysInterface doc (nameModule name)
Ian Lynagh's avatar
Ian Lynagh committed
125
  }
126 127 128 129
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
130 131
%*                                                      *
                loadInterface
132

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
133 134 135 136
        The main function to load an interface
        for an imported module, and put it in
        the External Package State
%*                                                      *
137
%*********************************************************
138

139
\begin{code}
Simon Marlow's avatar
Simon Marlow committed
140
-- | An 'IfM' function to load the home interface for a wired-in thing,
141
-- so that we're sure that we see its instance declarations and rules
142
-- See Note [Loading instances for wired-in things] in TcIface
Simon Marlow's avatar
Simon Marlow committed
143
loadWiredInHomeIface :: Name -> IfM lcl ()
144 145
loadWiredInHomeIface name
  = ASSERT( isWiredInName name )
146
    do _ <- loadSysInterface doc (nameModule name); return ()
147
  where
Ian Lynagh's avatar
Ian Lynagh committed
148
    doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
149

150
------------------
151
-- | Loads a system interface and throws an exception if it fails
152
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
153 154
loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem

155
------------------
156 157 158
-- | Loads a user interface and throws an exception if it fails. The first parameter indicates
-- whether we should import the boot variant of the module
loadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface
159 160
loadUserInterface is_boot doc mod_name 
  = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
161

162
------------------
163 164 165
-- | A wrapper for 'loadInterface' that throws an exception if it fails
loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException doc mod_name where_from
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
166
  = do  { mb_iface <- loadInterface doc mod_name where_from
Ian Lynagh's avatar
Ian Lynagh committed
167
        ; dflags <- getDynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
168
        ; case mb_iface of 
Ian Lynagh's avatar
Ian Lynagh committed
169
            Failed err      -> ghcError (ProgramError (showSDoc dflags err))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
170
            Succeeded iface -> return iface }
171

172
------------------
Simon Marlow's avatar
Simon Marlow committed
173
loadInterface :: SDoc -> Module -> WhereFrom
174
              -> IfM lcl (MaybeErr MsgDoc ModIface)
175

176 177 178
-- loadInterface looks in both the HPT and PIT for the required interface
-- If not found, it loads it, and puts it in the PIT (always). 

179
-- If it can't find a suitable interface file, we
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
180 181 182
--      a) modify the PackageIfaceTable to have an empty entry
--              (to avoid repeated complaints)
--      b) return (Left message)
183 184 185
--
-- It's not necessarily an error for there not to be an interface
-- file -- perhaps the module has changed, and that interface 
186
-- is no longer used
187

188
loadInterface doc_str mod from
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
189 190 191 192 193 194
  = do  {       -- Read the state
          (eps,hpt) <- getEpsAndHpt

        ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)

                -- Check whether we have the interface already
195
        ; dflags <- getDynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
196 197 198 199 200 201 202 203 204 205
        ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
            Just iface 
                -> return (Succeeded iface) ;   -- Already loaded
                        -- The (src_imp == mi_boot iface) test checks that the already-loaded
                        -- interface isn't a boot iface.  This can conceivably happen,
                        -- if an earlier import had a before we got to real imports.   I think.
            _ -> do {

        -- READ THE MODULE IN
        ; read_result <- case (wantHiBootFile dflags eps mod from) of
206 207
                           Failed err             -> return (Failed err)
                           Succeeded hi_boot_file -> findAndReadIface doc_str mod hi_boot_file
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
        ; case read_result of {
            Failed err -> do
                { let fake_iface = emptyModIface mod

                ; updateEps_ $ \eps ->
                        eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
                        -- Not found, so add an empty iface to 
                        -- the EPS map so that we don't look again
                                
                ; return (Failed err) } ;

        -- Found and parsed!
        -- We used to have a sanity check here that looked for:
        --  * System importing ..
        --  * a home package module ..
        --  * that we know nothing about (mb_dep == Nothing)!
        --
        -- But this is no longer valid because thNameToGhcName allows users to
        -- cause the system to load arbitrary interfaces (by supplying an appropriate
        -- Template Haskell original-name).
            Succeeded (iface, file_path) ->

        let 
            loc_doc = text file_path
        in 
        initIfaceLcl mod loc_doc $ do

        --      Load the new ModIface into the External Package State
        -- Even home-package interfaces loaded by loadInterface 
        --      (which only happens in OneShot mode; in Batch/Interactive 
        --      mode, home-package modules are loaded one by one into the HPT)
        -- are put in the EPS.
        --
        -- The main thing is to add the ModIface to the PIT, but
        -- we also take the
243
        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, IfaceVectInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
244 245 246 247 248 249 250
        -- out of the ModIface and put them into the big EPS pools

        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
        ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
        --     If we do loadExport first the wrong info gets into the cache (unless we
        --      explicitly tag each export which seems a bit of a bore)

ian@well-typed.com's avatar
ian@well-typed.com committed
251
        ; ignore_prags      <- goptM Opt_IgnoreInterfacePragmas
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
252 253 254 255 256
        ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
        ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
        ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
        ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
        ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
257
        ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface)
258

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
259 260 261 262 263 264
        ; let { final_iface = iface {   
                                mi_decls     = panic "No mi_decls in PIT",
                                mi_insts     = panic "No mi_insts in PIT",
                                mi_fam_insts = panic "No mi_fam_insts in PIT",
                                mi_rules     = panic "No mi_rules in PIT",
                                mi_anns      = panic "No mi_anns in PIT"
265 266
                              }
               }
267

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
268
        ; updateEps_  $ \ eps -> 
269
           if elemModuleEnv mod (eps_PIT eps) then eps else
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
270 271 272 273 274 275 276 277 278
            eps { 
              eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
              eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
              eps_rule_base    = extendRuleBaseList (eps_rule_base eps) 
                                                    new_eps_rules,
              eps_inst_env     = extendInstEnvList (eps_inst_env eps)  
                                                   new_eps_insts,
              eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
                                                      new_eps_fam_insts,
279 280
              eps_vect_info    = plusVectInfo (eps_vect_info eps) 
                                              new_eps_vect_info,
281 282
              eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
                                                  new_eps_anns,
283
              eps_mod_fam_inst_env
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
284 285 286 287 288 289 290 291 292 293 294 295 296 297
                               = let
                                   fam_inst_env = 
                                     extendFamInstEnvList emptyFamInstEnv
                                                          new_eps_fam_insts
                                 in
                                 extendModuleEnv (eps_mod_fam_inst_env eps)
                                                 mod
                                                 fam_inst_env,
              eps_stats        = addEpsInStats (eps_stats eps) 
                                               (length new_eps_decls)
                                               (length new_eps_insts)
                                               (length new_eps_rules) }

        ; return (Succeeded final_iface)
298 299
    }}}}

300
wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
301
               -> MaybeErr MsgDoc IsBootInterface
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317
-- Figure out whether we want Foo.hi or Foo.hi-boot
wantHiBootFile dflags eps mod from
  = case from of
       ImportByUser usr_boot 
          | usr_boot && not this_package
          -> Failed (badSourceImport mod)
          | otherwise -> Succeeded usr_boot

       ImportBySystem
          | not this_package   -- If the module to be imported is not from this package
          -> Succeeded False   -- don't look it up in eps_is_boot, because that is keyed
                               -- on the ModuleName of *home-package* modules only. 
                               -- We never import boot modules from other packages!

          | otherwise
          -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
318 319 320 321
                Just (_, is_boot) -> Succeeded is_boot
                Nothing           -> Succeeded False
                     -- The boot-ness of the requested interface, 
                     -- based on the dependencies in directly-imported modules
322 323 324 325 326 327 328 329 330 331
  where
    this_package = thisPackage dflags == modulePackageId mod

badSourceImport :: Module -> SDoc
badSourceImport mod
  = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package"))
       2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
          <+> quotes (ppr (modulePackageId mod)))
\end{code}

332 333 334 335
{-
Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending
review of this decision by SPJ - MCB 10/2008

Ian Lynagh's avatar
Ian Lynagh committed
336
badDepMsg :: Module -> SDoc
337
badDepMsg mod 
Ian Lynagh's avatar
Ian Lynagh committed
338 339
  = hang (ptext (sLit "Interface file inconsistency:"))
       2 (sep [ptext (sLit "home-package module") <+> quotes (ppr mod) <+> ptext (sLit "is needed,"), 
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
340
               ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")])
341
-}
342

343
\begin{code}
344
-----------------------------------------------------
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
345
--      Loading type/class/value decls
346 347 348 349 350
-- We pass the full Module name here, replete with
-- its package info, so that we can build a Name for
-- each binder with the right package info in it
-- All subsequent lookups, including crucially lookups during typechecking
-- the declaration itself, will find the fully-glorious Name
351 352 353 354
--
-- We handle ATs specially.  They are not main declarations, but also not
-- implict things (in particular, adding them to `implicitTyThings' would mess
-- things up in the renaming/type checking of source programs).
355 356
-----------------------------------------------------

357 358 359 360
addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
addDeclsToPTE pte things = extendNameEnvList pte things

loadDecls :: Bool
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
361 362
          -> [(Fingerprint, IfaceDecl)]
          -> IfL [(Name,TyThing)]
363 364
loadDecls ignore_prags ver_decls
   = do { mod <- getIfModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
365 366 367 368 369 370 371 372 373
        ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
        ; return (concat thingss)
        }

loadDecl :: Bool                    -- Don't load pragmas into the decl pool
         -> Module
          -> (Fingerprint, IfaceDecl)
          -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
                                    -- TyThings are forkM'd thunks
374
loadDecl ignore_prags mod (_version, decl)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
375 376 377
  = do  {       -- Populate the name cache with final versions of all 
                -- the names associated with the decl
          main_name      <- lookupOrig mod (ifName decl)
378
--        ; traceIf (text "Loading decl for " <> ppr main_name)
379

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
380 381 382 383 384 385
        -- Typecheck the thing, lazily
        -- NB. Firstly, the laziness is there in case we never need the
        -- declaration (in one-shot mode), and secondly it is there so that 
        -- we don't look up the occurrence of a name before calling mk_new_bndr
        -- on the binder.  This is important because we must get the right name
        -- which includes its nameParent.
386

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
387 388
        ; thing <- forkM doc $ do { bumpDeclStats main_name
                                  ; tcIfaceDecl ignore_prags decl }
389

390 391 392 393 394 395 396 397 398
        -- Populate the type environment with the implicitTyThings too.
        -- 
        -- Note [Tricky iface loop]
        -- ~~~~~~~~~~~~~~~~~~~~~~~~
        -- Summary: The delicate point here is that 'mini-env' must be
        -- buildable from 'thing' without demanding any of the things
        -- 'forkM'd by tcIfaceDecl.
        --
        -- In more detail: Consider the example
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
399
        --      data T a = MkT { x :: T a }
400 401 402 403
        -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
        -- (plus their workers, wrappers, coercions etc etc)
        -- 
        -- We want to return an environment 
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
404
        --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
405 406 407
        -- (where the "MkT" is the *Name* associated with MkT, etc.)
        --
        -- We do this by mapping the implict_names to the associated
408
        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443
        -- implicitTyThings, we can use getOccName on the implicit
        -- TyThings to make this association: each Name's OccName should
        -- be the OccName of exactly one implictTyThing.  So the key is
        -- to define a "mini-env"
        --
        -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
        -- where the 'MkT' here is the *OccName* associated with MkT.
        --
        -- However, there is a subtlety: due to how type checking needs
        -- to be staged, we can't poke on the forkM'd thunks inside the
        -- implictTyThings while building this mini-env.  
        -- If we poke these thunks too early, two problems could happen:
        --    (1) When processing mutually recursive modules across
        --        hs-boot boundaries, poking too early will do the
        --        type-checking before the recursive knot has been tied,
        --        so things will be type-checked in the wrong
        --        environment, and necessary variables won't be in
        --        scope.
        --        
        --    (2) Looking up one OccName in the mini_env will cause
        --        others to be looked up, which might cause that
        --        original one to be looked up again, and hence loop.
        --
        -- The code below works because of the following invariant:
        -- getOccName on a TyThing does not force the suspended type
        -- checks in order to extract the name. For example, we don't
        -- poke on the "T a" type of <selector x> on the way to
        -- extracting <selector x>'s OccName. Of course, there is no
        -- reason in principle why getting the OccName should force the
        -- thunks, but this means we need to be careful in
        -- implicitTyThings and its helper functions.
        --
        -- All a bit too finely-balanced for my liking.

        -- This mini-env and lookup function mediates between the
Thomas Schilling's avatar
Thomas Schilling committed
444
        --'Name's n and the map from 'OccName's to the implicit TyThings
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
445 446 447 448 449
        ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
              lookup n = case lookupOccEnv mini_env (getOccName n) of
                           Just thing -> thing
                           Nothing    -> 
                             pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
450

451
        ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
452
        ; return $ (main_name, thing) :
453 454 455
                      -- uses the invariant that implicit_names and
                      -- implictTyThings are bijective
                      [(n, lookup n) | n <- implicit_names]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
456
        }
457
  where
Ian Lynagh's avatar
Ian Lynagh committed
458
    doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
459

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
460
bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
461
bumpDeclStats name
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
462 463 464 465
  = do  { traceIf (text "Loading decl for" <+> ppr name)
        ; updateEps_ (\eps -> let stats = eps_stats eps
                              in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
        }
466 467 468 469
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
470
%*                                                      *
471
\subsection{Reading an interface file}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
472
%*                                                      *
473 474 475
%*********************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
476
findAndReadIface :: SDoc -> Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
477 478
                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                        -- False <=> Look for .hi file
479
                 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
480 481
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
482

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
483 484
        -- It *doesn't* add an error to the monad, because 
        -- sometimes it's ok to fail... see notes with loadInterface
485

Simon Marlow's avatar
Simon Marlow committed
486
findAndReadIface doc_str mod hi_boot_file
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
487 488 489 490 491 492 493 494 495
  = do  { traceIf (sep [hsep [ptext (sLit "Reading"), 
                              if hi_boot_file 
                                then ptext (sLit "[boot]") 
                                else empty,
                              ptext (sLit "interface for"), 
                              ppr mod <> semi],
                        nest 4 (ptext (sLit "reason:") <+> doc_str)])

        -- Check for GHC.Prim, and return its static interface
496
        ; dflags <- getDynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
497 498 499 500 501 502 503 504 505
        ; if mod == gHC_PRIM
          then return (Succeeded (ghcPrimIface,
                                   "<built in interface for GHC.Prim>"))
          else do

        -- Look for the file
        ; hsc_env <- getTopEnv
        ; mb_found <- liftIO (findExactModule hsc_env mod)
        ; case mb_found of {
Simon Marlow's avatar
Simon Marlow committed
506
              
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
507
              Found loc mod -> do 
508

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
509 510
        -- Found file, so read it
        { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
Simon Marlow's avatar
Simon Marlow committed
511

512 513 514
        -- If the interface is in the current package then if we could
        -- load it would already be in the HPT and we assume that our
        -- callers checked that.
Simon Marlow's avatar
Simon Marlow committed
515 516
        ; if thisPackage dflags == modulePackageId mod
                && not (isOneShot (ghcMode dflags))
517
            then return (Failed (homeModError mod loc))
Simon Marlow's avatar
Simon Marlow committed
518 519
            else do {

Ian Lynagh's avatar
Ian Lynagh committed
520
        ; traceIf (ptext (sLit "readIFace") <+> text file_path)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
521 522 523 524 525 526 527 528 529 530 531 532
        ; read_result <- readIface mod file_path hi_boot_file
        ; case read_result of
            Failed err -> return (Failed (badIfaceFile file_path err))
            Succeeded iface 
                | mi_module iface /= mod ->
                  return (Failed (wrongIfaceModErr iface mod file_path))
                | otherwise ->
                  return (Succeeded (iface, file_path))
                        -- Don't forget to fill in the package name...
        }}
            ; err -> do
                { traceIf (ptext (sLit "...not found"))
533
                ; dflags <- getDynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
534 535
                ; return (Failed (cannotFindInterface dflags 
                                        (moduleName mod) err)) }
Ian Lynagh's avatar
Ian Lynagh committed
536 537
        }
        }
538 539 540 541 542
\end{code}

@readIface@ tries just the one file.

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
543
readIface :: Module -> FilePath -> IsBootInterface 
544
          -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
545 546
        -- Failed err    <=> file not found, or unreadable, or illegible
        -- Succeeded iface <=> successfully found and parsed 
547

Ian Lynagh's avatar
Ian Lynagh committed
548
readIface wanted_mod file_path _
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
549
  = do  { res <- tryMostM $
550
                 readBinIface CheckHiWay QuietBinIFaceReading file_path
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
551 552 553 554 555 556 557 558 559
        ; case res of
            Right iface 
                | wanted_mod == actual_mod -> return (Succeeded iface)
                | otherwise                -> return (Failed err)
                where
                  actual_mod = mi_module iface
                  err = hiModuleNameMismatchWarn wanted_mod actual_mod

            Left exn    -> return (Failed (text (showException exn)))
560
    }
561 562 563 564
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
565 566 567
%*                                                       *
        Wired-in interface for GHC.Prim
%*                                                       *
568 569 570 571 572 573
%*********************************************************

\begin{code}
initExternalPackageState :: ExternalPackageState
initExternalPackageState
  = EPS { 
574 575 576 577 578 579
      eps_is_boot      = emptyUFM,
      eps_PIT          = emptyPackageIfaceTable,
      eps_PTE          = emptyTypeEnv,
      eps_inst_env     = emptyInstEnv,
      eps_fam_inst_env = emptyFamInstEnv,
      eps_rule_base    = mkRuleBase builtinRules,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
580
        -- Initialise the EPS rule pool with the built-in rules
581 582
      eps_mod_fam_inst_env
                       = emptyModuleEnv,
583
      eps_vect_info    = noVectInfo,
584
      eps_ann_env      = emptyAnnEnv,
585
      eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
586 587
                           , n_insts_in = 0, n_insts_out = 0
                           , n_rules_in = length builtinRules, n_rules_out = 0 }
588 589 590 591 592
    }
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
593 594 595
%*                                                       *
        Wired-in interface for GHC.Prim
%*                                                       *
596 597 598 599 600
%*********************************************************

\begin{code}
ghcPrimIface :: ModIface
ghcPrimIface
Simon Marlow's avatar
Simon Marlow committed
601
  = (emptyModIface gHC_PRIM) {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
602 603 604 605 606
        mi_exports  = ghcPrimExports,
        mi_decls    = [],
        mi_fixities = fixities,
        mi_fix_fn  = mkIfaceFixCache fixities
    }           
607
  where
608 609 610
    fixities = (getOccName seqId, Fixity 0 InfixR)  -- seq is infixr 0
             : mapMaybe mkFixity allThePrimOps
    mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
611 612 613
\end{code}

%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
614
%*                                                      *
615
\subsection{Statistics}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
616
%*                                                      *
617 618 619 620 621
%*********************************************************

\begin{code}
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats eps 
622
  = hcat [text "Renamer stats: ", msg]
623
  where
624 625
    stats = eps_stats eps
    msg = vcat 
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
626 627 628 629 630 631 632 633
        [int (n_ifaces_in stats) <+> text "interfaces read",
         hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
                int (n_decls_in stats), text "read"],
         hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
                int (n_insts_in stats), text "read"],
         hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
                int (n_rules_in stats), text "read"]
        ]
SamB's avatar
SamB committed
634
\end{code}
635 636


637
%************************************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
638 639 640
%*                                                                      *
                Printing interfaces
%*                                                                      *
641 642 643
%************************************************************************

\begin{code}
644 645 646
-- | Read binary interface, and print it out
showIface :: HscEnv -> FilePath -> IO ()
showIface hsc_env filename = do
Ian Lynagh's avatar
Ian Lynagh committed
647
   -- skip the hi way check; we don't want to worry about profiled vs.
648
   -- non-profiled interfaces, for example.
649 650
   iface <- initTcRnIf 's' hsc_env () () $
       readBinIface IgnoreHiWay TraceBinIFaceReading filename
651
   let dflags = hsc_dflags hsc_env
Ian Lynagh's avatar
Ian Lynagh committed
652
   log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (pprModIface iface)
653 654 655 656 657 658
\end{code}

\begin{code}
pprModIface :: ModIface -> SDoc
-- Show a ModIface
pprModIface iface
Ian Lynagh's avatar
Ian Lynagh committed
659
 = vcat [ ptext (sLit "interface")
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
660 661 662 663
                <+> ppr (mi_module iface) <+> pp_boot
                <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
                <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
                <+> (if mi_hpc    iface then ptext (sLit "[hpc]") else empty)
Ian Lynagh's avatar
Ian Lynagh committed
664
                <+> integer hiVersion
665 666 667 668
        , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
        , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
        , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
        , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
669
        , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash iface))
670
        , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
671
        , nest 2 (ptext (sLit "where"))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
672
        , ptext (sLit "exports:")
673
        , nest 2 (vcat (map pprExport (mi_exports iface)))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
674 675 676 677
        , pprDeps (mi_deps iface)
        , vcat (map pprUsage (mi_usages iface))
        , vcat (map pprIfaceAnnotation (mi_anns iface))
        , pprFixities (mi_fixities iface)
678 679 680 681
        , vcat (map pprIfaceDecl (mi_decls iface))
        , vcat (map ppr (mi_insts iface))
        , vcat (map ppr (mi_fam_insts iface))
        , vcat (map ppr (mi_rules iface))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
682
        , pprVectInfo (mi_vect_info iface)
683 684 685 686
        , ppr (mi_warns iface)
        , pprTrustInfo (mi_trust iface)
        , pprTrustPkg (mi_trust_pkg iface)
        ]
687
  where
Ian Lynagh's avatar
Ian Lynagh committed
688
    pp_boot | mi_boot iface = ptext (sLit "[boot]")
689
            | otherwise     = empty
690 691 692
\end{code}

When printing export lists, we print like this:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
693 694 695
        Avail   f               f
        AvailTC C [C, x, y]     C(x,y)
        AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
696 697 698

\begin{code}
pprExport :: IfaceExport -> SDoc
699 700 701 702 703 704
pprExport (Avail n)      = ppr n
pprExport (AvailTC _ []) = empty
pprExport (AvailTC n (n':ns)) 
  | n==n'     = ppr n <> pp_export ns
  | otherwise = ppr n <> char '|' <> pp_export (n':ns)
  where  
705 706 707 708
    pp_export []    = empty
    pp_export names = braces (hsep (map ppr names))

pprUsage :: Usage -> SDoc
709
pprUsage usage@UsagePackageModule{}
710
  = pprUsageImport usage usg_mod
711
pprUsage usage@UsageHomeModule{}
712
  = pprUsageImport usage usg_mod_name $$
713
    nest 2 (
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
714
        maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
715 716
        vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
        )
GregWeber's avatar
GregWeber committed
717
pprUsage usage@UsageFile{}
718 719
  = hsep [ptext (sLit "addDependentFile"),
          doubleQuotes (text (usg_file_path usage))]
720

721 722 723 724 725 726 727 728
pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport usage usg_mod'
  = hsep [ptext (sLit "import"), safe, ppr (usg_mod' usage),
                       ppr (usg_mod_hash usage)]
    where
        safe | usg_safe usage = ptext $ sLit "safe"
             | otherwise      = ptext $ sLit " -/ "

729
pprDeps :: Dependencies -> SDoc
730
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
731
                dep_finsts = finsts })
Ian Lynagh's avatar
Ian Lynagh committed
732
  = vcat [ptext (sLit "module dependencies:") <+> fsep (map ppr_mod mods),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
733 734 735 736
          ptext (sLit "package dependencies:") <+> fsep (map ppr_pkg pkgs),
          ptext (sLit "orphans:") <+> fsep (map ppr orphs),
          ptext (sLit "family instance modules:") <+> fsep (map ppr finsts)
        ]
737 738
  where
    ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
739 740
    ppr_pkg (pkg,trust_req)  = ppr pkg <>
                               (if trust_req then text "*" else empty)
741 742 743
    ppr_boot True  = text "[boot]"
    ppr_boot False = empty

744
pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
745
pprIfaceDecl (ver, decl)
746
  = ppr ver $$ nest 2 (ppr decl)
747 748 749

pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities []    = empty
Ian Lynagh's avatar
Ian Lynagh committed
750
pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
751 752
                  where
                    pprFix (occ,fix) = ppr fix <+> ppr occ 
753

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
754
pprVectInfo :: IfaceVectInfo -> SDoc
755 756 757 758 759
pprVectInfo (IfaceVectInfo { ifaceVectInfoVar          = vars
                           , ifaceVectInfoTyCon        = tycons
                           , ifaceVectInfoTyConReuse   = tyconsReuse
                           , ifaceVectInfoScalarVars   = scalarVars
                           , ifaceVectInfoScalarTyCons = scalarTyCons
760 761
                           }) = 
  vcat 
Ian Lynagh's avatar
Ian Lynagh committed
762 763 764
  [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
  , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
  , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
765 766
  , ptext (sLit "scalar variables:") <+> hsep (map ppr scalarVars)
  , ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons)
767
  ]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
768

769 770 771
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo trust = ptext (sLit "trusted:") <+> ppr trust

772 773 774
pprTrustPkg :: Bool -> SDoc
pprTrustPkg tpkg = ptext (sLit "require own pkg trusted:") <+> ppr tpkg

Ian Lynagh's avatar
Ian Lynagh committed
775 776 777 778
instance Outputable Warnings where
    ppr = pprWarns

pprWarns :: Warnings -> SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
779
pprWarns NoWarnings         = empty
Ian Lynagh's avatar
Ian Lynagh committed
780 781 782 783
pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
pprWarns (WarnSome prs) = ptext (sLit "Warnings")
                        <+> vcat (map pprWarning prs)
    where pprWarning (name, txt) = ppr name <+> ppr txt
784 785 786 787

pprIfaceAnnotation :: IfaceAnnotation -> SDoc
pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })
  = ppr target <+> ptext (sLit "annotated by") <+> ppr serialized
788 789 790
\end{code}


791
%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
792
%*                                                       *
793
\subsection{Errors}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
794
%*                                                       *
795 796 797
%*********************************************************

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
798
badIfaceFile :: String -> SDoc -> SDoc
799
badIfaceFile file err
Ian Lynagh's avatar
Ian Lynagh committed
800
  = vcat [ptext (sLit "Bad interface file:") <+> text file, 
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
801
          nest 4 err]
802

803
hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
804
hiModuleNameMismatchWarn requested_mod read_mod = 
Simon Marlow's avatar
Simon Marlow committed
805 806 807
  withPprStyle defaultUserStyle $
    -- we want the Modules below to be qualified with package names,
    -- so reset the PrintUnqualified setting.
Ian Lynagh's avatar
Ian Lynagh committed
808
    hsep [ ptext (sLit "Something is amiss; requested module ")
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
809 810 811 812
         , ppr requested_mod
         , ptext (sLit "differs from name found in the interface file")
         , ppr read_mod
         ]
813

Ian Lynagh's avatar
Ian Lynagh committed
814
wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
815
wrongIfaceModErr iface mod_name file_path 
Ian Lynagh's avatar
Ian Lynagh committed
816 817 818
  = sep [ptext (sLit "Interface file") <+> iface_file,
         ptext (sLit "contains module") <+> quotes (ppr (mi_module iface)) <> comma,
         ptext (sLit "but we were expecting module") <+> quotes (ppr mod_name),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
819 820 821 822 823
         sep [ptext (sLit "Probable cause: the source code which generated"),
             nest 2 iface_file,
             ptext (sLit "has an incompatible module name")
            ]
        ]
824
  where iface_file = doubleQuotes (text file_path)
Simon Marlow's avatar
Simon Marlow committed
825

Ian Lynagh's avatar
Ian Lynagh committed
826
homeModError :: Module -> ModLocation -> SDoc
Simon Marlow's avatar
Simon Marlow committed
827
homeModError mod location
Ian Lynagh's avatar
Ian Lynagh committed
828
  = ptext (sLit "attempting to use module ") <> quotes (ppr mod)
Simon Marlow's avatar
Simon Marlow committed
829 830 831
    <> (case ml_hs_file location of
           Just file -> space <> parens (text file)
           Nothing   -> empty)
Ian Lynagh's avatar
Ian Lynagh committed
832
    <+> ptext (sLit "which is not loaded")
833
\end{code}
834