| Just ty2' <- coreView ty2 = match menv subst ty1 ty2'
match menv subst (TyVarTy tv1) ty2
+ | Just ty1' <- lookupVarEnv subst tv1' -- tv1' is already bound
+ = if tcEqTypeX (nukeRnEnvL rn_env) ty1' ty2
+ -- ty1 has no locally-bound variables, hence nukeRnEnvL
+ -- Note tcEqType...we are doing source-type matching here
+ then Just subst
+ else Nothing -- ty2 doesn't match
+
| tv1' `elemVarSet` me_tmpls menv
- = case lookupVarEnv subst tv1' of
- Nothing -- No existing binding
- | any (inRnEnvR rn_env) (varSetElems (tyVarsOfType ty2))
- -> Nothing -- Occurs check
- | otherwise
- -> do { subst1 <- match_kind menv subst tv1 ty2
- ; return (extendVarEnv subst1 tv1' ty2) }
+ = if any (inRnEnvR rn_env) (varSetElems (tyVarsOfType ty2))
+ then Nothing -- Occurs check
+ else do { subst1 <- match_kind menv subst tv1 ty2
-- Note [Matching kinds]
-
- 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
- | otherwise -> Nothing -- ty2 doesn't match
-
+ ; return (extendVarEnv subst1 tv1' ty2) }
| otherwise -- tv1 is not a template tyvar
= case ty2 of
instance Outputable Refinement where
ppr (Reft _in_scope env)
- = ptext SLIT("Refinement") <+>
+ = ptext (sLit "Refinement") <+>
braces (ppr env)
emptyRefinement :: Refinement
\begin{code}
misMatch :: Type -> Type -> SDoc
misMatch t1 t2
- = ptext SLIT("Can't match types") <+> quotes (ppr t1) <+>
- ptext SLIT("and") <+> quotes (ppr t2)
+ = ptext (sLit "Can't match types") <+> quotes (ppr t1) <+>
+ ptext (sLit "and") <+> quotes (ppr t2)
lengthMisMatch :: [Type] -> [Type] -> SDoc
lengthMisMatch tys1 tys2
- = sep [ptext SLIT("Can't match unequal length lists"),
+ = sep [ptext (sLit "Can't match unequal length lists"),
nest 2 (ppr tys1), nest 2 (ppr tys2) ]
kindMisMatch :: TyVar -> Type -> SDoc
kindMisMatch tv1 t2
- = vcat [ptext SLIT("Can't match kinds") <+> quotes (ppr (tyVarKind tv1)) <+>
- ptext SLIT("and") <+> quotes (ppr (typeKind t2)),
- ptext SLIT("when matching") <+> quotes (ppr tv1) <+>
- ptext SLIT("with") <+> quotes (ppr t2)]
+ = vcat [ptext (sLit "Can't match kinds") <+> quotes (ppr (tyVarKind tv1)) <+>
+ ptext (sLit "and") <+> quotes (ppr (typeKind t2)),
+ ptext (sLit "when matching") <+> quotes (ppr tv1) <+>
+ ptext (sLit "with") <+> quotes (ppr t2)]
occursCheck :: TyVar -> Type -> SDoc
occursCheck tv ty
- = hang (ptext SLIT("Can't construct the infinite type"))
+ = hang (ptext (sLit "Can't construct the infinite type"))
2 (ppr tv <+> equals <+> ppr ty)
\end{code}