X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FstgSyn%2FCoreToStg.lhs;h=91c9a2013eea9dfce1d783eb33b2739cc9d185b0;hp=51e830c2e80699ab94209b19e14e10b7c117f6bd;hb=e8b4f75a43685b56d8300dee9db2472977fba8fc;hpb=75ba47fa64d358c569c214be669b6570533ae920

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)