From: qrczak <unknown>
Date: Wed, 10 Jan 2001 16:28:15 +0000 (+0000)
Subject: [project @ 2001-01-10 16:28:15 by qrczak]
X-Git-Tag: Approximately_9120_patches~2951
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a23a8116c3bab9340e1bee39ef80c83969d67101;p=ghc-hetmet.git

[project @ 2001-01-10 16:28:15 by qrczak]
Remove CError.throwCError. Export the new function errnoToIOError.

Add a missing colon in a string inside IOException formed from
the error-specific part and optional filename. The IOException
representation has not changed yet, but IMHO the filename should
be kept separate.

Correctly handle user errors in IO.ioeGet* functions like other
IO errors.

Let fail :: String -> IO a throw a user error instead of invoking error
(Haskell98 is ambiguous about that and IMHO it should be this way;
this is also what nhc does).
---

diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index 01b7182..6d3e4c7 100644
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelHandle.lhs,v 1.63 2000/11/07 10:42:56 simonmar Exp $
+% $Id: PrelHandle.lhs,v 1.64 2001/01/10 16:28:15 qrczak Exp $
 %
 % (c) The AQUA Project, Glasgow University, 1994-2000
 %
@@ -21,7 +21,7 @@ import PrelBase
 import PrelAddr		( Addr, nullAddr )
 import PrelByteArr	( ByteArray(..) )
 import PrelRead		( Read )
-import PrelList 	( span )
+import PrelList 	( break )
 import PrelIOBase
 import PrelMaybe	( Maybe(..) )
 import PrelException
@@ -937,20 +937,23 @@ ioeGetFileName        :: IOError -> Maybe FilePath
 ioeGetErrorString     :: IOError -> String
 ioeGetHandle          :: IOError -> Maybe Handle
 
-ioeGetHandle   (IOException (IOError h _ _ _))   = h
-ioeGetHandle   _ = error "IO.ioeGetHandle: not an IO error"
+ioeGetHandle (IOException (IOError h _ _ _))   = h
+ioeGetHandle (UserError _) = Nothing
+ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
 
 ioeGetErrorString (IOException (IOError _ iot _ str)) =
- case iot of
-   EOF -> "end of file"
-   _   -> str
-ioeGetErrorString   _ = error "IO.ioeGetErrorString: not an IO error"
+  case iot of
+    EOF -> "end of file"
+    _   -> str
+ioeGetErrorString (UserError str) = str
+ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
 
 ioeGetFileName (IOException (IOError _ _  _ str)) = 
- case span (/=':') str of
-   (_,[])  -> Nothing
-   (fs,_)  -> Just fs
-ioeGetFileName   _ = error "IO.ioeGetFileName: not an IO error"
+  case break (== ':') str of
+    (_, [])      -> Nothing
+    (_, _:' ':fs)-> Just fs
+ioeGetFileName (UserError _) = Nothing
+ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
 \end{code}
 
 'Top-level' IO actions want to catch exceptions (e.g., forkIO and 
diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index be14cef..00653b2 100644
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.29 2000/11/07 10:42:56 simonmar Exp $
+% $Id: PrelIOBase.lhs,v 1.30 2001/01/10 16:28:15 qrczak Exp $
 % 
 % (c) The University of Glasgow, 1994-2000
 %
@@ -92,7 +92,7 @@ instance  Monad IO  where
     return x	= returnIO x
 
     m >>= k     = bindIO m k
-    fail s	= error s -- not ioError?
+    fail s	= ioError (userError s)
 
 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
@@ -679,8 +679,8 @@ constructErrorMsg call_site reason =
      ERR_RESOURCEVANISHED	 -> ResourceVanished
      ERR_SYSTEMERROR	         -> SystemError
      ERR_TIMEEXPIRED	         -> TimeExpired
-     ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
-     ERR_UNSUPPORTEDOPERATION   -> UnsupportedOperation
+     ERR_UNSATISFIEDCONSTRAINTS  -> UnsatisfiedConstraints
+     ERR_UNSUPPORTEDOPERATION    -> UnsupportedOperation
      ERR_EOF		         -> EOF
      _			         -> OtherError
 
@@ -691,7 +691,7 @@ constructErrorMsg call_site reason =
      _ -> "") ++
    (case reason of
       Nothing -> ""
-      Just m  -> ' ':m)
+      Just m  -> ": "++m)
  in
  return (IOError Nothing iot call_site msg)
 \end{code}