ghc/lib/required/System.hs

   1 {-
   2 %
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   4 %
   5 \section[LibSystem]{Haskell 1.3 System Interaction}
   6 -}
   7 module System (
   8     ExitCode(ExitSuccess,ExitFailure),
   9     getArgs, getProgName, getEnv, system, exitWith ) where
  10
  11 import GHCio
  12 import GHCps    ( unpackPS, packCString )
  13 import GHCbase  ( indexAddrOffAddr, Addr )
  14
  15 {-
  16 The $ExitCode$ type defines the exit codes that a program
  17 can return.  $ExitSuccess$ indicates successful termination;
  18 and $ExitFailure code$ indicates program failure
  19 with value {\em code}.  The exact interpretation of {\em code}
  20 is operating-system dependent.  In particular, some values of
  21 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
  22 -}
  23
  24 data ExitCode = ExitSuccess | ExitFailure Int
  25                 deriving (Eq, Ord, Read, Show)
  26
  27
  28 getArgs                 :: IO [String]
  29 getProgName             :: IO String
  30 getEnv                  :: String -> IO String
  31 system                  :: String -> IO ExitCode
  32 exitWith                :: ExitCode -> IO a
  33
  34 {-
  35 Computation $getArgs$ returns a list of the program's command
  36 line arguments (not including the program name).
  37 -}
  38 getArgs = return (unpackArgv ``prog_argv'' (``prog_argc''::Int))
  39
  40 {-
  41 Computation $getProgName$ returns the name of the program
  42 as it was invoked.
  43 -}
  44 getProgName = return (unpackProgName ``prog_argv'')
  45
  46 {-
  47 Computation $getEnv var$ returns the value
  48 of the environment variable {\em var}.
  49
  50 This computation may fail with
  51 \begin{itemize}
  52 \item $NoSuchThing$
  53 The environment variable does not exist.
  54 \end{itemize}
  55 -}
  56 getEnv name =
  57     _ccall_ getenv name `stThen` \ litstring ->
  58     if litstring /= ``NULL'' then
  59         return (unpackPS (packCString litstring)) -- cheaper than it looks
  60     else
  61         fail (NoSuchThing ("environment variable: " ++ name))
  62
  63 {-
  64 Computation $system cmd$ returns the exit code
  65 produced when the operating system processes the command {\em cmd}.
  66
  67 This computation may fail with
  68 \begin{itemize}
  69 \item $PermissionDenied$
  70 The process has insufficient privileges to perform the operation.
  71 \item $ResourceExhausted$
  72 Insufficient resources are available to perform the operation.
  73 \item $UnsupportedOperation$
  74 The implementation does not support system calls.
  75 \end{itemize}
  76 -}
  77 system "" = fail (InvalidArgument "null command")
  78 system cmd =
  79     _ccall_ systemCmd cmd       `stThen` \ status ->
  80     case status of
  81         0  -> return ExitSuccess
  82         -1 -> constructErrorAndFail "system"
  83         n  -> return (ExitFailure n)
  84
  85 {-
  86 Computation $exitWith code$ terminates the
  87 program, returning {\em code} to the program's caller.
  88 Before it terminates, any open or semi-closed handles are first closed.
  89 -}
  90 exitWith ExitSuccess =
  91     _ccall_ EXIT (0::Int)       `stThen` \ () ->
  92     fail (OtherError "exit should not return")
  93
  94 exitWith (ExitFailure n)
  95   | n == 0 = fail (InvalidArgument "ExitFailure 0")
  96   | otherwise =
  97     _ccall_ EXIT n              `stThen` \ () ->
  98     fail (OtherError "exit should not return")
  99
 100 ------------------------------------------
 101 -- like unpackCString ...
 102
 103 type CHAR_STAR_STAR     = Addr  -- this is all a  HACK
 104 type CHAR_STAR          = Addr
 105
 106 unpackArgv      :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
 107 unpackProgName  :: CHAR_STAR_STAR        -> String   -- argv[0]
 108
 109 unpackArgv argv argc = unpack 1
 110   where
 111     unpack :: Int -> [String]
 112     unpack n
 113       = if (n >= argc)
 114         then ([] :: [String])
 115         else case (indexAddrOffAddr argv n) of { item ->
 116              unpackPS (packCString item) : unpack (n + 1) }
 117
 118 unpackProgName argv
 119   = case (indexAddrOffAddr argv 0) of { prog ->
 120     de_slash [] (unpackPS (packCString prog)) }
 121   where
 122     -- re-start accumulating at every '/'
 123     de_slash :: String -> String -> String
 124     de_slash acc []       = reverse acc
 125     de_slash acc ('/':xs) = de_slash []      xs
 126     de_slash acc (x:xs)   = de_slash (x:acc) xs