2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[System]{Module @System@}
8 {-# OPTIONS -#include "cbits/stgio.h" #-}
10 ExitCode(ExitSuccess,ExitFailure),
11 getArgs, getProgName, getEnv, system, exitWith
17 indexAddrOffAddr = primIndexAddrOffAddr
19 unpackCString = unsafeUnpackCString
24 import PrelIOBase ( IOError(..), IOErrorType(..), constructErrorAndFailWithInfo )
25 import PrelPack ( unpackCString )
30 %*********************************************************
32 \subsection{The @ExitCode@ type}
34 %*********************************************************
36 The $ExitCode$ type defines the exit codes that a program
37 can return. $ExitSuccess$ indicates successful termination;
38 and $ExitFailure code$ indicates program failure
39 with value {\em code}. The exact interpretation of {\em code}
40 is operating-system dependent. In particular, some values of
41 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
44 data ExitCode = ExitSuccess | ExitFailure Int
45 deriving (Eq, Ord, Read, Show)
50 %*********************************************************
52 \subsection{Other functions}
54 %*********************************************************
57 getArgs :: IO [String]
58 getProgName :: IO String
59 getEnv :: String -> IO String
60 system :: String -> IO ExitCode
61 exitWith :: ExitCode -> IO a
64 Computation $getArgs$ returns a list of the program's command
65 line arguments (not including the program name).
69 foreign import stdcall "libHS_cbits.so" "get_prog_argv" primArgv :: Addr
70 foreign import stdcall "libHS_cbits.so" "get_prog_argc" primArgc :: Int
72 getArgs = return (unpackArgv primArgv primArgc)
74 getArgs = return (unpackArgv ``prog_argv'' (``prog_argc''::Int))
78 Computation $getProgName$ returns the name of the program
83 getProgName = return (unpackProgName primArgv)
85 getProgName = return (unpackProgName ``prog_argv'')
89 Computation $getEnv var$ returns the value
90 of the environment variable {\em var}.
92 This computation may fail with
95 The environment variable does not exist.
100 foreign import stdcall "libHS_cbits.so" "getenv" primGetEnv :: PrimByteArray -> IO Addr
103 litstring <- primGetEnv (primPackString name)
104 if litstring /= nullAddr
105 then primUnpackCString litstring
106 else fail (IOError Nothing NoSuchThing "getEnv"
107 ("environment variable: " ++ name))
110 litstring <- _ccall_ getenv name
111 if litstring /= ``NULL''
112 then return (unpackCString litstring)
113 else fail (IOError Nothing NoSuchThing "getEnv"
114 ("environment variable: " ++ name))
118 Computation $system cmd$ returns the exit code
119 produced when the operating system processes the command {\em cmd}.
121 This computation may fail with
123 \item $PermissionDenied$
124 The process has insufficient privileges to perform the operation.
125 \item $ResourceExhausted$
126 Insufficient resources are available to perform the operation.
127 \item $UnsupportedOperation$
128 The implementation does not support system calls.
133 foreign import stdcall "libHS_cbits.so" "systemCmd" primSystem :: PrimByteArray -> IO Int
134 system "" = fail (IOError Nothing InvalidArgument "system" "null command")
136 status <- primSystem (primPackString cmd)
138 0 -> return ExitSuccess
139 -1 -> constructErrorAndFailWithInfo "system" cmd
140 n -> return (ExitFailure n)
143 system "" = fail (IOError Nothing InvalidArgument "system" "null command")
145 status <- _ccall_ systemCmd cmd
147 0 -> return ExitSuccess
148 -1 -> constructErrorAndFailWithInfo "system" cmd
149 n -> return (ExitFailure n)
153 Computation $exitWith code$ terminates the
154 program, returning {\em code} to the program's caller.
155 Before it terminates, any open or semi-closed handles are first closed.
159 foreign import stdcall "libHS_cbits.so" "exit" primExit :: Int -> IO ()
161 exitWith ExitSuccess = do
163 fail (IOError Nothing OtherError "exitWith" "exit should not return")
165 exitWith (ExitFailure n)
166 | n == 0 = fail (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
169 fail (IOError Nothing OtherError "exitWith" "exit should not return")
171 exitWith ExitSuccess = do
172 _ccall_ exit (0::Int)
173 fail (IOError Nothing OtherError "exitWith" "exit should not return")
175 exitWith (ExitFailure n)
176 | n == 0 = fail (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0")
179 fail (IOError Nothing OtherError "exitWith" "exit should not return")
184 %*********************************************************
186 \subsection{Local utilities}
188 %*********************************************************
191 type CHAR_STAR_STAR = Addr -- this is all a HACK
192 type CHAR_STAR = Addr
194 unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1]
195 unpackProgName :: CHAR_STAR_STAR -> String -- argv[0]
197 unpackArgv argv argc = unpack 1
199 unpack :: Int -> [String]
202 then ([] :: [String])
203 else case (indexAddrOffAddr argv n) of { item ->
204 unpackCString item : unpack (n + 1) }
207 = case (indexAddrOffAddr argv 0) of { prog ->
208 de_slash [] (unpackCString prog) }
210 -- re-start accumulating at every '/'
211 de_slash :: String -> String -> String
212 de_slash acc [] = reverse acc
213 de_slash acc ('/':xs) = de_slash [] xs
214 de_slash acc (x:xs) = de_slash (x:acc) xs