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