ghc/lib/glaExts/Foreign.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[Foreign]{Module @Foreign@}
   6
   7 \begin{code}
   8 module Foreign (
   9         module Foreign,
  10         Addr, Word
  11    ) where
  12
  13 import Prelude  ()
  14 import STBase
  15 import ArrBase
  16 import PrelBase
  17 import GHC
  18 \end{code}
  19
  20
  21 %*********************************************************
  22 %*                                                      *
  23 \subsection{Classes @CCallable@ and @CReturnable@}
  24 %*                                                      *
  25 %*********************************************************
  26
  27 \begin{code}
  28 class CCallable   a
  29 class CReturnable a
  30
  31 instance CCallable Char
  32 instance CReturnable Char
  33
  34 instance CCallable   Int
  35 instance CReturnable Int
  36
  37 -- DsCCall knows how to pass strings...
  38 instance CCallable   [Char]
  39
  40 instance CCallable   Float
  41 instance CReturnable Float
  42
  43 instance CCallable   Double
  44 instance CReturnable Double
  45
  46 instance CCallable Addr
  47 instance CReturnable Addr
  48
  49 instance CCallable Word
  50 instance CReturnable Word
  51
  52 -- Is this right?
  53 instance CCallable (MutableByteArray s ix)
  54
  55 instance CCallable (ByteArray ix)
  56
  57 instance CReturnable () -- Why, exactly?
  58 \end{code}
  59
  60
  61 %*********************************************************
  62 %*                                                      *
  63 \subsection{Type @ForeignObj@ and its operations}
  64 %*                                                      *
  65 %*********************************************************
  66
  67 \begin{code}
  68 data ForeignObj = ForeignObj ForeignObj#
  69 instance CCallable ForeignObj
  70
  71 eqForeignObj   :: ForeignObj -> ForeignObj -> Bool
  72 makeForeignObj :: Addr       -> Addr       -> PrimIO ForeignObj
  73
  74 makeForeignObj (A# obj) (A# finaliser) = ST $ \ (S# s#) ->
  75     case makeForeignObj# obj finaliser s# of
  76       StateAndForeignObj# s1# fo# -> (ForeignObj fo#, S# s1#)
  77
  78 eqForeignObj mp1 mp2
  79   = unsafePerformPrimIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
  80
  81 instance Eq ForeignObj where
  82     p == q = eqForeignObj p q
  83     p /= q = not (eqForeignObj p q)
  84 \end{code}
  85
  86
  87 %*********************************************************
  88 %*                                                      *
  89 \subsection{Type @StablePtr@ and its operations}
  90 %*                                                      *
  91 %*********************************************************
  92
  93 \begin{code}
  94 #ifndef __PARALLEL_HASKELL__
  95 data StablePtr a = StablePtr (StablePtr# a)
  96 instance CCallable   (StablePtr a)
  97 instance CReturnable (StablePtr a)
  98
  99 -- Nota Bene: it is important {\em not\/} to inline calls to
 100 -- @makeStablePtr#@ since the corresponding macro is very long and we'll
 101 -- get terrible code-bloat.
 102
 103 makeStablePtr  :: a -> PrimIO (StablePtr a)
 104 deRefStablePtr :: StablePtr a -> PrimIO a
 105 freeStablePtr  :: StablePtr a -> PrimIO ()
 106 performGC      :: PrimIO ()
 107
 108 {-# INLINE deRefStablePtr #-}
 109 {-# INLINE freeStablePtr #-}
 110 {-# INLINE performGC #-}
 111
 112 makeStablePtr f = ST $ \ (S# rw1#) ->
 113     case makeStablePtr# f rw1# of
 114       StateAndStablePtr# rw2# sp# -> (StablePtr sp#, S# rw2#)
 115
 116 deRefStablePtr (StablePtr sp#) = ST $ \ (S# rw1#) ->
 117     case deRefStablePtr# sp# rw1# of
 118       StateAndPtr# rw2# a -> (a, S# rw2#)
 119
 120 freeStablePtr sp = _ccall_ freeStablePointer sp
 121
 122 performGC = _ccall_GC_ StgPerformGarbageCollection
 123
 124 #endif /* !__PARALLEL_HASKELL__ */
 125 \end{code}
 126
 127 %*********************************************************
 128 %*                                                      *
 129 \subsection{Ghastly return types}
 130 %*                                                      *
 131 %*********************************************************
 132
 133 \begin{code}
 134 #ifndef __PARALLEL_HASKELL__
 135 data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
 136 #endif
 137 data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
 138 \end{code}