From: simonpj <unknown>
Date: Wed, 3 Jan 2001 10:57:41 +0000 (+0000)
Subject: [project @ 2001-01-03 10:57:41 by simonpj]
X-Git-Tag: Approximately_9120_patches~2987
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=11b6ad6c7fa563c0413b74d08b30f165b177d92c;p=ghc-hetmet.git

[project @ 2001-01-03 10:57:41 by simonpj]
Dont apply rules for a loop breaker
---

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 23f6f93..4683370 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -516,7 +516,7 @@ completeBinding old_bndr new_bndr top_lvl black_listed new_rhs thing_inside
 	-- We're looking at a binding with a trivial RHS, so
 	-- perhaps we can discard it altogether!
 	--
-	-- NB: a loop breaker never has postInlineUnconditionally True
+	-- NB: a loop breaker has must_keep_binding = True
 	-- and non-loop-breakers only have *forward* references
 	-- Hence, it's safe to discard the binding
 	--	
@@ -764,7 +764,7 @@ simplVar var cont
 ---------------------------------------------------------
 --	Dealing with a call
 
-completeCall var occ cont
+completeCall var occ_info cont
   = getBlackList		`thenSmpl` \ black_list_fn ->
     getInScope			`thenSmpl` \ in_scope ->
     getContArgs var cont	`thenSmpl` \ (args, call_cont, inline_call) ->
@@ -781,7 +781,7 @@ completeCall var occ cont
 	inline_cont | inline_call = discardInline cont
 		    | otherwise   = cont
 
-	maybe_inline = callSiteInline dflags black_listed inline_call occ
+	maybe_inline = callSiteInline dflags black_listed inline_call occ_info
 				      var arg_infos interesting_cont
     in
 	-- First, look for an inlining
@@ -809,10 +809,15 @@ completeCall var occ cont
 	-- But the black-listing mechanism means that inlining of the wrapper
 	-- won't occur for things that have specialisations till a later phase, so
 	-- it's ok to try for inlining first.
+	--
+	-- Don't apply rules for a loop breaker: doing so might give rise
+	-- to an infinite loop, for the same reasons that inlining the ordinary
+	-- RHS of a loop breaker might.
 
     getSwitchChecker 	`thenSmpl` \ chkr ->
     let
-	maybe_rule | switchIsOn chkr DontApplyRules = Nothing
+	maybe_rule |  switchIsOn chkr DontApplyRules 
+		   || isLoopBreaker occ_info	    = Nothing
 		   | otherwise			    = lookupRule in_scope var args' 
     in
     case maybe_rule of {