X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fext-core%2FCore.hs;h=a581d3c315a68a9122abd5f4644154d6b86c7d78;hp=9df300e010a3519522f4d2e9e2fe523149a59275;hb=8bfeb25ae78e99c7014113468b0057342db4208f;hpb=044805225a08d5e370b72d2efed66880912b0806 diff --git a/utils/ext-core/Core.hs b/utils/ext-core/Core.hs index 9df300e..a581d3c 100644 --- a/utils/ext-core/Core.hs +++ b/utils/ext-core/Core.hs @@ -15,7 +15,7 @@ data Tdef -- If we have: (Newtype tc co tbs (Just t)) -- there is an implicit axiom: -- co tbs :: tc tbs :=: t - | Newtype (Qual Tcon) (Qual Tcon) [Tbind] (Maybe Ty) + | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty deriving (Data, Typeable) data Cdef @@ -103,7 +103,7 @@ data CoercionKind = data KindOrCoercion = Kind Kind | Coercion CoercionKind data Lit = Literal CoreLit Ty - deriving (Data, Typeable, Eq) -- with nearlyEqualTy + deriving (Data, Typeable, Eq) data CoreLit = Lint Integer | Lrational Rational @@ -163,10 +163,11 @@ splitTyConApp_maybe (Tapp rator rand) = Tcon tc -> Just (tc,[rand]) _ -> Nothing splitTyConApp_maybe t@(Tforall _ _) = Nothing - -{- Doesn't expand out fully applied newtype synonyms - (for which an environment is needed). -} -nearlyEqualTy t1 t2 = eqTy [] [] t1 t2 + +-- This used to be called nearlyEqualTy, but now that +-- we don't need to expand newtypes anymore, it seems +-- like equality to me! +equalTy t1 t2 = eqTy [] [] t1 t2 where eqTy e1 e2 (Tvar v1) (Tvar v2) = case (elemIndex v1 e1,elemIndex v2 e2) of (Just i1, Just i2) -> i1 == i2 @@ -178,7 +179,7 @@ nearlyEqualTy t1 t2 = eqTy [] [] t1 t2 eqTy e1 e2 (Tforall (tv1,tk1) t1) (Tforall (tv2,tk2) t2) = tk1 `eqKind` tk2 && eqTy (tv1:e1) (tv2:e2) t1 t2 eqTy _ _ _ _ = False -instance Eq Ty where (==) = nearlyEqualTy +instance Eq Ty where (==) = equalTy subKindOf :: Kind -> Kind -> Bool