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
23 indexAddrOffAddr = primIndexAddrOffAddr
25 unpackCString = unsafeUnpackCString
30 import PrelIOBase ( IOError(..), IOErrorType(..), constructErrorAndFailWithInfo, stToIO )
31 import PrelPack ( unpackCString, unpackCStringST, packString )
32 import PrelArr ( ByteArray )
34 type PrimByteArray = ByteArray Int
36 primUnpackCString :: Addr -> IO String
37 primUnpackCString s = stToIO ( unpackCStringST s )
39 primPackString :: String -> PrimByteArray
40 primPackString s = packString s
45 %*********************************************************
47 \subsection{The @ExitCode@ type}
49 %*********************************************************
51 The $ExitCode$ type defines the exit codes that a program
52 can return. $ExitSuccess$ indicates successful termination;
53 and $ExitFailure code$ indicates program failure
54 with value {\em code}. The exact interpretation of {\em code}
55 is operating-system dependent. In particular, some values of
56 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
59 data ExitCode = ExitSuccess | ExitFailure Int
60 deriving (Eq, Ord, Read, Show)
64 Computation $getArgs$ returns a list of the program's command
65 line arguments (not including the program name).
68 getArgs :: IO [String]
69 getArgs = return (unpackArgv primArgv primArgc)
71 foreign import ccall "libHS_cbits.so" "get_prog_argv" unsafe primArgv :: Addr
72 foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
75 Computation $getProgName$ returns the name of the program
79 getProgName :: IO String
80 getProgName = return (unpackProgName primArgv)
83 Computation $getEnv var$ returns the value
84 of the environment variable {\em var}.
86 This computation may fail with
89 The environment variable does not exist.
93 getEnv :: String -> IO String
95 litstring <- primGetEnv (primPackString name)
96 if litstring /= nullAddr
97 then primUnpackCString litstring
98 else ioError (IOError Nothing NoSuchThing "getEnv"
99 ("environment variable: " ++ name))
101 foreign import ccall "libHS_cbits.so" "getenv" unsafe primGetEnv :: PrimByteArray -> IO Addr
104 Computation $system cmd$ returns the exit code
105 produced when the operating system processes the command {\em cmd}.
107 This computation may fail with
109 \item $PermissionDenied$
110 The process has insufficient privileges to perform the operation.
111 \item $ResourceExhausted$
112 Insufficient resources are available to perform the operation.
113 \item $UnsupportedOperation$
114 The implementation does not support system calls.
118 system :: String -> IO ExitCode
119 system "" = ioError (IOError Nothing InvalidArgument "system" "null command")
121 status <- primSystem (primPackString cmd)
123 0 -> return ExitSuccess
124 -1 -> constructErrorAndFailWithInfo "system" cmd
125 n -> return (ExitFailure n)
127 foreign import ccall "libHS_cbits.so" "systemCmd" unsafe primSystem :: PrimByteArray -> IO Int
130 @exitWith code@ terminates the program, returning {\em code} to the program's caller.
131 Before it terminates, any open or semi-closed handles are first closed.
134 exitWith :: ExitCode -> IO a
135 exitWith ExitSuccess = do
137 ioError (IOError Nothing OtherError "exitWith" "exit should not return")
139 exitWith (ExitFailure n)
140 | n == 0 = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
143 ioError (IOError Nothing OtherError "exitWith" "exit should not return")
145 foreign import ccall "libHS_cbits.so" "exit" unsafe 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 unpackProgName :: CHAR_STAR_STAR -> String -- argv[0]
165 unpackArgv argv argc = unpack 1
167 unpack :: Int -> [String]
170 then ([] :: [String])
171 else case (indexAddrOffAddr argv n) of { item ->
172 unpackCString item : unpack (n + 1) }
175 = case (indexAddrOffAddr argv 0) of { prog ->
176 de_slash [] (unpackCString prog) }
178 -- re-start accumulating at every '/'
179 de_slash :: String -> String -> String
180 de_slash acc [] = reverse acc
181 de_slash _acc ('/':xs) = de_slash [] xs
182 de_slash acc (x:xs) = de_slash (x:acc) xs