diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 5d1f2b2b699130b0bb21474b965f83ed65e72d7f..d06fd93cb3ed07481955c23b965ffa69d8776677 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -59,11 +59,7 @@ import TyCon ( tyConFamilySize )
import Type ( splitAlgTyConApp_maybe )
import Unique ( Unique )
import Util ( isIn, panic, assertPanic )
-import UniqFM
import Outputable
-
-import List ( maximumBy )
-import GlaExts --tmp
\end{code}
%************************************************************************
@@ -249,9 +245,7 @@ calcUnfoldingGuidance bOMB_OUT_SIZE expr
TooBig -> UnfoldNever
SizeIs size cased_args scrut_discount
- -> {- trace ("calcUnfoldingGuidance: \n" ++ showSDoc (ppr expr) ++ "\n"
- ++ show (I# size) ++ "\n" ++ show (map discount_for val_binders)) $ -}
- UnfoldIfGoodArgs
+ -> UnfoldIfGoodArgs
(length ty_binders)
(length val_binders)
(map discount_for val_binders)
@@ -259,16 +253,15 @@ calcUnfoldingGuidance bOMB_OUT_SIZE expr
(I# scrut_discount)
where
discount_for b
- | is_data = case lookupUFM cased_args b of
- Nothing -> 0
- Just d -> d
+ | is_data && b `is_elem` cased_args = tyConFamilySize tycon
| otherwise = 0
where
(is_data, tycon)
= case (splitAlgTyConApp_maybe (idType b)) of
Nothing -> (False, panic "discount")
Just (tc,_,_) -> (True, tc)
- }
+
+ is_elem = isIn "calcUnfoldingGuidance" }
\end{code}
\begin{code}
@@ -326,7 +319,9 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
size_up (Case scrut alts)
= nukeScrutDiscount (size_up scrut)
`addSize`
- size_up_alts scrut (coreExprType scrut) alts
+ arg_discount scrut
+ `addSize`
+ size_up_alts (coreExprType scrut) alts
-- We charge for the "case" itself in "size_up_alts"
------------
@@ -338,23 +333,11 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
size_up_arg other = sizeOne
------------
- size_up_alts scrut scrut_ty (AlgAlts alts deflt)
- = total_size
- `addSize`
- scrut_discount scrut
+ size_up_alts scrut_ty (AlgAlts alts deflt)
+ = (foldr (addSize . size_alg_alt) (size_up_deflt deflt) alts)
`addSizeN`
alt_cost
where
- alts_sizes = size_up_deflt deflt : map size_alg_alt alts
- total_size = foldr addSize sizeZero alts_sizes
-
- biggest_alt = maximumBy (\a b -> if ltSize a b then b else a) alts_sizes
-
- scrut_discount (Var v) | v `is_elem` args =
- scrutArg v (minusSize total_size biggest_alt + alt_cost)
- scrut_discount _ = sizeZero
-
-
size_alg_alt (con,args,rhs) = size_up rhs
-- Don't charge for args, so that wrappers look cheap
@@ -372,7 +355,7 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
Nothing -> 1
Just (tc,_,_) -> tyConFamilySize tc
- size_up_alts _ _ (PrimAlts alts deflt)
+ size_up_alts _ (PrimAlts alts deflt)
= foldr (addSize . size_prim_alt) (size_up_deflt deflt) alts
-- *no charge* for a primitive "case"!
where
@@ -383,6 +366,10 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
size_up_deflt (BindDefault binder rhs) = size_up rhs
------------
+ -- We want to record if we're case'ing an argument
+ arg_discount (Var v) | v `is_elem` args = scrutArg v
+ arg_discount other = sizeZero
+
is_elem :: Id -> [Id] -> Bool
is_elem = isIn "size_up_scrut"
@@ -397,14 +384,6 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
where
n_tot = n +# m
- -- trying to find a reasonable discount for eliminating this case.
- -- if the case is eliminated, in the worse case we end up with the
- -- largest alternative, so subtract the size of the largest alternative
- -- from the total size of the case to end up with the discount
- minusSize TooBig _ = 0
- minusSize _ TooBig = panic "CoreUnfold: minusSize" -- shouldn't happen
- minusSize (SizeIs n1 xs d1) (SizeIs n2 ys d2) = I# (n1 -# n2)
-
addSize TooBig _ = TooBig
addSize _ TooBig = TooBig
addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
@@ -413,9 +392,8 @@ sizeExpr (I# bOMB_OUT_SIZE) args expr
where
n_tot = n1 +# n2
d_tot = d1 +# d2
- xys = combineArgDiscounts xs ys
+ xys = xs ++ ys
-
\end{code}
@@ -425,25 +403,18 @@ Code for manipulating sizes
data ExprSize = TooBig
| SizeIs Int# -- Size found
- (UniqFM Int) -- discount for each argument
+ [Id] -- Arguments cased herein
Int# -- Size to subtract if result is scrutinised
-- by a case expression
-ltSize a TooBig = True
-ltSize TooBig a = False
-ltSize (SizeIs s1# _ _) (SizeIs s2# _ _) = s1# <=# s2#
-
-sizeZero = SizeIs 0# emptyUFM 0#
-sizeOne = SizeIs 1# emptyUFM 0#
-sizeN (I# n) = SizeIs n emptyUFM 0#
-conSizeN (I# n) = SizeIs n emptyUFM n
-scrutArg v d = SizeIs 0# (unitUFM v d) 0#
+sizeZero = SizeIs 0# [] 0#
+sizeOne = SizeIs 1# [] 0#
+sizeN (I# n) = SizeIs n [] 0#
+conSizeN (I# n) = SizeIs n [] n
+scrutArg v = SizeIs 0# [v] 0#
nukeScrutDiscount (SizeIs n vs d) = SizeIs n vs 0#
nukeScrutDiscount TooBig = TooBig
-
-combineArgDiscounts :: UniqFM Int -> UniqFM Int -> UniqFM Int
-combineArgDiscounts = plusUFM_C (+)
\end{code}
%************************************************************************
@@ -513,8 +484,8 @@ smallEnoughToInline id arg_is_evald_s result_is_scruted
result_discount | result_is_scruted = scrut_discount
| otherwise = 0
- arg_discount discount is_evald
- | is_evald = discount
+ arg_discount no_of_constrs is_evald
+ | is_evald = no_of_constrs * opt_UnfoldingConDiscount
| otherwise = 0
\end{code}