Allow CallStacks to be frozen

This introduces "freezing," an operation which prevents further
locations from being appended to a CallStack.  Library authors may want
to prevent CallStacks from exposing implementation details, as a matter
of hygiene. For example, in

```
head [] = error "head: empty list"

ghci> head []
*** Exception: head: empty list
CallStack (from implicit params):
  error, called at ...
```

including the call-site of `error` in `head` is not strictly necessary
as the error message already specifies clearly where the error came
from.

So we add a function `freezeCallStack` that wraps an existing CallStack,
preventing further call-sites from being pushed onto it. In other words,

```
pushCallStack callSite (freezeCallStack callStack) = freezeCallStack callStack
```

Now we can define `head` to not produce a CallStack at all

```
head [] =
  let ?callStack = freezeCallStack emptyCallStack
  in error "head: empty list"

ghci> head []
*** Exception: head: empty list
CallStack (from implicit params):
  error, called at ...
```

---

1. We add the `freezeCallStack` and `emptyCallStack` and update the
   definition of `CallStack` to support this functionality.

2. We add `errorWithoutStackTrace`, a variant of `error` that does not
   produce a stack trace, using this feature. I think this is a sensible
   wrapper function to provide in case users want it.

3. We replace uses of `error` in base with `errorWithoutStackTrace`. The
   rationale is that base does not export any functions that use CallStacks
   (except for `error` and `undefined`) so there's no way for the stack
   traces (from Implicit CallStacks) to include user-defined functions.
   They'll only contain the call to `error` itself. As base already has a
   good habit of providing useful error messages that name the triggering
   function, the stack trace really just adds noise to the error. (I don't
   have a strong opinion on whether we should include this third commit,
   but the change was very mechanical so I thought I'd include it anyway in
   case there's interest)

4. Updates tests in `array` and `stm` submodules

Test Plan: ./validate, new test is T11049

Reviewers: simonpj, nomeata, goldfire, austin, hvr, bgamari

Reviewed By: simonpj

Subscribers: thomie

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D1628

GHC Trac Issues: #11049

63 files changed, 338 insertions, 229 deletions

diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs
index babe8d9a76..e047662a9c 100644
--- a/libraries/base/Control/Concurrent.hs
+++ b/libraries/base/Control/Concurrent.hs
@@ -412,7 +412,7 @@ threadWaitRead fd
                           return ()
                         -- hWaitForInput does work properly, but we can only
                         -- do this for stdin since we know its FD.
-                  _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"
+                  _ -> errorWithoutStackTrace "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"
 #else
   = GHC.Conc.threadWaitRead fd
 #endif
@@ -428,7 +428,7 @@ threadWaitWrite :: Fd -> IO ()
 threadWaitWrite fd
 #ifdef mingw32_HOST_OS
   | threaded  = withThread (waitFd fd 1)
-  | otherwise = error "threadWaitWrite requires -threaded on Windows"
+  | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows"
 #else
   = GHC.Conc.threadWaitWrite fd
 #endif
@@ -452,7 +452,7 @@ threadWaitReadSTM fd
                                         Just (Left e)   -> throwSTM (e :: IOException)
                   let killAction = return ()
                   return (waitAction, killAction)
-  | otherwise = error "threadWaitReadSTM requires -threaded on Windows"
+  | otherwise = errorWithoutStackTrace "threadWaitReadSTM requires -threaded on Windows"
 #else
   = GHC.Conc.threadWaitReadSTM fd
 #endif
@@ -476,7 +476,7 @@ threadWaitWriteSTM fd
                                         Just (Left e)   -> throwSTM (e :: IOException)
                   let killAction = return ()
                   return (waitAction, killAction)
-  | otherwise = error "threadWaitWriteSTM requires -threaded on Windows"
+  | otherwise = errorWithoutStackTrace "threadWaitWriteSTM requires -threaded on Windows"
 #else
   = GHC.Conc.threadWaitWriteSTM fd
 #endif
diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs
index ece5c69dd5..b609ef2095 100644
--- a/libraries/base/Control/Exception/Base.hs
+++ b/libraries/base/Control/Exception/Base.hs
@@ -401,8 +401,8 @@ recSelError, recConError, irrefutPatError, runtimeError,
 
 recSelError              s = throw (RecSelError ("No match in record selector "
                                                  ++ unpackCStringUtf8# s))  -- No location info unfortunately
-runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately
-absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)
+runtimeError             s = errorWithoutStackTrace (unpackCStringUtf8# s)                   -- No location info unfortunately
+absentError              s = errorWithoutStackTrace ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)
 
 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
 irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs
index ae37911c18..6b78e90c89 100644
--- a/libraries/base/Control/Monad/Fix.hs
+++ b/libraries/base/Control/Monad/Fix.hs
@@ -28,7 +28,7 @@ import Data.Function ( fix )
 import Data.Maybe
 import Data.Monoid ( Dual(..), Sum(..), Product(..)
                    , First(..), Last(..), Alt(..) )
-import GHC.Base ( Monad, error, (.) )
+import GHC.Base ( Monad, errorWithoutStackTrace, (.) )
 import GHC.List ( head, tail )
 import GHC.ST
 import System.IO
@@ -63,7 +63,7 @@ class (Monad m) => MonadFix m where
 instance MonadFix Maybe where
     mfix f = let a = f (unJust a) in a
              where unJust (Just x) = x
-                   unJust Nothing  = error "mfix Maybe: Nothing"
+                   unJust Nothing  = errorWithoutStackTrace "mfix Maybe: Nothing"
 
 instance MonadFix [] where
     mfix f = case fix (f . head) of
@@ -79,7 +79,7 @@ instance MonadFix ((->) r) where
 instance MonadFix (Either e) where
     mfix f = let a = f (unRight a) in a
              where unRight (Right x) = x
-                   unRight (Left  _) = error "mfix Either: Left"
+                   unRight (Left  _) = errorWithoutStackTrace "mfix Either: Left"
 
 instance MonadFix (ST s) where
         mfix = fixST
diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
index c99912e62d..51b1d86e09 100644
--- a/libraries/base/Control/Monad/ST/Lazy/Imp.hs
+++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
@@ -76,7 +76,7 @@ instance Applicative (ST s) where
 
 instance Monad (ST s) where
 
-        fail s   = error s
+        fail s   = errorWithoutStackTrace s
 
         (ST m) >>= k
          = ST $ \ s ->
diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs
index 9134e13ba8..3c319995b8 100644
--- a/libraries/base/Data/Bits.hs
+++ b/libraries/base/Data/Bits.hs
@@ -529,7 +529,7 @@ instance Bits Integer where
    rotate x i = shift x i   -- since an Integer never wraps around
 
    bitSizeMaybe _ = Nothing
-   bitSize _  = error "Data.Bits.bitSize(Integer)"
+   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
    isSigned _ = True
 
 -----------------------------------------------------------------------------
diff --git a/libraries/base/Data/Char.hs b/libraries/base/Data/Char.hs
index c8dd9331c6..69e4db7018 100644
--- a/libraries/base/Data/Char.hs
+++ b/libraries/base/Data/Char.hs
@@ -97,7 +97,7 @@ digitToInt c
   | (fromIntegral dec::Word) <= 9 = dec
   | (fromIntegral hexl::Word) <= 5 = hexl + 10
   | (fromIntegral hexu::Word) <= 5 = hexu + 10
-  | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
+  | otherwise = errorWithoutStackTrace ("Char.digitToInt: not a digit " ++ show c) -- sigh
   where
     dec = ord c - ord '0'
     hexl = ord c - ord 'a'
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs
index c242566276..88191c1011 100644
--- a/libraries/base/Data/Data.hs
+++ b/libraries/base/Data/Data.hs
@@ -444,7 +444,7 @@ newtype Mp m x = Mp { unMp :: m (x, Bool) }
 
 -- | Build a term skeleton
 fromConstr :: Data a => Constr -> a
-fromConstr = fromConstrB (error "Data.Data.fromConstr")
+fromConstr = fromConstrB (errorWithoutStackTrace "Data.Data.fromConstr")
 
 
 -- | Build a term and use a generic function for subterms
@@ -582,7 +582,7 @@ repConstr dt cr =
         (IntRep,    IntConstr i)      -> mkIntegralConstr dt i
         (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
         (CharRep,   CharConstr c)     -> mkCharConstr dt c
-        _ -> error "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."
+        _ -> errorWithoutStackTrace "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."
 
 
 
@@ -620,7 +620,7 @@ mkConstr dt str fields fix =
 dataTypeConstrs :: DataType -> [Constr]
 dataTypeConstrs dt = case datarep dt of
                         (AlgRep cons) -> cons
-                        _ -> error $ "Data.Data.dataTypeConstrs is not supported for "
+                        _ -> errorWithoutStackTrace $ "Data.Data.dataTypeConstrs is not supported for "
                                     ++ dataTypeName dt ++
                                     ", as it is not an algebraic data type."
 
@@ -695,7 +695,7 @@ isAlgType dt = case datarep dt of
 indexConstr :: DataType -> ConIndex -> Constr
 indexConstr dt idx = case datarep dt of
                         (AlgRep cs) -> cs !! (idx-1)
-                        _           -> error $ "Data.Data.indexConstr is not supported for "
+                        _           -> errorWithoutStackTrace $ "Data.Data.indexConstr is not supported for "
                                                ++ dataTypeName dt ++
                                                ", as it is not an algebraic data type."
 
@@ -704,7 +704,7 @@ indexConstr dt idx = case datarep dt of
 constrIndex :: Constr -> ConIndex
 constrIndex con = case constrRep con of
                     (AlgConstr idx) -> idx
-                    _ -> error $ "Data.Data.constrIndex is not supported for "
+                    _ -> errorWithoutStackTrace $ "Data.Data.constrIndex is not supported for "
                                  ++ dataTypeName (constrType con) ++
                                  ", as it is not an algebraic data type."
 
@@ -713,7 +713,7 @@ constrIndex con = case constrRep con of
 maxConstrIndex :: DataType -> ConIndex
 maxConstrIndex dt = case dataTypeRep dt of
                         AlgRep cs -> length cs
-                        _            -> error $ "Data.Data.maxConstrIndex is not supported for "
+                        _            -> errorWithoutStackTrace $ "Data.Data.maxConstrIndex is not supported for "
                                                  ++ dataTypeName dt ++
                                                  ", as it is not an algebraic data type."
 
@@ -755,21 +755,21 @@ mkPrimCon dt str cr = Constr
                         { datatype  = dt
                         , conrep    = cr
                         , constring = str
-                        , confields = error "Data.Data.confields"
-                        , confixity = error "Data.Data.confixity"
+                        , confields = errorWithoutStackTrace "Data.Data.confields"
+                        , confixity = errorWithoutStackTrace "Data.Data.confixity"
                         }
 
 mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
 mkIntegralConstr dt i = case datarep dt of
                   IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))
-                  _ -> error $ "Data.Data.mkIntegralConstr is not supported for "
+                  _ -> errorWithoutStackTrace $ "Data.Data.mkIntegralConstr is not supported for "
                                ++ dataTypeName dt ++
                                ", as it is not an Integral data type."
 
 mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
 mkRealConstr dt f = case datarep dt of
                     FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
-                    _ -> error $ "Data.Data.mkRealConstr is not supported for "
+                    _ -> errorWithoutStackTrace $ "Data.Data.mkRealConstr is not supported for "
                                  ++ dataTypeName dt ++
                                  ", as it is not an Real data type."
 
@@ -777,7 +777,7 @@ mkRealConstr dt f = case datarep dt of
 mkCharConstr :: DataType -> Char -> Constr
 mkCharConstr dt c = case datarep dt of
                    CharRep -> mkPrimCon dt (show c) (CharConstr c)
-                   _ -> error $ "Data.Data.mkCharConstr is not supported for "
+                   _ -> errorWithoutStackTrace $ "Data.Data.mkCharConstr is not supported for "
                                 ++ dataTypeName dt ++
                                 ", as it is not an Char data type."
 
@@ -856,7 +856,7 @@ instance Data Bool where
   gunfold _ z c  = case constrIndex c of
                      1 -> z False
                      2 -> z True
-                     _ -> error $ "Data.Data.gunfold: Constructor "
+                     _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor "
                                   ++ show c
                                   ++ " is not of type Bool."
   dataTypeOf _ = boolDataType
@@ -871,7 +871,7 @@ instance Data Char where
   toConstr x = mkCharConstr charType x
   gunfold _ z c = case constrRep c of
                     (CharConstr x) -> z x
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Char."
   dataTypeOf _ = charType
 
@@ -885,7 +885,7 @@ instance Data Float where
   toConstr = mkRealConstr floatType
   gunfold _ z c = case constrRep c of
                     (FloatConstr x) -> z (realToFrac x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Float."
   dataTypeOf _ = floatType
 
@@ -899,7 +899,7 @@ instance Data Double where
   toConstr = mkRealConstr doubleType
   gunfold _ z c = case constrRep c of
                     (FloatConstr x) -> z (realToFrac x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Double."
   dataTypeOf _ = doubleType
 
@@ -913,7 +913,7 @@ instance Data Int where
   toConstr x = mkIntegralConstr intType x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Int."
   dataTypeOf _ = intType
 
@@ -927,7 +927,7 @@ instance Data Integer where
   toConstr = mkIntegralConstr integerType
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z x
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Integer."
   dataTypeOf _ = integerType
 
@@ -941,7 +941,7 @@ instance Data Int8 where
   toConstr x = mkIntegralConstr int8Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Int8."
   dataTypeOf _ = int8Type
 
@@ -955,7 +955,7 @@ instance Data Int16 where
   toConstr x = mkIntegralConstr int16Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Int16."
   dataTypeOf _ = int16Type
 
@@ -969,7 +969,7 @@ instance Data Int32 where
   toConstr x = mkIntegralConstr int32Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Int32."
   dataTypeOf _ = int32Type
 
@@ -983,7 +983,7 @@ instance Data Int64 where
   toConstr x = mkIntegralConstr int64Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Int64."
   dataTypeOf _ = int64Type
 
@@ -997,7 +997,7 @@ instance Data Word where
   toConstr x = mkIntegralConstr wordType x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Word"
   dataTypeOf _ = wordType
 
@@ -1011,7 +1011,7 @@ instance Data Word8 where
   toConstr x = mkIntegralConstr word8Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Word8."
   dataTypeOf _ = word8Type
 
@@ -1025,7 +1025,7 @@ instance Data Word16 where
   toConstr x = mkIntegralConstr word16Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Word16."
   dataTypeOf _ = word16Type
 
@@ -1039,7 +1039,7 @@ instance Data Word32 where
   toConstr x = mkIntegralConstr word32Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Word32."
   dataTypeOf _ = word32Type
 
@@ -1053,7 +1053,7 @@ instance Data Word64 where
   toConstr x = mkIntegralConstr word64Type x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Word64."
   dataTypeOf _ = word64Type
 
@@ -1070,7 +1070,7 @@ instance (Data a, Integral a) => Data (Ratio a) where
   gfoldl k z (a :% b) = z (%) `k` a `k` b
   toConstr _ = ratioConstr
   gunfold k z c | constrIndex c == 1 = k (k (z (%)))
-  gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"
+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(Ratio)"
   dataTypeOf _  = ratioDataType
 
 
@@ -1092,7 +1092,7 @@ instance Data a => Data [a] where
   gunfold k z c = case constrIndex c of
                     1 -> z []
                     2 -> k (k (z (:)))
-                    _ -> error "Data.Data.gunfold(List)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(List)"
   dataTypeOf _ = listDataType
   dataCast1 f  = gcast1 f
 
@@ -1126,7 +1126,7 @@ instance Data a => Data (Maybe a) where
   gunfold k z c = case constrIndex c of
                     1 -> z Nothing
                     2 -> k (z Just)
-                    _ -> error "Data.Data.gunfold(Maybe)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Maybe)"
   dataTypeOf _ = maybeDataType
   dataCast1 f  = gcast1 f
 
@@ -1154,7 +1154,7 @@ instance Data Ordering where
                     1 -> z LT
                     2 -> z EQ
                     3 -> z GT
-                    _ -> error "Data.Data.gunfold(Ordering)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Ordering)"
   dataTypeOf _ = orderingDataType
 
 
@@ -1177,7 +1177,7 @@ instance (Data a, Data b) => Data (Either a b) where
   gunfold k z c = case constrIndex c of
                     1 -> k (z Left)
                     2 -> k (z Right)
-                    _ -> error "Data.Data.gunfold(Either)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Either)"
   dataTypeOf _ = eitherDataType
   dataCast2 f  = gcast2 f
 
@@ -1193,7 +1193,7 @@ tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
 instance Data () where
   toConstr ()   = tuple0Constr
   gunfold _ z c | constrIndex c == 1 = z ()
-  gunfold _ _ _ = error "Data.Data.gunfold(unit)"
+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(unit)"
   dataTypeOf _  = tuple0DataType
 
 
@@ -1209,7 +1209,7 @@ instance (Data a, Data b) => Data (a,b) where
   gfoldl f z (a,b) = z (,) `f` a `f` b
   toConstr (_,_) = tuple2Constr
   gunfold k z c | constrIndex c == 1 = k (k (z (,)))
-  gunfold _ _ _ = error "Data.Data.gunfold(tup2)"
+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(tup2)"
   dataTypeOf _  = tuple2DataType
   dataCast2 f   = gcast2 f
 
@@ -1226,7 +1226,7 @@ instance (Data a, Data b, Data c) => Data (a,b,c) where
   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
   toConstr (_,_,_) = tuple3Constr
   gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
-  gunfold _ _ _ = error "Data.Data.gunfold(tup3)"
+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(tup3)"
   dataTypeOf _  = tuple3DataType
 
 
@@ -1244,7 +1244,7 @@ instance (Data a, Data b, Data c, Data d)
   toConstr (_,_,_,_) = tuple4Constr
   gunfold k z c = case constrIndex c of
                     1 -> k (k (k (k (z (,,,)))))
-                    _ -> error "Data.Data.gunfold(tup4)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup4)"
   dataTypeOf _ = tuple4DataType
 
 
@@ -1262,7 +1262,7 @@ instance (Data a, Data b, Data c, Data d, Data e)
   toConstr (_,_,_,_,_) = tuple5Constr
   gunfold k z c = case constrIndex c of
                     1 -> k (k (k (k (k (z (,,,,))))))
-                    _ -> error "Data.Data.gunfold(tup5)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup5)"
   dataTypeOf _ = tuple5DataType
 
 
@@ -1280,7 +1280,7 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f)
   toConstr (_,_,_,_,_,_) = tuple6Constr
   gunfold k z c = case constrIndex c of
                     1 -> k (k (k (k (k (k (z (,,,,,)))))))
-                    _ -> error "Data.Data.gunfold(tup6)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup6)"
   dataTypeOf _ = tuple6DataType
 
 
@@ -1299,23 +1299,23 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
   toConstr  (_,_,_,_,_,_,_) = tuple7Constr
   gunfold k z c = case constrIndex c of
                     1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
-                    _ -> error "Data.Data.gunfold(tup7)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup7)"
   dataTypeOf _ = tuple7DataType
 
 
 ------------------------------------------------------------------------------
 
 instance Data a => Data (Ptr a) where
-  toConstr _   = error "Data.Data.toConstr(Ptr)"
-  gunfold _ _  = error "Data.Data.gunfold(Ptr)"
+  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Ptr)"
+  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Ptr)"
   dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"
   dataCast1 x  = gcast1 x
 
 ------------------------------------------------------------------------------
 
 instance Data a => Data (ForeignPtr a) where
-  toConstr _   = error "Data.Data.toConstr(ForeignPtr)"
-  gunfold _ _  = error "Data.Data.gunfold(ForeignPtr)"
+  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(ForeignPtr)"
+  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(ForeignPtr)"
   dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"
   dataCast1 x  = gcast1 x
 
@@ -1325,8 +1325,8 @@ instance Data a => Data (ForeignPtr a) where
 instance (Data a, Data b, Ix a) => Data (Array a b)
  where
   gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
-  toConstr _   = error "Data.Data.toConstr(Array)"
-  gunfold _ _  = error "Data.Data.gunfold(Array)"
+  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Array)"
+  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Array)"
   dataTypeOf _ = mkNoRepType "Data.Array.Array"
   dataCast2 x  = gcast2 x
 
@@ -1344,7 +1344,7 @@ instance (Data t) => Data (Proxy t) where
   toConstr Proxy  = proxyConstr
   gunfold _ z c = case constrIndex c of
                     1 -> z Proxy
-                    _ -> error "Data.Data.gunfold(Proxy)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Proxy)"
   dataTypeOf _ = proxyDataType
   dataCast1 f  = gcast1 f
 
@@ -1362,7 +1362,7 @@ instance (a ~ b, Data a) => Data (a :~: b) where
   toConstr Refl   = reflConstr
   gunfold _ z c   = case constrIndex c of
                       1 -> z Refl
-                      _ -> error "Data.Data.gunfold(:~:)"
+                      _ -> errorWithoutStackTrace "Data.Data.gunfold(:~:)"
   dataTypeOf _    = equalityDataType
   dataCast2 f     = gcast2 f
 
@@ -1380,7 +1380,7 @@ instance (Coercible a b, Data a, Data b) => Data (Coercion a b) where
   toConstr Coercion = coercionConstr
   gunfold _ z c   = case constrIndex c of
                       1 -> z Coercion
-                      _ -> error "Data.Data.gunfold(Coercion)"
+                      _ -> errorWithoutStackTrace "Data.Data.gunfold(Coercion)"
   dataTypeOf _    = coercionDataType
   dataCast2 f     = gcast2 f
 
@@ -1398,7 +1398,7 @@ instance Data Version where
   toConstr (Version _ _) = versionConstr
   gunfold k z c = case constrIndex c of
                     1 -> k (k (z Version))
-                    _ -> error "Data.Data.gunfold(Version)"
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Version)"
   dataTypeOf _  = versionDataType
 
 -----------------------------------------------------------------------
diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs
index e7daf4614e..55082ff3be 100644
--- a/libraries/base/Data/Dynamic.hs
+++ b/libraries/base/Data/Dynamic.hs
@@ -135,7 +135,7 @@ dynApply (Dynamic t1 f) (Dynamic t2 x) =
 dynApp :: Dynamic -> Dynamic -> Dynamic
 dynApp f x = case dynApply f x of 
              Just r -> r
-             Nothing -> error ("Type error in dynamic application.\n" ++
+             Nothing -> errorWithoutStackTrace ("Type error in dynamic application.\n" ++
                                "Can't apply function " ++ show f ++
                                " to argument " ++ show x)
 
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
index 24b6dd18c2..722b68f694 100644
--- a/libraries/base/Data/Foldable.hs
+++ b/libraries/base/Data/Foldable.hs
@@ -156,7 +156,7 @@ class Foldable t where
     --
     -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@
     foldr1 :: (a -> a -> a) -> t a -> a
-    foldr1 f xs = fromMaybe (error "foldr1: empty structure")
+    foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure")
                     (foldr mf Nothing xs)
       where
         mf x m = Just (case m of
@@ -168,7 +168,7 @@ class Foldable t where
     --
     -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@
     foldl1 :: (a -> a -> a) -> t a -> a
-    foldl1 f xs = fromMaybe (error "foldl1: empty structure")
+    foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure")
                     (foldl mf Nothing xs)
       where
         mf m y = Just (case m of
@@ -198,12 +198,12 @@ class Foldable t where
 
     -- | The largest element of a non-empty structure.
     maximum :: forall a . Ord a => t a -> a
-    maximum = fromMaybe (error "maximum: empty structure") .
+    maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") .
        getMax . foldMap (Max #. (Just :: a -> Maybe a))
 
     -- | The least element of a non-empty structure.
     minimum :: forall a . Ord a => t a -> a
-    minimum = fromMaybe (error "minimum: empty structure") .
+    minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .
        getMin . foldMap (Min #. (Just :: a -> Maybe a))
 
     -- | The 'sum' function computes the sum of the numbers of a structure.
@@ -276,8 +276,8 @@ instance Foldable Proxy where
     {-# INLINE foldr #-}
     foldl _ z _ = z
     {-# INLINE foldl #-}
-    foldl1 _ _ = error "foldl1: Proxy"
-    foldr1 _ _ = error "foldr1: Proxy"
+    foldl1 _ _ = errorWithoutStackTrace "foldl1: Proxy"
+    foldr1 _ _ = errorWithoutStackTrace "foldr1: Proxy"
     length _   = 0
     null _     = True
     elem _ _   = False
diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs
index 155383648f..2218fc8e17 100644
--- a/libraries/base/Data/List/NonEmpty.hs
+++ b/libraries/base/Data/List/NonEmpty.hs
@@ -231,7 +231,7 @@ sort = lift List.sort
 -- Raises an error if given an empty list.
 fromList :: [a] -> NonEmpty a
 fromList (a:as) = a :| as
-fromList [] = error "NonEmpty.fromList: empty list"
+fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"
 
 -- | Convert a stream to a normal list efficiently.
 toList :: NonEmpty a -> [a]
@@ -440,7 +440,7 @@ isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs
 (!!) ~(x :| xs) n
   | n == 0 = x
   | n > 0  = xs List.!! (n - 1)
-  | otherwise = error "NonEmpty.!! negative argument"
+  | otherwise = errorWithoutStackTrace "NonEmpty.!! negative argument"
 
 -- | The 'zip' function takes two streams and returns a stream of
 -- corresponding pairs.
diff --git a/libraries/base/Data/Maybe.hs b/libraries/base/Data/Maybe.hs
index 3d9a5a9f36..e81cdf7a4c 100644
--- a/libraries/base/Data/Maybe.hs
+++ b/libraries/base/Data/Maybe.hs
@@ -144,7 +144,7 @@ isNothing _       = False
 -- *** Exception: Maybe.fromJust: Nothing
 --
 fromJust          :: Maybe a -> a
-fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck
+fromJust Nothing  = errorWithoutStackTrace "Maybe.fromJust: Nothing" -- yuck
 fromJust (Just x) = x
 
 -- | The 'fromMaybe' function takes a default value and and 'Maybe'
diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs
index be894c0877..1846182c95 100644
--- a/libraries/base/Data/OldList.hs
+++ b/libraries/base/Data/OldList.hs
@@ -563,7 +563,7 @@ insertBy cmp x ys@(y:ys')
 -- and returns the greatest element of the list by the comparison function.
 -- The list must be finite and non-empty.
 maximumBy               :: (a -> a -> Ordering) -> [a] -> a
-maximumBy _ []          =  error "List.maximumBy: empty list"
+maximumBy _ []          =  errorWithoutStackTrace "List.maximumBy: empty list"
 maximumBy cmp xs        =  foldl1 maxBy xs
                         where
                            maxBy x y = case cmp x y of
@@ -574,7 +574,7 @@ maximumBy cmp xs        =  foldl1 maxBy xs
 -- and returns the least element of the list by the comparison function.
 -- The list must be finite and non-empty.
 minimumBy               :: (a -> a -> Ordering) -> [a] -> a
-minimumBy _ []          =  error "List.minimumBy: empty list"
+minimumBy _ []          =  errorWithoutStackTrace "List.minimumBy: empty list"
 minimumBy cmp xs        =  foldl1 minBy xs
                         where
                            minBy x y = case cmp x y of
@@ -629,8 +629,8 @@ genericIndex :: (Integral i) => [a] -> i -> a
 genericIndex (x:_)  0 = x
 genericIndex (_:xs) n
  | n > 0     = genericIndex xs (n-1)
- | otherwise = error "List.genericIndex: negative argument."
-genericIndex _ _      = error "List.genericIndex: index too large."
+ | otherwise = errorWithoutStackTrace "List.genericIndex: negative argument."
+genericIndex _ _      = errorWithoutStackTrace "List.genericIndex: index too large."
 
 -- | The 'genericReplicate' function is an overloaded version of 'replicate',
 -- which accepts any 'Integral' value as the number of repetitions to make.
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
index 2dad8e4e78..9f602ea0c8 100644
--- a/libraries/base/Data/Proxy.hs
+++ b/libraries/base/Data/Proxy.hs
@@ -52,11 +52,11 @@ instance Read (Proxy s) where
   readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])
 
 instance Enum (Proxy s) where
-    succ _               = error "Proxy.succ"
-    pred _               = error "Proxy.pred"
+    succ _               = errorWithoutStackTrace "Proxy.succ"
+    pred _               = errorWithoutStackTrace "Proxy.pred"
     fromEnum _           = 0
     toEnum 0             = Proxy
-    toEnum _             = error "Proxy.toEnum: 0 expected"
+    toEnum _             = errorWithoutStackTrace "Proxy.toEnum: 0 expected"
     enumFrom _           = [Proxy]
     enumFromThen _ _     = [Proxy]
     enumFromThenTo _ _ _ = [Proxy]
diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs
index 0cd556d6fc..6fa0cd85d6 100644
--- a/libraries/base/Data/Semigroup.hs
+++ b/libraries/base/Data/Semigroup.hs
@@ -125,7 +125,7 @@ class Semigroup a where
   -- respectively.
   stimes :: Integral b => b -> a -> a
   stimes y0 x0
-    | y0 <= 0   = error "stimes: positive multiplier expected"
+    | y0 <= 0   = errorWithoutStackTrace "stimes: positive multiplier expected"
     | otherwise = f x0 y0
     where
       f x y
@@ -154,7 +154,7 @@ instance Semigroup b => Semigroup (a -> b) where
 instance Semigroup [a] where
   (<>) = (++)
   stimes n x
-    | n < 0 = error "stimes: [], negative multiplier"
+    | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier"
     | otherwise = rep n
     where
       rep 0 = []
@@ -166,7 +166,7 @@ instance Semigroup a => Semigroup (Maybe a) where
   Just a  <> Just b  = Just (a <> b)
   stimes _ Nothing  = Nothing
   stimes n (Just a) = case compare n 0 of
-    LT -> error "stimes: Maybe, negative multiplier"
+    LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"
     EQ -> Nothing
     GT -> Just (stimes n a)
 
@@ -231,7 +231,7 @@ instance Num a => Semigroup (Product a) where
 -- and so it should be preferred where possible.
 stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
 stimesMonoid n x0 = case compare n 0 of
-  LT -> error "stimesMonoid: negative multiplier"
+  LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"
   EQ -> mempty
   GT -> f x0 n
     where
@@ -250,7 +250,7 @@ stimesMonoid n x0 = case compare n 0 of
 -- works in /O(1)/ rather than /O(log n)/
 stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
 stimesIdempotentMonoid n x = case compare n 0 of
-  LT -> error "stimesIdempotentMonoid: negative multiplier"
+  LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"
   EQ -> mempty
   GT -> x
 
@@ -260,7 +260,7 @@ stimesIdempotentMonoid n x = case compare n 0 of
 -- works in /O(1)/ rather than /O(log n)/.
 stimesIdempotent :: Integral b => b -> a -> a
 stimesIdempotent n x
-  | n <= 0 = error "stimesIdempotent: positive multiplier expected"
+  | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"
   | otherwise = x
 
 instance Semigroup a => Semigroup (Const a b) where
@@ -616,7 +616,7 @@ instance Semigroup a => Semigroup (Option a) where
 
   stimes _ (Option Nothing) = Option Nothing
   stimes n (Option (Just a)) = case compare n 0 of
-    LT -> error "stimes: Option, negative multiplier"
+    LT -> errorWithoutStackTrace "stimes: Option, negative multiplier"
     EQ -> Option Nothing
     GT -> Option (Just (stimes n a))
 
diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs
index c85af5b282..cc34683f62 100644
--- a/libraries/base/Data/Type/Coercion.hs
+++ b/libraries/base/Data/Type/Coercion.hs
@@ -77,7 +77,7 @@ instance Coercible a b => Read (Coercion a b) where
 
 instance Coercible a b => Enum (Coercion a b) where
   toEnum 0 = Coercion
-  toEnum _ = error "Data.Type.Coercion.toEnum: bad argument"
+  toEnum _ = errorWithoutStackTrace "Data.Type.Coercion.toEnum: bad argument"
 
   fromEnum Coercion = 0
 
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
index 027a80092b..a72e268a71 100644
--- a/libraries/base/Data/Type/Equality.hs
+++ b/libraries/base/Data/Type/Equality.hs
@@ -122,7 +122,7 @@ instance a ~ b => Read (a :~: b) where
 
 instance a ~ b => Enum (a :~: b) where
   toEnum 0 = Refl
-  toEnum _ = error "Data.Type.Equality.toEnum: bad argument"
+  toEnum _ = errorWithoutStackTrace "Data.Type.Equality.toEnum: bad argument"
 
   fromEnum Refl = 0
 
diff --git a/libraries/base/GHC/Arr.hs b/libraries/base/GHC/Arr.hs
index 6b3a923dbc..c736f56c66 100644
--- a/libraries/base/GHC/Arr.hs
+++ b/libraries/base/GHC/Arr.hs
@@ -173,13 +173,13 @@ can do better, so we override the default method for index.
 {-# NOINLINE indexError #-}
 indexError :: Show a => (a,a) -> a -> String -> b
 indexError rng i tp
-  = error (showString "Ix{" . showString tp . showString "}.index: Index " .
+  = errorWithoutStackTrace (showString "Ix{" . showString tp . showString "}.index: Index " .
            showParen True (showsPrec 0 i) .
            showString " out of range " $
            showParen True (showsPrec 0 rng) "")
 
 hopelessIndexError :: Int -- Try to use 'indexError' instead!
-hopelessIndexError = error "Error in array index"
+hopelessIndexError = errorWithoutStackTrace "Error in array index"
 
 ----------------------------------------------------------------------
 instance  Ix Char  where
@@ -399,7 +399,7 @@ instance Eq (STArray s i e) where
 
 {-# NOINLINE arrEleBottom #-}
 arrEleBottom :: a
-arrEleBottom = error "(Array.!): undefined array element"
+arrEleBottom = errorWithoutStackTrace "(Array.!): undefined array element"
 
 -- | Construct an array with the specified bounds and containing values
 -- for given indices within these bounds.
@@ -504,7 +504,7 @@ safeRangeSize (l,u) = let r = rangeSize (l, u)
 
 -- Don't inline this error message everywhere!!
 negRange :: Int   -- Uninformative, but Ix does not provide Show
-negRange = error "Negative range size"
+negRange = errorWithoutStackTrace "Negative range size"
 
 {-# INLINE[1] safeIndex #-}
 -- See Note [Double bounds-checking of index values]
@@ -531,7 +531,7 @@ lessSafeIndex (l,u) _ i = index (l,u) i
 
 -- Don't inline this long error message everywhere!!
 badSafeIndex :: Int -> Int -> Int
-badSafeIndex i' n = error ("Error in array index; " ++ show i' ++
+badSafeIndex i' n = errorWithoutStackTrace ("Error in array index; " ++ show i' ++
                         " not in range [0.." ++ show n ++ ")")
 
 {-# INLINE unsafeAt #-}
@@ -604,7 +604,7 @@ foldl1Elems f = \ arr@(Array _ _ n _) ->
     go i | i == 0    = unsafeAt arr 0
          | otherwise = f (go (i-1)) (unsafeAt arr i)
   in
-    if n == 0 then error "foldl1: empty Array" else go (n-1)
+    if n == 0 then errorWithoutStackTrace "foldl1: empty Array" else go (n-1)
 
 -- | A right fold over the elements with no starting value
 {-# INLINABLE foldr1Elems #-}
@@ -614,7 +614,7 @@ foldr1Elems f = \ arr@(Array _ _ n _) ->
     go i | i == n-1  = unsafeAt arr i
          | otherwise = f (unsafeAt arr i) (go (i + 1))
   in
-    if n == 0 then error "foldr1: empty Array" else go 0
+    if n == 0 then errorWithoutStackTrace "foldr1: empty Array" else go 0
 
 -- | The list of associations of an array in index order.
 {-# INLINE assocs #-}
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 89ec703163..92a1ac39f7 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -187,8 +187,8 @@ not True = False
 (&&) True True = True
 otherwise = True
 
-build = error "urk"
-foldr = error "urk"
+build = errorWithoutStackTrace "urk"
+foldr = errorWithoutStackTrace "urk"
 #endif
 
 -- | The 'Maybe' type encapsulates an optional value.  A value of type
@@ -498,7 +498,7 @@ class Applicative m => Monad m where
     -- details). The definition here will be removed in a future
     -- release.
     fail        :: String -> m a
-    fail s      = error s
+    fail s      = errorWithoutStackTrace s
 
 {- Note [Recursive bindings for Applicative/Monad]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/libraries/base/GHC/Char.hs b/libraries/base/GHC/Char.hs
index 4928f21e96..c2f4ec4fe5 100644
--- a/libraries/base/GHC/Char.hs
+++ b/libraries/base/GHC/Char.hs
@@ -11,5 +11,5 @@ chr :: Int -> Char
 chr i@(I# i#)
  | isTrue# (int2Word# i# `leWord#` 0x10FFFF##) = C# (chr# i#)
  | otherwise
-    = error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
+    = errorWithoutStackTrace ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
 
diff --git a/libraries/base/GHC/Conc/IO.hs b/libraries/base/GHC/Conc/IO.hs
index b2c96b9fdb..1e9ffd58f0 100644
--- a/libraries/base/GHC/Conc/IO.hs
+++ b/libraries/base/GHC/Conc/IO.hs
@@ -198,6 +198,6 @@ registerDelay usecs
 #else
   | threaded = Event.registerDelay usecs
 #endif
-  | otherwise = error "registerDelay: requires -threaded"
+  | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded"
 
 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
diff --git a/libraries/base/GHC/Conc/Signal.hs b/libraries/base/GHC/Conc/Signal.hs
index 4afccf2496..e5cb5e3e43 100644
--- a/libraries/base/GHC/Conc/Signal.hs
+++ b/libraries/base/GHC/Conc/Signal.hs
@@ -55,7 +55,7 @@ setHandler sig handler = do
   let int = fromIntegral sig
   withMVar signal_handlers $ \arr ->
     if not (inRange (boundsIOArray arr) int)
-      then error "GHC.Conc.setHandler: signal out of range"
+      then errorWithoutStackTrace "GHC.Conc.setHandler: signal out of range"
       else do old <- unsafeReadIOArray arr int
               unsafeWriteIOArray arr int handler
               return old
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index 5e277332d0..e1d894a8c1 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -766,7 +766,7 @@ alwaysSucceeds i = do ( i >> retry ) `orElse` ( return () )
 -- False or raising an exception are both treated as invariant failures.
 always :: STM Bool -> STM ()
 always i = alwaysSucceeds ( do v <- i
-                               if (v) then return () else ( error "Transactional invariant violation" ) )
+                               if (v) then return () else ( errorWithoutStackTrace "Transactional invariant violation" ) )
 
 -- |Shared memory locations that support atomic memory transactions.
 data TVar a = TVar (TVar# RealWorld a)
diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs
index 8913a65907..4cbb8cadc2 100644
--- a/libraries/base/GHC/Conc/Windows.hs
+++ b/libraries/base/GHC/Conc/Windows.hs
@@ -123,7 +123,7 @@ threadDelay time
 registerDelay :: Int -> IO (TVar Bool)
 registerDelay usecs
   | threaded = waitForDelayEventSTM usecs
-  | otherwise = error "registerDelay: requires -threaded"
+  | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded"
 
 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 
@@ -299,7 +299,7 @@ toWin32ConsoleEvent ev =
        _ -> Nothing
 
 win32ConsoleHandler :: MVar (ConsoleEvent -> IO ())
-win32ConsoleHandler = unsafePerformIO (newMVar (error "win32ConsoleHandler"))
+win32ConsoleHandler = unsafePerformIO (newMVar (errorWithoutStackTrace "win32ConsoleHandler"))
 
 wakeupIOManager :: IO ()
 wakeupIOManager = c_sendIOManagerEvent io_MANAGER_WAKEUP
diff --git a/libraries/base/GHC/ConsoleHandler.hs b/libraries/base/GHC/ConsoleHandler.hs
index 609eb2005c..6d1e36f4ab 100644
--- a/libraries/base/GHC/ConsoleHandler.hs
+++ b/libraries/base/GHC/ConsoleHandler.hs
@@ -96,7 +96,7 @@ installHandler handler
           STG_SIG_DFL -> return Default
           STG_SIG_IGN -> return Ignore
           STG_SIG_HAN -> return (Catch old_h)
-          _           -> error "installHandler: Bad threaded rc value"
+          _           -> errorWithoutStackTrace "installHandler: Bad threaded rc value"
       return (new_h, prev_handler)
 
   | otherwise =
@@ -118,7 +118,7 @@ installHandler handler
          -- stable pointer is no longer in use, free it.
         freeStablePtr osptr
         return (Catch (\ ev -> oldh (fromConsoleEvent ev)))
-     _           -> error "installHandler: Bad non-threaded rc value"
+     _           -> errorWithoutStackTrace "installHandler: Bad non-threaded rc value"
   where
    fromConsoleEvent ev =
      case ev of
@@ -135,7 +135,7 @@ installHandler handler
         Just x  -> hdlr x >> rts_ConsoleHandlerDone ev
         Nothing -> return () -- silently ignore..
 
-   no_handler = error "win32ConsoleHandler"
+   no_handler = errorWithoutStackTrace "win32ConsoleHandler"
 
 foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool
 
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs
index dcda47b9fb..729b801dcf 100644
--- a/libraries/base/GHC/Enum.hs
+++ b/libraries/base/GHC/Enum.hs
@@ -123,7 +123,7 @@ boundedEnumFromThen n1 n2
 {-# NOINLINE toEnumError #-}
 toEnumError :: (Show a) => String -> Int -> (a,a) -> b
 toEnumError inst_ty i bnds =
-    error $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++
+    errorWithoutStackTrace $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++
             show i ++
             ") is outside of bounds " ++
             show bnds
@@ -131,7 +131,7 @@ toEnumError inst_ty i bnds =
 {-# NOINLINE fromEnumError #-}
 fromEnumError :: (Show a) => String -> a -> b
 fromEnumError inst_ty x =
-    error $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++
+    errorWithoutStackTrace $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++
             show x ++
             ") is outside of Int's bounds " ++
             show (minBound::Int, maxBound::Int)
@@ -139,12 +139,12 @@ fromEnumError inst_ty x =
 {-# NOINLINE succError #-}
 succError :: String -> a
 succError inst_ty =
-    error $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound"
+    errorWithoutStackTrace $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound"
 
 {-# NOINLINE predError #-}
 predError :: String -> a
 predError inst_ty =
-    error $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound"
+    errorWithoutStackTrace $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound"
 
 ------------------------------------------------------------------------
 -- Tuples
@@ -155,11 +155,11 @@ instance Bounded () where
     maxBound = ()
 
 instance Enum () where
-    succ _      = error "Prelude.Enum.().succ: bad argument"
-    pred _      = error "Prelude.Enum.().pred: bad argument"
+    succ _      = errorWithoutStackTrace "Prelude.Enum.().succ: bad argument"
+    pred _      = errorWithoutStackTrace "Prelude.Enum.().pred: bad argument"
 
     toEnum x | x == 0    = ()
-             | otherwise = error "Prelude.Enum.().toEnum: bad argument"
+             | otherwise = errorWithoutStackTrace "Prelude.Enum.().toEnum: bad argument"
 
     fromEnum () = 0
     enumFrom ()         = [()]
@@ -266,14 +266,14 @@ instance Bounded Bool where
 
 instance Enum Bool where
   succ False = True
-  succ True  = error "Prelude.Enum.Bool.succ: bad argument"
+  succ True  = errorWithoutStackTrace "Prelude.Enum.Bool.succ: bad argument"
 
   pred True  = False
-  pred False  = error "Prelude.Enum.Bool.pred: bad argument"
+  pred False  = errorWithoutStackTrace "Prelude.Enum.Bool.pred: bad argument"
 
   toEnum n | n == 0    = False
            | n == 1    = True
-           | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument"
+           | otherwise = errorWithoutStackTrace "Prelude.Enum.Bool.toEnum: bad argument"
 
   fromEnum False = 0
   fromEnum True  = 1
@@ -293,16 +293,16 @@ instance Bounded Ordering where
 instance Enum Ordering where
   succ LT = EQ
   succ EQ = GT
-  succ GT = error "Prelude.Enum.Ordering.succ: bad argument"
+  succ GT = errorWithoutStackTrace "Prelude.Enum.Ordering.succ: bad argument"
 
   pred GT = EQ
   pred EQ = LT
-  pred LT = error "Prelude.Enum.Ordering.pred: bad argument"
+  pred LT = errorWithoutStackTrace "Prelude.Enum.Ordering.pred: bad argument"
 
   toEnum n | n == 0 = LT
            | n == 1 = EQ
            | n == 2 = GT
-  toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument"
+  toEnum _ = errorWithoutStackTrace "Prelude.Enum.Ordering.toEnum: bad argument"
 
   fromEnum LT = 0
   fromEnum EQ = 1
@@ -323,10 +323,10 @@ instance  Bounded Char  where
 instance  Enum Char  where
     succ (C# c#)
        | isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
-       | otherwise             = error ("Prelude.Enum.Char.succ: bad argument")
+       | otherwise             = errorWithoutStackTrace ("Prelude.Enum.Char.succ: bad argument")
     pred (C# c#)
        | isTrue# (ord# c# /=# 0#) = C# (chr# (ord# c# -# 1#))
-       | otherwise                = error ("Prelude.Enum.Char.pred: bad argument")
+       | otherwise                = errorWithoutStackTrace ("Prelude.Enum.Char.pred: bad argument")
 
     toEnum   = chr
     fromEnum = ord
@@ -449,10 +449,10 @@ instance  Bounded Int where
 
 instance  Enum Int  where
     succ x
-       | x == maxBound  = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+       | x == maxBound  = errorWithoutStackTrace "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
        | otherwise      = x + 1
     pred x
-       | x == minBound  = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+       | x == minBound  = errorWithoutStackTrace "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
        | otherwise      = x - 1
 
     toEnum   x = x
diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs
index 6c40cba570..af6d119ff1 100644
--- a/libraries/base/GHC/Err.hs
+++ b/libraries/base/GHC/Err.hs
@@ -21,7 +21,7 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.Err( absentErr, error, undefined ) where
+module GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where
 import GHC.CString ()
 import GHC.Types (Char)
 import GHC.Stack.Types
@@ -35,6 +35,33 @@ import {-# SOURCE #-} GHC.Exception( errorCallWithCallStackException )
 error :: (?callStack :: CallStack) => [Char] -> a
 error s = raise# (errorCallWithCallStackException s ?callStack)
 
+-- | A variant of 'error' that does not produce a stack trace.
+--
+-- @since 4.9.0.0
+errorWithoutStackTrace :: [Char] -> a
+errorWithoutStackTrace s
+  = let ?callStack = freezeCallStack ?callStack
+    in error s
+{-# NOINLINE errorWithoutStackTrace #-}
+
+-- Note [Errors in base]
+-- ~~~~~~~~~~~~~~~~~~~~~
+-- As of base-4.9.0.0, `error` produces a stack trace alongside the
+-- error message using the Implicit CallStack machinery. This provides
+-- a partial stack trace, containing the call-site of each function
+-- with a (?callStack :: CallStack) implicit parameter constraint.
+--
+-- In base, however, the only functions that have such constraints are
+-- error and undefined, so the stack traces from partial functions in
+-- base will never contain a call-site in user code. Instead we'll
+-- usually just get the actual call to error. Base functions already
+-- have a good habit of providing detailed error messages, including the
+-- name of the offending partial function, so the partial stack-trace
+-- does not provide any extra information, just noise. Thus, we export
+-- the callstack-aware error, but within base we use the
+-- errorWithoutStackTrace variant for more hygienic erorr messages.
+
+
 -- | A special case of 'error'.
 -- It is expected that compilers will recognize this and insert error
 -- messages which are more appropriate to the context in which 'undefined'
@@ -45,4 +72,4 @@ undefined =  error "Prelude.undefined"
 -- | Used for compiler-generated error message;
 -- encoding saves bytes of string junk.
 absentErr :: a
-absentErr = error "Oops! The program has entered an `absent' argument!\n"
+absentErr = errorWithoutStackTrace "Oops! The program has entered an `absent' argument!\n"
diff --git a/libraries/base/GHC/Event/Array.hs b/libraries/base/GHC/Event/Array.hs
index 61cc773007..903f7c0c23 100644
--- a/libraries/base/GHC/Event/Array.hs
+++ b/libraries/base/GHC/Event/Array.hs
@@ -45,7 +45,7 @@ import GHC.Show (show)
 -- This fugly hack is brought by GHC's apparent reluctance to deal
 -- with MagicHash and UnboxedTuples when inferring types. Eek!
 #define CHECK_BOUNDS(_func_,_len_,_k_) \
-if (_k_) < 0 || (_k_) >= (_len_) then error ("GHC.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else
+if (_k_) < 0 || (_k_) >= (_len_) then errorWithoutStackTrace ("GHC.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else
 #else
 #define CHECK_BOUNDS(_func_,_len_,_k_)
 #endif
@@ -247,7 +247,7 @@ copy' d dstart s sstart maxCount = copyHack d s undefined
   copyHack :: Storable b => AC b -> AC b -> b -> IO (AC b)
   copyHack dac@(AC _ oldLen _) (AC src slen _) dummy = do
     when (maxCount < 0 || dstart < 0 || dstart > oldLen || sstart < 0 ||
-          sstart > slen) $ error "copy: bad offsets or lengths"
+          sstart > slen) $ errorWithoutStackTrace "copy: bad offsets or lengths"
     let size = sizeOf dummy
         count = min maxCount (slen - sstart)
     if count == 0
@@ -267,7 +267,7 @@ removeAt a i = removeHack a undefined
   removeHack :: Storable b => Array b -> b -> IO ()
   removeHack (Array ary) dummy = do
     AC fp oldLen cap <- readIORef ary
-    when (i < 0 || i >= oldLen) $ error "removeAt: invalid index"
+    when (i < 0 || i >= oldLen) $ errorWithoutStackTrace "removeAt: invalid index"
     let size   = sizeOf dummy
         newLen = oldLen - 1
     when (newLen > 0 && i < newLen) .
diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs
index 5dcc66e6dc..0b0f5587a7 100644
--- a/libraries/base/GHC/Event/Control.hs
+++ b/libraries/base/GHC/Event/Control.hs
@@ -159,7 +159,7 @@ readControlMessage ctrl fd
                         r <- c_read (fromIntegral fd) (castPtr p_siginfo)
                              sizeof_siginfo_t
                         when (r /= fromIntegral sizeof_siginfo_t) $
-                            error "failed to read siginfo_t"
+                            errorWithoutStackTrace "failed to read siginfo_t"
                         let !s' = fromIntegral s
                         return $ CMsgSignal fp s'
 
@@ -195,7 +195,7 @@ sendMessage fd msg = alloca $ \p -> do
   case msg of
     CMsgWakeup        -> poke p io_MANAGER_WAKEUP
     CMsgDie           -> poke p io_MANAGER_DIE
-    CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS"
+    CMsgSignal _fp _s -> errorWithoutStackTrace "Signals can only be sent from within the RTS"
   fromIntegral `fmap` c_write (fromIntegral fd) p 1
 
 #if defined(HAVE_EVENTFD)
diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc
index 2cffb00931..26b6861004 100644
--- a/libraries/base/GHC/Event/EPoll.hsc
+++ b/libraries/base/GHC/Event/EPoll.hsc
@@ -29,7 +29,7 @@ import qualified GHC.Event.Internal as E
 import GHC.Base
 
 new :: IO E.Backend
-new = error "EPoll back end not implemented for this platform"
+new = errorWithoutStackTrace "EPoll back end not implemented for this platform"
 
 available :: Bool
 available = False
diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc
index 2b8d443415..1068ec0136 100644
--- a/libraries/base/GHC/Event/KQueue.hsc
+++ b/libraries/base/GHC/Event/KQueue.hsc
@@ -19,7 +19,7 @@ import qualified GHC.Event.Internal as E
 import GHC.Base
 
 new :: IO E.Backend
-new = error "KQueue back end not implemented for this platform"
+new = errorWithoutStackTrace "KQueue back end not implemented for this platform"
 
 available :: Bool
 available = False
@@ -274,7 +274,7 @@ toEvent :: Filter -> E.Event
 toEvent (Filter f)
   | f == (#const EVFILT_READ) = E.evtRead
   | f == (#const EVFILT_WRITE) = E.evtWrite
-  | otherwise = error $ "toEvent: unknown filter " ++ show f
+  | otherwise = errorWithoutStackTrace $ "toEvent: unknown filter " ++ show f
 
 foreign import ccall unsafe "kqueue"
     c_kqueue :: IO CInt
diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs
index 0ca02c45c4..013850b5d2 100644
--- a/libraries/base/GHC/Event/Manager.hs
+++ b/libraries/base/GHC/Event/Manager.hs
@@ -172,7 +172,7 @@ newDefaultBackend = EPoll.new
 #elif defined(HAVE_POLL)
 newDefaultBackend = Poll.new
 #else
-newDefaultBackend = error "no back end for this platform"
+newDefaultBackend = errorWithoutStackTrace "no back end for this platform"
 #endif
 
 -- | Create a new event manager.
@@ -212,7 +212,7 @@ failOnInvalidFile loc fd m = do
   when (not ok) $
     let msg = "Failed while attempting to modify registration of file " ++
               show fd ++ " at location " ++ loc
-    in error msg
+    in errorWithoutStackTrace msg
 
 registerControlFd :: EventManager -> Fd -> Event -> IO ()
 registerControlFd mgr fd evs =
@@ -267,7 +267,7 @@ loop mgr@EventManager{..} = do
     -- in Thread.restartPollLoop.  See #8235
     Finished  -> return ()
     _         -> do cleanup mgr
-                    error $ "GHC.Event.Manager.loop: state is already " ++
+                    errorWithoutStackTrace $ "GHC.Event.Manager.loop: state is already " ++
                             show state
  where
   go = do state <- step mgr
diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs
index 3421b5a984..e61c31b1b4 100644
--- a/libraries/base/GHC/Event/PSQ.hs
+++ b/libraries/base/GHC/Event/PSQ.hs
@@ -458,7 +458,7 @@ tourView (Winner e (LLoser _ e' tl m tr) m') =
 -- Utility functions
 
 moduleError :: String -> String -> a
-moduleError fun msg = error ("GHC.Event.PSQ." ++ fun ++ ':' : ' ' : msg)
+moduleError fun msg = errorWithoutStackTrace ("GHC.Event.PSQ." ++ fun ++ ':' : ' ' : msg)
 {-# NOINLINE moduleError #-}
 
 ------------------------------------------------------------------------
diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc
index 6cbe14398b..b128572e71 100644
--- a/libraries/base/GHC/Event/Poll.hsc
+++ b/libraries/base/GHC/Event/Poll.hsc
@@ -17,7 +17,7 @@ import GHC.Base
 import qualified GHC.Event.Internal as E
 
 new :: IO E.Backend
-new = error "Poll back end not implemented for this platform"
+new = errorWithoutStackTrace "Poll back end not implemented for this platform"
 
 available :: Bool
 available = False
@@ -62,7 +62,7 @@ modifyFd p fd oevt nevt =
     return True
 
 modifyFdOnce :: Poll -> Fd -> E.Event -> IO Bool
-modifyFdOnce = error "modifyFdOnce not supported in Poll backend"
+modifyFdOnce = errorWithoutStackTrace "modifyFdOnce not supported in Poll backend"
 
 reworkFd :: Poll -> PollFd -> IO ()
 reworkFd p (PollFd fd npevt opevt) = do
@@ -72,7 +72,7 @@ reworkFd p (PollFd fd npevt opevt) = do
     else do
       found <- A.findIndex ((== fd) . pfdFd) ary
       case found of
-        Nothing        -> error "reworkFd: event not found"
+        Nothing        -> errorWithoutStackTrace "reworkFd: event not found"
         Just (i,_)
           | npevt /= 0 -> A.unsafeWrite ary i $ PollFd fd npevt 0
           | otherwise  -> A.removeAt ary i
diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs
index c1ab64c7a9..93b1766f5e 100644
--- a/libraries/base/GHC/Event/TimerManager.hs
+++ b/libraries/base/GHC/Event/TimerManager.hs
@@ -108,7 +108,7 @@ newDefaultBackend :: IO Backend
 #if defined(HAVE_POLL)
 newDefaultBackend = Poll.new
 #else
-newDefaultBackend = error "no back end for this platform"
+newDefaultBackend = errorWithoutStackTrace "no back end for this platform"
 #endif
 
 -- | Create a new event manager.
@@ -168,7 +168,7 @@ loop mgr = do
     Created -> go `finally` cleanup mgr
     Dying   -> cleanup mgr
     _       -> do cleanup mgr
-                  error $ "GHC.Event.Manager.loop: state is already " ++
+                  errorWithoutStackTrace $ "GHC.Event.Manager.loop: state is already " ++
                       show state
  where
   go = do running <- step mgr
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 032e650c1e..dc943e068d 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -103,8 +103,8 @@ maxTupleSize = 62
 the :: Eq a => [a] -> a
 the (x:xs)
   | all (x ==) xs = x
-  | otherwise     = error "GHC.Exts.the: non-identical elements"
-the []            = error "GHC.Exts.the: empty list"
+  | otherwise     = errorWithoutStackTrace "GHC.Exts.the: non-identical elements"
+the []            = errorWithoutStackTrace "GHC.Exts.the: empty list"
 
 -- | The 'sortWith' function sorts a list of elements using the
 -- user supplied function to project something out of each element
diff --git a/libraries/base/GHC/Fingerprint.hs b/libraries/base/GHC/Fingerprint.hs
index 8a92cd0595..7b7f5c7115 100644
--- a/libraries/base/GHC/Fingerprint.hs
+++ b/libraries/base/GHC/Fingerprint.hs
@@ -95,7 +95,7 @@ getFileHash path = withBinaryFile path ReadMode $ \h -> do
       let loop = do
             count <- hGetBuf h arrPtr _BUFSIZE
             eof <- hIsEOF h
-            when (count /= _BUFSIZE && not eof) $ error $
+            when (count /= _BUFSIZE && not eof) $ errorWithoutStackTrace $
               "GHC.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"
 
             f arrPtr count
diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs
index ddf9cf01ca..0ffefd5f67 100644
--- a/libraries/base/GHC/Float.hs
+++ b/libraries/base/GHC/Float.hs
@@ -658,7 +658,7 @@ formatRealFloatAlt fmt decs alt x
           "0"     -> "0.0e0"
           [d]     -> d : ".0e" ++ show_e'
           (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'
-          []      -> error "formatRealFloat/doFmt/FFExponent: []"
+          []      -> errorWithoutStackTrace "formatRealFloat/doFmt/FFExponent: []"
        Just dec ->
         let dec' = max dec 1 in
         case is of
@@ -704,7 +704,7 @@ roundTo base d is =
   case f d True is of
     x@(0,_) -> x
     (1,xs)  -> (1, 1:xs)
-    _       -> error "roundTo: bad Value"
+    _       -> errorWithoutStackTrace "roundTo: bad Value"
  where
   b2 = base `quot` 2
 
diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs
index d0688f0cbf..6d03967d3b 100644
--- a/libraries/base/GHC/ForeignPtr.hs
+++ b/libraries/base/GHC/ForeignPtr.hs
@@ -153,7 +153,7 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a)
 mallocForeignPtr = doMalloc undefined
   where doMalloc :: Storable b => b -> IO (ForeignPtr b)
         doMalloc a
-          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"
+          | I# size < 0 = errorWithoutStackTrace "mallocForeignPtr: size must be >= 0"
           | otherwise = do
           r <- newIORef NoFinalizers
           IO $ \s ->
@@ -168,7 +168,7 @@ mallocForeignPtr = doMalloc undefined
 -- size of the memory required is given explicitly as a number of bytes.
 mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
 mallocForeignPtrBytes size | size < 0 =
-  error "mallocForeignPtrBytes: size must be >= 0"
+  errorWithoutStackTrace "mallocForeignPtrBytes: size must be >= 0"
 mallocForeignPtrBytes (I# size) = do
   r <- newIORef NoFinalizers
   IO $ \s ->
@@ -182,7 +182,7 @@ mallocForeignPtrBytes (I# size) = do
 -- bytes.
 mallocForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)
 mallocForeignPtrAlignedBytes size _align | size < 0 =
-  error "mallocForeignPtrAlignedBytes: size must be >= 0"
+  errorWithoutStackTrace "mallocForeignPtrAlignedBytes: size must be >= 0"
 mallocForeignPtrAlignedBytes (I# size) (I# align) = do
   r <- newIORef NoFinalizers
   IO $ \s ->
@@ -208,7 +208,7 @@ mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a)
 mallocPlainForeignPtr = doMalloc undefined
   where doMalloc :: Storable b => b -> IO (ForeignPtr b)
         doMalloc a
-          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"
+          | I# size < 0 = errorWithoutStackTrace "mallocForeignPtr: size must be >= 0"
           | otherwise = IO $ \s ->
             case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
@@ -223,7 +223,7 @@ mallocPlainForeignPtr = doMalloc undefined
 -- exception to be thrown.
 mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a)
 mallocPlainForeignPtrBytes size | size < 0 =
-  error "mallocPlainForeignPtrBytes: size must be >= 0"
+  errorWithoutStackTrace "mallocPlainForeignPtrBytes: size must be >= 0"
 mallocPlainForeignPtrBytes (I# size) = IO $ \s ->
     case newPinnedByteArray# size s      of { (# s', mbarr# #) ->
        (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
@@ -236,7 +236,7 @@ mallocPlainForeignPtrBytes (I# size) = IO $ \s ->
 -- exception to be thrown.
 mallocPlainForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)
 mallocPlainForeignPtrAlignedBytes size _align | size < 0 =
-  error "mallocPlainForeignPtrAlignedBytes: size must be >= 0"
+  errorWithoutStackTrace "mallocPlainForeignPtrAlignedBytes: size must be >= 0"
 mallocPlainForeignPtrAlignedBytes (I# size) (I# align) = IO $ \s ->
     case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
        (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
@@ -250,7 +250,7 @@ addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
 addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
   PlainForeignPtr r -> insertCFinalizer r fp 0# nullAddr# p ()
   MallocPtr     _ r -> insertCFinalizer r fp 0# nullAddr# p c
-  _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
+  _ -> errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
 
 -- Note [MallocPtr finalizers] (#10904)
 --
@@ -270,7 +270,7 @@ addForeignPtrFinalizerEnv ::
 addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of
   PlainForeignPtr r -> insertCFinalizer r fp 1# ep p ()
   MallocPtr     _ r -> insertCFinalizer r fp 1# ep p c
-  _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
+  _ -> errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
 
 addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()
 -- ^This function adds a finalizer to the given @ForeignPtr@.  The
@@ -311,7 +311,7 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
     finalizer' = unIO (foreignPtrFinalizer r >> touch f)
 
 addForeignPtrConcFinalizer_ _ _ =
-  error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer"
+  errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to plain pointer"
 
 insertHaskellFinalizer :: IORef Finalizers -> IO () -> IO Bool
 insertHaskellFinalizer r f = do
@@ -358,7 +358,7 @@ ensureCFinalizerWeak ref@(IORef (STRef r#)) value = do
       update _ _ = noMixingError
 
 noMixingError :: a
-noMixingError = error $
+noMixingError = errorWithoutStackTrace $
    "GHC.ForeignPtr: attempt to mix Haskell and C finalizers " ++
    "in the same ForeignPtr"
 
@@ -441,5 +441,5 @@ finalizeForeignPtr (ForeignPtr _ foreignPtr) = foreignPtrFinalizer refFinalizers
                         (PlainForeignPtr ref) -> ref
                         (MallocPtr     _ ref) -> ref
                         PlainPtr _            ->
-                            error "finalizeForeignPtr PlainPtr"
+                            errorWithoutStackTrace "finalizeForeignPtr PlainPtr"
 
diff --git a/libraries/base/GHC/IO/Buffer.hs b/libraries/base/GHC/IO/Buffer.hs
index 77f1d99f46..b2d4cd1843 100644
--- a/libraries/base/GHC/IO/Buffer.hs
+++ b/libraries/base/GHC/IO/Buffer.hs
@@ -287,5 +287,5 @@ checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do
 
 check :: Buffer a -> Bool -> IO ()
 check _   True  = return ()
-check buf False = error ("buffer invariant violation: " ++ summaryBuffer buf)
+check buf False = errorWithoutStackTrace ("buffer invariant violation: " ++ summaryBuffer buf)
 
diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs
index 103eb87a0d..5a48a9ee3d 100644
--- a/libraries/base/GHC/IO/Encoding/CodePage/API.hs
+++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs
@@ -83,7 +83,7 @@ instance Storable CPINFO where
 
 pokeArray' :: Storable a => String -> Int -> Ptr a -> [a] -> IO ()
 pokeArray' msg sz ptr xs | length xs == sz = pokeArray ptr xs
-                         | otherwise       = error $ msg ++ ": expected " ++ show sz ++ " elements in list but got " ++ show (length xs)
+                         | otherwise       = errorWithoutStackTrace $ msg ++ ": expected " ++ show sz ++ " elements in list but got " ++ show (length xs)
 
 
 foreign import WINDOWS_CCONV unsafe "windows.h GetCPInfo"
@@ -189,7 +189,7 @@ byteView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr b
 cwcharView :: Buffer Word8 -> Buffer CWchar
 cwcharView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = half bufSize, bufL = half bufL, bufR = half bufR }
   where half x = case x `divMod` 2 of (y, 0) -> y
-                                      _      -> error "cwcharView: utf16_(encode|decode) (wrote out|consumed) non multiple-of-2 number of bytes"
+                                      _      -> errorWithoutStackTrace "cwcharView: utf16_(encode|decode) (wrote out|consumed) non multiple-of-2 number of bytes"
 
 utf16_native_encode :: CodeBuffer Char CWchar
 utf16_native_encode ibuf obuf = do
@@ -227,9 +227,9 @@ cpDecode cp max_char_size = \ibuf obuf -> do
       -- If we successfully translate all of the UTF-16 buffer, we need to know why we couldn't get any more
       -- UTF-16 out of the Windows API
       InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)
-                     | otherwise           -> error "cpDecode: impossible underflown UTF-16 buffer"
+                     | otherwise           -> errorWithoutStackTrace "cpDecode: impossible underflown UTF-16 buffer"
       -- InvalidSequence should be impossible since mbuf' is output from Windows.
-      InvalidSequence -> error "InvalidSequence on output of Windows API"
+      InvalidSequence -> errorWithoutStackTrace "InvalidSequence on output of Windows API"
       -- If we run out of space in obuf, we need to ask for more output buffer space, while also returning
       -- the characters we have managed to consume so far.
       OutputUnderflow -> do
@@ -287,7 +287,7 @@ cpEncode cp _max_char_size = \ibuf obuf -> do
       -- If we succesfully translate all of the UTF-16 buffer, we need to know why
       -- we weren't able to get any more UTF-16 out of the UTF-32 buffer
       InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)
-                     | otherwise           -> error "cpEncode: impossible underflown UTF-16 buffer"
+                     | otherwise           -> errorWithoutStackTrace "cpEncode: impossible underflown UTF-16 buffer"
       -- With OutputUnderflow/InvalidSequence we only care about the failings of the UTF-16->CP translation.
       -- Yes, InvalidSequence is possible even though mbuf' is guaranteed to be valid UTF-16, because
       -- the code page may not be able to represent the encoded Unicode codepoint.
@@ -371,7 +371,7 @@ bSearch msg code ibuf mbuf target_to_elems = go
         LT -> go' (md+1) mx
         GT -> go' mn (md-1)
     go' mn mx | mn <= mx  = go mn (mn + ((mx - mn) `div` 2)) mx
-              | otherwise = error $ "bSearch(" ++ msg ++ "): search crossed! " ++ show (summaryBuffer ibuf, summaryBuffer mbuf, target_to_elems, mn, mx)
+              | otherwise = errorWithoutStackTrace $ "bSearch(" ++ msg ++ "): search crossed! " ++ show (summaryBuffer ibuf, summaryBuffer mbuf, target_to_elems, mn, mx)
 
 cpRecode :: forall from to. Storable from
          => (Ptr from -> Int -> Ptr to -> Int -> IO (Either Bool Int))
diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs
index c1d15a93b7..ca5336955c 100644
--- a/libraries/base/GHC/IO/Handle.hs
+++ b/libraries/base/GHC/IO/Handle.hs
@@ -255,7 +255,7 @@ hSetEncoding hdl encoding = do
     closeTextCodecs h_
     openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
     bbuf <- readIORef haByteBuffer
-    ref <- newIORef (error "last_decode")
+    ref <- newIORef (errorWithoutStackTrace "last_decode")
     return (Handle__{ haLastDecode = ref,
                       haDecoder = mb_decoder,
                       haEncoder = mb_encoder,
@@ -571,7 +571,7 @@ hSetBinaryMode handle bin =
                    | otherwise = nativeNewlineMode
 
          bbuf <- readIORef haByteBuffer
-         ref <- newIORef (error "codec_state", bbuf)
+         ref <- newIORef (errorWithoutStackTrace "codec_state", bbuf)
 
          return Handle__{ haLastDecode = ref,
                           haEncoder  = mb_encoder,
diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
index 5d8ddfd981..48ece1dc5e 100644
--- a/libraries/base/GHC/IO/Handle/Internals.hs
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -628,7 +628,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
    let buf_state = initBufferState ha_type
    bbuf <- Buffered.newBuffer dev buf_state
    bbufref <- newIORef bbuf
-   last_decode <- newIORef (error "codec_state", bbuf)
+   last_decode <- newIORef (errorWithoutStackTrace "codec_state", bbuf)
 
    (cbufref,bmode) <-
          if buffered then getCharBuffer dev buf_state
@@ -848,7 +848,7 @@ readTextDevice h_@Handle__{..} cbuf = do
   (bbuf2,cbuf') <-
       case haDecoder of
           Nothing      -> do
-               writeIORef haLastDecode (error "codec_state", bbuf1)
+               writeIORef haLastDecode (errorWithoutStackTrace "codec_state", bbuf1)
                latin1_decode bbuf1 cbuf
           Just decoder -> do
                state <- getState decoder
@@ -937,7 +937,7 @@ decodeByteBuf h_@Handle__{..} cbuf = do
   (bbuf2,cbuf') <-
       case haDecoder of
           Nothing      -> do
-               writeIORef haLastDecode (error "codec_state", bbuf0)
+               writeIORef haLastDecode (errorWithoutStackTrace "codec_state", bbuf0)
                latin1_decode bbuf0 cbuf
           Just decoder -> do
                state <- getState decoder
diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index c31ab70a4a..65832c79ec 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -564,7 +564,7 @@ getSpareBuffer Handle__{haCharBuffer=ref,
                         haBufferMode=mode}
  = do
    case mode of
-     NoBuffering -> return (mode, error "no buffer!")
+     NoBuffering -> return (mode, errorWithoutStackTrace "no buffer!")
      _ -> do
           bufs <- readIORef spare_ref
           buf  <- readIORef ref
diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs
index 195054a7aa..b7de4ab95b 100644
--- a/libraries/base/GHC/IO/Handle/Types.hs
+++ b/libraries/base/GHC/IO/Handle/Types.hs
@@ -185,10 +185,10 @@ checkHandleInvariants h_ = do
  cbuf <- readIORef (haCharBuffer h_)
  checkBuffer cbuf
  when (isWriteBuffer cbuf && not (isEmptyBuffer cbuf)) $
-   error ("checkHandleInvariants: char write buffer non-empty: " ++
+   errorWithoutStackTrace ("checkHandleInvariants: char write buffer non-empty: " ++
           summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)
  when (isWriteBuffer bbuf /= isWriteBuffer cbuf) $
-   error ("checkHandleInvariants: buffer modes differ: " ++
+   errorWithoutStackTrace ("checkHandleInvariants: buffer modes differ: " ++
           summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)
 
 #else
diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs
index bbaa0a2751..92ded0d413 100644
--- a/libraries/base/GHC/List.hs
+++ b/libraries/base/GHC/List.hs
@@ -841,8 +841,8 @@ concat = foldr (++) []
 -- which takes an index of any integral type.
 (!!)                    :: [a] -> Int -> a
 #ifdef USE_REPORT_PRELUDE
-xs     !! n | n < 0 =  error "Prelude.!!: negative index"
-[]     !! _         =  error "Prelude.!!: index too large"
+xs     !! n | n < 0 =  errorWithoutStackTrace "Prelude.!!: negative index"
+[]     !! _         =  errorWithoutStackTrace "Prelude.!!: index too large"
 (x:_)  !! 0         =  x
 (_:xs) !! n         =  xs !! (n-1)
 #else
@@ -852,10 +852,10 @@ xs     !! n | n < 0 =  error "Prelude.!!: negative index"
 -- if so we should be careful not to trip up known-bottom
 -- optimizations.
 tooLarge :: Int -> a
-tooLarge _ = error (prel_list_str ++ "!!: index too large")
+tooLarge _ = errorWithoutStackTrace (prel_list_str ++ "!!: index too large")
 
 negIndex :: a
-negIndex = error $ prel_list_str ++ "!!: negative index"
+negIndex = errorWithoutStackTrace $ prel_list_str ++ "!!: negative index"
 
 {-# INLINABLE (!!) #-}
 xs !! n
@@ -996,7 +996,7 @@ unzip3   =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
 
 errorEmptyList :: String -> a
 errorEmptyList fun =
-  error (prel_list_str ++ fun ++ ": empty list")
+  errorWithoutStackTrace (prel_list_str ++ fun ++ ": empty list")
 
 prel_list_str :: String
 prel_list_str = "Prelude."
diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs
index dedf4f8790..e756f0d07f 100644
--- a/libraries/base/GHC/Natural.hs
+++ b/libraries/base/GHC/Natural.hs
@@ -215,7 +215,7 @@ instance Enum Natural where
     fromEnum (NatS# w) | i >= 0 = i
       where
         i = fromIntegral (W# w)
-    fromEnum _ = error "fromEnum: out of Int range"
+    fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range"
 
     enumFrom x        = enumDeltaNatural      x (NatS# 1##)
     enumFromThen x y
@@ -304,10 +304,10 @@ instance Bits Natural where
     NatJ# n `xor` NatS# m = NatJ# (xorBigNat n (wordToBigNat m))
     NatJ# n `xor` NatJ# m = bigNatToNatural (xorBigNat n m)
 
-    complement _ = error "Bits.complement: Natural complement undefined"
+    complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
 
     bitSizeMaybe _ = Nothing
-    bitSize = error "Natural: bitSize"
+    bitSize = errorWithoutStackTrace "Natural: bitSize"
     isSigned _ = False
 
     bit i@(I# i#) | i < finiteBitSize (0::Word) = wordToNatural (bit i)
@@ -484,7 +484,7 @@ instance Bits Natural where
   {-# INLINE (.|.) #-}
   xor (Natural n) (Natural m) = Natural (xor n m)
   {-# INLINE xor #-}
-  complement _ = error "Bits.complement: Natural complement undefined"
+  complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
   {-# INLINE complement #-}
   shift (Natural n) = Natural . shift n
   {-# INLINE shift #-}
@@ -502,7 +502,7 @@ instance Bits Natural where
   {-# INLINE testBit #-}
   bitSizeMaybe _ = Nothing
   {-# INLINE bitSizeMaybe #-}
-  bitSize = error "Natural: bitSize"
+  bitSize = errorWithoutStackTrace "Natural: bitSize"
   {-# INLINE bitSize #-}
   isSigned _ = False
   {-# INLINE isSigned #-}
@@ -523,14 +523,14 @@ instance Real Natural where
   {-# INLINE toRational #-}
 
 instance Enum Natural where
-  pred (Natural 0) = error "Natural.pred: 0"
+  pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"
   pred (Natural n) = Natural (pred n)
   {-# INLINE pred #-}
   succ (Natural n) = Natural (succ n)
   {-# INLINE succ #-}
   fromEnum (Natural n) = fromEnum n
   {-# INLINE fromEnum #-}
-  toEnum n | n < 0     = error "Natural.toEnum: negative"
+  toEnum n | n < 0     = errorWithoutStackTrace "Natural.toEnum: negative"
            | otherwise = Natural (toEnum n)
   {-# INLINE toEnum #-}
 
@@ -597,7 +597,7 @@ instance Data Natural where
   toConstr x = mkIntegralConstr naturalType x
   gunfold _ z c = case constrRep c of
                     (IntConstr x) -> z (fromIntegral x)
-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
                                  ++ " is not of type Natural"
   dataTypeOf _ = naturalType
 
diff --git a/libraries/base/GHC/Pack.hs b/libraries/base/GHC/Pack.hs
index 95ff849f31..73334b6c98 100644
--- a/libraries/base/GHC/Pack.hs
+++ b/libraries/base/GHC/Pack.hs
@@ -89,7 +89,7 @@ new_ps_array size = ST $ \ s ->
     case (newByteArray# size s)   of { (# s2#, barr# #) ->
     (# s2#, MutableByteArray bot bot barr# #) }
   where
-    bot = error "new_ps_array"
+    bot = errorWithoutStackTrace "new_ps_array"
 
 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
     case writeCharArray# barr# n ch s#  of { s2#   ->
diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc
index 62e720f7c0..12cead7821 100644
--- a/libraries/base/GHC/RTS/Flags.hsc
+++ b/libraries/base/GHC/RTS/Flags.hsc
@@ -87,7 +87,7 @@ instance Enum GiveGCStats where
     toEnum #{const ONELINE_GC_STATS} = OneLineGCStats
     toEnum #{const SUMMARY_GC_STATS} = SummaryGCStats
     toEnum #{const VERBOSE_GC_STATS} = VerboseGCStats
-    toEnum e = error ("invalid enum for GiveGCStats: " ++ show e)
+    toEnum e = errorWithoutStackTrace ("invalid enum for GiveGCStats: " ++ show e)
 
 -- | Parameters of the garbage collector.
 --
@@ -185,7 +185,7 @@ instance Enum DoCostCentres where
     toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose
     toEnum #{const COST_CENTRES_ALL}     = CostCentresAll
     toEnum #{const COST_CENTRES_XML}     = CostCentresXML
-    toEnum e = error ("invalid enum for DoCostCentres: " ++ show e)
+    toEnum e = errorWithoutStackTrace ("invalid enum for DoCostCentres: " ++ show e)
 
 -- | Parameters pertaining to the cost-center profiler.
 --
@@ -228,7 +228,7 @@ instance Enum DoHeapProfile where
     toEnum #{const HEAP_BY_RETAINER}     = HeapByRetainer
     toEnum #{const HEAP_BY_LDV}          = HeapByLDV
     toEnum #{const HEAP_BY_CLOSURE_TYPE} = HeapByClosureType
-    toEnum e = error ("invalid enum for DoHeapProfile: " ++ show e)
+    toEnum e = errorWithoutStackTrace ("invalid enum for DoHeapProfile: " ++ show e)
 
 -- | Parameters of the cost-center profiler
 --
@@ -267,7 +267,7 @@ instance Enum DoTrace where
     toEnum #{const TRACE_NONE}     = TraceNone
     toEnum #{const TRACE_EVENTLOG} = TraceEventLog
     toEnum #{const TRACE_STDERR}   = TraceStderr
-    toEnum e = error ("invalid enum for DoTrace: " ++ show e)
+    toEnum e = errorWithoutStackTrace ("invalid enum for DoTrace: " ++ show e)
 
 -- | Parameters pertaining to event tracing
 --
diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index 31381d6bd9..186be27cdf 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -205,7 +205,7 @@ class  (Real a, Fractional a) => RealFrac a  where
                                 -1 -> n
                                 0  -> if even n then n else m
                                 1  -> m
-                                _  -> error "round default defn: Bad value"
+                                _  -> errorWithoutStackTrace "round default defn: Bad value"
 
     ceiling x           =  if r > 0 then n + 1 else n
                            where (n,r) = properFraction x
@@ -476,7 +476,7 @@ odd             =  not . even
         Int -> Int -> Int #-}
 {-# INLINABLE [1] (^) #-}    -- See Note [Inlining (^)]
 (^) :: (Num a, Integral b) => a -> b -> a
-x0 ^ y0 | y0 < 0    = error "Negative exponent"
+x0 ^ y0 | y0 < 0    = errorWithoutStackTrace "Negative exponent"
         | y0 == 0   = 1
         | otherwise = f x0 y0
     where -- f : x0 ^ y0 = x ^ y
@@ -585,7 +585,7 @@ x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 {-# RULES "(^)/Rational"    (^) = (^%^) #-}
 (^%^)           :: Integral a => Rational -> a -> Rational
 (n :% d) ^%^ e
-    | e < 0     = error "Negative exponent"
+    | e < 0     = errorWithoutStackTrace "Negative exponent"
     | e == 0    = 1 :% 1
     | otherwise = (n ^ e) :% (d ^ e)
 
diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs
index 879d666bb0..4322aff2e8 100644
--- a/libraries/base/GHC/Show.hs
+++ b/libraries/base/GHC/Show.hs
@@ -396,7 +396,7 @@ intToDigit :: Int -> Char
 intToDigit (I# i)
     | isTrue# (i >=# 0#)  && isTrue# (i <=#  9#) = unsafeChr (ord '0' + I# i)
     | isTrue# (i >=# 10#) && isTrue# (i <=# 15#) = unsafeChr (ord 'a' + I# i - 10)
-    | otherwise =  error ("Char.intToDigit: not a digit " ++ show (I# i))
+    | otherwise =  errorWithoutStackTrace ("Char.intToDigit: not a digit " ++ show (I# i))
 
 showSignedInt :: Int -> Int -> ShowS
 showSignedInt (I# p) (I# n) r
@@ -464,7 +464,7 @@ integerToString n0 cs0
         (# q, r #) ->
             if q > 0 then q : r : jsplitb p ns
                      else     r : jsplitb p ns
-    jsplith _ [] = error "jsplith: []"
+    jsplith _ [] = errorWithoutStackTrace "jsplith: []"
 
     jsplitb :: Integer -> [Integer] -> [Integer]
     jsplitb _ []     = []
@@ -483,7 +483,7 @@ integerToString n0 cs0
                 r = fromInteger r'
             in if q > 0 then jhead q $ jblock r $ jprintb ns cs
                         else jhead r $ jprintb ns cs
-    jprinth [] _ = error "jprinth []"
+    jprinth [] _ = errorWithoutStackTrace "jprinth []"
 
     jprintb :: [Integer] -> String -> String
     jprintb []     cs = cs
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs
index d7c5c94193..727910a659 100644
--- a/libraries/base/GHC/Stack.hs
+++ b/libraries/base/GHC/Stack.hs
@@ -15,7 +15,7 @@
 -- @since 4.5.0.0
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE MagicHash, NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash, NoImplicitPrelude, ImplicitParams, RankNTypes #-}
 module GHC.Stack (
     -- * Call stacks
     currentCallStack,
@@ -23,7 +23,8 @@ module GHC.Stack (
     errorWithStackTrace,
 
     -- * Implicit parameter call stacks
-    CallStack, getCallStack, pushCallStack, prettyCallStack,
+    CallStack, emptyCallStack, freezeCallStack, getCallStack, popCallStack,
+    prettyCallStack, pushCallStack, withFrozenCallStack,
 
     -- * Source locations
     SrcLoc(..), prettySrcLoc,
@@ -62,3 +63,28 @@ errorWithStackTrace x = unsafeDupablePerformIO $ do
    if null stack
       then throwIO (ErrorCall x)
       else throwIO (ErrorCallWithLocation x (renderStack stack))
+
+
+-- | Pop the most recent call-site off the 'CallStack'.
+--
+-- This function, like 'pushCallStack', has no effect on a frozen 'CallStack'.
+--
+-- @since 4.9.0.0
+popCallStack :: CallStack -> CallStack
+popCallStack stk = case stk of
+  EmptyCallStack       -> errorWithoutStackTrace "popCallStack: empty stack"
+  PushCallStack _ stk' -> stk'
+  FreezeCallStack _    -> stk
+
+
+-- | Perform some computation without adding new entries to the 'CallStack'.
+--
+-- @since 4.9.0.0
+withFrozenCallStack :: (?callStack :: CallStack)
+                    => ( (?callStack :: CallStack) => a )
+                    -> a
+withFrozenCallStack do_this =
+                   -- we pop the stack before freezing it to remove
+                   -- withFrozenCallStack's call-site
+  let ?callStack = freezeCallStack (popCallStack ?callStack)
+  in do_this
diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs
index ebe4591e3b..a971f7c86a 100644
--- a/libraries/base/GHC/Stack/Types.hs
+++ b/libraries/base/GHC/Stack/Types.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+-- we hide this module from haddock to enforce GHC.Stack as the main
+-- access point.
 
 -----------------------------------------------------------------------------
 -- |
@@ -11,14 +14,14 @@
 -- Portability :  non-portable (GHC Extensions)
 --
 -- type definitions for call-stacks via implicit parameters.
--- Use GHC.Exts from the base package instead of importing this
+-- Use "GHC.Stack" from the base package instead of importing this
 -- module directly.
 --
 -----------------------------------------------------------------------------
 
 module GHC.Stack.Types (
     -- * Implicit parameter call stacks
-    CallStack, getCallStack, pushCallStack,
+    CallStack(..), emptyCallStack, freezeCallStack, getCallStack, pushCallStack,
     -- * Source locations
     SrcLoc(..)
   ) where
@@ -84,12 +87,26 @@ import GHC.Integer ()
 -- ordered with the most recently called function at the head.
 --
 -- @since 4.8.1.0
-data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)]
-                             -- ^ Get a list of stack frames with the most
-                             -- recently called function at the head.
-                           }
+data CallStack
+  = EmptyCallStack
+  | PushCallStack ([Char], SrcLoc) CallStack
+  | FreezeCallStack CallStack
+    -- ^ Freeze the stack at the given @CallStack@, preventing any further
+    -- call-sites from being pushed onto it.
+
   -- See Note [Overview of implicit CallStacks]
 
+-- | Extract a list of call-sites from the 'CallStack'.
+--
+-- The list is ordered by most recent call.
+--
+-- @since 4.8.1.0
+getCallStack :: CallStack -> [([Char], SrcLoc)]
+getCallStack stk = case stk of
+  EmptyCallStack        -> []
+  PushCallStack cs stk' -> cs : getCallStack stk'
+  FreezeCallStack stk'  -> getCallStack stk'
+
 
 -- Note [Definition of CallStack]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -109,10 +126,31 @@ data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)]
 
 -- | Push a call-site onto the stack.
 --
+-- This function has no effect on a frozen 'CallStack'.
+--
 -- @since 4.9.0.0
 pushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack
-pushCallStack callSite (CallStack stk)
-  = CallStack (callSite : stk)
+pushCallStack cs stk = case stk of
+  FreezeCallStack _ -> stk
+  _                 -> PushCallStack cs stk
+{-# INLINE pushCallStack #-}
+
+
+-- | The empty 'CallStack'.
+--
+-- @since 4.9.0.0
+emptyCallStack :: CallStack
+emptyCallStack = EmptyCallStack
+{-# INLINE emptyCallStack #-}
+
+-- | Freeze a call-stack, preventing any further call-sites from being appended.
+--
+-- prop> pushCallStack callSite (freezeCallStack callStack) = freezeCallStack callStack
+--
+-- @since 4.9.0.0
+freezeCallStack :: CallStack -> CallStack
+freezeCallStack stk = FreezeCallStack stk
+{-# INLINE freezeCallStack #-}
 
 
 -- | A single location in the source code.
diff --git a/libraries/base/Numeric.hs b/libraries/base/Numeric.hs
index 51be3a1698..e8b0b91eed 100644
--- a/libraries/base/Numeric.hs
+++ b/libraries/base/Numeric.hs
@@ -128,7 +128,7 @@ readSigned readPos = readParen False read'
 -- | Show /non-negative/ 'Integral' numbers in base 10.
 showInt :: Integral a => a -> ShowS
 showInt n0 cs0
-    | n0 < 0    = error "Numeric.showInt: can't show negative numbers"
+    | n0 < 0    = errorWithoutStackTrace "Numeric.showInt: can't show negative numbers"
     | otherwise = go n0 cs0
     where
     go n cs
@@ -211,8 +211,8 @@ showGFloatAlt d x =  showString (formatRealFloatAlt FFGeneric d True x)
 -- first argument, and the character representation specified by the second.
 showIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
 showIntAtBase base toChr n0 r0
-  | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
-  | n0 <  0   = error ("Numeric.showIntAtBase: applied to negative number " ++ show n0)
+  | base <= 1 = errorWithoutStackTrace ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
+  | n0 <  0   = errorWithoutStackTrace ("Numeric.showIntAtBase: applied to negative number " ++ show n0)
   | otherwise = showIt (quotRem n0 base) r0
    where
     showIt (n,d) r = seq c $ -- stricter than necessary
diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs
index fa070f3161..158cc0a8ff 100644
--- a/libraries/base/Prelude.hs
+++ b/libraries/base/Prelude.hs
@@ -95,7 +95,7 @@ module Prelude (
 
     -- ** Miscellaneous functions
     id, const, (.), flip, ($), until,
-    asTypeOf, error, undefined,
+    asTypeOf, error, errorWithoutStackTrace, undefined,
     seq, ($!),
 
     -- * List operations
diff --git a/libraries/base/System/Environment/ExecutablePath.hsc b/libraries/base/System/Environment/ExecutablePath.hsc
index 410e3acda2..8b6c7b6c57 100644
--- a/libraries/base/System/Environment/ExecutablePath.hsc
+++ b/libraries/base/System/Environment/ExecutablePath.hsc
@@ -84,7 +84,7 @@ _NSGetExecutablePath =
                         status2 <- c__NSGetExecutablePath newBuf bufsize
                         if status2 == 0
                              then peekFilePath newBuf
-                             else error "_NSGetExecutablePath: buffer too small"
+                             else errorWithoutStackTrace "_NSGetExecutablePath: buffer too small"
 
 foreign import ccall unsafe "stdlib.h realpath"
     c_realpath :: CString -> CString -> IO CString
@@ -145,7 +145,7 @@ getExecutablePath = go 2048  -- plenty, PATH_MAX is 512 under Win32
     go size = allocaArray (fromIntegral size) $ \ buf -> do
         ret <- c_GetModuleFileName nullPtr buf size
         case ret of
-            0 -> error "getExecutablePath: GetModuleFileNameW returned an error"
+            0 -> errorWithoutStackTrace "getExecutablePath: GetModuleFileNameW returned an error"
             _ | ret < size -> peekFilePath buf
               | otherwise  -> go (size * 2)
 
@@ -166,7 +166,7 @@ getExecutablePath =
             -- If argc > 0 then argv[0] is guaranteed by the standard
             -- to be a pointer to a null-terminated string.
             then peek p_argv >>= peek >>= peekFilePath
-            else error $ "getExecutablePath: " ++ msg
+            else errorWithoutStackTrace $ "getExecutablePath: " ++ msg
   where msg = "no OS specific implementation and program name couldn't be " ++
               "found in argv"
 
diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index e0ee9b15be..04e976a85b 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -480,7 +480,7 @@ openTempFile' loc tmp_dir template binary mode = findTempName
          -- Otherwise, something is wrong, because (break (== '.')) should
          -- always return a pair with either the empty string or a string
          -- beginning with '.' as the second component.
-         _                      -> error "bug in System.IO.openTempFile"
+         _                      -> errorWithoutStackTrace "bug in System.IO.openTempFile"
 
     findTempName = do
       rs <- rand_string
diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs
index 7bdb97cebd..6c340e4597 100644
--- a/libraries/base/Text/ParserCombinators/ReadP.hs
+++ b/libraries/base/Text/ParserCombinators/ReadP.hs
@@ -248,7 +248,7 @@ gather (R m)
   gath _ Fail         = Fail
   gath l (Look f)     = Look (\s -> gath l (f s))
   gath l (Result k p) = k (l []) <|> gath l p
-  gath _ (Final _)    = error "do not use readS_to_P in gather!"
+  gath _ (Final _)    = errorWithoutStackTrace "do not use readS_to_P in gather!"
 
 -- ---------------------------------------------------------------------------
 -- Derived operations
diff --git a/libraries/base/Text/Printf.hs b/libraries/base/Text/Printf.hs
index 2ccbc11c2f..4d12e561c7 100644
--- a/libraries/base/Text/Printf.hs
+++ b/libraries/base/Text/Printf.hs
@@ -871,7 +871,7 @@ dfmt c p a d =
 --
 -- @since 4.7.0.0
 perror :: String -> a
-perror s = error $ "printf: " ++ s
+perror s = errorWithoutStackTrace $ "printf: " ++ s
 
 -- | Calls 'perror' to indicate an unknown format letter for
 -- a given type.
diff --git a/libraries/base/Text/Read.hs b/libraries/base/Text/Read.hs
index 0e752c2bbb..2479eb529a 100644
--- a/libraries/base/Text/Read.hs
+++ b/libraries/base/Text/Read.hs
@@ -87,4 +87,4 @@ readMaybe s = case readEither s of
 -- | The 'read' function reads input from a string, which must be
 -- completely consumed by the input process.
 read :: Read a => String -> a
-read s = either error id (readEither s)
+read s = either errorWithoutStackTrace id (readEither s)
diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs
index 608bf85de4..ed4d204c86 100644
--- a/libraries/base/Text/Read/Lex.hs
+++ b/libraries/base/Text/Read/Lex.hs
@@ -504,7 +504,7 @@ valInteger b0 ds0 = go b0 (length ds0) $ map fromIntegral ds0
       where
         d = d1 * b + d2
     combine _ []  = []
-    combine _ [_] = error "this should not happen"
+    combine _ [_] = errorWithoutStackTrace "this should not happen"
 
 -- Calculate a Rational from the exponent [of 10 to multiply with],
 -- the integral part of the mantissa and the digits of the fractional
@@ -536,7 +536,7 @@ valDig 16 c
   | 'A' <= c && c <= 'F' = Just (ord c - ord 'A' + 10)
   | otherwise            = Nothing
 
-valDig _ _ = error "valDig: Bad base"
+valDig _ _ = errorWithoutStackTrace "valDig: Bad base"
 
 valDecDig :: Char -> Maybe Int
 valDecDig c
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 92685ca773..8560fe7110 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -4,17 +4,33 @@
 
   * Bundled with GHC 8.0
 
+  * `error` and `undefined` now print a partial stack-trace alongside the error message.
+
+  * New `errorWithoutStackTrace` function throws an error without printing the stack trace.
+
   * The restore operation provided by `mask` and `uninterruptibleMask` now
     restores the previous masking state whatever the current masking state is.
 
-  * Redundant typeclass constraints have been removed:
-     - `Data.Ratio.{denominator,numerator}` have no `Integral` constraint anymore
-     - **TODO**
-
   * New `GHC.Generics.packageName` operation
 
   * New `GHC.Stack.CallStack` data type
 
+  * New `GHC.Generics.packageName` operation
+
+  * New `GHC.Stack.Types` module now contains the definition of
+    `CallStack` and `SrcLoc`
+
+  * New `GHC.Stack.Types.emptyCallStack` function builds an empty `CallStack`
+
+  * New `GHC.Stack.Types.freezeCallStack` function freezes a `CallStack` preventing future `pushCallStack` operations from having any effect
+
+  * New `GHC.Stack.Types.pushCallStack` function pushes a call-site onto a `CallStack`
+
+  * `GHC.SrcLoc` has been removed
+
+  * `GHC.Stack.showCallStack` and `GHC.SrcLoc.showSrcLoc` are now called
+    `GHC.Stack.prettyCallStack` and `GHC.Stack.prettySrcLoc` respectively
+
   * add `Data.List.NonEmpty` and `Data.Semigroup` (to become
     super-class of `Monoid` in the future). These modules were
     provided by the `semigroups` package previously. (#10365)
@@ -119,6 +135,10 @@
   * Generalize `Debug.Trace.{traceM, traceShowM}` from `Monad` to `Applicative`
     (#10023)
 
+  * Redundant typeclass constraints have been removed:
+     - `Data.Ratio.{denominator,numerator}` have no `Integral` constraint anymore
+     - **TODO**
+
   * Generalise `forever` from `Monad` to `Applicative`
 
   * Generalize `filterM`, `mapAndUnzipM`, `zipWithM`, `zipWithM_`, `replicateM`,
diff --git a/libraries/base/codepages/MakeTable.hs b/libraries/base/codepages/MakeTable.hs
index 7b3328e2d8..394d447a6d 100644
--- a/libraries/base/codepages/MakeTable.hs
+++ b/libraries/base/codepages/MakeTable.hs
@@ -73,12 +73,12 @@ parseLine s = case words s of
 readHex' :: Enum a => String -> a
 readHex' ('0':'x':s) = case readHex s of
     [(n,"")] -> toEnum n -- explicitly call toEnum to catch overflow errors.
-    _ -> error $ "Can't read hex: " ++ show s
-readHex' s = error $ "Can't read hex: " ++ show s
+    _ -> errorWithoutStackTrace $ "Can't read hex: " ++ show s
+readHex' s = errorWithoutStackTrace $ "Can't read hex: " ++ show s
 
 readCharHex :: String -> Char
 readCharHex s = if c > fromEnum (maxBound :: Word16)
-                    then error "Can't handle non-BMP character."
+                    then errorWithoutStackTrace "Can't handle non-BMP character."
                     else toEnum c
     where c = readHex' s
 
@@ -255,7 +255,7 @@ showHex' s = "\\x" ++ showHex s ""
 
 repDualByte :: Enum c => c -> String
 repDualByte c
-    | n >= 2^(16::Int) = error "value is too high!"
+    | n >= 2^(16::Int) = errorWithoutStackTrace "value is too high!"
     -- NOTE : this assumes little-endian architecture.  But we're only using this on Windows,
     -- so it's probably OK.
     | otherwise = showHex' (n `mod` 256) ++ showHex' (n `div` 256)
diff --git a/libraries/base/tests/readFloat.stderr b/libraries/base/tests/readFloat.stderr
index a3a84648f0..929906187e 100644
--- a/libraries/base/tests/readFloat.stderr
+++ b/libraries/base/tests/readFloat.stderr
@@ -1,3 +1 @@
 readFloat: Prelude.read: no parse
-CallStack (from ImplicitParams):
-  error, called at libraries/base/Text/Read.hs:90:17 in base:Text.Read