X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=fd76f235bd8ce585c69532ce3db2d41ee283e110;hb=6a944ae7fe1e8e2e456c68717188463263f8978f;hp=fa9f5dcfb398a3951cd3aee6e97581e491a7a057;hpb=83361f58746ae08040079a6d809127bca2ae3f4c;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index fa9f5dc..fd76f23 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -93,11 +93,12 @@ mkUnfolding top_lvl expr
 	-- Sometimes during simplification, there's a large let-bound thing	
 	-- which has been substituted, and so is now dead; so 'expr' contains
 	-- two copies of the thing while the occurrence-analysed expression doesn't
-	-- Nevertheless, we don't occ-analyse before computing the size because the
+	-- Nevertheless, we *don't* occ-analyse before computing the size because the
 	-- size computation bales out after a while, whereas occurrence analysis does not.
 	--
 	-- This can occasionally mean that the guidance is very pessimistic;
-	-- it gets fixed up next round
+	-- it gets fixed up next round.  And it should be rare, because large
+	-- let-bound things that are dead are usually caught by preInlineUnconditionally
 
 mkCoreUnfolding :: Bool -> CoreExpr -> Arity -> UnfoldingGuidance -> Unfolding
 -- Occurrence-analyses the expression before capturing it
@@ -121,7 +122,8 @@ mkWwInlineRule id expr arity
 
 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
 mkCompulsoryUnfolding expr	   -- Used for things that absolutely must be unfolded
-  = mkCoreUnfolding True expr 0    -- Arity of unfolding doesn't matter
+  = mkCoreUnfolding True expr 
+                    0    -- Arity of unfolding doesn't matter
                     (InlineRule { ir_info = InlAlways, ir_sat = InlUnSat })	
 
 mkInlineRule :: InlSatFlag -> CoreExpr -> Arity -> Unfolding
@@ -190,6 +192,7 @@ Examples
   --------------
     0	  42#
     0	  x
+    0     True
     2	  f x
     1	  Just x
     4 	  f (g x)
@@ -316,9 +319,13 @@ sizeExpr bOMB_OUT_SIZE top_args expr
 	   _     	    -> funSize top_args fun (length val_args)
 
     ------------ 
-    size_up_alt (_con, _bndrs, rhs) = size_up rhs
+    size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 1
  	-- Don't charge for args, so that wrappers look cheap
 	-- (See comments about wrappers with Case)
+	--
+	-- IMPORATANT: *do* charge 1 for the alternative, else we 
+	-- find that giant case nests are treated as practically free
+	-- A good example is Foreign.C.Error.errrnoToIOError
 
     ------------
 	-- These addSize things have to be here because
@@ -389,7 +396,7 @@ funSize top_args fun n_val_args
 
 conSize :: DataCon -> Int -> ExprSize
 conSize dc n_val_args
-  | n_val_args == 0      = SizeIs (_ILIT(0)) emptyBag (_ILIT(1))
+  | n_val_args == 0      = SizeIs (_ILIT(0)) emptyBag (_ILIT(1))	-- Like variables
   | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox n_val_args +# _ILIT(1))
   | otherwise		 = SizeIs (_ILIT(1)) emptyBag (iUnbox n_val_args +# _ILIT(1))
 	-- Treat a constructors application as size 1, regardless of how
@@ -626,10 +633,7 @@ instance Outputable CallCtxt where
   ppr ValAppCtxt      = ptext (sLit "ValAppCtxt")
 
 callSiteInline dflags active_inline id lone_variable arg_infos cont_info
-  = let
-	n_val_args  = length arg_infos
-    in
-    case idUnfolding id of {
+  = case idUnfolding id of {
 	NoUnfolding 	 -> Nothing ;
 	OtherCon _  	 -> Nothing ;
 	DFunUnfolding {} -> Nothing ;	-- Never unfold a DFun
@@ -638,6 +642,8 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 			-- uf_arity will typically be equal to (idArity id), 
 			-- but may be less for InlineRules
     let
+	n_val_args  = length arg_infos
+
 	result | yes_or_no = Just unf_template
 	       | otherwise = Nothing
 
@@ -1125,7 +1131,9 @@ exprIsConApp_maybe expr
                       analyse rhs args
         where
 	  is_saturated = count isValArg args == idArity fun
-          unfolding = idUnfolding fun
+          unfolding = idUnfolding fun    -- Does not look through loop breakers
+		    -- ToDo: we *may* look through variables that are NOINLINE
+		    --       in this phase, and that is really not right
 
     analyse _ _ = Nothing