ef52bdbb3d8c0dc137bd3a589e49a1b4b2c95291
[ghc-hetmet.git] / ghc / compiler / iface / LoadIface.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section{Dealing with interface files}
5
6 \begin{code}
7 module LoadIface (
8         loadHomeInterface, loadInterface,
9         loadSrcInterface, loadOrphanModules, loadHiBootInterface,
10         readIface,      -- Used when reading the module's old interface
11         predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
12         initExternalPackageState,
13         noIfaceErr,   -- used by CompManager too
14    ) where
15
16 #include "HsVersions.h"
17
18 import {-# SOURCE #-}   TcIface( tcIfaceDecl )
19
20 import Packages         ( PackageState(..), isHomeModule  )
21 import DriverState      ( v_GhcMode, isCompManagerMode )
22 import DriverUtil       ( replaceFilenameSuffix )
23 import CmdLineOpts      ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
24 import Parser           ( parseIface )
25
26 import IfaceSyn         ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
27                           IfaceConDecls(..), IfaceInst(..), IfaceRule(..),
28                           IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..), 
29                           IfaceType(..), IfacePredType(..), IfaceExtName,
30                           mkIfaceExtName )
31 import IfaceEnv         ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
32                           lookupOrig )
33 import HscTypes         ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
34                           addEpsInStats, ExternalPackageState(..),
35                           PackageTypeEnv, emptyTypeEnv,  IfacePackage(..),
36                           lookupIfaceByModule, emptyPackageIfaceTable,
37                           IsBootInterface, mkIfaceFixCache, Gated,
38                           implicitTyThings, addRulesToPool, addInstsToPool,
39                           availNames
40                          )
41
42 import BasicTypes       ( Version, Fixity(..), FixityDirection(..),
43                           isMarkedStrict )
44 import TcType           ( Type, tcSplitTyConApp_maybe )
45 import Type             ( funTyCon )
46 import TcRnMonad
47
48 import PrelNames        ( gHC_PRIM )
49 import PrelInfo         ( ghcPrimExports )
50 import PrelRules        ( builtinRules )
51 import Rules            ( emptyRuleBase )
52 import InstEnv          ( emptyInstEnv )
53 import Name             ( Name {-instance NamedThing-}, getOccName,
54                           nameModule, isInternalName )
55 import NameEnv
56 import MkId             ( seqId )
57 import Module           ( Module, ModLocation(ml_hi_file), emptyModuleEnv, 
58                           extendModuleEnv, lookupModuleEnv, moduleUserString
59                         )
60 import OccName          ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
61                           mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
62 import Class            ( Class, className )
63 import TyCon            ( tyConName )
64 import SrcLoc           ( mkSrcLoc, importedSrcLoc )
65 import Maybes           ( isJust, mapCatMaybes )
66 import StringBuffer     ( hGetStringBuffer )
67 import FastString       ( mkFastString )
68 import ErrUtils         ( Message, mkLocMessage )
69 import Finder           ( findModule, findPackageModule,  FindResult(..),
70                           hiBootExt, hiBootVerExt )
71 import Lexer
72 import Outputable
73 import BinIface         ( readBinIface )
74 import Panic
75 import List             ( nub )
76
77 import DATA_IOREF       ( readIORef )
78
79 import Directory
80 \end{code}
81
82
83 %************************************************************************
84 %*                                                                      *
85                 loadSrcInterface, loadOrphanModules
86
87                 These two are called from TcM-land      
88 %*                                                                      *
89 %************************************************************************
90
91 \begin{code}
92 loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
93 -- This is called for each 'import' declaration in the source code
94 -- On a failure, fail in the monad with an error message
95
96 loadSrcInterface doc mod_name want_boot
97   = do  { mb_iface <- initIfaceTcRn $ loadInterface doc mod_name 
98                                            (ImportByUser want_boot)
99         ; case mb_iface of
100             Left err    -> failWithTc (elaborate err) 
101             Right iface -> return iface
102         }
103   where
104     elaborate err = hang (ptext SLIT("Failed to load interface for") <+> 
105                          quotes (ppr mod_name) <> colon) 4 err
106
107 loadHiBootInterface :: TcRn [Name]
108 -- Load the hi-boot iface for the module being compiled,
109 -- if it indeed exists in the transitive closure of imports
110 -- Return the list of names exported by the hi-boot file
111 loadHiBootInterface
112   = do  { eps <- getEps
113         ; mod <- getModule
114
115         ; traceIf (text "loadHiBootInterface" <+> ppr mod)
116
117         -- We're read all the direct imports by now, so eps_is_boot will
118         -- record if any of our imports mention us by way of hi-boot file
119         ; case lookupModuleEnv (eps_is_boot eps) mod of {
120             Nothing             -> return [] ;  -- The typical case
121
122             Just (_, False) ->          -- Someone below us imported us!
123                 -- This is a loop with no hi-boot in the way
124                 failWithTc (moduleLoop mod) ;
125
126             Just (mod_nm, True) ->      -- There's a hi-boot interface below us
127                 
128
129     do  {       -- Load it (into the PTE), and return the exported names
130           iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
131         ; sequenceM [ lookupOrig mod_nm occ
132                     | (mod,avails) <- mi_exports iface, 
133                       avail <- avails, occ <- availNames avail]
134     }}}
135   where
136     mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
137                  <+> ptext SLIT("to compare against the Real Thing")
138
139     moduleLoop mod = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
140                      <+> ptext SLIT("depends on itself")
141
142 loadOrphanModules :: [Module] -> TcM ()
143 loadOrphanModules mods
144   | null mods = returnM ()
145   | otherwise = initIfaceTcRn $
146                 do { traceIf (text "Loading orphan modules:" <+> 
147                                  fsep (map ppr mods))
148                    ; mappM_ load mods
149                    ; returnM () }
150   where
151     load mod   = loadSysInterface (mk_doc mod) mod
152     mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
153 \end{code}
154
155 %*********************************************************
156 %*                                                      *
157                 loadHomeInterface
158                 Called from Iface-land
159 %*                                                      *
160 %*********************************************************
161
162 \begin{code}
163 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
164 loadHomeInterface doc name
165   = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
166     loadSysInterface doc (nameModule name)
167
168 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
169 -- A wrapper for loadInterface that Throws an exception if it fails
170 loadSysInterface doc mod_name
171   = do  { mb_iface <- loadInterface doc mod_name ImportBySystem
172         ; case mb_iface of 
173             Left err    -> ghcError (ProgramError (showSDoc err))
174             Right iface -> return iface }
175 \end{code}
176
177
178 %*********************************************************
179 %*                                                      *
180                 loadInterface
181
182         The main function to load an interface
183         for an imported module, and put it in
184         the External Package State
185 %*                                                      *
186 %*********************************************************
187
188 \begin{code}
189 loadInterface :: SDoc -> Module -> WhereFrom 
190               -> IfM lcl (Either Message ModIface)
191 -- If it can't find a suitable interface file, we
192 --      a) modify the PackageIfaceTable to have an empty entry
193 --              (to avoid repeated complaints)
194 --      b) return (Left message)
195 --
196 -- It's not necessarily an error for there not to be an interface
197 -- file -- perhaps the module has changed, and that interface 
198 -- is no longer used -- but the caller can deal with that by 
199 -- catching the exception
200
201 loadInterface doc_str mod_name from
202   = do  {       -- Read the state
203           (eps,hpt) <- getEpsAndHpt
204
205         ; traceIf (text "Considering whether to load" <+> ppr mod_name <+> ppr from)
206
207                 -- Check whether we have the interface already
208         ; case lookupIfaceByModule hpt (eps_PIT eps) mod_name of {
209             Just iface 
210                 -> returnM (Right iface) ;      -- Already loaded
211                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
212                         -- interface isn't a boot iface.  This can conceivably happen,
213                         -- if an earlier import had a before we got to real imports.   I think.
214             other -> do
215
216         { let { hi_boot_file = case from of
217                                 ImportByUser usr_boot -> usr_boot
218                                 ImportBySystem        -> sys_boot
219
220               ; mb_dep   = lookupModuleEnv (eps_is_boot eps) mod_name
221               ; sys_boot = case mb_dep of
222                                 Just (_, is_boot) -> is_boot
223                                 Nothing           -> False
224                         -- The boot-ness of the requested interface, 
225               }         -- based on the dependencies in directly-imported modules
226
227         -- READ THE MODULE IN
228         ; let explicit | ImportByUser _ <- from = True
229                        | otherwise              = False
230         ; read_result <- findAndReadIface explicit doc_str mod_name hi_boot_file
231         ; dflags <- getDOpts
232         ; case read_result of {
233             Left err -> do
234                 { let fake_iface = emptyModIface ThisPackage mod_name
235
236                 ; updateEps_ $ \eps ->
237                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
238                         -- Not found, so add an empty iface to 
239                         -- the EPS map so that we don't look again
240                                 
241                 ; returnM (Left err) } ;
242
243         -- Found and parsed!
244             Right iface -> 
245
246         let { mod = mi_module iface } in
247
248         -- Sanity check.  If we're system-importing a module we know nothing at all
249         -- about, it should be from a different package to this one
250         WARN(   case from of { ImportBySystem -> True; other -> False } &&
251                 not (isJust mb_dep) && 
252                 isHomeModule dflags mod,
253                 ppr mod $$ ppr mb_dep $$ ppr (eps_is_boot eps) )
254
255         initIfaceLcl mod_name $ do
256         --      Load the new ModIface into the External Package State
257         -- Even home-package interfaces loaded by loadInterface 
258         --      (which only happens in OneShot mode; in Batch/Interactive 
259         --      mode, home-package modules are loaded one by one into the HPT)
260         -- are put in the EPS.
261         --
262         -- The main thing is to add the ModIface to the PIT, but
263         -- we also take the
264         --      IfaceDecls, IfaceInst, IfaceRules
265         -- out of the ModIface and put them into the big EPS pools
266
267         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
268         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
269         --     If we do loadExport first the wrong info gets into the cache (unless we
270         --      explicitly tag each export which seems a bit of a bore)
271
272         { ignore_prags <- doptM Opt_IgnoreInterfacePragmas
273         ; new_eps_decls <- loadDecls ignore_prags mod      (mi_decls iface)
274         ; new_eps_rules <- loadRules ignore_prags mod_name (mi_rules iface)
275         ; new_eps_insts <- loadInsts              mod_name (mi_insts iface)
276
277         ; let { final_iface = iface {   mi_decls = panic "No mi_decls in PIT",
278                                         mi_insts = panic "No mi_insts in PIT",
279                                         mi_rules = panic "No mi_rules in PIT" } }
280
281         ; updateEps_  $ \ eps -> 
282                 eps {   eps_PIT   = extendModuleEnv (eps_PIT eps) mod final_iface,
283                         eps_PTE   = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
284                         eps_rules = addRulesToPool  (eps_rules eps) new_eps_rules,
285                         eps_insts = addInstsToPool  (eps_insts eps) new_eps_insts,
286                         eps_stats = addEpsInStats   (eps_stats eps) (length new_eps_decls)
287                                                     (length new_eps_insts) (length new_eps_rules) }
288
289         ; return (Right final_iface)
290     }}}}}
291
292 -----------------------------------------------------
293 --      Loading type/class/value decls
294 -- We pass the full Module name here, replete with
295 -- its package info, so that we can build a Name for
296 -- each binder with the right package info in it
297 -- All subsequent lookups, including crucially lookups during typechecking
298 -- the declaration itself, will find the fully-glorious Name
299 -----------------------------------------------------
300
301 addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
302 addDeclsToPTE pte things = foldl extendNameEnvList pte things
303
304 loadDecls :: Bool       -- Don't load pragmas into the decl pool
305           -> Module
306           -> [(Version, IfaceDecl)]
307           -> IfL [[(Name,TyThing)]]     -- The list can be poked eagerly, but the
308                                         -- TyThings are forkM'd thunks
309 loadDecls ignore_prags mod decls = mapM (loadDecl ignore_prags mod) decls
310
311 loadDecl ignore_prags mod (_version, decl)
312   = do  {       -- Populate the name cache with final versions of all 
313                 -- the names associated with the decl
314           main_name      <- mk_new_bndr Nothing (ifName decl)
315         ; implicit_names <- mapM (mk_new_bndr (Just main_name)) (ifaceDeclSubBndrs decl)
316
317         -- Typecheck the thing, lazily
318         ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
319         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
320               lookup n = case lookupOccEnv mini_env (getOccName n) of
321                            Just thing -> thing
322                            Nothing    -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
323
324         ; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
325                 -- We build a list from the *known* names, with (lookup n) thunks
326                 -- as the TyThings.  That way we can extend the PTE without poking the
327                 -- thunks
328   where
329     stripped_decl | ignore_prags = discardDeclPrags decl
330                   | otherwise    = decl
331
332         -- mk_new_bndr allocates in the name cache the final canonical
333         -- name for the thing, with the correct 
334         --      * parent
335         --      * location
336         -- imported name, to fix the module correctly in the cache
337     mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
338     loc = importedSrcLoc (moduleUserString mod)
339     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
340
341 discardDeclPrags :: IfaceDecl -> IfaceDecl
342 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
343 discardDeclPrags decl                                  = decl
344
345 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
346 bumpDeclStats name
347   = do  { traceIf (text "Loading decl for" <+> ppr name)
348         ; updateEps_ (\eps -> let stats = eps_stats eps
349                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
350         }
351
352 -----------------
353 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
354 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
355 -- Deeply revolting, because it has to predict what gets bound,
356 -- especially the question of whether there's a wrapper for a datacon
357
358 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
359   = [tc_occ, dc_occ, dcww_occ] ++
360     [op | IfaceClassOp op _ _ <- sigs] ++
361     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] 
362   where
363     n_ctxt = length sc_ctxt
364     n_sigs = length sigs
365     tc_occ  = mkClassTyConOcc cls_occ
366     dc_occ  = mkClassDataConOcc cls_occ 
367     dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ  -- Newtypes have wrapper but no worker
368              | otherwise  = mkDataConWorkerOcc dc_occ   -- Otherwise worker but no wrapper
369     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh 
370
371 ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon}) 
372   = []
373 -- Newtype
374 ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ, 
375                                                                   ifConFields = fields})}) 
376   = fields ++ [con_occ, mkDataConWrapperOcc con_occ]    
377         -- Wrapper, no worker; see MkId.mkDataConIds
378
379 ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon _ cons})
380   = nub (concatMap fld_occs cons)       -- Eliminate duplicate fields
381     ++ concatMap dc_occs cons
382   where
383     fld_occs (IfVanillaCon { ifConFields = fields }) = fields
384     fld_occs (IfGadtCon {})                          = []
385     dc_occs con_decl
386         | has_wrapper = [con_occ, work_occ, wrap_occ]
387         | otherwise   = [con_occ, work_occ]
388         where
389           con_occ = ifConOcc con_decl
390           strs    = ifConStricts con_decl
391           wrap_occ = mkDataConWrapperOcc con_occ
392           work_occ = mkDataConWorkerOcc con_occ
393           has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
394                 -- ToDo: may miss strictness in existential dicts
395
396 ifaceDeclSubBndrs _other                      = []
397
398 -----------------------------------------------------
399 --      Loading instance decls
400 -----------------------------------------------------
401
402 loadInsts :: Module -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
403 loadInsts mod decls = mapM (loadInstDecl mod) decls
404
405 loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
406   = do  {
407         -- Find out what type constructors and classes are "gates" for the
408         -- instance declaration.  If all these "gates" are slurped in then
409         -- we should slurp the instance decl too.
410         -- 
411         -- We *don't* want to count names in the context part as gates, though.
412         -- For example:
413         --              instance Foo a => Baz (T a) where ...
414         --
415         -- Here the gates are Baz and T, but *not* Foo.
416         -- 
417         -- HOWEVER: functional dependencies make things more complicated
418         --      class C a b | a->b where ...
419         --      instance C Foo Baz where ...
420         -- Here, the gates are really only C and Foo, *not* Baz.
421         -- That is, if C and Foo are visible, even if Baz isn't, we must
422         -- slurp the decl.
423         --
424         -- Rather than take fundeps into account "properly", we just slurp
425         -- if C is visible and *any one* of the Names in the types
426         -- This is a slightly brutal approximation, but most instance decls
427         -- are regular H98 ones and it's perfect for them.
428         --
429         -- NOTICE that we rename the type before extracting its free
430         -- variables.  The free-variable finder for a renamed HsType 
431         -- does the Right Thing for built-in syntax like [] and (,).
432           let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
433         ; cls <- lookupIfaceExt cls_ext
434         ; tcs <- mapM lookupIfaceTc tc_exts
435         ; returnM (cls, (tcs, (mod,decl)))
436         }
437
438 -----------------------------------------------------
439 --      Loading Rules
440 -----------------------------------------------------
441
442 loadRules :: Bool       -- Don't load pragmas into the decl pool
443           -> Module
444           -> [IfaceRule] -> IfL [Gated IfaceRule]
445 loadRules ignore_prags mod rules
446   | ignore_prags = returnM []
447   | otherwise    = mapM (loadRule mod) rules
448
449 loadRule :: Module -> IfaceRule -> IfL (Gated IfaceRule)
450 -- "Gate" the rule simply by a crude notion of the free vars of
451 -- the LHS.  It can be crude, because having too few free vars is safe.
452 loadRule mod decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
453   = do  { names <- mapM lookupIfaceExt (fn : arg_fvs)
454         ; returnM (names, (mod, decl)) }
455   where
456     arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
457
458
459 ---------------------------
460 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
461 -- A crude approximation to the free external names of an IfExpr
462 -- Returns a subset of the true answer
463 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
464 crudeIfExprGblFvs (IfaceExt v)   = [v]
465 crudeIfExprGblFvs other          = []   -- Well, I said it was crude
466
467 get_tcs :: IfaceType -> [IfaceExtName]
468 -- Get a crude subset of the TyCons of an IfaceType
469 get_tcs (IfaceTyVar _)      = []
470 get_tcs (IfaceAppTy t1 t2)  = get_tcs t1 ++ get_tcs t2
471 get_tcs (IfaceFunTy t1 t2)  = get_tcs t1 ++ get_tcs t2
472 get_tcs (IfaceForAllTy _ t) = get_tcs t
473 get_tcs (IfacePredTy st)    = case st of
474                                  IfaceClassP cl ts -> get_tcs_s ts
475                                  IfaceIParam _ t   -> get_tcs t
476 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
477 get_tcs (IfaceTyConApp other        ts) = get_tcs_s ts
478
479 -- The lists are always small => appending is fine
480 get_tcs_s :: [IfaceType] -> [IfaceExtName]
481 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
482 \end{code}
483
484
485 %*********************************************************
486 %*                                                      *
487                 Gating
488 %*                                                      *
489 %*********************************************************
490
491 Extract the gates of an instance declaration
492
493 \begin{code}
494 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
495 -- Return the class, and the tycons mentioned in the rest of the head
496 -- We only pick the TyCon at the root of each type, to avoid
497 -- difficulties with overlap.  For example, suppose there are interfaces
498 -- in the pool for
499 --      C Int b
500 --      C a [b]
501 --      C a [T] 
502 -- Then, if we are trying to resolve (C Int x), we need the first
503 --       if we are trying to resolve (C x [y]), we need *both* the latter
504 --       two, even though T is not involved yet, so that we spot the overlap
505
506 ifaceInstGates (IfaceForAllTy _ t)                 = ifaceInstGates t
507 ifaceInstGates (IfaceFunTy _ t)                    = ifaceInstGates t
508 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
509 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
510         -- The other cases should not happen
511
512 instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
513   where
514     root_tycon (IfaceFunTy _ _)      = Just (IfaceTc funTyConExtName)
515     root_tycon (IfaceTyConApp tc _)  = Just tc
516     root_tycon other                 = Nothing
517
518 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
519
520
521 predInstGates :: Class -> [Type] -> (Name, [Name])
522 -- The same function, only this time on the predicate found in a dictionary
523 predInstGates cls tys
524   = (className cls, mapCatMaybes root_tycon tys)
525   where
526     root_tycon ty = case tcSplitTyConApp_maybe ty of
527                         Just (tc, _) -> Just (tyConName tc)
528                         Nothing      -> Nothing
529 \end{code}
530
531
532 %*********************************************************
533 %*                                                      *
534 \subsection{Reading an interface file}
535 %*                                                      *
536 %*********************************************************
537
538 \begin{code}
539 findAndReadIface :: Bool                -- True <=> explicit user import
540                  -> SDoc -> Module 
541                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
542                                         -- False <=> Look for .hi file
543                  -> IfM lcl (Either Message ModIface)
544         -- Nothing <=> file not found, or unreadable, or illegible
545         -- Just x  <=> successfully found and parsed 
546
547         -- It *doesn't* add an error to the monad, because 
548         -- sometimes it's ok to fail... see notes with loadInterface
549
550 findAndReadIface explicit doc_str mod_name hi_boot_file
551   = do  { traceIf (sep [hsep [ptext SLIT("Reading"), 
552                               if hi_boot_file 
553                                 then ptext SLIT("[boot]") 
554                                 else empty,
555                               ptext SLIT("interface for"), 
556                               ppr mod_name <> semi],
557                         nest 4 (ptext SLIT("reason:") <+> doc_str)])
558
559         -- Check for GHC.Prim, and return its static interface
560         ; dflags <- getDOpts
561         ; let base_id = basePackageId (pkgState dflags)
562               base_pkg 
563                 | Just id <- base_id = ExternalPackage id
564                 | otherwise          = ThisPackage
565                 -- if basePackageId is Nothing, it means we must be
566                 -- compiling the base package.
567         ; if mod_name == gHC_PRIM
568           then returnM (Right (ghcPrimIface{ mi_package = base_pkg }))
569           else do
570
571         -- Look for the file
572         ; mb_found <- ioToIOEnv (findHiFile dflags explicit mod_name hi_boot_file)
573         ; case mb_found of {
574               Left err -> do
575                 { traceIf (ptext SLIT("...not found"))
576                 ; dflags <- getDOpts
577                 ; returnM (Left (noIfaceErr dflags mod_name err)) } ;
578
579               Right (file_path,pkg) -> do 
580
581         -- Found file, so read it
582         { traceIf (ptext SLIT("readIFace") <+> text file_path)
583         ; read_result <- readIface mod_name file_path hi_boot_file
584         ; case read_result of
585             Left err    -> returnM (Left (badIfaceFile file_path err))
586             Right iface 
587                 | mi_module iface /= mod_name ->
588                   return (Left (wrongIfaceModErr iface mod_name file_path))
589                 | otherwise ->
590                   returnM (Right iface{mi_package=pkg})
591                         -- don't forget to fill in the package name...
592         }}}
593
594 findHiFile :: DynFlags -> Bool -> Module -> IsBootInterface
595            -> IO (Either FindResult (FilePath, IfacePackage))
596 findHiFile dflags explicit mod_name hi_boot_file
597  = do { 
598         -- In interactive or --make mode, we are *not allowed* to demand-load
599         -- a home package .hi file.  So don't even look for them.
600         -- This helps in the case where you are sitting in eg. ghc/lib/std
601         -- and start up GHCi - it won't complain that all the modules it tries
602         -- to load are found in the home location.
603         ghci_mode <- readIORef v_GhcMode ;
604         let { home_allowed = hi_boot_file || 
605                              not (isCompManagerMode ghci_mode) } ;
606         maybe_found <-  if home_allowed 
607                         then findModule dflags mod_name explicit
608                         else findPackageModule dflags mod_name explicit;
609
610         case maybe_found of {
611           Found loc pkg -> foundOk loc hi_boot_file pkg;
612           err           -> return (Left err) ;
613         }}
614    where
615     foundOk loc hi_boot_file pkg = do { -- Don't need module returned by finder
616
617         -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
618         let { hi_path            = ml_hi_file loc ;
619               hi_boot_path       = replaceFilenameSuffix hi_path hiBootExt ;
620               hi_boot_ver_path   = replaceFilenameSuffix hi_path hiBootVerExt 
621             };
622
623         if not hi_boot_file then
624            return (Right (hi_path,pkg))
625         else do {
626                 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
627                 if hi_ver_exists then return (Right (hi_boot_ver_path,pkg))
628                                  else return (Right (hi_boot_path,pkg))
629         }}
630 \end{code}
631
632 @readIface@ tries just the one file.
633
634 \begin{code}
635 readIface :: Module -> String -> IsBootInterface 
636           -> IfM lcl (Either Message ModIface)
637         -- Left err    <=> file not found, or unreadable, or illegible
638         -- Right iface <=> successfully found and parsed 
639
640 readIface wanted_mod_name file_path is_hi_boot_file
641   = do  { dflags <- getDOpts
642         ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }
643
644 read_iface dflags wanted_mod file_path is_hi_boot_file
645  | is_hi_boot_file              -- Read ascii
646  = do { res <- tryMost (hGetStringBuffer file_path) ;
647         case res of {
648           Left exn     -> return (Left (text (showException exn))) ;
649           Right buffer -> 
650         case unP parseIface (mkPState buffer loc dflags) of
651           PFailed span err -> return (Left (mkLocMessage span err))
652           POk _ iface 
653              | wanted_mod == actual_mod -> return (Right iface)
654              | otherwise                -> return (Left err) 
655              where
656                 actual_mod = mi_module iface
657                 err = hiModuleNameMismatchWarn wanted_mod actual_mod
658      }}
659
660  | otherwise            -- Read binary
661  = do   { res <- tryMost (readBinIface file_path)
662         ; case res of
663             Right iface -> return (Right iface)
664             Left exn    -> return (Left (text (showException exn))) }
665  where
666     loc  = mkSrcLoc (mkFastString file_path) 1 0
667 \end{code}
668
669
670 %*********************************************************
671 %*                                                       *
672         Wired-in interface for GHC.Prim
673 %*                                                       *
674 %*********************************************************
675
676 \begin{code}
677 initExternalPackageState :: ExternalPackageState
678 initExternalPackageState
679   = EPS { 
680       eps_is_boot    = emptyModuleEnv,
681       eps_PIT        = emptyPackageIfaceTable,
682       eps_PTE        = emptyTypeEnv,
683       eps_inst_env   = emptyInstEnv,
684       eps_rule_base  = emptyRuleBase,
685       eps_insts      = emptyNameEnv,
686       eps_rules      = addRulesToPool [] (map mk_gated_rule builtinRules),
687         -- Initialise the EPS rule pool with the built-in rules
688       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
689                            , n_insts_in = 0, n_insts_out = 0
690                            , n_rules_in = length builtinRules, n_rules_out = 0 }
691     }
692   where
693     mk_gated_rule (fn_name, core_rule)
694         = ([fn_name], (nameModule fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
695 \end{code}
696
697
698 %*********************************************************
699 %*                                                       *
700         Wired-in interface for GHC.Prim
701 %*                                                       *
702 %*********************************************************
703
704 \begin{code}
705 ghcPrimIface :: ModIface
706 ghcPrimIface
707   = (emptyModIface ThisPackage gHC_PRIM) {
708         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
709         mi_decls    = [],
710         mi_fixities = fixities,
711         mi_fix_fn  = mkIfaceFixCache fixities
712     }           
713   where
714     fixities = [(getOccName seqId, Fixity 0 InfixR)]
715                         -- seq is infixr 0
716 \end{code}
717
718 %*********************************************************
719 %*                                                      *
720 \subsection{Statistics}
721 %*                                                      *
722 %*********************************************************
723
724 \begin{code}
725 ifaceStats :: ExternalPackageState -> SDoc
726 ifaceStats eps 
727   = hcat [text "Renamer stats: ", msg]
728   where
729     stats = eps_stats eps
730     msg = vcat 
731         [int (n_ifaces_in stats) <+> text "interfaces read",
732          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
733                 int (n_decls_in stats), text "read"],
734          hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
735                 int (n_insts_in stats), text "read"],
736          hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
737                 int (n_rules_in stats), text "read"]
738         ]
739 \end{code}    
740
741
742 %*********************************************************
743 %*                                                       *
744 \subsection{Errors}
745 %*                                                       *
746 %*********************************************************
747
748 \begin{code}
749 badIfaceFile file err
750   = vcat [ptext SLIT("Bad interface file:") <+> text file, 
751           nest 4 err]
752
753 hiModuleNameMismatchWarn :: Module -> Module -> Message
754 hiModuleNameMismatchWarn requested_mod read_mod = 
755     hsep [ ptext SLIT("Something is amiss; requested module name")
756          , ppr requested_mod
757          , ptext SLIT("differs from name found in the interface file")
758          , ppr read_mod
759          ]
760
761 noIfaceErr dflags mod_name (PackageHidden pkg)
762   = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
763     $$ ptext SLIT("it is a member of package") <+> ppr pkg <> comma
764          <+> ptext SLIT("which is hidden")
765
766 noIfaceErr dflags mod_name (ModuleHidden pkg)
767   = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
768     $$ ptext SLIT("it is hidden") 
769         <+> parens (ptext SLIT("in package") <+> ppr pkg)
770
771 noIfaceErr dflags mod_name (NotFound files)
772   = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
773     $$ extra files
774   where 
775   extra files
776     | verbosity dflags < 3 = 
777         text "(use -v to see a list of the files searched for)"
778     | otherwise =
779         hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
780
781 wrongIfaceModErr iface mod_name file_path 
782   = sep [ptext SLIT("Interface file") <+> iface_file,
783          ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
784          ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
785          sep [ptext SLIT("Probable cause: the source code which generated"),
786              nest 2 iface_file,
787              ptext SLIT("has an incompatible module name")
788             ]
789         ]
790   where iface_file = doubleQuotes (text file_path)
791 \end{code}