-{-# OPTIONS -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.C.String
castCharToCChar, -- :: Char -> CChar
castCCharToChar, -- :: CChar -> Char
+ castCharToCUChar, -- :: Char -> CUChar
+ castCUCharToChar, -- :: CUChar -> Char
+ castCharToCSChar, -- :: Char -> CSChar
+ castCSCharToChar, -- :: CSChar -> Char
+
peekCAString, -- :: CString -> IO String
peekCAStringLen, -- :: CStringLen -> IO String
newCAString, -- :: String -> IO CString
import GHC.List
import GHC.Real
import GHC.Num
-import GHC.IOBase
import GHC.Base
#else
import Data.Char ( chr, ord )
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * new storage is allocated for the C string and must be explicitly freed
+-- * new storage is allocated for the C string and must be
+-- explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
--
newCString :: String -> IO CString
newCString = newCAString
-- | 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
+-- * new storage is allocated for the C string and must be
+-- explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
--
newCStringLen :: String -> IO CStringLen
newCStringLen = newCAStringLen
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * see the lifetime constraints of 'Foreign.Marshal.Alloc.alloca'
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
--
withCString :: String -> (CString -> IO a) -> IO a
withCString = withCAString
--- | Marshal a Haskell string into a NUL terminated C string using temporary
--- storage.
+-- | Marshal a Haskell string into a C string (ie, character array)
+-- in temporary storage, with explicit length information.
--
--- * the Haskell string may /not/ contain any NUL characters
---
--- * see the lifetime constraints of 'Foreign.Marshal.Alloc.alloca'
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
--
withCStringLen :: String -> (CStringLen -> IO a) -> IO a
withCStringLen = withCAStringLen
castCharToCChar :: Char -> CChar
castCharToCChar ch = fromIntegral (ord ch)
+-- | Convert a C @unsigned char@, representing a Latin-1 character, to
+-- the corresponding Haskell character.
+castCUCharToChar :: CUChar -> Char
+castCUCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C @unsigned char@.
+-- This function is only safe on the first 256 characters.
+castCharToCUChar :: Char -> CUChar
+castCharToCUChar ch = fromIntegral (ord ch)
+
+-- | Convert a C @signed char@, representing a Latin-1 character, to the
+-- corresponding Haskell character.
+castCSCharToChar :: CSChar -> Char
+castCSCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C @signed char@.
+-- This function is only safe on the first 256 characters.
+castCharToCSChar :: Char -> CSChar
+castCharToCSChar ch = fromIntegral (ord ch)
+
-- | Marshal a NUL terminated C string into a Haskell string.
--
peekCAString :: CString -> IO String
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)
+ 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.
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)
+ 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 string.
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * new storage is allocated for the C string and must be explicitly freed
+-- * new storage is allocated for the C string and must be
+-- explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
--
newCAString :: String -> IO CString
#ifndef __GLASGOW_HASKELL__
newCAString str = do
ptr <- mallocArray0 (length str)
let
- go [] n = pokeElemOff ptr n nUL
- go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+ go [] n = pokeElemOff ptr n nUL
+ go (c:cs) n = do pokeElemOff ptr 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
+-- * new storage is allocated for the C string and must be
+-- explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
--
newCAStringLen :: String -> IO CStringLen
#ifndef __GLASGOW_HASKELL__
-newCAStringLen str = do
- a <- newArray (charsToCChars str)
- return (pairLength str a)
+newCAStringLen str = newArrayLen (charsToCChars str)
#else
newCAStringLen str = do
ptr <- mallocArray0 len
let
- go [] n = n `seq` return () -- make it strict in n
- go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+ go [] n = n `seq` return () -- make it strict in n
+ go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
go str 0
return (ptr, len)
where
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * see the lifetime constraints of 'Foreign.Marshal.Alloc.alloca'
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
--
withCAString :: String -> (CString -> IO a) -> IO a
#ifndef __GLASGOW_HASKELL__
withCAString str f =
allocaArray0 (length str) $ \ptr ->
let
- go [] n = pokeElemOff ptr n nUL
- go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+ go [] n = pokeElemOff ptr n nUL
+ go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
in do
go str 0
f ptr
#endif
--- | Marshal a Haskell string into a NUL terminated C string using temporary
--- storage.
---
--- * the Haskell string may /not/ contain any NUL characters
+-- | Marshal a Haskell string into a C string (ie, character array)
+-- in temporary storage, with explicit length information.
--
--- * see the lifetime constraints of 'Foreign.Marshal.Alloc.alloca'
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
--
withCAStringLen :: String -> (CStringLen -> IO a) -> IO a
+withCAStringLen str f =
#ifndef __GLASGOW_HASKELL__
-withCAStringLen str act = withArray (charsToCChars str) $ act . pairLength str
+ withArrayLen (charsToCChars str) $ \ len ptr -> f (ptr, len)
#else
-withCAStringLen str f =
allocaArray len $ \ptr ->
let
- go [] n = n `seq` return () -- make it strict in n
- go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+ go [] n = n `seq` return () -- make it strict in n
+ go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
in do
go str 0
f (ptr,len)
nUL :: CChar
nUL = 0
--- pair a C string with the length of the given Haskell string
---
-pairLength :: String -> a -> (a, Int)
-pairLength = flip (,) . length
+-- allocate an array to hold the list and pair it with the number of elements
+newArrayLen :: Storable a => [a] -> IO (Ptr a, Int)
+newArrayLen xs = do
+ a <- newArray xs
+ return (a, length xs)
#ifndef __GLASGOW_HASKELL__
-- cast [CChar] to [Char]
-- terminated by NUL.
type CWString = Ptr CWchar
--- | A wide character string with explicit length information in bytes
+-- | A wide character string with explicit length information in 'CWchar's
-- instead of a terminating NUL (allowing NUL characters in the middle
-- of the string).
type CWStringLen = (Ptr CWchar, Int)
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * new storage is allocated for the C string and must be explicitly freed
+-- * new storage is allocated for the C wide string and must
+-- be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
--
newCWString :: String -> IO CWString
newCWString = newArray0 wNUL . charsToCWchars
-- | Marshal a Haskell string into a C wide string (ie, wide character array)
-- with explicit length information.
--
--- * new storage is allocated for the C string and must be explicitly freed
+-- * new storage is allocated for the C wide string and must
+-- be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
--
newCWStringLen :: String -> IO CWStringLen
-newCWStringLen str = do
- a <- newArray (charsToCWchars str)
- return (pairLength str a)
+newCWStringLen str = newArrayLen (charsToCWchars str)
-- | Marshal a Haskell string into a NUL terminated C wide string using
-- temporary storage.
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * see the lifetime constraints of 'Foreign.Marshal.Alloc.alloca'
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
--
withCWString :: String -> (CWString -> IO a) -> IO a
withCWString = withArray0 wNUL . charsToCWchars
--
-- * the Haskell string may /not/ contain any NUL characters
--
--- * see the lifetime constraints of 'Foreign.Marshal.Alloc.alloca'
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
--
withCWStringLen :: String -> (CWStringLen -> IO a) -> IO a
-withCWStringLen str act = withArray (charsToCWchars str) $ act . pairLength str
+withCWStringLen str f =
+ withArrayLen (charsToCWchars str) $ \ len ptr -> f (ptr, len)
-- auxiliary definitions
-- ----------------------
cWcharsToChars :: [CWchar] -> [Char]
charsToCWchars :: [Char] -> [CWchar]
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
-- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.
fromIntegral (c' `div` 0x400 + 0xd800) :
fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs
-#else /* !mingw32_TARGET_OS */
+#else /* !mingw32_HOST_OS */
cWcharsToChars xs = map castCWcharToChar xs
charsToCWchars xs = map castCharToCWchar xs
castCharToCWchar :: Char -> CWchar
castCharToCWchar ch = fromIntegral (ord ch)
-#endif /* !mingw32_TARGET_OS */
+#endif /* !mingw32_HOST_OS */
projects / ghc-base.git / blobdiff