+
+data Repr = ProdRepr {
+ prod_components :: [Type]
+ , prod_tycon :: TyCon
+ , prod_data_con :: DataCon
+ , prod_arr_tycon :: TyCon
+ , prod_arr_data_con :: DataCon
+ }
+
+ | SumRepr {
+ sum_components :: [Repr]
+ , sum_tycon :: TyCon
+ , sum_arr_tycon :: TyCon
+ , sum_arr_data_con :: DataCon
+ }
+
+mkProduct :: [Type] -> VM Repr
+mkProduct tys
+ = do
+ tycon <- builtin (prodTyCon arity)
+ let [data_con] = tyConDataCons tycon
+
+ (arr_tycon, _) <- parrayReprTyCon $ mkTyConApp tycon tys
+ let [arr_data_con] = tyConDataCons arr_tycon
+
+ return $ ProdRepr {
+ prod_components = tys
+ , prod_tycon = tycon
+ , prod_data_con = data_con
+ , prod_arr_tycon = arr_tycon
+ , prod_arr_data_con = arr_data_con
+ }
+ where
+ arity = length tys
+
+mkSum :: [Repr] -> VM Repr
+mkSum [repr] = return repr
+mkSum reprs
+ = do
+ tycon <- builtin (sumTyCon arity)
+ (arr_tycon, _) <- parrayReprTyCon
+ . mkTyConApp tycon
+ $ map reprType reprs
+
+ let [arr_data_con] = tyConDataCons arr_tycon
+
+ return $ SumRepr {
+ sum_components = reprs
+ , sum_tycon = tycon
+ , sum_arr_tycon = arr_tycon
+ , sum_arr_data_con = arr_data_con
+ }
+ where
+ 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
+ uarr <- builtin uarrTyCon
+ return [intPrimTy, mkTyConApp uarr [intTy]]
+arrShapeTys repr = return [intPrimTy]
+
+arrShapeVars :: Repr -> VM [Var]
+arrShapeVars repr = mapM (newLocalVar FSLIT("sh")) =<< arrShapeTys repr
+
+arrReprTys :: Repr -> VM [[Type]]
+arrReprTys (SumRepr { sum_components = prods })
+ = mapM arrProdTys prods
+arrReprTys prod
+ = do
+ tys <- arrProdTys prod
+ return [tys]
+
+arrProdTys (ProdRepr { prod_components = tys })
+ = mapM mkPArrayType (mk_types tys)
+ where
+ mk_types [] = [unitTy]
+ mk_types tys = tys
+
+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)
+