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