ghc/lib/std/PrelForeign.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelForeign.lhs,v 1.15 2000/06/30 13:39:35 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         ForeignObj(..),
  16         makeForeignObj,
  17         -- SUP: deprecated
  18         mkForeignObj,
  19         writeForeignObj
  20 #endif
  21    ) where
  22
  23 import PrelIOBase
  24 import PrelBase
  25 import PrelAddr
  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}