- var_tys = mkTyVarTys $ tyConTyVars vect_tc
- el_ty = mkTyConApp vect_tc var_tys
- data_cons = tyConDataCons vect_tc
- rep_el_tys = map dataConRepArgTys data_cons
-
- [arr_dc] = tyConDataCons arr_tc
-
- has_selector | [_] <- data_cons = False
- | otherwise = True
--}
-
-buildFromArrPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
-buildFromArrPRepr _ _ _ _ = return (Var unitDataConId)
-
-buildPRDict :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
-buildPRDict (ProdRepr {
- repr_prod_arg_tys = prod_arg_tys
- , repr_prod_tycon = prod_tycon
- })
- vect_tc prepr_tc _
+ var_tys = mkTyVarTys $ tyConTyVars vect_tc
+ el_ty = mkTyConApp vect_tc var_tys
+
+ [arr_dc] = tyConDataCons arr_tc
+
+ from_repr (SumRepr { sum_components = prods
+ , sum_arr_tycon = tycon
+ , sum_arr_data_con = data_con })
+ expr
+ shape_vars
+ repr_vars
+ res_ty
+ body
+ = do
+ vars <- mapM (newLocalVar FSLIT("xs")) =<< mapM arrReprType prods
+ result <- go prods repr_vars vars body
+
+ let scrut = unwrapFamInstScrut tycon ty_args expr
+ return . Case scrut (mkWildId scrut_ty) res_ty
+ $ [(DataAlt data_con, shape_vars ++ vars, result)]
+ where
+ ty_args = map reprType prods
+ scrut_ty = mkTyConApp tycon ty_args
+
+ go [] [] [] body = return body
+ go (prod : prods) (repr_vars : rss) (var : vars) body
+ = do
+ shape_vars <- mapM (newLocalVar FSLIT("s")) =<< arrShapeTys prod
+
+ from_prod prod (Var var) shape_vars repr_vars res_ty
+ =<< go prods rss vars body
+
+ from_repr repr expr shape_vars [repr_vars] res_ty body
+ = from_prod repr expr shape_vars repr_vars res_ty body
+
+ from_prod prod@(ProdRepr { prod_components = tys
+ , prod_arr_tycon = tycon
+ , prod_arr_data_con = data_con })
+ expr
+ shape_vars
+ repr_vars
+ res_ty
+ body
+ = do
+ let scrut = unwrapFamInstScrut tycon tys expr
+ scrut_ty = mkTyConApp tycon tys
+ ty <- arrReprType prod
+
+ return $ Case scrut (mkWildId scrut_ty) res_ty
+ [(DataAlt data_con, shape_vars ++ repr_vars, body)]
+
+ from_prod (EnumRepr { enum_arr_tycon = tycon
+ , enum_arr_data_con = data_con })
+ expr
+ shape_vars
+ _
+ res_ty
+ body
+ = let scrut = unwrapFamInstScrut tycon [] expr
+ scrut_ty = mkTyConApp tycon []
+ in
+ return $ Case scrut (mkWildId scrut_ty) res_ty
+ [(DataAlt data_con, shape_vars, body)]
+
+ from_prod (IdRepr ty)
+ expr
+ shape_vars
+ [repr_var]
+ res_ty
+ body
+ = return $ Let (NonRec repr_var expr) body
+
+ from_prod (VoidRepr {})
+ expr
+ shape_vars
+ [repr_var]
+ res_ty
+ body
+ = return $ Let (NonRec repr_var expr) body
+
+buildPRDictRepr :: Repr -> VM CoreExpr
+buildPRDictRepr (VoidRepr { void_tycon = tycon })
+ = prDFunOfTyCon tycon
+buildPRDictRepr (IdRepr ty) = mkPR ty
+buildPRDictRepr (ProdRepr {
+ prod_components = tys
+ , prod_tycon = tycon
+ })
+ = do
+ prs <- mapM mkPR tys
+ dfun <- prDFunOfTyCon tycon
+ return $ dfun `mkTyApps` tys `mkApps` prs
+
+buildPRDictRepr (SumRepr {
+ sum_components = prods
+ , sum_tycon = tycon })