+ tvs = tyConTyVars arr_tc
+ arg_tys = mkTyVarTys tvs
+
+buildPADict :: PAInstance -> VM [(Var, CoreExpr)]
+buildPADict (PAInstance {
+ painstInstance = inst
+ , painstVectTyCon = vect_tc
+ , painstArrTyCon = arr_tc })
+ = polyAbstract (tyConTyVars arr_tc) $ \abstract ->
+ do
+ shape <- tyConShape vect_tc
+ meth_binds <- mapM (mk_method shape) paMethods
+ let meth_exprs = map (Var . fst) meth_binds
+
+ pa_dc <- builtin paDictDataCon
+ let dict = mkConApp pa_dc (Type (mkTyConApp vect_tc arg_tys) : meth_exprs)
+ body = Let (Rec meth_binds) dict
+ return [(instanceDFunId inst, mkInlineMe $ abstract body)]
+ where
+ tvs = tyConTyVars arr_tc
+ arg_tys = mkTyVarTys tvs
+
+ mk_method shape (name, build)
+ = localV
+ $ do
+ body <- build shape vect_tc arr_tc
+ var <- newLocalVar name (exprType body)
+ return (var, mkInlineMe body)
+
+paMethods = [(FSLIT("lengthPA"), buildLengthPA),
+ (FSLIT("replicatePA"), buildReplicatePA)]
+
+buildLengthPA :: Shape -> TyCon -> TyCon -> VM CoreExpr
+buildLengthPA shape vect_tc arr_tc
+ = do
+ parr_ty <- mkPArrayType (mkTyConApp vect_tc arg_tys)
+ arg <- newLocalVar FSLIT("xs") parr_ty
+ shapes <- mapM (newLocalVar FSLIT("sh")) shape_tys
+ wilds <- mapM newDummyVar repr_tys
+ let scrut = unwrapFamInstScrut arr_tc arg_tys (Var arg)
+ scrut_ty = exprType scrut