[project @ 1998-01-22 15:54:43 by sof]

* removed ghc/Error.{lhs,hi-boot}
* moved contents of Error to GHCerr + adjusted
  import lists of files that use old Error functionality.
* moved seqError from Prelude to GHCerr.

ghc/lib/ghc/ArrBase.lhs

@@ -11,7 +11,7 @@ types and operations.
 
 module ArrBase where
 
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import Ix
 import PrelList (foldl)
 import STBase

ghc/lib/ghc/Error.hi-boot

----------------------------------------------------------------------------
---                              Error.hi-boot
--- 
---      This hand-written interface file is the initial bootstrap version
---	for Error.hi.
---	It doesn't need to give "error" a type signature, 
---	because it's wired into the compiler
----------------------------------------------------------------------------
- 
-_interface_ Error 1
-_exports_
-Error error;

ghc/lib/ghc/Error.lhs

-%
-% (c) The AQUA Project, Glasgow University, 1994-1996
-%
-
-\section[Error]{Module @Error@}
-
-\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
-
-module Error (errorIO, error) where
-
-import PrelBase
-import IOBase
-import Foreign
-import Addr
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Error-ish functions}
-%*							*
-%*********************************************************
-
-\begin{code}
-errorIO :: IO () -> a
-
-errorIO (IO io)
-  = case (errorIO# io) of
-      _ -> bottom
-  where
-    bottom = bottom -- Never evaluated
-
---errorIO x = (waitRead#, errorIO#, makeForeignObj#, waitWrite#, (+#))
-
--- error stops execution and displays an error message
-error :: String -> a
-error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
-
-error__ :: (Addr{-FILE *-} -> IO ()) -> String -> a
-
-error__ msg_hdr s
-#ifdef __PARALLEL_HASKELL__
-  = errorIO (msg_hdr sTDERR{-msg hdr-}	>>
-	     _ccall_ fflush sTDERR	>>
-	     fputs sTDERR s		>>
-	     _ccall_ fflush sTDERR	>>
-	     _ccall_ stg_exit (1::Int)
-	    )
-#else
-  = errorIO (msg_hdr sTDERR{-msg hdr-}	>>
-	     _ccall_ fflush sTDERR	>>
-	     fputs sTDERR s		>>
-	     _ccall_ fflush sTDERR	>>
-	     _ccall_ getErrorHandler	>>= \ errorHandler ->
-	     if errorHandler == (-1::Int) then
-		_ccall_ stg_exit (1::Int)
-	     else
-		_casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
-						>>= \ osptr ->
-		_ccall_ decrementErrorCount     >>= \ () ->
-		deRefStablePtr osptr            >>= \ oact ->
-		oact
-	    )
-#endif {- !parallel -}
-  where
-    sTDERR = (``stderr'' :: Addr)
-\end{code}
-

ghc/lib/ghc/GHCerr.lhs

@@ -13,12 +13,32 @@ with what the typechecker figures out.
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
-module GHCerr where
+module GHCerr 
+
+       (
+         irrefutPatError
+       , noDefaultMethodError
+       , noExplicitMethodError
+       , nonExhaustiveGuardsError
+       , patError
+       , recConError
+       , recUpdError               -- :: String -> a
+
+       , absentErr, parError       -- :: a
+       , seqError                  -- :: a
+
+       , error		           -- :: String -> a
+       , ioError	           -- :: String -> a
+       , assert__		   -- :: String -> Bool -> a -> a
+       ) where
 
 --import Prelude
 import PrelBase
+import IOBase
+import Addr
+import Foreign  ( StablePtr, deRefStablePtr )
 import PrelList ( span )
-import Error
+
 
 ---------------------------------------------------------------
 -- HACK: Magic unfoldings not implemented for unboxed lists
@@ -32,15 +52,74 @@ augment = error "GHCbase.augment"
 --build g 	= g (:) []
 \end{code}
 
+%*********************************************************
+%*							*
+\subsection{Error-ish functions}
+%*							*
+%*********************************************************
+
+\begin{code}
+errorIO :: IO () -> a
+
+errorIO (IO io)
+  = case (errorIO# io) of
+      _ -> bottom
+  where
+    bottom = bottom -- Never evaluated
+
+ioError :: String -> a
+ioError s = error__ ( \ x -> _ccall_ IOErrorHdrHook x ) s
+
+-- error stops execution and displays an error message
+error :: String -> a
+error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
+
+error__ :: (Addr{-FILE *-} -> IO ()) -> String -> a
+
+error__ msg_hdr s
+#ifdef __PARALLEL_HASKELL__
+  = errorIO (msg_hdr sTDERR{-msg hdr-}	>>
+	     _ccall_ fflush sTDERR	>>
+	     fputs sTDERR s		>>
+	     _ccall_ fflush sTDERR	>>
+	     _ccall_ stg_exit (1::Int)
+	    )
+#else
+  = errorIO (msg_hdr sTDERR{-msg hdr-}	>>
+	     _ccall_ fflush sTDERR	>>
+	     fputs sTDERR s		>>
+	     _ccall_ fflush sTDERR	>>
+	     _ccall_ getErrorHandler	>>= \ errorHandler ->
+	     if errorHandler == (-1::Int) then
+		_ccall_ stg_exit (1::Int)
+	     else
+		_casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
+						>>= \ osptr ->
+		_ccall_ decrementErrorCount     >>= \ () ->
+		deRefStablePtr osptr            >>= \ oact ->
+		oact
+	    )
+#endif {- !parallel -}
+  where
+    sTDERR = (``stderr'' :: Addr)
+\end{code}
+
+%*********************************************************
+%*							 *
+\subsection{Compiler generated errors + local utils}
+%*							 *
+%*********************************************************
 
 Used for compiler-generated error message;
 encoding saves bytes of string junk.
 
 \begin{code}
-absentErr, parError :: a
+absentErr, parError, seqError :: a
 
 absentErr = error "Oops! The program has entered an `absent' argument!\n"
 parError  = error "Oops! Entered GHCerr.parError (a GHC bug -- please report it!)\n"
+seqError = error "Oops! Entered seqError (a GHC bug -- please report it!)\n"
+
 \end{code}
 
 \begin{code}
@@ -59,6 +138,13 @@ nonExhaustiveGuardsError s = error (untangle s "Non-exhaustive guards in")
 patError 		 s = error (untangle s "Non-exhaustive patterns in")
 recConError 		 s = error (untangle s "Missing field in record construction:")
 recUpdError 		 s = error (untangle s "Record to doesn't contain field(s) to be updated")
+
+
+assert__ :: String -> Bool -> a -> a
+assert__ str pred v 
+  | pred      = v
+  | otherwise = error (untangle str "Assertion failed")
+
 \end{code}
 
 

ghc/lib/ghc/GHCmain.lhs

@@ -9,11 +9,12 @@ module GHCmain( mainIO ) where
 
 import Prelude
 import {-# SOURCE #-} qualified Main	-- for type of "Main.main"
+import GHCerr ( ioError )
 \end{code}
 
 \begin{code}
 mainIO :: IO ()		-- It must be of type (IO t) because that's what
 			-- the RTS expects.  GHC doesn't check this, so
 			-- make sure this type signature stays!
-mainIO = catch Main.main (\err -> error ("I/O error: "++showsPrec 0 err "\n"))
+mainIO = catch Main.main (\err -> ioError (showsPrec 0 err "\n"))
 \end{code}

ghc/lib/ghc/IOBase.lhs

@@ -13,7 +13,7 @@ concretely; the @IO@ module itself exports abstractly.
 
 module IOBase where
 
-import {-# SOURCE #-} Error
+import {-# SOURCE #-} GHCerr ( error )
 import STBase
 import PrelTup
 import PrelMaybe

ghc/lib/ghc/IOHandle.lhs

@@ -27,7 +27,7 @@ import PrelMaybe
 import PrelBase
 import GHC
 import Addr
-import Error
+import GHCerr   ( error )
 
 #ifndef __PARALLEL_HASKELL__
 import Foreign  ( ForeignObj, makeForeignObj, writeForeignObj )

ghc/lib/ghc/PackBase.lhs

@@ -47,7 +47,7 @@ module PackBase
 	where
 
 import PrelBase
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import PrelList ( length )
 import STBase
 import ArrBase

ghc/lib/ghc/PrelBase.lhs

@@ -13,7 +13,7 @@ module PrelBase(
 				-- to import it explicitly
   ) where
 
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import GHC
 
 infixr 9  .

ghc/lib/ghc/PrelList.lhs

@@ -22,7 +22,7 @@ module PrelList (
    zip, zip3, zipWith, zipWith3, unzip, unzip3
  ) where
 
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import PrelTup
 import PrelMaybe
 import PrelBase

ghc/lib/ghc/PrelNum.lhs

@@ -21,7 +21,7 @@ module PrelNum where
 
 import PrelBase
 import GHC
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import PrelList
 import PrelMaybe
 

ghc/lib/ghc/PrelRead.lhs

@@ -11,7 +11,7 @@ Instances of the Read class.
 
 module PrelRead where
 
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import PrelNum
 import PrelList
 import PrelTup

ghc/lib/ghc/PrelTup.lhs

@@ -11,7 +11,7 @@ This modules defines the typle data types.
 
 module PrelTup where
 
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import PrelBase
 \end{code}
 

ghc/lib/ghc/Unsafe.lhs

@@ -21,7 +21,7 @@ module Unsafe
 import PrelBase
 import IOBase
 import Addr
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 \end{code}
 
 %*********************************************************

ghc/lib/required/Char.lhs

@@ -27,7 +27,7 @@ module Char
 
 import PrelBase
 import PrelRead (readLitChar)
-import Error    ( error )
+import GHCerr   ( error )
 
 \end{code}
 

ghc/lib/required/Ix.lhs

@@ -13,7 +13,7 @@ module Ix
 	rangeSize
     ) where
 
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
 import PrelTup
 import PrelBase
 \end{code}

ghc/lib/required/Maybe.lhs

@@ -20,7 +20,7 @@ module Maybe
     unfoldr
    ) where
 
-import Error	( error )
+import GHCerr	( error )
 import Monad	( filter )
 import PrelList
 import PrelMaybe

ghc/lib/required/Prelude.lhs

@@ -71,8 +71,7 @@ import PrelEither
 import PrelBounded
 import Monad
 import Maybe
-import Error	( error )
-import GHCerr
+import GHCerr   ( error, seqError )
 
 -- These can't conveniently be defined in PrelBase because they use numbers,
 -- or I/O, so here's a convenient place to do them.
@@ -96,9 +95,6 @@ strict f x  = x `seq` f x
 seq :: Eval a => a -> b -> b
 seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
 
-seqError :: a
-seqError = error "Oops! Entered seqError (a GHC bug -- please report it!)\n"
-
 -- It is expected that compilers will recognize this and insert error
 -- messages which are more appropriate to the context in which undefined 
 -- appears.