{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
---
+-- |
-- Module : Foreign.C.String
-- Copyright : (c) The FFI task force 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
+-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : ffi@haskell.org
-- Stability : provisional
-- Portability : portable
--
--- $Id: String.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
---
-- Utilities for primitive marshaling
--
-----------------------------------------------------------------------------
castCharToCChar, -- :: Char -> CChar
castCCharToChar, -- :: CChar -> Char
- -- UnsafeCString: these might be more efficient than CStrings when
- -- passing the string to an "unsafe" foreign import. NOTE: this
- -- feature might be removed in favour of a more general approach in
- -- the future.
- --
- UnsafeCString, -- abstract
- withUnsafeCString, -- :: String -> (UnsafeCString -> IO a) -> IO a
-
) where
import Foreign.Marshal.Array
import Foreign.C.Types
import Foreign.Ptr
+import Foreign.Storable
import Data.Word
#ifdef __GLASGOW_HASKELL__
-import GHC.ByteArr
-import GHC.Pack
import GHC.List
import GHC.Real
import GHC.Num
import GHC.IOBase
import GHC.Base
+#else
+import Data.Char ( chr, ord )
+#define unsafeChr chr
#endif
-----------------------------------------------------------------------------
-- marshal a NUL terminated C string into a Haskell string
--
peekCString :: CString -> IO String
+#ifndef __GLASGOW_HASKELL__
peekCString cp = do cs <- peekArray0 nUL cp; return (cCharsToChars cs)
+#else
+peekCString cp = do
+ l <- lengthArray0 nUL cp
+ if l <= 0 then return "" else loop "" (l-1)
+ where
+ loop s i = do
+ xval <- peekElemOff cp i
+ let val = castCCharToChar xval
+ val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)
+#endif
-- marshal a C string with explicit length into a Haskell string
--
peekCStringLen :: CStringLen -> IO String
+#ifndef __GLASGOW_HASKELL__
peekCStringLen (cp, len) = do cs <- peekArray len cp; return (cCharsToChars cs)
+#else
+peekCStringLen (cp, len)
+ | len <= 0 = return "" -- being (too?) nice.
+ | otherwise = loop [] (len-1)
+ where
+ loop acc i = do
+ xval <- peekElemOff cp i
+ let val = castCCharToChar xval
+ -- blow away the coercion ASAP.
+ if (val `seq` (i == 0))
+ then return (val:acc)
+ else loop (val:acc) (i-1)
+#endif
-- marshal a Haskell string into a NUL terminated C strings
--
-- * new storage is allocated for the C string and must be explicitly freed
--
newCString :: String -> IO CString
+#ifndef __GLASGOW_HASKELL__
newCString = newArray0 nUL . charsToCChars
+#else
+newCString str = do
+ ptr <- mallocArray0 (length str)
+ let
+ go [] n# = pokeElemOff ptr (I# n#) nUL
+ go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
+ go str 0#
+ return ptr
+#endif
-- marshal a Haskell string into a C string (ie, character array) with
-- explicit length information
-- * new storage is allocated for the C string and must be explicitly freed
--
newCStringLen :: String -> IO CStringLen
+#ifndef __GLASGOW_HASKELL__
newCStringLen str = do a <- newArray (charsToCChars str)
return (pairLength str a)
+#else
+newCStringLen str = do
+ ptr <- mallocArray0 len
+ let
+ go [] n# = return ()
+ go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
+ go str 0#
+ return (ptr, len)
+ where
+ len = length str
+#endif
-- marshal a Haskell string into a NUL terminated C strings using temporary
-- storage
-- * see the lifetime constraints of `MarshalAlloc.alloca'
--
withCString :: String -> (CString -> IO a) -> IO a
+#ifndef __GLASGOW_HASKELL__
withCString = withArray0 nUL . charsToCChars
+#else
+withCString str f =
+ allocaArray0 (length str) $ \ptr ->
+ let
+ go [] n# = pokeElemOff ptr (I# n#) nUL
+ go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
+ in do
+ go str 0#
+ f ptr
+#endif
-- marshal a Haskell string into a NUL terminated C strings using temporary
-- storage
-- * see the lifetime constraints of `MarshalAlloc.alloca'
--
withCStringLen :: String -> (CStringLen -> IO a) -> IO a
+#ifndef __GLASGOW_HASKELL__
withCStringLen str act = withArray (charsToCChars str) $ act . pairLength str
+#else
+withCStringLen str f =
+ allocaArray len $ \ptr ->
+ let
+ go [] n# = return ()
+ go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
+ in do
+ go str 0#
+ f (ptr,len)
+ where
+ len = length str
+#endif
-- auxilliary definitions
-- ----------------------
-- cast [CChar] to [Char]
--
cCharsToChars :: [CChar] -> [Char]
-cCharsToChars = map castCCharToChar
+cCharsToChars xs = map castCCharToChar xs
-- cast [Char] to [CChar]
--
charsToCChars :: [Char] -> [CChar]
-charsToCChars = map castCharToCChar
+charsToCChars xs = map castCharToCChar xs
castCCharToChar :: CChar -> Char
castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
castCharToCChar :: Char -> CChar
castCharToCChar ch = fromIntegral (ord ch)
-
-
--- unsafe CStrings
--- ---------------
-
-withUnsafeCString :: String -> (UnsafeCString -> IO a) -> IO a
-#if __GLASGOW_HASKELL__
-newtype UnsafeCString = UnsafeCString (ByteArray Int)
-withUnsafeCString s f = f (UnsafeCString (packString s))
-#else
-newtype UnsafeCString = UnsafeCString (Ptr CChar)
-withUnsafeCString s f = withCString s (\p -> f (UnsafeCString p))
-#endif
projects / ghc-base.git / blobdiff