| ... |
... |
@@ -295,39 +295,24 @@ as the fundeps. |
|
295
|
295
|
#7875 is a case in point.
|
|
296
|
296
|
-}
|
|
297
|
297
|
|
|
298
|
|
-doDictFunDepImprovement :: Cts -> TcS ImprovementResult
|
|
|
298
|
+doDictFunDepImprovement :: DictCt -> SolverStage Void
|
|
299
|
299
|
-- (doDictFunDepImprovement inst_envs cts)
|
|
300
|
300
|
-- * Generate the fundeps from interacting the
|
|
301
|
301
|
-- top-level `inst_envs` with the constraints `cts`
|
|
302
|
302
|
-- * Do the unifications and return any unsolved constraints
|
|
303
|
303
|
-- See Note [Fundeps with instances, and equality orientation]
|
|
304
|
|
--- foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
|
|
305
|
|
-doDictFunDepImprovement unsolved_wanteds
|
|
306
|
|
- = do { inerts <- getInertCans -- The inert_dicts are all Givens
|
|
307
|
|
- ; inst_envs <- getInstEnvs
|
|
308
|
|
- ; (_, imp_res) <- foldM (do_one_dict inst_envs)
|
|
309
|
|
- (inert_dicts inerts, noopImprovement)
|
|
310
|
|
- unsolved_wanteds
|
|
311
|
|
- ; return imp_res }
|
|
312
|
|
-
|
|
313
|
|
-do_one_dict :: InstEnvs
|
|
314
|
|
- -> (DictMap DictCt, ImprovementResult)
|
|
315
|
|
- -> Ct
|
|
316
|
|
- -> TcS (DictMap DictCt, ImprovementResult)
|
|
317
|
|
--- The `local_dicts` accumulator starts life as just the Givens, but
|
|
318
|
|
--- as we encounter each Wanted we augment it. Result: each Wanted
|
|
319
|
|
--- is interacted with all the Givens, and all prededing Wanteds.
|
|
320
|
|
--- This is worst-case quadratic because we have to compare each
|
|
321
|
|
--- constraint with all the others, to find all the pairwise interactions
|
|
322
|
|
-do_one_dict inst_envs (local_dicts, imp_res) (CDictCan dict_ct)
|
|
323
|
|
- = do { (local_dicts1, imp_res1) <- do_one_local local_dicts dict_ct
|
|
|
304
|
+
|
|
|
305
|
+-- doLocalFunDepImprovement does StartAgain if there
|
|
|
306
|
+-- are any fundeps: see (DFL1) in Note [Do fundeps last]
|
|
|
307
|
+
|
|
|
308
|
+doDictFunDepImprovement dict_ct
|
|
|
309
|
+ = do { inst_envs <- getInstEnvs
|
|
|
310
|
+ ; imp_res1 <- do_dict_local_fds dict_ct
|
|
324
|
311
|
; if noImprovement imp_res1
|
|
325
|
312
|
then do { imp_res2 <- do_one_top inst_envs dict_ct
|
|
326
|
|
- ; return (local_dicts1, imp_res `plusImprovements` imp_res2) }
|
|
327
|
|
- else return (local_dicts1, imp_res `plusImprovements` imp_res1) }
|
|
|
313
|
+ ; return (imp_res `plusImprovements` imp_res2) }
|
|
|
314
|
+ else return (imp_res `plusImprovements` imp_res1) }
|
|
328
|
315
|
|
|
329
|
|
-do_one_dict _ acc _ -- Non-DictCt constraints
|
|
330
|
|
- = return acc
|
|
331
|
316
|
|
|
332
|
317
|
do_one_top :: InstEnvs -> DictCt -> TcS ImprovementResult
|
|
333
|
318
|
do_one_top inst_envs (DictCt { di_ev = ev, di_cls = cls, di_tys = xis })
|
| ... |
... |
@@ -351,14 +336,14 @@ do_one_top inst_envs (DictCt { di_ev = ev, di_cls = cls, di_tys = xis }) |
|
351
|
336
|
new_orig = FunDepOrigin2 dict_pred dict_origin
|
|
352
|
337
|
inst_pred inst_loc
|
|
353
|
338
|
|
|
354
|
|
-do_one_local :: DictMap DictCt -> DictCt -> TcS (DictMap DictCt, ImprovementResult)
|
|
355
|
|
--- Using functional dependencies, interact the unsolved Wanteds
|
|
356
|
|
--- against each other and the inert Givens, to produce new equalities
|
|
357
|
|
-do_one_local locals dict_ct@(DictCt { di_cls = cls, di_ev = wanted_ev })
|
|
|
339
|
+do_dict_local_fds :: DictCt -> TcS ImprovementResult
|
|
|
340
|
+-- Using functional dependencies, interact the DictCt with the
|
|
|
341
|
+-- inert Givens and Wanteds, to produce new equalities
|
|
|
342
|
+do_dict_local_fds dict_ct@(DictCt { di_cls = cls, di_ev = wanted_ev })
|
|
358
|
343
|
-- locals contains all the Givens and earlier Wanteds
|
|
359
|
|
- = do { imp_res <- foldM do_interaction noopImprovement $
|
|
360
|
|
- findDictsByClass locals cls
|
|
361
|
|
- ; return (addDict dict_ct locals, imp_res) }
|
|
|
344
|
+ = do { inerts <- getInertCans
|
|
|
345
|
+ ; foldM do_interaction noopImprovement $
|
|
|
346
|
+ findDictsByClass locals cls }
|
|
362
|
347
|
where
|
|
363
|
348
|
wanted_pred = ctEvPred wanted_ev
|
|
364
|
349
|
wanted_loc = ctEvLoc wanted_ev
|