projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2005-11-16 12:55:58 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
types
/
Unify.lhs
diff --git
a/ghc/compiler/types/Unify.lhs
b/ghc/compiler/types/Unify.lhs
index
e6a0878
..
d5d6d1d
100644
(file)
--- a/
ghc/compiler/types/Unify.lhs
+++ b/
ghc/compiler/types/Unify.lhs
@@
-20,7
+20,8
@@
import VarEnv
import VarSet
import Kind ( isSubKind )
import Type ( typeKind, tyVarsOfType, tyVarsOfTypes, tyVarsOfTheta, mkTyVarTys,
import VarSet
import Kind ( isSubKind )
import Type ( typeKind, tyVarsOfType, tyVarsOfTypes, tyVarsOfTheta, mkTyVarTys,
- TvSubstEnv, emptyTvSubstEnv, TvSubst(..), substTy, tcEqTypeX )
+ TvSubstEnv, emptyTvSubstEnv, TvSubst(..), substTy, tcEqTypeX,
+ tcView )
import TypeRep ( Type(..), PredType(..), funTyCon )
import DataCon ( DataCon, dataConInstResTy )
import Util ( snocView )
import TypeRep ( Type(..), PredType(..), funTyCon )
import DataCon ( DataCon, dataConInstResTy )
import Util ( snocView )
@@
-127,8
+128,8
@@
match :: MatchEnv -- For the most part this is pushed downwards
-- This matcher works on source types; that is,
-- it respects NewTypes and PredType
-- This matcher works on source types; that is,
-- it respects NewTypes and PredType
-match menv subst (NoteTy _ ty1) ty2 = match menv subst ty1 ty2
-match menv subst ty1 (NoteTy _ ty2) = match menv subst ty1 ty2
+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'
match menv subst (TyVarTy tv1) ty2
| tv1 `elemVarSet` me_tmpls menv
match menv subst (TyVarTy tv1) ty2
| tv1 `elemVarSet` me_tmpls menv
@@
-294,8
+295,8
@@
unify subst ty1 ty2 = -- pprTrace "unify" (ppr subst <+> pprParendType ty1 <+> p
unify_ subst (TyVarTy tv1) ty2 = uVar False subst tv1 ty2
unify_ subst ty1 (TyVarTy tv2) = uVar True subst tv2 ty1
unify_ subst (TyVarTy tv1) ty2 = uVar False subst tv1 ty2
unify_ subst ty1 (TyVarTy tv2) = uVar True subst tv2 ty1
-unify_ subst (NoteTy _ ty1) ty2 = unify subst ty1 ty2
-unify_ subst ty1 (NoteTy _ ty2) = unify subst ty1 ty2
+unify_ subst ty1 ty2 | Just ty1' <- tcView ty1 = unify subst ty1' ty2
+unify_ subst ty1 ty2 | Just ty2' <- tcView ty2 = unify subst ty1 ty2'
unify_ subst (PredTy p1) (PredTy p2) = unify_pred subst p1 p2
unify_ subst (PredTy p1) (PredTy p2) = unify_pred subst p1 p2
@@
-368,8
+369,9
@@
uUnrefined :: TvSubstEnv -- An existing substitution to extend
-- We know that tv1 isn't refined
-- We know that tv1 isn't refined
-uUnrefined subst tv1 ty2 (NoteTy _ ty2')
- = uUnrefined subst tv1 ty2 ty2' -- Unwrap synonyms
+uUnrefined subst tv1 ty2 ty2'
+ | Just ty2'' <- tcView ty2'
+ = uUnrefined subst tv1 ty2 ty2'' -- Unwrap synonyms
-- This is essential, in case we have
-- type Foo a = a
-- and then unify a :=: Foo a
-- This is essential, in case we have
-- type Foo a = a
-- and then unify a :=: Foo a