--------------------------------------------------------
-slurpImpDecls source_fvs
- = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
- -- The current slurped-set records all local things
- getSlurped `thenRn` \ local_binders ->
-
- slurpSourceRefs source_fvs `thenRn` \ (decls1, needed1, wired_in) ->
- let
- inst_gates1 = foldr (plusFV . getWiredInGates) source_fvs wired_in
- inst_gates2 = foldr (plusFV . getGates source_fvs) inst_gates1 decls1
- in
- -- Do this first slurpDecls before the getImportedInstDecls,
- -- so that the home modules of all the inst_gates will be sure to be loaded
- slurpDecls decls1 needed1 `thenRn` \ (decls2, needed2) ->
- mapRn_ (load_home local_binders) wired_in `thenRn_`
-
- -- Now we can get the instance decls
- getImportedInstDecls inst_gates2 `thenRn` \ inst_decls ->
- rnIfaceDecls decls2 needed2 inst_decls `thenRn` \ (decls3, needed3) ->
- closeDecls decls3 needed3
- where
- load_home local_binders name
- | name `elemNameSet` local_binders = returnRn ()
- -- When compiling the prelude, a wired-in thing may
- -- be defined in this module, in which case we don't
- -- want to load its home module!
- -- Using 'isLocallyDefined' doesn't work because some of
- -- the free variables returned are simply 'listTyCon_Name',
- -- with a system provenance. We could look them up every time
- -- but that seems a waste.
- | otherwise = loadHomeInterface doc name `thenRn_`
- returnRn ()
- where
- doc = ptext SLIT("need home module for wired in thing") <+> ppr name
-
--------------------------------------------------------
-slurpSourceRefs :: FreeVars -- Variables referenced in source
- -> RnMG ([RenamedHsDecl],
- FreeVars, -- Un-satisfied needs
- [Name]) -- Those variables referenced in the source
- -- that turned out to be wired in things
-
-slurpSourceRefs source_fvs
- = go [] emptyFVs [] (nameSetToList source_fvs)
- where
- go decls fvs wired []
- = returnRn (decls, fvs, wired)
- go decls fvs wired (wanted_name:refs)
- | isWiredInName wanted_name
- = go decls fvs (wanted_name:wired) refs
- | otherwise
- = importDecl wanted_name `thenRn` \ maybe_decl ->
- case maybe_decl of
- -- No declaration... (already slurped, or local)
- Nothing -> go decls fvs wired refs
- Just decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
- go (new_decl : decls) (fvs1 `plusFV` fvs) wired
- (extraGates new_decl ++ refs)
-
--- Hack alert. If we suck in a class
--- class Ord a => Baz a where ...
--- then Eq is also a 'gate'. Why? Because Eq is a superclass of Ord,
--- and hence may be needed during context reduction even though
--- Eq is never mentioned explicitly. So we snaffle out the super-classes
--- right now, so that slurpSourceRefs will heave them in
---
--- Similarly the RHS of type synonyms
-extraGates (TyClD (ClassDecl ctxt _ tvs _ _ _ _ _ _ _))
- = nameSetToList (delListFromNameSet (extractHsCtxtTyNames ctxt) (map getTyVarName tvs))
-extraGates (TyClD (TySynonym _ tvs ty _))
- = nameSetToList (delListFromNameSet (extractHsTyNames ty) (map getTyVarName tvs))
-extraGates other = []
-
--------------------------------------------------------
--- closeDecls keeps going until the free-var set is empty
-closeDecls decls needed
- | not (isEmptyFVs needed)
- = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
- closeDecls decls1 needed1
-
- | otherwise
- = getImportedRules `thenRn` \ rule_decls ->
- case rule_decls of
- [] -> returnRn decls -- No new rules, so we are done
- other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
- closeDecls decls1 needed1
-
-
--------------------------------------------------------
-rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
- -> [(Module, RdrNameHsDecl)]
- -> RnM d ([RenamedHsDecl], FreeVars)
-rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
-rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
- rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
-
-rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
-
-
--------------------------------------------------------
--- Augment decls with any decls needed by needed.
--- Return also free vars of the new decls (only)
-slurpDecls decls needed
- = go decls emptyFVs (nameSetToList needed)