[commit: ghc] master: Kill off sizePred (614ba3c)
git at git.haskell.org
git at git.haskell.org
Fri Jun 26 16:53:22 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/614ba3c57be611a053c8c95698020de68df29558/ghc
>---------------------------------------------------------------
commit 614ba3c57be611a053c8c95698020de68df29558
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jun 26 14:34:42 2015 +0100
Kill off sizePred
It really isn't needed, and life is simpler without
>---------------------------------------------------------------
614ba3c57be611a053c8c95698020de68df29558
compiler/typecheck/TcCanonical.hs | 10 +++++++--
compiler/typecheck/TcInstDcls.hs | 4 ++--
compiler/typecheck/TcRnTypes.hs | 10 +++++----
compiler/typecheck/TcType.hs | 45 ++++++++++++---------------------------
4 files changed, 30 insertions(+), 39 deletions(-)
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index 9bd2f70..e91304a 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -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)
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index 9a0093d..2c9a980 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -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
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 6c3c73e..c2d5da0 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -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
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index c3e12c3..37bf470 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -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)
More information about the ghc-commits
mailing list