diff options
Diffstat (limited to 'compiler/GHC/Core/Predicate.hs')
| -rw-r--r-- | compiler/GHC/Core/Predicate.hs | 89 |
1 files changed, 47 insertions, 42 deletions
diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs index 86acfbee23..1946d4cee9 100644 --- a/compiler/GHC/Core/Predicate.hs +++ b/compiler/GHC/Core/Predicate.hs @@ -25,7 +25,7 @@ module GHC.Core.Predicate ( classMethodTy, classMethodInstTy, -- Implicit parameters - isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, + isIPLikePred, mentionsIP, isIPTyCon, isIPClass, isCallStackTy, isCallStackPred, isCallStackPredTy, isIPPred_maybe, @@ -260,39 +260,16 @@ isIPTyCon tc = tc `hasKey` ipClassKey isIPClass :: Class -> Bool isIPClass cls = cls `hasKey` ipClassKey -isIPLikePred :: Type -> Bool --- See Note [Local implicit parameters] -isIPLikePred = is_ip_like_pred initIPRecTc - - -is_ip_like_pred :: RecTcChecker -> Type -> Bool -is_ip_like_pred rec_clss ty - | Just (tc, tys) <- splitTyConApp_maybe ty - , Just rec_clss' <- if isTupleTyCon tc -- Tuples never cause recursion - then Just rec_clss - else checkRecTc rec_clss tc - , Just cls <- tyConClass_maybe tc - = isIPClass cls || has_ip_super_classes rec_clss' cls tys - +-- | Decomposes a predicate if it is an implicit parameter. Does not look in +-- superclasses. See also [Local implicit parameters]. +isIPPred_maybe :: Class -> [Type] -> Maybe (FastString, Type) +isIPPred_maybe cls tys + | isIPClass cls + , [t1,t2] <- tys + , Just x <- isStrLitTy t1 + = Just (x,t2) | otherwise - = False -- Includes things like (D []) where D is - -- a Constraint-ranged family; #7785 - -hasIPSuperClasses :: Class -> [Type] -> Bool --- See Note [Local implicit parameters] -hasIPSuperClasses = has_ip_super_classes initIPRecTc - -has_ip_super_classes :: RecTcChecker -> Class -> [Type] -> Bool -has_ip_super_classes rec_clss cls tys - = any ip_ish (classSCSelIds cls) - where - -- Check that the type of a superclass determines its value - -- sc_sel_id :: forall a b. C a b -> <superclass type> - ip_ish sc_sel_id = is_ip_like_pred rec_clss $ - classMethodInstTy sc_sel_id tys - -initIPRecTc :: RecTcChecker -initIPRecTc = setRecTcMaxBound 1 initRecTc + = Nothing -- --------------------- CallStack predicates --------------------------------- @@ -326,20 +303,48 @@ isCallStackTy ty | otherwise = False +-- --------------------- isIPLike and mentionsIP -------------------------- +-- See Note [Local implicit parameters] --- | Decomposes a predicate if it is an implicit parameter. Does not look in --- superclasses. See also [Local implicit parameters]. -isIPPred_maybe :: Class -> [Type] -> Maybe (FastString, Type) -isIPPred_maybe cls tys - | cls `hasKey` ipClassKey - , [t1,t2] <- tys - , Just x <- isStrLitTy t1 - = Just (x,t2) +isIPLikePred :: Type -> Bool +-- Is `pred`, or any of its superclasses, an implicit parameter? +-- See Note [Local implicit parameters] +isIPLikePred pred = mentions_ip_pred initIPRecTc Nothing pred + +mentionsIP :: FastString -> Class -> [Type] -> Bool +-- Is (cls tys) an implicit parameter with string `fs`, or +-- is any of its superclasses such at thing. +-- See Note [Local implicit parameters] +mentionsIP fs cls tys = mentions_ip initIPRecTc (Just fs) cls tys + +mentions_ip :: RecTcChecker -> Maybe FastString -> Class -> [Type] -> Bool +mentions_ip rec_clss mb_fs cls tys + | Just (fs', _) <- isIPPred_maybe cls tys + = case mb_fs of + Nothing -> True + Just fs -> fs == fs' | otherwise - = Nothing + = or [ mentions_ip_pred rec_clss mb_fs (classMethodInstTy sc_sel_id tys) + | sc_sel_id <- classSCSelIds cls ] + +mentions_ip_pred :: RecTcChecker -> Maybe FastString -> Type -> Bool +mentions_ip_pred rec_clss mb_fs ty + | Just (cls, tys) <- getClassPredTys_maybe ty + , let tc = classTyCon cls + , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss + else checkRecTc rec_clss tc + = mentions_ip rec_clss' mb_fs cls tys + | otherwise + = False -- Includes things like (D []) where D is + -- a Constraint-ranged family; #7785 + +initIPRecTc :: RecTcChecker +initIPRecTc = setRecTcMaxBound 1 initRecTc {- Note [Local implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See also Note [Shadowing of Implicit Parameters] in GHC.Tc.Solver.Dict. + The function isIPLikePred tells if this predicate, or any of its superclasses, is an implicit parameter. |