Nicer error message for #3782

It now says:

ghc-stage2: sorry! (this is work in progress)
  (GHC version 7.1.20101028 for i386-apple-darwin):
	Vectorise.Builtins.indexBuiltin

    DPH builtin function 'sumTyCon' of size '11' is not yet implemented.
    This function does not appear in your source program, but it is needed
    to compile your code in the backend. This is a known, current limitation
    of DPH. If you want it to to work you should send mail to cvs-ghc@haskell.org
    and ask what you can do to help (it might involve some GHC hacking).

I added 'pprSorry' that behaves like 'pprPanic' except it say sorry! instead
of panic!, and doesn't ask the user to report a bug.

diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 37f116c..96cf492 100644 (file)
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -59,9 +59,9 @@ module Outputable (
         mkUserStyle, cmdlineParserStyle, Depth(..),
        
        -- * Error handling and debugging utilities
-       pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, 
+       pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError, 
        pprTrace, warnPprTrace,
-       trace, pgmError, panic, panicFastInt, assertPanic
+       trace, pgmError, panic, sorry, panicFastInt, assertPanic
     ) where
 
 import {-# SOURCE #-}  Module( Module, ModuleName, moduleName )
@@ -779,27 +779,35 @@ plural _   = char 's'
 %************************************************************************
 
 \begin{code}
+
 pprPanic :: String -> SDoc -> a
 -- ^ Throw an exception saying "bug in GHC"
-pprPgmError :: String -> SDoc -> a
--- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
-pprTrace :: String -> SDoc -> a -> a
--- ^ If debug output is on, show some 'SDoc' on the screen
-
 pprPanic    = pprAndThen panic
 
+pprSorry :: String -> SDoc -> a
+-- ^ Throw an exceptio saying "this isn't finished yet"
+pprSorry    = pprAndThen sorry
+
+
+pprPgmError :: String -> SDoc -> a
+-- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
 pprPgmError = pprAndThen pgmError
 
+
+pprTrace :: String -> SDoc -> a -> a
+-- ^ If debug output is on, show some 'SDoc' on the screen
 pprTrace str doc x
    | opt_NoDebugOutput = x
    | otherwise         = pprAndThen trace str doc x
 
+
 pprPanicFastInt :: String -> SDoc -> FastInt
 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'
 pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
                             where
                               doc = text heading <+> pretty_msg
 
+
 pprAndThen :: (String -> a) -> String -> SDoc -> a
 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
     where

diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index e11b28f..0e1b59d 100644 (file)
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -15,7 +15,7 @@ module Panic
      ghcError, progName,
      pgmError,
 
-     panic, panicFastInt, assertPanic, trace,
+     panic, sorry, panicFastInt, assertPanic, trace,
      
      Exception.Exception(..), showException, try, tryMost, throwTo,
 
@@ -61,12 +61,14 @@ ghcError e = Exception.throw e
 -- assumed to contain a location already, so we don't print one).
 
 data GhcException
-  = PhaseFailed String         -- name of phase 
-               ExitCode        -- an external phase (eg. cpp) failed
+  = PhaseFailed  String                -- name of phase 
+                ExitCode       -- an external phase (eg. cpp) failed
   | Signal Int                  -- some other fatal signal (SIGHUP,SIGTERM)
-  | UsageError String          -- prints the short usage msg after the error
+  | UsageError   String                -- prints the short usage msg after the error
   | CmdLineError String                -- cmdline prob, but doesn't print usage
-  | Panic String               -- the `impossible' happened
+  | Panic        String                -- the `impossible' happened
+  | Sorry        String                -- the user tickled something that's known not to work yet, 
+                               -- and we're not counting it as a bug.
   | InstallationError String   -- an installation problem
   | ProgramError String                -- error in the user's code, probably
   deriving Eq
@@ -113,6 +115,11 @@ showGhcException (Panic s)
                 ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
                 ++ s ++ "\n\n"
                 ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n")
+showGhcException (Sorry s)
+   = showString ("sorry! (this is work in progress)\n"
+                ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
+                ++ s ++ "\n")
+
 
 throwGhcException :: GhcException -> a
 throwGhcException = Exception.throw
@@ -130,8 +137,9 @@ instance Typeable GhcException where
 Panics and asserts.
 
 \begin{code}
-panic, pgmError :: String -> a
+panic, sorry, pgmError :: String -> a
 panic    x = throwGhcException (Panic x)
+sorry    x = throwGhcException (Sorry x)
 pgmError x = throwGhcException (ProgramError x)
 
 --  #-versions because panic can't return an unboxed int, and that's

diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs
index 884224e..8e22070 100644 (file)
--- a/compiler/vectorise/Vectorise/Builtins/Base.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Base.hs
@@ -117,7 +117,15 @@ indexBuiltin
 
 indexBuiltin fn f i bi
   | inRange (bounds xs) i = xs ! i
-  | otherwise            = pprPanic fn (ppr i)
+  | otherwise            
+  = pprSorry "Vectorise.Builtins.indexBuiltin" 
+       (vcat   [ text ""
+               , text "DPH builtin function '" <> text fn <> text "' of size '" <> ppr i <> text "' is not yet implemented."
+               , text "This function does not appear in your source program, but it is needed"
+               , text "to compile your code in the backend. This is a known, current limitation"
+               , text "of DPH. If you want it to to work you should send mail to cvs-ghc@haskell.org"
+               , text "and ask what you can do to help (it might involve some GHC hacking)."])
+
   where        xs = f bi