From 255f46e120cc18f51703c79d009d76016140abcb Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Fri, 24 Aug 2007 02:30:30 +0000 Subject: [PATCH] Remove Embed and related stuff from vectorisation --- compiler/prelude/PrelNames.lhs | 8 ++--- compiler/vectorise/VectBuiltIn.hs | 10 ++---- compiler/vectorise/VectUtils.hs | 70 +++++++++++-------------------------- 3 files changed, 27 insertions(+), 61 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 9839290..49ff539 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -218,7 +218,7 @@ genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName] ndpNames :: [Name] ndpNames = [ parrayTyConName, paTyConName, preprTyConName, prTyConName - , embedTyConName + , mkPRName , closureTyConName , mkClosureName, applyClosureName , mkClosurePName, applyClosurePName @@ -698,7 +698,7 @@ parrayTyConName = tcQual nDP_PARRAY FSLIT("PArray") parrayTyConKey paTyConName = tcQual nDP_PARRAY FSLIT("PA") paTyConKey preprTyConName = tcQual nDP_PARRAY FSLIT("PRepr") preprTyConKey prTyConName = clsQual nDP_PARRAY FSLIT("PR") prTyConKey -embedTyConName = tcQual nDP_REPR FSLIT("Embed") embedTyConKey +mkPRName = varQual nDP_PARRAY FSLIT("mkPR") mkPRIdKey lengthPAName = varQual nDP_PARRAY FSLIT("lengthPA") lengthPAIdKey replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey @@ -893,8 +893,7 @@ parrayTyConKey = mkPreludeTyConUnique 135 closureTyConKey = mkPreludeTyConUnique 136 paTyConKey = mkPreludeTyConUnique 137 preprTyConKey = mkPreludeTyConUnique 138 -embedTyConKey = mkPreludeTyConUnique 139 -prTyConKey = mkPreludeTyConUnique 140 +prTyConKey = mkPreludeTyConUnique 139 ---------------- Template Haskell ------------------- @@ -1088,6 +1087,7 @@ emptyPAIdKey = mkPreludeMiscIdUnique 133 packPAIdKey = mkPreludeMiscIdUnique 134 combinePAIdKey = mkPreludeMiscIdUnique 135 intEqPAIdKey = mkPreludeMiscIdUnique 136 +mkPRIdKey = mkPreludeMiscIdUnique 137 ---------------- Template Haskell ------------------- -- USES IdUniques 200-399 diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 0afef5b..0b8c047 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -41,10 +41,9 @@ data Builtins = Builtins { , preprTyCon :: TyCon , prTyCon :: TyCon , prDataCon :: DataCon - , embedTyCon :: TyCon - , embedDataCon :: DataCon , sumTyCons :: Array Int TyCon , closureTyCon :: TyCon + , mkPRVar :: Var , mkClosureVar :: Var , applyClosureVar :: Var , mkClosurePVar :: Var @@ -78,8 +77,6 @@ initBuiltins preprTyCon <- dsLookupTyCon preprTyConName prTyCon <- dsLookupTyCon prTyConName let [prDataCon] = tyConDataCons prTyCon - embedTyCon <- dsLookupTyCon embedTyConName - let [embedDataCon] = tyConDataCons embedTyCon closureTyCon <- dsLookupTyCon closureTyConName sum_tcs <- mapM (lookupExternalTyCon nDP_REPR) @@ -87,6 +84,7 @@ initBuiltins let sumTyCons = listArray (2, mAX_NDP_SUM) sum_tcs + mkPRVar <- dsLookupGlobalId mkPRName mkClosureVar <- dsLookupGlobalId mkClosureName applyClosureVar <- dsLookupGlobalId applyClosureName mkClosurePVar <- dsLookupGlobalId mkClosurePName @@ -108,10 +106,9 @@ initBuiltins , preprTyCon = preprTyCon , prTyCon = prTyCon , prDataCon = prDataCon - , embedTyCon = embedTyCon - , embedDataCon = embedDataCon , sumTyCons = sumTyCons , closureTyCon = closureTyCon + , mkPRVar = mkPRVar , mkClosureVar = mkClosureVar , applyClosureVar = applyClosureVar , mkClosurePVar = mkClosurePVar @@ -168,7 +165,6 @@ builtinPRs :: Builtins -> [(Name, Module, FastString)] builtinPRs bi = [ mk (tyConName unitTyCon) nDP_REPR FSLIT("dPR_Unit") - , mk embedTyConName nDP_REPR FSLIT("dPR_Embed") , mk closureTyConName nDP_CLOSURE FSLIT("dPR_Clo") -- temporary diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index 5d03521..9101178 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -94,9 +94,6 @@ splitFixedTyConApp tc ty | otherwise = pprPanic "splitFixedTyConApp" (ppr tc <+> ppr ty) -splitEmbedTy :: Type -> Type -splitEmbedTy = splitUnTy "splitEmbedTy" embedTyConName - splitClosureTy :: Type -> (Type, Type) splitClosureTy = splitBinTy "splitClosureTy" closureTyConName @@ -132,7 +129,6 @@ data TyConRepr = TyConRepr { repr_tyvars :: [TyVar] , repr_tys :: [[Type]] - , repr_embed_tys :: [[Type]] , repr_prod_tycons :: [Maybe TyCon] , repr_prod_tys :: [Type] , repr_sum_tycon :: Maybe TyCon @@ -142,17 +138,15 @@ data TyConRepr = TyConRepr { mkTyConRepr :: TyCon -> VM TyConRepr mkTyConRepr vect_tc = do - embed_tys <- mapM (mapM mkEmbedType) rep_tys prod_tycons <- mapM (mk_tycon prodTyCon) rep_tys - sum_tycon <- mk_tycon sumTyCon rep_tys + let prod_tys = zipWith mk_tc_app_maybe prod_tycons rep_tys + sum_tycon <- mk_tycon sumTyCon prod_tys - let prod_tys = zipWith mk_tc_app_maybe prod_tycons embed_tys return $ TyConRepr { repr_tyvars = tyvars , repr_tys = rep_tys - , repr_embed_tys = embed_tys , repr_prod_tycons = prod_tycons , repr_prod_tys = prod_tys , repr_sum_tycon = sum_tycon @@ -198,8 +192,6 @@ mkPRepr tys mkToPRepr :: [[CoreExpr]] -> VM ([CoreExpr], Type) mkToPRepr ess = do - embed_tc <- builtin embedTyCon - embed_dc <- builtin embedDataCon sum_tcs <- builtins sumTyCon prod_tcs <- builtins prodTyCon @@ -212,28 +204,20 @@ mkToPRepr ess sum_tc = sum_tcs (length es) mk_alt dc expr = mkConApp dc (map Type tys ++ [expr]) - mk_prod [] = (Var unitDataConId, unitTy) - mk_prod [(expr, ty)] = (expr, ty) - mk_prod es = (mkConApp prod_dc (map Type tys ++ exprs), - mkTyConApp prod_tc tys) + mk_prod [] = (Var unitDataConId, unitTy) + mk_prod [expr] = (expr, exprType expr) + mk_prod exprs = (mkConApp prod_dc (map Type tys ++ exprs), + mkTyConApp prod_tc tys) where - (exprs, tys) = unzip es - prod_tc = prod_tcs (length es) + tys = map exprType exprs + prod_tc = prod_tcs (length exprs) [prod_dc] = tyConDataCons prod_tc - mk_embed expr = (mkConApp embed_dc [Type ty, expr], - mkTyConApp embed_tc [ty]) - where ty = exprType expr - - return . mk_sum $ map (mk_prod . map mk_embed) ess + return . mk_sum . map mk_prod $ ess mkToArrPRepr :: CoreExpr -> CoreExpr -> [[CoreExpr]] -> VM CoreExpr mkToArrPRepr len sel ess = do - embed_tc <- builtin embedTyCon - (embed_rtc, _) <- parrayReprTyCon (mkTyConApp embed_tc [unitTy]) - let [embed_rdc] = tyConDataCons embed_rtc - let mk_sum [(expr, ty)] = return (expr, ty) mk_sum es = do @@ -246,28 +230,23 @@ mkToArrPRepr len sel ess where (exprs, tys) = unzip es - mk_prod [(expr, ty)] = return (expr, ty) - mk_prod es + mk_prod [expr] = return (expr, splitPArrayTy (exprType expr)) + mk_prod exprs = do - prod_tc <- builtin . prodTyCon $ length es + prod_tc <- builtin . prodTyCon $ length exprs (prod_rtc, _) <- parrayReprTyCon (mkTyConApp prod_tc tys) let [prod_rdc] = tyConDataCons prod_rtc return (mkConApp prod_rdc (map Type tys ++ (len : exprs)), mkTyConApp prod_tc tys) where - (exprs, tys) = unzip es - - mk_embed expr = (mkConApp embed_rdc [Type ty, expr], - mkTyConApp embed_tc [ty]) - where ty = splitPArrayTy (exprType expr) + tys = map (splitPArrayTy . exprType) exprs - liftM fst (mk_sum =<< mapM (mk_prod . map mk_embed) ess) + liftM fst (mk_sum =<< mapM mk_prod ess) mkFromPRepr :: CoreExpr -> Type -> [([Var], CoreExpr)] -> VM CoreExpr mkFromPRepr scrut res_ty alts = do - embed_dc <- builtin embedDataCon sum_tcs <- builtins sumTyCon prod_tcs <- builtins prodTyCon @@ -288,23 +267,14 @@ mkFromPRepr scrut res_ty alts mk_alt dc p body = (DataAlt dc, [p], body) un_prod expr ty [] r = return r - un_prod expr ty [var] r = return $ un_embed expr ty var r + un_prod expr ty [var] r = return $ Let (NonRec var expr) r un_prod expr ty vars r - = do - xs <- mapM (newLocalVar FSLIT("x")) tys - let body = foldr (\(e,t,v) r -> un_embed e t v r) r - $ zip3 (map Var xs) tys vars - return $ Case expr (mkWildId ty) res_ty - [(DataAlt prod_dc, xs, body)] + = return $ Case expr (mkWildId ty) res_ty + [(DataAlt prod_dc, vars, r)] where - tys = splitFixedTyConApp prod_tc ty prod_tc = prod_tcs $ length vars [prod_dc] = tyConDataCons prod_tc - un_embed expr ty var r - = Case expr (mkWildId ty) res_ty - [(DataAlt embed_dc, [var], r)] - un_sum scrut (exprType scrut) alts mkFromArrPRepr :: CoreExpr -> Type -> Var -> Var -> [[Var]] -> CoreExpr @@ -312,9 +282,6 @@ mkFromArrPRepr :: CoreExpr -> Type -> Var -> Var -> [[Var]] -> CoreExpr mkFromArrPRepr scrut res_ty len sel vars res = return (Var unitDataConId) -mkEmbedType :: Type -> VM Type -mkEmbedType ty = mkBuiltinTyConApp embedTyCon [ty] - mkClosureType :: Type -> Type -> VM Type mkClosureType arg_ty res_ty = mkBuiltinTyConApp closureTyCon [arg_ty, res_ty] @@ -460,6 +427,9 @@ paMethod method ty dict <- paDictOfType ty return $ mkApps (Var fn) [Type ty, dict] +mkPR :: Type -> VM CoreExpr +mkPR = paMethod mkPRVar + lengthPA :: CoreExpr -> VM CoreExpr lengthPA x = liftM (`App` x) (paMethod lengthPAVar ty) where -- 1.7.10.4