From 5b90821ab7fc1b7e3a773506dcff8aa92d7fce7f Mon Sep 17 00:00:00 2001 From: simonmar Date: Fri, 10 Aug 2001 13:49:00 +0000 Subject: [PATCH] [project @ 2001-08-10 13:48:06 by simonmar] Remove UnsafeCString (normal CString is fast enough now). --- ghc/lib/std/Directory.hsc | 48 +++++++++++++++++++++---------------------- ghc/lib/std/PrelCString.lhs | 15 +------------- ghc/lib/std/System.lhs | 10 ++++----- 3 files changed, 29 insertions(+), 44 deletions(-) diff --git a/ghc/lib/std/Directory.hsc b/ghc/lib/std/Directory.hsc index 1ce5844..ee457cd 100644 --- 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 --- 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 --- 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 -- 1.7.10.4