X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FC%2FString.hs;h=becfa4ea688118d4c0a36fa2c3e222d0c6a2915a;hb=41e8fba828acbae1751628af50849f5352b27873;hp=b7b9bb6ea5ae01db49aea3d94bfdbeab9d07fcee;hpb=84e5e8926b526142bebeb6932a0c70666b6a18ac;p=ghc-base.git

diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs
index b7b9bb6..becfa4e 100644
--- a/Foreign/C/String.hs
+++ b/Foreign/C/String.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Foreign.C.String
@@ -9,14 +10,29 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- Utilities for primitive marshaling
+-- Utilities for primitive marshalling of C strings.
+--
+-- The marshalling converts each Haskell character, representing a Unicode
+-- code point, to one or more bytes in a manner that, by default, is
+-- determined by the current locale.  As a consequence, no guarantees
+-- can be made about the relative length of a Haskell string and its
+-- corresponding C string, and therefore all the marshalling routines
+-- include memory allocation.  The translation between Unicode and the
+-- encoding of the current locale may be lossy.
 --
 -----------------------------------------------------------------------------
 
 module Foreign.C.String (   -- representation of strings in C
 
+  -- * C strings
+
   CString,           -- = Ptr CChar
-  CStringLen,        -- = (CString, Int)
+  CStringLen,        -- = (Ptr CChar, Int)
+
+  -- ** Using a locale-dependent encoding
+
+  -- | Currently these functions are identical to their @CAString@ counterparts;
+  -- eventually they will use an encoding determined by the current locale.
 
   -- conversion of C strings into Haskell strings
   --
@@ -33,11 +49,49 @@ module Foreign.C.String (   -- representation of strings in C
   withCString,       -- :: String -> (CString    -> IO a) -> IO a
   withCStringLen,    -- :: String -> (CStringLen -> IO a) -> IO a
 
-  -- conversion between Haskell and C characters *ignoring* the encoding
-  --
+  charIsRepresentable, -- :: Char -> IO Bool
+
+  -- ** Using 8-bit characters
+
+  -- | These variants of the above functions are for use with C libraries
+  -- that are ignorant of Unicode.  These functions should be used with
+  -- care, as a loss of information can occur.
+
   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
+  newCAStringLen,    -- :: String -> IO CStringLen
+  withCAString,      -- :: String -> (CString    -> IO a) -> IO a
+  withCAStringLen,   -- :: String -> (CStringLen -> IO a) -> IO a
+
+  -- * C wide strings
+
+  -- | These variants of the above functions are for use with C libraries
+  -- that encode Unicode using the C @wchar_t@ type in a system-dependent
+  -- way.  The only encodings supported are
+  --
+  -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or
+  --
+  -- * UTF-16 (as used on Windows systems).
+
+  CWString,          -- = Ptr CWchar
+  CWStringLen,       -- = (Ptr CWchar, Int)
+
+  peekCWString,      -- :: CWString    -> IO String
+  peekCWStringLen,   -- :: CWStringLen -> IO String
+  newCWString,       -- :: String -> IO CWString
+  newCWStringLen,    -- :: String -> IO CWStringLen
+  withCWString,      -- :: String -> (CWString    -> IO a) -> IO a
+  withCWStringLen,   -- :: String -> (CWStringLen -> IO a) -> IO a
+
   ) where
 
 import Foreign.Marshal.Array
@@ -51,7 +105,6 @@ import Data.Word
 import GHC.List
 import GHC.Real
 import GHC.Num
-import GHC.IOBase
 import GHC.Base
 #else
 import Data.Char ( chr, ord )
@@ -64,137 +117,243 @@ import Data.Char ( chr, ord )
 -- representation of strings in C
 -- ------------------------------
 
-type CString    = Ptr CChar		-- conventional NUL terminates strings
-type CStringLen = (CString, Int)	-- strings with explicit length
+-- | A C string is a reference to an array of C characters terminated by NUL.
+type CString    = Ptr CChar
 
+-- | A string with explicit length information in bytes instead of a
+-- terminating NUL (allowing NUL characters in the middle of the string).
+type CStringLen = (Ptr CChar, Int)
 
 -- exported functions
 -- ------------------
 --
 -- * the following routines apply the default conversion when converting the
 --   C-land character encoding into the Haskell-land character encoding
+
+-- | Marshal a NUL terminated C string into a Haskell string.
 --
---   ** NOTE: The current implementation doesn't handle conversions yet! **
+peekCString    :: CString -> IO String
+peekCString = peekCAString
+
+-- | Marshal a C string with explicit length into a Haskell string.
 --
--- * the routines using an explicit length tolerate NUL characters in the
---   middle of a string
+peekCStringLen           :: CStringLen -> IO String
+peekCStringLen = peekCAStringLen
+
+-- | 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 using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCString :: String -> IO CString
+newCString = newCAString
 
--- marshal a NUL terminated C string into a Haskell string 
+-- | Marshal a Haskell string into a C string (ie, character array) with
+-- explicit length information.
 --
-peekCString    :: CString -> IO String
+-- * 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
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * 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 C string (ie, character array)
+-- in temporary storage, with explicit length information.
+--
+-- * 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
+
+-- | Determines whether a character can be accurately encoded in a 'CString'.
+-- Unrepresentable characters are converted to @\'?\'@.
+--
+-- Currently only Latin-1 characters are representable.
+charIsRepresentable :: Char -> IO Bool
+charIsRepresentable c = return (ord c < 256)
+
+-- single byte characters
+-- ----------------------
+--
+--   ** NOTE: These routines don't handle conversions! **
+
+-- | Convert a C byte, representing a Latin-1 character, to the corresponding
+-- Haskell character.
+castCCharToChar :: CChar -> Char
+castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C character.
+-- This function is only safe on the first 256 characters.
+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
 #ifndef __GLASGOW_HASKELL__
-peekCString cp  = do cs <- peekArray0 nUL cp; return (cCharsToChars cs)
+peekCAString cp  = do
+  cs <- peekArray0 nUL cp
+  return (cCharsToChars cs)
 #else
-peekCString cp = loop 0
+peekCAString cp = do
+  l <- lengthArray0 nUL cp
+  if l <= 0 then return "" else loop "" (l-1)
   where
-    loop i = do
-        val <- peekElemOff cp i
-        if val == nUL then return [] else do
-            rest <- loop (i+1)
-            return (castCCharToChar val : rest)
+    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 
+-- | Marshal a C string with explicit length into a Haskell string.
 --
-peekCStringLen           :: CStringLen -> IO String
+peekCAStringLen           :: CStringLen -> IO String
 #ifndef __GLASGOW_HASKELL__
-peekCStringLen (cp, len)  = do cs <- peekArray len cp; return (cCharsToChars cs)
+peekCAStringLen (cp, len)  = do
+  cs <- peekArray len cp
+  return (cCharsToChars cs)
 #else
-peekCStringLen (cp, len) = loop 0
+peekCAStringLen (cp, len) 
+  | len <= 0  = return "" -- being (too?) nice.
+  | otherwise = loop [] (len-1)
   where
-    loop i | i == len  = return []
-	   | otherwise = do
-        	val <- peekElemOff cp i
-        	rest <- loop (i+1)
-        	return (castCCharToChar val : rest)
+    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
+-- | Marshal a Haskell string into a NUL terminated C string.
 --
--- * the Haskell string may *not* contain any NUL characters
+-- * 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
+newCAString :: String -> IO CString
 #ifndef __GLASGOW_HASKELL__
-newCString  = newArray0 nUL . charsToCChars
+newCAString  = newArray0 nUL . charsToCChars
 #else
-newCString str = do
+newCAString 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#
+        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
+-- | 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
+newCAStringLen     :: String -> IO CStringLen
 #ifndef __GLASGOW_HASKELL__
-newCStringLen str  = do a <- newArray (charsToCChars str)
-			return (pairLength str a)
+newCAStringLen str  = newArrayLen (charsToCChars str)
 #else
-newCStringLen str = do
+newCAStringLen 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#
+        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
     len = length str
 #endif
 
--- marshal a Haskell string into a NUL terminated C strings using temporary
--- storage
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
 --
--- * the Haskell string may *not* contain any NUL characters
+-- * the Haskell string may /not/ contain any NUL characters
 --
--- * see the lifetime constraints of `MarshalAlloc.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
+withCAString :: String -> (CString -> IO a) -> IO a
 #ifndef __GLASGOW_HASKELL__
-withCString  = withArray0 nUL . charsToCChars
+withCAString  = withArray0 nUL . charsToCChars
 #else
-withCString str f =
+withCAString 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#)
+        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#
+      go str 0
       f ptr
 #endif
 
--- marshal a Haskell string into a NUL terminated C strings 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 `MarshalAlloc.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
+withCAStringLen         :: String -> (CStringLen -> IO a) -> IO a
+withCAStringLen str f    =
 #ifndef __GLASGOW_HASKELL__
-withCStringLen str act  = withArray (charsToCChars str) $ act . pairLength str
+  withArrayLen (charsToCChars str) $ \ len ptr -> f (ptr, len)
 #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#)
+        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#
+      go str 0
       f (ptr,len)
   where
     len = length str
 #endif
 
--- auxilliary definitions
+-- auxiliary definitions
 -- ----------------------
 
 -- C's end of string character
@@ -202,11 +361,13 @@ withCStringLen str f =
 nUL :: CChar
 nUL  = 0
 
--- pair a C string with the length of the given Haskell string
---
-pairLength :: String -> CString -> CStringLen
-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]
 --
 cCharsToChars :: [CChar] -> [Char]
@@ -216,9 +377,125 @@ cCharsToChars xs  = map castCCharToChar xs
 --
 charsToCChars :: [Char] -> [CChar]
 charsToCChars xs  = map castCharToCChar xs
+#endif
 
-castCCharToChar :: CChar -> Char
-castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+-----------------------------------------------------------------------------
+-- Wide strings
 
-castCharToCChar :: Char -> CChar
-castCharToCChar ch = fromIntegral (ord ch)
+-- representation of wide strings in C
+-- -----------------------------------
+
+-- | A C wide string is a reference to an array of C wide characters
+-- terminated by NUL.
+type CWString    = Ptr CWchar
+
+-- | 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)
+
+-- | Marshal a NUL terminated C wide string into a Haskell string.
+--
+peekCWString    :: CWString -> IO String
+peekCWString cp  = do
+  cs <- peekArray0 wNUL cp
+  return (cWcharsToChars cs)
+
+-- | Marshal a C wide string with explicit length into a Haskell string.
+--
+peekCWStringLen           :: CWStringLen -> IO String
+peekCWStringLen (cp, len)  = do
+  cs <- peekArray len cp
+  return (cWcharsToChars cs)
+
+-- | Marshal a Haskell string into a NUL terminated C wide string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * 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 wide string and must
+--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCWStringLen     :: String -> IO CWStringLen
+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
+--
+-- * 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
+
+-- | Marshal a Haskell string into a NUL terminated C wide string using
+-- temporary storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * 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 f    =
+  withArrayLen (charsToCWchars str) $ \ len ptr -> f (ptr, len)
+
+-- auxiliary definitions
+-- ----------------------
+
+wNUL :: CWchar
+wNUL = 0
+
+cWcharsToChars :: [CWchar] -> [Char]
+charsToCWchars :: [Char] -> [CWchar]
+
+#ifdef mingw32_HOST_OS
+
+-- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.
+
+-- coding errors generate Chars in the surrogate range
+cWcharsToChars = map chr . fromUTF16 . map fromIntegral
+ where
+  fromUTF16 (c1:c2:wcs)
+    | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =
+      ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs
+  fromUTF16 (c:wcs) = c : fromUTF16 wcs
+  fromUTF16 [] = []
+
+charsToCWchars = foldr utf16Char [] . map ord
+ where
+  utf16Char c wcs
+    | c < 0x10000 = fromIntegral c : wcs
+    | otherwise   = let c' = c - 0x10000 in
+                    fromIntegral (c' `div` 0x400 + 0xd800) :
+                    fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs
+
+#else /* !mingw32_HOST_OS */
+
+cWcharsToChars xs  = map castCWcharToChar xs
+charsToCWchars xs  = map castCharToCWchar xs
+
+-- These conversions only make sense if __STDC_ISO_10646__ is defined
+-- (meaning that wchar_t is ISO 10646, aka Unicode)
+
+castCWcharToChar :: CWchar -> Char
+castCWcharToChar ch = chr (fromIntegral ch )
+
+castCharToCWchar :: Char -> CWchar
+castCharToCWchar ch = fromIntegral (ord ch)
+
+#endif /* !mingw32_HOST_OS */