From d5e78cc70dc29cb59687156486e2acaaa444c029 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 1 Nov 2006 17:04:48 +0000 Subject: [PATCH] Comments and layout only --- compiler/types/Unify.lhs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index 9d94a63..5a1dbbc 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -120,24 +120,26 @@ match :: MatchEnv -- For the most part this is pushed downwards -- it respects NewTypes and PredType match menv subst ty1 ty2 | Just ty1' <- tcView ty1 = match menv subst ty1' ty2 -match menv subst ty1 ty2 | Just ty2' <- tcView ty2 = match menv subst ty1 ty2' + | Just ty2' <- tcView ty2 = match menv subst ty1 ty2' match menv subst (TyVarTy tv1) ty2 | tv1 `elemVarSet` me_tmpls menv = case lookupVarEnv subst tv1' of - Nothing | any (inRnEnvR rn_env) (varSetElems (tyVarsOfType ty2)) - -> Nothing -- Occurs check - | not (typeKind ty2 `isSubKind` tyVarKind tv1) - -> Nothing -- Kind mis-match - | otherwise - -> Just (extendVarEnv subst tv1 ty2) - - Just ty1' | tcEqTypeX (nukeRnEnvL rn_env) ty1' ty2 + Nothing -- No existing binding + | any (inRnEnvR rn_env) (varSetElems (tyVarsOfType ty2)) + -> Nothing -- Occurs check + | not (typeKind ty2 `isSubKind` tyVarKind tv1) + -> Nothing -- Kind mis-match + | otherwise + -> Just (extendVarEnv subst tv1 ty2) + + Just ty1' -- There is an existing binding; check whether ty2 matches it + | tcEqTypeX (nukeRnEnvL rn_env) ty1' ty2 -- ty1 has no locally-bound variables, hence nukeRnEnvL -- Note tcEqType...we are doing source-type matching here - -> Just subst - - other -> Nothing + -> Just subst + | otherwise -> Nothing -- ty2 doesn't match + | otherwise -- tv1 is not a template tyvar = case ty2 of @@ -161,6 +163,7 @@ match menv subst (FunTy ty1a ty1b) (FunTy ty2a ty2b) ; match menv subst' ty1b ty2b } match menv subst (AppTy ty1a ty1b) ty2 | Just (ty2a, ty2b) <- repSplitAppTy_maybe ty2 + -- 'repSplit' used because the tcView stuff is done above = do { subst' <- match menv subst ty1a ty2a ; match menv subst' ty1b ty2b } -- 1.7.10.4