-bindsToIds :: IdSet -- These Ids are needed already
- -> IdSet -- Ids used at code-gen time; they have better pragma info!
- -> [CoreBind] -- In dependency order, later depend on earlier
- -> [Id] -- Set of Ids actually spat out, complete with exactly the IdInfo
- -- they need for exporting to another module
-
-bindsToIds needed_ids codegen_ids binds
- = go needed_ids (reverse binds) []
- -- Reverse so that later things will
- -- provoke earlier ones to be emitted
- where
- -- The 'needed' set contains the Ids that are needed by earlier
- -- interface file emissions. If the Id isn't in this set, and isn't
- -- exported, there's no need to emit anything
- need_id needed_set id = id `elemVarSet` needed_set || isUserExportedId id
-
- go needed [] emitted
- | not (isEmptyVarSet needed) = pprTrace "ifaceBinds: free vars:"
- (sep (map ppr (varSetElems needed)))
- emitted
- | otherwise = emitted
-
- go needed (NonRec id rhs : binds) emitted
- | need_id needed id
- = if omitIfaceSigForId id then
- go (needed `delVarSet` id) binds (id:emitted)
- else
- go ((needed `unionVarSet` extras) `delVarSet` id)
- binds
- (new_id:emitted)
- | otherwise
- = go needed binds emitted
- where
- (new_id, extras) = mkFinalId codegen_ids False id rhs
-
- -- Recursive groups are a bit more of a pain. We may only need one to
- -- start with, but it may call out the next one, and so on. So we
- -- have to look for a fixed point. We don't want necessarily them all,
- -- because without -O we may only need the first one (if we don't emit
- -- its unfolding)
- go needed (Rec pairs : binds) emitted
- = go needed' binds emitted'
- where
- (new_emitted, extras) = go_rec needed pairs
- needed' = (needed `unionVarSet` extras) `minusVarSet` mkVarSet (map fst pairs)
- emitted' = new_emitted ++ emitted
-
- go_rec :: IdSet -> [(Id,CoreExpr)] -> ([Id], IdSet)
- go_rec needed pairs
- | null needed_prs = ([], emptyVarSet)
- | otherwise = (emitted ++ more_emitted,
- extras `unionVarSet` more_extras)
- where
- (needed_prs,leftover_prs) = partition is_needed pairs
- (emitted, extras_s) = unzip [ mkFinalId codegen_ids True id rhs
- | (id,rhs) <- needed_prs, not (omitIfaceSigForId id)]
- extras = unionVarSets extras_s
- (more_emitted, more_extras) = go_rec extras leftover_prs
-
- is_needed (id,_) = need_id needed id
-\end{code}
-
-
-
-\begin{code}
-mkFinalId :: IdSet -- The Ids with arity info from the code generator
- -> Bool -- True <=> recursive, so don't include unfolding
- -> Id
- -> CoreExpr -- The Id's right hand side
- -> (Id, IdSet) -- The emitted id, plus any *extra* needed Ids
-
-mkFinalId codegen_ids is_rec id rhs
- = (id `setIdInfo` new_idinfo, new_needed_ids)
- where
- core_idinfo = idInfo id
- stg_idinfo = case lookupVarSet codegen_ids id of
- Just id' -> idInfo id'
- Nothing -> pprTrace "ifaceBinds not found:" (ppr id) $
- idInfo id
-
- new_idinfo | opt_OmitInterfacePragmas
- = vanillaIdInfo
- | otherwise
- = core_idinfo `setArityInfo` arity_info
- `setCafInfo` cafInfo stg_idinfo
- `setUnfoldingInfo` unfold_info
- `setWorkerInfo` worker_info
- `setSpecInfo` emptyCoreRules
- -- We zap the specialisations because they are
- -- passed on separately through the modules IdCoreRules
-
- ------------ Arity --------------
- arity_info = arityInfo stg_idinfo
- stg_arity = arityLowerBound arity_info
-
- ------------ Worker --------------
- -- We only treat a function as having a worker if
- -- the exported arity (which is now the number of visible lambdas)
- -- is the same as the arity at the moment of the w/w split
- -- If so, we can safely omit the unfolding inside the wrapper, and
- -- instead re-generate it from the type/arity/strictness info
- -- But if the arity has changed, we just take the simple path and
- -- put the unfolding into the interface file, forgetting the fact
- -- that it's a wrapper.
+mkUsageInfo :: HscEnv -> ExternalPackageState
+ -> ImportAvails -> Usages
+ -> [ImportVersion Name]
+
+mkUsageInfo hsc_env eps
+ (ImportAvails { imp_mods = dir_imp_mods })
+ (Usages { usg_ext = pkg_mods,
+ usg_home = home_names })
+ = let
+ hpt = hsc_HPT hsc_env
+ pit = eps_PIT eps
+
+ import_all_mods = [moduleName m | (m,True) <- moduleEnvElts dir_imp_mods]
+
+ -- mv_map groups together all the things imported and used
+ -- from a particular module in this package
+ -- We use a finite map because we want the domain
+ mv_map :: ModuleEnv [Name]
+ mv_map = foldNameSet add_mv emptyModuleEnv home_names
+ add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
+ where
+ mod = nameModule name
+ add_item names _ = name:names
+
+ -- In our usage list we record