Robustify lookupFamInstEnv

[ghc-hetmet.git] / compiler / typecheck / TcTyFuns.lhs

diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs
index 3f3a7c9..0066d2f 100644 (file)
--- a/compiler/typecheck/TcTyFuns.lhs
+++ b/compiler/typecheck/TcTyFuns.lhs
@@ -69,21 +69,16 @@ tcUnfoldSynFamInst (TyConApp tycon tys)
   | not (isOpenSynTyCon tycon)     -- unfold *only* _synonym_ family instances
   = return Nothing
   | otherwise
-  = do { -- we only use the indexing arguments for matching, 
-         -- not the additional ones
-       ; maybeFamInst <- tcLookupFamInst tycon idxTys
+  = do { -- The TyCon might be over-saturated, but that's ok for tcLookupFamInst
+       ; maybeFamInst <- tcLookupFamInst tycon tys
        ; case maybeFamInst of
            Nothing                -> return Nothing
-           Just (rep_tc, rep_tys) -> return $ Just (mkTyConApp rep_tc tys',
-                                                   mkTyConApp coe_tc tys')
+           Just (rep_tc, rep_tys) -> return $ Just (mkTyConApp rep_tc rep_tys,
+                                                   mkTyConApp coe_tc rep_tys)
              where
-               tys'   = rep_tys ++ restTys
                coe_tc = expectJust "TcTyFuns.tcUnfoldSynFamInst" 
                                    (tyConFamilyCoercion_maybe rep_tc)
        }
-    where
-        n                = tyConArity tycon
-        (idxTys, restTys) = splitAt n tys
 tcUnfoldSynFamInst _other = return Nothing
 \end{code}
 
@@ -231,9 +226,6 @@ tcReduceEqs locals wanteds
 We maintain normalised equalities together with the skolems introduced as
 intermediates during flattening of equalities as well as 
 
-!!!TODO: We probably now can do without the skolem set.  It's not used during
-finalisation in the current code.
-
 \begin{code}
 -- |Configuration of normalised equalities used during solving.
 --
@@ -286,7 +278,7 @@ no further propoagation is possible.
 --
 normaliseEqs :: [Inst] -> TcM EqConfig
 normaliseEqs eqs 
-  = do { ASSERTM2( allM isValidWantedEqInst eqs, ppr eqs )
+  = do { ASSERTM2( allM wantedEqInstIsUnsolved eqs, ppr eqs )
        ; traceTc $ ptext (sLit "Entering normaliseEqs")
 
        ; (eqss, skolemss) <- mapAndUnzipM normEqInst eqs
@@ -352,7 +344,7 @@ finaliseEqsAndDicts (EqConfig { eqs     = eqs
 
          -- Assert that all cotvs of wanted equalities are still unfilled, and
          -- zonk all final insts, to make any improvement visible
-       ; ASSERTM2( allM isValidWantedEqInst eqs'', ppr eqs'' )
+       ; ASSERTM2( allM wantedEqInstIsUnsolved eqs'', ppr eqs'' )
        ; zonked_locals  <- zonkInsts locals'
        ; zonked_wanteds <- zonkInsts (eqs'' ++ wanteds')
        ; return (zonked_locals, zonked_wanteds, final_binds, improved)
@@ -384,9 +376,6 @@ families.  Moreover, in Forms (2) & (3), the left-hand side may not occur in
 the right-hand side, and the relation x > y is an arbitrary, but total order
 on type variables
 
-!!!TODO: We may need to keep track of swapping for error messages (and to
-re-orient on finilisation).
-
 \begin{code}
 data RewriteInst
   = RewriteVar  -- Form (2) above
@@ -960,9 +949,6 @@ applySubstFam eq1@(RewriteFam {rwi_fam = fam1, rwi_args = args1})
     -- rule matches => rewrite
   | fam1 == fam2 && tcEqTypes args1 args2 &&
     (isWantedRewriteInst eq2 || not (isWantedRewriteInst eq1))
--- !!!TODO: tcEqTypes is insufficient as it does not look through type synonyms
--- !!!Check whether anything breaks by making tcEqTypes look through synonyms.
--- !!!Should be ok and we don't want three type equalities.
   = do { co2' <- mkRightTransEqInstCo co2 co1 (lhs, rhs)
        ; eq2' <- deriveEqInst eq2 lhs rhs co2'
        ; liftM Just $ normEqInst eq2'
@@ -1240,7 +1226,7 @@ instantiateAndExtract eqs localsEmpty skolems
       | Just tv2 <- tcGetTyVar_maybe ty2
       , isMetaTyVar tv2
       , mayInst tv2 && (checkingMode || tv2 `elemVarSet` skolems)
-                        -- !!!TODO: this is too liberal, even if tv2 is in 
+                        -- !!!FIXME: this is too liberal, even if tv2 is in 
                         -- skolems we shouldn't instantiate if tvs occurs 
                         -- in other equalities that may propagate it into the
                         -- environment