ghc/lib/std/System.lhs

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