[commit: ghc] type-nats: Add some missing cases for type literals. (e980df9)
Iavor Diatchki
diatchki at galois.com
Mon Dec 19 03:37:47 CET 2011
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/e980df90d4c37539b882fccd0c89b17543a24d91
>---------------------------------------------------------------
commit e980df90d4c37539b882fccd0c89b17543a24d91
Author: Iavor S. Diatchki <iavor.diatchki at gmail.com>
Date: Sun Dec 18 17:58:41 2011 -0800
Add some missing cases for type literals.
>---------------------------------------------------------------
compiler/typecheck/TcCanonical.lhs | 8 +++++++-
compiler/typecheck/TcErrors.lhs | 1 +
2 files changed, 8 insertions(+), 1 deletions(-)
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index afd9093..c1b40c7 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -564,6 +564,9 @@ flatten d ctxt ty
-- else return (xi,co,no_flattening)
-- }
+
+flatten _ _ xi@(LiteralTy _) = return (xi, mkTcReflCo xi)
+
flatten d ctxt v@(TyVarTy _)
= do { ieqs <- getInertEqs
; let co = liftInertEqsTy ieqs ctxt v -- co : v ~ ty
@@ -696,6 +699,7 @@ flatten d ctxt ty@(ForAllTy {})
where under_families tvs rho
= go (mkVarSet tvs) rho
where go _bound (TyVarTy _tv) = False
+ go _ (LiteralTy _) = False
go bound (TyConApp tc tys)
| isSynFamilyTyCon tc
, (args,rest) <- splitAt (tyConArity tc) tys
@@ -1391,6 +1395,8 @@ expandAway tv ty@(ForAllTy {})
expandAway tv ty@(TyConApp tc tys)
= (mkTyConApp tc <$> mapM (expandAway tv) tys) <|> (tcView ty >>= expandAway tv)
+expandAway _ xi@(LiteralTy _) = return xi
+
\end{code}
Note [Type synonyms and canonicalization]
@@ -1584,4 +1590,4 @@ emitFDWorkAsDerived, emitFDWorkAsWanted :: [(EvVar,WantedLoc)]
emitFDWorkAsDerived = emitFDWork False
emitFDWorkAsWanted = emitFDWork True
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 893cd7a..d35670d 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -681,6 +681,7 @@ quickFlattenTy :: TcType -> TcM TcType
quickFlattenTy ty | Just ty' <- tcView ty = quickFlattenTy ty'
quickFlattenTy ty@(TyVarTy {}) = return ty
quickFlattenTy ty@(ForAllTy {}) = return ty -- See
+quickFlattenTy ty@(LiteralTy _) = return ty
-- Don't flatten because of the danger or removing a bound variable
quickFlattenTy (AppTy ty1 ty2) = do { fy1 <- quickFlattenTy ty1
; fy2 <- quickFlattenTy ty2
More information about the Cvs-ghc
mailing list