Rework the Implicit CallStack solver to handle local lets.
authorEric Seidel <gridaphobe@gmail.com>
Sat, 12 Dec 2015 15:53:50 +0000 (16:53 +0100)
committerBen Gamari <ben@smart-cactus.org>
Sat, 12 Dec 2015 17:39:22 +0000 (18:39 +0100)
We can't just solve CallStack constraints indiscriminately when they
occur in the RHS of a let-binder. The top-level given CallStack (if
any) will not be in scope, so I've re-worked the CallStack solver as
follows:

1. CallStacks are treated like regular IPs unless one of the following
   two rules apply.

2. In a function call, we push the call-site onto a NEW wanted
   CallStack, which GHC will solve as a regular IP (either directly from a
   given, or by quantifying over it in a local let).

3. If, after the constraint solver is done, any wanted CallStacks
   remain, we default them to the empty CallStack. This rule exists mainly
   to clean up after rule 2 in a top-level binder with no given CallStack.

In rule (2) we have to be careful to emit the new wanted with an
IPOccOrigin instead of an OccurrenceOf origin, so rule (2) doesn't fire
again. This is a bit shady but I've updated the Note to explain the
trick.

Test Plan: validate

Reviewers: simonpj, austin, bgamari, hvr

Reviewed By: simonpj, bgamari

Subscribers: thomie

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

GHC Trac Issues: #10845

38 files changed:
.gitignore
compiler/deSugar/DsBinds.hs
compiler/typecheck/TcEvidence.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcInteract.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSimplify.hs
compiler/utils/Outputable.hs
docs/users_guide/7.12.1-notes.rst
docs/users_guide/glasgow_exts.rst
libraries/base/GHC/Exception.hs
libraries/base/GHC/IO/Exception.hs
libraries/base/GHC/Stack.hs
libraries/base/GHC/Stack/Types.hs
libraries/base/changelog.md
testsuite/.gitignore
testsuite/tests/codeGen/should_run/cgrun059.stderr
testsuite/tests/concurrent/should_run/conc021.stderr
testsuite/tests/ghci.debugger/scripts/break011.stdout
testsuite/tests/ghci.debugger/scripts/break017.stdout
testsuite/tests/ghci.debugger/scripts/print033.stdout
testsuite/tests/ghci/scripts/T5557.stdout
testsuite/tests/ghci/scripts/T8959.stdout
testsuite/tests/ghci/scripts/ghci013.stdout
testsuite/tests/ghci/scripts/ghci046.stdout
testsuite/tests/ghci/scripts/ghci055.stdout
testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
testsuite/tests/partial-sigs/should_fail/T10999.stderr
testsuite/tests/pmcheck/should_compile/T3927b.stderr
testsuite/tests/th/T1849.script
testsuite/tests/typecheck/should_run/IPLocation.hs
testsuite/tests/typecheck/should_run/IPLocation.stdout
testsuite/tests/typecheck/should_run/T10845.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_run/T10845.stdout [new file with mode: 0644]
testsuite/tests/typecheck/should_run/T10846.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_run/T10846.stdout [new file with mode: 0644]
testsuite/tests/typecheck/should_run/T8119.stdout
testsuite/tests/typecheck/should_run/all.T

index 82c81c0..bfd567e 100644 (file)
@@ -98,6 +98,7 @@ _darcs/
 /docs/users_guide/build-html
 /docs/users_guide/build-pdf
 /docs/users_guide/.doctrees-*
+/docs/users_guide/.doctrees/
 /driver/ghci/ghc-pkg-inplace
 /driver/ghci/ghci-inplace
 /driver/ghci/ghci.res
index ca2d49d..9932fb0 100644 (file)
@@ -1195,6 +1195,5 @@ dsEvCallStack cs = do
                   let ip_co = unwrapIP (exprType tmExpr)
                   return (pushCS nameExpr locExpr (mkCastDs tmExpr ip_co))
   case cs of
-    EvCsTop name loc tm -> mkPush name loc tm
     EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm
-    EvCsEmpty -> panic "Cannot have an empty CallStack"
+    EvCsEmpty -> return emptyCS
index 032cc54..7890115 100644 (file)
@@ -394,9 +394,6 @@ data EvCallStack
   | EvCsPushCall Name RealSrcSpan EvTerm
     -- ^ @EvCsPushCall name loc stk@ represents a call to @name@, occurring at
     -- @loc@, in a calling context @stk@.
-  | EvCsTop FastString RealSrcSpan EvTerm
-    -- ^ @EvCsTop name loc stk@ represents a use of an implicit parameter
-    -- @?name@, occurring at @loc@, in a calling context @stk@.
   deriving( Data.Data, Data.Typeable )
 
 {-
@@ -511,57 +508,79 @@ Note [Overview of implicit CallStacks]
 The goal of CallStack evidence terms is to reify locations
 in the program source as runtime values, without any support
 from the RTS. We accomplish this by assigning a special meaning
-to implicit parameters of type GHC.Stack.CallStack. A use of
-a CallStack IP, e.g.
+to implicit parameters of type GHC.Stack.CallStack.
 
-  head []    = error (show (?loc :: CallStack))
-  head (x:_) = x
+Implicit CallStacks are regular implicit parameters, augmented with two
+extra rules in the constraint solver:
 
-will be solved with the source location that gave rise to the IP
-constraint (here, the use of ?loc). If there is already
-a CallStack IP in scope, e.g. passed-in as an argument
+1. Occurrences of CallStack IPs are solved directly from the given IP,
+   just like a regular IP. For example, the occurrence of `?stk` in
 
-  head :: (?loc :: CallStack) => [a] -> a
-  head []    = error (show (?loc :: CallStack))
-  head (x:_) = x
+     error :: (?stk :: CallStack) => String -> a
+     error s = raise (ErrorCall (s ++ show ?stk))
+
+   will be solved for the `?stk` in `error`s context as before.
+
+2. In a function call, instead of simply passing the given IP, we first
+   append the current call-site to it. For example, consider a
+   call to the callstack-aware `error` above.
+
+     undefined :: (?stk :: CallStack) => a
+     undefined = error "undefined!"
+
+   Here we want to take the given `?stk` and append the current
+   call-site, before passing it to `error`. In essence, we want to
+   rewrite `error "undefined!"` to
+
+     let ?stk = pushCallStack <error's location> ?stk
+     in error "undefined!"
+
+   We achieve this effect by emitting a NEW wanted
 
-we will push the new location onto the CallStack that was passed
-in. These two cases are reflected by the EvCallStack evidence
-type. In the first case, we will create an evidence term
+     [W] d :: IP "stk" CallStack
 
-  EvCsTop "?loc" <?loc's location> EvCsEmpty
+   from which we build the evidence term
 
-and in the second we'll have a given constraint
+     EvCsPushCall "error" <error's location> (EvId d)
 
-  [G] d :: IP "loc" CallStack
+   that we use to solve the call to `error`. The new wanted `d` will
+   then be solved per rule (1), ie as a regular IP.
 
-in scope, and will create an evidence term
+   (see TcInteract.interactDict)
 
-  EvCsTop "?loc" <?loc's location> d
+3. We default any insoluble CallStacks to the empty CallStack. Suppose
+   `undefined` did not request a CallStack, ie
 
-When we call a function that uses a CallStack IP, e.g.
+     undefinedNoStk :: a
+     undefinedNoStk = error "undefined!"
 
-  f = head xs
+   Under the usual IP rules, the new wanted from rule (2) would be
+   insoluble as there's no given IP from which to solve it, so we
+   would get an "unbound implicit parameter" error.
 
-we create an evidence term
+   We don't ever want to emit an insoluble CallStack IP, so we add a
+   defaulting pass to default any remaining wanted CallStacks to the
+   empty CallStack with the evidence term
 
-  EvCsPushCall "head" <head's location> EvCsEmpty
+     EvCsEmpty
 
-again pushing onto a given evidence term if one exists.
+   (see TcSimplify.simpl_top and TcSimplify.defaultCallStacks)
 
 This provides a lightweight mechanism for building up call-stacks
 explicitly, but is notably limited by the fact that the stack will
 stop at the first function whose type does not include a CallStack IP.
-For example, using the above definition of head:
+For example, using the above definition of `undefined`:
 
-  f :: [a] -> a
-  f = head
+  head :: [a] -> a
+  head []    = undefined
+  head (x:_) = x
+
+  g = head []
 
-  g = f []
+the resulting CallStack will include the call to `undefined` in `head`
+and the call to `error` in `undefined`, but *not* the call to `head`
+in `g`, because `head` did not explicitly request a CallStack.
 
-the resulting CallStack will include use of ?loc inside head and
-the call to head inside f, but NOT the call to f inside g, because f
-did not explicitly request a CallStack.
 
 Important Details:
 - GHC should NEVER report an insoluble CallStack constraint.
@@ -572,21 +591,6 @@ Important Details:
   source-span. Both CallStack and SrcLoc are kept abstract so only GHC can
   construct new values.
 
-- Consider the use of ?stk in:
-
-    head :: (?stk :: CallStack) => [a] -> a
-    head [] = error (show ?stk)
-
-  When solving the use of ?stk we'll have a given
-
-   [G] d :: IP "stk" CallStack
-
-  in scope. In the interaction phase, GHC would normally solve the use of ?stk
-  directly from the given, i.e. re-using the dicionary. But this is NOT what we
-  want! We want to generate a *new* CallStack with ?loc's SrcLoc pushed onto
-  the given CallStack. So we must take care in TcInteract.interactDict to
-  prioritize solving wanted CallStacks.
-
 - We will automatically solve any wanted CallStack regardless of the name of the
   IP, i.e.
 
@@ -600,21 +604,19 @@ Important Details:
     head [] = error (show (?stk :: CallStack))
 
   the printed CallStack will NOT include head's call-site. This reflects the
-  standard scoping rules of implicit-parameters. (See TcInteract.interactDict)
+  standard scoping rules of implicit-parameters.
 
 - An EvCallStack term desugars to a CoreExpr of type `IP "some str" CallStack`.
   The desugarer will need to unwrap the IP newtype before pushing a new
   call-site onto a given stack (See DsBinds.dsEvCallStack)
 
-- We only want to intercept constraints that arose due to the use of an IP or a
-  function call. In particular, we do NOT want to intercept the
+- When we emit a new wanted CallStack from rule (2) we set its origin to
+  `IPOccOrigin ip_name` instead of the original `OccurrenceOf func`
+  (see TcInteract.interactDict).
 
-    (?stk :: CallStack) => [a] -> a
-      ~
-    (?stk :: CallStack) => [a] -> a
+  This is a bit shady, but is how we ensure that the new wanted is
+  solved like a regular IP.
 
-  constraint that arises from the ambiguity check on `head`s type signature.
-  (See TcEvidence.isCallStackIP)
 -}
 
 mkEvCast :: EvTerm -> TcCoercion -> EvTerm
@@ -674,7 +676,6 @@ sccEvBinds bs = stronglyConnCompFromEdgedVertices edges
 evVarsOfCallStack :: EvCallStack -> VarSet
 evVarsOfCallStack cs = case cs of
   EvCsEmpty -> emptyVarSet
-  EvCsTop _ _ tm -> evVarsOfTerm tm
   EvCsPushCall _ _ tm -> evVarsOfTerm tm
 
 evVarsOfTypeable :: EvTypeable -> VarSet
@@ -763,10 +764,8 @@ instance Outputable EvLit where
 instance Outputable EvCallStack where
   ppr EvCsEmpty
     = ptext (sLit "[]")
-  ppr (EvCsTop name loc tm)
-    = angleBrackets (ppr (name,loc)) <+> ptext (sLit ":") <+> ppr tm
   ppr (EvCsPushCall name loc tm)
-    = angleBrackets (ppr (name,loc)) <+> ptext (sLit ":") <+> ppr tm
+    = ppr (name,loc) <+> ptext (sLit ":") <+> ppr tm
 
 instance Outputable EvTypeable where
   ppr (EvTypeableTyCon ts)    = ptext (sLit "TC") <+> ppr ts
index 2b57a40..51f3c2f 100644 (file)
@@ -1264,8 +1264,6 @@ zonkEvTerm env (EvTypeable ty ev) =
 zonkEvTerm env (EvCallStack cs)
   = case cs of
       EvCsEmpty -> return (EvCallStack cs)
-      EvCsTop n l tm -> do { tm' <- zonkEvTerm env tm
-                           ; return (EvCallStack (EvCsTop n l tm')) }
       EvCsPushCall n l tm -> do { tm' <- zonkEvTerm env tm
                                 ; return (EvCallStack (EvCsPushCall n l tm')) }
 
index 75399f1..c78d6bb 100644 (file)
@@ -2,13 +2,15 @@
 
 module TcInteract (
      solveSimpleGivens,   -- Solves [EvVar],GivenLoc
-     solveSimpleWanteds   -- Solves Cts
+     solveSimpleWanteds,  -- Solves Cts
+
+     solveCallStack,      -- for use in TcSimplify
   ) where
 
 #include "HsVersions.h"
 
 import BasicTypes ( infinity, IntWithInf, intGtLimit )
-import HsTypes ( hsIPNameFS )
+import HsTypes ( HsIPName(..) )
 import FastString
 import TcCanonical
 import TcFlatten
@@ -21,7 +23,7 @@ import Var
 import TcType
 import Name
 import PrelNames ( knownNatClassName, knownSymbolClassName,
-                   callStackTyConKey, typeableClassName, coercibleTyConKey,
+                   typeableClassName, coercibleTyConKey,
                    heqTyConKey )
 import TysWiredIn ( ipClass, typeNatKind, typeSymbolKind, heqDataCon,
                     coercibleDataCon )
@@ -683,24 +685,30 @@ 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 })
-  -- don't ever try to solve CallStack IPs directly from other dicts,
-  -- we always build new dicts instead.
+  | isWanted ev_w
+  , Just ip_name      <- isCallStackCt 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
+  -- of solving it directly from a given.
   -- See Note [Overview of implicit CallStacks]
-  | Just mkEvCs <- isCallStackIP loc cls tys
-  , isWanted ev_w
-  = do let ev_cs =
-             case lookupInertDict inerts cls tys of
-               Just ev | isGiven ev -> mkEvCs (ctEvTerm ev)
-               _ -> mkEvCs (EvCallStack EvCsEmpty)
-
-       -- now we have ev_cs :: CallStack, but the evidence term should
-       -- be a dictionary, so we have to coerce ev_cs to a
-       -- dictionary for `IP ip CallStack`
-       let ip_ty = mkClassPred cls tys
-       let ev_tm = mkEvCast (EvCallStack ev_cs) (wrapIP ip_ty)
-       addSolvedDict ev_w cls tys
-       setWantedEvBind (ctEvId ev_w) ev_tm
-       stopWith ev_w "Wanted CallStack IP"
+  = do { let loc = ctEvLoc ev_w
+
+         -- First we emit a new constraint that will capture the
+         -- given CallStack.
+       ; let new_loc      = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name))
+                            -- We change the origin to IPOccOrigin so
+                            -- this rule does not fire again.
+                            -- See Note [Overview of implicit CallStacks]
+
+       ; mb_new <- newWantedEvVar new_loc (ctEvPred ev_w)
+       ; emitWorkNC (freshGoals [mb_new])
+
+         -- Then we solve the wanted by pushing the call-site onto the
+         -- newly emitted CallStack.
+       ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (getEvTerm mb_new)
+       ; solveCallStack ev_w ev_cs
+       ; stopWith ev_w "Wanted CallStack IP" }
 
   | Just ctev_i <- lookupInertDict inerts cls tys
   = do { (inert_effect, stop_now) <- solveOneFromTheOther ctev_i ev_w
@@ -720,8 +728,6 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs
   | otherwise
   = do { addFunDepWork inerts ev_w cls
        ; continueWith workItem  }
-  where
-    loc = ctEvLoc ev_w
 
 interactDict _ wi = pprPanic "interactDict" (ppr wi)
 
@@ -777,25 +783,6 @@ interactGivenIP inerts workItem@(CDictCan { cc_ev = ev, cc_class = cls
 
 interactGivenIP _ wi = pprPanic "interactGivenIP" (ppr wi)
 
--- | Is the constraint for an implicit CallStack parameter?
--- i.e.   (IP "name" CallStack)
-isCallStackIP :: CtLoc -> Class -> [Type] -> Maybe (EvTerm -> EvCallStack)
-isCallStackIP loc cls tys
-  | cls == ipClass
-  , [_ip_name, ty] <- tys
-  , Just (tc, _) <- splitTyConApp_maybe ty
-  , tc `hasKey` callStackTyConKey
-  = occOrigin (ctLocOrigin loc)
-  | otherwise
-  = Nothing
-  where
-    locSpan = ctLocSpan loc
-
-    -- We only want to grab constraints that arose due to the use of an IP or a
-    -- function call. See Note [Overview of implicit CallStacks]
-    occOrigin (OccurrenceOf n) = Just (EvCsPushCall n locSpan)
-    occOrigin (IPOccOrigin n)  = Just (EvCsTop ('?' `consFS` hsIPNameFS n) locSpan)
-    occOrigin _                = Nothing
 
 {-
 Note [Shadowing of Implicit Parameters]
@@ -2102,6 +2089,14 @@ a TypeRep for them.  For qualified but not polymorphic types, like
    For now we leave it off, until we have a better story for impredicativity.
 -}
 
+solveCallStack :: CtEvidence -> EvCallStack -> TcS ()
+solveCallStack ev ev_cs = do
+  -- We're given ev_cs :: CallStack, but the evidence term should be a
+  -- dictionary, so we have to coerce ev_cs to a dictionary for
+  -- `IP ip CallStack`. See Note [Overview of implicit CallStacks]
+  let ev_tm = mkEvCast (EvCallStack ev_cs) (wrapIP (ctEvPred ev))
+  setWantedEvBind (ctEvId ev) ev_tm
+
 {- ********************************************************************
 *                                                                     *
                    Class lookup for lifted equality
index 932b7dd..b0c2e80 100644 (file)
@@ -67,7 +67,7 @@ module TcRnTypes(
         isCDictCan_Maybe, isCFunEqCan_maybe,
         isCIrredEvCan, isCNonCanonical, isWantedCt, isDerivedCt,
         isGivenCt, isHoleCt, isOutOfScopeCt, isExprHoleCt, isTypeHoleCt,
-        isUserTypeErrorCt, getUserTypeErrorMsg,
+        isUserTypeErrorCt, isCallStackCt, getUserTypeErrorMsg,
         ctEvidence, ctLoc, setCtLoc, ctPred, ctFlavour, ctEqRel, ctOrigin,
         mkTcEqPredLikeEv,
         mkNonCanonical, mkNonCanonicalCt,
@@ -127,6 +127,7 @@ import HsSyn
 import CoreSyn
 import HscTypes
 import TcEvidence
+import TysWiredIn ( callStackTyCon, ipClass )
 import Type
 import CoAxiom  ( Role )
 import Class    ( Class )
@@ -1731,6 +1732,20 @@ isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of
                          Just _ -> True
                          _      -> False
 
+-- | Is the constraint for an Implicit CallStack
+-- (i.e. @IP "name" CallStack@)?
+--
+-- If so, returns @Just "name"@.
+isCallStackCt :: Ct -> Maybe FastString
+isCallStackCt CDictCan { cc_class = cls, cc_tyargs = tys }
+  | cls == ipClass
+  , [ip_name_ty, ty] <- tys
+  , Just (tc, _) <- splitTyConApp_maybe ty
+  , tc == callStackTyCon
+  = isStrLitTy ip_name_ty
+isCallStackCt _
+  = Nothing
+
 instance Outputable Ct where
   ppr ct = ppr (cc_ev ct) <+> parens pp_sort
     where
index 11e7136..190c6c4 100644 (file)
@@ -154,7 +154,41 @@ simpl_top wanteds
            ; if something_happened
              then do { wc_residual <- nestTcS (solveWantedsAndDrop wc)
                      ; try_class_defaulting wc_residual }
-             else return wc }
+                  -- See Note [Overview of implicit CallStacks]
+             else try_callstack_defaulting wc }
+
+    try_callstack_defaulting :: WantedConstraints -> TcS WantedConstraints
+    try_callstack_defaulting wc
+      | isEmptyWC wc
+      = return wc
+      | otherwise
+      = defaultCallStacks wc
+
+-- | Default any remaining @CallStack@ constraints to empty @CallStack@s.
+defaultCallStacks :: WantedConstraints -> TcS WantedConstraints
+-- See Note [Overview of implicit CallStacks]
+defaultCallStacks wanteds
+  = do simples <- handle_simples (wc_simple wanteds)
+       implics <- mapBagM handle_implic (wc_impl wanteds)
+       return (wanteds { wc_simple = simples, wc_impl = implics })
+
+  where
+
+  handle_simples simples
+    = catBagMaybes <$> mapBagM defaultCallStack simples
+
+  handle_implic implic = do
+    wanteds <- defaultCallStacks (ic_wanted implic)
+    return (implic { ic_wanted = wanteds })
+
+  defaultCallStack ct@(CDictCan { cc_ev = ev_w })
+    | Just _ <- isCallStackCt ct
+    = do { solveCallStack ev_w EvCsEmpty
+         ; return Nothing }
+
+  defaultCallStack ct
+    = return (Just ct)
+
 
 -- | Type-check a thing, returning the result and any EvBinds produced
 -- during solving. Emits errors -- but does not fail -- if there is trouble.
@@ -227,7 +261,7 @@ Option (i) had many disadvantages:
       untouchable.
 
 Instead our new defaulting story is to pull defaulting out of the solver loop and
-go with option (i), implemented at SimplifyTop. Namely:
+go with option (ii), implemented at SimplifyTop. Namely:
      - First, have a go at solving the residual constraint of the whole
        program
      - Try to approximate it with a simple constraint
index 8f30f00..b539fa6 100644 (file)
@@ -113,7 +113,6 @@ import GHC.Fingerprint
 import GHC.Show         ( showMultiLineString )
 #if __GLASGOW_HASKELL__ > 710
 import GHC.Stack
-import GHC.Exception
 #endif
 
 {-
@@ -1071,8 +1070,8 @@ pprTraceIt desc x = pprTrace desc (ppr x) x
 -- | If debug output is on, show some 'SDoc' on the screen along
 -- with a call stack when available.
 #if __GLASGOW_HASKELL__ > 710
-pprSTrace :: (?location :: CallStack) => SDoc -> a -> a
-pprSTrace = pprTrace (showCallStack ?location)
+pprSTrace :: (?callStack :: CallStack) => SDoc -> a -> a
+pprSTrace = pprTrace (prettyCallStack ?callStack)
 #else
 pprSTrace :: SDoc -> a -> a
 pprSTrace = pprTrace "no callstack info"
index ff24091..8ce40e8 100644 (file)
@@ -31,28 +31,25 @@ Language
                                -- | Just a normal sum
                                Sum :: Int -> Int -> Expr Int
 
--  Implicit parameters of the new ghc-prim type ``GHC.Types.CallStack``
-   are treated specially, and automatically solved for the current
-   source location. For example
+-  Implicit parameters of the new ``base`` type ``GHC.Stack.CallStack``
+   are treated specially in function calls, the solver automatically
+   appends the source location of the call to the ``CallStack`` in
+   the environment. For example
 
    ::
+        myerror :: (?callStack :: CallStack) => String -> a
+        myerror msg = error (msg ++ "\n" ++ prettyCallStack ?callStack)
 
-                             f = print (?stk :: CallStack)
+        ghci> myerror "die"
+        *** Exception: die
+        CallStack (from ImplicitParams):
+          myerror, called at <interactive>:2:1 in interactive:Ghci1
 
-   will print the singleton stack containing the occurrence of ``?stk``.
-   If there is another ``CallStack`` implicit in-scope, the new location
-   will be appended to the existing stack, e.g.
+   prints the call-site of ``myerror``. The name of the implicit
+   parameter does not matter, but within ``base`` we call it
+   ``?callStack``.
 
-   ::
-
-                             f :: (?stk :: CallStack) => IO ()
-                             f = print (?stk :: CallStack)
-
-   will print the occurrence of ``?stk`` and the call-site of ``f``. The
-   name of the implicit parameter does not matter.
-
-   See the release notes for ghc-prim for a description of the
-   ``CallStack`` type.
+   See :ref:`lib-base` for a description of the ``CallStack`` type.
 
 -  To conform to the common case, the default role assigned to
    parameters of datatypes declared in ``hs-boot`` files is
@@ -279,19 +276,22 @@ array
 
 -  Version number XXXXX (was 0.5.0.0)
 
+
+.. _lib-base:
+
 base
 ~~~~
 
 -  Version number 4.9.0.0 (was 4.7.0.0)
 
--  A new module ``GHC.SrcLoc`` was added, exporting a new type
-   ``SrcLoc``. A ``SrcLoc`` contains package, module, and file names, as
-   well as start and end positions.
-
--  A new type ``CallStack`` was added for use with the new implicit
-   callstack parameters. A ``CallStack`` is a ``[(String, SrcLoc)]``,
+-  ``GHC.Stack`` exports two new types ``SrcLoc`` and ``CallStack``. A
+   ``SrcLoc`` contains package, module, and file names, as well as start
+   and end positions. A ``CallStack`` is a ``[(String, SrcLoc)]``,
    sorted by most-recent call.
 
+-  ``error`` and ``undefined`` will now report a partial stack-trace
+   using the new ``CallStack`` feature (and the ``-prof`` stack if available).
+
 -  A new function, ``interruptible``, was added to ``GHC.IO`` allowing
    an ``IO`` action to be run such that it can be interrupted by an
    asynchronous exception, even if exceptions are masked (except if
index ca30bdd..3c98dc7 100644 (file)
@@ -8151,37 +8151,46 @@ a type signature for ``y``, then ``y`` will get type
 Special implicit parameters
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-GHC treats implicit parameters of type ``GHC.Types.CallStack``
-specially, by resolving them to the current location in the program.
-Consider:
+Implicit parameters of the new ``base`` type ``GHC.Stack.CallStack`` are
+treated specially in function calls, the solver automatically appends
+the source location of the call to the ``CallStack`` in the
+environment. For example
 
 ::
+   myerror :: (?callStack :: CallStack) => String -> a
+   myerror msg = error (msg ++ "\n" ++ prettyCallStack ?callStack)
 
-      f :: String
-      f = show (?loc :: CallStack)
+   ghci> myerror "die"
+   *** Exception: die
+   CallStack (from ImplicitParams):
+     myerror, called at <interactive>:2:1 in interactive:Ghci1
 
-GHC will automatically resolve ``?loc`` to its source location. If
-another implicit parameter with type ``CallStack`` is in scope, GHC will
-append the two locations, creating an explicit call-stack. For example:
+prints the call-site of ``myerror``. The name of the implicit
+parameter does not matter, but within ``base`` we call it
+``?callStack``.
 
-::
-
-      f :: (?stk :: CallStack) => String
-      f = show (?stk :: CallStack)
-
-will produce the location of ``?stk``, followed by ``f``\'s call-site.
-Note that the name of the implicit parameter does not matter (we used
-``?loc`` above), GHC will solve any implicit parameter with the right
-type. The name does, however, matter when pushing new locations onto
-existing stacks. Consider:
+The ``CallStack`` will only extend as far as the types allow it, for
+example
 
 ::
+   head :: (?callStack :: CallStack) => [a] -> a
+   head []     = myerror "empty"
+   head (x:xs) = x
+   
+   bad :: Int
+   bad = head []
+
+   ghci> bad
+   *** Exception: empty
+   CallStack (from ImplicitParams):
+     myerror, called at Bad.hs:8:15 in main:Bad
+     head, called at Bad.hs:12:7 in main:Bad
 
-      f :: (?stk :: CallStack) => String
-      f = show (?loc :: CallStack)
+includes the call-site of ``myerror`` in ``head``, and of ``head`` in
+``bad``, but not the call-site of ``bad`` at the GHCi prompt.
 
-When we call ``f``, the stack will include the use of ``?loc``, but not
-the call to ``f``; in this case the names must match.
+GHC will never report an unbound implicit ``CallStack``, and will
+instead default such occurrences to the empty ``CallStack``.
 
 ``CallStack`` is kept abstract, but GHC provides a function
 
@@ -8192,15 +8201,9 @@ the call to ``f``; in this case the names must match.
 to access the individual call-sites in the stack. The ``String`` is the
 name of the function that was called, and the ``SrcLoc`` provides the
 package, module, and file name, as well as the line and column numbers.
-The stack will never be empty, as the first call-site will be the
-location at which the implicit parameter was used. GHC will also never
-infer ``?loc :: CallStack`` as a type constraint, which means that
-functions must explicitly ask to be told about their call-sites.
-
-A potential "gotcha" when using implicit ``CallStack``\ s is that the
-``:type`` command in GHCi will not report the ``?loc :: CallStack``
-constraint, as the typechecker will immediately solve it. Use ``:info``
-instead to print the unsolved type.
+GHC will infer ``CallStack`` constraints using the same rules as for
+ordinary implicit parameters.
+
 
 .. _kinding:
 
index afd1a50..80761ad 100644 (file)
@@ -27,9 +27,9 @@ module GHC.Exception
        , SomeException(..), ErrorCall(..,ErrorCall), ArithException(..)
        , divZeroException, overflowException, ratioZeroDenomException
        , errorCallException, errorCallWithCallStackException
-       , showCallStack, popCallStack, showSrcLoc
          -- re-export CallStack and SrcLoc from GHC.Types
-       , CallStack(..), SrcLoc(..)
+       , CallStack, getCallStack, prettyCallStack
+       , SrcLoc(..), prettySrcLoc
        ) where
 
 import Data.Maybe
@@ -187,7 +187,7 @@ errorCallWithCallStackException :: String -> CallStack -> SomeException
 errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do
   ccsStack <- currentCallStack
   let
-    implicitParamCallStack = showCallStackLines (popCallStack stk)
+    implicitParamCallStack = prettyCallStackLines stk
     ccsCallStack = showCCSStack ccsStack
     stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
   return $ toException (ErrorCallWithLocation s stack)
@@ -196,11 +196,14 @@ showCCSStack :: [String] -> [String]
 showCCSStack [] = []
 showCCSStack stk = "CallStack (from -prof):" : map ("  " ++) (reverse stk)
 
+-- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
+-- files. See Note [Definition of CallStack]
+
 -- | Pretty print 'SrcLoc'
 --
--- @since 4.9.0.0
-showSrcLoc :: SrcLoc -> String
-showSrcLoc SrcLoc {..}
+-- @since 4.8.1.0
+prettySrcLoc :: SrcLoc -> String
+prettySrcLoc SrcLoc {..}
   = foldr (++) ""
       [ srcLocFile, ":"
       , show srcLocStartLine, ":"
@@ -210,22 +213,17 @@ showSrcLoc SrcLoc {..}
 
 -- | Pretty print 'CallStack'
 --
--- @since 4.9.0.0
-showCallStack :: CallStack -> String
-showCallStack = intercalate "\n" . showCallStackLines
-
-showCallStackLines :: CallStack -> [String]
-showCallStackLines (CallStack stk) =
-    "CallStack (from ImplicitParams):" : map (("  " ++) . showCallSite) stk
+-- @since 4.8.1.0
+prettyCallStack :: CallStack -> String
+prettyCallStack = intercalate "\n" . prettyCallStackLines
+
+prettyCallStackLines :: CallStack -> [String]
+prettyCallStackLines cs = case getCallStack cs of
+  []  -> []
+  stk -> "CallStack (from ImplicitParams):"
+       : map (("  " ++) . prettyCallSite) stk
   where
-    showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc
-
--- | Remove the most recent callsite from the 'CallStack'
---
--- @since 4.9.0.0
-popCallStack :: CallStack -> CallStack
-popCallStack (CallStack (_:rest)) = CallStack rest
-popCallStack _ = error "CallStack cannot be empty!"
+    prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc
 
 -- |Arithmetic exceptions.
 data ArithException
index 7e483de..933ce94 100644 (file)
@@ -357,7 +357,7 @@ assertError predicate v
   | predicate = lazy v
   | otherwise = throw (AssertionFailed
                         ("Assertion failed\n"
-                         ++ showCallStack (popCallStack ?callStack)))
+                         ++ prettyCallStack ?callStack))
 
 unsupportedOperation :: IOError
 unsupportedOperation =
index f6fe41f..8f57239 100644 (file)
@@ -23,7 +23,10 @@ module GHC.Stack (
     errorWithStackTrace,
 
     -- * Implicit parameter call stacks
-    SrcLoc(..), CallStack(..),
+    CallStack, getCallStack, pushCallStack, prettyCallStack,
+
+    -- * Source locations
+    SrcLoc(..), prettySrcLoc,
 
     -- * Internals
     CostCentreStack,
@@ -40,6 +43,7 @@ module GHC.Stack (
   ) where
 
 import GHC.Stack.CCS
+import GHC.Stack.Types
 import GHC.IO
 import GHC.Base
 import GHC.List
index a43fe9a..f877f7e 100644 (file)
@@ -18,7 +18,9 @@
 
 module GHC.Stack.Types (
     -- * Implicit parameter call stacks
-    SrcLoc(..), CallStack(..),
+    CallStack, getCallStack, pushCallStack,
+    -- * Source locations
+    SrcLoc(..)
   ) where
 
 {-
@@ -44,22 +46,28 @@ import GHC.Integer ()
 -- Explicit call-stacks built via ImplicitParams
 ----------------------------------------------------------------------
 
--- | @CallStack@s are an alternate method of obtaining the call stack at a given
--- point in the program.
+-- | Implicit @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,
+-- GHC has two built-in rules for solving implicit-parameters of type
+-- @CallStack@.
+--
+-- 1. If the @CallStack@ occurs in a function call, it appends the
+--    source location of the call to the @CallStack@ in the environment.
+-- 2. @CallStack@s that cannot be solved normally (i.e. unbound
+--    occurrences) are defaulted to the empty @CallStack@.
+--
+-- Otherwise implicit @CallStack@s behave just like ordinary implicit
+-- parameters. For example:
 --
 -- @
--- myerror :: (?loc :: CallStack) => String -> a
--- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc)
+-- myerror :: (?callStack :: CallStack) => String -> a
+-- myerror msg = error (msg ++ "\n" ++ prettyCallStack ?callStack)
 -- @
+--
 -- ghci> myerror "die"
 -- *** Exception: die
--- CallStack:
---   ?loc, called at MyError.hs:7:51 in main:MyError
+-- CallStack (from ImplicitParams):
 --   myerror, called at <interactive>:2:1 in interactive:Ghci1
 --
 -- @CallStack@s do not interact with the RTS and do not require compilation with
@@ -71,13 +79,38 @@ import GHC.Integer ()
 -- 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.9.0.0
+-- @since 4.8.1.0
 data CallStack = CallStack { getCallStack :: [([Char], SrcLoc)] }
   -- See Note [Overview of implicit CallStacks]
 
--- | A single location in the source code.
+
+-- Note [Definition of CallStack]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Implicit CallStacks are defined very early in base because they are
+-- used by error and undefined. At this point in the dependency graph,
+-- we do not have enough functionality to (conveniently) write a nice
+-- pretty-printer for CallStack. The sensible place to define the
+-- pretty-printer would be GHC.Stack, which is the main access point,
+-- but unfortunately GHC.Stack imports GHC.Exception, which *needs*
+-- the pretty-printer. So the CallStack type and functions are split
+-- between three modules:
+--
+-- 1. GHC.Stack.Types: defines the type and *simple* functions
+-- 2. GHC.Exception: defines the pretty-printer
+-- 3. GHC.Stack: exports everything and acts as the main access point
+
+
+-- | Push a call-site onto the stack.
 --
 -- @since 4.9.0.0
+pushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack
+pushCallStack callSite (CallStack stk)
+  = CallStack (callSite : stk)
+
+
+-- | A single location in the source code.
+--
+-- @since 4.8.1.0
 data SrcLoc = SrcLoc
   { srcLocPackage   :: [Char]
   , srcLocModule    :: [Char]
index 3cf39e3..e4d12ed 100644 (file)
 
   * New `GHC.Generics.packageName` operation
 
-  * New `GHC.Stack.CallStack` data type
+  * New `GHC.Stack.Types` module now contains the definition of
+    `CallStack` and `SrcLoc`
+
+  * New `GHC.Stack.Types.pushCallStack` function pushes a call-site onto a `CallStack`
+
+  * `GHC.SrcLoc` has been removed
+
+  * `GHC.Stack.showCallStack` and `GHC.SrcLoc.showSrcLoc` are now called
+    `GHC.Stack.prettyCallStack` and `GHC.Stack.prettySrcLoc` respectively
 
   * `Complex` now has `Generic`, `Generic1`, `Functor`, `Foldable`, `Traversable`,
     `Applicative`, and `Monad` instances
 
   * `Lifetime` is now exported from `GHC.Event`
 
-  * Implicit-parameter based source location support exposed in `GHC.SrcLoc`.
+  * Implicit-parameter based source location support exposed in `GHC.SrcLoc` and `GHC.Stack`.
     See GHC User's Manual for more information.
 
 ## 4.8.0.0  *Mar 2015*
index 0bb8082..ef3e720 100644 (file)
@@ -1551,6 +1551,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/typecheck/should_run/T9497c-run
 /tests/typecheck/should_run/T9858c
 /tests/typecheck/should_run/T9858d
+/tests/typecheck/should_run/T10845
 /tests/typecheck/should_run/TcCoercible
 /tests/typecheck/should_run/TcNullaryTC
 /tests/typecheck/should_run/TcTypeNatSimpleRun
index 2365a03..af01704 100644 (file)
@@ -1,3 +1,4 @@
 cgrun059: Error: File not found
 CallStack (from ImplicitParams):
   error, called at cgrun059.hs:12:28 in main:Main
+  raiseError, called at cgrun059.hs:25:29 in main:Main
index b48a068..4c70f77 100644 (file)
@@ -1,3 +1,4 @@
 conc021: wurble
 CallStack (from ImplicitParams):
   error, called at conc021.hs:9:9 in main:Main
+  foo, called at conc021.hs:6:1 in main:Main
index 69cbcc4..dee4d94 100644 (file)
@@ -9,12 +9,12 @@ _exception :: e = _
 -2  : main (../Test7.hs:2:8-29)
 <end of history>
 Logged breakpoint at ../Test7.hs:2:18-28
-_result :: a14
+_result :: a3
 Logged breakpoint at ../Test7.hs:2:8-29
-_result :: IO a14
+_result :: IO a3
 no more logged breakpoints
 Logged breakpoint at ../Test7.hs:2:18-28
-_result :: a14
+_result :: a3
 Stopped at <exception thrown>
 _exception :: e
 already at the beginning of the history
@@ -23,7 +23,7 @@ _exception = SomeException
                   "foo"
                   "CallStack (from ImplicitParams):
   error, called at ../Test7.hs:2:18 in main:Main")
-_result :: a14 = _
+_result :: a3 = _
 _exception :: SomeException = SomeException
                                 (ErrorCallWithLocation
                                    "foo"
index 2bc2c23..e7e1817 100644 (file)
@@ -9,7 +9,8 @@ as = 'b' : 'c' : (_t1::[Char])
 Forcing
 *** Exception: Prelude.undefined
 CallStack (from ImplicitParams):
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  error, called at libraries/base/GHC/Err.hs:43: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])
index 62b39bb..1aa12c7 100644 (file)
@@ -1 +1 @@
-u = (_t1::ST s (forall s'. ST s' a))
+u = (_t1::(?callStack::CallStack) => ST s (forall s'. ST s' a))
index 86df6ab..835d351 100644 (file)
@@ -1,8 +1,10 @@
 *** Exception: Prelude.undefined
 CallStack (from ImplicitParams):
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+  error, called at libraries/base/GHC/Err.hs:43: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:42:14 in base:GHC.Err
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at <interactive>:3:12 in interactive:Ghci1
+  it, called at <interactive>:3:1 in interactive:Ghci1
index 4631732..77d1b7d 100644 (file)
@@ -1,6 +1,9 @@
 lookup :: Eq a => a -> [(a, b)] -> Maybe b
-undefined :: (forall a. a -> a) -> a :: (forall a1. a1 -> a1) -> a
+undefined :: (forall a. a -> a) -> a
+  :: (?callStack::CallStack) => (forall a1. a1 -> a1) -> a
 lookup ∷ Eq a ⇒ a → [(a, b)] → Maybe b
-undefined :: (forall a. a -> a) -> a ∷ (∀ a1. a1 → a1) → a
+undefined :: (forall a. a -> a) -> a
+  ∷ (?callStack::CallStack) ⇒ (∀ a1. a1 → a1) → a
 lookup :: Eq a => a -> [(a, b)] -> Maybe b
-undefined :: (forall a. a -> a) -> a :: (forall a1. a1 -> a1) -> a
+undefined :: (forall a. a -> a) -> a
+  :: (?callStack::CallStack) => (forall a1. a1 -> a1) -> a
index 6d99b87..245881f 100644 (file)
@@ -1 +1 @@
-f :: Monad m => (m a, r) -> m b
+f :: (Monad m, ?callStack::CallStack) => (m a, r) -> m b
index c4e7cf3..8b11297 100644 (file)
@@ -2,5 +2,5 @@ AND HTrue HTrue :: *
 = HTrue
 AND (OR HFalse HTrue) (OR HTrue HFalse) :: *
 = HTrue
-t :: HTrue
-t :: HFalse
+t :: (?callStack::CallStack) => HTrue
+t :: (?callStack::CallStack) => HFalse
index 578740d..6011c68 100644 (file)
@@ -1,6 +1,3 @@
-*** Exception: Prelude.undefined
-CallStack (from ImplicitParams):
-  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
-  undefined, called at <interactive>:1:7 in interactive:Ghci1
-x :: r = _
+x = _
+x :: ?callStack::CallStack => r = _
 y :: Integer = 3
index 965d492..0c0410d 100644 (file)
-TYPE SIGNATURES\r
-  !! :: forall a. [a] -> Int -> a\r
-  $ :: forall a b. (a -> b) -> a -> b\r
-  $! :: forall a b. (a -> b) -> a -> b\r
-  && :: Bool -> Bool -> Bool\r
-  * :: forall a. Num a => a -> a -> a\r
-  ** :: forall a. Floating a => a -> a -> a\r
-  + :: forall a. Num a => a -> a -> a\r
-  ++ :: forall a. [a] -> [a] -> [a]\r
-  - :: forall a. Num a => a -> a -> a\r
-  . :: forall b c a. (b -> c) -> (a -> b) -> a -> c\r
-  / :: forall a. Fractional a => a -> a -> a\r
-  /= :: forall a. Eq a => a -> a -> Bool\r
-  < :: forall a. Ord a => a -> a -> Bool\r
-  <= :: forall a. Ord a => a -> a -> Bool\r
-  =<< ::\r
-    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b\r
-  == :: forall a. Eq a => a -> a -> Bool\r
-  > :: forall a. Ord a => a -> a -> Bool\r
-  >= :: forall a. Ord a => a -> a -> Bool\r
-  >> :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b\r
-  >>= ::\r
-    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b\r
-  ^ :: forall a b. (Integral b, Num a) => a -> b -> a\r
-  ^^ :: forall a b. (Fractional a, Integral b) => a -> b -> a\r
-  abs :: forall a. Num a => a -> a\r
-  acos :: forall a. Floating a => a -> a\r
-  acosh :: forall a. Floating a => a -> a\r
-  all ::\r
-    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool\r
-  and :: forall (t :: * -> *). Foldable t => t Bool -> Bool\r
-  any ::\r
-    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool\r
-  appendFile :: FilePath -> String -> IO ()\r
-  asTypeOf :: forall a. a -> a -> a\r
-  asin :: forall a. Floating a => a -> a\r
-  asinh :: forall a. Floating a => a -> a\r
-  atan :: forall a. Floating a => a -> a\r
-  atan2 :: forall a. RealFloat a => a -> a -> a\r
-  atanh :: forall a. Floating a => a -> a\r
-  break :: forall a. (a -> Bool) -> [a] -> ([a], [a])\r
-  ceiling :: forall a b. (Integral b, RealFrac a) => a -> b\r
-  compare :: forall a. Ord a => a -> a -> Ordering\r
-  concat :: forall (t :: * -> *) a. Foldable t => t [a] -> [a]\r
-  concatMap ::\r
-    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]\r
-  const :: forall a b. a -> b -> a\r
-  cos :: forall a. Floating a => a -> a\r
-  cosh :: forall a. Floating a => a -> a\r
-  curry :: forall a b c. ((a, b) -> c) -> a -> b -> c\r
-  cycle :: forall a. [a] -> [a]\r
-  decodeFloat :: forall a. RealFloat a => a -> (Integer, Int)\r
-  div :: forall a. Integral a => a -> a -> a\r
-  divMod :: forall a. Integral a => a -> a -> (a, a)\r
-  drop :: forall a. Int -> [a] -> [a]\r
-  dropWhile :: forall a. (a -> Bool) -> [a] -> [a]\r
-  either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c\r
-  elem ::\r
-    forall (t :: * -> *) a. (Eq a, Foldable t) => a -> t a -> Bool\r
-  encodeFloat :: forall a. RealFloat a => Integer -> Int -> a\r
-  enumFrom :: forall a. Enum a => a -> [a]\r
-  enumFromThen :: forall a. Enum a => a -> a -> [a]\r
-  enumFromThenTo :: forall a. Enum a => a -> a -> a -> [a]\r
-  enumFromTo :: forall a. Enum a => a -> a -> [a]\r
-  error :: forall a. [Char] -> a\r
-  even :: forall a. Integral a => a -> Bool\r
-  exp :: forall a. Floating a => a -> a\r
-  exponent :: forall a. RealFloat a => a -> Int\r
-  fail :: forall (m :: * -> *) a. Monad m => String -> m a\r
-  filter :: forall a. (a -> Bool) -> [a] -> [a]\r
-  flip :: forall a b c. (a -> b -> c) -> b -> a -> c\r
-  floatDigits :: forall a. RealFloat a => a -> Int\r
-  floatRadix :: forall a. RealFloat a => a -> Integer\r
-  floatRange :: forall a. RealFloat a => a -> (Int, Int)\r
-  floor :: forall a b. (Integral b, RealFrac a) => a -> b\r
-  fmap ::\r
-    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b\r
-  foldl ::\r
-    forall (t :: * -> *) b a.\r
-    Foldable t =>\r
-    (b -> a -> b) -> b -> t a -> b\r
-  foldl1 ::\r
-    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a\r
-  foldr ::\r
-    forall (t :: * -> *) a b.\r
-    Foldable t =>\r
-    (a -> b -> b) -> b -> t a -> b\r
-  foldr1 ::\r
-    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a\r
-  fromEnum :: forall a. Enum a => a -> Int\r
-  fromInteger :: forall a. Num a => Integer -> a\r
-  fromIntegral :: forall a b. (Integral a, Num b) => a -> b\r
-  fromRational :: forall a. Fractional a => Rational -> a\r
-  fst :: forall a b. (a, b) -> a\r
-  gcd :: forall a. Integral a => a -> a -> a\r
-  getChar :: IO Char\r
-  getContents :: IO String\r
-  getLine :: IO String\r
-  head :: forall a. [a] -> a\r
-  id :: forall a. a -> a\r
-  init :: forall a. [a] -> [a]\r
-  interact :: (String -> String) -> IO ()\r
-  ioError :: forall a. IOError -> IO a\r
-  isDenormalized :: forall a. RealFloat a => a -> Bool\r
-  isIEEE :: forall a. RealFloat a => a -> Bool\r
-  isInfinite :: forall a. RealFloat a => a -> Bool\r
-  isNaN :: forall a. RealFloat a => a -> Bool\r
-  isNegativeZero :: forall a. RealFloat a => a -> Bool\r
-  iterate :: forall a. (a -> a) -> a -> [a]\r
-  last :: forall a. [a] -> a\r
-  lcm :: forall a. Integral a => a -> a -> a\r
-  length :: forall (t :: * -> *) a. Foldable t => t a -> Int\r
-  lex :: ReadS String\r
-  lines :: String -> [String]\r
-  log :: forall a. Floating a => a -> a\r
-  logBase :: forall a. Floating a => a -> a -> a\r
-  lookup :: forall a b. Eq a => a -> [(a, b)] -> Maybe b\r
-  map :: forall a b. (a -> b) -> [a] -> [b]\r
-  mapM ::\r
-    forall (t :: * -> *) (m :: * -> *) a b.\r
-    (Monad m, Traversable t) =>\r
-    (a -> m b) -> t a -> m (t b)\r
-  mapM_ ::\r
-    forall (t :: * -> *) (m :: * -> *) a b.\r
-    (Monad m, Foldable t) =>\r
-    (a -> m b) -> t a -> m ()\r
-  max :: forall a. Ord a => a -> a -> a\r
-  maxBound :: forall t. Bounded t => t\r
-  maximum :: forall (t :: * -> *) a. (Ord a, Foldable t) => t a -> a\r
-  maybe :: forall b a. b -> (a -> b) -> Maybe a -> b\r
-  min :: forall a. Ord a => a -> a -> a\r
-  minBound :: forall t. Bounded t => t\r
-  minimum :: forall (t :: * -> *) a. (Ord a, Foldable t) => t a -> a\r
-  mod :: forall a. Integral a => a -> a -> a\r
-  negate :: forall a. Num a => a -> a\r
-  not :: Bool -> Bool\r
-  notElem ::\r
-    forall (t :: * -> *) a. (Eq a, Foldable t) => a -> t a -> Bool\r
-  null :: forall (t :: * -> *) a. Foldable t => t a -> Bool\r
-  odd :: forall a. Integral a => a -> Bool\r
-  or :: forall (t :: * -> *). Foldable t => t Bool -> Bool\r
-  otherwise :: Bool\r
-  pi :: forall t. Floating t => t\r
-  pred :: forall a. Enum a => a -> a\r
-  print :: forall a. Show a => a -> IO ()\r
-  product :: forall (t :: * -> *) a. (Num a, Foldable t) => t a -> a\r
-  properFraction ::\r
-    forall a b. (Integral b, RealFrac a) => a -> (b, a)\r
-  putChar :: Char -> IO ()\r
-  putStr :: String -> IO ()\r
-  putStrLn :: String -> IO ()\r
-  quot :: forall a. Integral a => a -> a -> a\r
-  quotRem :: forall a. Integral a => a -> a -> (a, a)\r
-  read :: forall a. Read a => String -> a\r
-  readFile :: FilePath -> IO String\r
-  readIO :: forall a. Read a => String -> IO a\r
-  readList :: forall a. Read a => ReadS [a]\r
-  readLn :: forall a. Read a => IO a\r
-  readParen :: forall a. Bool -> ReadS a -> ReadS a\r
-  reads :: forall a. Read a => ReadS a\r
-  readsPrec :: forall a. Read a => Int -> ReadS a\r
-  realToFrac :: forall a b. (Fractional b, Real a) => a -> b\r
-  recip :: forall a. Fractional a => a -> a\r
-  rem :: forall a. Integral a => a -> a -> a\r
-  repeat :: forall a. a -> [a]\r
-  replicate :: forall a. Int -> a -> [a]\r
-  return :: forall (m :: * -> *) a. Monad m => a -> m a\r
-  reverse :: forall a. [a] -> [a]\r
-  round :: forall a b. (Integral b, RealFrac a) => a -> b\r
-  scaleFloat :: forall a. RealFloat a => Int -> a -> a\r
-  scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b]\r
-  scanl1 :: forall a. (a -> a -> a) -> [a] -> [a]\r
-  scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]\r
-  scanr1 :: forall a. (a -> a -> a) -> [a] -> [a]\r
-  seq :: forall a b. a -> b -> b\r
-  sequence ::\r
-    forall (t :: * -> *) (m :: * -> *) a.\r
-    (Monad m, Traversable t) =>\r
-    t (m a) -> m (t a)\r
-  sequence_ ::\r
-    forall (t :: * -> *) (m :: * -> *) a.\r
-    (Monad m, Foldable t) =>\r
-    t (m a) -> m ()\r
-  show :: forall a. Show a => a -> String\r
-  showChar :: Char -> ShowS\r
-  showList :: forall a. Show a => [a] -> ShowS\r
-  showParen :: Bool -> ShowS -> ShowS\r
-  showString :: String -> ShowS\r
-  shows :: forall a. Show a => a -> ShowS\r
-  showsPrec :: forall a. Show a => Int -> a -> ShowS\r
-  significand :: forall a. RealFloat a => a -> a\r
-  signum :: forall a. Num a => a -> a\r
-  sin :: forall a. Floating a => a -> a\r
-  sinh :: forall a. Floating a => a -> a\r
-  snd :: forall a b. (a, b) -> b\r
-  span :: forall a. (a -> Bool) -> [a] -> ([a], [a])\r
-  splitAt :: forall a. Int -> [a] -> ([a], [a])\r
-  sqrt :: forall a. Floating a => a -> a\r
-  subtract :: forall a. Num a => a -> a -> a\r
-  succ :: forall a. Enum a => a -> a\r
-  sum :: forall (t :: * -> *) a. (Num a, Foldable t) => t a -> a\r
-  tail :: forall a. [a] -> [a]\r
-  take :: forall a. Int -> [a] -> [a]\r
-  takeWhile :: forall a. (a -> Bool) -> [a] -> [a]\r
-  tan :: forall a. Floating a => a -> a\r
-  tanh :: forall a. Floating a => a -> a\r
-  toEnum :: forall a. Enum a => Int -> a\r
-  toInteger :: forall a. Integral a => a -> Integer\r
-  toRational :: forall a. Real a => a -> Rational\r
-  truncate :: forall a b. (Integral b, RealFrac a) => a -> b\r
-  uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c\r
-  undefined :: forall t. t\r
-  unlines :: [String] -> String\r
-  until :: forall a. (a -> Bool) -> (a -> a) -> a -> a\r
-  unwords :: [String] -> String\r
-  unzip :: forall a b. [(a, b)] -> ([a], [b])\r
-  unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])\r
-  userError :: String -> IOError\r
-  words :: String -> [String]\r
-  writeFile :: FilePath -> String -> IO ()\r
-  zip :: forall a b. [a] -> [b] -> [(a, b)]\r
-  zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]\r
-  zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]\r
-  zipWith3 ::\r
-    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]\r
-  || :: Bool -> Bool -> Bool\r
-TYPE CONSTRUCTORS\r
-COERCION AXIOMS\r
-Dependent modules: []\r
-Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,\r
-                     integer-gmp-1.0.0.0]\r
+TYPE SIGNATURES
+  !! :: forall a. [a] -> Int -> a
+  $ :: forall a b. (a -> b) -> a -> b
+  $! :: forall a b. (a -> b) -> a -> b
+  && :: Bool -> Bool -> Bool
+  * :: forall a. Num a => a -> a -> a
+  ** :: forall a. Floating a => a -> a -> a
+  + :: forall a. Num a => a -> a -> a
+  ++ :: forall a. [a] -> [a] -> [a]
+  - :: forall a. Num a => a -> a -> a
+  . :: forall b c a. (b -> c) -> (a -> b) -> a -> c
+  / :: forall a. Fractional a => a -> a -> a
+  /= :: forall a. Eq a => a -> a -> Bool
+  < :: forall a. Ord a => a -> a -> Bool
+  <= :: forall a. Ord a => a -> a -> Bool
+  =<< ::
+    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
+  == :: forall a. Eq a => a -> a -> Bool
+  > :: forall a. Ord a => a -> a -> Bool
+  >= :: forall a. Ord a => a -> a -> Bool
+  >> :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
+  >>= ::
+    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
+  ^ :: forall a b. (Integral b, Num a) => a -> b -> a
+  ^^ :: forall a b. (Fractional a, Integral b) => a -> b -> a
+  abs :: forall a. Num a => a -> a
+  acos :: forall a. Floating a => a -> a
+  acosh :: forall a. Floating a => a -> a
+  all ::
+    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
+  and :: forall (t :: * -> *). Foldable t => t Bool -> Bool
+  any ::
+    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
+  appendFile :: FilePath -> String -> IO ()
+  asTypeOf :: forall a. a -> a -> a
+  asin :: forall a. Floating a => a -> a
+  asinh :: forall a. Floating a => a -> a
+  atan :: forall a. Floating a => a -> a
+  atan2 :: forall a. RealFloat a => a -> a -> a
+  atanh :: forall a. Floating a => a -> a
+  break :: forall a. (a -> Bool) -> [a] -> ([a], [a])
+  ceiling :: forall a b. (Integral b, RealFrac a) => a -> b
+  compare :: forall a. Ord a => a -> a -> Ordering
+  concat :: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
+  concatMap ::
+    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
+  const :: forall a b. a -> b -> a
+  cos :: forall a. Floating a => a -> a
+  cosh :: forall a. Floating a => a -> a
+  curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
+  cycle :: forall a. [a] -> [a]
+  decodeFloat :: forall a. RealFloat a => a -> (Integer, Int)
+  div :: forall a. Integral a => a -> a -> a
+  divMod :: forall a. Integral a => a -> a -> (a, a)
+  drop :: forall a. Int -> [a] -> [a]
+  dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
+  either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
+  elem ::
+    forall (t :: * -> *) a. (Eq a, Foldable t) => a -> t a -> Bool
+  encodeFloat :: forall a. RealFloat a => Integer -> Int -> a
+  enumFrom :: forall a. Enum a => a -> [a]
+  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::CallStack) => [Char] -> a
+  even :: forall a. Integral a => a -> Bool
+  exp :: forall a. Floating a => a -> a
+  exponent :: forall a. RealFloat a => a -> Int
+  fail :: forall (m :: * -> *) a. Monad m => String -> m a
+  filter :: forall a. (a -> Bool) -> [a] -> [a]
+  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+  floatDigits :: forall a. RealFloat a => a -> Int
+  floatRadix :: forall a. RealFloat a => a -> Integer
+  floatRange :: forall a. RealFloat a => a -> (Int, Int)
+  floor :: forall a b. (Integral b, RealFrac a) => a -> b
+  fmap ::
+    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
+  foldl ::
+    forall (t :: * -> *) b a.
+    Foldable t =>
+    (b -> a -> b) -> b -> t a -> b
+  foldl1 ::
+    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
+  foldr ::
+    forall (t :: * -> *) a b.
+    Foldable t =>
+    (a -> b -> b) -> b -> t a -> b
+  foldr1 ::
+    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
+  fromEnum :: forall a. Enum a => a -> Int
+  fromInteger :: forall a. Num a => Integer -> a
+  fromIntegral :: forall a b. (Integral a, Num b) => a -> b
+  fromRational :: forall a. Fractional a => Rational -> a
+  fst :: forall a b. (a, b) -> a
+  gcd :: forall a. Integral a => a -> a -> a
+  getChar :: IO Char
+  getContents :: IO String
+  getLine :: IO String
+  head :: forall a. [a] -> a
+  id :: forall a. a -> a
+  init :: forall a. [a] -> [a]
+  interact :: (String -> String) -> IO ()
+  ioError :: forall a. IOError -> IO a
+  isDenormalized :: forall a. RealFloat a => a -> Bool
+  isIEEE :: forall a. RealFloat a => a -> Bool
+  isInfinite :: forall a. RealFloat a => a -> Bool
+  isNaN :: forall a. RealFloat a => a -> Bool
+  isNegativeZero :: forall a. RealFloat a => a -> Bool
+  iterate :: forall a. (a -> a) -> a -> [a]
+  last :: forall a. [a] -> a
+  lcm :: forall a. Integral a => a -> a -> a
+  length :: forall (t :: * -> *) a. Foldable t => t a -> Int
+  lex :: ReadS String
+  lines :: String -> [String]
+  log :: forall a. Floating a => a -> a
+  logBase :: forall a. Floating a => a -> a -> a
+  lookup :: forall a b. Eq a => a -> [(a, b)] -> Maybe b
+  map :: forall a b. (a -> b) -> [a] -> [b]
+  mapM ::
+    forall (t :: * -> *) (m :: * -> *) a b.
+    (Monad m, Traversable t) =>
+    (a -> m b) -> t a -> m (t b)
+  mapM_ ::
+    forall (t :: * -> *) (m :: * -> *) a b.
+    (Monad m, Foldable t) =>
+    (a -> m b) -> t a -> m ()
+  max :: forall a. Ord a => a -> a -> a
+  maxBound :: forall t. Bounded t => t
+  maximum :: forall (t :: * -> *) a. (Ord a, Foldable t) => t a -> a
+  maybe :: forall b a. b -> (a -> b) -> Maybe a -> b
+  min :: forall a. Ord a => a -> a -> a
+  minBound :: forall t. Bounded t => t
+  minimum :: forall (t :: * -> *) a. (Ord a, Foldable t) => t a -> a
+  mod :: forall a. Integral a => a -> a -> a
+  negate :: forall a. Num a => a -> a
+  not :: Bool -> Bool
+  notElem ::
+    forall (t :: * -> *) a. (Eq a, Foldable t) => a -> t a -> Bool
+  null :: forall (t :: * -> *) a. Foldable t => t a -> Bool
+  odd :: forall a. Integral a => a -> Bool
+  or :: forall (t :: * -> *). Foldable t => t Bool -> Bool
+  otherwise :: Bool
+  pi :: forall t. Floating t => t
+  pred :: forall a. Enum a => a -> a
+  print :: forall a. Show a => a -> IO ()
+  product :: forall (t :: * -> *) a. (Num a, Foldable t) => t a -> a
+  properFraction ::
+    forall a b. (Integral b, RealFrac a) => a -> (b, a)
+  putChar :: Char -> IO ()
+  putStr :: String -> IO ()
+  putStrLn :: String -> IO ()
+  quot :: forall a. Integral a => a -> a -> a
+  quotRem :: forall a. Integral a => a -> a -> (a, a)
+  read :: forall a. Read a => String -> a
+  readFile :: FilePath -> IO String
+  readIO :: forall a. Read a => String -> IO a
+  readList :: forall a. Read a => ReadS [a]
+  readLn :: forall a. Read a => IO a
+  readParen :: forall a. Bool -> ReadS a -> ReadS a
+  reads :: forall a. Read a => ReadS a
+  readsPrec :: forall a. Read a => Int -> ReadS a
+  realToFrac :: forall a b. (Fractional b, Real a) => a -> b
+  recip :: forall a. Fractional a => a -> a
+  rem :: forall a. Integral a => a -> a -> a
+  repeat :: forall a. a -> [a]
+  replicate :: forall a. Int -> a -> [a]
+  return :: forall (m :: * -> *) a. Monad m => a -> m a
+  reverse :: forall a. [a] -> [a]
+  round :: forall a b. (Integral b, RealFrac a) => a -> b
+  scaleFloat :: forall a. RealFloat a => Int -> a -> a
+  scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
+  scanl1 :: forall a. (a -> a -> a) -> [a] -> [a]
+  scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]
+  scanr1 :: forall a. (a -> a -> a) -> [a] -> [a]
+  seq :: forall a b. a -> b -> b
+  sequence ::
+    forall (t :: * -> *) (m :: * -> *) a.
+    (Monad m, Traversable t) =>
+    t (m a) -> m (t a)
+  sequence_ ::
+    forall (t :: * -> *) (m :: * -> *) a.
+    (Monad m, Foldable t) =>
+    t (m a) -> m ()
+  show :: forall a. Show a => a -> String
+  showChar :: Char -> ShowS
+  showList :: forall a. Show a => [a] -> ShowS
+  showParen :: Bool -> ShowS -> ShowS
+  showString :: String -> ShowS
+  shows :: forall a. Show a => a -> ShowS
+  showsPrec :: forall a. Show a => Int -> a -> ShowS
+  significand :: forall a. RealFloat a => a -> a
+  signum :: forall a. Num a => a -> a
+  sin :: forall a. Floating a => a -> a
+  sinh :: forall a. Floating a => a -> a
+  snd :: forall a b. (a, b) -> b
+  span :: forall a. (a -> Bool) -> [a] -> ([a], [a])
+  splitAt :: forall a. Int -> [a] -> ([a], [a])
+  sqrt :: forall a. Floating a => a -> a
+  subtract :: forall a. Num a => a -> a -> a
+  succ :: forall a. Enum a => a -> a
+  sum :: forall (t :: * -> *) a. (Num a, Foldable t) => t a -> a
+  tail :: forall a. [a] -> [a]
+  take :: forall a. Int -> [a] -> [a]
+  takeWhile :: forall a. (a -> Bool) -> [a] -> [a]
+  tan :: forall a. Floating a => a -> a
+  tanh :: forall a. Floating a => a -> a
+  toEnum :: forall a. Enum a => Int -> a
+  toInteger :: forall a. Integral a => a -> Integer
+  toRational :: forall a. Real a => a -> Rational
+  truncate :: forall a b. (Integral b, RealFrac a) => a -> b
+  uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
+  undefined :: forall t. (?callStack::CallStack) => t
+  unlines :: [String] -> String
+  until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
+  unwords :: [String] -> String
+  unzip :: forall a b. [(a, b)] -> ([a], [b])
+  unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
+  userError :: String -> IOError
+  words :: String -> [String]
+  writeFile :: FilePath -> String -> IO ()
+  zip :: forall a b. [a] -> [b] -> [(a, b)]
+  zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
+  zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
+  zipWith3 ::
+    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+  || :: Bool -> Bool -> Bool
+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]
index c74719a..4085291 100644 (file)
@@ -1,6 +1,7 @@
 
 T10999.hs:5:6: error:
-    Found constraint wildcard ‘_’ standing for ‘Ord a’
+    Found constraint wildcard ‘_’ standing for ‘(Ord a,
+                                                 ?callStack::CallStack)’
     To use the inferred type, enable PartialTypeSignatures
     In the type signature:
       f :: _ => () -> _
@@ -8,7 +9,9 @@ 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 :: Ord a => () -> Set.Set a at T10999.hs:6:1
+               the inferred type of
+               f :: (Ord a, ?callStack::CallStack) => () -> Set.Set a
+               at T10999.hs:6:1
       To use the inferred type, enable PartialTypeSignatures
     • In the type signature:
         f :: _ => () -> _
index fb4449c..e69de29 100644 (file)
@@ -1,39 +0,0 @@
-T3927b.hs:58:5: warning:
-    • Redundant constraint: Restrict op (Implements 'Dealer)
-    • In the type signature for:
-           f :: Restrict op (Implements 'Dealer) =>
-                SockOp 'Dealer op -> Operation op
-      In an equation for ‘dealer’:
-          dealer
-            = Socket (Proxy :: Proxy Dealer) f
-            where
-                f ::
-                  Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op
-                f SRead = undefined
-                f SWrite = undefined
-
-T3927b.hs:65:5: warning:
-    • Redundant constraint: Restrict op (Implements 'Push)
-    • In the type signature for:
-           f :: Restrict op (Implements 'Push) =>
-                SockOp 'Push op -> Operation op
-      In an equation for ‘push’:
-          push
-            = Socket (Proxy :: Proxy Push) f
-            where
-                f ::
-                  Restrict op (Implements Push) => SockOp Push op -> Operation op
-                f SWrite = undefined
-
-T3927b.hs:71:5: warning:
-    • Redundant constraint: Restrict op (Implements 'Pull)
-    • In the type signature for:
-           f :: Restrict op (Implements 'Pull) =>
-                SockOp 'Pull op -> Operation op
-      In an equation for ‘pull’:
-          pull
-            = Socket (Proxy :: Proxy Pull) f
-            where
-                f ::
-                  Restrict op (Implements Pull) => SockOp Pull op -> Operation op
-                f SRead = undefined
index 5ae77b9..cee251a 100644 (file)
@@ -1,9 +1,9 @@
 :set -XTemplateHaskell
 import Language.Haskell.TH
 let seeType n = do VarI _ t _ <- reify n; runIO $ putStrLn $ show t; [| return True |]
-let f = undefined :: Int -> Int
-let g = undefined :: [Int]
-let h = undefined :: (Int, Int)
+let f :: Int -> Int; f = undefined
+let g :: [Int]     ; g = undefined
+let h :: (Int, Int); h = undefined
 $(seeType (mkName "f"))
 $(seeType (mkName "g"))
 $(seeType (mkName "h"))
index 63f73d2..75575e0 100644 (file)
@@ -2,21 +2,14 @@
 {-# OPTIONS_GHC -dcore-lint #-}
 module Main where
 
-import GHC.Exception
-import GHC.Types
+import GHC.Stack
 
-f0 = putStrLn $ showCallStack ?loc
-     -- should just show the location of ?loc
+f0 = putStrLn $ prettyCallStack ?loc
+     -- should be empty
 
 f1 :: (?loc :: CallStack) => IO ()
-f1 = putStrLn $ showCallStack ?loc
-     -- should show the location of ?loc *and* f1's call-site
-
-f2 :: (?loc :: CallStack) => IO ()
-f2 = do putStrLn $ showCallStack ?loc
-        putStrLn $ showCallStack ?loc
-     -- each ?loc should refer to a different location, but they should
-     -- share f2's call-site
+f1 = putStrLn $ prettyCallStack ?loc
+     -- should show the location of f1's call-site
 
 f3 :: ((?loc :: CallStack) => () -> IO ()) -> IO ()
 f3 x = x ()
@@ -32,14 +25,13 @@ f5 x = x ()
        -- we only push new call-sites onto CallStacks with the name IP name
 
 f6 :: (?loc :: CallStack) => Int -> IO ()
-f6 0 = putStrLn $ showCallStack ?loc
+f6 0 = putStrLn $ prettyCallStack ?loc
 f6 n = f6 (n-1)
        -- recursive functions add a SrcLoc for each recursive call
 
 main = do f0
           f1
-          f2
-          f3 (\ () -> putStrLn $ showCallStack ?loc)
-          f4 (\ () -> putStrLn $ showCallStack ?loc)
-          f5 (\ () -> putStrLn $ showCallStack ?loc3)
+          f3 (\ () -> putStrLn $ prettyCallStack ?loc)
+          f4 (\ () -> putStrLn $ prettyCallStack ?loc)
+          f5 (\ () -> putStrLn $ prettyCallStack ?loc3)
           f6 5
index d02250f..92c0cd4 100644 (file)
@@ -1,28 +1,16 @@
+
 CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:8:31 in main:Main
+  f1, called at IPLocation.hs:34:11 in main:Main
 CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:12:31 in main:Main
-  f1, called at IPLocation.hs:40:11 in main:Main
+  x, called at IPLocation.hs:16:8 in main:Main
 CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:16:34 in main:Main
-  f2, called at IPLocation.hs:41:11 in main:Main
+  x, called at IPLocation.hs:21:8 in main:Main
+  f4, called at IPLocation.hs:36:11 in main:Main
+
 CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:17:34 in main:Main
-  f2, called at IPLocation.hs:41:11 in main:Main
-CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:42:48 in main:Main
-  x, called at IPLocation.hs:22:8 in main:Main
-CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:43:48 in main:Main
-  x, called at IPLocation.hs:27:8 in main:Main
-  f4, called at IPLocation.hs:43:11 in main:Main
-CallStack (from ImplicitParams):
-  ?loc3, called at IPLocation.hs:44:48 in main:Main
-CallStack (from ImplicitParams):
-  ?loc, called at IPLocation.hs:35:33 in main:Main
-  f6, called at IPLocation.hs:36:8 in main:Main
-  f6, called at IPLocation.hs:36:8 in main:Main
-  f6, called at IPLocation.hs:36:8 in main:Main
-  f6, called at IPLocation.hs:36:8 in main:Main
-  f6, called at IPLocation.hs:36:8 in main:Main
-  f6, called at IPLocation.hs:45:11 in main:Main
+  f6, called at IPLocation.hs:30:8 in main:Main
+  f6, called at IPLocation.hs:30:8 in main:Main
+  f6, called at IPLocation.hs:30:8 in main:Main
+  f6, called at IPLocation.hs:30:8 in main:Main
+  f6, called at IPLocation.hs:30:8 in main:Main
+  f6, called at IPLocation.hs:38:11 in main:Main
diff --git a/testsuite/tests/typecheck/should_run/T10845.hs b/testsuite/tests/typecheck/should_run/T10845.hs
new file mode 100644 (file)
index 0000000..3d813fc
--- /dev/null
@@ -0,0 +1,20 @@
+{-# LANGUAGE ImplicitParams #-}
+{-# OPTIONS_GHC -dcore-lint #-}
+
+import GHC.Stack
+
+f1 :: (?loc :: CallStack) => CallStack
+-- we can infer a CallStack for let-binders
+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
new file mode 100644 (file)
index 0000000..af39ed4
--- /dev/null
@@ -0,0 +1,5 @@
+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
diff --git a/testsuite/tests/typecheck/should_run/T10846.hs b/testsuite/tests/typecheck/should_run/T10846.hs
new file mode 100644 (file)
index 0000000..e9ec573
--- /dev/null
@@ -0,0 +1,20 @@
+{-# LANGUAGE ImplicitParams, PartialTypeSignatures #-}
+
+module Main where
+
+import GHC.Stack
+
+f1 :: (?loc :: CallStack) => String
+f1 = show $ map (srcLocStartLine . snd) $ getCallStack ?loc
+
+f2 :: (?loc :: CallStack) => _
+f2 = show $ map (srcLocStartLine . snd) $ getCallStack ?loc
+
+f3 :: (?loc :: CallStack, _) => String
+f3 = show $ map (srcLocStartLine . snd) $ getCallStack ?loc
+
+main :: IO ()
+main = do
+  putStrLn f1
+  putStrLn f2
+  putStrLn f3
diff --git a/testsuite/tests/typecheck/should_run/T10846.stdout b/testsuite/tests/typecheck/should_run/T10846.stdout
new file mode 100644 (file)
index 0000000..04ad2fd
--- /dev/null
@@ -0,0 +1,3 @@
+[18]
+[19]
+[20]
index cda6b1d..e796b66 100644 (file)
@@ -1,2 +1,3 @@
-test `asTypeOf` (undefined :: a -> b) :: Int -> Int
+test `asTypeOf` (undefined :: a -> b)
+  :: (?callStack::CallStack) => Int -> Int
 \x -> test x :: Int -> Int
index 217f75e..def9ede 100755 (executable)
@@ -78,6 +78,8 @@ test('testeq2', normal, compile_and_run, [''])
 test('T1624', normal, compile_and_run, [''])
 test('IPRun', normal, compile_and_run, [''])
 test('IPLocation', normal, compile_and_run, [''])
+test('T10845', normal, compile_and_run, [''])
+test('T10846', normal, compile_and_run, [''])
 
 # Support files for T1735 are in directory T1735_Help/
 test('T1735', normal, multimod_compile_and_run, ['T1735',''])