X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=2050f4d689168da3b186ca8444994c652f5a3a92;hb=6bb68af67f4782e1d02f186c1a6c01ff4e430202;hp=1b46aa9fe2500adcb2c9ef74d39e6aed5abbd940;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 1b46aa9..2050f4d 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -632,7 +632,7 @@ addNonRecWithUnf env new_bndr new_rhs new_unfolding
     ASSERT( isId new_bndr )
     WARN( new_arity < old_arity || new_arity < dmd_arity, 
           (ptext (sLit "Arity decrease:") <+> ppr final_id <+> ppr old_arity
-		<+> ppr new_arity <+> ppr dmd_arity) $$ ppr new_rhs )
+		<+> ppr new_arity <+> ppr dmd_arity) )
 	-- Note [Arity decrease]
 
     final_id `seq`   -- This seq forces the Id, and hence its IdInfo,
@@ -819,7 +819,7 @@ simplExprF' env expr@(Lam _ _) cont
 
 simplExprF' env (Type ty) cont
   = ASSERT( contIsRhsOrArg cont )
-    do  { ty' <- simplType env ty
+    do  { ty' <- simplCoercion env ty
         ; rebuild env (Type ty') cont }
 
 simplExprF' env (Case scrut bndr _ alts) cont
@@ -857,6 +857,8 @@ simplType env ty
 
 ---------------------------------
 simplCoercion :: SimplEnv -> InType -> SimplM OutType
+-- The InType isn't *necessarily* a coercion, but it might be
+-- (in a type application, say) and optCoercion is a no-op on types
 simplCoercion env co
   = do { co' <- simplType env co
        ; return (optCoercion co') }
@@ -1165,7 +1167,7 @@ rebuildCall env fun (ArgInfo { ai_strs = [] }) cont
                    | otherwise = mkCoerce co expr
 
 rebuildCall env fun info (ApplyTo _ (Type arg_ty) se cont)
-  = do  { ty' <- simplType (se `setInScope` env) arg_ty
+  = do  { ty' <- simplCoercion (se `setInScope` env) arg_ty
         ; rebuildCall env (fun `App` Type ty') info cont }
 
 rebuildCall env fun