+% -----------------------------------------------------------------------------
+% $Id: PrelErr.lhs,v 1.21 2001/07/24 16:09:48 simonpj Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
%
\section[PrelErr]{Module @PrelErr@}
, absentErr, parError -- :: a
, seqError -- :: a
+ , errorCString -- :: Addr# -> a -- Arg is a ptr to C string
, error -- :: String -> a
, assertError -- :: String -> Bool -> a -> a
+ , undefined -- :: a
) where
import PrelBase
-import PrelIOBase ( IO(..) )
---import PrelHandle ( catch )
-import PrelAddr
import PrelList ( span )
import PrelException
-import PrelPack ( packString )
-import PrelArr ( ByteArray(..) )
-
-#ifndef __PARALLEL_HASKELL__
-import PrelStable ( StablePtr, deRefStablePtr )
-#endif
-
----------------------------------------------------------------
--- HACK: Magic unfoldings not implemented for unboxed lists
--- Need to define a "build" to avoid undefined symbol
--- in this module to avoid .hi proliferation.
-
---{-# GENERATE_SPECS build a #-}
---build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
---build g = g (:) []
---build = error "GHCbase.build"
---augment = error "GHCbase.augment"
\end{code}
%*********************************************************
%*********************************************************
\begin{code}
-{-
-errorIO :: IO () -> a
-
-errorIO (IO io)
- = case (errorIO# io) of
- _ -> bottom
- where
- bottom = bottom -- Never evaluated
--}
---ioError :: String -> a
---ioError s = error__ ``&IOErrorHdrHook'' s
-
-- error stops execution and displays an error message
error :: String -> a
error s = throw (ErrorCall s)
---error s = error__ ``&ErrorHdrHook'' s
-{-
--- This local variant of "error" calls PatErrorHdrHook instead of ErrorHdrHook,
--- but the former does exactly the same as the latter, so I nuked it.
--- SLPJ Jan 97
---
--- Hmm..distinguishing between these two kinds of error is quite useful in the
--- compiler sources, printing out a more verbose msg in the case of patter
--- matching failure.
--- So I've reinstated patError to invoke its own message function hook again.
--- SOF 8/98
-patError__ x = error__ ``&PatErrorHdrHook'' x
-
-error__ :: Addr{-C function pointer to hook-} -> String -> a
-
-error__ msg_hdr s
-#ifdef __PARALLEL_HASKELL__
- = errorIO (do
- (hFlush stdout) `catchException` (\ _ -> return ())
- let bs@(ByteArray (_,len) _) = packString s
- _ccall_ writeErrString__ msg_hdr bs len
- _ccall_ stg_exit (1::Int)
- )
-#else
- = errorIO ( do
- (hFlush stdout) `catchException` (\ _ -> return ())
- -- Note: there's potential for trouble here in a
- -- a concurrent setting if an error is flagged after the
- -- lock on the stdout handle. (I don't see a possibility
- -- of this occurring with the current impl, but still.)
- let bs@(ByteArray (_,len) _) = packString s
- _ccall_ writeErrString__ msg_hdr bs len
- errorHandler <- _ccall_ getErrorHandler
- if errorHandler == (-1::Int) then
- _ccall_ stg_exit (1::Int)
- else do
- osptr <- _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
- _ccall_ decrementErrorCount
- oact <- deRefStablePtr osptr
- oact
- )
-
-#endif {- !parallel -}
--}
+
+errorCString :: Addr# -> a
+errorCString s = error (unpackCString# s)
+
+-- It is expected that compilers will recognize this and insert error
+-- messages which are more appropriate to the context in which undefined
+-- appears.
+
+undefined :: a
+undefined = error "Prelude.undefined"
\end{code}
%*********************************************************
noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
-nonExhaustiveGuardsError s = throw (NonExhaustiveGuards (untangle s "Non-exhaustive guards in"))
+nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
recSelError s = throw (RecSelError (untangle s "Missing field in record selection"))
recConError s = throw (RecConError (untangle s "Missing field in record construction"))
assertError :: String -> Bool -> a -> a
assertError str pred v
| pred = v
- | otherwise = error (untangle str "Assertion failed")
+ | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
\end{code}
= location
++ ": "
++ message
- ++ "\'" ++ details ++ "\'"
+ ++ details
++ "\n"
where
(location, details)