From 84ca819a2640cfb688acbf53a9e71e5329b4b8ee Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Tue, 17 Jul 2007 06:48:16 +0000 Subject: [PATCH] Handle unlifted tycons and tuples correctly during vectorisation --- compiler/vectorise/VectMonad.hs | 5 ++++- compiler/vectorise/VectType.hs | 8 +++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs index f6f8139..eed5a81 100644 --- a/compiler/vectorise/VectMonad.hs +++ b/compiler/vectorise/VectMonad.hs @@ -297,7 +297,10 @@ lookupVar v $ maybeV (readGEnv $ \env -> lookupVarEnv (global_vars env) v) lookupTyCon :: TyCon -> VM (Maybe TyCon) -lookupTyCon tc = readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc) +lookupTyCon tc + | isUnLiftedTyCon tc || isTupleTyCon tc = return (Just tc) + + | otherwise = readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc) defTyCon :: TyCon -> TyCon -> VM () defTyCon tc tc' = updGEnv $ \env -> diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs index dd77c12..46c3267 100644 --- a/compiler/vectorise/VectType.hs +++ b/compiler/vectorise/VectType.hs @@ -209,7 +209,13 @@ tyConsOfType :: Type -> UniqSet TyCon tyConsOfType ty | Just ty' <- coreView ty = tyConsOfType ty' tyConsOfType (TyVarTy v) = emptyUniqSet -tyConsOfType (TyConApp tc tys) = tyConsOfTypes tys `addOneToUniqSet` tc +tyConsOfType (TyConApp tc tys) = extend (tyConsOfTypes tys) + where + extend | isUnLiftedTyCon tc + || isTupleTyCon tc = id + + | otherwise = (`addOneToUniqSet` tc) + tyConsOfType (AppTy a b) = tyConsOfType a `unionUniqSets` tyConsOfType b tyConsOfType (FunTy a b) = (tyConsOfType a `unionUniqSets` tyConsOfType b) `addOneToUniqSet` funTyCon -- 1.7.10.4