[project @ 1998-05-22 15:27:05 by simonm]

Back out some changes that accidentally made it into the last commit.

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 5d1f2b2..d06fd93 100644 (file)
--- 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}