ghc/lib/std/Directory.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1997
   3 %
   4 \section[Directory]{Directory interface}
   5
   6 A directory contains a series of entries, each of which is a named
   7 reference to a file system object (file, directory etc.).  Some
   8 entries may be hidden, inaccessible, or have some administrative
   9 function (e.g. "." or ".." under POSIX), but in this standard all such
  10 entries are considered to form part of the directory contents.
  11 Entries in sub-directories are not, however, considered to form part
  12 of the directory contents.
  13
  14 Each file system object is referenced by a {\em path}.  There is
  15 normally at least one absolute path to each file system object.  In
  16 some operating systems, it may also be possible to have paths which
  17 are relative to the current directory.
  18
  19 \begin{code}
  20 {-# OPTIONS -#include <sys/stat.h> -#include <dirent.h> -#include "cbits/stgio.h" #-}
  21 module Directory
  22    (
  23     Permissions(Permissions),
  24
  25     createDirectory,
  26     removeDirectory,
  27     renameDirectory,
  28     getDirectoryContents,
  29     getCurrentDirectory,
  30     setCurrentDirectory,
  31
  32     removeFile,
  33     renameFile,
  34
  35     doesFileExist,
  36     doesDirectoryExist,
  37     getPermissions,
  38     setPermissions,
  39 #ifndef __HUGS__
  40     getModificationTime
  41 #endif
  42    ) where
  43
  44 #ifdef __HUGS__
  45 import PreludeBuiltin
  46 #else
  47 import PrelBase
  48 import PrelIOBase
  49 import PrelHandle
  50 import PrelST
  51 import PrelArr
  52 import PrelPack         ( unpackNBytesST )
  53 import PrelAddr
  54 import Time             ( ClockTime(..) )
  55 #endif
  56
  57 \end{code}
  58
  59 %*********************************************************
  60 %*                                                      *
  61 \subsection{Signatures}
  62 %*                                                      *
  63 %*********************************************************
  64
  65 \begin{code}
  66 createDirectory         :: FilePath -> IO ()
  67 removeDirectory         :: FilePath -> IO ()
  68 removeFile              :: FilePath -> IO ()
  69 renameDirectory         :: FilePath -> FilePath -> IO ()
  70 renameFile              :: FilePath -> FilePath -> IO ()
  71 getDirectoryContents    :: FilePath -> IO [FilePath]
  72 getCurrentDirectory     :: IO FilePath
  73 setCurrentDirectory     :: FilePath -> IO ()
  74 doesFileExist           :: FilePath -> IO Bool
  75 doesDirectoryExist      :: FilePath -> IO Bool
  76 getPermissions          :: FilePath -> IO Permissions
  77 setPermissions          :: FilePath -> Permissions -> IO ()
  78 #ifndef __HUGS__
  79 getModificationTime     :: FilePath -> IO ClockTime
  80 #endif
  81 \end{code}
  82
  83 \begin{code}
  84 #ifdef __HUGS__
  85 foreign import stdcall "libHS_cbits.so" "createDirectory"       primCreateDirectory     :: CString -> IO Int
  86 foreign import stdcall "libHS_cbits.so" "removeDirectory"       primRemoveDirectory     :: CString -> IO Int
  87 foreign import stdcall "libHS_cbits.so" "removeFile"            primRemoveFile          :: CString -> IO Int
  88 foreign import stdcall "libHS_cbits.so" "renameDirectory"       primRenameDirectory     :: CString -> CString -> IO Int
  89 foreign import stdcall "libHS_cbits.so" "renameFile"            primRenameFile          :: CString -> CString -> IO Int
  90 foreign import stdcall "libHS_cbits.so" "openDir__"             primOpenDir             :: CString -> IO Addr
  91 foreign import stdcall "libHS_cbits.so" "readDir__"             primReadDir             :: Addr -> IO Addr
  92 foreign import stdcall "libHS_cbits.so" "get_dirent_d_name"   primGetDirentDName      :: Addr -> IO Addr
  93 foreign import stdcall "libHS_cbits.so" "setCurrentDirectory" primSetCurrentDirectory :: CString -> IO Int
  94 foreign import stdcall "libHS_cbits.so" "getCurrentDirectory" primGetCurrentDirectory :: IO Addr
  95 foreign import stdcall "libc.so.6"        "free"                primFree                :: Addr -> IO ()
  96 foreign import stdcall "libc.so.6"        "malloc"              primMalloc              :: Word -> IO Addr
  97 foreign import stdcall "libc.so.6"        "chmod"               primChmod               :: CString -> Word -> IO Int
  98 #endif
  99 \end{code}
 100
 101 %*********************************************************
 102 %*                                                      *
 103 \subsection{Permissions}
 104 %*                                                      *
 105 %*********************************************************
 106
 107 The @Permissions@ type is used to record whether certain
 108 operations are permissible on a file/directory:
 109 [to whom? - owner/group/world - the Report don't say much]
 110
 111 \begin{code}
 112 data Permissions
 113  = Permissions {
 114     readable,   writeable,
 115     executable, searchable :: Bool
 116    } deriving (Eq, Ord, Read, Show)
 117 \end{code}
 118
 119 %*********************************************************
 120 %*                                                      *
 121 \subsection{Implementation}
 122 %*                                                      *
 123 %*********************************************************
 124
 125 @createDirectory dir@ creates a new directory {\em dir} which is
 126 initially empty, or as near to empty as the operating system
 127 allows.
 128
 129 The operation may fail with:
 130
 131 \begin{itemize}
 132 \item @isPermissionError@ / @PermissionDenied@
 133 The process has insufficient privileges to perform the operation.
 134 @[EROFS, EACCES]@
 135 \item @isAlreadyExistsError@ / @AlreadyExists@
 136 The operand refers to a directory that already exists.
 137 @ [EEXIST]@
 138 \item @HardwareFault@
 139 A physical I/O error has occurred.
 140 @ [EIO]@
 141 \item @InvalidArgument@
 142 The operand is not a valid directory name.
 143 @[ENAMETOOLONG, ELOOP]@
 144 \item @NoSuchThing@
 145 There is no path to the directory.
 146 @[ENOENT, ENOTDIR]@
 147 \item @ResourceExhausted@
 148 Insufficient resources (virtual memory, process file descriptors,
 149 physical disk space, etc.) are available to perform the operation.
 150 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 151 \item @InappropriateType@
 152 The path refers to an existing non-directory object.
 153 @[EEXIST]@
 154 \end{itemize}
 155
 156 \begin{code}
 157
 158 createDirectory path = do
 159 #ifdef __HUGS__
 160     rc <- primCreateDirectory (primPackString path)
 161 #else
 162     rc <- _ccall_ createDirectory path
 163 #endif
 164     if rc == 0 then return () else
 165         constructErrorAndFailWithInfo "createDirectory" path
 166 \end{code}
 167
 168 @removeDirectory dir@ removes an existing directory {\em dir}.  The
 169 implementation may specify additional constraints which must be
 170 satisfied before a directory can be removed (e.g. the directory has to
 171 be empty, or may not be in use by other processes).  It is not legal
 172 for an implementation to partially remove a directory unless the
 173 entire directory is removed. A conformant implementation need not
 174 support directory removal in all situations (e.g. removal of the root
 175 directory).
 176
 177 The operation may fail with:
 178 \begin{itemize}
 179 \item @HardwareFault@
 180 A physical I/O error has occurred.
 181 [@EIO@]
 182 \item @InvalidArgument@
 183 The operand is not a valid directory name.
 184 @[ENAMETOOLONG, ELOOP]@
 185 \item @isDoesNotExist@ / @NoSuchThing@
 186 The directory does not exist.
 187 @[ENOENT, ENOTDIR]@
 188 \item @isPermissionError@ / @PermissionDenied@
 189 The process has insufficient privileges to perform the operation.
 190 @[EROFS, EACCES, EPERM]@
 191 \item @UnsatisfiedConstraints@
 192 Implementation-dependent constraints are not satisfied.
 193 @[EBUSY, ENOTEMPTY, EEXIST]@
 194 \item @UnsupportedOperation@
 195 The implementation does not support removal in this situation.
 196 @[EINVAL]@
 197 \item @InappropriateType@
 198 The operand refers to an existing non-directory object.
 199 @[ENOTDIR]@
 200 \end{itemize}
 201
 202 \begin{code}
 203 removeDirectory path = do
 204 #ifdef __HUGS__
 205     rc <- primRemoveDirectory (primPackString path)
 206 #else
 207     rc <- _ccall_ removeDirectory path
 208 #endif
 209     if rc == 0 then
 210         return ()
 211      else
 212         constructErrorAndFailWithInfo "removeDirectory" path
 213 \end{code}
 214
 215 @removeFile file@ removes the directory entry for an existing file
 216 {\em file}, where {\em file} is not itself a directory. The
 217 implementation may specify additional constraints which must be
 218 satisfied before a file can be removed (e.g. the file may not be in
 219 use by other processes).
 220
 221 The operation may fail with:
 222 \begin{itemize}
 223 \item @HardwareFault@
 224 A physical I/O error has occurred.
 225 @[EIO]@
 226 \item @InvalidArgument@
 227 The operand is not a valid file name.
 228 @[ENAMETOOLONG, ELOOP]@
 229 \item @isDoesNotExist@ / @NoSuchThing@
 230 The file does not exist.
 231 @[ENOENT, ENOTDIR]@
 232 \item @isPermissionError@ / @PermissionDenied@
 233 The process has insufficient privileges to perform the operation.
 234 @[EROFS, EACCES, EPERM]@
 235 \item @UnsatisfiedConstraints@
 236 Implementation-dependent constraints are not satisfied.
 237 @[EBUSY]@
 238 \item @InappropriateType@
 239 The operand refers to an existing directory.
 240 @[EPERM, EINVAL]@
 241 \end{itemize}
 242
 243 \begin{code}
 244 removeFile path = do
 245 #ifdef __HUGS__
 246     rc <- primRemoveFile (primPackString path)
 247 #else
 248     rc <- _ccall_ removeFile path
 249 #endif
 250     if rc == 0 then
 251         return ()
 252      else
 253         constructErrorAndFailWithInfo "removeFile" path
 254 \end{code}
 255
 256 @renameDirectory old@ {\em new} changes the name of an existing
 257 directory from {\em old} to {\em new}.  If the {\em new} directory
 258 already exists, it is atomically replaced by the {\em old} directory.
 259 If the {\em new} directory is neither the {\em old} directory nor an
 260 alias of the {\em old} directory, it is removed as if by
 261 $removeDirectory$.  A conformant implementation need not support
 262 renaming directories in all situations (e.g. renaming to an existing
 263 directory, or across different physical devices), but the constraints
 264 must be documented.
 265
 266 The operation may fail with:
 267 \begin{itemize}
 268 \item @HardwareFault@
 269 A physical I/O error has occurred.
 270 @[EIO]@
 271 \item @InvalidArgument@
 272 Either operand is not a valid directory name.
 273 @[ENAMETOOLONG, ELOOP]@
 274 \item @isDoesNotExistError@ / @NoSuchThing@
 275 The original directory does not exist, or there is no path to the target.
 276 @[ENOENT, ENOTDIR]@
 277 \item @isPermissionError@ / @PermissionDenied@
 278 The process has insufficient privileges to perform the operation.
 279 @[EROFS, EACCES, EPERM]@
 280 \item @ResourceExhausted@
 281 Insufficient resources are available to perform the operation.
 282 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 283 \item @UnsatisfiedConstraints@
 284 Implementation-dependent constraints are not satisfied.
 285 @[EBUSY, ENOTEMPTY, EEXIST]@
 286 \item @UnsupportedOperation@
 287 The implementation does not support renaming in this situation.
 288 @[EINVAL, EXDEV]@
 289 \item @InappropriateType@
 290 Either path refers to an existing non-directory object.
 291 @[ENOTDIR, EISDIR]@
 292 \end{itemize}
 293
 294 \begin{code}
 295 renameDirectory opath npath = do
 296 #ifdef __HUGS__
 297     rc <- primRenameDirectory (primPackString opath) (primPackString npath)
 298 #else
 299     rc <- _ccall_ renameDirectory opath npath
 300 #endif
 301     if rc == 0 then
 302         return ()
 303      else
 304         constructErrorAndFailWithInfo "renameDirectory" ("old: " ++ opath ++ ",new: " ++ npath)
 305 \end{code}
 306
 307 @renameFile old@ {\em new} changes the name of an existing file system
 308 object from {\em old} to {\em new}.  If the {\em new} object already
 309 exists, it is atomically replaced by the {\em old} object.  Neither
 310 path may refer to an existing directory.  A conformant implementation
 311 need not support renaming files in all situations (e.g. renaming
 312 across different physical devices), but the constraints must be
 313 documented.
 314
 315 The operation may fail with:
 316 \begin{itemize}
 317 \item @HardwareFault@
 318 A physical I/O error has occurred.
 319 @[EIO]@
 320 \item @InvalidArgument@
 321 Either operand is not a valid file name.
 322 @[ENAMETOOLONG, ELOOP]@
 323 \item @isDoesNotExistError@ / @NoSuchThing@
 324 The original file does not exist, or there is no path to the target.
 325 @[ENOENT, ENOTDIR]@
 326 \item @isPermissionError@ / @PermissionDenied@
 327 The process has insufficient privileges to perform the operation.
 328 @[EROFS, EACCES, EPERM]@
 329 \item @ResourceExhausted@
 330 Insufficient resources are available to perform the operation.
 331 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 332 \item @UnsatisfiedConstraints@
 333 Implementation-dependent constraints are not satisfied.
 334 @[EBUSY]@
 335 \item @UnsupportedOperation@
 336 The implementation does not support renaming in this situation.
 337 @[EXDEV]@
 338 \item @InappropriateType@
 339 Either path refers to an existing directory.
 340 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 341 \end{itemize}
 342
 343 \begin{code}
 344 renameFile opath npath = do
 345 #ifdef __HUGS__
 346     rc <- primRenameFile (primPackString opath) (primPackString npath)
 347 #else
 348     rc <- _ccall_ renameFile opath npath
 349 #endif
 350     if rc == 0 then
 351         return ()
 352      else
 353         constructErrorAndFailWithInfo   "renameFile" opath
 354 \end{code}
 355
 356 @getDirectoryContents dir@ returns a list of {\em all} entries
 357 in {\em dir}.
 358
 359 The operation may fail with:
 360 \begin{itemize}
 361 \item @HardwareFault@
 362 A physical I/O error has occurred.
 363 @[EIO]@
 364 \item @InvalidArgument@
 365 The operand is not a valid directory name.
 366 @[ENAMETOOLONG, ELOOP]@
 367 \item @isDoesNotExistError@ / @NoSuchThing@
 368 The directory does not exist.
 369 @[ENOENT, ENOTDIR]@
 370 \item @isPermissionError@ / @PermissionDenied@
 371 The process has insufficient privileges to perform the operation.
 372 @[EACCES]@
 373 \item @ResourceExhausted@
 374 Insufficient resources are available to perform the operation.
 375 @[EMFILE, ENFILE]@
 376 \item @InappropriateType@
 377 The path refers to an existing non-directory object.
 378 @[ENOTDIR]@
 379 \end{itemize}
 380
 381 \begin{code}
 382 --getDirectoryContents :: FilePath -> IO [FilePath]
 383 #ifdef __HUGS__
 384 getDirectoryContents path = do
 385     dir <- primOpenDir (primPackString path)
 386     if dir == nullAddr
 387         then constructErrorAndFailWithInfo "getDirectoryContents" path
 388         else loop dir
 389   where
 390     loop :: Addr -> IO [String]
 391     loop dir  = do
 392       dirent_ptr <- primReadDir dir
 393       if dirent_ptr == nullAddr
 394        then do
 395           -- readDir__ implicitly performs closedir() when the
 396           -- end is reached.
 397           return []
 398        else do
 399           str     <- primGetDirentDName dirent_ptr
 400           entry   <- primUnpackCString str
 401           entries <- loop dir
 402           return (entry:entries)
 403 #else
 404 getDirectoryContents path = do
 405     dir <- _ccall_ openDir__ path
 406     if dir == ``NULL''
 407         then constructErrorAndFailWithInfo "getDirectoryContents" path
 408         else loop dir
 409   where
 410     loop :: Addr -> IO [String]
 411     loop dir  = do
 412       dirent_ptr <- _ccall_ readDir__ dir
 413       if (dirent_ptr::Addr) == ``NULL''
 414        then do
 415           -- readDir__ implicitly performs closedir() when the
 416           -- end is reached.
 417           return []
 418        else do
 419           str     <- _casm_ `` %r=(char*)((struct dirent*)%0)->d_name; '' dirent_ptr
 420             -- not using the unpackCString function here, since we have to force
 421             -- the unmarshalling of the directory entry right here as subsequent
 422             -- calls to readdir() may overwrite it.
 423           len     <- _ccall_ strlen str
 424           entry   <- stToIO (unpackNBytesST str len)
 425           entries <- loop dir
 426           return (entry:entries)
 427 #endif
 428 \end{code}
 429
 430 If the operating system has a notion of current directories,
 431 @getCurrentDirectory@ returns an absolute path to the
 432 current directory of the calling process.
 433
 434 The operation may fail with:
 435 \begin{itemize}
 436 \item @HardwareFault@
 437 A physical I/O error has occurred.
 438 @[EIO]@
 439 \item @isDoesNotExistError@ / @NoSuchThing@
 440 There is no path referring to the current directory.
 441 @[EPERM, ENOENT, ESTALE...]@
 442 \item @isPermissionError@ / @PermissionDenied@
 443 The process has insufficient privileges to perform the operation.
 444 @[EACCES]@
 445 \item @ResourceExhausted@
 446 Insufficient resources are available to perform the operation.
 447 \item @UnsupportedOperation@
 448 The operating system has no notion of current directory.
 449 \end{itemize}
 450
 451 \begin{code}
 452 getCurrentDirectory = do
 453 #ifdef __HUGS__
 454     str <- primGetCurrentDirectory
 455 #else
 456     str <- _ccall_ getCurrentDirectory
 457 #endif
 458     if str /= nullAddr
 459         then do
 460 #ifdef __HUGS__
 461             pwd <- primUnpackCString str
 462             primFree str
 463 #else
 464                 -- don't use unpackCString (see getDirectoryContents above)
 465             len <- _ccall_ strlen str
 466             pwd <- stToIO (unpackNBytesST str len)
 467             _ccall_ free str
 468 #endif
 469             return pwd
 470         else
 471             constructErrorAndFail "getCurrentDirectory"
 472 \end{code}
 473
 474 If the operating system has a notion of current directories,
 475 @setCurrentDirectory dir@ changes the current
 476 directory of the calling process to {\em dir}.
 477
 478 The operation may fail with:
 479 \begin{itemize}
 480 \item @HardwareFault@
 481 A physical I/O error has occurred.
 482 @[EIO]@
 483 \item @InvalidArgument@
 484 The operand is not a valid directory name.
 485 @[ENAMETOOLONG, ELOOP]@
 486 \item @isDoesNotExistError@ / @NoSuchThing@
 487 The directory does not exist.
 488 @[ENOENT, ENOTDIR]@
 489 \item @isPermissionError@ / @PermissionDenied@
 490 The process has insufficient privileges to perform the operation.
 491 @[EACCES]@
 492 \item @UnsupportedOperation@
 493 The operating system has no notion of current directory, or the
 494 current directory cannot be dynamically changed.
 495 \item @InappropriateType@
 496 The path refers to an existing non-directory object.
 497 @[ENOTDIR]@
 498 \end{itemize}
 499
 500 \begin{code}
 501 setCurrentDirectory path = do
 502 #ifdef __HUGS__
 503     rc <- primSetCurrentDirectory (primPackString path)
 504 #else
 505     rc <- _ccall_ setCurrentDirectory path
 506 #endif
 507     if rc == 0
 508         then return ()
 509         else constructErrorAndFailWithInfo "setCurrentDirectory" path
 510 \end{code}
 511
 512
 513 \begin{code}
 514 --doesFileExist :: FilePath -> IO Bool
 515 #ifdef __HUGS__
 516 foreign import stdcall "libc.so.6"        "access"     primAccess  :: PrimByteArray -> Int -> IO Int
 517 foreign import stdcall "libHS_cbits.so" "const_F_OK" const_F_OK  :: Int
 518
 519 doesFileExist name = do
 520   rc <- primAccess (primPackString name) const_F_OK
 521   return (rc == 0)
 522 #else
 523 doesFileExist name = do
 524   rc <- _ccall_ access name (``F_OK''::Int)
 525   return (rc == 0)
 526 #endif
 527
 528 --doesDirectoryExist :: FilePath -> IO Bool
 529 doesDirectoryExist name =
 530  (getFileStatus name >>= \ st -> return (isDirectory st))
 531    `catch`
 532  (\ _ -> return False)
 533
 534 #ifndef __HUGS__
 535 --getModificationTime :: FilePath -> IO ClockTime
 536 getModificationTime name =
 537  getFileStatus name >>= \ st ->
 538  modificationTime st
 539 #endif
 540
 541 --getPermissions :: FilePath -> IO Permissions
 542 getPermissions name =
 543   getFileStatus name >>= \ st ->
 544   let
 545    fm = fileMode st
 546    isect v = intersectFileMode v fm == v
 547   in
 548   return (
 549     Permissions {
 550       readable   = isect ownerReadMode,
 551       writeable  = isect ownerWriteMode,
 552       executable = not (isDirectory st)   && isect ownerExecuteMode,
 553       searchable = not (isRegularFile st) && isect ownerExecuteMode
 554     }
 555   )
 556
 557 --setPermissions :: FilePath -> Permissions -> IO ()
 558 #ifdef __HUGS__
 559 setPermissions name (Permissions r w e s) = do
 560     let
 561      read  = if r      then ownerReadMode    else emptyFileMode
 562      write = if w      then ownerWriteMode   else emptyFileMode
 563      exec  = if e || s then ownerExecuteMode else emptyFileMode
 564
 565      mode  = read `unionFileMode` (write `unionFileMode` exec)
 566
 567     rc <- primChmod (primPackString name) mode
 568     if rc == 0
 569         then return ()
 570         else fail (IOError Nothing SystemError "setPermissions" "insufficient permissions")
 571 #else
 572 setPermissions name (Permissions r w e s) = do
 573     let
 574      read#  = case (if r then ownerReadMode else ``0'') of { W# x# -> x# }
 575      write# = case (if w then ownerWriteMode else ``0'') of { W# x# -> x# }
 576      exec#  = case (if e || s then ownerExecuteMode else ``0'') of { W# x# -> x# }
 577
 578      mode  = I# (word2Int# (read# `or#` write# `or#` exec#))
 579
 580     rc <- _ccall_ chmod name mode
 581     if rc == 0
 582         then return ()
 583         else fail (IOError Nothing SystemError "setPermissions" "insufficient permissions")
 584 #endif
 585 \end{code}
 586
 587
 588 (Sigh)..copied from Posix.Files to avoid dep. on posix library
 589
 590 \begin{code}
 591 #ifdef __HUGS__
 592 foreign import stdcall "libHS_cbits.so" "sizeof_stat" sizeof_stat :: Int
 593 foreign import stdcall "libHS_cbits.so" "prim_stat"   primStat :: PrimByteArray -> PrimMutableByteArray RealWorld -> IO Int
 594
 595 type FileStatus = PrimByteArray
 596
 597 getFileStatus :: FilePath -> IO FileStatus
 598 getFileStatus name = do
 599     bytes <- primNewByteArray sizeof_stat
 600     rc <- primStat (primPackString name) bytes
 601     if rc == 0
 602         then primUnsafeFreezeByteArray bytes
 603         else fail (IOError Nothing SystemError "getFileStatus" "")
 604 #else
 605 type FileStatus = ByteArray Int
 606
 607 getFileStatus :: FilePath -> IO FileStatus
 608 getFileStatus name = do
 609     bytes <- stToIO (newCharArray (0,``sizeof(struct stat)''))
 610     rc <- _casm_ ``%r = stat(%0,(struct stat *)%1);'' name bytes
 611     if rc == 0
 612         then stToIO (unsafeFreezeByteArray bytes)
 613         else fail (IOError Nothing SystemError "getFileStatus" "")
 614
 615 modificationTime :: FileStatus -> IO ClockTime
 616 modificationTime stat = do
 617     i1 <- malloc1
 618     _casm_ ``((unsigned long *)%1)[0] = ((struct stat *)%0)->st_mtime;'' stat i1
 619     secs <- cvtUnsigned i1
 620     return (TOD secs 0)
 621   where
 622     malloc1 = IO $ \ s# ->
 623         case newIntArray# 1# s# of
 624           (# s2#, barr# #) -> (# s2#, MutableByteArray bnds barr# #)
 625
 626     bnds = (0,1)
 627     -- The C routine fills in an unsigned word.  We don't have `unsigned2Integer#,'
 628     -- so we freeze the data bits and use them for an MP_INT structure.  Note that
 629     -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably
 630     -- acceptable to gmp.
 631
 632     cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
 633         case readIntArray# arr# 0# s# of
 634           (# s2#, r# #) ->
 635             if r# ==# 0# then
 636                 (# s2#, 0 #)
 637             else
 638                 case unsafeFreezeByteArray# arr# s2# of
 639                   (# s3#, frozen# #) ->
 640                         (# s3#, J# 1# 1# frozen# #)
 641 #endif
 642
 643 #ifdef __HUGS__
 644 foreign import stdcall "libHS_cbits.so" "get_stat_st_mode" fileMode     :: FileStatus -> FileMode
 645 foreign import stdcall "libHS_cbits.so" "prim_S_ISDIR"     prim_S_ISDIR :: FileMode -> Int
 646 foreign import stdcall "libHS_cbits.so" "prim_S_ISREG"     prim_S_ISREG :: FileMode -> Int
 647
 648 isDirectory :: FileStatus -> Bool
 649 isDirectory stat = prim_S_ISDIR (fileMode stat) /= 0
 650
 651 isRegularFile :: FileStatus -> Bool
 652 isRegularFile stat = prim_S_ISREG (fileMode stat) /= 0
 653 #else
 654 isDirectory :: FileStatus -> Bool
 655 isDirectory stat = unsafePerformIO $ do
 656     rc <- _casm_ ``%r = S_ISDIR(((struct stat *)%0)->st_mode);'' stat
 657     return (rc /= 0)
 658
 659 isRegularFile :: FileStatus -> Bool
 660 isRegularFile stat = unsafePerformIO $ do
 661     rc <- _casm_ ``%r = S_ISREG(((struct stat *)%0)->st_mode);'' stat
 662     return (rc /= 0)
 663 #endif
 664 \end{code}
 665
 666 \begin{code}
 667 type FileMode = Word
 668
 669 #ifdef __HUGS__
 670 emptyFileMode     :: FileMode
 671 unionFileMode     :: FileMode -> FileMode -> FileMode
 672 intersectFileMode :: FileMode -> FileMode -> FileMode
 673
 674 foreign import stdcall "libHS_cbits.so" "const_S_IRUSR" ownerReadMode    :: FileMode
 675 foreign import stdcall "libHS_cbits.so" "const_S_IWUSR" ownerWriteMode   :: FileMode
 676 foreign import stdcall "libHS_cbits.so" "const_S_IXUSR" ownerExecuteMode :: FileMode
 677
 678 emptyFileMode     = primIntToWord 0
 679 unionFileMode     = primOrWord
 680 intersectFileMode = primAndWord
 681 #else
 682 ownerReadMode    :: FileMode
 683 ownerReadMode    = ``S_IRUSR''
 684
 685 ownerWriteMode   :: FileMode
 686 ownerWriteMode   = ``S_IWUSR''
 687
 688 ownerExecuteMode :: FileMode
 689 ownerExecuteMode = ``S_IXUSR''
 690
 691 intersectFileMode :: FileMode -> FileMode -> FileMode
 692 intersectFileMode (W# m1#) (W# m2#) = W# (m1# `and#` m2#)
 693
 694 fileMode          :: FileStatus -> FileMode
 695 fileMode stat = unsafePerformIO (
 696         _casm_ ``%r = ((struct stat *)%0)->st_mode;'' stat)
 697 #endif
 698
 699 \end{code}