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

diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs
index 8a23c6b..becfa4e 100644
--- a/Foreign/C/String.hs
+++ b/Foreign/C/String.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Foreign.C.String
@@ -59,6 +60,11 @@ module Foreign.C.String (   -- representation of strings in C
   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
@@ -99,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 )
@@ -200,6 +205,26 @@ castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
 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
@@ -214,8 +239,8 @@ peekCAString cp = do
   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.
@@ -232,11 +257,11 @@ peekCAStringLen (cp, len)
   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.
@@ -254,8 +279,8 @@ newCAString  = newArray0 nUL . charsToCChars
 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
@@ -269,15 +294,13 @@ newCAString str = do
 --
 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
@@ -300,8 +323,8 @@ withCAString  = withArray0 nUL . charsToCChars
 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
@@ -315,14 +338,14 @@ withCAString str f =
 --   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)
@@ -338,10 +361,11 @@ withCAStringLen str f =
 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]
@@ -365,7 +389,7 @@ charsToCChars xs  = map castCharToCChar xs
 -- 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)
@@ -403,9 +427,7 @@ newCWString  = newArray0 wNUL . charsToCWchars
 --   '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.
@@ -429,7 +451,8 @@ withCWString  = withArray0 wNUL . charsToCWchars
 --   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
 -- ----------------------