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.IOBase
  47 import GHC.List     ( span )
  48 import GHC.Exception
  49 #endif
  50 \end{code}
  51
  52 %*********************************************************
  53 %*                                                      *
  54 \subsection{Error-ish functions}
  55 %*                                                      *
  56 %*********************************************************
  57
  58 \begin{code}
  59 -- | 'error' stops execution and displays an error message.
  60 error :: String -> a
  61 error s = throw (ErrorCall s)
  62
  63 -- | A special case of 'error'.
  64 -- It is expected that compilers will recognize this and insert error
  65 -- messages which are more appropriate to the context in which 'undefined'
  66 -- appears.
  67
  68 undefined :: a
  69 undefined =  error "Prelude.undefined"
  70 \end{code}
  71
  72 %*********************************************************
  73 %*                                                       *
  74 \subsection{Compiler generated errors + local utils}
  75 %*                                                       *
  76 %*********************************************************
  77
  78 Used for compiler-generated error message;
  79 encoding saves bytes of string junk.
  80
  81 \begin{code}
  82 absentErr :: a
  83
  84 absentErr = error "Oops! The program has entered an `absent' argument!\n"
  85 \end{code}
  86
  87 \begin{code}
  88 recSelError, recConError, irrefutPatError, runtimeError,
  89              nonExhaustiveGuardsError, patError, noMethodBindingError
  90         :: Addr# -> a   -- All take a UTF8-encoded C string
  91
  92 recSelError              s = throw (RecSelError (unpackCStringUtf8# s)) -- No location info unfortunately
  93 runtimeError             s = error (unpackCStringUtf8# s)               -- No location info unfortunately
  94
  95 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
  96 irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
  97 recConError              s = throw (RecConError      (untangle s "Missing field in record construction"))
  98 noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation"))
  99 patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
 100
 101 assertError :: Addr# -> Bool -> a -> a
 102 assertError str pred v
 103   | pred      = v
 104   | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
 105 \end{code}
 106
 107
 108 (untangle coded message) expects "coded" to be of the form
 109
 110         "location|details"
 111
 112 It prints
 113
 114         location message details
 115
 116 \begin{code}
 117 untangle :: Addr# -> String -> String
 118 untangle coded message
 119   =  location
 120   ++ ": "
 121   ++ message
 122   ++ details
 123   ++ "\n"
 124   where
 125     coded_str = unpackCStringUtf8# coded
 126
 127     (location, details)
 128       = case (span not_bar coded_str) of { (loc, rest) ->
 129         case rest of
 130           ('|':det) -> (loc, ' ' : det)
 131           _         -> (loc, "")
 132         }
 133     not_bar c = c /= '|'
 134 \end{code}
 135
 136 Divide by zero and arithmetic overflow.
 137 We put them here because they are needed relatively early
 138 in the libraries before the Exception type has been defined yet.
 139
 140 \begin{code}
 141 {-# NOINLINE divZeroError #-}
 142 divZeroError :: a
 143 divZeroError = throw (ArithException DivideByZero)
 144
 145 {-# NOINLINE overflowError #-}
 146 overflowError :: a
 147 overflowError = throw (ArithException Overflow)
 148 \end{code}
 149