X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectType.hs;h=dfebe1849348225647f823fce23c599f9c44cdbe;hb=48fb2b521898998a17873ad6cf30610aa5ab6db3;hp=5dceb3b0fb4324fe404a18e80b7b0e32d0176f37;hpb=24901afd71ec4776b2949f38c87103eb2cda2985;p=ghc-hetmet.git

diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index 5dceb3b..dfebe18 100644
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -77,8 +77,8 @@ vectTypeEnv env
       zipWithM_ defTyCon   keep_tcs keep_tcs
       zipWithM_ defDataCon keep_dcs keep_dcs
       vect_tcs <- vectTyConDecls conv_tcs
-      parr_tcs1 <- mapM (\tc -> buildPArrayTyCon (tyConName tc) tc) keep_tcs
-      parr_tcs2 <- zipWithM (buildPArrayTyCon . tyConName) conv_tcs vect_tcs
+      parr_tcs1 <- zipWithM buildPArrayTyCon keep_tcs keep_tcs
+      parr_tcs2 <- zipWithM buildPArrayTyCon conv_tcs vect_tcs
       let new_tcs = vect_tcs ++ parr_tcs1 ++ parr_tcs2
 
       let new_env = extendTypeEnvList env
@@ -173,8 +173,8 @@ vectDataCon dc
     rep_arg_tys = dataConRepArgTys dc
     tycon       = dataConTyCon dc
 
-buildPArrayTyCon :: Name -> TyCon -> VM TyCon
-buildPArrayTyCon orig_name vect_tc = fixV $ \repr_tc ->
+buildPArrayTyCon :: TyCon -> TyCon -> VM TyCon
+buildPArrayTyCon orig_tc vect_tc = fixV $ \repr_tc ->
   do
     name'  <- cloneName mkPArrayTyConOcc orig_name
     parent <- buildPArrayParentInfo orig_name vect_tc repr_tc
@@ -191,6 +191,7 @@ buildPArrayTyCon orig_name vect_tc = fixV $ \repr_tc ->
                         False           -- FIXME: no generics
                         False           -- not GADT syntax
   where
+    orig_name = tyConName orig_tc
     name   = tyConName vect_tc
     kind   = tyConKind vect_tc
     tyvars = tyConTyVars vect_tc
@@ -201,7 +202,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)]