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         writeForeignObj
  16 #endif
  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 makeForeignObj  :: Addr -> IO ForeignObj
  40 makeForeignObj (A# obj) = IO ( \ s# ->
  41     case makeForeignObj# obj s# of
  42       (# s1#, fo# #) -> (# s1#,  ForeignObj fo# #) )
  43
  44 eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
  45 --makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
  46 writeForeignObj :: ForeignObj  -> Addr       -> IO ()
  47
  48 writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
  49     case writeForeignObj# fo# datum# s# of { s1# -> (# s1#, () #) } )
  50
  51 eqForeignObj mp1 mp2
  52   = unsafePerformIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
  53
  54 instance Eq ForeignObj where
  55     p == q = eqForeignObj p q
  56     p /= q = not (eqForeignObj p q)
  57 #endif /* !__PARALLEL_HASKELL__ */
  58 \end{code}
  59
  60 %*********************************************************
  61 %*                                                      *
  62 \subsection{Unpacking Foreigns}
  63 %*                                                      *
  64 %*********************************************************
  65
  66 Primitives for converting Foreigns pointing to external
  67 sequence of bytes into a list of @Char@s (a renamed version
  68 of the code above).
  69
  70 \begin{code}
  71 #ifndef __PARALLEL_HASKELL__
  72 unpackCStringFO :: ForeignObj -> [Char]
  73 unpackCStringFO (ForeignObj fo#) = unpackCStringFO# fo#
  74
  75 unpackCStringFO# :: ForeignObj# -> [Char]
  76 unpackCStringFO# fo {- ptr. to NUL terminated string-}
  77   = unpack 0#
  78   where
  79     unpack nh
  80       | ch `eqChar#` '\0'# = []
  81       | otherwise          = C# ch : unpack (nh +# 1#)
  82       where
  83         ch = indexCharOffForeignObj# fo nh
  84
  85 unpackNBytesFO :: ForeignObj -> Int -> [Char]
  86 unpackNBytesFO (ForeignObj fo) (I# l) = unpackNBytesFO# fo l
  87
  88 unpackNBytesFO#    :: ForeignObj# -> Int#   -> [Char]
  89   -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
  90 unpackNBytesFO# fo len
  91   = unpack 0#
  92     where
  93      unpack i
  94       | i >=# len  = []
  95       | otherwise  = C# ch : unpack (i +# 1#)
  96       where
  97         ch = indexCharOffForeignObj# fo i
  98 #endif
  99 \end{code}