1 -- -----------------------------------------------------------------------------
2 -- $Id: System.lhs,v 1.33 2001/08/14 17:14:22 sof 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
25 import PrelMarshalAlloc
31 -- ---------------------------------------------------------------------------
32 -- getArgs, getProgName, getEnv
34 -- Computation `getArgs' returns a list of the program's command
35 -- line arguments (not including the program name).
37 getArgs :: IO [String]
40 alloca $ \ p_argv -> do
41 getProgArgv p_argc p_argv
44 peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
47 foreign import "getProgArgv" getProgArgv :: Ptr Int -> Ptr (Ptr CString) -> IO ()
49 -- Computation `getProgName' returns the name of the program
52 getProgName :: IO String
55 alloca $ \ p_argv -> do
56 getProgArgv p_argc p_argv
60 -- Computation `getEnv var' returns the value
61 -- of the environment variable {\em var}.
63 -- This computation may fail with
64 -- NoSuchThing: The environment variable does not exist.
66 getEnv :: String -> IO String
68 withCString name $ \s -> do
69 litstring <- _getenv s
70 if litstring /= nullPtr
71 then peekCString litstring
72 else ioException (IOError Nothing NoSuchThing "getEnv"
73 "no environment variable" (Just name))
75 foreign import ccall "getenv" unsafe _getenv :: CString -> IO (Ptr CChar)
77 -- ---------------------------------------------------------------------------
80 -- Computation `system cmd' returns the exit code
81 -- produced when the operating system processes the command {\em cmd}.
83 -- This computation may fail with
85 -- The process has insufficient privileges to perform the operation.
87 -- Insufficient resources are available to perform the operation.
88 -- UnsupportedOperation
89 -- The implementation does not support system calls.
91 system :: String -> IO ExitCode
92 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
94 withCString cmd $ \s -> do
95 status <- throwErrnoIfMinus1 "system" (primSystem s)
97 0 -> return ExitSuccess
98 n -> return (ExitFailure n)
100 foreign import ccall "systemCmd" unsafe primSystem :: CString -> IO Int
102 -- ---------------------------------------------------------------------------
105 -- `exitWith code' terminates the program, returning `code' to the
106 -- program's caller. Before it terminates, any open or semi-closed
107 -- handles are first closed.
109 exitWith :: ExitCode -> IO a
110 exitWith ExitSuccess = throw (ExitException ExitSuccess)
111 exitWith code@(ExitFailure n)
112 | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
113 | otherwise = throw (ExitException code)
116 exitFailure = exitWith (ExitFailure 1)
118 -- ---------------------------------------------------------------------------
121 unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
122 unpackProgName argv = do
123 s <- peekElemOff argv 0 >>= peekCString
124 return (de_slash "" s)
126 -- re-start accumulating at every '/'
127 de_slash :: String -> String -> String
128 de_slash acc [] = reverse acc
129 de_slash _acc ('/':xs) = de_slash [] xs
130 de_slash acc (x:xs) = de_slash (x:acc) xs