- = IfaceRule SLIT("bogus") [] (getName id) [] (UfVar (getName id)) noSrcLoc
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Compute final Ids}
-%* *
-%************************************************************************
-
-A "final Id" has exactly the IdInfo for going into an interface file, or
-exporting to another module.
-
-\begin{code}
-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