Add PlainPanic for throwing exceptions without depending on pprint

This commit splits out a subset of GhcException which do not depend on
pretty printing (SDoc), as a new datatype called
PlainGhcException. These exceptions can be caught as GhcException,
because 'fromException' will convert them.

The motivation for this change is that that the Panic module
transitively depends on many modules, primarily due to pretty printing
code.  It's on the order of about 130 modules.  This large set of
dependencies has a few implications:

1. To avoid cycles / use of boot files, these dependencies cannot
throw GhcException.

2. There are some utility modules that use UnboxedTuples and also use
`panic`. This means that when loading GHC into GHCi, about 130
additional modules would need to be compiled instead of
interpreted. Splitting the non-pprint exception throwing into a new
module resolves this issue. See #13101

11 files changed, 178 insertions, 96 deletions

diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 348c170d7f..8780a52208 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -37,7 +37,7 @@ module UniqSupply (
 import GhcPrelude
 
 import Unique
-import Panic (panic)
+import PlainPanic (panic)
 
 import GHC.IO
 
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index e3e3df0b3f..38ef67d495 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -558,6 +558,7 @@ Library
         Outputable
         Pair
         Panic
+        PlainPanic
         PprColour
         Pretty
         State
diff --git a/compiler/iface/BinFingerprint.hs b/compiler/iface/BinFingerprint.hs
index 913ece0f27..1eef4d67b4 100644
--- a/compiler/iface/BinFingerprint.hs
+++ b/compiler/iface/BinFingerprint.hs
@@ -15,7 +15,7 @@ import GhcPrelude
 import Fingerprint
 import Binary
 import Name
-import Panic
+import PlainPanic
 import Util
 
 fingerprintBinMem :: BinHandle -> IO Fingerprint
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index e6dfa3da2c..035b65ff23 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -64,7 +64,7 @@ import GhcPrelude
 
 import {-# SOURCE #-} Name (Name)
 import FastString
-import Panic
+import PlainPanic
 import UniqFM
 import FastMutInt
 import Fingerprint
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index 4f16624537..0db61ec93f 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -101,7 +101,7 @@ import GhcPrelude as Prelude
 
 import Encoding
 import FastFunctions
-import Panic
+import PlainPanic
 import Util
 
 import Control.Concurrent.MVar
diff --git a/compiler/utils/Panic.hs b/compiler/utils/Panic.hs
index df6612bdda..16f493826c 100644
--- a/compiler/utils/Panic.hs
+++ b/compiler/utils/Panic.hs
@@ -14,7 +14,7 @@ module Panic (
      GhcException(..), showGhcException,
      throwGhcException, throwGhcExceptionIO,
      handleGhcException,
-     progName,
+     PlainPanic.progName,
      pgmError,
 
      panic, sorry, assertPanic, trace,
@@ -27,20 +27,19 @@ module Panic (
 
      withSignalHandlers,
 ) where
-#include "HsVersions.h"
 
 import GhcPrelude
 
 import {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe)
+import PlainPanic
 
-import Config
 import Exception
 
 import Control.Monad.IO.Class
 import Control.Concurrent
+import Data.Typeable      ( cast )
 import Debug.Trace        ( trace )
 import System.IO.Unsafe
-import System.Environment
 
 #if !defined(mingw32_HOST_OS)
 import System.Posix.Signals as S
@@ -50,7 +49,6 @@ import System.Posix.Signals as S
 import GHC.ConsoleHandler as S
 #endif
 
-import GHC.Stack
 import System.Mem.Weak  ( deRefWeak )
 
 -- | GHC's own exception type
@@ -91,25 +89,25 @@ data GhcException
   | ProgramError    String
   | PprProgramError String SDoc
 
-instance Exception GhcException
+instance Exception GhcException where
+  fromException (SomeException e)
+    | Just ge <- cast e = Just ge
+    | Just pge <- cast e = Just $
+        case pge of
+          PlainSignal n -> Signal n
+          PlainUsageError str -> UsageError str
+          PlainCmdLineError str -> CmdLineError str
+          PlainPanic str -> Panic str
+          PlainSorry str -> Sorry str
+          PlainInstallationError str -> InstallationError str
+          PlainProgramError str -> ProgramError str
+    | otherwise = Nothing
 
 instance Show GhcException where
   showsPrec _ e@(ProgramError _) = showGhcException e
   showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
   showsPrec _ e = showString progName . showString ": " . showGhcException e
 
-
--- | The name of this GHC.
-progName :: String
-progName = unsafePerformIO (getProgName)
-{-# NOINLINE progName #-}
-
-
--- | Short usage information to display when we are given the wrong cmd line arguments.
-short_usage :: String
-short_usage = "Usage: For basic information, try the `--help' option."
-
-
 -- | Show an exception as a string.
 showException :: Exception e => e -> String
 showException = show
@@ -134,42 +132,21 @@ safeShowException e = do
 -- If the error message to be printed includes a pretty-printer document
 -- which forces one of these fields this call may bottom.
 showGhcException :: GhcException -> ShowS
-showGhcException exception
- = case exception of
-        UsageError str
-         -> showString str . showChar '\n' . showString short_usage
-
-        CmdLineError str        -> showString str
-        PprProgramError str  sdoc  ->
-            showString str . showString "\n\n" .
-            showString (showSDocUnsafe sdoc)
-        ProgramError str        -> showString str
-        InstallationError str   -> showString str
-        Signal n                -> showString "signal: " . shows n
-
-        PprPanic  s sdoc ->
-            panicMsg $ showString s . showString "\n\n"
-                     . showString (showSDocUnsafe sdoc)
-        Panic s -> panicMsg (showString s)
-
-        PprSorry  s sdoc ->
-            sorryMsg $ showString s . showString "\n\n"
-                     . showString (showSDocUnsafe sdoc)
-        Sorry s -> sorryMsg (showString s)
-  where
-    sorryMsg :: ShowS -> ShowS
-    sorryMsg s =
-        showString "sorry! (unimplemented feature or known bug)\n"
-      . showString ("  (GHC version " ++ cProjectVersion ++ ":\n\t")
-      . s . showString "\n"
-
-    panicMsg :: ShowS -> ShowS
-    panicMsg s =
-        showString "panic! (the 'impossible' happened)\n"
-      . showString ("  (GHC version " ++ cProjectVersion ++ ":\n\t")
-      . s . showString "\n\n"
-      . showString "Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\n"
-
+showGhcException = showPlainGhcException . \case
+  Signal n -> PlainSignal n
+  UsageError str -> PlainUsageError str
+  CmdLineError str -> PlainCmdLineError str
+  Panic str -> PlainPanic str
+  Sorry str -> PlainSorry str
+  InstallationError str -> PlainInstallationError str
+  ProgramError str -> PlainProgramError str
+
+  PprPanic str sdoc -> PlainPanic $
+      concat [str, "\n\n", showSDocUnsafe sdoc]
+  PprSorry str sdoc -> PlainProgramError $
+      concat [str, "\n\n", showSDocUnsafe sdoc]
+  PprProgramError str sdoc -> PlainProgramError $
+      concat [str, "\n\n", showSDocUnsafe sdoc]
 
 throwGhcException :: GhcException -> a
 throwGhcException = Exception.throw
@@ -180,42 +157,11 @@ throwGhcExceptionIO = Exception.throwIO
 handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
 handleGhcException = ghandle
 
-
--- | Panics and asserts.
-panic, sorry, pgmError :: String -> a
-panic    x = unsafeDupablePerformIO $ do
-   stack <- ccsToStrings =<< getCurrentCCS x
-   if null stack
-      then throwGhcException (Panic x)
-      else throwGhcException (Panic (x ++ '\n' : renderStack stack))
-
-sorry    x = throwGhcException (Sorry x)
-pgmError x = throwGhcException (ProgramError x)
-
 panicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a
 panicDoc    x doc = throwGhcException (PprPanic        x doc)
 sorryDoc    x doc = throwGhcException (PprSorry        x doc)
 pgmErrorDoc x doc = throwGhcException (PprProgramError x doc)
 
-cmdLineError :: String -> a
-cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO
-
-cmdLineErrorIO :: String -> IO a
-cmdLineErrorIO x = do
-  stack <- ccsToStrings =<< getCurrentCCS x
-  if null stack
-    then throwGhcException (CmdLineError x)
-    else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack))
-
-
-
--- | Throw a failed assertion exception for a given filename and line number.
-assertPanic :: String -> Int -> a
-assertPanic file line =
-  Exception.throw (Exception.AssertionFailed
-           ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
-
-
 -- | Like try, but pass through UserInterrupt and Panic exceptions.
 --   Used when we want soft failures when reading interface files, for example.
 --   TODO: I'm not entirely sure if this is catching what we really want to catch
diff --git a/compiler/utils/PlainPanic.hs b/compiler/utils/PlainPanic.hs
new file mode 100644
index 0000000000..0892ebff7d
--- /dev/null
+++ b/compiler/utils/PlainPanic.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-}
+
+-- | Defines a simple exception type and utilities to throw it. The
+-- 'PlainGhcException' type is a subset of the 'Panic.GhcException'
+-- type.  It omits the exception constructors that involve
+-- pretty-printing via 'Outputable.SDoc'.
+--
+-- There are two reasons for this:
+--
+-- 1. To avoid import cycles / use of boot files. "Outputable" has
+-- many transitive dependencies. To throw exceptions from these
+-- modules, the functions here can be used without introducing import
+-- cycles.
+--
+-- 2. To reduce the number of modules that need to be compiled to
+-- object code when loading GHC into GHCi. See #13101
+module PlainPanic
+  ( PlainGhcException(..)
+  , showPlainGhcException
+
+  , panic, sorry, pgmError
+  , cmdLineError, cmdLineErrorIO
+  , assertPanic
+
+  , progName
+  ) where
+
+#include "HsVersions.h"
+
+import Config
+import Exception
+import GHC.Stack
+import GhcPrelude
+import System.Environment
+import System.IO.Unsafe
+
+-- | This type is very similar to 'Panic.GhcException', but it omits
+-- the constructors that involve pretty-printing via
+-- 'Outputable.SDoc'.  Due to the implementation of 'fromException'
+-- for 'Panic.GhcException', this type can be caught as a
+-- 'Panic.GhcException'.
+--
+-- Note that this should only be used for throwing exceptions, not for
+-- catching, as 'Panic.GhcException' will not be converted to this
+-- type when catching.
+data PlainGhcException
+  -- | Some other fatal signal (SIGHUP,SIGTERM)
+  = PlainSignal Int
+
+  -- | Prints the short usage msg after the error
+  | PlainUsageError        String
+
+  -- | A problem with the command line arguments, but don't print usage.
+  | PlainCmdLineError      String
+
+  -- | The 'impossible' happened.
+  | PlainPanic             String
+
+  -- | The user tickled something that's known not to work yet,
+  --   but we're not counting it as a bug.
+  | PlainSorry             String
+
+  -- | An installation problem.
+  | PlainInstallationError String
+
+  -- | An error in the user's code, probably.
+  | PlainProgramError      String
+
+instance Exception PlainGhcException
+
+instance Show PlainGhcException where
+  showsPrec _ e@(PlainProgramError _) = showPlainGhcException e
+  showsPrec _ e@(PlainCmdLineError _) = showString "<command line>: " . showPlainGhcException e
+  showsPrec _ e = showString progName . showString ": " . showPlainGhcException e
+
+-- | The name of this GHC.
+progName :: String
+progName = unsafePerformIO (getProgName)
+{-# NOINLINE progName #-}
+
+-- | Short usage information to display when we are given the wrong cmd line arguments.
+short_usage :: String
+short_usage = "Usage: For basic information, try the `--help' option."
+
+-- | Append a description of the given exception to this string.
+showPlainGhcException :: PlainGhcException -> ShowS
+showPlainGhcException =
+  \case
+    PlainSignal n -> showString "signal: " . shows n
+    PlainUsageError str -> showString str . showChar '\n' . showString short_usage
+    PlainCmdLineError str -> showString str
+    PlainPanic s -> panicMsg (showString s)
+    PlainSorry s -> sorryMsg (showString s)
+    PlainInstallationError str -> showString str
+    PlainProgramError str -> showString str
+  where
+    sorryMsg :: ShowS -> ShowS
+    sorryMsg s =
+        showString "sorry! (unimplemented feature or known bug)\n"
+      . showString ("  (GHC version " ++ cProjectVersion ++ ":\n\t")
+      . s . showString "\n"
+
+    panicMsg :: ShowS -> ShowS
+    panicMsg s =
+        showString "panic! (the 'impossible' happened)\n"
+      . showString ("  (GHC version " ++ cProjectVersion ++ ":\n\t")
+      . s . showString "\n\n"
+      . showString "Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\n"
+
+throwPlainGhcException :: PlainGhcException -> a
+throwPlainGhcException = Exception.throw
+
+-- | Panics and asserts.
+panic, sorry, pgmError :: String -> a
+panic    x = unsafeDupablePerformIO $ do
+   stack <- ccsToStrings =<< getCurrentCCS x
+   if null stack
+      then throwPlainGhcException (PlainPanic x)
+      else throwPlainGhcException (PlainPanic (x ++ '\n' : renderStack stack))
+
+sorry    x = throwPlainGhcException (PlainSorry x)
+pgmError x = throwPlainGhcException (PlainProgramError x)
+
+cmdLineError :: String -> a
+cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO
+
+cmdLineErrorIO :: String -> IO a
+cmdLineErrorIO x = do
+  stack <- ccsToStrings =<< getCurrentCCS x
+  if null stack
+    then throwPlainGhcException (PlainCmdLineError x)
+    else throwPlainGhcException (PlainCmdLineError (x ++ '\n' : renderStack stack))
+
+-- | Throw a failed assertion exception for a given filename and line number.
+assertPanic :: String -> Int -> a
+assertPanic file line =
+  Exception.throw (Exception.AssertionFailed
+           ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs
index 66518f95b6..5adfdd7699 100644
--- a/compiler/utils/Pretty.hs
+++ b/compiler/utils/Pretty.hs
@@ -115,7 +115,7 @@ import GhcPrelude hiding (error)
 
 import BufWrite
 import FastString
-import Panic
+import PlainPanic
 import System.IO
 import Numeric (showHex)
 
@@ -123,9 +123,6 @@ import Numeric (showHex)
 import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) )
 import GHC.Ptr  ( Ptr(..) )
 
--- Don't import Util( assertPanic ) because it makes a loop in the module structure
-
-
 -- ---------------------------------------------------------------------------
 -- The Doc calculus
 
diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs
index 64578bffde..98b8c19340 100644
--- a/compiler/utils/StringBuffer.hs
+++ b/compiler/utils/StringBuffer.hs
@@ -50,7 +50,7 @@ import GhcPrelude
 import Encoding
 import FastString
 import FastFunctions
-import Outputable
+import PlainPanic
 import Util
 
 import Data.Maybe
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index c07b87f547..4b8c47a2cf 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -134,7 +134,7 @@ module Util (
 import GhcPrelude
 
 import Exception
-import Panic
+import PlainPanic
 
 import Data.Data
 import Data.IORef       ( IORef, newIORef, atomicModifyIORef' )
diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs
index 867dd14fb0..27a9324438 100644
--- a/includes/CodeGen.Platform.hs
+++ b/includes/CodeGen.Platform.hs
@@ -2,7 +2,7 @@
 import CmmExpr
 #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \
     || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc))
-import Panic
+import PlainPanic
 #endif
 import Reg