- details = [details | (details, _, _) <- cycle]
- bndrs = [bndr | (bndr, _, _) <- details]
- rhs_usages = [rhs_usage | (_, rhs_usage, _) <- details]
- total_usage = foldr combineUsageDetails body_usage rhs_usages
- (combined_usage, tagged_bndrs) = tagBinders total_usage bndrs
- final_bind = Rec (reOrderRec env new_cycle)
-
- new_cycle = CyclicSCC (zipWithEqual "occAnalBind" mk_new_bind tagged_bndrs cycle)
- mk_new_bind tagged_bndr ((_, _, rhs'), key, keys) = ((tagged_bndr, rhs'), key, keys)
+ details = [details | (details, _, _) <- cycle]
+ bndrs = [bndr | (bndr, _, _) <- details]
+ bndr_usages = [addRuleUsage rhs_usage bndr | (bndr, rhs_usage, _) <- details]
+ total_usage = foldr (+++) body_usage bndr_usages
+ (final_usage, tagged_cycle) = mapAccumL tag_bind total_usage cycle
+ tag_bind usg ((bndr,rhs_usg,rhs),k,ks) = (usg', ((bndr',rhs_usg,rhs),k,ks))
+ where
+ (usg', bndr') = tagBinder usg bndr
+ final_bind = Rec (reOrderCycle (mkVarSet bndrs) tagged_cycle)
+
+{- An alternative; rebuild the edges. No semantic difference, but perf might change
+
+ -- Hopefully 'bndrs' is a relatively small group now
+ -- Now get ready for the loop-breaking phase
+ -- We've done dead-code elimination already, so no worries about un-referenced binders
+ keys = map idUnique bndrs
+ mk_node tagged_bndr (_, rhs_usage, rhs')
+ = ((tagged_bndr, rhs'), idUnique tagged_bndr, used)
+ where
+ used = [key | key <- keys, used_outside_rule rhs_usage key ]
+
+ used_outside_rule usage uniq = case lookupUFM_Directly usage uniq of
+ Nothing -> False
+ Just RulesOnly -> False -- Ignore rules
+ other -> True
+-}