Change how pprPanic works

We now include the String and the SDoc in the exception, and don't
flatten them into a String until near the top-level

2 files changed, 14 insertions, 3 deletions

diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 9076913751..25fa15e18d 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -67,7 +67,8 @@ module Outputable (
         -- * Error handling and debugging utilities
         pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
         pprTrace, pprDefiniteTrace, warnPprTrace,
-        trace, pgmError, panic, sorry, panicFastInt, assertPanic
+        trace, pgmError, panic, sorry, panicFastInt, assertPanic,
+        pprDebugAndThen,
     ) where
 
 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
@@ -904,7 +905,7 @@ plural _   = char 's'
 
 pprPanic :: String -> SDoc -> a
 -- ^ Throw an exception saying "bug in GHC"
-pprPanic    = pprDebugAndThen panic
+pprPanic    = panicDoc
 
 pprSorry :: String -> SDoc -> a
 -- ^ Throw an exception saying "this isn't finished yet"
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index 42594c8109..019eec387e 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -14,6 +14,7 @@ module Panic (
      pgmError,
 
      panic, sorry, panicFastInt, assertPanic, trace,
+     panicDoc,
 
      Exception.Exception(..), showException, safeShowException, try, tryMost, throwTo,
 
@@ -22,9 +23,12 @@ module Panic (
 ) where
 #include "HsVersions.h"
 
+import {-# SOURCE #-} Outputable (SDoc)
+
 import Config
 import FastTypes
 import Exception
+
 import Control.Concurrent
 import Data.Dynamic
 #if __GLASGOW_HASKELL__ < 705
@@ -78,6 +82,7 @@ data GhcException
 
   -- | The 'impossible' happened.
   | Panic        String
+  | PprPanic     String SDoc
 
   -- | The user tickled something that's known not to work yet,
   --   but we're not counting it as a bug.
@@ -88,7 +93,7 @@ data GhcException
 
   -- | An error in the user's code, probably.
   | ProgramError String
-  deriving (Typeable, Eq)
+  deriving (Typeable)
 
 instance Exception GhcException
 
@@ -143,6 +148,8 @@ showGhcException exception
         InstallationError str   -> showString str
         Signal n                -> showString "signal: " . shows n
 
+        PprPanic  s _ ->
+            showGhcException (Panic (s ++ "\n<<details unavailable>>"))
         Panic s
          -> showString $
                 "panic! (the 'impossible' happened)\n"
@@ -185,6 +192,9 @@ panic    x = unsafeDupablePerformIO $ do
 panic    x = throwGhcException (Panic x)
 #endif
 
+panicDoc :: String -> SDoc -> a
+panicDoc x doc = throwGhcException (PprPanic x doc)
+
 sorry    x = throwGhcException (Sorry x)
 pgmError x = throwGhcException (ProgramError x)