2 % (c) The AQUA Project, Glasgow University, 1994-1999
5 \section[System]{Module @System@}
8 {-# OPTIONS -#include "cbits/stgio.h" #-}
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
26 import PrelIOBase ( IOError(..), IOErrorType(..), constructErrorAndFailWithInfo, stToIO )
27 import PrelPack ( unpackCString, unpackCStringST, packString )
28 import PrelByteArr ( ByteArray )
30 type PrimByteArray = ByteArray Int
32 primUnpackCString :: Addr -> IO String
33 primUnpackCString s = stToIO ( unpackCStringST s )
35 primPackString :: String -> PrimByteArray
36 primPackString s = packString s
40 %*********************************************************
42 \subsection{The @ExitCode@ type}
44 %*********************************************************
46 The $ExitCode$ type defines the exit codes that a program
47 can return. $ExitSuccess$ indicates successful termination;
48 and $ExitFailure code$ indicates program failure
49 with value {\em code}. The exact interpretation of {\em code}
50 is operating-system dependent. In particular, some values of
51 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
54 data ExitCode = ExitSuccess | ExitFailure Int
55 deriving (Eq, Ord, Read, Show)
59 Computation $getArgs$ returns a list of the program's command
60 line arguments (not including the program name).
63 getArgs :: IO [String]
64 getArgs = return (unpackArgv primArgv primArgc)
66 foreign import ccall "libHS_cbits.so" "get_prog_argv" unsafe primArgv :: Addr
67 foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
70 Computation $getProgName$ returns the name of the program
74 getProgName :: IO String
75 getProgName = return (unpackProgName primArgv)
78 Computation $getEnv var$ returns the value
79 of the environment variable {\em var}.
81 This computation may fail with
84 The environment variable does not exist.
88 getEnv :: String -> IO String
90 litstring <- primGetEnv (primPackString name)
91 if litstring /= nullAddr
92 then primUnpackCString litstring
93 else ioError (IOError Nothing NoSuchThing "getEnv"
94 ("environment variable: " ++ name))
96 foreign import ccall "libHS_cbits.so" "getenv" unsafe primGetEnv :: PrimByteArray -> IO Addr
99 Computation $system cmd$ returns the exit code
100 produced when the operating system processes the command {\em cmd}.
102 This computation may fail with
104 \item $PermissionDenied$
105 The process has insufficient privileges to perform the operation.
106 \item $ResourceExhausted$
107 Insufficient resources are available to perform the operation.
108 \item $UnsupportedOperation$
109 The implementation does not support system calls.
113 system :: String -> IO ExitCode
114 system "" = ioError (IOError Nothing InvalidArgument "system" "null command")
116 status <- primSystem (primPackString cmd)
118 0 -> return ExitSuccess
119 -1 -> constructErrorAndFailWithInfo "system" cmd
120 n -> return (ExitFailure n)
122 foreign import ccall "libHS_cbits.so" "systemCmd" unsafe primSystem :: PrimByteArray -> IO Int
125 @exitWith code@ terminates the program, returning {\em code} to the program's caller.
126 Before it terminates, any open or semi-closed handles are first closed.
129 exitWith :: ExitCode -> IO a
130 exitWith ExitSuccess = do
132 ioError (IOError Nothing OtherError "exitWith" "exit should not return")
134 exitWith (ExitFailure n)
135 | n == 0 = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
138 ioError (IOError Nothing OtherError "exitWith" "exit should not return")
140 -- SUP: Although shutdownHaskellAndExit must be called "safe", because it *can*
141 -- re-enter Haskell land through finalizers
142 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
145 exitFailure = exitWith (ExitFailure 1)
149 %*********************************************************
151 \subsection{Local utilities}
153 %*********************************************************
156 type CHAR_STAR_STAR = Addr -- this is all a HACK
157 type CHAR_STAR = Addr
159 unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
160 unpackArgv argv argc = unpack 1
162 unpack :: Int -> [String]
166 case (indexAddrOffAddr argv n) of
167 item -> unpackCString item : unpack (n + 1)
169 unpackProgName :: CHAR_STAR_STAR -> String -- argv[0]
171 = case (indexAddrOffAddr argv 0) of { prog ->
172 de_slash [] (unpackCString prog) }
174 -- re-start accumulating at every '/'
175 de_slash :: String -> String -> String
176 de_slash acc [] = reverse acc
177 de_slash _acc ('/':xs) = de_slash [] xs
178 de_slash acc (x:xs) = de_slash (x:acc) xs
184 -----------------------------------------------------------------------------
185 -- Standard Library: System operations
187 -- Warning: the implementation of these functions in Hugs 98 is very weak.
188 -- The functions themselves are best suited to uses in compiled programs,
189 -- and not to use in an interpreter-based environment like Hugs.
191 -- Suitable for use with Hugs 98
192 -----------------------------------------------------------------------------
193 import PrelPrim ( primGetRawArgs
195 , prelCleanupAfterRunAction
196 , copy_String_to_cstring
210 data ExitCode = ExitSuccess | ExitFailure Int
211 deriving (Eq, Ord, Read, Show)
213 getArgs :: IO [String]
214 getArgs = primGetRawArgs >>= \rawargs ->
215 return (tail rawargs)
217 getProgName :: IO String
218 getProgName = primGetRawArgs >>= \rawargs ->
219 return (head rawargs)
221 getEnv :: String -> IO String
225 exitFailure = exitWith (ExitFailure 1)
227 toExitCode :: Int -> ExitCode
228 toExitCode 0 = ExitSuccess
229 toExitCode n = ExitFailure n
231 fromExitCode :: ExitCode -> Int
232 fromExitCode ExitSuccess = 0
233 fromExitCode (ExitFailure n) = n
235 -- see comment in Prelude.hs near primRunIO_hugs_toplevel
236 exitWith :: ExitCode -> IO a
238 = do cleanup_action <- readIORef prelCleanupAfterRunAction
239 case cleanup_action of
242 nh_stderr >>= nh_flush
243 nh_stdout >>= nh_flush
244 nh_stdin >>= nh_close
245 nh_exitwith (fromExitCode c)
246 (ioError.IOError) "System.exitWith: should not return"
248 system :: String -> IO ExitCode
251 = (ioError.IOError) "System.system: null command"
253 = do str <- copy_String_to_cstring cmd
254 status <- nh_system str
257 0 -> return ExitSuccess
258 n -> return (ExitFailure n)
264 -----------------------------------------------------------------------------