1 -- -----------------------------------------------------------------------------
2 -- $Id: System.lhs,v 1.32 2001/08/10 13:48:06 simonmar Exp $
4 -- (c) The University of Glasgow, 1994-2000
10 ExitCode(ExitSuccess,ExitFailure)
11 , getArgs -- :: IO [String]
12 , getProgName -- :: IO String
13 , getEnv -- :: String -> IO String
14 , system -- :: String -> IO ExitCode
15 , exitWith -- :: ExitCode -> IO a
16 , exitFailure -- :: IO a
24 import PrelMarshalArray
30 -- ---------------------------------------------------------------------------
31 -- getArgs, getProgName, getEnv
33 -- Computation `getArgs' returns a list of the program's command
34 -- line arguments (not including the program name).
36 getArgs :: IO [String]
38 argv <- peek prog_argv_label
39 argc <- peek prog_argc_label
40 peekArray (fromIntegral argc - 1) (advancePtr argv 1) >>= mapM peekCString
42 foreign label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar))
43 foreign label "prog_argc" prog_argc_label :: Ptr CInt
45 -- Computation `getProgName' returns the name of the program
48 getProgName :: IO String
50 argv <- peek prog_argv_label
53 -- Computation `getEnv var' returns the value
54 -- of the environment variable {\em var}.
56 -- This computation may fail with
57 -- NoSuchThing: The environment variable does not exist.
59 getEnv :: String -> IO String
61 withCString name $ \s -> do
62 litstring <- _getenv s
63 if litstring /= nullPtr
64 then peekCString litstring
65 else ioException (IOError Nothing NoSuchThing "getEnv"
66 "no environment variable" (Just name))
68 foreign import ccall "getenv" unsafe _getenv :: CString -> IO (Ptr CChar)
70 -- ---------------------------------------------------------------------------
73 -- Computation `system cmd' returns the exit code
74 -- produced when the operating system processes the command {\em cmd}.
76 -- This computation may fail with
78 -- The process has insufficient privileges to perform the operation.
80 -- Insufficient resources are available to perform the operation.
81 -- UnsupportedOperation
82 -- The implementation does not support system calls.
84 system :: String -> IO ExitCode
85 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
87 withCString cmd $ \s -> do
88 status <- throwErrnoIfMinus1 "system" (primSystem s)
90 0 -> return ExitSuccess
91 n -> return (ExitFailure n)
93 foreign import ccall "systemCmd" unsafe primSystem :: CString -> IO Int
95 -- ---------------------------------------------------------------------------
98 -- `exitWith code' terminates the program, returning `code' to the
99 -- program's caller. Before it terminates, any open or semi-closed
100 -- handles are first closed.
102 exitWith :: ExitCode -> IO a
103 exitWith ExitSuccess = throw (ExitException ExitSuccess)
104 exitWith code@(ExitFailure n)
105 | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
106 | otherwise = throw (ExitException code)
109 exitFailure = exitWith (ExitFailure 1)
111 -- ---------------------------------------------------------------------------
114 unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
115 unpackProgName argv = do
116 s <- peekElemOff argv 0 >>= peekCString
117 return (de_slash "" s)
119 -- re-start accumulating at every '/'
120 de_slash :: String -> String -> String
121 de_slash acc [] = reverse acc
122 de_slash _acc ('/':xs) = de_slash [] xs
123 de_slash acc (x:xs) = de_slash (x:acc) xs