SpecConstr was conservative about avoiding reboxing (see Note [Reboxing])
but that meant it lost useful opportunities. This patch makes it much
more aggressive, but at the risk of doing some reboxing.
Actually, the strictness analyser has the same property (it's possible
for it to generate reboxing code, and thus increase allocation), but we
don't worry so much about that. Maybe we should.
Ideally, one would do some more sophisticated analysis that spotted
the reboxing cases without excluding the useful ones.
But meanwhile, let's try this.
ppr BothOcc = ptext SLIT("both-occ")
ppr NoOcc = ptext SLIT("no-occ")
ppr BothOcc = ptext SLIT("both-occ")
ppr NoOcc = ptext SLIT("no-occ")
+-- Experimentally, this vresion of combineOcc makes ScrutOcc "win", so
+-- that if the thing is scrutinised anywhere then we get to see that
+-- in the overall result, even if it's also used in a boxed way
+-- This might be too agressive; see Note [Reboxing]
combineOcc NoOcc occ = occ
combineOcc occ NoOcc = occ
combineOcc (ScrutOcc xs) (ScrutOcc ys) = ScrutOcc (plusUFM_C combineOccs xs ys)
combineOcc NoOcc occ = occ
combineOcc occ NoOcc = occ
combineOcc (ScrutOcc xs) (ScrutOcc ys) = ScrutOcc (plusUFM_C combineOccs xs ys)
+combineOcc occ (ScrutOcc ys) = ScrutOcc ys
+combineOcc (ScrutOcc xs) occ = ScrutOcc xs
combineOcc UnkOcc UnkOcc = UnkOcc
combineOcc _ _ = BothOcc
combineOcc UnkOcc UnkOcc = UnkOcc
combineOcc _ _ = BothOcc
specialise env fn bndrs body body_usg
= do { let (_, bndr_occs) = lookupOccs body_usg bndrs
specialise env fn bndrs body body_usg
= do { let (_, bndr_occs) = lookupOccs body_usg bndrs
+ all_calls = lookupVarEnv (calls body_usg) fn `orElse` []
- ; mb_calls <- -- pprTrace "specialise" (ppr fn <+> ppr bndrs <+> ppr bndr_occs) $
- mapM (callToPats (scope env) bndr_occs)
- (lookupVarEnv (calls body_usg) fn `orElse` [])
+ ; mb_pats <- mapM (callToPats (scope env) bndr_occs) all_calls
- ; let good_calls :: [([Var], [CoreArg])]
- good_calls = catMaybes mb_calls
+ ; let good_pats :: [([Var], [CoreArg])]
+ good_pats = catMaybes mb_pats
in_scope = mkInScopeSet $ unionVarSets $
[ exprsFreeVars pats `delVarSetList` vs
in_scope = mkInScopeSet $ unionVarSets $
[ exprsFreeVars pats `delVarSetList` vs
- | (vs,pats) <- good_calls ]
- uniq_calls = nubBy (same_call in_scope) good_calls
- ; mapAndUnzipUs (spec_one env fn (mkLams bndrs body))
- (uniq_calls `zip` [1..]) }
+ | (vs,pats) <- good_pats ]
+ uniq_pats = nubBy (same_pat in_scope) good_pats
+ ; -- pprTrace "specialise" (vcat [ppr fn <+> ppr bndrs <+> ppr bndr_occs,
+ -- text "calls" <+> ppr all_calls,
+ -- text "good pats" <+> ppr good_pats,
+ -- text "uniq pats" <+> ppr uniq_pats]) $
+ mapAndUnzipUs (spec_one env fn (mkLams bndrs body))
+ (uniq_pats `zip` [1..]) }
- -- Two calls are the same if they match both ways
- same_call in_scope (vs1,as1)(vs2,as2)
+ -- Two pats are the same if they match both ways
+ same_pat in_scope (vs1,as1)(vs2,as2)
= isJust (matchN in_scope vs1 as1 as2)
&& isJust (matchN in_scope vs2 as2 as1)
= isJust (matchN in_scope vs1 as1 as2)
&& isJust (matchN in_scope vs2 as2 as1)
| Just (CV dc args) <- is_con_app_maybe con_env arg
, case arg_occ of
ScrutOcc _ -> True -- Used only by case scrutinee
| Just (CV dc args) <- is_con_app_maybe con_env arg
, case arg_occ of
ScrutOcc _ -> True -- Used only by case scrutinee
- BothOcc -> case arg of -- Used by case scrut
- App {} -> True -- ...and elsewhere...
+ BothOcc -> case arg of -- Used elsewhere
+ App {} -> True -- see Note [Reboxing]
other -> False
other -> False -- No point; the arg is not decomposed
= do { args' <- argsToPats in_scope con_env (args `zip` conArgOccs arg_occ dc)
other -> False
other -> False -- No point; the arg is not decomposed
= do { args' <- argsToPats in_scope con_env (args `zip` conArgOccs arg_occ dc)