Commit 01b12ca9 authored by Joachim Breitner's avatar Joachim Breitner
Browse files

Separate SubGoalDepthCounters (constraints and typ fun applications)

parent e42ddfe1
......@@ -1396,8 +1396,8 @@ are created by in RtClosureInspect.zonkRTTIType.
%************************************************************************
\begin{code}
solverDepthErrorTcS :: Ct -> TcM a
solverDepthErrorTcS ct
solverDepthErrorTcS :: SubGoalCounter -> Ct -> TcM a
solverDepthErrorTcS cnt ct
= setCtLoc loc $
do { pred <- zonkTcType (ctPred ct)
; env0 <- tcInitTidyEnv
......@@ -1407,7 +1407,7 @@ solverDepthErrorTcS ct
where
loc = cc_loc ct
depth = ctLocDepth loc
msg = vcat [ ptext (sLit "Context reduction stack overflow; size =") <+> ppr depth
msg = vcat [ ptext (sLit "Context reduction stack overflow; size =") <+> int (subGoalCounterValue cnt depth)
, ptext (sLit "Use -fcontext-stack=N to increase stack size to N") ]
\end{code}
......
......@@ -124,8 +124,8 @@ solveInteract cts
; case sel of
NoWorkRemaining -- Done, successfuly (modulo frozen)
-> return ()
MaxDepthExceeded ct -- Failure, depth exceeded
-> wrapErrTcS $ solverDepthErrorTcS ct
MaxDepthExceeded cnt ct -- Failure, depth exceeded
-> wrapErrTcS $ solverDepthErrorTcS cnt ct
NextWorkItem ct -- More work, loop around!
-> do { runSolverPipeline thePipeline ct; solve_loop max_depth } }
......@@ -134,8 +134,10 @@ type SimplifierStage = WorkItem -> TcS StopOrContinue
data SelectWorkItem
= NoWorkRemaining -- No more work left (effectively we're done!)
| MaxDepthExceeded Ct -- More work left to do but this constraint has exceeded
-- the max subgoal depth and we must stop
| MaxDepthExceeded SubGoalCounter Ct
-- More work left to do but this constraint has exceeded
-- the maximum depth for one of the subgoal counters and we
-- must stop
| NextWorkItem Ct -- More work left, here's the next item to look at
selectNextWorkItem :: Int -- Max depth allowed
......@@ -149,8 +151,8 @@ selectNextWorkItem max_depth
(Nothing,_)
-> (NoWorkRemaining,wl) -- No more work
(Just ct, new_wl)
| subGoalDepthExceeded max_depth (ctLocDepth (cc_loc ct)) -- Depth exceeded
-> (MaxDepthExceeded ct,new_wl)
| Just cnt <- subGoalDepthExceeded max_depth (ctLocDepth (cc_loc ct)) -- Depth exceeded
-> (MaxDepthExceeded cnt ct,new_wl)
(Just ct, new_wl)
-> (NextWorkItem ct, new_wl) -- New workitem and worklist
......@@ -1437,8 +1439,9 @@ doTopReact inerts workItem
--------------------
doTopReactDict :: InertSet -> CtEvidence -> Class -> [Xi]
-> CtLoc -> TcS TopInteractResult
-- Try to use type-class instance declarations to simplify the constraint
doTopReactDict inerts fl cls xis loc
| not (isWanted fl)
| not (isWanted fl) -- Never use instances for Given or Derived constraints
= try_fundeps_and_return
| Just ev <- lookupSolvedDict inerts pred -- Cached
......@@ -1473,7 +1476,7 @@ doTopReactDict inerts fl cls xis loc
; setEvBind dict_id ev_term
; let mk_new_wanted ev
= CNonCanonical { cc_ev = ev
, cc_loc = bumpCtLocDepth loc }
, cc_loc = bumpCtLocDepth CountConstraints loc }
; updWorkListTcS (extendWorkListCts (map mk_new_wanted evs))
; return $
SomeTopInt { tir_rule = "Dict/Top (solved, more work)"
......@@ -1537,7 +1540,7 @@ doTopReactFunEq _ct fl fun_tc args xi loc
; case ctevs of
[ctev] -> updWorkListTcS $ extendWorkListEq $
CNonCanonical { cc_ev = ctev
, cc_loc = bumpCtLocDepth loc }
, cc_loc = bumpCtLocDepth CountTyFunApps loc }
ctevs -> -- No subgoal (because it's cached)
ASSERT( null ctevs) return ()
; return $ SomeTopInt { tir_rule = str
......
......@@ -55,8 +55,9 @@ module TcRnTypes(
andWC, unionsWC, addFlats, addImplics, mkFlatWC, addInsols,
Implication(..),
SubGoalCounter(..),
SubGoalDepth, initialSubGoalDepth, bumpSubGoalDepth,
subGoalDepthExceeded,
subGoalCounterValue, subGoalDepthExceeded,
CtLoc(..), ctLocSpan, ctLocEnv, ctLocOrigin,
ctLocDepth, bumpCtLocDepth,
setCtLocOrigin, setCtLocEnv,
......@@ -1473,6 +1474,78 @@ NB: either (a `canRewrite` b) or (b `canRewrite` a)
canRewriteOrSame is similar but returns True for Wanted/Wanted.
See the call sites for explanations.
%************************************************************************
%* *
SubGoalDepth
%* *
%************************************************************************
Note [SubGoalDepth]
~~~~~~~~~~~~~~~~~~~
The 'SubGoalCounter' takes care of stopping the constraint solver from looping.
Because of the different use-cases of regular constaints and type function
applications, there are two independent counters. Therefore, this datatype is
abstract. See Note [WorkList]
Each counter starts at zero and increases.
* The "dictionary constraint counter" counts the depth of type class
instance declarations. Example:
[W] d{7} : Eq [Int]
That is d's dictionary-constraint depth is 7. If we use the instance
$dfEqList :: Eq a => Eq [a]
to simplify it, we get
d{7} = $dfEqList d'{8}
where d'{8} : Eq Int, and d' has dictionary-constraint depth 8.
For civilised (decidable) instance declarations, each increase of
depth removes a type constructor from the type, so the depth never
gets big; i.e. is bounded by the structural depth of the type.
The flag -fcontext-stack=n (not very well named!) fixes the maximium
level.
* The "type function reduction counter" does the same thing when resolving
* qualities involving type functions. Example:
Assume we have a wanted at depth 7:
[W] d{7} : F () ~ a
If thre is an type function equation "F () = Int", this would be rewritten to
[W] d{8} : Int ~ a
and remembered as having depth 8.
\begin{code}
data SubGoalCounter = CountConstraints | CountTyFunApps
data SubGoalDepth -- See Note [SubGoalDepth]
= SubGoalDepth
{-# UNPACK #-} !Int -- Dictionary constraints
{-# UNPACK #-} !Int -- Type function reductions
deriving (Eq, Ord)
instance Outputable SubGoalDepth where
ppr (SubGoalDepth c f) = angleBrackets $
char 'C' <> colon <> int c <> comma <>
char 'F' <> colon <> int f
initialSubGoalDepth :: SubGoalDepth
initialSubGoalDepth = SubGoalDepth 0 0
bumpSubGoalDepth :: SubGoalCounter -> SubGoalDepth -> SubGoalDepth
bumpSubGoalDepth CountConstraints (SubGoalDepth c f) = SubGoalDepth (c+1) f
bumpSubGoalDepth CountTyFunApps (SubGoalDepth c f) = SubGoalDepth c (f+1)
subGoalCounterValue :: SubGoalCounter -> SubGoalDepth -> Int
subGoalCounterValue CountConstraints (SubGoalDepth c _) = c
subGoalCounterValue CountTyFunApps (SubGoalDepth _ f) = f
subGoalDepthExceeded :: Int -> SubGoalDepth -> Maybe SubGoalCounter
subGoalDepthExceeded max_depth (SubGoalDepth c f)
| c > max_depth = Just CountConstraints
| f > max_depth = Just CountTyFunApps
| otherwise = Nothing
\end{code}
%************************************************************************
%* *
......@@ -1487,31 +1560,13 @@ type will evolve...
\begin{code}
data CtLoc = CtLoc { ctl_origin :: CtOrigin
, ctl_env :: TcLclEnv
, ctl_depth :: SubGoalDepth }
, ctl_env :: TcLclEnv
, ctl_depth :: !SubGoalDepth }
-- The TcLclEnv includes particularly
-- source location: tcl_loc :: SrcSpan
-- context: tcl_ctxt :: [ErrCtxt]
-- binder stack: tcl_bndrs :: [TcIdBinders]
newtype SubGoalDepth = SubGoalDepth Int
-- An ever increasing number used to restrict
-- simplifier iterations. Bounded by -fcontext-stack.
-- See Note [WorkList]
instance Outputable SubGoalDepth where
ppr (SubGoalDepth n) = int n
initialSubGoalDepth :: SubGoalDepth
initialSubGoalDepth = SubGoalDepth 0
bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth
bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n+1)
subGoalDepthExceeded :: Int -> SubGoalDepth -> Bool
subGoalDepthExceeded max_depth (SubGoalDepth d) = d > max_depth
mkGivenLoc :: SkolemInfo -> TcLclEnv -> CtLoc
mkGivenLoc skol_info env = CtLoc { ctl_origin = GivenOrigin skol_info
, ctl_env = env
......@@ -1529,8 +1584,8 @@ ctLocOrigin = ctl_origin
ctLocSpan :: CtLoc -> SrcSpan
ctLocSpan (CtLoc { ctl_env = lcl}) = tcl_loc lcl
bumpCtLocDepth :: CtLoc -> CtLoc
bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }
bumpCtLocDepth :: SubGoalCounter -> CtLoc -> CtLoc
bumpCtLocDepth cnt loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth cnt d }
setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
setCtLocOrigin ctl orig = ctl { ctl_origin = orig }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment