From 552de7b426f990a961a051ec486a77982c4b7770 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 22 Jan 1998 15:55:09 +0000
Subject: [PATCH] [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 | 2 +-
ghc/lib/ghc/Error.hi-boot | 12 -----
ghc/lib/ghc/Error.lhs | 68 --------------------------
ghc/lib/ghc/GHCerr.lhs | 92 ++++++++++++++++++++++++++++++++++--
ghc/lib/ghc/GHCmain.lhs | 3 +-
ghc/lib/ghc/IOBase.lhs | 2 +-
ghc/lib/ghc/IOHandle.lhs | 2 +-
ghc/lib/ghc/PackBase.lhs | 2 +-
ghc/lib/ghc/PrelBase.lhs | 2 +-
ghc/lib/ghc/PrelList.lhs | 2 +-
ghc/lib/ghc/PrelNum.lhs | 2 +-
ghc/lib/ghc/PrelRead.lhs | 2 +-
ghc/lib/ghc/PrelTup.lhs | 2 +-
ghc/lib/ghc/Unsafe.lhs | 2 +-
ghc/lib/required/Char.lhs | 2 +-
ghc/lib/required/Ix.lhs | 2 +-
ghc/lib/required/Maybe.lhs | 2 +-
ghc/lib/required/Prelude.lhs | 6 +--
18 files changed, 105 insertions(+), 102 deletions(-)
delete mode 100644 ghc/lib/ghc/Error.hi-boot
delete mode 100644 ghc/lib/ghc/Error.lhs
diff --git a/ghc/lib/ghc/ArrBase.lhs b/ghc/lib/ghc/ArrBase.lhs
index 4686421b8af6..b80c0cdbbb1c 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 fe91b8a86cd0..000000000000
--- 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 1d62ce613484..000000000000
--- 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 ee5643bc014e..afa3f15ac67a 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 0a67a1d704fb..fa143b666974 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 b9a9fca98041..f23a25ad1dae 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 a2787815a919..a0d4f14a0098 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 1f8614b9aabf..0f9dd04b5914 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 cfe4a83cfc67..ee3151b4ae82 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 7fd2d20aeb09..df0e4fb8dcd4 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 434406021e83..3c1e4fee47c8 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 60917b369040..3b3e4c8eaf34 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 e400bcd951dc..951d46dfe907 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 1a145af090d0..653a5d0f1d9f 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 40ba72d82cde..9dcca7e2270b 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 65d32e78e2e1..50bc1632b207 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 40b130f63cf7..acecd04bb5d8 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 84dca26d754a..b386d66405b1 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.
--
GitLab