- var_tys = mkTyVarTys $ tyConTyVars vect_tc
- arg_ty = mkTyConApp vect_tc var_tys
- data_cons = tyConDataCons vect_tc
-
- mk_alts _ _ [] = [(DEFAULT, [], Var unitDataConId)]
- mk_alts [dc] [vars] [expr] = [(DataAlt dc, vars, expr)]
- mk_alts dcs vars exprs = zipWith4 mk_alt dcs vars sum_data_cons exprs
-
- mk_alt dc vars sum_dc expr = (DataAlt dc, vars,
- mkConApp sum_dc (map Type prod_tys ++ [expr]))
-
- mk_prod _ _ [] = Var unitDataConId
- mk_prod _ _ [expr] = expr
- mk_prod (Just dc) tys exprs = mkConApp dc (map Type tys ++ exprs)
-
-buildFromPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
-buildFromPRepr (TyConRepr {
- repr_tys = repr_tys
- , repr_prod_data_cons = prod_data_cons
- , repr_prod_tys = prod_tys
- , repr_sum_data_cons = sum_data_cons
- , repr_type = repr_type
- })
- vect_tc prepr_tc _
+ arity = length reprs
+
+reprProducts :: Repr -> [Repr]
+reprProducts (SumRepr { sum_components = rs }) = rs
+reprProducts repr = [repr]
+
+reprType :: Repr -> Type
+reprType (ProdRepr { prod_tycon = tycon, prod_components = tys })
+ = mkTyConApp tycon tys
+reprType (SumRepr { sum_tycon = tycon, sum_components = reprs })
+ = mkTyConApp tycon (map reprType reprs)
+
+arrReprType :: Repr -> VM Type
+arrReprType = mkPArrayType . reprType
+
+reprTys :: Repr -> [[Type]]
+reprTys (SumRepr { sum_components = prods }) = map prodTys prods
+reprTys prod = [prodTys prod]
+
+prodTys (ProdRepr { prod_components = tys }) = tys
+
+reprVars :: Repr -> VM [[Var]]
+reprVars = mapM (mapM (newLocalVar FSLIT("r"))) . reprTys
+
+arrShapeTys :: Repr -> VM [Type]
+arrShapeTys (SumRepr {})
+ = do
+ int_arr <- builtin parrayIntPrimTyCon
+ return [intPrimTy, mkTyConApp int_arr [], mkTyConApp int_arr []]
+arrShapeTys repr = return [intPrimTy]
+
+arrShapeVars :: Repr -> VM [Var]
+arrShapeVars repr = mapM (newLocalVar FSLIT("sh")) =<< arrShapeTys repr
+
+replicateShape :: Repr -> CoreExpr -> CoreExpr -> VM [CoreExpr]
+replicateShape (ProdRepr {}) len _ = return [len]
+replicateShape (SumRepr {}) len tag
+ = do
+ rep <- builtin replicatePAIntPrimVar
+ up <- builtin upToPAIntPrimVar
+ return [len, Var rep `mkApps` [len, tag], Var up `App` len]
+
+arrReprElemTys :: Repr -> [[Type]]
+arrReprElemTys (SumRepr { sum_components = prods })
+ = map arrProdElemTys prods
+arrReprElemTys prod@(ProdRepr {})
+ = [arrProdElemTys prod]
+
+arrProdElemTys (ProdRepr { prod_components = [] })
+ = [unitTy]
+arrProdElemTys (ProdRepr { prod_components = tys })
+ = tys
+
+arrReprTys :: Repr -> VM [[Type]]
+arrReprTys = mapM (mapM mkPArrayType) . arrReprElemTys
+
+arrReprVars :: Repr -> VM [[Var]]
+arrReprVars repr
+ = mapM (mapM (newLocalVar FSLIT("rs"))) =<< arrReprTys repr
+
+mkRepr :: TyCon -> VM Repr
+mkRepr vect_tc
+ = mkSum
+ =<< mapM mkProduct (map dataConRepArgTys $ tyConDataCons vect_tc)
+
+buildPReprType :: TyCon -> VM Type
+buildPReprType = liftM reprType . mkRepr
+
+buildToPRepr :: Repr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
+buildToPRepr repr vect_tc prepr_tc _