Commit 614ba3c5 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Kill off sizePred

It really isn't needed, and life is simpler without
parent 7c07cf16
......@@ -318,8 +318,14 @@ newSCWorkFromFlavored :: CtEvidence -> Class -> [Xi] -> TcS ()
-- Returns superclasses, see Note [Adding superclasses]
newSCWorkFromFlavored flavor cls xis
| CtGiven { ctev_evar = evar, ctev_loc = loc } <- flavor
= do { let size = sizePred (mkClassPred cls xis)
loc' = case ctLocOrigin loc of
= do { let size = sizeTypes xis
loc' | isCTupleClass cls
= loc -- For tuple predicates, just take them apart, without
-- adding their (large) size into the chain. When we
-- get down to a base predicate, we'll include its size.
-- Trac #10335
| otherwise
= case ctLocOrigin loc of
GivenOrigin InstSkol
-> loc { ctl_origin = GivenOrigin (InstSC size) }
GivenOrigin (InstSC n)
......
......@@ -999,7 +999,7 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds _fam_envs sc_t
; return (ids, listToBag binds, listToBag implics) }
where
loc = getSrcSpan dfun_id
size = sizePred (mkClassPred cls inst_tys)
size = sizeTypes inst_tys
tc_super (sc_pred, n)
= do { (sc_implic, sc_ev_id) <- checkInstConstraints $ \_ ->
emitWanted (ScOrigin size) sc_pred
......@@ -1096,7 +1096,7 @@ generate a guaranteed-non-bottom superclass witness from:
(sc3) a call of a dfun (always returns a dictionary constructor)
The tricky case is (sc2). We proceed by induction on the size of
the (type of) the dictionary, defined by TcValidity.sizePred.
the (type of) the dictionary, defined by TcValidity.sizeTypes.
Let's suppose we are building a dictionary of size 3, and
suppose the Superclass Invariant holds of smaller dictionaries.
Then if we have a smaller dictionary, its immediate superclasses
......
......@@ -2067,9 +2067,10 @@ data SkolemInfo
| ClsSkol Class -- Bound at a class decl
| InstSkol -- Bound at an instance decl
| InstSC TypeSize -- A "given" constraint obtained by superclass selection
-- from an InstSkol, giving the largest class from
-- which we made a superclass selection in the chain
| InstSC TypeSize -- A "given" constraint obtained by superclass selection.
-- If (C ty1 .. tyn) is the largest class from
-- which we made a superclass selection in the chain,
-- then TypeSize = sizeTypes [ty1, .., tyn]
-- See Note [Solving superclass constraints] in TcInstDcls
| DataSkol -- Bound at a data type declaration
......@@ -2193,7 +2194,8 @@ data CtOrigin
| ViewPatOrigin
| ScOrigin TypeSize -- Typechecking superclasses of an instance declaration
-- whose head has the given size
-- If the instance head is C ty1 .. tyn
-- then TypeSize = sizeTypes [ty1, .., tyn]
-- See Note [Solving superclass constraints] in TcInstDcls
| DerivOrigin -- Typechecking deriving
......
......@@ -149,7 +149,7 @@ module TcType (
pprType, pprParendType, pprTypeApp, pprTyThingCategory,
pprTheta, pprThetaArrowTy, pprClassPred,
TypeSize, sizePred, sizeType, sizeTypes
TypeSize, sizeType, sizeTypes
) where
......@@ -1872,40 +1872,23 @@ is irreducible. See Trac #5581.
type TypeSize = IntWithInf
sizeType :: Type -> TypeSize
sizeType, size_type :: Type -> TypeSize
-- Size of a type: the number of variables and constructors
sizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty
sizeType (TyVarTy {}) = 1
sizeType (TyConApp tc tys)
-- Ignore kinds altogether
sizeType ty | isKind ty = 0
| otherwise = size_type ty
size_type ty | Just exp_ty <- tcView ty = size_type exp_ty
size_type (TyVarTy {}) = 1
size_type (TyConApp tc tys)
| isTypeFamilyTyCon tc = infinity -- Type-family applications can
-- expand to any arbitrary size
| otherwise = sizeTypes tys + 1
sizeType (LitTy {}) = 1
sizeType (FunTy arg res) = sizeType arg + sizeType res + 1
sizeType (AppTy fun arg) = sizeType fun + sizeType arg
sizeType (ForAllTy _ ty) = sizeType ty
size_type (LitTy {}) = 1
size_type (FunTy arg res) = size_type arg + size_type res + 1
size_type (AppTy fun arg) = size_type fun + size_type arg
size_type (ForAllTy _ ty) = size_type ty
sizeTypes :: [Type] -> TypeSize
-- IA0_NOTE: Avoid kinds.
sizeTypes xs = sum (map sizeType tys)
where tys = filter (not . isKind) xs
-- Note [Size of a predicate]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
-- We are considering whether class constraints terminate.
-- Equality constraints and constraints for the implicit
-- parameter class always termiante so it is safe to say "size 0".
-- (Implicit parameter constraints always terminate because
-- there are no instances for them---they are only solved by
-- "local instances" in expressions).
-- See Trac #4200.
sizePred :: PredType -> TypeSize
sizePred p
= case classifyPredType p of
ClassPred cls tys
| isIPClass cls -> 0 -- See Note [Size of a predicate]
| isCTupleClass cls -> maximum (0 : map sizePred tys)
| otherwise -> sizeTypes tys
EqPred {} -> 0 -- See Note [Size of a predicate]
IrredPred ty -> sizeType ty
sizeTypes tys = sum (map sizeType tys)
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