1 % -----------------------------------------------------------------------------
2 % $Id: System.lhs,v 1.26 2000/07/07 11:03:58 simonmar Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[System]{Module @System@}
10 {-# OPTIONS -#include "cbits/stgio.h" #-}
13 ExitCode(ExitSuccess,ExitFailure)
14 , getArgs -- :: IO [String]
15 , getProgName -- :: IO String
16 , getEnv -- :: String -> IO String
17 , system -- :: String -> IO ExitCode
18 , exitWith -- :: ExitCode -> IO a
19 , exitFailure -- :: IO a
28 import PrelIOBase ( IOException(..), ioException,
29 IOErrorType(..), constructErrorAndFailWithInfo, stToIO )
30 import PrelPack ( unpackCString, unpackCStringST, packString )
31 import PrelByteArr ( ByteArray )
33 type PrimByteArray = ByteArray Int
35 primUnpackCString :: Addr -> IO String
36 primUnpackCString s = stToIO ( unpackCStringST s )
38 primPackString :: String -> PrimByteArray
39 primPackString s = packString s
43 %*********************************************************
45 \subsection{The @ExitCode@ type}
47 %*********************************************************
49 The $ExitCode$ type defines the exit codes that a program
50 can return. $ExitSuccess$ indicates successful termination;
51 and $ExitFailure code$ indicates program failure
52 with value {\em code}. The exact interpretation of {\em code}
53 is operating-system dependent. In particular, some values of
54 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
57 data ExitCode = ExitSuccess | ExitFailure Int
58 deriving (Eq, Ord, Read, Show)
62 Computation $getArgs$ returns a list of the program's command
63 line arguments (not including the program name).
66 getArgs :: IO [String]
67 getArgs = return (unpackArgv primArgv primArgc)
69 foreign import ccall "libHS_cbits.so" "get_prog_argv" unsafe primArgv :: Addr
70 foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
73 Computation $getProgName$ returns the name of the program
77 getProgName :: IO String
78 getProgName = return (unpackProgName primArgv)
81 Computation $getEnv var$ returns the value
82 of the environment variable {\em var}.
84 This computation may fail with
87 The environment variable does not exist.
91 getEnv :: String -> IO String
93 litstring <- primGetEnv (primPackString name)
94 if litstring /= nullAddr
95 then primUnpackCString litstring
96 else ioException (IOError Nothing NoSuchThing "getEnv"
97 ("environment variable: " ++ name))
99 foreign import ccall "libHS_cbits.so" "getenv" unsafe primGetEnv :: PrimByteArray -> IO Addr
102 Computation $system cmd$ returns the exit code
103 produced when the operating system processes the command {\em cmd}.
105 This computation may fail with
107 \item $PermissionDenied$
108 The process has insufficient privileges to perform the operation.
109 \item $ResourceExhausted$
110 Insufficient resources are available to perform the operation.
111 \item $UnsupportedOperation$
112 The implementation does not support system calls.
116 system :: String -> IO ExitCode
117 system "" = ioException (IOError Nothing InvalidArgument "system" "null command")
119 status <- primSystem (primPackString cmd)
121 0 -> return ExitSuccess
122 -1 -> constructErrorAndFailWithInfo "system" cmd
123 n -> return (ExitFailure n)
125 foreign import ccall "libHS_cbits.so" "systemCmd" unsafe primSystem :: PrimByteArray -> IO Int
128 @exitWith code@ terminates the program, returning {\em code} to the program's caller.
129 Before it terminates, any open or semi-closed handles are first closed.
132 exitWith :: ExitCode -> IO a
133 exitWith ExitSuccess = do
135 ioException (IOError Nothing OtherError "exitWith" "exit should not return")
137 exitWith (ExitFailure n)
138 | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
141 ioException (IOError Nothing OtherError "exitWith" "exit should not return")
143 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
144 -- re-enter Haskell land through finalizers.
145 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
148 exitFailure = exitWith (ExitFailure 1)
152 %*********************************************************
154 \subsection{Local utilities}
156 %*********************************************************
159 type CHAR_STAR_STAR = Addr -- this is all a HACK
160 type CHAR_STAR = Addr
162 unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
163 unpackArgv argv argc = unpack 1
165 unpack :: Int -> [String]
169 case (indexAddrOffAddr argv n) of
170 item -> unpackCString item : unpack (n + 1)
172 unpackProgName :: CHAR_STAR_STAR -> String -- argv[0]
174 = case (indexAddrOffAddr argv 0) of { prog ->
175 de_slash [] (unpackCString prog) }
177 -- re-start accumulating at every '/'
178 de_slash :: String -> String -> String
179 de_slash acc [] = reverse acc
180 de_slash _acc ('/':xs) = de_slash [] xs
181 de_slash acc (x:xs) = de_slash (x:acc) xs
187 -----------------------------------------------------------------------------
188 -- Standard Library: System operations
190 -- Warning: the implementation of these functions in Hugs 98 is very weak.
191 -- The functions themselves are best suited to uses in compiled programs,
192 -- and not to use in an interpreter-based environment like Hugs.
194 -- Suitable for use with Hugs 98
195 -----------------------------------------------------------------------------
196 import PrelPrim ( primGetRawArgs
198 , prelCleanupAfterRunAction
199 , copy_String_to_cstring
213 data ExitCode = ExitSuccess | ExitFailure Int
214 deriving (Eq, Ord, Read, Show)
216 getArgs :: IO [String]
217 getArgs = primGetRawArgs >>= \rawargs ->
218 return (tail rawargs)
220 getProgName :: IO String
221 getProgName = primGetRawArgs >>= \rawargs ->
222 return (head rawargs)
224 getEnv :: String -> IO String
228 exitFailure = exitWith (ExitFailure 1)
230 toExitCode :: Int -> ExitCode
231 toExitCode 0 = ExitSuccess
232 toExitCode n = ExitFailure n
234 fromExitCode :: ExitCode -> Int
235 fromExitCode ExitSuccess = 0
236 fromExitCode (ExitFailure n) = n
238 -- see comment in Prelude.hs near primRunIO_hugs_toplevel
239 exitWith :: ExitCode -> IO a
241 = do cleanup_action <- readIORef prelCleanupAfterRunAction
242 case cleanup_action of
245 nh_stderr >>= nh_flush
246 nh_stdout >>= nh_flush
247 nh_stdin >>= nh_close
248 nh_exitwith (fromExitCode c)
249 (ioException . IOError) "System.exitWith: should not return"
251 system :: String -> IO ExitCode
254 = (ioException.IOError) "System.system: null command"
256 = do str <- copy_String_to_cstring cmd
257 status <- nh_system str
260 0 -> return ExitSuccess
261 n -> return (ExitFailure n)
267 -----------------------------------------------------------------------------