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 <[email protected]>
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



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to