Kill off sizePred
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 26 Jun 2015 13:34:42 +0000 (14:34 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 26 Jun 2015 16:53:27 +0000 (17:53 +0100)
It really isn't needed, and life is simpler without

compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcType.hs

index 9bd2f70..e91304a 100644 (file)
@@ -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)
index 9a0093d..2c9a980 100644 (file)
@@ -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
index 6c3c73e..c2d5da0 100644 (file)
@@ -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
index c3e12c3..37bf470 100644 (file)
@@ -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)