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