Avoid using deprecated flags
[packages/base.git] / GHC / Err.lhs
1 \begin{code}
2 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
3 {-# OPTIONS_HADDOCK hide #-}
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module      :  GHC.Err
7 -- Copyright   :  (c) The University of Glasgow, 1994-2002
8 -- License     :  see libraries/base/LICENSE
9 -- 
10 -- Maintainer  :  cvs-ghc@haskell.org
11 -- Stability   :  internal
12 -- Portability :  non-portable (GHC extensions)
13 --
14 -- The "GHC.Err" module defines the code for the wired-in error functions,
15 -- which have a special type in the compiler (with \"open tyvars\").
16 -- 
17 -- We cannot define these functions in a module where they might be used
18 -- (e.g., "GHC.Base"), because the magical wired-in type will get confused
19 -- with what the typechecker figures out.
20 -- 
21 -----------------------------------------------------------------------------
22
23 -- #hide
24 module GHC.Err
25        (
26          irrefutPatError
27        , noMethodBindingError
28        , nonExhaustiveGuardsError
29        , patError
30        , recSelError
31        , recConError
32        , runtimeError              -- :: Addr#  -> a    -- Addr# points to UTF8 encoded C string
33
34        , absentErr                 -- :: a
35        , divZeroError              -- :: a
36        , overflowError             -- :: a
37
38        , error                     -- :: String -> a
39        , assertError               -- :: String -> Bool -> a -> a
40
41        , undefined                 -- :: a
42        ) where
43
44 #ifndef __HADDOCK__
45 import GHC.Base
46 import GHC.List     ( span )
47 import GHC.Exception
48 #endif
49 \end{code}
50
51 %*********************************************************
52 %*                                                      *
53 \subsection{Error-ish functions}
54 %*                                                      *
55 %*********************************************************
56
57 \begin{code}
58 -- | 'error' stops execution and displays an error message.
59 error :: String -> a
60 error s = throw (ErrorCall s)
61
62 -- | A special case of 'error'.
63 -- It is expected that compilers will recognize this and insert error
64 -- messages which are more appropriate to the context in which 'undefined'
65 -- appears. 
66
67 undefined :: a
68 undefined =  error "Prelude.undefined"
69 \end{code}
70
71 %*********************************************************
72 %*                                                       *
73 \subsection{Compiler generated errors + local utils}
74 %*                                                       *
75 %*********************************************************
76
77 Used for compiler-generated error message;
78 encoding saves bytes of string junk.
79
80 \begin{code}
81 absentErr :: a
82
83 absentErr = error "Oops! The program has entered an `absent' argument!\n"
84 \end{code}
85
86 \begin{code}
87 recSelError, recConError, irrefutPatError, runtimeError,
88              nonExhaustiveGuardsError, patError, noMethodBindingError
89         :: Addr# -> a   -- All take a UTF8-encoded C string
90
91 recSelError              s = throw (RecSelError (unpackCStringUtf8# s)) -- No location info unfortunately
92 runtimeError             s = error (unpackCStringUtf8# s)               -- No location info unfortunately
93
94 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
95 irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
96 recConError              s = throw (RecConError      (untangle s "Missing field in record construction"))
97 noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation"))
98 patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
99
100 assertError :: Addr# -> Bool -> a -> a
101 assertError str pred v 
102   | pred      = v
103   | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
104 \end{code}
105
106
107 (untangle coded message) expects "coded" to be of the form 
108
109         "location|details"
110
111 It prints
112
113         location message details
114
115 \begin{code}
116 untangle :: Addr# -> String -> String
117 untangle coded message
118   =  location
119   ++ ": " 
120   ++ message
121   ++ details
122   ++ "\n"
123   where
124     coded_str = unpackCStringUtf8# coded
125
126     (location, details)
127       = case (span not_bar coded_str) of { (loc, rest) ->
128         case rest of
129           ('|':det) -> (loc, ' ' : det)
130           _         -> (loc, "")
131         }
132     not_bar c = c /= '|'
133 \end{code}
134
135 Divide by zero and arithmetic overflow.
136 We put them here because they are needed relatively early
137 in the libraries before the Exception type has been defined yet.
138
139 \begin{code}
140 {-# NOINLINE divZeroError #-}
141 divZeroError :: a
142 divZeroError = throw (ArithException DivideByZero)
143
144 {-# NOINLINE overflowError #-}
145 overflowError :: a
146 overflowError = throw (ArithException Overflow)
147 \end{code}
148