ghc/lib/std/PrelForeign.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[Foreign]{Module @Foreign@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelForeign (
  11         module PrelForeign,
  12 #ifndef __PARALLEL_HASKELL__
  13         ForeignObj(..),
  14         makeForeignObj,
  15 #endif
  16         StateAndForeignObj#(..)
  17    ) where
  18
  19 import PrelIOBase
  20 import PrelST
  21 import PrelBase
  22 import PrelCCall
  23 import PrelAddr
  24 import PrelGHC
  25 \end{code}
  26
  27
  28 %*********************************************************
  29 %*                                                      *
  30 \subsection{Type @ForeignObj@ and its operations}
  31 %*                                                      *
  32 %*********************************************************
  33
  34 \begin{code}
  35 #ifndef __PARALLEL_HASKELL__
  36 --instance CCallable ForeignObj
  37 --instance CCallable ForeignObj#
  38
  39 eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
  40 --makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
  41 writeForeignObj :: ForeignObj  -> Addr       -> IO ()
  42
  43 {- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
  44 makeMallocPtr   :: Addr        -> IO ForeignObj
  45
  46 {-
  47 --makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
  48 makeForeignObj (A# obj) (A# finaliser) = IO ( \ s# ->
  49     case makeForeignObj# obj finaliser s# of
  50       StateAndForeignObj# s1# fo# -> IOok s1# (ForeignObj fo#))
  51 -}
  52
  53 writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
  54     case writeForeignObj# fo# datum# s# of { s1# -> IOok s1# () } )
  55
  56 makeMallocPtr a = makeForeignObj a (``&free''::Addr)
  57
  58 eqForeignObj mp1 mp2
  59   = unsafePerformIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
  60
  61 instance Eq ForeignObj where
  62     p == q = eqForeignObj p q
  63     p /= q = not (eqForeignObj p q)
  64 #endif /* !__PARALLEL_HASKELL__ */
  65 \end{code}
  66
  67 %*********************************************************
  68 %*                                                      *
  69 \subsection{Type @StablePtr@ and its operations}
  70 %*                                                      *
  71 %*********************************************************
  72
  73 \begin{code}
  74 #ifndef __PARALLEL_HASKELL__
  75 data StablePtr a = StablePtr (StablePtr# a)
  76 instance CCallable   (StablePtr a)
  77 instance CCallable   (StablePtr# a)
  78 instance CReturnable (StablePtr a)
  79
  80 -- Nota Bene: it is important {\em not\/} to inline calls to
  81 -- @makeStablePtr#@ since the corresponding macro is very long and we'll
  82 -- get terrible code-bloat.
  83
  84 makeStablePtr  :: a -> IO (StablePtr a)
  85 deRefStablePtr :: StablePtr a -> IO a
  86 freeStablePtr  :: StablePtr a -> IO ()
  87
  88 {-# INLINE deRefStablePtr #-}
  89 {-# INLINE freeStablePtr #-}
  90
  91 makeStablePtr f = IO $ \ rw1# ->
  92     case makeStablePtr# f rw1# of
  93       StateAndStablePtr# rw2# sp# -> IOok rw2# (StablePtr sp#)
  94
  95 deRefStablePtr (StablePtr sp#) = IO $ \ rw1# ->
  96     case deRefStablePtr# sp# rw1# of
  97       StateAndPtr# rw2# a -> IOok rw2# a
  98
  99 freeStablePtr sp = _ccall_ freeStablePointer sp
 100
 101 eqStablePtr :: StablePtr a -> StablePtr b -> Bool
 102 eqStablePtr s1 s2
 103   = unsafePerformIO (_ccall_ eqStablePtr s1 s2) /= (0::Int)
 104
 105 instance Eq (StablePtr a) where
 106     p == q = eqStablePtr p q
 107     p /= q = not (eqStablePtr p q)
 108
 109 #endif /* !__PARALLEL_HASKELL__ */
 110 \end{code}
 111
 112 %*********************************************************
 113 %*                                                      *
 114 \subsection{Ghastly return types}
 115 %*                                                      *
 116 %*********************************************************
 117
 118 \begin{code}
 119 #ifndef __PARALLEL_HASKELL__
 120 data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
 121 #endif
 122 --data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
 123 \end{code}