ghc/lib/std/PrelErr.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelErr]{Module @PrelErr@}
   6
   7 The PrelErr module defines the code for the wired-in error functions,
   8 which have a special type in the compiler (with "open tyvars").
   9
  10 We cannot define these functions in a module where they might be used
  11 (e.g., PrelBase), because the magical wired-in type will get confused
  12 with what the typechecker figures out.
  13
  14 \begin{code}
  15 {-# OPTIONS -fno-implicit-prelude #-}
  16 module PrelErr
  17
  18        (
  19          irrefutPatError
  20        , noMethodBindingError
  21        , nonExhaustiveGuardsError
  22        , patError
  23        , recSelError
  24        , recConError
  25        , recUpdError               -- :: String -> a
  26
  27        , absentErr, parError       -- :: a
  28        , seqError                  -- :: a
  29
  30        , error                     -- :: String -> a
  31        , ioError                   -- :: String -> a
  32        , assertError               -- :: String -> Bool -> a -> a
  33        ) where
  34
  35 --import Prelude
  36 import PrelBase
  37 import PrelIOBase
  38 import PrelAddr
  39 import PrelList     ( span )
  40
  41 #ifndef __PARALLEL_HASKELL__
  42 import PrelForeign  ( StablePtr, deRefStablePtr )
  43 #endif
  44
  45 ---------------------------------------------------------------
  46 -- HACK: Magic unfoldings not implemented for unboxed lists
  47 --       Need to define a "build" to avoid undefined symbol
  48 -- in this module to avoid .hi proliferation.
  49
  50 build   = error "GHCbase.build"
  51 augment = error "GHCbase.augment"
  52 --{-# GENERATE_SPECS build a #-}
  53 --build                 :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
  54 --build g       = g (:) []
  55 \end{code}
  56
  57 %*********************************************************
  58 %*                                                      *
  59 \subsection{Error-ish functions}
  60 %*                                                      *
  61 %*********************************************************
  62
  63 \begin{code}
  64 errorIO :: IO () -> a
  65
  66 errorIO (IO io)
  67   = case (errorIO# io) of
  68       _ -> bottom
  69   where
  70     bottom = bottom -- Never evaluated
  71
  72 ioError :: String -> a
  73 ioError s = error__ ( \ x -> _ccall_ IOErrorHdrHook x ) s
  74
  75 -- error stops execution and displays an error message
  76 error :: String -> a
  77 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
  78
  79 error__ :: (Addr{-FILE *-} -> IO ()) -> String -> a
  80
  81 error__ msg_hdr s
  82 #ifdef __PARALLEL_HASKELL__
  83   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
  84              _ccall_ fflush sTDERR      >>
  85              fputs sTDERR s             >>
  86              _ccall_ fflush sTDERR      >>
  87              _ccall_ stg_exit (1::Int)
  88             )
  89 #else
  90   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
  91              _ccall_ fflush sTDERR      >>
  92              fputs sTDERR s             >>
  93              _ccall_ fflush sTDERR      >>
  94              _ccall_ getErrorHandler    >>= \ errorHandler ->
  95              if errorHandler == (-1::Int) then
  96                 _ccall_ stg_exit (1::Int)
  97              else
  98                 _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
  99                                                 >>= \ osptr ->
 100                 _ccall_ decrementErrorCount     >>= \ () ->
 101                 deRefStablePtr osptr            >>= \ oact ->
 102                 oact
 103             )
 104 #endif {- !parallel -}
 105   where
 106     sTDERR = (``stderr'' :: Addr)
 107 \end{code}
 108
 109 %*********************************************************
 110 %*                                                       *
 111 \subsection{Compiler generated errors + local utils}
 112 %*                                                       *
 113 %*********************************************************
 114
 115 Used for compiler-generated error message;
 116 encoding saves bytes of string junk.
 117
 118 \begin{code}
 119 absentErr, parError, seqError :: a
 120
 121 absentErr = error "Oops! The program has entered an `absent' argument!\n"
 122 parError  = error "Oops! Entered GHCerr.parError (a GHC bug -- please report it!)\n"
 123 seqError = error "Oops! Entered seqError (a GHC bug -- please report it!)\n"
 124
 125 \end{code}
 126
 127 \begin{code}
 128 irrefutPatError
 129    , noMethodBindingError
 130  --, noExplicitMethodError
 131    , nonExhaustiveGuardsError
 132    , patError
 133    , recSelError
 134    , recConError
 135    , recUpdError :: String -> a
 136
 137 --noDefaultMethodError     s = error ("noDefaultMethodError:"++s)
 138 --noExplicitMethodError    s = error ("No default method for class operation "++s)
 139 noMethodBindingError     s = error (untangle s "No instance nor default method for class operation")
 140 irrefutPatError          s = error (untangle s "Irrefutable pattern failed for pattern")
 141 nonExhaustiveGuardsError s = error (untangle s "Non-exhaustive guards in")
 142 patError                 s = error (untangle s "Non-exhaustive patterns in")
 143 recSelError              s = error (untangle s "Missing field in record selection:")
 144 recConError              s = error (untangle s "Missing field in record construction:")
 145 recUpdError              s = error (untangle s "Record to doesn't contain field(s) to be updated")
 146
 147
 148 assertError :: String -> Bool -> a -> a
 149 assertError str pred v
 150   | pred      = v
 151   | otherwise = error (untangle str "Assertion failed")
 152
 153 \end{code}
 154
 155
 156 (untangle coded message) expects "coded" to be of the form
 157
 158         "location|details"
 159
 160 It prints
 161
 162         location message details
 163
 164 \begin{code}
 165 untangle coded message
 166   =  location
 167   ++ ": "
 168   ++ message
 169   ++ details
 170   ++ "\n"
 171   where
 172     (location, details)
 173       = case (span not_bar coded) of { (location, rest) ->
 174         case rest of
 175           ('|':details) -> (location, ' ' : details)
 176           _             -> (location, "")
 177         }
 178     not_bar c = c /= '|'
 179 \end{code}
 180
 181 -- This local variant of "error" calls PatErrorHdrHook instead of ErrorHdrHook,
 182 -- but the former does exactly the same as the latter, so I nuked it.
 183 --              SLPJ Jan 97
 184 -- patError__ = error__ (\ x -> _ccall_ PatErrorHdrHook x)
 185