From 10c6e54de5f6b4ebd3183d8184941e1915edf6cf Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Mon, 16 Jul 2007 10:56:19 +0000 Subject: [PATCH] Pass PA dictionaries after all type arguments This makes the code slightly simpler but only works because we do not support rank-n types. --- compiler/vectorise/Vectorise.hs | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index d5b78f1..a73e705 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -184,16 +184,13 @@ abstractOverTyVars tvs p Just ty -> liftM Just (newLocalVar FSLIT("dPA") ty) Nothing -> return Nothing - mk_lams mdicts = mkLams [arg | (tv, mdict) <- zip tvs mdicts - , arg <- tv : maybeToList mdict] + mk_lams mdicts = mkLams (tvs ++ [dict | Just dict <- mdicts]) applyToTypes :: CoreExpr -> [Type] -> VM CoreExpr applyToTypes expr tys = do dicts <- mapM paDictOfType tys - return $ mkApps expr [arg | (ty, dict) <- zip tys dicts - , arg <- [Type ty, dict]] - + return $ expr `mkTyApps` tys `mkApps` dicts vectPolyExpr :: CoreExpr -> CoreExprWithFVs -> VM (CoreExpr, CoreExpr) vectPolyExpr lc expr @@ -447,14 +444,13 @@ vectType (AppTy ty1 ty2) = liftM2 AppTy (vectType ty1) (vectType ty2) vectType (TyConApp tc tys) = liftM2 TyConApp (vectTyCon tc) (mapM vectType tys) vectType (FunTy ty1 ty2) = liftM2 TyConApp (builtin closureTyCon) (mapM vectType [ty1,ty2]) -vectType (ForAllTy tv ty) +vectType ty@(ForAllTy _ _) = do - r <- paDictArgType tv - ty' <- vectType ty - return $ ForAllTy tv (wrap r ty') + mdicts <- mapM paDictArgType tyvars + mono_ty' <- vectType mono_ty + return $ tyvars `mkForAllTys` ([dict | Just dict <- mdicts] `mkFunTys` mono_ty') where - wrap Nothing = id - wrap (Just pa_ty) = FunTy pa_ty + (tyvars, mono_ty) = splitForAllTys ty vectType ty = pprPanic "vectType:" (ppr ty) -- 1.7.10.4