X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FDirectory.lhs;h=1c65c8753db11140df756743dba135015e3efd12;hb=89d2a24fe5be9800eb6ef0831832cba6355face5;hp=fb76a2efefda6972d702bc6930f23809c0b7ff26;hpb=fc0ea62713a45e0004927195946746c1bcebe0ef;p=ghc-hetmet.git diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs index fb76a2e..1c65c87 100644 --- a/ghc/lib/std/Directory.lhs +++ b/ghc/lib/std/Directory.lhs @@ -51,16 +51,21 @@ module Directory ) where #ifdef __HUGS__ -import PreludeBuiltin +--import PreludeBuiltin #else -import PrelBase -import PrelIOBase -import PrelHandle -import PrelST -import PrelArr + +import Prelude -- Just to get it in the dependencies + +import PrelGHC ( RealWorld, or#, and# ) +import PrelByteArr ( ByteArray, MutableByteArray, + newWordArray, readWordArray, newCharArray ) +import PrelArrExtra ( unsafeFreezeByteArray ) import PrelPack ( unpackNBytesST, packString, unpackCStringST ) -import PrelAddr +import PrelIOBase ( stToIO, + constructErrorAndFail, constructErrorAndFailWithInfo, + IOError(IOError), IOErrorType(SystemError) ) import Time ( ClockTime(..) ) +import PrelAddr ( Addr, nullAddr, Word(..), wordToInt, intToWord ) #endif \end{code} @@ -258,7 +263,7 @@ renameDirectory opath npath = do constructErrorAndFailWithInfo "renameDirectory" ("old: " ++ opath ++ ",new: " ++ npath) \end{code} -@renameFile old@ {\em new} changes the name of an existing file system +@renameFile@ {\em old} {\em new} changes the name of an existing file system object from {\em old} to {\em new}. If the {\em new} object already exists, it is atomically replaced by the {\em old} object. Neither path may refer to an existing directory. A conformant implementation @@ -439,7 +444,7 @@ doesFileExist name = do (getFileStatus name >>= \ st -> return (not (isDirectory st))) (\ _ -> return False) -foreign import ccall "libHS_cbits.so" "const_F_OK" unsafe const_F_OK :: Int +foreign import ccall "libHS_cbits" "const_F_OK" unsafe const_F_OK :: Int #ifndef __HUGS__ getModificationTime :: FilePath -> IO ClockTime @@ -499,35 +504,13 @@ getFileStatus name = do #ifndef __HUGS__ modificationTime :: FileStatus -> IO ClockTime modificationTime stat = do - -- ToDo: better, this is ugly stuff. - i1 <- malloc1 + i1 <- stToIO (newWordArray (0,1)) setFileMode i1 stat - secs <- cvtUnsigned i1 - return (TOD secs 0) - where - malloc1 = IO $ \ s# -> - case newIntArray# 1# s# of - (# s2#, barr# #) -> (# s2#, MutableByteArray bnds barr# #) - - bnds = (0,1) - -- The C routine fills in an unsigned word. We don't have `unsigned2Integer#,' - -- so we freeze the data bits and use them for an MP_INT structure. Note that - -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably - -- acceptable to gmp. - - cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# -> - case readIntArray# arr# 0# s# of - (# s2#, r# #) -> - if r# ==# 0# then - (# s2#, 0 #) - else - case unsafeFreezeByteArray# arr# s2# of - (# s3#, frozen# #) -> - (# s3#, J# 1# 1# frozen# #) - -foreign import ccall "libHS_cbits.so" "set_stat_st_mtime" unsafe - setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO () + secs <- stToIO (readWordArray i1 0) + return (TOD (toInteger (wordToInt secs)) 0) +foreign import ccall "libHS_cbits" "set_stat_st_mtime" unsafe + setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO () #endif isDirectory :: FileStatus -> Bool @@ -536,13 +519,13 @@ isDirectory stat = prim_S_ISDIR (fileMode stat) /= 0 isRegularFile :: FileStatus -> Bool isRegularFile stat = prim_S_ISREG (fileMode stat) /= 0 -foreign import ccall "libHS_cbits.so" "sizeof_stat" unsafe sizeof_stat :: Int -foreign import ccall "libHS_cbits.so" "prim_stat" unsafe +foreign import ccall "libHS_cbits" "sizeof_stat" unsafe sizeof_stat :: Int +foreign import ccall "libHS_cbits" "prim_stat" unsafe primStat :: PrimByteArray -> PrimMutableByteArray RealWorld -> IO Int -foreign import ccall "libHS_cbits.so" "get_stat_st_mode" unsafe fileMode :: FileStatus -> FileMode -foreign import ccall "libHS_cbits.so" "prim_S_ISDIR" unsafe prim_S_ISDIR :: FileMode -> Int -foreign import ccall "libHS_cbits.so" "prim_S_ISREG" unsafe prim_S_ISREG :: FileMode -> Int +foreign import ccall "libHS_cbits" "get_stat_st_mode" unsafe fileMode :: FileStatus -> FileMode +foreign import ccall "libHS_cbits" "prim_S_ISDIR" unsafe prim_S_ISDIR :: FileMode -> Int +foreign import ccall "libHS_cbits" "prim_S_ISREG" unsafe prim_S_ISREG :: FileMode -> Int \end{code} \begin{code} @@ -552,17 +535,16 @@ emptyFileMode :: FileMode unionFileMode :: FileMode -> FileMode -> FileMode intersectFileMode :: FileMode -> FileMode -> FileMode -foreign import ccall "libHS_cbits.so" "const_S_IRUSR" unsafe ownerReadMode :: FileMode -foreign import ccall "libHS_cbits.so" "const_S_IWUSR" unsafe ownerWriteMode :: FileMode -foreign import ccall "libHS_cbits.so" "const_S_IXUSR" unsafe ownerExecuteMode :: FileMode +foreign import ccall "libHS_cbits" "const_S_IRUSR" unsafe ownerReadMode :: FileMode +foreign import ccall "libHS_cbits" "const_S_IWUSR" unsafe ownerWriteMode :: FileMode +foreign import ccall "libHS_cbits" "const_S_IXUSR" unsafe ownerExecuteMode :: FileMode #ifdef __HUGS__ emptyFileMode = primIntToWord 0 unionFileMode = primOrWord intersectFileMode = primAndWord #else ---ToDo: tidy up. -emptyFileMode = W# (int2Word# 0#) +emptyFileMode = intToWord 0 unionFileMode = orWord intersectFileMode = andWord #endif @@ -592,18 +574,18 @@ primNewByteArray :: Int -> IO (PrimMutableByteArray s) primNewByteArray sz_in_bytes = stToIO (newCharArray (0,sz_in_bytes)) #endif -foreign import ccall "libHS_cbits.so" "createDirectory" unsafe primCreateDirectory :: CString -> IO Int -foreign import ccall "libHS_cbits.so" "removeDirectory" unsafe primRemoveDirectory :: CString -> IO Int -foreign import ccall "libHS_cbits.so" "removeFile" unsafe primRemoveFile :: CString -> IO Int -foreign import ccall "libHS_cbits.so" "renameDirectory" unsafe primRenameDirectory :: CString -> CString -> IO Int -foreign import ccall "libHS_cbits.so" "renameFile" unsafe primRenameFile :: CString -> CString -> IO Int -foreign import ccall "libHS_cbits.so" "openDir__" unsafe primOpenDir :: CString -> IO Addr -foreign import ccall "libHS_cbits.so" "readDir__" unsafe primReadDir :: Addr -> IO Addr -foreign import ccall "libHS_cbits.so" "get_dirent_d_name" unsafe primGetDirentDName :: Addr -> IO Addr -foreign import ccall "libHS_cbits.so" "setCurrentDirectory" unsafe primSetCurrentDirectory :: CString -> IO Int -foreign import ccall "libHS_cbits.so" "getCurrentDirectory" unsafe primGetCurrentDirectory :: IO Addr -foreign import ccall "libc.so.6" "free" unsafe primFree :: Addr -> IO () -foreign import ccall "libc.so.6" "malloc" unsafe primMalloc :: Word -> IO Addr -foreign import ccall "libc.so.6" "chmod" unsafe primChmod :: CString -> Word -> IO Int +foreign import ccall "libHS_cbits" "createDirectory" unsafe primCreateDirectory :: CString -> IO Int +foreign import ccall "libHS_cbits" "removeDirectory" unsafe primRemoveDirectory :: CString -> IO Int +foreign import ccall "libHS_cbits" "removeFile" unsafe primRemoveFile :: CString -> IO Int +foreign import ccall "libHS_cbits" "renameDirectory" unsafe primRenameDirectory :: CString -> CString -> IO Int +foreign import ccall "libHS_cbits" "renameFile" unsafe primRenameFile :: CString -> CString -> IO Int +foreign import ccall "libHS_cbits" "openDir__" unsafe primOpenDir :: CString -> IO Addr +foreign import ccall "libHS_cbits" "readDir__" unsafe primReadDir :: Addr -> IO Addr +foreign import ccall "libHS_cbits" "get_dirent_d_name" unsafe primGetDirentDName :: Addr -> IO Addr +foreign import ccall "libHS_cbits" "setCurrentDirectory" unsafe primSetCurrentDirectory :: CString -> IO Int +foreign import ccall "libHS_cbits" "getCurrentDirectory" unsafe primGetCurrentDirectory :: IO Addr +foreign import ccall "libc" "free" unsafe primFree :: Addr -> IO () +foreign import ccall "libc" "malloc" unsafe primMalloc :: Word -> IO Addr +foreign import ccall "libc" "chmod" unsafe primChmod :: CString -> Word -> IO Int \end{code}