ghc/lib/std/PrelForeign.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelForeign.lhs,v 1.16 2000/12/11 16:56:47 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[Foreign]{Module @Foreign@}
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelForeign (
  13         module PrelForeign,
  14 #ifndef __PARALLEL_HASKELL__
  15         ForeignPtr(..),
  16
  17         -- the rest are deprecated
  18         ForeignObj(..),
  19         makeForeignObj,
  20         mkForeignObj,
  21         writeForeignObj
  22 #endif
  23    ) where
  24
  25 import PrelIOBase
  26 import PrelBase
  27 import PrelAddr
  28 import PrelWeak ( addForeignFinalizer )
  29 \end{code}
  30
  31 %*********************************************************
  32 %*                                                      *
  33 \subsection{ForeignPtr}
  34 %*                                                      *
  35 %*********************************************************
  36
  37 \begin{code}
  38 data ForeignPtr a = ForeignPtr ForeignObj#
  39 instance CCallable (ForeignPtr a)
  40 \end{code}
  41
  42 %*********************************************************
  43 %*                                                      *
  44 \subsection{Type @ForeignObj@ and its operations}
  45 %*                                                      *
  46 %*********************************************************
  47
  48 mkForeignObj and writeForeignObj are the building blocks
  49 for makeForeignObj, they can probably be nuked in the future.
  50
  51 \begin{code}
  52 #ifndef __PARALLEL_HASKELL__
  53 --instance CCallable ForeignObj
  54 --instance CCallable ForeignObj#
  55
  56 makeForeignObj :: Addr -> IO () -> IO ForeignObj
  57 makeForeignObj addr finalizer = do
  58    fObj <- mkForeignObj addr
  59    addForeignFinalizer fObj finalizer
  60    return fObj
  61
  62 mkForeignObj  :: Addr -> IO ForeignObj
  63 mkForeignObj (A# obj) = IO ( \ s# ->
  64     case mkForeignObj# obj s# of
  65       (# s1#, fo# #) -> (# s1#,  ForeignObj fo# #) )
  66
  67 writeForeignObj :: ForeignObj -> Addr -> IO ()
  68 writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
  69     case writeForeignObj# fo# datum# s# of { s1# -> (# s1#, () #) } )
  70 #endif /* !__PARALLEL_HASKELL__ */
  71 \end{code}
  72
  73 %*********************************************************
  74 %*                                                      *
  75 \subsection{Unpacking Foreigns}
  76 %*                                                      *
  77 %*********************************************************
  78
  79 Primitives for converting Foreigns pointing to external
  80 sequence of bytes into a list of @Char@s (a renamed version
  81 of the code above).
  82
  83 \begin{code}
  84 #ifndef __PARALLEL_HASKELL__
  85 unpackCStringFO :: ForeignObj -> [Char]
  86 unpackCStringFO (ForeignObj fo#) = unpackCStringFO# fo#
  87
  88 unpackCStringFO# :: ForeignObj# -> [Char]
  89 unpackCStringFO# fo {- ptr. to NUL terminated string-}
  90   = unpack 0#
  91   where
  92     unpack nh
  93       | ch `eqChar#` '\0'# = []
  94       | otherwise          = C# ch : unpack (nh +# 1#)
  95       where
  96         ch = indexCharOffForeignObj# fo nh
  97
  98 unpackNBytesFO :: ForeignObj -> Int -> [Char]
  99 unpackNBytesFO (ForeignObj fo) (I# l) = unpackNBytesFO# fo l
 100
 101 unpackNBytesFO#    :: ForeignObj# -> Int#   -> [Char]
 102   -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
 103 unpackNBytesFO# fo len
 104   = unpack 0#
 105     where
 106      unpack i
 107       | i >=# len  = []
 108       | otherwise  = C# ch : unpack (i +# 1#)
 109       where
 110         ch = indexCharOffForeignObj# fo i
 111 #endif
 112 \end{code}
 113