From e7577a785b467d1a7f48bef8fc6d934c67a56ba7 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Tue, 26 Feb 2008 17:47:43 +0000
Subject: [PATCH] Fix Trac #1899; missing equality check in typechecker's
 constraint simplifier

This patch fixes a missing equality check (uifying type variable b=b) in
the new constraint simplifier in TcTyFuns.  As it stands, we were making
'b' point to itself, which subsequently led to an infinite loop when
zonking.  Test is T1899.hs
---
 compiler/typecheck/TcTyFuns.lhs |   27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs
index 82e397f..1de7386 100644
--- a/compiler/typecheck/TcTyFuns.lhs
+++ b/compiler/typecheck/TcTyFuns.lhs
@@ -986,26 +986,30 @@ unifyMetaRule insts
         uMeta _swapped _tv (IndirectTv _) _ty _cotv
           = return ([inst], False)
 
-        -- signature skolem meets non-variable type
-        -- => cannot update!
-        uMeta _swapped _tv (DoneTv (MetaTv (SigTv _) _)) ty _cotv
-          | not $ isTyVarTy ty
-          = return ([inst], False)
-
         -- type variable meets type variable
         -- => check that tv2 hasn't been updated yet and choose which to update
 	uMeta swapped tv1 (DoneTv details1) (TyVarTy tv2) cotv
+	  | tv1 == tv2
+ 	  = return ([inst], False)	-- The two types are already identical
+
+	  | otherwise
 	  = do { lookupTV2 <- lookupTcTyVar tv2
                ; case lookupTV2 of
-                   IndirectTv ty  -> uMeta swapped tv1 (DoneTv details1) ty cotv
-                   DoneTv details2 -> 
-                     uMetaVar swapped tv1 details1 tv2 details2 cotv
+                   IndirectTv ty   -> uMeta swapped tv1 (DoneTv details1) ty cotv
+                   DoneTv details2 -> uMetaVar swapped tv1 details1 tv2 details2 cotv
 	       }
 
+	------ Beyond this point we know that ty2 is not a type variable
+
+        -- signature skolem meets non-variable type
+        -- => cannot update!
+        uMeta _swapped _tv (DoneTv (MetaTv (SigTv _) _)) _non_tv_ty _cotv
+          = return ([inst], False)
+
         -- updatable meta variable meets non-variable type
         -- => occurs check, monotype check, and kinds match check, then update
-	uMeta swapped tv (DoneTv (MetaTv _ ref)) ty cotv
-	  = do { mb_ty' <- checkTauTvUpdate tv ty    -- occurs + monotype check
+	uMeta swapped tv (DoneTv (MetaTv _ ref)) non_tv_ty cotv
+	  = do { mb_ty' <- checkTauTvUpdate tv non_tv_ty    -- occurs + monotype check
                ; case mb_ty' of
                    Nothing  -> return ([inst], False)  -- tv occurs in faminst
                    Just ty' ->
@@ -1017,6 +1021,7 @@ unifyMetaRule insts
 
         uMeta _ _ _ _ _ = panic "uMeta"
 
+	-- uMetaVar: unify two type variables
         -- meta variable meets skolem 
         -- => just update
         uMetaVar swapped tv1 (MetaTv _ ref) tv2 (SkolemTv _) cotv
-- 
1.7.10.4