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 \end{code}
  20
  21
  22 #ifndef __HUGS__
  23 \begin{code}
  24 import Prelude
  25 import PrelAddr
  26 import PrelIOBase       ( IOError(..), IOErrorType(..), constructErrorAndFailWithInfo, stToIO )
  27 import PrelPack         ( unpackCString, unpackCStringST, packString )
  28 import PrelByteArr      ( ByteArray )
  29
  30 type PrimByteArray  = ByteArray Int
  31
  32 primUnpackCString :: Addr -> IO String
  33 primUnpackCString s = stToIO ( unpackCStringST s )
  34
  35 primPackString :: String -> PrimByteArray
  36 primPackString s    = packString s
  37
  38 \end{code}
  39
  40 %*********************************************************
  41 %*                                                      *
  42 \subsection{The @ExitCode@ type}
  43 %*                                                      *
  44 %*********************************************************
  45
  46 The $ExitCode$ type defines the exit codes that a program
  47 can return.  $ExitSuccess$ indicates successful termination;
  48 and $ExitFailure code$ indicates program failure
  49 with value {\em code}.  The exact interpretation of {\em code}
  50 is operating-system dependent.  In particular, some values of
  51 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
  52
  53 \begin{code}
  54 data ExitCode = ExitSuccess | ExitFailure Int
  55                 deriving (Eq, Ord, Read, Show)
  56
  57 \end{code}
  58
  59 Computation $getArgs$ returns a list of the program's command
  60 line arguments (not including the program name).
  61
  62 \begin{code}
  63 getArgs                 :: IO [String]
  64 getArgs = return (unpackArgv primArgv primArgc)
  65
  66 foreign import ccall "libHS_cbits.so" "get_prog_argv" unsafe primArgv :: Addr
  67 foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
  68 \end{code}
  69
  70 Computation $getProgName$ returns the name of the program
  71 as it was invoked.
  72
  73 \begin{code}
  74 getProgName             :: IO String
  75 getProgName = return (unpackProgName primArgv)
  76 \end{code}
  77
  78 Computation $getEnv var$ returns the value
  79 of the environment variable {\em var}.
  80
  81 This computation may fail with
  82 \begin{itemize}
  83 \item $NoSuchThing$
  84 The environment variable does not exist.
  85 \end{itemize}
  86
  87 \begin{code}
  88 getEnv                  :: String -> IO String
  89 getEnv name = do
  90     litstring <- primGetEnv (primPackString name)
  91     if litstring /= nullAddr
  92         then primUnpackCString litstring
  93         else ioError (IOError Nothing NoSuchThing "getEnv"
  94                         ("environment variable: " ++ name))
  95
  96 foreign import ccall "libHS_cbits.so" "getenv" unsafe primGetEnv :: PrimByteArray -> IO Addr
  97 \end{code}
  98
  99 Computation $system cmd$ returns the exit code
 100 produced when the operating system processes the command {\em cmd}.
 101
 102 This computation may fail with
 103 \begin{itemize}
 104 \item $PermissionDenied$
 105 The process has insufficient privileges to perform the operation.
 106 \item $ResourceExhausted$
 107 Insufficient resources are available to perform the operation.
 108 \item $UnsupportedOperation$
 109 The implementation does not support system calls.
 110 \end{itemize}
 111
 112 \begin{code}
 113 system                  :: String -> IO ExitCode
 114 system "" = ioError (IOError Nothing InvalidArgument "system" "null command")
 115 system cmd = do
 116     status <- primSystem (primPackString cmd)
 117     case status of
 118         0  -> return ExitSuccess
 119         -1 -> constructErrorAndFailWithInfo "system" cmd
 120         n  -> return (ExitFailure n)
 121
 122 foreign import ccall "libHS_cbits.so" "systemCmd" unsafe primSystem :: PrimByteArray -> IO Int
 123 \end{code}
 124
 125 @exitWith code@ terminates the program, returning {\em code} to the program's caller.
 126 Before it terminates, any open or semi-closed handles are first closed.
 127
 128 \begin{code}
 129 exitWith                :: ExitCode -> IO a
 130 exitWith ExitSuccess = do
 131     primExit 0
 132     ioError (IOError Nothing OtherError "exitWith" "exit should not return")
 133
 134 exitWith (ExitFailure n)
 135   | n == 0 = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
 136   | otherwise = do
 137     primExit n
 138     ioError (IOError Nothing OtherError "exitWith" "exit should not return")
 139
 140 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
 141
 142 exitFailure :: IO a
 143 exitFailure = exitWith (ExitFailure 1)
 144 \end{code}
 145
 146
 147 %*********************************************************
 148 %*                                                      *
 149 \subsection{Local utilities}
 150 %*                                                      *
 151 %*********************************************************
 152
 153 \begin{code}
 154 type CHAR_STAR_STAR     = Addr  -- this is all a  HACK
 155 type CHAR_STAR          = Addr
 156
 157 unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
 158 unpackArgv argv argc = unpack 1
 159   where
 160    unpack :: Int -> [String]
 161    unpack n
 162      | n >= argc = []
 163      | otherwise =
 164          case (indexAddrOffAddr argv n) of
 165            item -> unpackCString item : unpack (n + 1)
 166
 167 unpackProgName  :: CHAR_STAR_STAR        -> String   -- argv[0]
 168 unpackProgName argv
 169   = case (indexAddrOffAddr argv 0) of { prog ->
 170     de_slash [] (unpackCString prog) }
 171   where
 172     -- re-start accumulating at every '/'
 173     de_slash :: String -> String -> String
 174     de_slash  acc []       = reverse acc
 175     de_slash _acc ('/':xs) = de_slash []      xs
 176     de_slash  acc (x:xs)   = de_slash (x:acc) xs
 177 \end{code}
 178
 179 #else
 180
 181 \begin{code}
 182 -----------------------------------------------------------------------------
 183 -- Standard Library: System operations
 184 --
 185 -- Warning: the implementation of these functions in Hugs 98 is very weak.
 186 -- The functions themselves are best suited to uses in compiled programs,
 187 -- and not to use in an interpreter-based environment like Hugs.
 188 --
 189 -- Suitable for use with Hugs 98
 190 -----------------------------------------------------------------------------
 191 import PrelPrim ( primGetRawArgs
 192                 , primGetEnv
 193                 , prelCleanupAfterRunAction
 194                 , copy_String_to_cstring
 195                 , readIORef
 196                 , nh_stderr
 197                 , nh_stdout
 198                 , nh_stdin
 199                 , nh_exitwith
 200                 , nh_flush
 201                 , nh_close
 202                 , nh_system
 203                 , nh_free
 204                 , nh_getPID
 205                 )
 206
 207
 208 data ExitCode = ExitSuccess | ExitFailure Int
 209                 deriving (Eq, Ord, Read, Show)
 210
 211 getArgs                     :: IO [String]
 212 getArgs                      = primGetRawArgs >>= \rawargs ->
 213                                return (tail rawargs)
 214
 215 getProgName                 :: IO String
 216 getProgName                  = primGetRawArgs >>= \rawargs ->
 217                                return (head rawargs)
 218
 219 getEnv                      :: String -> IO String
 220 getEnv                       = primGetEnv
 221
 222 exitFailure                 :: IO a
 223 exitFailure                  = exitWith (ExitFailure 1)
 224
 225 toExitCode                  :: Int -> ExitCode
 226 toExitCode 0                 = ExitSuccess
 227 toExitCode n                 = ExitFailure n
 228
 229 fromExitCode                :: ExitCode -> Int
 230 fromExitCode ExitSuccess     = 0
 231 fromExitCode (ExitFailure n) = n
 232
 233 -- see comment in Prelude.hs near primRunIO_hugs_toplevel
 234 exitWith :: ExitCode -> IO a
 235 exitWith c
 236    = do cleanup_action <- readIORef prelCleanupAfterRunAction
 237         case cleanup_action of
 238            Just xx -> xx
 239            Nothing -> return ()
 240         nh_stderr >>= nh_flush
 241         nh_stdout >>= nh_flush
 242         nh_stdin  >>= nh_close
 243         nh_exitwith (fromExitCode c)
 244         (ioError.IOError) "System.exitWith: should not return"
 245
 246 system :: String -> IO ExitCode
 247 system cmd
 248    | null cmd
 249    = (ioError.IOError) "System.system: null command"
 250    | otherwise
 251    = do str    <- copy_String_to_cstring cmd
 252         status <- nh_system str
 253         nh_free str
 254         case status of
 255            0  -> return ExitSuccess
 256            n  -> return (ExitFailure n)
 257
 258 getPID :: IO Int
 259 getPID
 260    = nh_getPID
 261
 262 -----------------------------------------------------------------------------
 263 \end{code}
 264 #endif