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.

8 files changed, 12 insertions, 18 deletions

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index b939f4beb6..012ae37039 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -27,7 +27,6 @@ import DynFlags
 import Outputable
 import Util                 ( zipLazy )
 import MonadUtils
-import FamInstEnv           ( toBranchedFamInst )
 
 import Control.Monad
 
@@ -93,7 +92,7 @@ vectModule guts@(ModGuts { mg_tcs        = tycons
                         -- and dfuns
                       , mg_binds        = Rec tc_binds : (binds_top ++ binds_imp)
                       , mg_fam_inst_env = fam_inst_env
-                      , mg_fam_insts    = fam_insts ++ (map toBranchedFamInst new_fam_insts)
+                      , mg_fam_insts    = fam_insts ++ new_fam_insts
                       }
       }
 
diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs
index 2d415aab36..3358ceafab 100644
--- a/compiler/vectorise/Vectorise/Env.hs
+++ b/compiler/vectorise/Vectorise/Env.hs
@@ -174,7 +174,7 @@ extendImportedVarsEnv ps genv
 
 -- |Extend the list of type family instances.
 --
-extendFamEnv :: [FamInst Unbranched] -> GlobalEnv -> GlobalEnv
+extendFamEnv :: [FamInst] -> GlobalEnv -> GlobalEnv
 extendFamEnv new genv
   = genv { global_fam_inst_env = (g_fam_inst, extendFamInstEnvList l_fam_inst new) }
   where (g_fam_inst, l_fam_inst) = global_fam_inst_env genv
diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
index af815c9294..9390696fc7 100644
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
@@ -32,13 +32,13 @@ import Control.Monad
 import Outputable
 
 
-buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM (FamInst Unbranched)
+buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPReprTyCon orig_tc vect_tc repr
  = do name      <- mkLocalisedName mkPReprTyConOcc (tyConName orig_tc)
       rhs_ty    <- sumReprType repr
       prepr_tc  <- builtin preprTyCon
       let axiom = mkSingleCoAxiom name tyvars prepr_tc instTys rhs_ty
-      liftDs $ newFamInst SynFamilyInst False axiom
+      liftDs $ newFamInst SynFamilyInst axiom
   where
     tyvars = tyConTyVars vect_tc
     instTys = [mkTyConApp vect_tc . mkTyVarTys $ tyConTyVars vect_tc]
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index 893f1559be..6b06996ec8 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -14,7 +14,6 @@ import Vectorise.Generic.Description
 import Vectorise.Utils
 import Vectorise.Env( GlobalEnv( global_fam_inst_env ) )
 
-import Coercion( mkSingleCoAxiom )
 import BasicTypes
 import BuildTyCl
 import DataCon
@@ -31,7 +30,7 @@ import Control.Monad
 
 -- buildPDataTyCon ------------------------------------------------------------
 -- | Build the PData instance tycon for a given type constructor.
-buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM (FamInst Unbranched)
+buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPDataTyCon orig_tc vect_tc repr 
  = fixV $ \fam_inst ->
    do let repr_tc = dataFamInstRepTyCon fam_inst
@@ -42,7 +41,7 @@ buildPDataTyCon orig_tc vect_tc repr
  where
     orig_name = tyConName orig_tc
 
-buildDataFamInst :: Name -> TyCon -> TyCon -> AlgTyConRhs -> VM (FamInst Unbranched)
+buildDataFamInst :: Name -> TyCon -> TyCon -> AlgTyConRhs -> VM FamInst
 buildDataFamInst name' fam_tc vect_tc rhs
  = do { axiom_name <- mkDerivedName mkInstTyCoOcc name'
 
@@ -60,7 +59,7 @@ buildDataFamInst name' fam_tc vect_tc rhs
                            False       -- Not promotable
                            False       -- not GADT syntax
                            (FamInstTyCon ax fam_tc pat_tys)
-      ; liftDs $ newFamInst (DataFamilyInst rep_tc) False ax }
+      ; liftDs $ newFamInst (DataFamilyInst rep_tc) ax }
  where
     tyvars    = tyConTyVars vect_tc
     rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
@@ -92,7 +91,7 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
 
 -- buildPDatasTyCon -----------------------------------------------------------
 -- | Build the PDatas instance tycon for a given type constructor.
-buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM (FamInst Unbranched)
+buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPDatasTyCon orig_tc vect_tc repr 
  = fixV $ \fam_inst ->
    do let repr_tc = dataFamInstRepTyCon fam_inst
diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
index ceb62eef80..84b29ceb61 100644
--- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs
+++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
@@ -67,7 +67,7 @@ lookupInst cls tys
 --
 lookupFamInst :: TyCon -> [Type] -> VM FamInstMatch
 lookupFamInst tycon tys
-  = ASSERT( isFamilyTyCon tycon )
+  = ASSERT( isOpenFamilyTyCon tycon )
     do { instEnv <- readGEnv global_fam_inst_env
        ; case lookupFamInstEnv instEnv tycon tys of
            [match] -> return match
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 0ae0f936b3..66db6185da 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -162,7 +162,7 @@ vectTypeEnv :: [TyCon]                   -- Type constructors defined in this mo
             -> [CoreVect]                -- All 'VECTORISE [SCALAR] type' declarations in this module
             -> [CoreVect]                -- All 'VECTORISE class' declarations in this module
             -> VM ( [TyCon]              -- old TyCons ++ new TyCons
-                  , [FamInst Unbranched] -- New type family instances.
+                  , [FamInst]            -- New type family instances.
                   , [(Var, CoreExpr)])   -- New top level bindings.
 vectTypeEnv tycons vectTypeDecls vectClassDecls
   = do { traceVt "** vectTypeEnv" $ ppr tycons
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index d088f45355..0bd54f4408 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -39,8 +39,6 @@ import DataCon
 import MkId
 import DynFlags
 import FastString
-import Util
-import Panic
 
 #include "HsVersions.h"
 
@@ -211,10 +209,8 @@ pdataReprTyCon :: Type -> VM (TyCon, [Type])
 pdataReprTyCon ty 
   = do 
     { FamInstMatch { fim_instance = famInst
-                   , fim_index    = index
                    , fim_tys      = tys } <- builtin pdataTyCon >>= (`lookupFamInst` [ty])
-    ; ASSERT( index == 0 )
-      return (dataFamInstRepTyCon famInst, tys)
+    ; return (dataFamInstRepTyCon famInst, tys)
     }
 
 -- |Get the representation tycon of the 'PData' data family for a given type constructor.
diff --git a/compiler/vectorise/Vectorise/Utils/PADict.hs b/compiler/vectorise/Vectorise/Utils/PADict.hs
index 8029dfb466..84a6ff37d9 100644
--- a/compiler/vectorise/Vectorise/Utils/PADict.hs
+++ b/compiler/vectorise/Vectorise/Utils/PADict.hs
@@ -119,7 +119,7 @@ prDictOfPReprInst :: Type -> VM CoreExpr
 prDictOfPReprInst ty
   = do
     { (FamInstMatch { fim_instance = prepr_fam, fim_tys = prepr_args }) <- preprSynTyCon ty
-    ; prDictOfPReprInstTyCon ty (famInstAxiom (toUnbranchedFamInst prepr_fam)) prepr_args
+    ; prDictOfPReprInstTyCon ty (famInstAxiom prepr_fam) prepr_args
     }
 
 -- |Given a type @ty@, its PRepr synonym tycon and its type arguments,