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