From: simonpj <unknown>
Date: Fri, 7 Sep 2001 16:46:21 +0000 (+0000)
Subject: [project @ 2001-09-07 16:46:21 by simonpj]
X-Git-Tag: Approximately_9120_patches~1007
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=dd27c95844ede8ea93b871eb7f0489f09f5020ff;p=ghc-hetmet.git

[project @ 2001-09-07 16:46:21 by simonpj]
Make dmdFix not loop forever
---

diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
index 66e1395..3f84afd 100644
--- a/ghc/compiler/stranal/DmdAnal.lhs
+++ b/ghc/compiler/stranal/DmdAnal.lhs
@@ -279,10 +279,10 @@ dmdFix :: TopLevelFlag
        -> (SigEnv, DmdEnv,
 	   [(Id,CoreExpr)])	-- Binders annotated with stricness info
 
-dmdFix top_lvl sigs pairs
-  = loop 1 initial_sigs pairs
+dmdFix top_lvl sigs orig_pairs
+  = loop 1 initial_sigs orig_pairs
   where
-    bndrs        = map fst pairs
+    bndrs        = map fst orig_pairs
     initial_sigs = extendSigEnvList sigs [(id, (initial_sig id, top_lvl)) | id <- bndrs]
     
     loop :: Int
@@ -296,11 +296,11 @@ dmdFix top_lvl sigs pairs
 		-- processing the RHSs with sigs (= sigs'), whereas pairs 
 		-- is the result of processing the RHSs with the *previous* 
 		-- iteration of sigs.
-      | n >= 5       = pprTrace "dmdFix loop" (ppr n <+> (vcat 
+      | n >= 10       = pprTrace "dmdFix loop" (ppr n <+> (vcat 
 				[ text "Sigs:" <+> ppr [(id,lookup sigs id, lookup sigs' id) | (id,_) <- pairs],
 				  text "env:" <+> ppr (ufmToList sigs),
 				  text "binds:" <+> pprCoreBinding (Rec pairs)]))
-			      (loop (n+1) sigs' pairs')
+			      (emptySigEnv, emptyDmdEnv, orig_pairs)	-- Safe output
       | otherwise    = loop (n+1) sigs' pairs'
       where
 		-- Use the new signature to do the next pair