+finalIfaceInfo iface_cache@(IfaceCache _ _ iface_var) modname if_final_env@((qual, unqual, tc_qual, tc_unqual), stack) if_instdecls
+ =
+-- pprTrace "usageIf:qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (n,m) <- keysFM qual]) $
+-- pprTrace "usageIf:unqual:" (ppCat (map ppPStr (keysFM unqual))) $
+-- pprTrace "usageIf:tc_qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (n,m) <- keysFM tc_qual]) $
+-- pprTrace "usageIf:tc_unqual:" (ppCat (map ppPStr (keysFM tc_unqual))) $
+ readVar iface_var ST_THEN \ (_, orig_iface_fm, _) ->
+ let
+ all_ifaces = eltsFM orig_iface_fm
+ -- all the interfaces we have looked at
+
+ big_maps
+ -- combine all the version maps we have seen into maps to
+ -- (a) lookup a module-version number, lookup an entity's
+ -- individual version number
+ = foldr mk_map (emptyFM,emptyFM) all_ifaces
+
+ val_stuff@(val_usages, val_versions)
+ = foldFM (process_item big_maps) (emptyFM, emptyFM){-init-} qual
+
+ (all_usages, all_versions)
+ = foldFM (process_item big_maps) val_stuff{-keep going-} tc_qual
+ in
+ return (all_usages, all_versions, [])
+ where
+ mk_map (ParsedIface m _ mv _ _ vers _ _ _ _ _ _ _) (mv_map, ver_map)
+ = (addToFM mv_map m mv, -- add this module
+ addListToFM ver_map [ ((n,m), v) | (n,v) <- fmToList vers ])
+
+ -----------------------
+ process_item :: BigMaps
+ -> (FAST_STRING,Module) -> RnName -- RnEnv (QualNames) components
+ -> (UsagesMap, VersionsMap) -- input
+ -> (UsagesMap, VersionsMap) -- output
+
+ process_item (big_mv_map, big_version_map) key@(n,m) rn as_before@(usages, versions)
+ | irrelevant rn
+ = as_before
+ | m == modname -- this module => add to "versions"
+ = (usages, addToFM versions n 1{-stub-})
+ | otherwise -- from another module => add to "usages"
+ = case (add_to_usages usages key) of
+ Nothing -> as_before
+ Just new_usages -> (new_usages, versions)
+ where
+ add_to_usages usages key@(n,m)
+ = case (lookupFM big_mv_map m) of
+ Nothing -> Nothing
+ Just mv ->
+ case (lookupFM big_version_map key) of
+ Nothing -> Nothing
+ Just kv ->
+ Just $ addToFM usages m (
+ case (lookupFM usages m) of
+ Nothing -> -- nothing for this module yet...
+ (mv, unitFM n kv)
+
+ Just (mversion, mstuff) -> -- the "new" stuff will shadow the old
+ ASSERT(mversion == mv)
+ (mversion, addToFM mstuff n kv)
+ )
+
+ irrelevant (RnConstr _ _) = True -- We don't report these in their
+ irrelevant (RnField _ _) = True -- own right in usages/etc.
+ irrelevant (RnClassOp _ _) = True
+ irrelevant (RnImplicit n) = isLexCon (nameOf (origName "irrelevant" n)) -- really a RnConstr
+ irrelevant _ = False