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

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index ddbc632..91c9a20 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -36,7 +36,7 @@ import Name		( getOccName, isExternalName, nameOccName )
 import OccName		( occNameString, occNameFS )
 import BasicTypes       ( Arity )
 import StaticFlags	( opt_RuntimeTypes )
-import PackageConfig	( PackageId )
+import Module
 import Outputable
 
 infixr 9 `thenLne`
@@ -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)