From f117d08b91ad84ce0cac31fca3e584fa09d332ac Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Sat, 4 Aug 2007 17:44:20 +0000
Subject: [PATCH] Fix Trac #1037

It makes *sense* for a foreign import to have a zero-sized return, thus

  foreign import ccall foo :: Int -> State# RealWorld

but it's not clear that it's useful, and it requires some back-end (a
Hint for void types) to make it go right through. It's not clear that
we really want this facility, so rather than fixing the code
generator, I'm just making the construct illegal for now.
---
 compiler/typecheck/TcType.lhs |   25 ++++++++++++++++++-------
 1 file changed, 18 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index eaf2faa..3271ec2 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -1163,13 +1163,11 @@ isFFIDotnetTy dflags ty
 	--     it no longer does so.  May need to adjust isFFIDotNetTy
 	--     if we do want to look through newtypes.
 
-isFFIDotnetObjTy ty = 
-  let
+isFFIDotnetObjTy ty
+  = checkRepTyCon check_tc t_ty
+  where
    (_, t_ty) = tcSplitForAllTys ty
-  in
-  case tcSplitTyConApp_maybe (repType t_ty) of
-    Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
-    _ -> False
+   check_tc tc = getName tc == objectTyConName
 
 toDNType :: Type -> DNType
 toDNType ty
@@ -1252,7 +1250,11 @@ legalFFITyCon tc
   = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
 
 marshalableTyCon dflags tc
-  =  (dopt Opt_UnliftedFFITypes dflags && isUnLiftedTyCon tc)
+  =  (dopt Opt_UnliftedFFITypes dflags 
+      && isUnLiftedTyCon tc
+      && case tyConPrimRep tc of	-- Note [Marshalling VoidRep]
+	   VoidRep -> False
+	   other   -> True)
   || boxedMarshalableTyCon tc
 
 boxedMarshalableTyCon tc
@@ -1267,3 +1269,12 @@ boxedMarshalableTyCon tc
 			 , boolTyConKey
 			 ]
 \end{code}
+
+Note [Marshalling VoidRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't treat State# (whose PrimRep is VoidRep) as marshalable.
+In turn that means you can't write
+	foreign import foo :: Int -> State# RealWorld
+
+Reason: the back end falls over with panic "primRepHint:VoidRep";
+	and there is no compelling reason to permit it
-- 
1.7.10.4