1 -- -----------------------------------------------------------------------------
2 -- $Id: System.lhs,v 1.36 2001/10/13 16:02:47 sof Exp $
4 -- (c) The University of Glasgow, 1994-2000
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
25 import PrelMarshalArray
26 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
42 p <- fromIntegral `liftM` peek p_argc
44 peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
47 foreign import "getProgArgv" getProgArgv :: Ptr CInt -> 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
126 basename :: String -> String
131 | isPathSeparator x = go xs xs
132 | otherwise = go acc xs
134 isPathSeparator :: Char -> Bool
135 isPathSeparator '/' = True
136 #ifdef mingw32_TARGET_OS
137 isPathSeparator '\\' = True
139 isPathSeparator _ = False