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