LoadIface.lhs 38.2 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
{-# LANGUAGE CPP #-}
10
{-# OPTIONS_GHC -fno-warn-orphans #-}
11
module LoadIface (
12 13
        -- RnM/TcM functions
        loadModuleInterface, loadModuleInterfaces, 
14 15
        loadSrcInterface, loadSrcInterface_maybe, 
        loadInterfaceForName, loadInterfaceForModule,
16 17

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

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

#include "HsVersions.h"

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

Simon Marlow's avatar
Simon Marlow committed
32
import DynFlags
33
import IfaceSyn
Simon Marlow's avatar
Simon Marlow committed
34 35 36 37
import IfaceEnv
import HscTypes

import BasicTypes hiding (SuccessFlag(..))
38
import TcRnMonad
Simon Marlow's avatar
Simon Marlow committed
39

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

Ian Lynagh's avatar
Ian Lynagh committed
66
import Control.Monad
67 68
import Data.IORef
import System.FilePath
69 70 71 72
\end{code}


%************************************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
73
%*                                                                      *
74
        loadSrcInterface, loadOrphanModules, loadInterfaceForName
75

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
76 77
                These three are called from TcM-land    
%*                                                                      *
78 79 80
%************************************************************************

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

89 90 91 92 93 94 95 96 97 98 99 100 101 102
loadSrcInterface doc mod want_boot maybe_pkg
  = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
       ; case res of
           Failed err      -> failWithTc err
           Succeeded iface -> return iface }

-- | Like loadSrcInterface, but returns a MaybeErr
loadSrcInterface_maybe :: SDoc
                       -> ModuleName
                       -> IsBootInterface     -- {-# SOURCE #-} ?
                       -> Maybe FastString    -- "package", if any
                       -> RnM (MaybeErr MsgDoc ModIface)

loadSrcInterface_maybe doc mod want_boot maybe_pkg
Simon Marlow's avatar
Simon Marlow committed
103 104 105 106 107
  -- 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.
108 109 110 111 112
  = do { hsc_env <- getTopEnv
       ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
       ; case res of
           Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
           err         -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
113

114 115 116 117 118 119 120
-- | 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
121
  | null mods = return ()
122
  | otherwise = initIfaceTcRn (mapM_ load mods)
123
  where
124
    load mod = loadSysInterface (doc <+> parens (ppr mod)) mod
125

Simon Marlow's avatar
Simon Marlow committed
126 127 128
-- | Loads the interface for a given Name.
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
loadInterfaceForName doc name
Ian Lynagh's avatar
Ian Lynagh committed
129 130 131 132 133 134
  = 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 )
        }
135 136
  ; ASSERT2( isExternalName name, ppr name ) 
    initIfaceTcRn $ loadSysInterface doc (nameModule name)
Ian Lynagh's avatar
Ian Lynagh committed
137
  }
138 139 140 141 142 143 144 145 146 147

-- | Loads the interface for a given Module.
loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
loadInterfaceForModule doc m
  = do
    -- Should not be called with this module
    when debugIsOn $ do
      this_mod <- getModule
      MASSERT2( this_mod /= m, ppr m <+> parens doc )
    initIfaceTcRn $ loadSysInterface doc m
148 149 150 151
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
152 153
%*                                                      *
                loadInterface
154

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
155 156 157 158
        The main function to load an interface
        for an imported module, and put it in
        the External Package State
%*                                                      *
159
%*********************************************************
160

161
\begin{code}
Simon Marlow's avatar
Simon Marlow committed
162
-- | An 'IfM' function to load the home interface for a wired-in thing,
163
-- so that we're sure that we see its instance declarations and rules
164
-- See Note [Loading instances for wired-in things] in TcIface
Simon Marlow's avatar
Simon Marlow committed
165
loadWiredInHomeIface :: Name -> IfM lcl ()
166 167
loadWiredInHomeIface name
  = ASSERT( isWiredInName name )
168
    do _ <- loadSysInterface doc (nameModule name); return ()
169
  where
Ian Lynagh's avatar
Ian Lynagh committed
170
    doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
171

172
------------------
173
-- | Loads a system interface and throws an exception if it fails
174
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
175 176
loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem

177
------------------
178 179 180
-- | 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
181 182
loadUserInterface is_boot doc mod_name 
  = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
183

184 185 186 187
loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
loadPluginInterface doc mod_name
  = loadInterfaceWithException doc mod_name ImportByPlugin

188
------------------
189 190 191
-- | 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
192
  = do  { mb_iface <- loadInterface doc mod_name where_from
Ian Lynagh's avatar
Ian Lynagh committed
193
        ; dflags <- getDynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
194
        ; case mb_iface of 
195
            Failed err      -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
196
            Succeeded iface -> return iface }
197

198
------------------
Simon Marlow's avatar
Simon Marlow committed
199
loadInterface :: SDoc -> Module -> WhereFrom
200
              -> IfM lcl (MaybeErr MsgDoc ModIface)
201

202 203 204
-- 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). 

205
-- If it can't find a suitable interface file, we
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
206 207 208
--      a) modify the PackageIfaceTable to have an empty entry
--              (to avoid repeated complaints)
--      b) return (Left message)
209 210 211
--
-- It's not necessarily an error for there not to be an interface
-- file -- perhaps the module has changed, and that interface 
212
-- is no longer used
213

214
loadInterface doc_str mod from
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
215 216 217 218 219 220
  = do  {       -- Read the state
          (eps,hpt) <- getEpsAndHpt

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

                -- Check whether we have the interface already
221
        ; dflags <- getDynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
222 223 224 225 226 227 228 229 230 231
        ; 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
232 233
                           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
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
        ; 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
269
        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, IfaceVectInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
270 271 272 273 274 275 276
        -- 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
277
        ; ignore_prags      <- goptM Opt_IgnoreInterfacePragmas
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
278 279 280 281 282
        ; 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)
283
        ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface)
284

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
285 286 287 288 289 290
        ; 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"
291 292
                              }
               }
293

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
294
        ; updateEps_  $ \ eps -> 
295
           if elemModuleEnv mod (eps_PIT eps) then eps else
296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325
              case from of  -- See Note [Care with plugin imports]
                ImportByPlugin -> eps {
                  eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
                  eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls}
                _              -> 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,
                  eps_vect_info    = plusVectInfo (eps_vect_info eps) 
                                                  new_eps_vect_info,
                  eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
                                                      new_eps_anns,
                  eps_mod_fam_inst_env
                                   = 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) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
326 327

        ; return (Succeeded final_iface)
328 329
    }}}}

330
wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
331
               -> MaybeErr MsgDoc IsBootInterface
332 333 334 335 336 337 338 339
-- 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

340 341 342
       ImportByPlugin
          -> Succeeded False

343 344 345 346 347 348 349 350
       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
351 352 353 354
                Just (_, is_boot) -> Succeeded is_boot
                Nothing           -> Succeeded False
                     -- The boot-ness of the requested interface, 
                     -- based on the dependencies in directly-imported modules
355
  where
356
    this_package = thisPackage dflags == modulePackageKey mod
357 358 359 360 361

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")
362
          <+> quotes (ppr (modulePackageKey mod)))
363 364
\end{code}

365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382
Note [Care with plugin imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When dynamically loading a plugin (via loadPluginInterface) we
populate the same External Package State (EPS), even though plugin
modules are to link with the compiler itself, and not with the 
compiled program.  That's fine: mostly the EPS is just a cache for
the interace files on disk.

But it's NOT ok for the RULES or instance environment.  We do not want
to fire a RULE from the plugin on the code we are compiling, otherwise
the code we are compiling will have a reference to a RHS of the rule
that exists only in the compiler!  This actually happened to Daniel,
via a RULE arising from a specialisation of (^) in the plugin.

Solution: when loading plugins, do not extend the rule and instance
environments.  We are only interested in the type environment, so that
we can check that the plugin exports a function with the type that the
compiler expects.
383

384

385
\begin{code}
386
-----------------------------------------------------
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
387
--      Loading type/class/value decls
388 389 390 391 392
-- 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
393 394
--
-- We handle ATs specially.  They are not main declarations, but also not
Edward Z. Yang's avatar
Edward Z. Yang committed
395
-- implicit things (in particular, adding them to `implicitTyThings' would mess
396
-- things up in the renaming/type checking of source programs).
397 398
-----------------------------------------------------

399 400 401 402
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
403 404
          -> [(Fingerprint, IfaceDecl)]
          -> IfL [(Name,TyThing)]
405 406
loadDecls ignore_prags ver_decls
   = do { mod <- getIfModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
407 408 409 410 411 412 413 414 415
        ; 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
416
loadDecl ignore_prags mod (_version, decl)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
417 418 419
  = do  {       -- Populate the name cache with final versions of all 
                -- the names associated with the decl
          main_name      <- lookupOrig mod (ifName decl)
420

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
421 422 423 424 425 426
        -- 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.
427

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

431 432 433 434 435 436 437 438 439
        -- 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
440
        --      data T a = MkT { x :: T a }
441 442 443 444
        -- 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
445
        --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
446 447
        -- (where the "MkT" is the *Name* associated with MkT, etc.)
        --
Edward Z. Yang's avatar
Edward Z. Yang committed
448
        -- We do this by mapping the implicit_names to the associated
449
        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
450 451
        -- implicitTyThings, we can use getOccName on the implicit
        -- TyThings to make this association: each Name's OccName should
Edward Z. Yang's avatar
Edward Z. Yang committed
452
        -- be the OccName of exactly one implicitTyThing.  So the key is
453 454 455 456 457 458 459
        -- 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
Edward Z. Yang's avatar
Edward Z. Yang committed
460
        -- implicitTyThings while building this mini-env.  
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484
        -- 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
485
        --'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
486 487 488 489 490
        ; 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))
491

492
        ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
493 494

--         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
495
        ; return $ (main_name, thing) :
496
                      -- uses the invariant that implicit_names and
Edward Z. Yang's avatar
Edward Z. Yang committed
497
                      -- implicitTyThings are bijective
498
                      [(n, lookup n) | n <- implicit_names]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
499
        }
500
  where
Ian Lynagh's avatar
Ian Lynagh committed
501
    doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
502

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
503
bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
504
bumpDeclStats name
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
505 506 507 508
  = 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 } })
        }
509 510 511 512
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
513
%*                                                      *
514
\subsection{Reading an interface file}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
515
%*                                                      *
516 517
%*********************************************************

518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536
Note [Home module load error]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the sought-for interface is in the current package (as determined
by -package-name flag) then it jolly well should already be in the HPT
because we process home-package modules in dependency order.  (Except
in one-shot mode; see notes with hsc_HPT decl in HscTypes).

It is possible (though hard) to get this error through user behaviour.
  * Suppose package P (modules P1, P2) depends on package Q (modules Q1,
    Q2, with Q2 importing Q1)
  * We compile both packages.  
  * Now we edit package Q so that it somehow depends on P
  * Now recompile Q with --make (without recompiling P).  
  * Then Q1 imports, say, P1, which in turn depends on Q2. So Q2
    is a home-package module which is not yet in the HPT!  Disaster.

This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
See Trac #8320.

537
\begin{code}
Simon Marlow's avatar
Simon Marlow committed
538
findAndReadIface :: SDoc -> Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
539 540
                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                        -- False <=> Look for .hi file
541
                 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
542 543
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
544

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

Simon Marlow's avatar
Simon Marlow committed
548
findAndReadIface doc_str mod hi_boot_file
549 550 551 552 553 554 555 556 557 558
  = 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
       if mod == gHC_PRIM
559 560 561
           then do
               iface <- getHooked ghcPrimIfaceHook ghcPrimIface
               return (Succeeded (iface,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
562
                                   "<built in interface for GHC.Prim>"))
563 564 565 566 567 568 569 570 571 572 573 574
           else do
               dflags <- getDynFlags
               -- Look for the file
               hsc_env <- getTopEnv
               mb_found <- liftIO (findExactModule hsc_env mod)
               case mb_found of
                   Found loc mod -> do 

                       -- Found file, so read it
                       let file_path = addBootSuffix_maybe hi_boot_file
                                                           (ml_hi_file loc)

575
                       -- See Note [Home module load error]
576
                       if thisPackage dflags == modulePackageKey mod &&
577 578
                          not (isOneShot (ghcMode dflags))
                           then return (Failed (homeModError mod loc))
579 580 581
                           else do r <- read_file file_path
                                   checkBuildDynamicToo r
                                   return r
582 583 584 585 586 587 588
                   err -> do
                       traceIf (ptext (sLit "...not found"))
                       dflags <- getDynFlags
                       return (Failed (cannotFindInterface dflags 
                                           (moduleName mod) err))
    where read_file file_path = do
              traceIf (ptext (sLit "readIFace") <+> text file_path)
589
              read_result <- readIface mod file_path
590 591 592 593 594 595 596 597
              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...
598 599
          checkBuildDynamicToo (Succeeded (iface, filePath)) = do
              dflags <- getDynFlags
600
              whenGeneratingDynamicToo dflags $ withDoDynamicToo $ do
601
                  let ref = canGenerateDynamicToo dflags
602 603
                      dynFilePath = addBootSuffix_maybe hi_boot_file
                                  $ replaceExtension filePath (dynHiSuf dflags)
604 605 606 607 608 609 610 611 612 613 614
                  r <- read_file dynFilePath
                  case r of
                      Succeeded (dynIface, _)
                       | mi_mod_hash iface == mi_mod_hash dynIface ->
                          return ()
                       | otherwise ->
                          do traceIf (text "Dynamic hash doesn't match")
                             liftIO $ writeIORef ref False
                      Failed err ->
                          do traceIf (text "Failed to load dynamic interface file:" $$ err)
                             liftIO $ writeIORef ref False
615
          checkBuildDynamicToo _ = return ()
616 617 618 619 620
\end{code}

@readIface@ tries just the one file.

\begin{code}
621
readIface :: Module -> FilePath
622
          -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
623 624
        -- Failed err    <=> file not found, or unreadable, or illegible
        -- Succeeded iface <=> successfully found and parsed 
625

626
readIface wanted_mod file_path
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
627
  = do  { res <- tryMostM $
628
                 readBinIface CheckHiWay QuietBinIFaceReading file_path
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
629 630 631 632 633 634 635 636 637
        ; 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)))
638
    }
639 640 641 642
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
643 644 645
%*                                                       *
        Wired-in interface for GHC.Prim
%*                                                       *
646 647 648 649 650 651
%*********************************************************

\begin{code}
initExternalPackageState :: ExternalPackageState
initExternalPackageState
  = EPS { 
652 653 654 655 656 657
      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
658
        -- Initialise the EPS rule pool with the built-in rules
659 660
      eps_mod_fam_inst_env
                       = emptyModuleEnv,
661
      eps_vect_info    = noVectInfo,
662
      eps_ann_env      = emptyAnnEnv,
663
      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
664 665
                           , n_insts_in = 0, n_insts_out = 0
                           , n_rules_in = length builtinRules, n_rules_out = 0 }
666 667 668 669 670
    }
\end{code}


%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
671 672 673
%*                                                       *
        Wired-in interface for GHC.Prim
%*                                                       *
674 675 676 677 678
%*********************************************************

\begin{code}
ghcPrimIface :: ModIface
ghcPrimIface
Simon Marlow's avatar
Simon Marlow committed
679
  = (emptyModIface gHC_PRIM) {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
680 681 682 683 684
        mi_exports  = ghcPrimExports,
        mi_decls    = [],
        mi_fixities = fixities,
        mi_fix_fn  = mkIfaceFixCache fixities
    }           
685
  where
686 687
    fixities = (getOccName seqId, Fixity 0 InfixR)  -- seq is infixr 0
             : mapMaybe mkFixity allThePrimOps
688
    mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
689 690 691
\end{code}

%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
692
%*                                                      *
693
\subsection{Statistics}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
694
%*                                                      *
695 696 697 698 699
%*********************************************************

\begin{code}
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats eps 
700
  = hcat [text "Renamer stats: ", msg]
701
  where
702 703
    stats = eps_stats eps
    msg = vcat 
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
704 705 706 707 708 709 710 711
        [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
712
\end{code}
713 714


715
%************************************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
716 717 718
%*                                                                      *
                Printing interfaces
%*                                                                      *
719 720 721
%************************************************************************

\begin{code}
722 723 724
-- | Read binary interface, and print it out
showIface :: HscEnv -> FilePath -> IO ()
showIface hsc_env filename = do
Ian Lynagh's avatar
Ian Lynagh committed
725
   -- skip the hi way check; we don't want to worry about profiled vs.
726
   -- non-profiled interfaces, for example.
727 728
   iface <- initTcRnIf 's' hsc_env () () $
       readBinIface IgnoreHiWay TraceBinIFaceReading filename
729
   let dflags = hsc_dflags hsc_env
Ian Lynagh's avatar
Ian Lynagh committed
730
   log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (pprModIface iface)
731 732 733 734 735 736
\end{code}

\begin{code}
pprModIface :: ModIface -> SDoc
-- Show a ModIface
pprModIface iface
Ian Lynagh's avatar
Ian Lynagh committed
737
 = vcat [ ptext (sLit "interface")
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
738 739 740 741
                <+> 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
742
                <+> integer hiVersion
743 744 745 746
        , 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))
747
        , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash iface))
748
        , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
749
        , nest 2 (ptext (sLit "where"))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
750
        , ptext (sLit "exports:")
751
        , nest 2 (vcat (map pprExport (mi_exports iface)))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
752 753 754 755
        , pprDeps (mi_deps iface)
        , vcat (map pprUsage (mi_usages iface))
        , vcat (map pprIfaceAnnotation (mi_anns iface))
        , pprFixities (mi_fixities iface)
756
        , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
757 758 759
        , 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
760
        , pprVectInfo (mi_vect_info iface)
761 762 763 764
        , ppr (mi_warns iface)
        , pprTrustInfo (mi_trust iface)
        , pprTrustPkg (mi_trust_pkg iface)
        ]
765
  where
Ian Lynagh's avatar
Ian Lynagh committed
766
    pp_boot | mi_boot iface = ptext (sLit "[boot]")
767
            | otherwise     = empty
768 769 770
\end{code}

When printing export lists, we print like this:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
771 772 773
        Avail   f               f
        AvailTC C [C, x, y]     C(x,y)
        AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
774 775 776

\begin{code}
pprExport :: IfaceExport -> SDoc
777 778 779 780 781 782
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  
783 784 785 786
    pp_export []    = empty
    pp_export names = braces (hsep (map ppr names))

pprUsage :: Usage -> SDoc
787
pprUsage usage@UsagePackageModule{}
788
  = pprUsageImport usage usg_mod
789
pprUsage usage@UsageHomeModule{}
790
  = pprUsageImport usage usg_mod_name $$
791
    nest 2 (
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
792
        maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
793 794
        vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
        )
GregWeber's avatar
GregWeber committed
795
pprUsage usage@UsageFile{}
796 797
  = hsep [ptext (sLit "addDependentFile"),
          doubleQuotes (text (usg_file_path usage))]
798

799 800 801 802 803 804 805 806
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 " -/ "

807
pprDeps :: Dependencies -> SDoc
808
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
809
                dep_finsts = finsts })
Ian Lynagh's avatar
Ian Lynagh committed
810
  = vcat [ptext (sLit "module dependencies:") <+> fsep (map ppr_mod mods),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
811 812 813 814
          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)
        ]
815 816
  where
    ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
817 818
    ppr_pkg (pkg,trust_req)  = ppr pkg <>
                               (if trust_req then text "*" else empty)
819 820 821 822 823
    ppr_boot True  = text "[boot]"
    ppr_boot False = empty

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
828
pprVectInfo :: IfaceVectInfo -> SDoc
829 830 831 832 833
pprVectInfo (IfaceVectInfo { ifaceVectInfoVar            = vars
                           , ifaceVectInfoTyCon          = tycons
                           , ifaceVectInfoTyConReuse     = tyconsReuse
                           , ifaceVectInfoParallelVars   = parallelVars
                           , ifaceVectInfoParallelTyCons = parallelTyCons
834 835
                           }) = 
  vcat 
Ian Lynagh's avatar
Ian Lynagh committed
836 837 838
  [ 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)
839 840
  , ptext (sLit "parallel variables:") <+> hsep (map ppr parallelVars)
  , ptext (sLit "parallel tycons:") <+> hsep (map ppr parallelTyCons)
841
  ]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
842

843 844 845
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo trust = ptext (sLit "trusted:") <+> ppr trust

846 847 848
pprTrustPkg :: Bool -> SDoc
pprTrustPkg tpkg = ptext (sLit "require own pkg trusted:") <+> ppr tpkg

Ian Lynagh's avatar
Ian Lynagh committed
849 850 851 852
instance Outputable Warnings where
    ppr = pprWarns

pprWarns :: Warnings -> SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
853
pprWarns NoWarnings         = empty
Ian Lynagh's avatar
Ian Lynagh committed
854 855 856 857
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
858 859 860 861

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


865
%*********************************************************
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
866
%*                                                       *
867
\subsection{Errors}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
868
%*                                                       *
869 870 871
%*********************************************************

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

877
hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
878
hiModuleNameMismatchWarn requested_mod read_mod = 
879 880
  -- ToDo: This will fail to have enough qualification when the package IDs
  -- are the same
881
  withPprStyle (mkUserStyle alwaysQualify AllTheWay) $
Simon Marlow's avatar
Simon Marlow committed
882 883
    -- we want the Modules below to be qualified with package names,
    -- so reset the PrintUnqualified setting.
Ian Lynagh's avatar
Ian Lynagh committed
884
    hsep [ ptext (sLit "Something is amiss; requested module ")
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
885 886 887 888
         , ppr requested_mod
         , ptext (sLit "differs from name found in the interface file")
         , ppr read_mod
         ]
889

Ian Lynagh's avatar
Ian Lynagh committed
890
wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
891
wrongIfaceModErr iface mod_name file_path 
Ian Lynagh's avatar
Ian Lynagh committed
892 893 894
  = 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
895 896 897 898 899
         sep [ptext (sLit "Probable cause: the source code which generated"),
             nest 2 iface_file,
             ptext (sLit "has an incompatible module name")
            ]
        ]
900
  where iface_file = doubleQuotes (text file_path)
Simon Marlow's avatar
Simon Marlow committed
901

Ian Lynagh's avatar
Ian Lynagh committed
902
homeModError :: Module -> ModLocation -> SDoc
903
-- See Note [Home module load error]
Simon Marlow's avatar
Simon Marlow committed
904
homeModError mod location
Ian Lynagh's avatar
Ian Lynagh committed
905
  = ptext (sLit "attempting to use module ") <> quotes (ppr mod)
Simon Marlow's avatar
Simon Marlow committed
906 907 908
    <> (case ml_hs_file location of
           Just file -> space <> parens (text file)
           Nothing   -> empty)
Ian Lynagh's avatar
Ian Lynagh committed
909
    <+> ptext (sLit "which is not loaded")
910
\end{code}
911