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