#undef DEBUG_DUMP
-- -----------------------------------------------------------------------------
--- $Id: PrelIO.hsc,v 1.2 2001/05/21 14:05:04 simonmar Exp $
+-- $Id: PrelIO.hsc,v 1.3 2001/05/22 15:06:47 simonmar Exp $
--
-- (c) The University of Glasgow, 1992-2001
--
import PrelMaybe
import PrelReal
import PrelNum
-import PrelRead ( Read(..), readIO )
+import PrelRead
import PrelShow
import PrelMaybe ( Maybe(..) )
import PrelPtr
r <- readIO l
return r
+ -- raises an exception instead of an error
+readIO :: Read a => String -> IO a
+readIO s = case (do { (x,t) <- reads s ;
+ ("","") <- lex t ;
+ return x }) of
+#ifndef NEW_READS_REP
+ [x] -> return x
+ [] -> ioError (userError "Prelude.readIO: no parse")
+ _ -> ioError (userError "Prelude.readIO: ambiguous parse")
+#else
+ Just x -> return x
+ Nothing -> ioError (userError "Prelude.readIO: no parse")
+#endif
+
-- ---------------------------------------------------------------------------
-- Simple input operations
% ------------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.38 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelIOBase.lhs,v 1.39 2001/05/22 15:06:47 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2001
%
module PrelIOBase where
import PrelST
+import PrelRead
import PrelArr
import PrelBase
import PrelNum -- To get fromInteger etc, needed because of -fno-implicit-prelude
bufferIsWritable _other = False
bufferEmpty :: Buffer -> Bool
-bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } | r == w = True
+bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
bufferEmpty _other = False
-- only makes sense for a write buffer
data BufferMode
= NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
- deriving (Eq, Ord, Show)
- {- Read instance defined in IO. -}
+ deriving (Eq, Ord, Show, Read)
-- ---------------------------------------------------------------------------
-- IORefs
| ArithException ArithException -- Arithmetic exceptions
| ArrayException ArrayException -- Array-related exceptions
| ErrorCall String -- Calls to 'error'
+ | ExitException ExitCode -- Call to System.exitWith
| NoMethodError String -- A non-existent method was invoked
| PatternMatchFail String -- A pattern match / guard failure
| RecSelError String -- Selecting a non-existent field
showsPrec _ (ArithException err) = shows err
showsPrec _ (ArrayException err) = shows err
showsPrec _ (ErrorCall err) = showString err
+ showsPrec _ (ExitException err) = showString "exit: " . shows err
showsPrec _ (NoMethodError err) = showString err
showsPrec _ (PatternMatchFail err) = showString err
showsPrec _ (RecSelError err) = showString err
showsPrec _ (NonTermination) = showString "<<loop>>"
showsPrec _ (UserError err) = showString err
+-- -----------------------------------------------------------------------------
+-- 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 `code'. The exact interpretation of `code'
+-- is operating-system dependent. In particular, some values of
+-- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
+
+-- We need it here because it is used in ExitException in the
+-- Exception datatype (above).
+
+data ExitCode = ExitSuccess | ExitFailure Int
+ deriving (Eq, Ord, Read, Show)
+
-- --------------------------------------------------------------------------
-- Primitive throw
-- -----------------------------------------------------------------------------
--- $Id: PrelTopHandler.lhs,v 1.1 2001/05/21 14:07:31 simonmar Exp $
+-- $Id: PrelTopHandler.lhs,v 1.2 2001/05/22 15:06:47 simonmar Exp $
--
-- (c) The University of Glasgow, 2001
--
real_handler ex =
case ex of
AsyncException StackOverflow -> reportStackOverflow True
+
+ -- only the main thread gets ExitException exceptions
+ ExitException ExitSuccess -> shutdownHaskellAndExit 0
+ ExitException (ExitFailure n) -> shutdownHaskellAndExit n
+
ErrorCall s -> reportError True s
other -> reportError True (showsPrec 0 other "\n")
+-- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
+-- re-enter Haskell land through finalizers.
+foreign import ccall "shutdownHaskellAndExit"
+ shutdownHaskellAndExit :: Int -> IO ()
+
reportStackOverflow :: Bool -> IO ()
reportStackOverflow bombOut = do
(hFlush stdout) `catchException` (\ _ -> return ())
-- -----------------------------------------------------------------------------
--- $Id: System.lhs,v 1.30 2001/05/18 16:54:05 simonmar Exp $
+-- $Id: System.lhs,v 1.31 2001/05/22 15:06:47 simonmar Exp $
--
-- (c) The University of Glasgow, 1994-2000
--
import PrelMarshalArray
import PrelPtr
import PrelStorable
-import PrelIOBase ( IOException(..), ioException, IOErrorType(..))
-
--- -----------------------------------------------------------------------------
--- 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 `code'. The exact interpretation of `code'
--- is operating-system dependent. In particular, some values of
--- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
-
-data ExitCode = ExitSuccess | ExitFailure Int
- deriving (Eq, Ord, Read, Show)
+import PrelIOBase
+import PrelConc
+-- ---------------------------------------------------------------------------
+-- getArgs, getProgName, getEnv
-- Computation `getArgs' returns a list of the program's command
-- line arguments (not including the program name).
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
+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.
getProgName :: IO String
-getProgName = unpackProgName primArgv
+getProgName = do
+ argv <- peek prog_argv_label
+ unpackProgName argv
-- Computation `getEnv var' returns the value
-- of the environment variable {\em var}.
-- handles are first closed.
exitWith :: ExitCode -> IO a
-exitWith ExitSuccess = do
- primExit 0
- ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
-
-exitWith (ExitFailure n)
+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)
-- ---------------------------------------------------------------------------
-- Local utilities
-unpackArgv :: Ptr (Ptr CChar) -> Int -> IO [String] -- argv[1 .. argc-1]
-unpackArgv argv argc
- = peekArray (argc-1) (advancePtr argv 1) >>= mapM peekCString
-
unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
unpackProgName argv = do
s <- peekElemOff argv 0 >>= peekCString
de_slash acc [] = reverse acc
de_slash _acc ('/':xs) = de_slash [] xs
de_slash acc (x:xs) = de_slash (x:acc) xs
-
\end{code}
+++ /dev/null
-/*
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
- *
- * $Id: progargs.c,v 1.5 2001/05/18 16:54:06 simonmar Exp $
- *
- * System.getArgs Runtime Support
- */
-
-#include "Rts.h"
-
-HsAddr
-get_prog_argv(void)
-{
- return prog_argv;
-}
-
-HsInt
-get_prog_argc()
-{
- return prog_argc;
-}
-
projects / ghc-hetmet.git / commitdiff