import RnMonad
import RnNames ( getGlobalNames )
import RnSource ( rnDecl )
-import RnIfaces ( getImportedInstDecls, getDecl, getImportVersions, getSpecialInstModules,
- mkSearchPath, getWiredInDecl
+import RnIfaces ( getImportedInstDecls, importDecl, getImportVersions, getSpecialInstModules,
+ mkSearchPath
)
import RnEnv ( availsToNameSet, addAvailToNameSet,
addImplicitOccsRn, lookupImplicitOccRn )
) `thenRn` \ rn_local_decls ->
-- SLURP IN ALL THE NEEDED DECLARATIONS
- -- Notice that the rnEnv starts empty
- closeDecls rn_local_decls (availsToNameSet local_avails) []
- `thenRn` \ (rn_all_decls1, all_names1, imp_avails1) ->
-
- -- SLURP IN ALL NEEDED INSTANCE DECLARATIONS
- -- We extract instance decls that only mention things (type constructors, classes) that are
- -- already imported. Those that don't can't possibly be useful to us.
- --
- -- We do another closeDecls, so that we can slurp info for the dictionary functions
- -- for the instance declaration. These are *not* optional because the version number on
- -- the dfun acts as the version number for the instance declaration itself; if the
- -- instance decl changes, so will its dfun version number.
- getImportedInstDecls `thenRn` \ imported_insts ->
- let
- all_big_names = mkNameSet [name | Avail name _ <- local_avails] `unionNameSets`
- mkNameSet [name | Avail name _ <- imp_avails1]
-
- rn_needed_insts = [ initRnMS emptyRnEnv mod_name InterfaceMode (rnDecl (InstD inst_decl))
- | (inst_names, mod_name, inst_decl) <- imported_insts,
- all (`elemNameSet` all_big_names) inst_names
- ]
- in
- sequenceRn rn_needed_insts `thenRn` \ inst_decls ->
- closeDecls rn_all_decls1 all_names1 imp_avails1 `thenRn` \ (rn_all_decls2, all_names2, imp_avails2) ->
+ closeDecls rn_local_decls `thenRn` \ rn_all_decls ->
-- GENERATE THE VERSION/USAGE INFO
- getImportVersions imp_avails2 `thenRn` \ import_versions ->
+ getImportVersions mod_name exports `thenRn` \ import_versions ->
getNameSupplyRn `thenRn` \ name_supply ->
renamed_module = HsModule mod_name vers
trashed_exports trashed_imports trashed_fixities
- (inst_decls ++ rn_all_decls2)
+ rn_all_decls
loc
in
returnRn (Just (renamed_module,
\begin{code}
closeDecls :: [RenamedHsDecl] -- Declarations got so far
- -> NameSet -- Names bound by those declarations
- -> [AvailInfo] -- Available stuff generated by closeDecls so far
- -> RnMG ([RenamedHsDecl], -- input + extra decls slurped
- NameSet, -- input + names bound by extra decls
- [AvailInfo]) -- input + extra avails from extra decls
+ -> RnMG [RenamedHsDecl] -- input + extra decls slurped
-- The monad includes a list of possibly-unresolved Names
-- This list is empty when closeDecls returns
-closeDecls decls decl_names import_avails
+closeDecls decls
= popOccurrenceName `thenRn` \ maybe_unresolved ->
-
case maybe_unresolved of
- -- No more unresolved names; we're done
- Nothing -> returnRn (decls, decl_names, import_avails)
-
- -- An "unresolved" name that we've already dealt with
- Just (name,_) | name `elemNameSet` decl_names
- -> closeDecls decls decl_names import_avails
+ -- No more unresolved names
+ Nothing -> -- Slurp instance declarations
+ getImportedInstDecls `thenRn` \ inst_decls ->
+ traceRn (ppSep [ppPStr SLIT("Slurped"), ppInt (length inst_decls), ppPStr SLIT("instance decls")])
+ `thenRn_`
+
+ -- None? then at last we are done
+ if null inst_decls then
+ returnRn decls
+ else
+ mapRn rn_inst_decl inst_decls `thenRn` \ new_inst_decls ->
+
+ -- We *must* loop again here. Why? Two reasons:
+ -- (a) an instance decl will give rise to an unresolved dfun, whose
+ -- decl we must slurp to get its version number; that's the version
+ -- number for the whole instance decl.
+ -- (b) an instance decl might give rise to a new unresolved class,
+ -- whose decl we must slurp, which might let in some new instance decls,
+ -- and so on. Example: instance Foo a => Baz [a] where ...
- -- An unresolved name that's wired in. In this case there's no
- -- declaration to get, but we still want to record it as now available,
- -- so that we remember to look for instance declarations involving it.
- Just (name,_) | isWiredInName name
- -> getWiredInDecl name `thenRn` \ decl_avail ->
- closeDecls decls
- (addAvailToNameSet decl_names decl_avail)
- (decl_avail : import_avails)
-
- -- Genuinely unresolved name
- Just (name,necessity) | otherwise
- -> getDecl name `thenRn` \ (decl_avail,new_decl) ->
- case decl_avail of
-
- -- Can't find the declaration; check that it was optional
- NotAvailable -> case necessity of {
- Optional -> addWarnRn (getDeclWarn name);
- other -> addErrRn (getDeclErr name)
- } `thenRn_`
- closeDecls decls decl_names import_avails
-
- -- Found it
- other -> initRnMS emptyRnEnv mod_name InterfaceMode (
- rnDecl new_decl
- ) `thenRn` \ rn_decl ->
- closeDecls (rn_decl : decls)
- (addAvailToNameSet decl_names decl_avail)
- (decl_avail : import_avails)
+ closeDecls (new_inst_decls ++ decls)
+
+ -- An unresolved name
+ Just (name,necessity)
+ -> -- Slurp its declaration, if any
+-- traceRn (ppSep [ppPStr SLIT("Considering"), ppr PprDebug name]) `thenRn_`
+ importDecl name necessity `thenRn` \ maybe_decl ->
+ case maybe_decl of
+
+ -- No declaration... (wired in thing or optional)
+ Nothing -> closeDecls decls
+
+ -- Found a declaration... rename it
+ Just decl -> rn_iface_decl mod_name decl `thenRn` \ new_decl ->
+ closeDecls (new_decl : decls)
where
(mod_name,_) = modAndOcc name
+ where
+ -- Notice that the rnEnv starts empty
+ rn_iface_decl mod_name decl = initRnMS emptyRnEnv mod_name InterfaceMode (rnDecl decl)
+ rn_inst_decl (mod_name,decl) = rn_iface_decl mod_name (InstD decl)
-getDeclErr name sty
- = ppSep [ppStr "Failed to find interface decl for", ppr sty name]
-
-getDeclWarn name sty
- = ppSep [ppStr "Warning: failed to find (optional) interface decl for", ppr sty name]
\end{code}
projects / ghc-hetmet.git / blobdiff