diff options
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 |