From: simonpj <unknown>
Date: Wed, 24 Oct 2001 13:46:58 +0000 (+0000)
Subject: [project @ 2001-10-24 13:46:58 by simonpj]
X-Git-Tag: Approximately_9120_patches~719
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a2e93eceac693c8570bfd21e13c252be6bb2faf6;p=ghc-hetmet.git

[project @ 2001-10-24 13:46:58 by simonpj]
----------------------------------------------
	Minor fix to occurrence analyer (don't merge)
	----------------------------------------------

Wasn't dealing right with the case

	x = e
	y = foldr x

Here we don't want to inline x, because y is a PAP.
---

diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index 6e359a3..3ac0dcc 100644
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -671,9 +671,20 @@ the "build hack" to work.
 occAnalApp env (Var fun, args) is_rhs
   = case args_stuff of { (args_uds, args') ->
     let
-	final_uds = fun_uds `combineUsageDetails` args_uds
+	-- We mark the free vars of the argument of a constructor or PAP 
+	-- as "many", if it is the RHS of a let(rec).
+	-- This means that nothing gets inlined into a constructor argument
+	-- position, which is what we want.  Typically those constructor
+	-- arguments are just variables, or trivial expressions.
+	--
+	-- This is the *whole point* of the isRhsEnv predicate
+        final_args_uds
+		| isRhsEnv env,
+		  isDataConId fun || valArgCount args < idArity fun
+		= mapVarEnv markMany args_uds
+		| otherwise = args_uds
     in
-    (final_uds, mkApps (Var fun) args') }
+    (fun_uds `combineUsageDetails` final_args_uds, mkApps (Var fun) args') }
   where
     fun_uniq = idUnique fun
 
@@ -690,16 +701,6 @@ occAnalApp env (Var fun, args) is_rhs
 			--	foldr (\x -> let v = ...x... in \y -> ...v...) z xs
 			-- by floating in the v
 
-		| isRhsEnv env,
-		  isDataConId fun || valArgCount args < idArity fun
-		= case occAnalArgs env args of
-		    (arg_uds, args') -> (mapVarEnv markMany arg_uds, args')
-			-- We mark the free vars of the argument of a constructor or PAP 
-			-- as "many", if it is the RHS of a let(rec).
-			-- This means that nothing gets inlined into a constructor argument
-			-- position, which is what we want.  Typically those constructor
-			-- arguments are just variables, or trivial expressions.
-
 		| otherwise = occAnalArgs env args