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