[project @ 2001-08-10 13:48:06 by simonmar]

Remove UnsafeCString (normal CString is fast enough now).

diff --git a/ghc/lib/std/Directory.hsc b/ghc/lib/std/Directory.hsc
index 1ce5844..ee457cd 100644 (file)
--- a/ghc/lib/std/Directory.hsc
+++ b/ghc/lib/std/Directory.hsc
@@ -1,5 +1,5 @@
 -- -----------------------------------------------------------------------------
--- $Id: Directory.hsc,v 1.13 2001/07/13 11:48:52 rrt Exp $
+-- $Id: Directory.hsc,v 1.14 2001/08/10 13:48:06 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2000
 --
@@ -123,7 +123,7 @@ The path refers to an existing non-directory object.
 
 createDirectory :: FilePath -> IO ()
 createDirectory path = do
-    withUnsafeCString path $ \s -> do
+    withCString path $ \s -> do
       throwErrnoIfMinus1Retry_ "createDirectory" $
 #if defined(mingw32_TARGET_OS)
         mkdir s
@@ -169,7 +169,7 @@ The operand refers to an existing non-directory object.
 
 removeDirectory :: FilePath -> IO ()
 removeDirectory path = do
-    withUnsafeCString path $ \s ->
+    withCString path $ \s ->
        throwErrnoIfMinus1Retry_ "removeDirectory" (rmdir s)
 
 {-
@@ -204,7 +204,7 @@ The operand refers to an existing directory.
 
 removeFile :: FilePath -> IO ()
 removeFile path = do
-    withUnsafeCString path $ \s ->
+    withCString path $ \s ->
       throwErrnoIfMinus1Retry_ "removeFile" (unlink s)
 
 {-
@@ -256,8 +256,8 @@ renameDirectory opath npath =
                            ("not a directory") (Just opath))
        else do
 
-   withUnsafeCString opath $ \s1 ->
-     withUnsafeCString npath $ \s2 ->
+   withCString opath $ \s1 ->
+     withCString npath $ \s2 ->
         throwErrnoIfMinus1Retry_ "renameDirectory" (rename s1 s2)
 
 {-
@@ -307,8 +307,8 @@ renameFile opath npath =
                           "is a directory" (Just opath))
        else do
 
-    withUnsafeCString opath $ \s1 ->
-      withUnsafeCString npath $ \s2 ->
+    withCString opath $ \s1 ->
+      withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (rename s1 s2)
 
 {-
@@ -340,7 +340,7 @@ The path refers to an existing non-directory object.
 
 getDirectoryContents :: FilePath -> IO [FilePath]
 getDirectoryContents path = do
-   p <- withUnsafeCString path $ \s ->
+   p <- withCString path $ \s ->
          throwErrnoIfNullRetry "getDirectoryContents" (opendir s)
    loop p
   where
@@ -439,7 +439,7 @@ The path refers to an existing non-directory object.
 
 setCurrentDirectory :: FilePath -> IO ()
 setCurrentDirectory path = do
-    withUnsafeCString path $ \s -> 
+    withCString path $ \s -> 
        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (chdir s)
        -- ToDo: add path to error
 
@@ -469,7 +469,7 @@ getModificationTime name =
 
 getPermissions :: FilePath -> IO Permissions
 getPermissions name = do
-  withUnsafeCString name $ \s -> do
+  withCString name $ \s -> do
   read  <- access s (#const R_OK)
   write <- access s (#const W_OK)
   exec  <- access s (#const X_OK)
@@ -494,13 +494,13 @@ setPermissions name (Permissions r w e s) = do
 
      mode  = read `unionCMode` (write `unionCMode` exec)
 
-    withUnsafeCString name $ \s ->
+    withCString name $ \s ->
       throwErrnoIfMinus1_ "setPermissions" $ chmod s mode
 
 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 withFileStatus name f = do
     allocaBytes (#const sizeof(struct stat)) $ \p ->
-      withUnsafeCString name $ \s -> do
+      withCString name $ \s -> do
         throwErrnoIfMinus1Retry_ "withFileStatus" (stat s p)
        f p
 
@@ -531,26 +531,24 @@ emptyCMode     = 0
 unionCMode     :: CMode -> CMode -> CMode
 unionCMode     = (+)
 
-type UCString = UnsafeCString
-
 #if defined(mingw32_TARGET_OS)
-foreign import ccall unsafe mkdir    :: UCString -> IO CInt
+foreign import ccall unsafe mkdir    :: CString -> IO CInt
 #else
-foreign import ccall unsafe mkdir    :: UCString -> CInt -> IO CInt
+foreign import ccall unsafe mkdir    :: CString -> CInt -> IO CInt
 #endif
 
-foreign import ccall unsafe chmod    :: UCString -> CMode -> IO CInt
-foreign import ccall unsafe access   :: UCString -> CMode -> IO CInt
-foreign import ccall unsafe rmdir    :: UCString -> IO CInt
-foreign import ccall unsafe chdir    :: UCString -> IO CInt
+foreign import ccall unsafe chmod    :: CString -> CMode -> IO CInt
+foreign import ccall unsafe access   :: CString -> CMode -> IO CInt
+foreign import ccall unsafe rmdir    :: CString -> IO CInt
+foreign import ccall unsafe chdir    :: CString -> IO CInt
 foreign import ccall unsafe getcwd   :: Ptr CChar -> CInt -> IO (Ptr CChar)
-foreign import ccall unsafe unlink   :: UCString -> IO CInt
-foreign import ccall unsafe rename   :: UCString -> UCString -> IO CInt
+foreign import ccall unsafe unlink   :: CString -> IO CInt
+foreign import ccall unsafe rename   :: CString -> CString -> IO CInt
                     
-foreign import ccall unsafe opendir  :: UCString  -> IO (Ptr CDir)
+foreign import ccall unsafe opendir  :: CString  -> IO (Ptr CDir)
 foreign import ccall unsafe readdir  :: Ptr CDir -> IO (Ptr CDirent)
 foreign import ccall unsafe closedir :: Ptr CDir -> IO CInt
 
-foreign import ccall unsafe stat     :: UCString -> Ptr CStat -> IO CInt
+foreign import ccall unsafe stat     :: CString -> Ptr CStat -> IO CInt
 
 type CDirent = ()

diff --git a/ghc/lib/std/PrelCString.lhs b/ghc/lib/std/PrelCString.lhs
index 4fe13fd..1d2ef13 100644 (file)
--- a/ghc/lib/std/PrelCString.lhs
+++ b/ghc/lib/std/PrelCString.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelCString.lhs,v 1.4 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelCString.lhs,v 1.5 2001/08/10 13:48:06 simonmar Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -124,17 +124,4 @@ 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
 \end{code}

diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs
index 602bc99..45483b9 100644 (file)
--- a/ghc/lib/std/System.lhs
+++ b/ghc/lib/std/System.lhs
@@ -1,5 +1,5 @@
 -- -----------------------------------------------------------------------------
--- $Id: System.lhs,v 1.31 2001/05/22 15:06:47 simonmar Exp $
+-- $Id: System.lhs,v 1.32 2001/08/10 13:48:06 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2000
 --
@@ -58,14 +58,14 @@ getProgName = do
 
 getEnv :: String -> IO String
 getEnv name =
-    withUnsafeCString name $ \s -> do
+    withCString name $ \s -> do
       litstring <- _getenv s
       if litstring /= nullPtr
        then peekCString litstring
         else ioException (IOError Nothing NoSuchThing "getEnv"
                          "no environment variable" (Just name))
 
-foreign import ccall "getenv" unsafe _getenv :: UnsafeCString -> IO (Ptr CChar)
+foreign import ccall "getenv" unsafe _getenv :: CString -> IO (Ptr CChar)
 
 -- ---------------------------------------------------------------------------
 -- system
@@ -84,13 +84,13 @@ foreign import ccall "getenv" unsafe _getenv :: UnsafeCString -> IO (Ptr CChar)
 system :: String -> IO ExitCode
 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
 system cmd =
-  withUnsafeCString cmd $ \s -> do
+  withCString cmd $ \s -> do
     status <- throwErrnoIfMinus1 "system" (primSystem s)
     case status of
         0  -> return ExitSuccess
         n  -> return (ExitFailure n)
 
-foreign import ccall "systemCmd" unsafe primSystem :: UnsafeCString -> IO Int
+foreign import ccall "systemCmd" unsafe primSystem :: CString -> IO Int
 
 -- ---------------------------------------------------------------------------
 -- exitWith