ghc/lib/std/System.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1999
   3 %
   4
   5 \section[System]{Module @System@}
   6
   7 \begin{code}
   8 {-# OPTIONS -#include "cbits/stgio.h" #-}
   9 module System
  10     (
  11       ExitCode(ExitSuccess,ExitFailure)
  12     , getArgs       -- :: IO [String]
  13     , getProgName   -- :: IO String
  14     , getEnv        -- :: String -> IO String
  15     , system        -- :: String -> IO ExitCode
  16     , exitWith      -- :: ExitCode -> IO a
  17     , exitFailure   -- :: IO a
  18   ) where
  19
  20 #ifdef __HUGS__
  21 import PreludeBuiltin
  22
  23 indexAddrOffAddr = primIndexAddrOffAddr
  24
  25 unpackCString = unsafeUnpackCString
  26
  27 #else
  28 import Prelude
  29 import PrelAddr
  30 import PrelIOBase       ( IOError(..), IOErrorType(..), constructErrorAndFailWithInfo, stToIO )
  31 import PrelPack         ( unpackCString, unpackCStringST, packString )
  32 import PrelArr          ( ByteArray )
  33
  34 type PrimByteArray  = ByteArray Int
  35
  36 primUnpackCString :: Addr -> IO String
  37 primUnpackCString s = stToIO ( unpackCStringST s )
  38
  39 primPackString :: String -> PrimByteArray
  40 primPackString s    = packString s
  41 #endif
  42
  43 \end{code}
  44
  45 %*********************************************************
  46 %*                                                      *
  47 \subsection{The @ExitCode@ type}
  48 %*                                                      *
  49 %*********************************************************
  50
  51 The $ExitCode$ type defines the exit codes that a program
  52 can return.  $ExitSuccess$ indicates successful termination;
  53 and $ExitFailure code$ indicates program failure
  54 with value {\em code}.  The exact interpretation of {\em code}
  55 is operating-system dependent.  In particular, some values of
  56 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
  57
  58 \begin{code}
  59 data ExitCode = ExitSuccess | ExitFailure Int
  60                 deriving (Eq, Ord, Read, Show)
  61
  62 \end{code}
  63
  64 Computation $getArgs$ returns a list of the program's command
  65 line arguments (not including the program name).
  66
  67 \begin{code}
  68 getArgs                 :: IO [String]
  69 getArgs = return (unpackArgv primArgv primArgc)
  70
  71 foreign import ccall "libHS_cbits.so" "get_prog_argv" unsafe primArgv :: Addr
  72 foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
  73 \end{code}
  74
  75 Computation $getProgName$ returns the name of the program
  76 as it was invoked.
  77
  78 \begin{code}
  79 getProgName             :: IO String
  80 getProgName = return (unpackProgName primArgv)
  81 \end{code}
  82
  83 Computation $getEnv var$ returns the value
  84 of the environment variable {\em var}.
  85
  86 This computation may fail with
  87 \begin{itemize}
  88 \item $NoSuchThing$
  89 The environment variable does not exist.
  90 \end{itemize}
  91
  92 \begin{code}
  93 getEnv                  :: String -> IO String
  94 getEnv name = do
  95     litstring <- primGetEnv (primPackString name)
  96     if litstring /= nullAddr
  97         then primUnpackCString litstring
  98         else ioError (IOError Nothing NoSuchThing "getEnv"
  99                         ("environment variable: " ++ name))
 100
 101 foreign import ccall "libHS_cbits.so" "getenv" unsafe primGetEnv :: PrimByteArray -> IO Addr
 102 \end{code}
 103
 104 Computation $system cmd$ returns the exit code
 105 produced when the operating system processes the command {\em cmd}.
 106
 107 This computation may fail with
 108 \begin{itemize}
 109 \item $PermissionDenied$
 110 The process has insufficient privileges to perform the operation.
 111 \item $ResourceExhausted$
 112 Insufficient resources are available to perform the operation.
 113 \item $UnsupportedOperation$
 114 The implementation does not support system calls.
 115 \end{itemize}
 116
 117 \begin{code}
 118 system                  :: String -> IO ExitCode
 119 system "" = ioError (IOError Nothing InvalidArgument "system" "null command")
 120 system cmd = do
 121     status <- primSystem (primPackString cmd)
 122     case status of
 123         0  -> return ExitSuccess
 124         -1 -> constructErrorAndFailWithInfo "system" cmd
 125         n  -> return (ExitFailure n)
 126
 127 foreign import ccall "libHS_cbits.so" "systemCmd" unsafe primSystem :: PrimByteArray -> IO Int
 128 \end{code}
 129
 130 @exitWith code@ terminates the program, returning {\em code} to the program's caller.
 131 Before it terminates, any open or semi-closed handles are first closed.
 132
 133 \begin{code}
 134 exitWith                :: ExitCode -> IO a
 135 exitWith ExitSuccess = do
 136     primExit 0
 137     ioError (IOError Nothing OtherError "exitWith" "exit should not return")
 138
 139 exitWith (ExitFailure n)
 140   | n == 0 = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
 141   | otherwise = do
 142     primExit n
 143     ioError (IOError Nothing OtherError "exitWith" "exit should not return")
 144
 145 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
 146
 147 exitFailure :: IO a
 148 exitFailure = exitWith (ExitFailure 1)
 149 \end{code}
 150
 151
 152 %*********************************************************
 153 %*                                                      *
 154 \subsection{Local utilities}
 155 %*                                                      *
 156 %*********************************************************
 157
 158 \begin{code}
 159 type CHAR_STAR_STAR     = Addr  -- this is all a  HACK
 160 type CHAR_STAR          = Addr
 161
 162 unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
 163 unpackArgv argv argc = unpack 1
 164   where
 165    unpack :: Int -> [String]
 166    unpack n
 167      | n >= argc = []
 168      | otherwise =
 169          case (indexAddrOffAddr argv n) of
 170            item -> unpackCString item : unpack (n + 1)
 171
 172 unpackProgName  :: CHAR_STAR_STAR        -> String   -- argv[0]
 173 unpackProgName argv
 174   = case (indexAddrOffAddr argv 0) of { prog ->
 175     de_slash [] (unpackCString prog) }
 176   where
 177     -- re-start accumulating at every '/'
 178     de_slash :: String -> String -> String
 179     de_slash  acc []       = reverse acc
 180     de_slash _acc ('/':xs) = de_slash []      xs
 181     de_slash  acc (x:xs)   = de_slash (x:acc) xs
 182 \end{code}