diff options
| author | Roman Leshchinskiy <rl@cse.unsw.edu.au> | 2007-08-24 23:01:52 +0000 |
|---|---|---|
| committer | Roman Leshchinskiy <rl@cse.unsw.edu.au> | 2007-08-24 23:01:52 +0000 |
| commit | eaaecbaefe18da05d618942c51286cacfa1be2af (patch) | |
| tree | c88a562df553f391133f282a62e5a5eec9cb9aed /compiler/vectorise/VectUtils.hs | |
| parent | 27cb0a02d3e4c7a166e2c991e6ad4c09f54a10bc (diff) | |
| download | haskell-eaaecbaefe18da05d618942c51286cacfa1be2af.tar.gz | |
Complete PA dictionary generation for product types
Diffstat (limited to 'compiler/vectorise/VectUtils.hs')
| -rw-r--r-- | compiler/vectorise/VectUtils.hs | 29 |
1 files changed, 7 insertions, 22 deletions
diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index a50b4de3c7..709a3c018d 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -4,10 +4,11 @@ module VectUtils ( mkDataConTag, splitClosureTy, + mkBuiltinCo, mkPADictType, mkPArrayType, mkPReprType, - parrayCoerce, parrayReprTyCon, parrayReprDataCon, mkVScrut, - prDFunOfTyCon, prCoerce, + parrayReprTyCon, parrayReprDataCon, mkVScrut, + prDFunOfTyCon, paDictArgType, paDictOfType, paDFunType, paMethod, mkPR, lengthPA, replicatePA, emptyPA, liftPA, polyAbstract, polyApply, polyVApply, @@ -139,16 +140,11 @@ mkPADictType ty = mkBuiltinTyConApp paTyCon [ty] mkPArrayType :: Type -> VM Type mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty] -parrayCoerce :: TyCon -> [Type] -> CoreExpr -> VM CoreExpr -parrayCoerce repr_tc args expr - | Just arg_co <- tyConFamilyCoercion_maybe repr_tc +mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion +mkBuiltinCo get_tc = do - parray <- builtin parrayTyCon - - let co = mkAppCoercion (mkTyConApp parray []) - (mkSymCoercion (mkTyConApp arg_co args)) - - return $ mkCoerce co expr + tc <- builtin get_tc + return $ mkTyConApp tc [] parrayReprTyCon :: Type -> VM (TyCon, [Type]) parrayReprTyCon ty = builtin parrayTyCon >>= (`lookupFamInst` [ty]) @@ -170,17 +166,6 @@ prDFunOfTyCon :: TyCon -> VM CoreExpr prDFunOfTyCon tycon = liftM Var (traceMaybeV "prDictOfTyCon" (ppr tycon) (lookupTyConPR tycon)) -prCoerce :: TyCon -> [Type] -> CoreExpr -> VM CoreExpr -prCoerce repr_tc args expr - | Just arg_co <- tyConFamilyCoercion_maybe repr_tc - = do - pr_tc <- builtin prTyCon - - let co = mkAppCoercion (mkTyConApp pr_tc []) - (mkSymCoercion (mkTyConApp arg_co args)) - - return $ mkCoerce co expr - paDictArgType :: TyVar -> VM (Maybe Type) paDictArgType tv = go (TyVarTy tv) (tyVarKind tv) where |