From: simonmar <unknown>
Date: Mon, 11 Dec 2000 16:57:18 +0000 (+0000)
Subject: [project @ 2000-12-11 16:56:47 by simonmar]
X-Git-Tag: Approximately_9120_patches~3132
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=422ed14cf07244371e1a012a420bbaad215770db;p=ghc-hetmet.git

[project @ 2000-12-11 16:56:47 by simonmar]
add ForeignPtr
---

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 49aef1d..bed62c4 100644
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -76,7 +76,7 @@ module TysWiredIn (
  	isFFIDynResultTy,   -- :: Type -> Bool
  	isFFILabelTy,       -- :: Type -> Bool
 	isAddrTy,	    -- :: Type -> Bool
-	isForeignObjTy      -- :: Type -> Bool
+	isForeignPtrTy      -- :: Type -> Bool
 
     ) where
 
@@ -374,6 +374,19 @@ isForeignObjTy :: Type -> Bool
 isForeignObjTy = isTyCon foreignObjTyConKey
 \end{code}
 
+\begin{code}
+foreignPtrTyCon
+  = pcNonRecDataTyCon foreignPtrTyConName
+	alpha_tyvar  [(True,False)] [foreignPtrDataCon]
+  where
+    foreignPtrDataCon
+      = pcDataCon foreignPtrDataConName
+	    alpha_tyvar [] [foreignObjPrimTy] foreignPtrTyCon
+
+isForeignPtrTy :: Type -> Bool
+isForeignPtrTy = isTyCon foreignPtrTyConKey
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
@@ -464,8 +477,8 @@ legalIncomingTyCon :: TyCon -> Bool
 -- bytearrays from a _ccall_ / foreign declaration
 -- (or be passed them as arguments in foreign exported functions).
 legalIncomingTyCon tc
-  | getUnique tc `elem` [ foreignObjTyConKey, byteArrayTyConKey, 
-                                              mutableByteArrayTyConKey ] 
+  | getUnique tc `elem` [ foreignObjTyConKey, foreignPtrTyConKey,
+			  byteArrayTyConKey, mutableByteArrayTyConKey ] 
   = False
   -- It's also illegal to make foreign exports that take unboxed
   -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
@@ -491,6 +504,7 @@ boxedMarshalableTyCon tc
 			 , wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey
 			 , floatTyConKey, doubleTyConKey
 			 , addrTyConKey, charTyConKey, foreignObjTyConKey
+			 , foreignPtrTyConKey
 			 , stablePtrTyConKey
 			 , byteArrayTyConKey, mutableByteArrayTyConKey
 			 , boolTyConKey
diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs
index d99ca15..f0ea40d 100644
--- a/ghc/lib/std/PrelForeign.lhs
+++ b/ghc/lib/std/PrelForeign.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelForeign.lhs,v 1.15 2000/06/30 13:39:35 simonmar Exp $
+% $Id: PrelForeign.lhs,v 1.16 2000/12/11 16:56:47 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -12,9 +12,11 @@
 module PrelForeign (
 	module PrelForeign,
 #ifndef __PARALLEL_HASKELL__
+	ForeignPtr(..),
+
+	-- the rest are deprecated
 	ForeignObj(..),
 	makeForeignObj,
-	-- SUP: deprecated
 	mkForeignObj,
 	writeForeignObj
 #endif
@@ -26,6 +28,16 @@ import PrelAddr
 import PrelWeak	( addForeignFinalizer )
 \end{code}
 
+%*********************************************************
+%*							*
+\subsection{ForeignPtr}
+%*							*
+%*********************************************************
+
+\begin{code}
+data ForeignPtr a = ForeignPtr ForeignObj#
+instance CCallable (ForeignPtr a)
+\end{code}
 
 %*********************************************************
 %*							*
@@ -98,3 +110,4 @@ unpackNBytesFO# fo len
 	ch = indexCharOffForeignObj# fo i
 #endif
 \end{code}
+