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