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

1 files changed, 7 insertions, 7 deletions

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))