X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectType.hs;h=a7c463b462426ee1676fca430dd19b92040279d9;hb=ea8027bad72931bce05f36cae99497e7f255eef7;hp=c77343b7e5b6ebc0b073ad84d3fb03b54edffdef;hpb=9396c0736a7e7d73c2a13f1a18104e0c43b924b0;p=ghc-hetmet.git

diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index c77343b..a7c463b 100644
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -248,6 +248,13 @@ buildFromPRepr _ vect_tc prepr_tc _
                   bndrs <- mapM (newLocalVar FSLIT("x")) $ dataConRepArgTys dc
                   return (bndrs, mkConApp dc (map Type var_tys ++ map Var bndrs))
 
+buildPRDict :: Shape -> TyCon -> TyCon -> TyCon -> VM CoreExpr
+buildPRDict _ vect_tc prepr_tc _
+  = prCoerce prepr_tc var_tys
+  =<< prDictOfType (mkTyConApp prepr_tc var_tys)
+  where
+    var_tys = mkTyVarTys $ tyConTyVars vect_tc
+
 buildPArrayTyCon :: TyCon -> TyCon -> VM TyCon
 buildPArrayTyCon orig_tc vect_tc = fixV $ \repr_tc ->
   do
@@ -416,7 +423,8 @@ buildPADict shape vect_tc prepr_tc arr_tc dfun
 paMethods = [(FSLIT("lengthPA"),    buildLengthPA),
              (FSLIT("replicatePA"), buildReplicatePA),
              (FSLIT("toPRepr"),     buildToPRepr),
-             (FSLIT("fromPRepr"),   buildFromPRepr)]
+             (FSLIT("fromPRepr"),   buildFromPRepr),
+             (FSLIT("dictPRepr"),   buildPRDict)]
 
 buildLengthPA :: Shape -> TyCon -> TyCon -> TyCon -> VM CoreExpr
 buildLengthPA shape vect_tc _ arr_tc