diff --git a/ghc/lib/ghc/ArrBase.lhs b/ghc/lib/ghc/ArrBase.lhs
index 4686421b8af68dfcb2c5e8c9b7990cdbdcf660eb..b80c0cdbbb1c6dc08962685c086d6add63237af0 100644
--- a/ghc/lib/ghc/ArrBase.lhs
+++ b/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
diff --git a/ghc/lib/ghc/Error.hi-boot b/ghc/lib/ghc/Error.hi-boot
deleted file mode 100644
index fe91b8a86cd09852b8308d3deb8c065d714fc049..0000000000000000000000000000000000000000
--- a/ghc/lib/ghc/Error.hi-boot
+++ /dev/null
@@ -1,12 +0,0 @@
----------------------------------------------------------------------------
--- 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;
diff --git a/ghc/lib/ghc/Error.lhs b/ghc/lib/ghc/Error.lhs
deleted file mode 100644
index 1d62ce6134845d71232ea03bd8daead43b6fe06b..0000000000000000000000000000000000000000
--- a/ghc/lib/ghc/Error.lhs
+++ /dev/null
@@ -1,68 +0,0 @@
-%
-% (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}
-
diff --git a/ghc/lib/ghc/GHCerr.lhs b/ghc/lib/ghc/GHCerr.lhs
index ee5643bc014e964df600e59a3e3a599b85eb6f9e..afa3f15ac67af34a496d4e0cee6610277c6bdc45 100644
--- a/ghc/lib/ghc/GHCerr.lhs
+++ b/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}
diff --git a/ghc/lib/ghc/GHCmain.lhs b/ghc/lib/ghc/GHCmain.lhs
index 0a67a1d704fb7527c2ff85a334278f0c28d58ef4..fa143b666974e9af76e50e82b83c02f36a454cfa 100644
--- a/ghc/lib/ghc/GHCmain.lhs
+++ b/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}
diff --git a/ghc/lib/ghc/IOBase.lhs b/ghc/lib/ghc/IOBase.lhs
index b9a9fca980413ac632b3fc52e499f2179f19f768..f23a25ad1dae55ea7a8b12983fdd718bae258e19 100644
--- a/ghc/lib/ghc/IOBase.lhs
+++ b/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
diff --git a/ghc/lib/ghc/IOHandle.lhs b/ghc/lib/ghc/IOHandle.lhs
index a2787815a919f98aa9247fa9ec1476489d0d24d5..a0d4f14a0098a7843d26c6216985f4d09606b4aa 100644
--- a/ghc/lib/ghc/IOHandle.lhs
+++ b/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 )
diff --git a/ghc/lib/ghc/PackBase.lhs b/ghc/lib/ghc/PackBase.lhs
index 1f8614b9aabf7719f197d2c41edcc92517bf6ad9..0f9dd04b5914aff0ede8adea6a73ec9d0b588517 100644
--- a/ghc/lib/ghc/PackBase.lhs
+++ b/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
diff --git a/ghc/lib/ghc/PrelBase.lhs b/ghc/lib/ghc/PrelBase.lhs
index cfe4a83cfc67ef659d47b595d419b39852dfd1c4..ee3151b4ae82e711afca59accaa960675a6d7198 100644
--- a/ghc/lib/ghc/PrelBase.lhs
+++ b/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 .
diff --git a/ghc/lib/ghc/PrelList.lhs b/ghc/lib/ghc/PrelList.lhs
index 7fd2d20aeb096d92cd183c8b5fc5c1226ad23994..df0e4fb8dcd444fc5de305ea0086f2a3e5cd8fe1 100644
--- a/ghc/lib/ghc/PrelList.lhs
+++ b/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
diff --git a/ghc/lib/ghc/PrelNum.lhs b/ghc/lib/ghc/PrelNum.lhs
index 434406021e8374fd375cfeb5ee549e951628a135..3c1e4fee47c82ba1a07bdaf529e27b1e1dd415a0 100644
--- a/ghc/lib/ghc/PrelNum.lhs
+++ b/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
diff --git a/ghc/lib/ghc/PrelRead.lhs b/ghc/lib/ghc/PrelRead.lhs
index 60917b3690405c84f05ea1b6f6f73be32c40674b..3b3e4c8eaf3440c357e0db4e8b2acf73f38fa8dc 100644
--- a/ghc/lib/ghc/PrelRead.lhs
+++ b/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
diff --git a/ghc/lib/ghc/PrelTup.lhs b/ghc/lib/ghc/PrelTup.lhs
index e400bcd951dcdb2455a41e5321585b07428ab06d..951d46dfe9075c1ff337fb1f6c79631bf9fd032a 100644
--- a/ghc/lib/ghc/PrelTup.lhs
+++ b/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}
diff --git a/ghc/lib/ghc/Unsafe.lhs b/ghc/lib/ghc/Unsafe.lhs
index 1a145af090d033227daf947d944c9c5209100f79..653a5d0f1d9fb7b171286ae876bfeae4f96a3633 100644
--- a/ghc/lib/ghc/Unsafe.lhs
+++ b/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}
%*********************************************************
diff --git a/ghc/lib/required/Char.lhs b/ghc/lib/required/Char.lhs
index 40ba72d82cdece30fee440bd8d6bafb3e21f8b98..9dcca7e2270bb313c4b86835af49c8e45dbb024b 100644
--- a/ghc/lib/required/Char.lhs
+++ b/ghc/lib/required/Char.lhs
@@ -27,7 +27,7 @@ module Char
import PrelBase
import PrelRead (readLitChar)
-import Error ( error )
+import GHCerr ( error )
\end{code}
diff --git a/ghc/lib/required/Ix.lhs b/ghc/lib/required/Ix.lhs
index 65d32e78e2e18bb06be3aaf86ff819c1a830233e..50bc1632b20761dac306996ffe0b94b9c218fa4e 100644
--- a/ghc/lib/required/Ix.lhs
+++ b/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}
diff --git a/ghc/lib/required/Maybe.lhs b/ghc/lib/required/Maybe.lhs
index 40b130f63cf768c8d07cd2c5e718b67e6e05f2c2..acecd04bb5d832381d45cc4d69075155354cd00b 100644
--- a/ghc/lib/required/Maybe.lhs
+++ b/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
diff --git a/ghc/lib/required/Prelude.lhs b/ghc/lib/required/Prelude.lhs
index 84dca26d754ada5d30778e5282e5d6ac6a63e2a5..b386d66405b1a31ac664a9aa0b15a9a4698c6a9c 100644
--- a/ghc/lib/required/Prelude.lhs
+++ b/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.