[project @ 2001-01-25 17:14:06 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / Simplify.lhs

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 34f4dee..56466cb 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -1219,7 +1219,11 @@ knownCon :: OutExpr -> AltCon -> [OutExpr]
         -> SimplM OutExprStuff
 
 knownCon expr con args bndr alts se cont
-  = tick (KnownBranch bndr)    `thenSmpl_`
+  =    -- Arguments should be atomic;
+       -- yell if not
+    WARN( not (all exprIsTrivial args), 
+         text "knownCon" <+> ppr expr )
+    tick (KnownBranch bndr)    `thenSmpl_`
     setSubstEnv se             (
     simplBinder bndr           $ \ bndr' ->
     completeBinding bndr bndr' False False expr $