X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=844c6a105374c0e1a26a2d18c803921709bfca3b;hp=f8ab29dcd593189f77eb18929143305d51ae4b5a;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index f8ab29d..844c6a1 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -42,6 +42,13 @@
   the scrutinee of the case, and we can inline it.  
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module SetLevels (
 	setLevels, 
 
@@ -56,7 +63,7 @@ module SetLevels (
 import CoreSyn
 
 import DynFlags	( FloatOutSwitches(..) )
-import CoreUtils	( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
+import CoreUtils	( exprType, exprIsTrivial, mkPiTypes )
 import CoreFVs		-- all of it
 import CoreSubst	( Subst, emptySubst, extendInScope, extendIdSubst,
 			  cloneIdBndr, cloneRecIdBndrs )
@@ -290,6 +297,10 @@ lvlExpr ctxt_lvl env (_, AnnNote note expr)
   = lvlExpr ctxt_lvl env expr 		`thenLvl` \ expr' ->
     returnLvl (Note note expr')
 
+lvlExpr ctxt_lvl env (_, AnnCast expr co)
+  = lvlExpr ctxt_lvl env expr		`thenLvl` \ expr' ->
+    returnLvl (Cast expr' co)
+
 -- We don't split adjacent lambdas.  That is, given
 --	\x y -> (x+1,y)
 -- we don't float to give 
@@ -395,21 +406,9 @@ lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
 	-- that if we'll escape a value lambda, or will go to the top level.
     good_destination 
 	| dest_lvl `ltMajLvl` ctxt_lvl		-- Escapes a value lambda
-	= not (exprIsCheap expr) || isTopLvl dest_lvl
-	  -- Even if it escapes a value lambda, we only
-	  -- float if it's not cheap (unless it'll get all the
-	  -- way to the top).  I've seen cases where we
-	  -- float dozens of tiny free expressions, which cost
-	  -- more to allocate than to evaluate.
-	  -- NB: exprIsCheap is also true of bottom expressions, which
-	  --     is good; we don't want to share them
-	  --
-	  -- It's only Really Bad to float a cheap expression out of a
-	  -- strict context, because that builds a thunk that otherwise
-	  -- would never be built.  So another alternative would be to
-	  -- add 
-	  -- 	|| (strict_ctxt && not (exprIsBottom expr))
-	  -- to the condition above. We should really try this out.
+	= True
+	-- OLD CODE: not (exprIsCheap expr) || isTopLvl dest_lvl
+	-- 	     see Note [Escaping a value lambda]
 
 	| otherwise		-- Does not escape a value lambda
 	= isTopLvl dest_lvl 	-- Only float if we are going to the top level
@@ -429,6 +428,48 @@ lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
 	  -- which is pretty stupid.  Hence the strict_ctxt test
 \end{code}
 
+Note [Escaping a value lambda]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to float even cheap expressions out of value lambdas, 
+because that saves allocation.  Consider
+	f = \x.  .. (\y.e) ...
+Then we'd like to avoid allocating the (\y.e) every time we call f,
+(assuming e does not mention x).   
+
+An example where this really makes a difference is simplrun009.
+
+Another reason it's good is because it makes SpecContr fire on functions.
+Consider
+	f = \x. ....(f (\y.e))....
+After floating we get
+	lvl = \y.e
+	f = \x. ....(f lvl)...
+and that is much easier for SpecConstr to generate a robust specialisation for.
+
+The OLD CODE (given where this Note is referred to) prevents floating
+of the example above, so I just don't understand the old code.  I
+don't understand the old comment either (which appears below).  I
+measured the effect on nofib of changing OLD CODE to 'True', and got
+zeros everywhere, but a 4% win for 'puzzle'.  Very small 0.5% loss for
+'cse'; turns out to be because our arity analysis isn't good enough
+yet (mentioned in Simon-nofib-notes).
+
+OLD comment was:
+	 Even if it escapes a value lambda, we only
+	 float if it's not cheap (unless it'll get all the
+	 way to the top).  I've seen cases where we
+	 float dozens of tiny free expressions, which cost
+	 more to allocate than to evaluate.
+	 NB: exprIsCheap is also true of bottom expressions, which
+	     is good; we don't want to share them
+
+	It's only Really Bad to float a cheap expression out of a
+	strict context, because that builds a thunk that otherwise
+	would never be built.  So another alternative would be to
+	add 
+		|| (strict_ctxt && not (exprIsBottom expr))
+	to the condition above. We should really try this out.
+
 
 %************************************************************************
 %*									*
@@ -767,8 +808,7 @@ absVarsOf dest_lvl (_, lvl_env, _, id_env) v
 			Just (abs_vars, _) -> abs_vars
 			Nothing	           -> [v]
 
-    add_tyvars v | isId v    = v : varSetElems (idFreeTyVars v)
-		 | otherwise = [v]
+    add_tyvars v = v : varSetElems (varTypeTyVars v)
 
 	-- We are going to lambda-abstract, so nuke any IdInfo,
 	-- and add the tyvars of the Id (if necessary)
@@ -839,9 +879,11 @@ cloneRecVars NotTopLevel env@(_,_,subst,_) vs ctxt_lvl dest_lvl
     returnUs (env', vs2)
 
 	-- VERY IMPORTANT: we must zap the demand info 
-	-- if the thing is going to float out past a lambda
+	-- if the thing is going to float out past a lambda,
+	-- or if it's going to top level (where things can't be strict)
 zap_demand dest_lvl ctxt_lvl id
-  | ctxt_lvl == dest_lvl = id			-- Stays put
-  | otherwise		 = zapDemandIdInfo id	-- Floats out
+  | ctxt_lvl == dest_lvl,
+    not (isTopLvl dest_lvl) = id	-- Stays, and not going to top level
+  | otherwise		    = zapDemandIdInfo id	-- Floats out
 \end{code}