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 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 141 -- re-enter Haskell land through finalizers.
 142 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
 143
 144 exitFailure :: IO a
 145 exitFailure = exitWith (ExitFailure 1)
 146 \end{code}
 147
 148
 149 %*********************************************************
 150 %*                                                      *
 151 \subsection{Local utilities}
 152 %*                                                      *
 153 %*********************************************************
 154
 155 \begin{code}
 156 type CHAR_STAR_STAR     = Addr  -- this is all a  HACK
 157 type CHAR_STAR          = Addr
 158
 159 unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
 160 unpackArgv argv argc = unpack 1
 161   where
 162    unpack :: Int -> [String]
 163    unpack n
 164      | n >= argc = []
 165      | otherwise =
 166          case (indexAddrOffAddr argv n) of
 167            item -> unpackCString item : unpack (n + 1)
 168
 169 unpackProgName  :: CHAR_STAR_STAR        -> String   -- argv[0]
 170 unpackProgName argv
 171   = case (indexAddrOffAddr argv 0) of { prog ->
 172     de_slash [] (unpackCString prog) }
 173   where
 174     -- re-start accumulating at every '/'
 175     de_slash :: String -> String -> String
 176     de_slash  acc []       = reverse acc
 177     de_slash _acc ('/':xs) = de_slash []      xs
 178     de_slash  acc (x:xs)   = de_slash (x:acc) xs
 179 \end{code}
 180
 181 #else
 182
 183 \begin{code}
 184 -----------------------------------------------------------------------------
 185 -- Standard Library: System operations
 186 --
 187 -- Warning: the implementation of these functions in Hugs 98 is very weak.
 188 -- The functions themselves are best suited to uses in compiled programs,
 189 -- and not to use in an interpreter-based environment like Hugs.
 190 --
 191 -- Suitable for use with Hugs 98
 192 -----------------------------------------------------------------------------
 193 import PrelPrim ( primGetRawArgs
 194                 , primGetEnv
 195                 , prelCleanupAfterRunAction
 196                 , copy_String_to_cstring
 197                 , readIORef
 198                 , nh_stderr
 199                 , nh_stdout
 200                 , nh_stdin
 201                 , nh_exitwith
 202                 , nh_flush
 203                 , nh_close
 204                 , nh_system
 205                 , nh_free
 206                 , nh_getPID
 207                 )
 208
 209
 210 data ExitCode = ExitSuccess | ExitFailure Int
 211                 deriving (Eq, Ord, Read, Show)
 212
 213 getArgs                     :: IO [String]
 214 getArgs                      = primGetRawArgs >>= \rawargs ->
 215                                return (tail rawargs)
 216
 217 getProgName                 :: IO String
 218 getProgName                  = primGetRawArgs >>= \rawargs ->
 219                                return (head rawargs)
 220
 221 getEnv                      :: String -> IO String
 222 getEnv                       = primGetEnv
 223
 224 exitFailure                 :: IO a
 225 exitFailure                  = exitWith (ExitFailure 1)
 226
 227 toExitCode                  :: Int -> ExitCode
 228 toExitCode 0                 = ExitSuccess
 229 toExitCode n                 = ExitFailure n
 230
 231 fromExitCode                :: ExitCode -> Int
 232 fromExitCode ExitSuccess     = 0
 233 fromExitCode (ExitFailure n) = n
 234
 235 -- see comment in Prelude.hs near primRunIO_hugs_toplevel
 236 exitWith :: ExitCode -> IO a
 237 exitWith c
 238    = do cleanup_action <- readIORef prelCleanupAfterRunAction
 239         case cleanup_action of
 240            Just xx -> xx
 241            Nothing -> return ()
 242         nh_stderr >>= nh_flush
 243         nh_stdout >>= nh_flush
 244         nh_stdin  >>= nh_close
 245         nh_exitwith (fromExitCode c)
 246         (ioError.IOError) "System.exitWith: should not return"
 247
 248 system :: String -> IO ExitCode
 249 system cmd
 250    | null cmd
 251    = (ioError.IOError) "System.system: null command"
 252    | otherwise
 253    = do str    <- copy_String_to_cstring cmd
 254         status <- nh_system str
 255         nh_free str
 256         case status of
 257            0  -> return ExitSuccess
 258            n  -> return (ExitFailure n)
 259
 260 getPID :: IO Int
 261 getPID
 262    = nh_getPID
 263
 264 -----------------------------------------------------------------------------
 265 \end{code}
 266 #endif