From: simonmar <unknown>
Date: Wed, 14 Mar 2001 14:44:34 +0000 (+0000)
Subject: [project @ 2001-03-14 14:44:34 by simonmar]
X-Git-Tag: Approximately_9120_patches~2412
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=382f3ce4f1767b0591ec6c98de715be0f1292b57;p=ghc-hetmet.git

[project @ 2001-03-14 14:44:34 by simonmar]
don't consider SCC annotations in an argument to be trivial.
---

diff --git a/ghc/compiler/coreSyn/CorePrep.lhs b/ghc/compiler/coreSyn/CorePrep.lhs
index 6b3877d..13c642d 100644
--- a/ghc/compiler/coreSyn/CorePrep.lhs
+++ b/ghc/compiler/coreSyn/CorePrep.lhs
@@ -10,7 +10,7 @@ module CorePrep (
 
 #include "HsVersions.h"
 
-import CoreUtils( exprIsTrivial, exprIsAtom, exprType, exprIsValue, etaExpand )
+import CoreUtils( exprIsAtom, exprType, exprIsValue, etaExpand )
 import CoreFVs	( exprFreeVars )
 import CoreLint	( endPass )
 import CoreSyn
@@ -173,6 +173,18 @@ corePrepArg env arg dem
 needs_binding | opt_KeepStgTypes = exprIsAtom
 	      | otherwise	 = exprIsTrivial
 
+-- version that doesn't consider an scc annotation to be trivial.
+exprIsTrivial (Var v)
+  | hasNoBinding v		       = idArity v == 0
+  | otherwise                          = True
+exprIsTrivial (Type _)	      	       = True
+exprIsTrivial (Lit lit)       	       = True
+exprIsTrivial (App e arg)     	       = isTypeArg arg && exprIsTrivial e
+exprIsTrivial (Note (SCC _) e) 	       = False
+exprIsTrivial (Note _ e)      	       = exprIsTrivial e
+exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
+exprIsTrivial other	      	       = False
+
 -- ---------------------------------------------------------------------------
 -- Dealing with expressions
 -- ---------------------------------------------------------------------------