From e4b7186c16788b719e0150ac3bc3cc628ea00d64 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 7 Oct 2010 09:13:27 +0000
Subject: [PATCH] Fix an ASSERT failure in FamInstEnv

I added a lot of comments too, to explain the preconditions;
esp Note [FamInstEnv]
---
 compiler/types/FamInstEnv.lhs |   69 ++++++++++++++++++++++++++++-------------
 1 file changed, 48 insertions(+), 21 deletions(-)

diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index f6e76a7..eed3bf5 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -155,13 +155,31 @@ mkImportedFamInst fam mb_tcs tycon
 %*									*
 %************************************************************************
 
-InstEnv maps a family name to the list of known instances for that family.
+Note [FamInstEnv]
+~~~~~~~~~~~~~~~~~~~~~
+A FamInstEnv maps a family name to the list of known instances for that family.
+
+The same FamInstEnv includes both 'data family' and 'type family' instances.
+Type families are reduced during type inference, but not data families;
+the user explains when to use a data family instance by using contructors
+and pattern matching.
+
+Neverthless it is still useful to have data families in the FamInstEnv:
+
+ - For finding overlaps and conflicts
+
+ - For finding the representation type...see FamInstEnv.topNormaliseType
+   and its call site in Simplify
+
+ - In standalone deriving instance Eq (T [Int]) we need to find the 
+   representation type for T [Int]
 
 \begin{code}
 type FamInstEnv = UniqFM FamilyInstEnv	-- Maps a family to its instances
+     -- See Note [FamInstEnv]
 
 type FamInstEnvs = (FamInstEnv, FamInstEnv)
- 	-- External package inst-env, Home-package inst-env
+     -- External package inst-env, Home-package inst-env
 
 data FamilyInstEnv
   = FamIE [FamInst]	-- The instances for a particular family, in any order
@@ -233,6 +251,7 @@ lookupFamInstEnv
     :: FamInstEnvs
     -> TyCon -> [Type]		-- What we are looking for
     -> [FamInstMatch] 	        -- Successful matches
+-- Precondition: the tycon is saturated (or over-saturated)
 
 lookupFamInstEnv
    = lookup_fam_inst_env match True
@@ -250,6 +269,8 @@ lookupFamInstEnvConflicts
 -- to find conflicting matches
 -- The skolem tyvars are needed because we don't have a 
 -- unique supply to hand
+--
+-- Precondition: the tycon is saturated (or over-saturated)
 
 lookupFamInstEnvConflicts envs fam_inst skol_tvs
   = lookup_fam_inst_env my_unify False envs fam tys'
@@ -314,11 +335,14 @@ lookup_fam_inst_env 	      -- The worker, local to this module
     -> FamInstEnvs
     -> TyCon -> [Type]		-- What we are looking for
     -> [FamInstMatch] 	        -- Successful matches
+
+-- Precondition: the tycon is saturated (or over-saturated)
+
 lookup_fam_inst_env match_fun one_sided (pkg_ie, home_ie) fam tys
   | not (isFamilyTyCon fam) 
   = []
   | otherwise
-  = ASSERT( n_tys >= arity )	-- Family type applications must be saturated
+  = ASSERT2( n_tys >= arity, ppr fam <+> ppr tys )	-- Family type applications must be saturated
     home_matches ++ pkg_matches
   where
     home_matches = lookup home_ie 
@@ -442,25 +466,28 @@ topNormaliseType env ty
 ---------------
 normaliseTcApp :: FamInstEnvs -> TyCon -> [Type] -> (CoercionI, Type)
 normaliseTcApp env tc tys
-  = let	-- First normalise the arg types so that they'll match 
+  | isFamilyTyCon tc
+  , tyConArity tc <= length tys	   -- Unsaturated data families are possible
+  , [(fam_inst, inst_tys)] <- lookupFamInstEnv env tc ntys 
+  = let    -- A matching family instance exists
+	rep_tc         	= famInstTyCon fam_inst
+	co_tycon       	= expectJust "lookupFamInst" (tyConFamilyCoercion_maybe rep_tc)
+	co	       	= mkTyConApp co_tycon inst_tys
+	first_coi      	= mkTransCoI tycon_coi (ACo co)
+	(rest_coi, nty) = normaliseType env (mkTyConApp rep_tc inst_tys)
+	fix_coi         = mkTransCoI first_coi rest_coi
+    in 
+    (fix_coi, nty)
+
+  | otherwise
+  = (tycon_coi, TyConApp tc ntys)
+
+  where
+	-- Normalise the arg types so that they'll match 
 	-- when we lookup in in the instance envt
-	(cois, ntys) = mapAndUnzip (normaliseType env) tys
-	tycon_coi    = mkTyConAppCoI tc cois
-    in 	-- Now try the top-level redex
-    case lookupFamInstEnv env tc ntys of
-		-- A matching family instance exists
-	[(fam_inst, tys)] -> (fix_coi, nty)
-	    where
-		rep_tc         = famInstTyCon fam_inst
-		co_tycon       = expectJust "lookupFamInst" (tyConFamilyCoercion_maybe rep_tc)
-		co	       = mkTyConApp co_tycon tys
-		first_coi      = mkTransCoI tycon_coi (ACo co)
-		(rest_coi,nty) = normaliseType env (mkTyConApp rep_tc tys)
-		fix_coi        = mkTransCoI first_coi rest_coi
-
-		-- No unique matching family instance exists;
-		-- we do not do anything
-	_ -> (tycon_coi, TyConApp tc ntys)
+    (cois, ntys) = mapAndUnzip (normaliseType env) tys
+    tycon_coi    = mkTyConAppCoI tc cois
+
 ---------------
 normaliseType :: FamInstEnvs 		-- environment with family instances
 	      -> Type  			-- old type
-- 
1.7.10.4