Revise implementation of overlapping type family instances.

This commit changes the syntax and story around overlapping type
family instances. Before, we had "unbranched" instances and
"branched" instances. Now, we have closed type families and
open ones.

The behavior of open families is completely unchanged. In particular,
coincident overlap of open type family instances still works, despite
emails to the contrary.

A closed type family is declared like this:
> type family F a where
>   F Int = Bool
>   F a   = Char
The equations are tried in order, from top to bottom, subject to
certain constraints, as described in the user manual. It is not
allowed to declare an instance of a closed family.

1 files changed, 20 insertions, 10 deletions

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index cc410388df..e1236cac10 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -542,10 +542,9 @@ rnFamInstDecl doc mb_cls tycon pats payload rnPayload
 rnTyFamInstDecl :: Maybe (Name, [Name])
                 -> TyFamInstDecl RdrName
                 -> RnM (TyFamInstDecl Name, FreeVars)
-rnTyFamInstDecl mb_cls (TyFamInstDecl { tfid_eqns = eqns, tfid_group = group })
-  = do { (eqns', fvs) <- rnList (rnTyFamInstEqn mb_cls) eqns
-       ; return (TyFamInstDecl { tfid_eqns = eqns'
-                               , tfid_group = group
+rnTyFamInstDecl mb_cls (TyFamInstDecl { tfid_eqn = L loc eqn })
+  = do { (eqn', fvs) <- rnTyFamInstEqn mb_cls eqn
+       ; return (TyFamInstDecl { tfid_eqn = L loc eqn'
                                , tfid_fvs = fvs }, fvs) }
 
 rnTyFamInstEqn :: Maybe (Name, [Name])
@@ -1044,16 +1043,27 @@ rnFamDecl :: Maybe Name
           -> FamilyDecl RdrName
           -> RnM (FamilyDecl Name, FreeVars)
 rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
-                             , fdFlavour = flav, fdKindSig = kind })
-  = bindHsTyVars fmly_doc mb_cls kvs tyvars $ \tyvars' ->
-    do { tycon' <- lookupLocatedTopBndrRn tycon
-       ; (kind', fv_kind) <- rnLHsMaybeKind fmly_doc kind
+                             , fdInfo = info, fdKindSig = kind })
+  = do { ((tycon', tyvars', kind'), fv1) <-
+           bindHsTyVars fmly_doc mb_cls kvs tyvars $ \tyvars' ->
+           do { tycon' <- lookupLocatedTopBndrRn tycon
+              ; (kind', fv_kind) <- rnLHsMaybeKind fmly_doc kind
+              ; return ((tycon', tyvars', kind'), fv_kind) }
+       ; (info', fv2) <- rn_info info
        ; return (FamilyDecl { fdLName = tycon', fdTyVars = tyvars'
-                            , fdFlavour = flav, fdKindSig = kind' }
-                , fv_kind ) }
+                            , fdInfo = info', fdKindSig = kind' }
+                , fv1 `plusFV` fv2) }
   where 
      fmly_doc = TyFamilyCtx tycon
      kvs = extractRdrKindSigVars kind
+
+     rn_info (ClosedTypeFamily eqns)
+       = do { (eqns', fvs) <- rnList (rnTyFamInstEqn Nothing) eqns
+                                                    -- no class context,
+            ; return (ClosedTypeFamily eqns', fvs) }
+     rn_info OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
+     rn_info DataFamily     = return (DataFamily, emptyFVs)
+     
 \end{code}
 
 Note [Stupid theta]