Better names for PArray instance coercions

[ghc-hetmet.git] / compiler / vectorise / VectType.hs

diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index d5a1ba1..15b2a5b 100644 (file)
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -12,6 +12,8 @@ import TyCon
 import Type
 import TypeRep
 import Coercion
+import FamInstEnv        ( FamInst, mkLocalFamInst )
+import InstEnv           ( Instance )
 import OccName
 import MkId
 import BasicTypes        ( StrictnessMark(..), boolToRecFlag )
@@ -66,7 +68,7 @@ vectType ty = pprPanic "vectType:" (ppr ty)
 
 type TyConGroup = ([TyCon], UniqSet TyCon)
 
-vectTypeEnv :: TypeEnv -> VM TypeEnv
+vectTypeEnv :: TypeEnv -> VM (TypeEnv, [FamInst], [Instance])
 vectTypeEnv env
   = do
       cs <- readGEnv $ mk_map . global_tycons
@@ -78,9 +80,13 @@ vectTypeEnv env
       parr_tcs1 <- mapM (\tc -> buildPArrayTyCon (tyConName tc) tc) keep_tcs
       parr_tcs2 <- zipWithM (buildPArrayTyCon . tyConName) conv_tcs vect_tcs
       let new_tcs = vect_tcs ++ parr_tcs1 ++ parr_tcs2
-      return $ extendTypeEnvList env
-                 (map ATyCon new_tcs ++ [ADataCon dc | tc <- new_tcs
-                                                     , dc <- tyConDataCons tc])
+
+      let new_env = extendTypeEnvList env
+                       (map ATyCon new_tcs
+                        ++ [ADataCon dc | tc <- new_tcs
+                                        , dc <- tyConDataCons tc])
+
+      return (new_env, map mkLocalFamInst (parr_tcs1 ++ parr_tcs2), [])
   where
     tycons = typeEnvTyCons env
     groups = tyConGroups tycons
@@ -195,7 +201,7 @@ buildPArrayParentInfo :: Name -> TyCon -> TyCon -> VM TyConParent
 buildPArrayParentInfo orig_name vect_tc repr_tc
   = do
       parray_tc <- builtin parrayTyCon
-      co_name <- cloneName mkInstTyCoOcc orig_name
+      co_name <- cloneName mkInstTyCoOcc (tyConName repr_tc)
 
       let inst_tys = [mkTyConApp vect_tc (map mkTyVarTy tyvars)]