Don't infer CallStacks

We originally wanted CallStacks to be opt-in, but dealing with let
binders complicated things, forcing us to infer CallStacks. It turns
out that the inference is actually unnecessary though, we can let the
wanted CallStacks bubble up to the outer context by refusing to
quantify over them. Eventually they'll be solved from a given CallStack
or defaulted to the empty CallStack if they reach the top.

So this patch prevents GHC from quantifying over CallStacks, getting us
back to the original plan. There's a small ugliness to do with
PartialTypeSignatures, if the partial theta contains a CallStack
constraint, we *do* want to quantify over the CallStack; the user asked
us to!

Note that this means that

  foo :: _ => CallStack
  foo = getCallStack callStack

will be an *empty* CallStack, since we won't infer a CallStack for the
hole in the theta. I think this is the right move though, since we want
CallStacks to be opt-in. One can always write

  foo :: (HasCallStack, _) => CallStack
  foo = getCallStack callStack

to get the CallStack and still have GHC infer the rest of the theta.

Test Plan: ./validate

Reviewers: goldfire, simonpj, austin, hvr, bgamari

Reviewed By: simonpj, bgamari

Subscribers: bitemyapp, thomie

Projects: #ghc

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

GHC Trac Issues: #11573

23 files changed, 111 insertions, 112 deletions

diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 3bad211f0c..496765859d 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -757,7 +757,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
   = -- No type signature for this binder
     do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)
                         -- Include kind variables!  Trac #7916
-             my_theta = pickQuantifiablePreds free_tvs inferred_theta
+             my_theta = pickQuantifiablePreds free_tvs [] inferred_theta
              binders  = [ mkNamedBinder Invisible tv
                         | tv <- qtvs
                         , tv `elemVarSet` free_tvs ]
@@ -781,7 +781,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
   = do { annotated_theta <- zonkTcTypes annotated_theta
        ; let free_tvs = closeOverKinds (tyCoVarsOfTypes annotated_theta
                                         `unionVarSet` tau_tvs)
-             my_theta = pickQuantifiablePreds free_tvs inferred_theta
+             my_theta = pickQuantifiablePreds free_tvs annotated_theta inferred_theta
 
        -- Report the inferred constraints for an extra-constraints wildcard/hole as
        -- an error message, unless the PartialTypeSignatures flag is enabled. In this
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index e3626c1731..c4d02d8248 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -606,6 +606,9 @@ in `g`, because `head` did not explicitly request a CallStack.
 Important Details:
 - GHC should NEVER report an insoluble CallStack constraint.
 
+- GHC should NEVER infer a CallStack constraint unless one was requested
+  with a partial type signature (See TcType.pickQuantifiablePreds).
+
 - A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)],
   where the String is the name of the binder that is used at the
   SrcLoc. SrcLoc is also defined in GHC.Stack.Types and contains the
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index a0654d2475..1c12d72409 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -683,7 +683,7 @@ interactIrred _ wi = pprPanic "interactIrred" (ppr wi)
 interactDict :: InertCans -> Ct -> TcS (StopOrContinue Ct)
 interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs = tys })
   | isWanted ev_w
-  , Just ip_name      <- isCallStackDict cls tys
+  , Just ip_name      <- isCallStackPred (ctPred workItem)
   , OccurrenceOf func <- ctLocOrigin (ctEvLoc ev_w)
   -- If we're given a CallStack constraint that arose from a function
   -- call, we need to push the current call-site onto the stack instead
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index b218ec0ec2..8d8ce4ec6c 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -70,7 +70,7 @@ module TcRnTypes(
         isCDictCan_Maybe, isCFunEqCan_maybe,
         isCIrredEvCan, isCNonCanonical, isWantedCt, isDerivedCt,
         isGivenCt, isHoleCt, isOutOfScopeCt, isExprHoleCt, isTypeHoleCt,
-        isUserTypeErrorCt, isCallStackDict, getUserTypeErrorMsg,
+        isUserTypeErrorCt, getUserTypeErrorMsg,
         ctEvidence, ctLoc, setCtLoc, ctPred, ctFlavour, ctEqRel, ctOrigin,
         mkTcEqPredLikeEv,
         mkNonCanonical, mkNonCanonicalCt,
@@ -141,8 +141,6 @@ import ConLike  ( ConLike(..) )
 import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )
 import PatSyn   ( PatSyn, pprPatSynType )
 import Id       ( idName )
-import PrelNames ( callStackTyConKey, ipClassKey )
-import Unique ( hasKey )
 import FieldLabel ( FieldLabel )
 import TcType
 import Annotations
@@ -1777,20 +1775,6 @@ isPendingScDict ct@(CDictCan { cc_pend_sc = True })
                   = Just (ct { cc_pend_sc = False })
 isPendingScDict _ = Nothing
 
--- | Are we looking at an Implicit CallStack
--- (i.e. @IP "name" CallStack@)?
---
--- If so, returns @Just "name"@.
-isCallStackDict :: Class -> [Type] -> Maybe FastString
-isCallStackDict cls tys
-  | cls `hasKey` ipClassKey
-  , [ip_name_ty, ty] <- tys
-  , Just (tc, _) <- splitTyConApp_maybe ty
-  , tc `hasKey` callStackTyConKey
-  = isStrLitTy ip_name_ty
-isCallStackDict _ _
-  = Nothing
-
 superClassesMightHelp :: Ct -> Bool
 -- ^ True if taking superclasses of givens, or of wanteds (to perhaps
 -- expose more equalities or functional dependencies) might help to
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 3adb77eb9d..9c17668b57 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -177,8 +177,7 @@ defaultCallStacks wanteds
     return (implic { ic_wanted = wanteds })
 
   defaultCallStack ct
-    | Just (cls, tys) <- getClassPredTys_maybe (ctPred ct)
-    , Just _ <- isCallStackDict cls tys
+    | Just _ <- isCallStackPred (ctPred ct)
     = do { solveCallStack (cc_ev ct) EvCsEmpty
          ; return Nothing }
 
@@ -771,7 +770,8 @@ decideQuantification apply_mr sigs name_taus constraints
                  -- quantifyTyVars turned some meta tyvars into
                  -- quantified skolems, so we have to zonk again
 
-       ; let theta     = pickQuantifiablePreds (mkVarSet qtvs) constraints
+       ; let theta     = pickQuantifiablePreds
+                           (mkVarSet qtvs) (concatMap sig_theta sigs) constraints
              min_theta = mkMinimalBySCs theta
                -- See Note [Minimize by Superclasses]
 
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 55b2991a39..3f637c8db2 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -74,7 +74,7 @@ module TcType (
   pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis,
   isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy,
   isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
-  isIntegerTy, isBoolTy, isUnitTy, isCharTy,
+  isIntegerTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred,
   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
   isPredTy, isTyVarClassPred, isTyVarExposed, isTyVarUnderDatatype,
   checkValidClsArgs, hasTyVarHead,
@@ -1707,11 +1707,12 @@ evVarPred var
 -- [Inheriting implicit parameters] and [Quantifying over equality constraints]
 pickQuantifiablePreds
   :: TyVarSet           -- Quantifying over these
+  -> TcThetaType        -- Context from PartialTypeSignatures
   -> TcThetaType        -- Proposed constraints to quantify
   -> TcThetaType        -- A subset that we can actually quantify
 -- This function decides whether a particular constraint shoudl be
 -- quantified over, given the type variables that are being quantified
-pickQuantifiablePreds qtvs theta
+pickQuantifiablePreds qtvs annotated_theta theta
   = let flex_ctxt = True in  -- Quantify over non-tyvar constraints, even without
                              -- -XFlexibleContexts: see Trac #10608, #10351
          -- flex_ctxt <- xoptM Opt_FlexibleContexts
@@ -1719,9 +1720,21 @@ pickQuantifiablePreds qtvs theta
   where
     pick_me flex_ctxt pred
       = case classifyPredType pred of
+
           ClassPred cls tys
-             | isIPClass cls    -> True -- See note [Inheriting implicit parameters]
-             | otherwise        -> pick_cls_pred flex_ctxt cls tys
+            | Just str <- isCallStackPred pred
+              -- NEVER infer a CallStack constraint, unless we were
+              -- given one in a partial type signatures.
+              -- Otherwise, we let the constraints bubble up to be
+              -- solved from the outer context, or be defaulted when we
+              -- reach the top-level.
+              -- see Note [Overview of implicit CallStacks]
+              -> str `elem` givenStks
+
+            | isIPClass cls    -> True -- See note [Inheriting implicit parameters]
+
+            | otherwise
+              -> pick_cls_pred flex_ctxt cls tys
 
           EqPred ReprEq ty1 ty2 -> pick_cls_pred flex_ctxt coercibleClass [ty1, ty2]
             -- representational equality is like a class constraint
@@ -1729,6 +1742,9 @@ pickQuantifiablePreds qtvs theta
           EqPred NomEq ty1 ty2  -> quant_fun ty1 || quant_fun ty2
           IrredPred ty          -> tyCoVarsOfType ty `intersectsVarSet` qtvs
 
+    givenStks = [ str | (str, ty) <- mapMaybe isIPPred_maybe annotated_theta
+                      , isCallStackTy ty ]
+
     pick_cls_pred flex_ctxt cls tys
       = tyCoVarsOfTypes tys `intersectsVarSet` qtvs
         && (checkValidClsArgs flex_ctxt cls tys)
@@ -1901,6 +1917,25 @@ isStringTy ty
       Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
       _                   -> False
 
+-- | Is a type a 'CallStack'?
+isCallStackTy :: Type -> Bool
+isCallStackTy ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` callStackTyConKey
+  | otherwise
+  = False
+
+-- | Is a 'PredType' a 'CallStack' implicit parameter?
+--
+-- If so, return the name of the parameter.
+isCallStackPred :: PredType -> Maybe FastString
+isCallStackPred pred
+  | Just (str, ty) <- isIPPred_maybe pred
+  , isCallStackTy ty
+  = Just str
+  | otherwise
+  = Nothing
+
 is_tc :: Unique -> Type -> Bool
 -- Newtypes are opaque to this
 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 220e642733..0bd48d3b6e 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -13367,8 +13367,10 @@ For example, we can define ::
 
    errorWithCallStack :: HasCallStack => String -> a
 
-as a variant of ``error`` that will get its call-site. We can access the
-call-stack inside ``errorWithCallStack`` with ``GHC.Stack.callStack``. ::
+as a variant of ``error`` that will get its call-site (as of GHC 8.0,
+``error`` already gets its call-site, but let's assume for the sake of
+demonstration that it does not). We can access the call-stack inside
+``errorWithCallStack`` with ``GHC.Stack.callStack``. ::
 
    errorWithCallStack :: HasCallStack => String -> a
    errorWithCallStack msg = error (msg ++ "\n" ++ prettyCallStack callStack)
@@ -13386,12 +13388,12 @@ alongside our error message.
 The ``CallStack`` will only extend as far as the types allow it, for
 example ::
 
-   head :: HasCallStack => [a] -> a
-   head []     = errorWithCallStack "empty"
-   head (x:xs) = x
+   myHead :: HasCallStack => [a] -> a
+   myHead []     = errorWithCallStack "empty"
+   myHead (x:xs) = x
 
    bad :: Int
-   bad = head []
+   bad = myHead []
 
 .. code-block:: none
 
@@ -13399,27 +13401,23 @@ example ::
    *** Exception: empty
    CallStack (from HasCallStack):
      errorWithCallStack, called at Bad.hs:8:15 in main:Bad
-     head, called at Bad.hs:12:7 in main:Bad
+     myHead, called at Bad.hs:12:7 in main:Bad
 
-includes the call-site of ``errorWithCallStack`` in ``head``,
-and of ``head`` in ``bad``,
-but not the call-site of ``bad`` at the GHCi prompt.
+includes the call-site of ``errorWithCallStack`` in ``myHead``, and of
+``myHead`` in ``bad``, but not the call-site of ``bad`` at the GHCi
+prompt.
 
-GHC solves ``HasCallStack`` constraints in three steps:
+GHC solves ``HasCallStack`` constraints in two steps:
 
-1. If there is a ``CallStack`` in scope -- i.e. the enclosing function
+1. If there is a ``CallStack`` in scope -- i.e. the enclosing definition
    has a ``HasCallStack`` constraint -- GHC will push the new call-site
    onto the existing ``CallStack``.
 
-2. If there is no ``CallStack`` in scope -- e.g. in the GHCi session
-   above -- and the enclosing definition does not have an explicit
-   type signature, GHC will infer a ``HasCallStack`` constraint for the
-   enclosing definition (subject to the monomorphism restriction).
+2. Otherwise GHC will solve the ``HasCallStack`` constraint for the
+   singleton ``CallStack`` containing just the current call-site.
 
-3. If there is no ``CallStack`` in scope and the enclosing definition
-   has an explicit type signature, GHC will solve the ``HasCallStack``
-   constraint for the singleton ``CallStack`` containing just the
-   current call-site.
+Importantly, GHC will **never** infer a ``HasCallStack`` constraint,
+you must request it explicitly.
 
 ``CallStack`` is kept abstract, but GHC provides a function ::
 
@@ -13433,20 +13431,20 @@ package, module, and file name, as well as the line and column numbers.
 allows users to freeze the current ``CallStack``, preventing any future push
 operations from having an effect. This can be used by library authors
 to prevent ``CallStack``\s from exposing unnecessary implementation
-details. Consider the ``head`` example above, the ``errorWithCallStack`` line in
+details. Consider the ``myHead`` example above, the ``errorWithCallStack`` line in
 the printed stack is not particularly enlightening, so we might choose
 to suppress it by freezing the ``CallStack`` that we pass to ``errorWithCallStack``. ::
 
-   head :: HasCallStack => [a] -> a
-   head []     = withFrozenCallStack (errorWithCallStack "empty")
-   head (x:xs) = x
+   myHead :: HasCallStack => [a] -> a
+   myHead []     = withFrozenCallStack (errorWithCallStack "empty")
+   myHead (x:xs) = x
 
 .. code-block:: none
 
-   ghci> head []
+   ghci> myHead []
    *** Exception: empty
    CallStack (from HasCallStack):
-     head, called at Bad.hs:12:7 in main:Bad
+     myHead, called at Bad.hs:12:7 in main:Bad
 
 **NOTE**: The intrepid user may notice that ``HasCallStack`` is just an
 alias for an implicit parameter ``?callStack :: CallStack``. This is an
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs
index 5f2034e2d2..f5b175c0bb 100644
--- a/libraries/base/GHC/Stack.hs
+++ b/libraries/base/GHC/Stack.hs
@@ -74,9 +74,9 @@ errorWithStackTrace x = unsafeDupablePerformIO $ do
 -- @since 4.9.0.0
 popCallStack :: CallStack -> CallStack
 popCallStack stk = case stk of
-  EmptyCallStack       -> errorWithoutStackTrace "popCallStack: empty stack"
-  PushCallStack _ stk' -> stk'
-  FreezeCallStack _    -> stk
+  EmptyCallStack         -> errorWithoutStackTrace "popCallStack: empty stack"
+  PushCallStack _ _ stk' -> stk'
+  FreezeCallStack _      -> stk
 {-# INLINE popCallStack #-}
 
 -- | Return the current 'CallStack'.
diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs
index 1fead13051..33b24a4af6 100644
--- a/libraries/base/GHC/Stack/Types.hs
+++ b/libraries/base/GHC/Stack/Types.hs
@@ -131,7 +131,7 @@ type HasCallStack = (?callStack :: CallStack)
 -- @since 4.8.1.0
 data CallStack
   = EmptyCallStack
-  | PushCallStack ([Char], SrcLoc) CallStack
+  | PushCallStack [Char] SrcLoc CallStack
   | FreezeCallStack CallStack
     -- ^ Freeze the stack at the given @CallStack@, preventing any further
     -- call-sites from being pushed onto it.
@@ -145,16 +145,16 @@ data CallStack
 -- @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'
+  EmptyCallStack            -> []
+  PushCallStack fn loc stk' -> (fn,loc) : getCallStack stk'
+  FreezeCallStack stk'      -> getCallStack stk'
 
 -- | Convert a list of call-sites to a 'CallStack'.
 --
 -- @since 4.9.0.0
 fromCallSiteList :: [([Char], SrcLoc)] -> CallStack
-fromCallSiteList (c:cs) = PushCallStack c (fromCallSiteList cs)
-fromCallSiteList []     = EmptyCallStack
+fromCallSiteList ((fn,loc):cs) = PushCallStack fn loc (fromCallSiteList cs)
+fromCallSiteList []            = EmptyCallStack
 
 -- Note [Definition of CallStack]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -178,9 +178,9 @@ fromCallSiteList []     = EmptyCallStack
 --
 -- @since 4.9.0.0
 pushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack
-pushCallStack cs stk = case stk of
+pushCallStack (fn, loc) stk = case stk of
   FreezeCallStack _ -> stk
-  _                 -> PushCallStack cs stk
+  _                 -> PushCallStack fn loc stk
 {-# INLINE pushCallStack #-}
 
 
diff --git a/testsuite/tests/codeGen/should_run/cgrun059.stderr b/testsuite/tests/codeGen/should_run/cgrun059.stderr
index af01704f99..da868fc522 100644
--- a/testsuite/tests/codeGen/should_run/cgrun059.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun059.stderr
@@ -1,4 +1,3 @@
 cgrun059: Error: File not found
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at cgrun059.hs:12:28 in main:Main
-  raiseError, called at cgrun059.hs:25:29 in main:Main
diff --git a/testsuite/tests/concurrent/should_run/conc021.stderr b/testsuite/tests/concurrent/should_run/conc021.stderr
index 4c70f77f54..659f325726 100644
--- a/testsuite/tests/concurrent/should_run/conc021.stderr
+++ b/testsuite/tests/concurrent/should_run/conc021.stderr
@@ -1,4 +1,3 @@
 conc021: wurble
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at conc021.hs:9:9 in main:Main
-  foo, called at conc021.hs:6:1 in main:Main
diff --git a/testsuite/tests/deSugar/should_run/T11601.stderr b/testsuite/tests/deSugar/should_run/T11601.stderr
index 6db78c08a4..de0d9deb91 100644
--- a/testsuite/tests/deSugar/should_run/T11601.stderr
+++ b/testsuite/tests/deSugar/should_run/T11601.stderr
@@ -2,4 +2,3 @@ T11601: Prelude.undefined
 CallStack (from HasCallStack):
   error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
   undefined, called at T11601.hs:6:35 in main:Main
-  f, called at T11601.hs:8:15 in main:Main
diff --git a/testsuite/tests/ghci.debugger/scripts/break017.stdout b/testsuite/tests/ghci.debugger/scripts/break017.stdout
index 6c8513f00b..7a1664db78 100644
--- a/testsuite/tests/ghci.debugger/scripts/break017.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break017.stdout
@@ -8,9 +8,8 @@ Printing 1
 as = 'b' : 'c' : (_t1::[Char])
 Forcing
 *** Exception: Prelude.undefined
-CallStack (from ImplicitParams):
-  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
+CallStack (from HasCallStack):
+  error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
   undefined, called at <interactive>:3:17 in interactive:Ghci1
-  it, called at <interactive>:3:1 in interactive:Ghci1
 Printing 2
 as = 'b' : 'c' : (_t2::[Char])
diff --git a/testsuite/tests/ghci.debugger/scripts/print033.stdout b/testsuite/tests/ghci.debugger/scripts/print033.stdout
index 4963c68366..62b39bbaea 100644
--- a/testsuite/tests/ghci.debugger/scripts/print033.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/print033.stdout
@@ -1,2 +1 @@
-u = (_t1::(?callStack::GHC.Stack.Types.CallStack) =>
-          ST s (forall s'. ST s' a))
+u = (_t1::ST s (forall s'. ST s' a))
diff --git a/testsuite/tests/ghci/scripts/T5557.stdout b/testsuite/tests/ghci/scripts/T5557.stdout
index 835d351d75..4b864f9063 100644
--- a/testsuite/tests/ghci/scripts/T5557.stdout
+++ b/testsuite/tests/ghci/scripts/T5557.stdout
@@ -1,10 +1,8 @@
 *** Exception: Prelude.undefined
-CallStack (from ImplicitParams):
-  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
+CallStack (from HasCallStack):
+  error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
   undefined, called at <interactive>:2:12 in interactive:Ghci1
-  it, called at <interactive>:2:1 in interactive:Ghci1
 *** Exception: Prelude.undefined
-CallStack (from ImplicitParams):
-  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
+CallStack (from HasCallStack):
+  error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
   undefined, called at <interactive>:3:12 in interactive:Ghci1
-  it, called at <interactive>:3:1 in interactive:Ghci1
diff --git a/testsuite/tests/ghci/scripts/ghci013.stdout b/testsuite/tests/ghci/scripts/ghci013.stdout
index d70c57fd67..d6c3823fdd 100644
--- a/testsuite/tests/ghci/scripts/ghci013.stdout
+++ b/testsuite/tests/ghci/scripts/ghci013.stdout
@@ -1,2 +1 @@
-f :: (?callStack::GHC.Stack.Types.CallStack, Monad m) =>
-     (m a, t) -> m b
+f :: Monad m => (m a, t) -> m b
diff --git a/testsuite/tests/ghci/scripts/ghci046.stdout b/testsuite/tests/ghci/scripts/ghci046.stdout
index da71a9a73d..c4e7cf3fc7 100644
--- a/testsuite/tests/ghci/scripts/ghci046.stdout
+++ b/testsuite/tests/ghci/scripts/ghci046.stdout
@@ -2,5 +2,5 @@ AND HTrue HTrue :: *
 = HTrue
 AND (OR HFalse HTrue) (OR HTrue HFalse) :: *
 = HTrue
-t :: (?callStack::GHC.Stack.Types.CallStack) => HTrue
-t :: (?callStack::GHC.Stack.Types.CallStack) => HFalse
+t :: HTrue
+t :: HFalse
diff --git a/testsuite/tests/ghci/scripts/ghci055.stdout b/testsuite/tests/ghci/scripts/ghci055.stdout
index e878582a2b..f98845ccbe 100644
--- a/testsuite/tests/ghci/scripts/ghci055.stdout
+++ b/testsuite/tests/ghci/scripts/ghci055.stdout
@@ -1,3 +1,6 @@
-x = _
-x :: ?callStack::GHC.Stack.Types.CallStack => a = _
+*** Exception: Prelude.undefined
+CallStack (from HasCallStack):
+  error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
+  undefined, called at <interactive>:1:5 in interactive:Ghci1
+x :: a = _
 y :: Integer = 3
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
index e0daa4e87d..c34b1396c7 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
@@ -62,8 +62,7 @@ TYPE SIGNATURES
   enumFromThen :: forall a. Enum a => a -> a -> [a]
   enumFromThenTo :: forall a. Enum a => a -> a -> a -> [a]
   enumFromTo :: forall a. Enum a => a -> a -> [a]
-  error ::
-    forall a. (?callStack::GHC.Stack.Types.CallStack) => [Char] -> a
+  error :: forall a. [Char] -> a
   even :: forall a. Integral a => a -> Bool
   exp :: forall a. Floating a => a -> a
   exponent :: forall a. RealFloat a => a -> Int
@@ -213,7 +212,7 @@ TYPE SIGNATURES
   toRational :: forall a. Real a => a -> Rational
   truncate :: forall a b. (RealFrac a, Integral b) => a -> b
   uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
-  undefined :: forall t. (?callStack::GHC.Stack.Types.CallStack) => t
+  undefined :: forall t. t
   unlines :: [String] -> String
   until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
   unwords :: [String] -> String
@@ -232,4 +231,4 @@ TYPE CONSTRUCTORS
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
-                     integer-gmp-1.0.0.0]
+                     integer-gmp-1.0.0.1]
diff --git a/testsuite/tests/partial-sigs/should_fail/T10999.stderr b/testsuite/tests/partial-sigs/should_fail/T10999.stderr
index ef4d9f83c1..c74719addf 100644
--- a/testsuite/tests/partial-sigs/should_fail/T10999.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T10999.stderr
@@ -1,7 +1,6 @@
 
 T10999.hs:5:6: error:
-    Found constraint wildcard ‘_’
-      standing for ‘(?callStack::GHC.Stack.Types.CallStack, Ord a)’
+    Found constraint wildcard ‘_’ standing for ‘Ord a’
     To use the inferred type, enable PartialTypeSignatures
     In the type signature:
       f :: _ => () -> _
@@ -9,10 +8,7 @@ T10999.hs:5:6: error:
 T10999.hs:5:17: error:
     • Found type wildcard ‘_’ standing for ‘Set.Set a’
       Where: ‘a’ is a rigid type variable bound by
-               the inferred type of
-               f :: (?callStack::GHC.Stack.Types.CallStack, Ord a) =>
-                    () -> Set.Set a
-               at T10999.hs:6:1
+               the inferred type of f :: Ord a => () -> Set.Set a at T10999.hs:6:1
       To use the inferred type, enable PartialTypeSignatures
     • In the type signature:
         f :: _ => () -> _
diff --git a/testsuite/tests/typecheck/should_run/T10845.hs b/testsuite/tests/typecheck/should_run/T10845.hs
index 3d813fc40f..c93595feff 100644
--- a/testsuite/tests/typecheck/should_run/T10845.hs
+++ b/testsuite/tests/typecheck/should_run/T10845.hs
@@ -4,17 +4,10 @@
 import GHC.Stack
 
 f1 :: (?loc :: CallStack) => CallStack
--- we can infer a CallStack for let-binders
+-- we can solve CallStacks in local functions from CallStacks
+-- in the outer context
 f1 = let y x = (?loc :: CallStack)
      in y 0
 
-f2 :: (?loc :: CallStack) => CallStack
--- but only when we would infer an IP.
--- i.e. the monomorphism restriction prevents us
--- from inferring a CallStack.
-f2 = let y = (?loc :: CallStack)
-     in y
-
 main :: IO ()
 main = do putStrLn $ prettyCallStack f1
-          putStrLn $ prettyCallStack f2
diff --git a/testsuite/tests/typecheck/should_run/T10845.stdout b/testsuite/tests/typecheck/should_run/T10845.stdout
index af39ed4728..9f065bb837 100644
--- a/testsuite/tests/typecheck/should_run/T10845.stdout
+++ b/testsuite/tests/typecheck/should_run/T10845.stdout
@@ -1,5 +1,2 @@
-CallStack (from ImplicitParams):
-  y, called at T10845.hs:10:9 in main:Main
-  f1, called at T10845.hs:20:36 in main:Main
-CallStack (from ImplicitParams):
-  f2, called at T10845.hs:21:36 in main:Main
+CallStack (from HasCallStack):
+  f1, called at T10845.hs:13:38 in main:Main
diff --git a/testsuite/tests/typecheck/should_run/T8119.stdout b/testsuite/tests/typecheck/should_run/T8119.stdout
index 7e9d9e1558..cda6b1de02 100644
--- a/testsuite/tests/typecheck/should_run/T8119.stdout
+++ b/testsuite/tests/typecheck/should_run/T8119.stdout
@@ -1,3 +1,2 @@
-test `asTypeOf` (undefined :: a -> b)
-  :: (?callStack::GHC.Stack.Types.CallStack) => Int -> Int
+test `asTypeOf` (undefined :: a -> b) :: Int -> Int
 \x -> test x :: Int -> Int