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