-% -----------------------------------------------------------------------------
-% $Id: System.lhs,v 1.28 2001/01/11 17:25:57 simonmar Exp $
-%
-% (c) The University of Glasgow, 1994-2000
-%
-
-\section[System]{Module @System@}
+-- -----------------------------------------------------------------------------
+-- $Id: System.lhs,v 1.31 2001/05/22 15:06:47 simonmar Exp $
+--
+-- (c) The University of Glasgow, 1994-2000
+--
\begin{code}
-{-# OPTIONS -#include "cbits/stgio.h" #-}
module System
(
ExitCode(ExitSuccess,ExitFailure)
, exitWith -- :: ExitCode -> IO a
, exitFailure -- :: IO a
) where
-\end{code}
-\begin{code}
import Monad
import Prelude
+import PrelCError
import PrelCString
import PrelCTypes
import PrelMarshalArray
import PrelPtr
import PrelStorable
-import PrelIOBase ( IOException(..), ioException,
- IOErrorType(..), constructErrorAndFailWithInfo )
-import PrelByteArr ( ByteArray )
-\end{code}
-
-%*********************************************************
-%* *
-\subsection{The @ExitCode@ type}
-%* *
-%*********************************************************
-
-The $ExitCode$ type defines the exit codes that a program
-can return. $ExitSuccess$ indicates successful termination;
-and $ExitFailure code$ indicates program failure
-with value {\em code}. The exact interpretation of {\em code}
-is operating-system dependent. In particular, some values of
-{\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
+import PrelIOBase
+import PrelConc
-\begin{code}
-data ExitCode = ExitSuccess | ExitFailure Int
- deriving (Eq, Ord, Read, Show)
-
-\end{code}
+-- ---------------------------------------------------------------------------
+-- getArgs, getProgName, getEnv
-Computation $getArgs$ returns a list of the program's command
-line arguments (not including the program name).
+-- Computation `getArgs' returns a list of the program's command
+-- line arguments (not including the program name).
-\begin{code}
getArgs :: IO [String]
-getArgs = unpackArgv primArgv primArgc
+getArgs = do
+ argv <- peek prog_argv_label
+ argc <- peek prog_argc_label
+ peekArray (fromIntegral argc - 1) (advancePtr argv 1) >>= mapM peekCString
-foreign import ccall "get_prog_argv" unsafe primArgv :: Ptr (Ptr CChar)
-foreign import ccall "get_prog_argc" unsafe primArgc :: Int
-\end{code}
+foreign label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar))
+foreign label "prog_argc" prog_argc_label :: Ptr CInt
-Computation $getProgName$ returns the name of the program
-as it was invoked.
+-- Computation `getProgName' returns the name of the program
+-- as it was invoked.
-\begin{code}
getProgName :: IO String
-getProgName = unpackProgName primArgv
-\end{code}
+getProgName = do
+ argv <- peek prog_argv_label
+ unpackProgName argv
-Computation $getEnv var$ returns the value
-of the environment variable {\em var}.
+-- Computation `getEnv var' returns the value
+-- of the environment variable {\em var}.
-This computation may fail with
-\begin{itemize}
-\item $NoSuchThing$
-The environment variable does not exist.
-\end{itemize}
+-- This computation may fail with
+-- NoSuchThing: The environment variable does not exist.
-\begin{code}
getEnv :: String -> IO String
getEnv name =
withUnsafeCString name $ \s -> do
"no environment variable" (Just name))
foreign import ccall "getenv" unsafe _getenv :: UnsafeCString -> IO (Ptr CChar)
-\end{code}
-Computation $system cmd$ returns the exit code
-produced when the operating system processes the command {\em cmd}.
+-- ---------------------------------------------------------------------------
+-- system
-This computation may fail with
-\begin{itemize}
-\item $PermissionDenied$
-The process has insufficient privileges to perform the operation.
-\item $ResourceExhausted$
-Insufficient resources are available to perform the operation.
-\item $UnsupportedOperation$
-The implementation does not support system calls.
-\end{itemize}
+-- Computation `system cmd' returns the exit code
+-- produced when the operating system processes the command {\em cmd}.
-\begin{code}
-system :: String -> IO ExitCode
+-- This computation may fail with
+-- PermissionDenied
+-- The process has insufficient privileges to perform the operation.
+-- ResourceExhausted
+-- Insufficient resources are available to perform the operation.
+-- UnsupportedOperation
+-- The implementation does not support system calls.
+
+system :: String -> IO ExitCode
system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
system cmd =
withUnsafeCString cmd $ \s -> do
- status <- primSystem s
+ status <- throwErrnoIfMinus1 "system" (primSystem s)
case status of
0 -> return ExitSuccess
- -1 -> constructErrorAndFailWithInfo "system" cmd
n -> return (ExitFailure n)
foreign import ccall "systemCmd" unsafe primSystem :: UnsafeCString -> IO Int
-\end{code}
-@exitWith code@ terminates the program, returning {\em code} to the program's caller.
-Before it terminates, any open or semi-closed handles are first closed.
+-- ---------------------------------------------------------------------------
+-- exitWith
-\begin{code}
-exitWith :: ExitCode -> IO a
-exitWith ExitSuccess = do
- primExit 0
- ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
+-- `exitWith code' terminates the program, returning `code' to the
+-- program's caller. Before it terminates, any open or semi-closed
+-- handles are first closed.
-exitWith (ExitFailure n)
+exitWith :: ExitCode -> IO a
+exitWith ExitSuccess = throw (ExitException ExitSuccess)
+exitWith code@(ExitFailure n)
| n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
- | otherwise = do
- primExit n
- ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
-
--- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
--- re-enter Haskell land through finalizers.
-foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
+ | otherwise = throw (ExitException code)
exitFailure :: IO a
exitFailure = exitWith (ExitFailure 1)
-\end{code}
-
-%*********************************************************
-%* *
-\subsection{Local utilities}
-%* *
-%*********************************************************
-
-\begin{code}
-unpackArgv :: Ptr (Ptr CChar) -> Int -> IO [String] -- argv[1 .. argc-1]
-unpackArgv argv argc = peekArray argc argv >>= mapM peekCString
+-- ---------------------------------------------------------------------------
+-- Local utilities
unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
unpackProgName argv = do
projects / ghc-hetmet.git / blobdiff