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

48 files changed, 409 insertions, 269 deletions

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 6895677a8f..ad584a325e 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -1088,7 +1088,7 @@ proxyHashId
     ty      = mkForAllTys [kv, tv] (mkProxyPrimTy k t)
     kv      = kKiVar
     k       = mkTyVarTy kv
-    tv:_    = tyVarList k
+    [tv]    = mkTemplateTyVars [k]
     t       = mkTyVarTy tv
 
 ------------------------------------------------
diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs
index 8bdee4ae5f..3c115f419c 100644
--- a/compiler/coreSyn/MkCore.hs
+++ b/compiler/coreSyn/MkCore.hs
@@ -717,19 +717,30 @@ errorName :: Name
 errorName = mkWiredInIdName gHC_ERR (fsLit "error") errorIdKey eRROR_ID
 
 eRROR_ID :: Id
-eRROR_ID = pc_bottoming_Id1 errorName errorTy
+eRROR_ID = pc_bottoming_Id2 errorName errorTy
 
 errorTy  :: Type   -- See Note [Error and friends have an "open-tyvar" forall]
-errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
+errorTy  = mkSigmaTy [openAlphaTyVar] []
+             (mkFunTys [ mkClassPred
+                           ipClass
+                           [ mkStrLitTy (fsLit "callStack")
+                           , mkTyConTy callStackTyCon ]
+                       , mkListTy charTy]
+                       openAlphaTy)
 
 undefinedName :: Name
 undefinedName = mkWiredInIdName gHC_ERR (fsLit "undefined") undefinedKey uNDEFINED_ID
 
 uNDEFINED_ID :: Id
-uNDEFINED_ID = pc_bottoming_Id0 undefinedName undefinedTy
+uNDEFINED_ID = pc_bottoming_Id1 undefinedName undefinedTy
 
 undefinedTy  :: Type   -- See Note [Error and friends have an "open-tyvar" forall]
-undefinedTy  = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
+undefinedTy  = mkSigmaTy [openAlphaTyVar] []
+                 (mkFunTy (mkClassPred
+                             ipClass
+                             [ mkStrLitTy (fsLit "callStack")
+                             , mkTyConTy callStackTyCon ])
+                          openAlphaTy)
 
 {-
 Note [Error and friends have an "open-tyvar" forall]
@@ -773,10 +784,11 @@ pc_bottoming_Id1 name ty
     strict_sig = mkClosedStrictSig [evalDmd] botRes
     -- These "bottom" out, no matter what their arguments
 
-pc_bottoming_Id0 :: Name -> Type -> Id
--- Same but arity zero
-pc_bottoming_Id0 name ty
+pc_bottoming_Id2 :: Name -> Type -> Id
+-- Same but arity two
+pc_bottoming_Id2 name ty
  = mkVanillaGlobalWithInfo name ty bottoming_info
  where
     bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig
-    strict_sig = mkClosedStrictSig [] botRes
+                                   `setArityInfo`      2
+    strict_sig = mkClosedStrictSig [evalDmd, evalDmd] botRes
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 9d95b485f3..8be97dfe40 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -61,7 +61,7 @@ import Var
 -- import RnEnv( FastStringEnv, mkFsEnv, lookupFsEnv )
 import TysWiredIn
 import TysPrim
-import PrelNames( funTyConKey, ipClassName )
+import PrelNames( funTyConKey )
 import Name
 import BasicTypes
 import Binary
@@ -636,7 +636,7 @@ pprIfaceTypeApp tc args = sdocWithDynFlags (pprTyTcApp TopPrec tc args)
 
 pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
 pprTyTcApp ctxt_prec tc tys dflags
-  | ifaceTyConName tc == ipClassName
+  | ifaceTyConName tc == getName ipTyCon
   , ITC_Type (IfaceLitTy (IfaceStrTyLit n)) (ITC_Type ty ITC_Nil) <- tys
   = char '?' <> ftext n <> ptext (sLit "::") <> ppr_ty TopPrec ty
 
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 12a1543d44..e56307fa94 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -320,9 +320,6 @@ basicKnownKeyNames
         -- Type-level naturals
         knownNatClassName, knownSymbolClassName,
 
-        -- Implicit parameters
-        ipClassName,
-
         -- Source locations
         callStackDataConName, callStackTyConName,
         srcLocDataConName,
@@ -1172,18 +1169,14 @@ knownNatClassName     = clsQual gHC_TYPELITS (fsLit "KnownNat") knownNatClassNam
 knownSymbolClassName :: Name
 knownSymbolClassName  = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey
 
--- Implicit parameters
-ipClassName :: Name
-ipClassName         = clsQual gHC_CLASSES (fsLit "IP") ipClassNameKey
-
 -- Source Locations
 callStackDataConName, callStackTyConName, srcLocDataConName :: Name
 callStackDataConName
-  = dcQual gHC_STACK  (fsLit "CallStack") callStackDataConKey
+  = dcQual gHC_TYPES  (fsLit "CallStack") callStackDataConKey
 callStackTyConName
-  = tcQual  gHC_STACK (fsLit "CallStack") callStackTyConKey
+  = tcQual  gHC_TYPES (fsLit "CallStack") callStackTyConKey
 srcLocDataConName
-  = dcQual gHC_SRCLOC (fsLit "SrcLoc")   srcLocDataConKey
+  = dcQual gHC_TYPES (fsLit "SrcLoc")   srcLocDataConKey
 
 -- plugins
 pLUGINS :: Module
@@ -1312,9 +1305,6 @@ knownSymbolClassNameKey = mkPreludeClassUnique 43
 ghciIoClassKey :: Unique
 ghciIoClassKey = mkPreludeClassUnique 44
 
-ipClassNameKey :: Unique
-ipClassNameKey = mkPreludeClassUnique 45
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1540,6 +1530,14 @@ callStackTyConKey = mkPreludeTyConUnique 182
 typeRepTyConKey :: Unique
 typeRepTyConKey = mkPreludeTyConUnique 183
 
+-- Implicit Parameters
+ipTyConKey :: Unique
+ipTyConKey = mkPreludeTyConUnique 184
+
+ipCoNameKey :: Unique
+ipCoNameKey = mkPreludeTyConUnique 185
+
+
 ---------------- Template Haskell -------------------
 --      USES TyConUniques 200-299
 -----------------------------------------------------
@@ -1615,6 +1613,9 @@ callStackDataConKey, srcLocDataConKey :: Unique
 callStackDataConKey                     = mkPreludeDataConUnique 36
 srcLocDataConKey                        = mkPreludeDataConUnique 37
 
+ipDataConKey :: Unique
+ipDataConKey                            = mkPreludeDataConUnique 38
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index d45c6880a0..5ce89ad7ef 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -10,7 +10,8 @@
 -- | This module defines TyCons that can't be expressed in Haskell.
 --   They are all, therefore, wired-in TyCons.  C.f module TysWiredIn
 module TysPrim(
-        tyVarList, alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
+        mkTemplateTyVars,
+        alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
         alphaTy, betaTy, gammaTy, deltaTy,
         openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, openAlphaTyVars,
         kKiVar,
@@ -205,18 +206,19 @@ alphaTyVars is a list of type variables for use in templates:
         ["a", "b", ..., "z", "t1", "t2", ... ]
 -}
 
-tyVarList :: Kind -> [TyVar]
-tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
-                                (mkTyVarOccFS (mkFastString name))
-                                noSrcSpan) kind
-                 | u <- [2..],
-                   let name | c <= 'z'  = [c]
-                            | otherwise = 't':show u
-                            where c = chr (u-2 + ord 'a')
-                 ]
+mkTemplateTyVars :: [Kind] -> [TyVar]
+mkTemplateTyVars kinds =
+  [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
+                            (mkTyVarOccFS (mkFastString name))
+                            noSrcSpan) k
+  | (k,u) <- zip kinds [2..],
+    let name | c <= 'z'  = [c]
+             | otherwise = 't':show u
+          where c = chr (u-2 + ord 'a')
+  ]
 
 alphaTyVars :: [TyVar]
-alphaTyVars = tyVarList liftedTypeKind
+alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind
 
 betaTyVars :: [TyVar]
 betaTyVars = tail alphaTyVars
@@ -234,14 +236,15 @@ alphaTy, betaTy, gammaTy, deltaTy :: Type
         -- result type for "error", so that we can have (error Int# "Help")
 openAlphaTyVars :: [TyVar]
 openAlphaTyVar, openBetaTyVar :: TyVar
-openAlphaTyVars@(openAlphaTyVar:openBetaTyVar:_) = tyVarList openTypeKind
+openAlphaTyVars@(openAlphaTyVar:openBetaTyVar:_)
+  = mkTemplateTyVars $ repeat openTypeKind
 
 openAlphaTy, openBetaTy :: Type
 openAlphaTy = mkTyVarTy openAlphaTyVar
 openBetaTy  = mkTyVarTy openBetaTyVar
 
 kKiVar :: KindVar
-kKiVar = (tyVarList superKind) !! 10
+kKiVar = (mkTemplateTyVars $ repeat superKind) !! 10
 
 {-
 ************************************************************************
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index f8ee24fbe8..449377d03c 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -75,6 +75,11 @@ module TysWiredIn (
         eqTyCon_RDR, eqTyCon, eqTyConName, eqBoxDataCon,
         coercibleTyCon, coercibleDataCon, coercibleClass,
 
+        -- * Implicit Parameters
+        ipTyCon, ipDataCon, ipClass,
+
+        callStackTyCon,
+
         mkWiredInTyConName -- This is used in TcTypeNats to define the
                            -- built-in functions for evaluation.
     ) where
@@ -88,6 +93,8 @@ import PrelNames
 import TysPrim
 
 -- others:
+import CoAxiom
+import Coercion
 import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
 import Module           ( Module )
 import Type             ( mkTyConApp )
@@ -160,6 +167,7 @@ wiredInTyCons = [ unitTyCon     -- Not treated like other tuples, because
               , coercibleTyCon
               , typeNatKindCon
               , typeSymbolKindCon
+              , ipTyCon
               ]
 
 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -174,6 +182,13 @@ mkWiredInDataConName built_in modu fs unique datacon
                   (AConLike (RealDataCon datacon))    -- Relevant DataCon
                   built_in
 
+mkWiredInCoAxiomName :: BuiltInSyntax -> Module -> FastString -> Unique
+                     -> CoAxiom Branched -> Name
+mkWiredInCoAxiomName built_in modu fs unique ax
+  = mkWiredInName modu (mkTcOccFS fs) unique
+                  (ACoAxiom ax)        -- Relevant CoAxiom
+                  built_in
+
 -- See Note [Kind-changing of (~) and Coercible]
 eqTyConName, eqBoxDataConName :: Name
 eqTyConName      = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "~")   eqTyConKey      eqTyCon
@@ -896,14 +911,14 @@ eqTyCon = mkAlgTyCon eqTyConName
   where
     kv = kKiVar
     k = mkTyVarTy kv
-    a:b:_ = tyVarList k
+    [a,b] = mkTemplateTyVars [k,k]
 
 eqBoxDataCon :: DataCon
 eqBoxDataCon = pcDataCon eqBoxDataConName args [TyConApp eqPrimTyCon (map mkTyVarTy args)] eqTyCon
   where
     kv = kKiVar
     k = mkTyVarTy kv
-    a:b:_ = tyVarList k
+    [a,b] = mkTemplateTyVars [k,k]
     args = [kv, a, b]
 
 
@@ -914,7 +929,7 @@ coercibleTyCon = mkClassTyCon
   where kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind)
         kv = kKiVar
         k = mkTyVarTy kv
-        a:b:_ = tyVarList k
+        [a,b] = mkTemplateTyVars [k,k]
         tvs = [kv, a, b]
         rhs = DataTyCon [coercibleDataCon] False
 
@@ -923,8 +938,59 @@ coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon
   where
     kv = kKiVar
     k = mkTyVarTy kv
-    a:b:_ = tyVarList k
+    [a,b] = mkTemplateTyVars [k,k]
     args = [kv, a, b]
 
 coercibleClass :: Class
 coercibleClass = mkClass (tyConTyVars coercibleTyCon) [] [] [] [] [] (mkAnd []) coercibleTyCon
+
+{-
+Note [The Implicit Parameter class]
+
+Implicit parameters `?x :: a` are desugared into dictionaries for the
+class `IP "x" a`, which is defined (in GHC.Classes) as
+
+  class IP (x :: Symbol) a | x -> a
+
+This class is wired-in so that `error` and `undefined`, which have
+wired-in types, can use the implicit-call-stack feature to provide
+a call-stack alongside the error message.
+-}
+
+ipDataConName, ipTyConName, ipCoName :: Name
+ipDataConName = mkWiredInDataConName UserSyntax gHC_CLASSES (fsLit "IP")
+                  ipDataConKey ipDataCon
+ipTyConName   = mkWiredInTyConName UserSyntax gHC_CLASSES (fsLit "IP")
+                  ipTyConKey ipTyCon
+ipCoName      = mkWiredInCoAxiomName BuiltInSyntax gHC_CLASSES (fsLit "NTCo:IP")
+                  ipCoNameKey (toBranchedAxiom ipCoAxiom)
+
+-- See Note [The Implicit Parameter class]
+ipTyCon :: TyCon
+ipTyCon = mkClassTyCon ipTyConName kind [ip,a] [] rhs ipClass NonRecursive
+  where
+    kind = mkArrowKinds [typeSymbolKind, liftedTypeKind] constraintKind
+    [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
+    rhs = NewTyCon ipDataCon (mkTyVarTy a) ([], mkTyVarTy a) ipCoAxiom
+
+ipCoAxiom :: CoAxiom Unbranched
+ipCoAxiom = mkNewTypeCo ipCoName ipTyCon [ip,a] [Nominal, Nominal] (mkTyVarTy a)
+  where
+    [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
+
+ipDataCon :: DataCon
+ipDataCon = pcDataCon ipDataConName [ip,a] ts ipTyCon
+  where
+    [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
+    ts  = [mkTyVarTy a]
+
+ipClass :: Class
+ipClass = mkClass (tyConTyVars ipTyCon) [([ip], [a])] [] [] [] [] (mkAnd [])
+            ipTyCon
+  where
+    [ip, a] = tyConTyVars ipTyCon
+
+-- this is a fake version of the CallStack TyCon so we can refer to it
+-- in MkCore.errorTy
+callStackTyCon :: TyCon
+callStackTyCon = pcNonRecDataTyCon callStackTyConName Nothing [] []
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 8a7ca4d5c1..897828d5ec 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -37,6 +37,7 @@ import FamInst( tcGetFamInstEnvs )
 import TyCon
 import TcType
 import TysPrim
+import TysWiredIn
 import Id
 import Var
 import VarSet
@@ -56,7 +57,7 @@ import BasicTypes
 import Outputable
 import FastString
 import Type(mkStrLitTy)
-import PrelNames( ipClassName, gHC_PRIM )
+import PrelNames( gHC_PRIM )
 import TcValidity (checkValidType)
 
 import Control.Monad
@@ -225,8 +226,7 @@ tcLocalBinds (HsValBinds (ValBindsOut binds sigs)) thing_inside
 tcLocalBinds (HsValBinds (ValBindsIn {})) _ = panic "tcLocalBinds"
 
 tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
-  = do  { ipClass <- tcLookupClass ipClassName
-        ; (given_ips, ip_binds') <-
+  = do  { (given_ips, ip_binds') <-
             mapAndUnzipM (wrapLocSndM (tc_ip_bind ipClass)) ip_binds
 
         -- If the binding binds ?x = E, we  must now
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index d2b0c59244..354515a72e 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -46,7 +46,7 @@ import Var
 import VarSet
 import VarEnv
 import TysWiredIn
-import TysPrim( intPrimTy, addrPrimTy )
+import TysPrim( intPrimTy )
 import PrimOp( tagToEnumKey )
 import PrelNames
 import DynFlags
@@ -191,7 +191,6 @@ tcExpr (NegApp expr neg_expr) res_ty
 
 tcExpr (HsIPVar x) res_ty
   = do { let origin = IPOccOrigin x
-       ; ipClass <- tcLookupClass ipClassName
            {- Implicit parameters must have a *tau-type* not a.
               type scheme.  We enforce this by creating a fresh
               type variable as its type.  (Because res_ty may not
@@ -1067,25 +1066,19 @@ tcInferIdWithOrig orig id_name
   = do { dflags <- getDynFlags
        ; if gopt Opt_IgnoreAsserts dflags
          then tc_infer_id orig id_name
-         else tc_infer_assert dflags orig }
+         else tc_infer_assert orig }
 
   | otherwise
   = tc_infer_id orig id_name
 
-tc_infer_assert :: DynFlags -> CtOrigin -> TcM (HsExpr TcId, TcRhoType)
+tc_infer_assert :: CtOrigin -> TcM (HsExpr TcId, TcRhoType)
 -- Deal with an occurrence of 'assert'
 -- See Note [Adding the implicit parameter to 'assert']
-tc_infer_assert dflags orig
-  = do { sloc <- getSrcSpanM
-       ; assert_error_id <- tcLookupId assertErrorName
+tc_infer_assert orig
+  = do { assert_error_id <- tcLookupId assertErrorName
        ; (wrap, id_rho) <- deeplyInstantiate orig (idType assert_error_id)
-       ; let (arg_ty, res_ty) = case tcSplitFunTy_maybe id_rho of
-                                   Nothing      -> pprPanic "assert type" (ppr id_rho)
-                                   Just arg_res -> arg_res
-       ; ASSERT( arg_ty `tcEqType` addrPrimTy )
-         return (HsApp (L sloc (mkHsWrap wrap (HsVar assert_error_id)))
-                       (L sloc (srcSpanPrimLit dflags sloc))
-                , res_ty) }
+       ; return (mkHsWrap wrap (HsVar assert_error_id), id_rho)
+       }
 
 tc_infer_id :: CtOrigin -> Name -> TcM (HsExpr TcId, TcRhoType)
 -- Return type is deeply instantiated
@@ -1133,17 +1126,12 @@ tc_infer_id orig id_name
       | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel id)
       | otherwise                  = return ()
 
-srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr TcId
-srcSpanPrimLit dflags span
-    = HsLit (HsStringPrim "" (unsafeMkByteString
-                             (showSDocOneLine dflags (ppr span))))
-
 {-
 Note [Adding the implicit parameter to 'assert']
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The typechecker transforms (assert e1 e2) to (assertError "Foo.hs:27"
-e1 e2).  This isn't really the Right Thing because there's no way to
-"undo" if you want to see the original source code in the typechecker
+The typechecker transforms (assert e1 e2) to (assertError e1 e2).
+This isn't really the Right Thing because there's no way to "undo"
+if you want to see the original source code in the typechecker
 output.  We'll have fix this in due course, when we care more about
 being able to reconstruct the exact original program.
 
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 605929efbe..39ab4e621b 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -72,7 +72,7 @@ import Util
 
 import Data.Maybe( isNothing )
 import Control.Monad ( unless, when, zipWithM )
-import PrelNames( ipClassName, funTyConKey, allNameStrings )
+import PrelNames( funTyConKey, allNameStrings )
 
 {-
         ----------------------------
@@ -490,7 +490,6 @@ tc_hs_type hs_ty@(HsExplicitTupleTy _ tys) exp_kind
 tc_hs_type ipTy@(HsIParamTy n ty) exp_kind
   = do { ty' <- tc_lhs_type ty ekLifted
        ; checkExpectedKind ipTy constraintKind exp_kind
-       ; ipClass <- tcLookupClass ipClassName
        ; let n' = mkStrLitTy $ hsIPNameFS n
        ; return (mkClassPred ipClass [n',ty'])
        }
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 0684fdf1d5..6feb3f0c33 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -20,9 +20,9 @@ import CoAxiom(sfInteractTop, sfInteractInert)
 
 import Var
 import TcType
-import PrelNames ( knownNatClassName, knownSymbolClassName, ipClassNameKey,
+import PrelNames ( knownNatClassName, knownSymbolClassName,
                    callStackTyConKey, typeableClassName )
-import TysWiredIn ( typeNatKind, typeSymbolKind )
+import TysWiredIn ( ipClass, typeNatKind, typeSymbolKind )
 import Id( idType )
 import Class
 import TyCon
@@ -704,7 +704,7 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs
          else
             continueWith workItem }
 
-  | cls `hasKey` ipClassNameKey
+  | cls == ipClass
   , isGiven ev_w
   = interactGivenIP inerts workItem
 
@@ -1755,7 +1755,7 @@ Other notes:
 -- i.e.   (IP "name" CallStack)
 isCallStackIP :: CtLoc -> Class -> [Type] -> Maybe (EvTerm -> EvCallStack)
 isCallStackIP loc cls tys
-  | cls `hasKey` ipClassNameKey
+  | cls == ipClass
   , [_ip_name, ty] <- tys
   , Just (tc, _) <- splitTyConApp_maybe ty
   , tc `hasKey` callStackTyConKey
diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs
index 9815958da7..18d3b32fdd 100644
--- a/compiler/typecheck/TcTypeNats.hs
+++ b/compiler/typecheck/TcTypeNats.hs
@@ -29,7 +29,7 @@ import TysWiredIn ( typeNatKind, typeSymbolKind
                   , promotedEQDataCon
                   , promotedGTDataCon
                   )
-import TysPrim    ( tyVarList, mkArrowKinds )
+import TysPrim    ( mkArrowKinds, mkTemplateTyVars )
 import PrelNames  ( gHC_TYPELITS
                   , typeNatAddTyFamNameKey
                   , typeNatMulTyFamNameKey
@@ -106,7 +106,7 @@ typeNatLeqTyCon :: TyCon
 typeNatLeqTyCon =
   mkFamilyTyCon name
     (mkArrowKinds [ typeNatKind, typeNatKind ] boolKind)
-    (take 2 $ tyVarList typeNatKind)
+    (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     (BuiltInSynFamTyCon ops)
     NoParentTyCon
 
@@ -123,7 +123,7 @@ typeNatCmpTyCon :: TyCon
 typeNatCmpTyCon =
   mkFamilyTyCon name
     (mkArrowKinds [ typeNatKind, typeNatKind ] orderingKind)
-    (take 2 $ tyVarList typeNatKind)
+    (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     (BuiltInSynFamTyCon ops)
     NoParentTyCon
 
@@ -140,7 +140,7 @@ typeSymbolCmpTyCon :: TyCon
 typeSymbolCmpTyCon =
   mkFamilyTyCon name
     (mkArrowKinds [ typeSymbolKind, typeSymbolKind ] orderingKind)
-    (take 2 $ tyVarList typeSymbolKind)
+    (mkTemplateTyVars [ typeSymbolKind, typeSymbolKind ])
     (BuiltInSynFamTyCon ops)
     NoParentTyCon
 
@@ -162,7 +162,7 @@ mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
 mkTypeNatFunTyCon2 op tcb =
   mkFamilyTyCon op
     (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind)
-    (take 2 $ tyVarList typeNatKind)
+    (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     (BuiltInSynFamTyCon tcb)
     NoParentTyCon
 
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 1ee53ba582..a2feeef723 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -163,7 +163,7 @@ import TyCon
 import TysPrim
 import {-# SOURCE #-} TysWiredIn ( eqTyCon, coercibleTyCon, typeNatKind, typeSymbolKind )
 import PrelNames ( eqTyConKey, coercibleTyConKey,
-                   ipClassNameKey, openTypeKindTyConKey,
+                   ipTyConKey, openTypeKindTyConKey,
                    constraintKindTyConKey, liftedTypeKindTyConKey )
 import CoAxiom
 
@@ -908,10 +908,10 @@ isIPPred ty = case tyConAppTyCon_maybe ty of
     _       -> False
 
 isIPTyCon :: TyCon -> Bool
-isIPTyCon tc = tc `hasKey` ipClassNameKey
+isIPTyCon tc = tc `hasKey` ipTyConKey
 
 isIPClass :: Class -> Bool
-isIPClass cls = cls `hasKey` ipClassNameKey
+isIPClass cls = cls `hasKey` ipTyConKey
   -- Class and it corresponding TyCon have the same Unique
 
 isCTupleClass :: Class -> Bool
diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs
index e2be8a0ec4..291e14ccc1 100644
--- a/compiler/types/TypeRep.hs
+++ b/compiler/types/TypeRep.hs
@@ -703,7 +703,7 @@ pprTyTcApp :: TyPrec -> TyCon -> [Type] -> SDoc
 -- Used for types only; so that we can make a
 -- special case for type-level lists
 pprTyTcApp p tc tys
-  | tc `hasKey` ipClassNameKey
+  | tc `hasKey` ipTyConKey
   , [LitTy (StrTyLit n),ty] <- tys
   = maybeParen p FunPrec $
     char '?' <> ftext n <> ptext (sLit "::") <> ppr_type TopPrec ty
diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml
index 386095e1d9..582966639e 100644
--- a/docs/users_guide/7.12.1-notes.xml
+++ b/docs/users_guide/7.12.1-notes.xml
@@ -46,8 +46,8 @@
            </listitem>
             <listitem>
                 <para>
-                    Implicit parameters of the new base type
-                    <literal>GHC.Stack.CallStack</literal> are treated
+                    Implicit parameters of the new ghc-prim type
+                    <literal>GHC.Types.CallStack</literal> are treated
                     specially, and automatically solved for the current source
                     location. For example
                     <programlisting>
@@ -66,7 +66,7 @@
                     parameter does not matter.
                </para>
                 <para>
-                    See the release notes for base for a description of the
+                    See the release notes for ghc-prim for a description of the
                     <literal>CallStack</literal> type.
                </para>
             </listitem>
@@ -249,19 +249,16 @@
            </listitem>
             <listitem>
                 <para>
-                    A new module <literal>GHC.SrcLoc</literal> was added,
-                    exporting a new type <literal>SrcLoc</literal>. A
-                    <literal>SrcLoc</literal> contains package, module,
-                    and file names, as well as start and end positions.
+                    The functions <literal>error</literal>,
+                    <literal>undefined</literal>, and
+                    <literal>assertError</literal> now take an implicit
+                    <literal>CallStack</literal> parameter, and will
+                    output a formatted call stack alongside the error
+                    message.
                </para>
-           </listitem>
-            <listitem>
                 <para>
-                    A new type <literal>CallStack</literal> was added for use
-                    with the new implicit callstack parameters. A
-                    <literal>CallStack</literal> is a
-                    <literal>[(String, SrcLoc)]</literal>, sorted by most-recent
-                    call.
+                    See <xref linkend="implicit-parameters-special"/> for a description of the
+                    implicit call stack feature.
                </para>
            </listitem>
             <listitem>
@@ -400,6 +397,22 @@
                     Version number XXXXX (was 0.3.1.0)
                </para>
            </listitem>
+            <listitem>
+                <para>
+                    A new type <literal>SrcLoc</literal> was added. A
+                    <literal>SrcLoc</literal> contains package, module,
+                    and file names, as well as start and end positions.
+               </para>
+           </listitem>
+            <listitem>
+                <para>
+                    A new type <literal>CallStack</literal> was added for use
+                    with the new implicit callstack parameters. A
+                    <literal>CallStack</literal> is a
+                    <literal>[(String, SrcLoc)]</literal>, sorted by most-recent
+                    call.
+               </para>
+           </listitem>
        </itemizedlist>
     </sect3>
 
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 92cbdc05a7..f8fa9c34c6 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -8124,9 +8124,9 @@ inner binding of <literal>?x</literal>, so <literal>(f 9)</literal> will return
 </para>
 </sect3>
 
-<sect3><title>Special implicit parameters</title>
+<sect3 id="implicit-parameters-special"><title>Special implicit parameters</title>
 <para>
-GHC treats implicit parameters of type <literal>GHC.Stack.CallStack</literal>
+GHC treats implicit parameters of type <literal>GHC.Types.CallStack</literal>
 specially, by resolving them to the current location in the program. Consider:
 <programlisting>
   f :: String
diff --git a/libraries/Cabal b/libraries/Cabal
-Subproject f47732a50d4bd103c5660c2fbcd77cbce8c521b
+Subproject ad1136358d10d68f3d94fa2fe0f11a25331bdf1
diff --git a/libraries/array b/libraries/array
-Subproject 68323b26865ec86a53237ca8974e82bf406a971
+Subproject 2f5b772f4475d70a68c6f9d10390ac9812afdb7
diff --git a/libraries/base/Control/Exception.hs b/libraries/base/Control/Exception.hs
index 9c388f4450..1383972c7a 100644
--- a/libraries/base/Control/Exception.hs
+++ b/libraries/base/Control/Exception.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}
+{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification, PatternSynonyms #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -56,6 +56,7 @@ module Control.Exception (
         RecSelError(..),
         RecUpdError(..),
         ErrorCall(..),
+        pattern ErrorCall,
         TypeError(..),
 
         -- * Throwing exceptions
diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs
index ece5c69dd5..ba2502f379 100644
--- a/libraries/base/Control/Exception/Base.hs
+++ b/libraries/base/Control/Exception/Base.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 -----------------------------------------------------------------------------
@@ -38,7 +39,7 @@ module Control.Exception.Base (
         RecConError(..),
         RecSelError(..),
         RecUpdError(..),
-        ErrorCall(..),
+        ErrorCall(..), pattern ErrorCall,
         TypeError(..), -- #10284, custom error type for deferred type errors
 
         -- * Throwing exceptions
diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs
index 9bd71327d9..8cdb10709d 100644
--- a/libraries/base/GHC/Err.hs
+++ b/libraries/base/GHC/Err.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -28,17 +28,17 @@ import GHC.Prim
 import GHC.Integer ()   -- Make sure Integer is compiled first
                         -- because GHC depends on it in a wired-in way
                         -- so the build system doesn't see the dependency
-import {-# SOURCE #-} GHC.Exception( errorCallException )
+import {-# SOURCE #-} GHC.Exception( errorCallWithCallStackException )
 
 -- | 'error' stops execution and displays an error message.
-error :: [Char] -> a
-error s = raise# (errorCallException s)
+error :: (?callStack :: CallStack) => [Char] -> a
+error s = raise# (errorCallWithCallStackException s ?callStack)
 
 -- | 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'
 -- appears.
-undefined :: a
+undefined :: (?callStack :: CallStack) => a
 undefined =  error "Prelude.undefined"
 
 -- | Used for compiler-generated error message;
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs
index b82ae114e6..3fbae05c9a 100644
--- a/libraries/base/GHC/Exception.hs
+++ b/libraries/base/GHC/Exception.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE NoImplicitPrelude
            , ExistentialQuantification
            , MagicHash
+           , RecordWildCards
+           , PatternSynonyms
   #-}
 {-# OPTIONS_HADDOCK hide #-}
 
@@ -22,9 +24,12 @@
 module GHC.Exception
        ( Exception(..)    -- Class
        , throw
-       , SomeException(..), ErrorCall(..), ArithException(..)
+       , SomeException(..), ErrorCall(..), pattern ErrorCall, ArithException(..)
        , divZeroException, overflowException, ratioZeroDenomException
-       , errorCallException
+       , errorCallException, errorCallWithCallStackException
+       , showCallStack, popCallStack, showSrcLoc
+         -- re-export CallStack and SrcLoc from GHC.Types
+       , CallStack(..), SrcLoc(..)
        ) where
 
 import Data.Maybe
@@ -158,17 +163,61 @@ throw e = raise# (toException e)
 
 -- |This is thrown when the user calls 'error'. The @String@ is the
 -- argument given to 'error'.
-newtype ErrorCall = ErrorCall String
+data ErrorCall = ErrorCallWithLocation String String
     deriving (Eq, Ord)
 
+pattern ErrorCall err <- ErrorCallWithLocation err _ where
+  ErrorCall err = ErrorCallWithLocation err ""
+
 instance Exception ErrorCall
 
 instance Show ErrorCall where
-    showsPrec _ (ErrorCall err) = showString err
+  showsPrec _ (ErrorCallWithLocation err "") = showString err
+  showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc)
 
 errorCallException :: String -> SomeException
 errorCallException s = toException (ErrorCall s)
 
+errorCallWithCallStackException :: String -> CallStack -> SomeException
+errorCallWithCallStackException s stk
+  = toException (ErrorCallWithLocation s (showCallStack (popCallStack stk)))
+
+
+-- | Pretty print 'SrcLoc'
+--
+-- @since 4.8.2.0
+showSrcLoc :: SrcLoc -> String
+showSrcLoc SrcLoc {..}
+  = foldr (++) ""
+      [ srcLocFile, ":"
+      , show srcLocStartLine, ":"
+      , show srcLocStartCol, " in "
+      , srcLocPackage, ":", srcLocModule
+      ]
+
+-- | Pretty print 'CallStack'
+--
+-- @since 4.8.2.0
+showCallStack :: CallStack -> String
+showCallStack (CallStack stk@(_:_))
+  = unlines ("CallStack:" : map (indent . showCallSite) stk)
+  where
+  -- Data.OldList isn't available yet, so we repeat the definition here
+  unlines [] = []
+  unlines [l] = l
+  unlines (l:ls) = l ++ '\n' : unlines ls
+  indent l = "  " ++ l
+  showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc
+showCallStack _ = error "CallStack cannot be empty!"
+
+
+-- | Remove the most recent callsite from the 'CallStack'
+--
+-- @since 4.8.2.0
+popCallStack :: CallStack -> CallStack
+popCallStack (CallStack (_:rest)) = CallStack rest
+popCallStack _ = error "CallStack cannot be empty!"
+
 -- |Arithmetic exceptions.
 data ArithException
   = Overflow
diff --git a/libraries/base/GHC/Exception.hs-boot b/libraries/base/GHC/Exception.hs-boot
index aa19897363..594f2665e8 100644
--- a/libraries/base/GHC/Exception.hs-boot
+++ b/libraries/base/GHC/Exception.hs-boot
@@ -25,10 +25,13 @@ to get a visibly-bottom value.
 -}
 
 module GHC.Exception ( SomeException, errorCallException,
+                       errorCallWithCallStackException,
                        divZeroException, overflowException, ratioZeroDenomException
     ) where
-import GHC.Types( Char )
+import GHC.Types( Char, CallStack )
 
 data SomeException
 divZeroException, overflowException, ratioZeroDenomException  :: SomeException
+
 errorCallException :: [Char] -> SomeException
+errorCallWithCallStackException :: [Char] -> CallStack -> SomeException
diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs
index 482027b742..e723ebdf33 100644
--- a/libraries/base/GHC/IO/Exception.hs
+++ b/libraries/base/GHC/IO/Exception.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,
-             ExistentialQuantification #-}
+             ExistentialQuantification, ImplicitParams #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 {-# OPTIONS_HADDOCK hide #-}
 
@@ -352,10 +352,12 @@ instance Show IOException where
 -- Note the use of "lazy". This means that
 --     assert False (throw e)
 -- will throw the assertion failure rather than e. See trac #5561.
-assertError :: Addr# -> Bool -> a -> a
-assertError str predicate v
+assertError :: (?callStack :: CallStack) => Bool -> a -> a
+assertError predicate v
   | predicate = lazy v
-  | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
+  | otherwise = throw (AssertionFailed
+                        ("Assertion failed\n"
+                         ++ showCallStack (popCallStack ?callStack)))
 
 unsupportedOperation :: IOError
 unsupportedOperation =
diff --git a/libraries/base/GHC/SrcLoc.hs b/libraries/base/GHC/SrcLoc.hs
deleted file mode 100644
index 23a109bd8f..0000000000
--- a/libraries/base/GHC/SrcLoc.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
--- | @since 4.8.2.0
-module GHC.SrcLoc
-  ( SrcLoc
-  , srcLocPackage
-  , srcLocModule
-  , srcLocFile
-  , srcLocStartLine
-  , srcLocStartCol
-  , srcLocEndLine
-  , srcLocEndCol
-
-  -- * Pretty printing
-  , showSrcLoc
-  ) where
-
--- | A single location in the source code.
---
--- @since 4.8.2.0
-data SrcLoc = SrcLoc
-  { srcLocPackage   :: String
-  , srcLocModule    :: String
-  , srcLocFile      :: String
-  , srcLocStartLine :: Int
-  , srcLocStartCol  :: Int
-  , srcLocEndLine   :: Int
-  , srcLocEndCol    :: Int
-  } deriving (Show, Eq)
-
--- | Pretty print 'SrcLoc'
---
--- @since 4.8.2.0
-showSrcLoc :: SrcLoc -> String
-showSrcLoc SrcLoc {..}
-  = concat [ srcLocFile, ":"
-           , show srcLocStartLine, ":"
-           , show srcLocStartCol, " in "
-           , srcLocPackage, ":", srcLocModule
-           ]
diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc
index 40fba7dcc8..a2283ff656 100644
--- a/libraries/base/GHC/Stack.hsc
+++ b/libraries/base/GHC/Stack.hsc
@@ -18,18 +18,10 @@
 {-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-}
 module GHC.Stack (
     -- * Call stacks
-    -- ** Simulated by the RTS
     currentCallStack,
     whoCreated,
     errorWithStackTrace,
 
-    -- ** Explicitly created via implicit-parameters
-    --
-    -- @since 4.8.2.0
-    CallStack,
-    getCallStack,
-    showCallStack,
-
     -- * Internals
     CostCentreStack,
     CostCentre,
@@ -44,8 +36,6 @@ module GHC.Stack (
     renderStack
   ) where
 
-import Data.List ( unlines )
-
 import Foreign
 import Foreign.C
 
@@ -56,8 +46,6 @@ import GHC.Foreign as GHC
 import GHC.IO.Encoding
 import GHC.Exception
 import GHC.List ( concatMap, null, reverse )
-import GHC.Show
-import GHC.SrcLoc
 
 #define PROFILING
 #include "Rts.h"
@@ -139,52 +127,4 @@ errorWithStackTrace x = unsafeDupablePerformIO $ do
    stack <- ccsToStrings =<< getCurrentCCS x
    if null stack
       then throwIO (ErrorCall x)
-      else throwIO (ErrorCall (x ++ '\n' : renderStack stack))
-
-
-----------------------------------------------------------------------
--- Explicit call-stacks built via ImplicitParams
-----------------------------------------------------------------------
-
--- | @CallStack@s are an alternate method of obtaining the call stack at a given
--- point in the program.
---
--- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will
--- solve it with the current location. If another @CallStack@ implicit-parameter
--- is in-scope (e.g. as a function argument), the new location will be appended
--- to the one in-scope, creating an explicit call-stack. For example,
---
--- @
--- myerror :: (?loc :: CallStack) => String -> a
--- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc)
--- @
--- ghci> myerror "die"
--- *** Exception: die
--- ?loc, called at MyError.hs:7:51 in main:MyError
---   myerror, called at <interactive>:2:1 in interactive:Ghci1
---
--- @CallStack@s do not interact with the RTS and do not require compilation with
--- @-prof@. On the other hand, as they are built up explicitly using
--- implicit-parameters, they will generally not contain as much information as
--- the simulated call-stacks maintained by the RTS.
---
--- The @CallStack@ type is abstract, but it can be converted into a
--- @[(String, SrcLoc)]@ via 'getCallStack'. The @String@ is the name of function
--- that was called, the 'SrcLoc' is the call-site. The list is ordered with the
--- most recently called function at the head.
---
--- @since 4.8.2.0
-data CallStack = CallStack { getCallStack :: [(String, SrcLoc)] }
-  -- See Note [Overview of implicit CallStacks]
-  deriving (Show, Eq)
-
--- | Pretty print 'CallStack'
---
--- @since 4.8.2.0
-showCallStack :: CallStack -> String
-showCallStack (CallStack (root:rest))
-  = unlines (showCallSite root : map (indent . showCallSite) rest)
-  where
-  indent l = "  " ++ l
-  showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc
-showCallStack _ = error "CallStack cannot be empty!"
+      else throwIO (ErrorCallWithLocation x (renderStack stack))
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 21a8ae7bcb..33734a00c7 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -248,7 +248,6 @@ Library
         GHC.StaticPtr
         GHC.STRef
         GHC.Show
-        GHC.SrcLoc
         GHC.Stable
         GHC.Stack
         GHC.Stats
diff --git a/libraries/base/tests/assert.stderr b/libraries/base/tests/assert.stderr
index 8d99aa0a64..7183f1e763 100644
--- a/libraries/base/tests/assert.stderr
+++ b/libraries/base/tests/assert.stderr
@@ -1,2 +1,4 @@
-assert: assert.hs:9:11-16: Assertion failed
+assert: Assertion failed
+CallStack:
+  assert, called at assert.hs:9:11 in main:Main
 
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index 7bc746f256..6dcd5f1a7f 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -30,10 +30,11 @@ module GHC.Types (
         SPEC(..),
         Nat, Symbol,
         Coercible,
+        SrcLoc(..), CallStack(..)
     ) where
 
 import GHC.Prim
-
+import GHC.Tuple ()
 
 infixr 5 :
 
@@ -308,3 +309,51 @@ you're reading this in 2023 then things went wrong). See #8326.
 -- Libraries can specify this by using 'SPEC' data type to inform which
 -- loops should be aggressively specialized.
 data SPEC = SPEC | SPEC2
+
+-- | A single location in the source code.
+--
+-- @since 4.8.2.0
+data SrcLoc = SrcLoc
+  { srcLocPackage   :: [Char]
+  , srcLocModule    :: [Char]
+  , srcLocFile      :: [Char]
+  , srcLocStartLine :: Int
+  , srcLocStartCol  :: Int
+  , srcLocEndLine   :: Int
+  , srcLocEndCol    :: Int
+  }
+
+----------------------------------------------------------------------
+-- Explicit call-stacks built via ImplicitParams
+----------------------------------------------------------------------
+
+-- | @CallStack@s are an alternate method of obtaining the call stack at a given
+-- point in the program.
+--
+-- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will
+-- solve it with the current location. If another @CallStack@ implicit-parameter
+-- is in-scope (e.g. as a function argument), the new location will be appended
+-- to the one in-scope, creating an explicit call-stack. For example,
+--
+-- @
+-- myerror :: (?loc :: CallStack) => String -> a
+-- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc)
+-- @
+-- ghci> myerror "die"
+-- *** Exception: die
+-- CallStack:
+--   ?loc, called at MyError.hs:7:51 in main:MyError
+--   myerror, called at <interactive>:2:1 in interactive:Ghci1
+--
+-- @CallStack@s do not interact with the RTS and do not require compilation with
+-- @-prof@. On the other hand, as they are built up explicitly using
+-- implicit-parameters, they will generally not contain as much information as
+-- the simulated call-stacks maintained by the RTS.
+--
+-- A @CallStack@ is a @[(String, SrcLoc)]@. The @String@ is the name of
+-- function that was called, the 'SrcLoc' is the call-site. The list is
+-- ordered with the most recently called function at the head.
+--
+-- @since 4.8.2.0
+data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)] }
+  -- See Note [Overview of implicit CallStacks]
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) }
diff --git a/utils/haddock b/utils/haddock
-Subproject 6a1d4a65010932a660ceacda93c8c20fb5e1399
+Subproject 7570ed8595402bcd354b7b24de1f4b0e3e527a5