diff options
Diffstat (limited to 'compiler/deSugar/Match.hs')
| -rw-r--r-- | compiler/deSugar/Match.hs | 20 |
1 files changed, 7 insertions, 13 deletions
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 3910250bc7..6ffa25dbc9 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -35,6 +35,7 @@ import PatSyn import MatchCon import MatchLit import Type +import Coercion ( eqCoercion ) import TcType ( toTcTypeBag ) import TyCon( isNewTyCon ) import TysWiredIn @@ -246,7 +247,8 @@ matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult -- Apply the coercion to the match variable and then match that matchCoercion (var:vars) ty (eqns@(eqn1:_)) = do { let CoPat co pat _ = firstPat eqn1 - ; var' <- newUniqueId var (hsPatType pat) + ; let pat_ty' = hsPatType pat + ; var' <- newUniqueId var pat_ty' ; match_result <- match (var':vars) ty $ map (decomposeFirstPat getCoPat) eqns ; rhs' <- dsHsWrapper co (Var var) @@ -261,7 +263,8 @@ matchView (var:vars) ty (eqns@(eqn1:_)) -- to figure out the type of the fresh variable let ViewPat viewExpr (L _ pat) _ = firstPat eqn1 -- do the rest of the compilation - ; var' <- newUniqueId var (hsPatType pat) + ; let pat_ty' = hsPatType pat + ; var' <- newUniqueId var pat_ty' ; match_result <- match (var':vars) ty $ map (decomposeFirstPat getViewPat) eqns -- compile the view expressions @@ -930,7 +933,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 wrap WpHole WpHole = True wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2' wrap (WpFun w1 w2 _ _) (WpFun w1' w2' _ _) = wrap w1 w1' && wrap w2 w2' - wrap (WpCast co) (WpCast co') = co `eq_co` co' + wrap (WpCast co) (WpCast co') = co `eqCoercion` co' wrap (WpEvApp et1) (WpEvApp et2) = et1 `ev_term` et2 wrap (WpTyApp t) (WpTyApp t') = eqType t t' -- Enhancement: could implement equality for more wrappers @@ -940,7 +943,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 --------- ev_term :: EvTerm -> EvTerm -> Bool ev_term (EvId a) (EvId b) = a==b - ev_term (EvCoercion a) (EvCoercion b) = a `eq_co` b + ev_term (EvCoercion a) (EvCoercion b) = a `eqCoercion` b ev_term _ _ = False --------- @@ -950,15 +953,6 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 eq_list _ (_:_) [] = False eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys - --------- - eq_co :: TcCoercion -> TcCoercion -> Bool - -- Just some simple cases (should the r1 == r2 rather be an ASSERT?) - eq_co (TcRefl r1 t1) (TcRefl r2 t2) = r1 == r2 && eqType t1 t2 - eq_co (TcCoVarCo v1) (TcCoVarCo v2) = v1==v2 - eq_co (TcSymCo co1) (TcSymCo co2) = co1 `eq_co` co2 - eq_co (TcTyConAppCo r1 tc1 cos1) (TcTyConAppCo r2 tc2 cos2) = r1 == r2 && tc1==tc2 && eq_list eq_co cos1 cos2 - eq_co _ _ = False - patGroup :: DynFlags -> Pat Id -> PatGroup patGroup _ (WildPat {}) = PgAny patGroup _ (BangPat {}) = PgBang |