Use IP based CallStack in error and undefined

This patch modifies `error`, `undefined`, and `assertError` to use
implicit call-stacks to provide better error messages to users.

There are a few knock-on effects:

- `GHC.Classes.IP` is now wired-in so it can be used in the wired-in
  types for `error` and `undefined`.

- `TysPrim.tyVarList` has been replaced with a new function
  `TysPrim.mkTemplateTyVars`. `tyVarList` made it easy to introduce
  subtle bugs when you need tyvars of different kinds. The naive

  ```
  tv1 = head $ tyVarList kind1
  tv2 = head $ tyVarList kind2
  ```

  would result in `tv1` and `tv2` sharing a `Unique`, thus substitutions
  would be applied incorrectly, treating `tv1` and `tv2` as the same
  tyvar. `mkTemplateTyVars` avoids this pitfall by taking a list of kinds
  and producing a single tyvar of each kind.

- The types `GHC.SrcLoc.SrcLoc` and `GHC.Stack.CallStack` now live in
  ghc-prim.

- The type `GHC.Exception.ErrorCall` has a new constructor
  `ErrorCallWithLocation` that takes two `String`s instead of one, the
  2nd one being arbitrary metadata about the error (but usually the
  call-stack). A bi-directional pattern synonym `ErrorCall` continues to
  provide the old API.

Updates Cabal, array, and haddock submodules.

Reviewers: nh2, goldfire, simonpj, hvr, rwbarton, austin, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, rodlogic, goldfire, maoe, simonmar, carter,
liyang, bgamari, thomie

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

GHC Trac Issues: #5273

19 files changed, 104 insertions, 52 deletions

diff --git a/testsuite/tests/annotations/should_fail/annfail12.stderr b/testsuite/tests/annotations/should_fail/annfail12.stderr
index b3cbb4eb14..37e8378a7e 100644
--- a/testsuite/tests/annotations/should_fail/annfail12.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail12.stderr
@@ -1,6 +1,8 @@
 
-annfail12.hs:5:1:
+annfail12.hs:5:1: error:
     Exception when trying to run compile-time code:
       You were meant to see this error!
+CallStack:
+  error, called at annfail12.hs:5:12 in main:Annfail12
     In the annotation:
       {-# ANN f (error "You were meant to see this error!" :: Int) #-}
diff --git a/testsuite/tests/cabal/cabal07/cabal07.stderr b/testsuite/tests/cabal/cabal07/cabal07.stderr
index 39f80ff93f..049d77c9bf 100644
--- a/testsuite/tests/cabal/cabal07/cabal07.stderr
+++ b/testsuite/tests/cabal/cabal07/cabal07.stderr
@@ -1,6 +1,7 @@
 
-Q.hs:3:8:
+Q.hs:3:8: error:
     Could not find module ‘Data.Set’
-    It is a member of the hidden package ‘containers-<VERSION>@<HASH>’.
+    It is a member of the hidden package ‘containers-0.5.6.2@0tT640fErehCGZtZRn6YbE’.
     Perhaps you need to add ‘containers’ to the build-depends in your .cabal file.
     Use -v to see a list of the files searched for.
+ExitFailure 1
\ No newline at end of file
diff --git a/testsuite/tests/deriving/should_run/T9576.stderr b/testsuite/tests/deriving/should_run/T9576.stderr
index bc2a0b3247..49d41a3a36 100644
--- a/testsuite/tests/deriving/should_run/T9576.stderr
+++ b/testsuite/tests/deriving/should_run/T9576.stderr
@@ -1,4 +1,4 @@
-T9576: T9576.hs:6:31:
+T9576: T9576.hs:6:31: error:
     No instance for (Show Foo) arising from a use of ‘showsPrec’
     In the second argument of ‘(.)’, namely ‘(showsPrec 11 b1)’
     In the second argument of ‘showParen’, namely
diff --git a/testsuite/tests/driver/T1372/T1372.stderr b/testsuite/tests/driver/T1372/T1372.stderr
index 2f6bb5f94a..d48426cc9d 100644
--- a/testsuite/tests/driver/T1372/T1372.stderr
+++ b/testsuite/tests/driver/T1372/T1372.stderr
@@ -1,2 +1,3 @@
-

-Main.hs:5:5: error: Data constructor not in scope: T

+
+Main.hs:5:5: error: Data constructor not in scope: T
+ExitFailure 1
\ No newline at end of file
diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout
index cd9436e34a..b926ed2474 100644
--- a/testsuite/tests/ghci.debugger/scripts/break009.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout
@@ -2,3 +2,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11
 Stopped at ../Test6.hs:5:8-11
 _result :: a = _
 *** Exception: Prelude.head: empty list
+CallStack:
+  error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List
diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout
index b84023b643..dafc1fc397 100644
--- a/testsuite/tests/ghci.debugger/scripts/break011.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout
@@ -1,4 +1,6 @@
 *** Exception: foo
+CallStack:
+  error, called at <interactive>:2:1 in interactive:Ghci1
 Stopped at <exception thrown>
 _exception :: e = _
 Stopped at <exception thrown>
@@ -7,17 +9,29 @@ _exception :: e = _
 -2  : main (../Test7.hs:2:8-29)
 <end of history>
 Logged breakpoint at ../Test7.hs:2:18-28
-_result :: a
+_result :: a12
 Logged breakpoint at ../Test7.hs:2:8-29
-_result :: IO a
+_result :: IO a12
 no more logged breakpoints
 Logged breakpoint at ../Test7.hs:2:18-28
-_result :: a
+_result :: a12
 Stopped at <exception thrown>
 _exception :: e
 already at the beginning of the history
-_exception = SomeException "foo"
-_result :: a = _
-_exception :: SomeException = SomeException "foo"
+_exception = SomeException
+               (ErrorCallWithLocation
+                  "foo"
+                  "CallStack:
+  error, called at ../Test7.hs:2:18 in main:Main")
+_result :: a12 = _
+_exception :: SomeException = SomeException
+                                (ErrorCallWithLocation
+                                   "foo"
+                                   "CallStack:
+  error, called at ../Test7.hs:2:18 in main:Main")
 *** Exception: foo
+CallStack:
+  error, called at ../Test7.hs:2:18 in main:Main
 *** Exception: foo
+CallStack:
+  error, called at ../Test7.hs:2:18 in main:Main
diff --git a/testsuite/tests/ghci.debugger/scripts/break017.stdout b/testsuite/tests/ghci.debugger/scripts/break017.stdout
index 305289d216..4825e435bb 100644
--- a/testsuite/tests/ghci.debugger/scripts/break017.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break017.stdout
@@ -8,5 +8,8 @@ Printing 1
 as = 'b' : 'c' : (_t1::[Char])
 Forcing
 *** Exception: Prelude.undefined
+CallStack:
+  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  undefined, called at <interactive>:3:17 in interactive:Ghci1
 Printing 2
 as = 'b' : 'c' : (_t2::[Char])
diff --git a/testsuite/tests/ghci/scripts/T10501.stderr b/testsuite/tests/ghci/scripts/T10501.stderr
index 6c3cc16efd..b9e45ccc66 100644
--- a/testsuite/tests/ghci/scripts/T10501.stderr
+++ b/testsuite/tests/ghci/scripts/T10501.stderr
@@ -1,2 +1,7 @@
 *** Exception: Prelude.head: empty list
+CallStack:
+  error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List
 *** Exception: Prelude.undefined
+CallStack:
+  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  undefined, called at <interactive>:1:17 in interactive:Ghci1
diff --git a/testsuite/tests/ghci/scripts/T5557.stdout b/testsuite/tests/ghci/scripts/T5557.stdout
index e8585c00f0..aa3a83242e 100644
--- a/testsuite/tests/ghci/scripts/T5557.stdout
+++ b/testsuite/tests/ghci/scripts/T5557.stdout
@@ -1,2 +1,8 @@
 *** Exception: Prelude.undefined
+CallStack:
+  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  undefined, called at <interactive>:2:12 in interactive:Ghci1
 *** Exception: Prelude.undefined
+CallStack:
+  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  undefined, called at <interactive>:3:12 in interactive:Ghci1
diff --git a/testsuite/tests/ghci/scripts/ghci055.stdout b/testsuite/tests/ghci/scripts/ghci055.stdout
index 1bac2ab20e..03245e2097 100644
--- a/testsuite/tests/ghci/scripts/ghci055.stdout
+++ b/testsuite/tests/ghci/scripts/ghci055.stdout
@@ -1,3 +1,6 @@
-*** Exception: Prelude.undefined

-x :: t = *** Exception: Prelude.undefined

-y :: Integer = 3

+*** Exception: Prelude.undefined
+CallStack:
+  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  undefined, called at <interactive>:1:7 in interactive:Ghci1
+x :: t = _
+y :: Integer = 3
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index affc2671a8..7ded1feac4 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -452,7 +452,7 @@ test('T5321Fun',
              #  (increase due to new codegen)
              # 2014-09-03: 299656164     (specialisation and inlining)
              # 10/12/2014: 206406188     #  Improvements in constraint solver
-            (wordsize(64), 429921312, 10)])
+            (wordsize(64), 509921312, 10)])
              # prev:       585521080
              # 29/08/2012: 713385808     #  (increase due to new codegen)
              # 15/05/2013: 628341952     #  (reason for decrease unknown)
@@ -462,6 +462,9 @@ test('T5321Fun',
              # 06/11/2014: 541287000     #  Simon's flat-skol changes to the constraint solver
              # 10/12/2014: 408110888     #  Improvements in constraint solver
              # 16/12/2014: 429921312     #  Flattener parameterized over roles
+             # 10/08/2015: 509921312
+             #  (undefined now takes an implicit parameter and GHC -O0 does
+             #  not recognize that the application is bottom)
       ],
       compile,[''])
 
@@ -474,7 +477,7 @@ test('T5321FD',
             #  (increase due to new codegen)
             # 2014-07-31: 211699816 (Windows) (-11%)
             #  (due to better optCoercion, 5e7406d9, #9233)
-           (wordsize(64), 410895536, 10)])
+           (wordsize(64), 470895536, 10)])
             # prev:       418306336
             # 29/08/2012: 492905640
             #  (increase due to new codegen)
@@ -488,6 +491,9 @@ test('T5321FD',
             #  (due to better optCoercion, 5e7406d9, #9233)
             # 2014-10-08  410895536
             #  (various changes; biggest improvements due to 949ad67 and FastString package ids)
+            # 2015-08-10: 470895536
+            #  (undefined now takes an implicit parameter and GHC -O0 does
+            #  not recognize that the application is bottom)
       ],
       compile,[''])
 
diff --git a/testsuite/tests/simplCore/should_compile/EvalTest.stdout b/testsuite/tests/simplCore/should_compile/EvalTest.stdout
index 8bc22a42f2..b536c541c0 100644
--- a/testsuite/tests/simplCore/should_compile/EvalTest.stdout
+++ b/testsuite/tests/simplCore/should_compile/EvalTest.stdout
@@ -1 +1 @@
-rght [Dmd=<S,U>] :: AList a1
+rght [Dmd=<S,U>] :: AList a
diff --git a/testsuite/tests/simplCore/should_compile/T4930.hs b/testsuite/tests/simplCore/should_compile/T4930.hs
index ae5d4fd5f7..aeab39e39f 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.hs
+++ b/testsuite/tests/simplCore/should_compile/T4930.hs
@@ -1,5 +1,5 @@
 module T4930 where
 
 foo :: Int -> Int
-foo n = (if n < 5 then error "Too small" else n+2) 
+foo n = (if n < 5 then foo n else n+2)
         `seq` n+5
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index 3e140ddc92..552c8a8ddc 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -1,39 +1,39 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 23, types: 11, coercions: 0}
+Result size of Tidy Core = {terms: 35, types: 14, coercions: 0}
 
--- RHS size: {terms: 2, types: 0, coercions: 0}
-lvl :: [Char]
-[GblId, Str=DmdType]
-lvl = unpackCString# "Too small"#
-
--- RHS size: {terms: 2, types: 1, coercions: 0}
-T4930.foo1 :: Int
-[GblId, Str=DmdType b]
-T4930.foo1 = error @ Int lvl
+Rec {
+-- RHS size: {terms: 23, types: 6, coercions: 0}
+T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int#
+[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <L,U>]
+T4930.$wfoo =
+  \ (ww :: Int#) ->
+    case case tagToEnum# @ Bool (<# ww 5#) of _ [Occ=Dead] {
+           False -> I# (+# ww 2#);
+           True -> case T4930.$wfoo ww of ww1 { __DEFAULT -> I# ww1 }
+         }
+    of _ [Occ=Dead] { I# ipv ->
+    +# ww 5#
+    }
+end Rec }
 
--- RHS size: {terms: 16, types: 5, coercions: 0}
-foo :: Int -> Int
+-- RHS size: {terms: 10, types: 4, coercions: 0}
+foo [InlPrag=INLINE[0]] :: Int -> Int
 [GblId,
  Arity=1,
+ Caf=NoCafRefs,
  Str=DmdType <S,1*U(U)>m,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (n [Occ=Once!] :: Int) ->
-                 case n of _ [Occ=Dead] { I# x ->
-                 case tagToEnum# @ Bool (<# x 5#) of _ [Occ=Dead] {
-                   False -> I# (+# x 5#);
-                   True -> T4930.foo1
-                 }
+         Tmpl= \ (w [Occ=Once!] :: Int) ->
+                 case w of _ [Occ=Dead] { I# ww1 [Occ=Once] ->
+                 case T4930.$wfoo ww1 of ww2 { __DEFAULT -> I# ww2 }
                  }}]
 foo =
-  \ (n :: Int) ->
-    case n of _ [Occ=Dead] { I# x ->
-    case tagToEnum# @ Bool (<# x 5#) of _ [Occ=Dead] {
-      False -> I# (+# x 5#);
-      True -> T4930.foo1
-    }
+  \ (w :: Int) ->
+    case w of _ [Occ=Dead] { I# ww1 ->
+    case T4930.$wfoo ww1 of ww2 { __DEFAULT -> I# ww2 }
     }
 
 
diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr
index c899ed5aa6..695c69e3d9 100644
--- a/testsuite/tests/th/T5358.stderr
+++ b/testsuite/tests/th/T5358.stderr
@@ -2,6 +2,8 @@
 T5358.hs:14:12: error:
     Exception when trying to run compile-time code:
       runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool
+CallStack:
+  error, called at T5358.hs:15:18 in main:T5358
     Code: do { VarI _ t _ <- reify (mkName "prop_x1");
                ($) error ((++) "runTest called error: " pprint t) }
     In the untyped splice:
diff --git a/testsuite/tests/th/T5976.stderr b/testsuite/tests/th/T5976.stderr
index 64cf33acef..f434458a01 100644
--- a/testsuite/tests/th/T5976.stderr
+++ b/testsuite/tests/th/T5976.stderr
@@ -1,5 +1,7 @@
 
-T5976.hs:1:1:
+T5976.hs:1:1: error:
     Exception when trying to run compile-time code:
       bar
-      Code: error ((++) "foo " error "bar")
+CallStack:
+  error, called at T5976.hs:3:21 in main:Main
+    Code: error ((++) "foo " error "bar")
diff --git a/testsuite/tests/th/T7276a.stdout b/testsuite/tests/th/T7276a.stdout
index 3e8c4878a8..410004b14d 100644
--- a/testsuite/tests/th/T7276a.stdout
+++ b/testsuite/tests/th/T7276a.stdout
@@ -1,14 +1,14 @@
 
-<interactive>:3:9: Warning:
+<interactive>:3:9: warning:
     Couldn't match type ‘[Dec]’ with ‘Exp’
     Expected type: Q Exp
       Actual type: DecsQ
     In the expression: [d| a = () |] :: Q Exp
     In an equation for ‘x’: x = [d| a = () |] :: Q Exp
 
-<interactive>:1:1:
+<interactive>:1:1: error:
     Exception when trying to run compile-time code:
-      <interactive>:3:9:
+      <interactive>:3:9: error:
     Couldn't match type ‘[Dec]’ with ‘Exp’
     Expected type: Q Exp
       Actual type: DecsQ
diff --git a/testsuite/tests/th/T8987.stderr b/testsuite/tests/th/T8987.stderr
index 2b128bb101..6df4f7d4ec 100644
--- a/testsuite/tests/th/T8987.stderr
+++ b/testsuite/tests/th/T8987.stderr
@@ -1,5 +1,8 @@
 
-T8987.hs:1:1:
+T8987.hs:1:1: error:
     Exception when trying to run compile-time code:
       Prelude.undefined
+CallStack:
+  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  undefined, called at T8987.hs:6:23 in main:T8987
     Code: (>>) reportWarning ['1', undefined] return []
diff --git a/testsuite/tests/th/TH_exn2.stderr b/testsuite/tests/th/TH_exn2.stderr
index 79ec99171a..fb914289a3 100644
--- a/testsuite/tests/th/TH_exn2.stderr
+++ b/testsuite/tests/th/TH_exn2.stderr
@@ -1,6 +1,8 @@
 
-TH_exn2.hs:1:1:
+TH_exn2.hs:1:1: error:
     Exception when trying to run compile-time code:
       Prelude.tail: empty list
-      Code: do { ds <- [d| |];
-                 return (tail ds) }
+CallStack:
+  error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List
+    Code: do { ds <- [d| |];
+               return (tail ds) }