diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-06-14 08:59:07 -0700 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-06-14 09:01:37 -0700 |
commit | 9d22fbe2d3d8c4609919040007ea8bb561bf9a38 (patch) | |
tree | 5b6033d1c025d71326aaa76043a0c06658a76662 /compiler | |
parent | 23b73c97312e4d812812ed25a6396fff44d1da28 (diff) | |
download | haskell-9d22fbe2d3d8c4609919040007ea8bb561bf9a38.tar.gz |
Rename cmpType to nonDetCmpType
This makes it obvious that it's nondeterministic and hopefully
will prevent someone from using it accidentally.
GHC Trac: #4012
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/specialise/Specialise.hs | 4 | ||||
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 8 | ||||
-rw-r--r-- | compiler/typecheck/TcType.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcValidity.hs | 4 | ||||
-rw-r--r-- | compiler/types/Type.hs | 62 |
5 files changed, 45 insertions, 35 deletions
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 84f8b62639..b69c9140b9 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -1746,8 +1746,8 @@ CallInfoSet used to be defined as: data CallInfoSet = CIS Id (Map CallKey ([DictExpr], VarSet)) Unfortunately this was not deterministic. The Ord instance of CallKey was -defined in terms of cmpType which is not deterministic. -See Note [cmpType nondeterminism]. +defined in terms of nonDetCmpType which is not deterministic. +See Note [nonDetCmpType nondeterminism]. The end result was that if the function had multiple specializations they would be generated in arbitrary order. diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index b53fa65dc9..030de0762f 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1928,8 +1928,8 @@ this by simplifying the RHS to a form in which Note [Deterministic simplifyInstanceContexts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Canonicalisation uses cmpType which is nondeterministic. Sorting -with cmpType puts the returned lists in a nondeterministic order. +Canonicalisation uses nonDetCmpType which is nondeterministic. Sorting +with nonDetCmpType puts the returned lists in a nondeterministic order. If we were to return them, we'd get class constraints in nondeterministic order. @@ -1948,7 +1948,7 @@ Or: To prevent the order from being nondeterministic we only canonicalize when comparing and return them in the same order as simplifyDeriv returned them. -See also Note [cmpType nondeterminism] +See also Note [nonDetCmpType nondeterminism] -} @@ -1999,7 +1999,7 @@ simplifyInstanceContexts infer_specs eqSolution a b = eqListBy (eqListBy eqType) (canSolution a) (canSolution b) -- Canonicalise for comparison -- See Note [Deterministic simplifyInstanceContexts] - canSolution = map (sortBy cmpType) + canSolution = map (sortBy nonDetCmpType) ------------------------------------------------------------------ gen_soln :: DerivSpec ThetaOrigin -> TcM ThetaType gen_soln (DS { ds_loc = loc, ds_tvs = tyvars diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index d6cd5b21ad..286ad6398e 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -70,7 +70,7 @@ module TcType ( --------------------------------- -- Predicates. -- Again, newtypes are opaque - eqType, eqTypes, cmpType, cmpTypes, eqTypeX, + eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX, pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis, isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index b4f2d883be..679bf04314 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -711,7 +711,9 @@ check_valid_theta env ctxt theta ; traceTc "check_valid_theta" (ppr theta) ; mapM_ (check_pred_ty env dflags ctxt) theta } where - (_,dups) = removeDups cmpType theta + (_,dups) = removeDups nonDetCmpType theta + -- It's OK to use nonDetCmpType because dups only appears in the + -- warning ------------------------- {- Note [Validity checking for constraints] diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 181f8e57eb..8ce60a50bb 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -128,7 +128,8 @@ module Type ( tyCoVarsOfTypesWellScoped, -- * Type comparison - eqType, eqTypeX, eqTypes, cmpType, cmpTypes, cmpTypeX, cmpTypesX, cmpTc, + eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX, + nonDetCmpTypesX, nonDetCmpTc, eqVarBndrs, -- * Forcing evaluation of types @@ -2055,16 +2056,22 @@ eqType :: Type -> Type -> Bool -- (The kind check is a recursive call, but since all kinds have type -- @Type@, there is no need to check the types of kinds.) -- See also Note [Non-trivial definitional equality] in TyCoRep. -eqType t1 t2 = isEqual $ cmpType t1 t2 +eqType t1 t2 = isEqual $ nonDetCmpType t1 t2 + -- It's OK to use nonDetCmpType here and eqType is deterministic, + -- nonDetCmpType does equality deterministically -- | Compare types with respect to a (presumably) non-empty 'RnEnv2'. eqTypeX :: RnEnv2 -> Type -> Type -> Bool -eqTypeX env t1 t2 = isEqual $ cmpTypeX env t1 t2 +eqTypeX env t1 t2 = isEqual $ nonDetCmpTypeX env t1 t2 + -- It's OK to use nonDetCmpType here and eqTypeX is deterministic, + -- nonDetCmpTypeX does equality deterministically -- | Type equality on lists of types, looking through type synonyms -- but not newtypes. eqTypes :: [Type] -> [Type] -> Bool -eqTypes tys1 tys2 = isEqual $ cmpTypes tys1 tys2 +eqTypes tys1 tys2 = isEqual $ nonDetCmpTypes tys1 tys2 + -- It's OK to use nonDetCmpType here and eqTypes is deterministic, + -- nonDetCmpTypes does equality deterministically eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2 -- Check that the var lists are the same length @@ -2080,24 +2087,25 @@ eqVarBndrs _ _ _= Nothing -- Now here comes the real worker {- -Note [cmpType nondeterminism] +Note [nonDetCmpType nondeterminism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -cmpType is implemented in terms of cmpTypeX. cmpTypeX uses cmpTc which -compares TyCons by their Unique value. Using Uniques for ordering leads -to nondeterminism. We hit the same problem in the TyVarTy case, comparing -type variables is nondeterministic, note the call to nonDetCmpVar in cmpTypeX. +nonDetCmpType is implemented in terms of nonDetCmpTypeX. nonDetCmpTypeX +uses nonDetCmpTc which compares TyCons by their Unique value. Using Uniques for +ordering leads to nondeterminism. We hit the same problem in the TyVarTy case, +comparing type variables is nondeterministic, note the call to nonDetCmpVar in +nonDetCmpTypeX. See Note [Unique Determinism] for more details. -} -cmpType :: Type -> Type -> Ordering -cmpType t1 t2 +nonDetCmpType :: Type -> Type -> Ordering +nonDetCmpType t1 t2 -- we know k1 and k2 have the same kind, because they both have kind *. - = cmpTypeX rn_env t1 t2 + = nonDetCmpTypeX rn_env t1 t2 where rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2])) -cmpTypes :: [Type] -> [Type] -> Ordering -cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2 +nonDetCmpTypes :: [Type] -> [Type] -> Ordering +nonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2 where rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2))) @@ -2111,9 +2119,9 @@ data TypeOrdering = TLT -- ^ @t1 < t2@ | TGT -- ^ @t1 > t2@ deriving (Eq, Ord, Enum, Bounded) -cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse +nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse -- See Note [Non-trivial definitional equality] in TyCoRep -cmpTypeX env orig_t1 orig_t2 = +nonDetCmpTypeX env orig_t1 orig_t2 = case go env orig_t1 orig_t2 of -- If there are casts then we also need to do a comparison of the kinds of -- the types being compared @@ -2165,7 +2173,7 @@ cmpTypeX env orig_t1 orig_t2 = go env (ForAllTy (Anon s1) t1) (ForAllTy (Anon s2) t2) = go env s1 s2 `thenCmpTy` go env t1 t2 go env (TyConApp tc1 tys1) (TyConApp tc2 tys2) - = liftOrdering (tc1 `cmpTc` tc2) `thenCmpTy` gos env tys1 tys2 + = liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2 go _ (LitTy l1) (LitTy l2) = liftOrdering (compare l1 l2) go env (CastTy t1 _) t2 = hasCast $ go env t1 t2 go env t1 (CastTy t2 _) = hasCast $ go env t1 t2 @@ -2176,7 +2184,7 @@ cmpTypeX env orig_t1 orig_t2 = = liftOrdering $ (get_rank ty1) `compare` (get_rank ty2) where get_rank :: Type -> Int get_rank (CastTy {}) - = pprPanic "cmpTypeX.get_rank" (ppr [ty1,ty2]) + = pprPanic "nonDetCmpTypeX.get_rank" (ppr [ty1,ty2]) get_rank (TyVarTy {}) = 0 get_rank (CoercionTy {}) = 1 get_rank (AppTy {}) = 3 @@ -2192,20 +2200,20 @@ cmpTypeX env orig_t1 orig_t2 = gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2 ------------- -cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering -cmpTypesX _ [] [] = EQ -cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 - `thenCmp` cmpTypesX env tys1 tys2 -cmpTypesX _ [] _ = LT -cmpTypesX _ _ [] = GT +nonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering +nonDetCmpTypesX _ [] [] = EQ +nonDetCmpTypesX env (t1:tys1) (t2:tys2) = nonDetCmpTypeX env t1 t2 + `thenCmp` nonDetCmpTypesX env tys1 tys2 +nonDetCmpTypesX _ [] _ = LT +nonDetCmpTypesX _ _ [] = GT ------------- -- | Compare two 'TyCon's. NB: This should /never/ see the "star synonyms", -- as recognized by Kind.isStarKindSynonymTyCon. See Note -- [Kind Constraint and kind *] in Kind. --- See Note [cmpType nondeterminism] -cmpTc :: TyCon -> TyCon -> Ordering -cmpTc tc1 tc2 +-- See Note [nonDetCmpType nondeterminism] +nonDetCmpTc :: TyCon -> TyCon -> Ordering +nonDetCmpTc tc1 tc2 = ASSERT( not (isStarKindSynonymTyCon tc1) && not (isStarKindSynonymTyCon tc2) ) u1 `nonDetCmpUnique` u2 where |