| ... |
... |
@@ -807,7 +807,8 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls |
|
807
|
807
|
|
|
808
|
808
|
| otherwise -- Wanted, but not cached
|
|
809
|
809
|
= do { dflags <- getDynFlags
|
|
810
|
|
- ; lkup_res <- matchClassInst dflags inerts cls xis dict_loc
|
|
|
810
|
+ ; mode <- getTcSMode
|
|
|
811
|
+ ; lkup_res <- matchClassInst dflags mode inerts cls xis dict_loc
|
|
811
|
812
|
; case lkup_res of
|
|
812
|
813
|
OneInst { cir_what = what }
|
|
813
|
814
|
-> do { let is_local_given = case what of { LocalInstance -> True; _ -> False }
|
| ... |
... |
@@ -865,10 +866,10 @@ checkInstanceOK loc what pred |
|
865
|
866
|
| otherwise
|
|
866
|
867
|
= loc
|
|
867
|
868
|
|
|
868
|
|
-matchClassInst :: DynFlags -> InertSet
|
|
|
869
|
+matchClassInst :: DynFlags -> TcSMode -> InertSet
|
|
869
|
870
|
-> Class -> [Type]
|
|
870
|
871
|
-> CtLoc -> TcS ClsInstResult
|
|
871
|
|
-matchClassInst dflags inerts clas tys loc
|
|
|
872
|
+matchClassInst dflags mode inerts clas tys loc
|
|
872
|
873
|
-- First check whether there is an in-scope Given that could
|
|
873
|
874
|
-- match this constraint. In that case, do not use any instance
|
|
874
|
875
|
-- whether top level, or local quantified constraints.
|
| ... |
... |
@@ -879,7 +880,7 @@ matchClassInst dflags inerts clas tys loc |
|
879
|
880
|
-- It is always safe to unpack constraint tuples
|
|
880
|
881
|
-- And if we don't do so, we may never solve it at all
|
|
881
|
882
|
-- See Note [Solving tuple constraints]
|
|
882
|
|
- , not (noMatchableGivenDicts inerts loc clas tys)
|
|
|
883
|
+ , not (noMatchableGivenDicts mode inerts loc clas tys)
|
|
883
|
884
|
= do { traceTcS "Delaying instance application" $
|
|
884
|
885
|
vcat [ text "Work item:" <+> pprClassPred clas tys ]
|
|
885
|
886
|
; return NotSure }
|
| ... |
... |
@@ -910,8 +911,11 @@ matchClassInst dflags inerts clas tys loc |
|
910
|
911
|
-- potentially, match the given class constraint. This is used when checking to see if a
|
|
911
|
912
|
-- Given might overlap with an instance. See Note [Instance and Given overlap]
|
|
912
|
913
|
-- in GHC.Tc.Solver.Dict
|
|
913
|
|
-noMatchableGivenDicts :: InertSet -> CtLoc -> Class -> [TcType] -> Bool
|
|
914
|
|
-noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys
|
|
|
914
|
+noMatchableGivenDicts :: TcSMode -> InertSet -> CtLoc -> Class -> [TcType] -> Bool
|
|
|
915
|
+noMatchableGivenDicts mode inerts@(IS { inert_cans = inert_cans }) loc_w clas tys
|
|
|
916
|
+ | TcSShortCut <- mode
|
|
|
917
|
+ = True -- In TcSShortCut mode we behave as if there were no Givens at all
|
|
|
918
|
+ | otherwise
|
|
915
|
919
|
= not $ anyBag matchable_given $
|
|
916
|
920
|
findDictsByClass (inert_dicts inert_cans) clas
|
|
917
|
921
|
where
|