module ArrBase where
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import Ix
import PrelList (foldl)
import STBase
+++ /dev/null
----------------------------------------------------------------------------
--- 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;
+++ /dev/null
-%
-% (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}
-
\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
--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}
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}
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}
module IOBase where
-import {-# SOURCE #-} Error
+import {-# SOURCE #-} GHCerr ( error )
import STBase
import PrelTup
import PrelMaybe
import PrelBase
import GHC
import Addr
-import Error
+import GHCerr ( error )
#ifndef __PARALLEL_HASKELL__
import Foreign ( ForeignObj, makeForeignObj, writeForeignObj )
where
import PrelBase
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import PrelList ( length )
import STBase
import ArrBase
-- to import it explicitly
) where
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import GHC
infixr 9 .
zip, zip3, zipWith, zipWith3, unzip, unzip3
) where
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import PrelTup
import PrelMaybe
import PrelBase
import PrelBase
import GHC
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import PrelList
import PrelMaybe
module PrelRead where
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import PrelNum
import PrelList
import PrelTup
module PrelTup where
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import PrelBase
\end{code}
import PrelBase
import IOBase
import Addr
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
\end{code}
%*********************************************************
import PrelBase
import PrelRead (readLitChar)
-import Error ( error )
+import GHCerr ( error )
\end{code}
rangeSize
) where
-import {-# SOURCE #-} Error ( error )
+import {-# SOURCE #-} GHCerr ( error )
import PrelTup
import PrelBase
\end{code}
unfoldr
) where
-import Error ( error )
+import GHCerr ( error )
import Monad ( filter )
import PrelList
import PrelMaybe
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.
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.
projects / ghc-hetmet.git / commitdiff