1 -- -----------------------------------------------------------------------------
2 -- $Id: System.lhs,v 1.37 2001/11/08 16:36:39 simonmar 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" unsafe
48 getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
50 -- Computation `getProgName' returns the name of the program
53 getProgName :: IO String
56 alloca $ \ p_argv -> do
57 getProgArgv p_argc p_argv
61 -- Computation `getEnv var' returns the value
62 -- of the environment variable {\em var}.
64 -- This computation may fail with
65 -- NoSuchThing: The environment variable does not exist.
67 getEnv :: String -> IO String
69 withCString name $ \s -> do
70 litstring <- _getenv s
71 if litstring /= nullPtr
72 then peekCString litstring
73 else ioException (IOError Nothing NoSuchThing "getEnv"
74 "no environment variable" (Just name))
76 foreign import ccall "getenv" unsafe _getenv :: CString -> IO (Ptr CChar)
78 -- ---------------------------------------------------------------------------
81 -- Computation `system cmd' returns the exit code
82 -- produced when the operating system processes the command {\em cmd}.
84 -- This computation may fail with
86 -- The process has insufficient privileges to perform the operation.
88 -- Insufficient resources are available to perform the operation.
89 -- UnsupportedOperation
90 -- The implementation does not support system calls.
92 system :: String -> IO ExitCode
93 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
95 withCString cmd $ \s -> do
96 status <- throwErrnoIfMinus1 "system" (primSystem s)
98 0 -> return ExitSuccess
99 n -> return (ExitFailure n)
101 foreign import ccall "systemCmd" unsafe primSystem :: CString -> IO Int
103 -- ---------------------------------------------------------------------------
106 -- `exitWith code' terminates the program, returning `code' to the
107 -- program's caller. Before it terminates, any open or semi-closed
108 -- handles are first closed.
110 exitWith :: ExitCode -> IO a
111 exitWith ExitSuccess = throw (ExitException ExitSuccess)
112 exitWith code@(ExitFailure n)
113 | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
114 | otherwise = throw (ExitException code)
117 exitFailure = exitWith (ExitFailure 1)
119 -- ---------------------------------------------------------------------------
122 unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
123 unpackProgName argv = do
124 s <- peekElemOff argv 0 >>= peekCString
127 basename :: String -> String
132 | isPathSeparator x = go xs xs
133 | otherwise = go acc xs
135 isPathSeparator :: Char -> Bool
136 isPathSeparator '/' = True
137 #ifdef mingw32_TARGET_OS
138 isPathSeparator '\\' = True
140 isPathSeparator _ = False