From e8b4f75a43685b56d8300dee9db2472977fba8fc Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Tue, 16 Oct 2007 12:46:06 +0000
Subject: [PATCH] Eliminate over-zealous warning in CoreToStg

---
 compiler/stgSyn/CoreToStg.lhs |   10 ++++++++--
 compiler/types/TyCon.lhs      |    1 +
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 51e830c..91c9a20 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -563,9 +563,15 @@ coreToStgArgs (arg : args)	-- Non-type argument
     let
 	arg_ty = exprType arg
 	stg_arg_ty = stgArgType stg_arg
+	bad_args = (isUnLiftedType arg_ty && not (isUnLiftedType stg_arg_ty)) 
+		|| (typePrimRep arg_ty /= typePrimRep stg_arg_ty)
+	-- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted), 
+	-- and pass it to a function expecting an HValue (arg_ty).  This is ok because
+	-- we can treat an unlifted value as lifted.  But the other way round 
+	-- we complain.
+	-- We also want to check if a pointer is cast to a non-ptr etc
     in
-    WARN( isUnLiftedType arg_ty /= isUnLiftedType stg_arg_ty, 
-	  ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg)
+    WARN( bad_args, ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg )
     returnLne (stg_arg : stg_args, fvs)
 
 
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 0ac3bf0..84d16e0 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -475,6 +475,7 @@ data PrimRep
   | AddrRep		-- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep
+  deriving( Eq )
 
 -- Size of a PrimRep, in bytes
 sizeofPrimRep :: PrimRep -> Int
-- 
1.7.10.4