[project @ 1999-12-20 10:34:27 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / Directory.lhs

diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs
index f5f2611..6ca0029 100644 (file)
--- a/ghc/lib/std/Directory.lhs
+++ b/ghc/lib/std/Directory.lhs
@@ -20,7 +20,12 @@ are relative to the current directory.
 {-# OPTIONS -#include <sys/stat.h> -#include <dirent.h> -#include "cbits/stgio.h" #-}
 module Directory 
    ( 
-      Permissions(Permissions,readable,writable,executable,searchable)
+      Permissions               -- abstract
+      
+    , readable                  -- :: Permissions -> Bool
+    , writable                  -- :: Permissions -> Bool
+    , executable                -- :: Permissions -> Bool
+    , searchable                -- :: Permissions -> Bool
 
     , createDirectory          -- :: FilePath -> IO ()
     , removeDirectory          -- :: FilePath -> IO ()
@@ -46,16 +51,22 @@ 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, int2Word#, or#, and# )
+import PrelByteArr     ( ByteArray, MutableByteArray,
+                         newWordArray, readWordArray, newCharArray,
+                         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 )
 #endif
 
 \end{code}
@@ -434,7 +445,7 @@ doesFileExist name = do
    (getFileStatus name >>= \ st -> return (not (isDirectory st)))
    (\ _ -> return False)
 
-foreign import ccall "libHS_cbits.so" "const_F_OK" const_F_OK  :: Int
+foreign import ccall "libHS_cbits.so" "const_F_OK" unsafe const_F_OK  :: Int
 
 #ifndef __HUGS__
 getModificationTime :: FilePath -> IO ClockTime
@@ -494,35 +505,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" 
-   setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO ()
+    secs <- stToIO (readWordArray i1 0)
+    return (TOD (toInteger (wordToInt secs)) 0)
 
+foreign import ccall "libHS_cbits.so" "set_stat_st_mtime" unsafe
+   setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO ()
 #endif
 
 isDirectory :: FileStatus -> Bool
@@ -531,12 +520,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" sizeof_stat :: Int
-foreign import ccall "libHS_cbits.so" "prim_stat"   primStat :: PrimByteArray -> PrimMutableByteArray RealWorld -> IO Int
+foreign import ccall "libHS_cbits.so" "sizeof_stat" unsafe sizeof_stat :: Int
+foreign import ccall "libHS_cbits.so" "prim_stat"   unsafe
+  primStat :: PrimByteArray -> PrimMutableByteArray RealWorld -> IO Int
 
-foreign import ccall "libHS_cbits.so" "get_stat_st_mode" fileMode     :: FileStatus -> FileMode
-foreign import ccall "libHS_cbits.so" "prim_S_ISDIR"     prim_S_ISDIR :: FileMode -> Int
-foreign import ccall "libHS_cbits.so" "prim_S_ISREG"     prim_S_ISREG :: FileMode -> 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
 \end{code}
 
 \begin{code}
@@ -586,18 +576,18 @@ primNewByteArray :: Int -> IO (PrimMutableByteArray s)
 primNewByteArray sz_in_bytes = stToIO (newCharArray (0,sz_in_bytes))
 #endif
 
-foreign import ccall "libHS_cbits.so" "createDirectory"        primCreateDirectory     :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "removeDirectory"        primRemoveDirectory     :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "removeFile"             primRemoveFile          :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "renameDirectory"        primRenameDirectory     :: CString -> CString -> IO Int
-foreign import ccall "libHS_cbits.so" "renameFile"             primRenameFile          :: CString -> CString -> IO Int
-foreign import ccall "libHS_cbits.so" "openDir__"              primOpenDir             :: CString -> IO Addr
-foreign import ccall "libHS_cbits.so" "readDir__"              primReadDir             :: Addr -> IO Addr
-foreign import ccall "libHS_cbits.so" "get_dirent_d_name"   primGetDirentDName      :: Addr -> IO Addr
-foreign import ccall "libHS_cbits.so" "setCurrentDirectory" primSetCurrentDirectory :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "getCurrentDirectory" primGetCurrentDirectory :: IO Addr
-foreign import ccall "libc.so.6"        "free"                primFree                :: Addr -> IO ()
-foreign import ccall "libc.so.6"        "malloc"              primMalloc              :: Word -> IO Addr
-foreign import ccall "libc.so.6"        "chmod"               primChmod               :: CString -> Word -> IO Int
+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
 \end{code}