Handle unlifted tycons and tuples correctly during vectorisation

diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index f6f8139..eed5a81 100644 (file)
--- 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)
                  $  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 ->
 
 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 (file)
--- 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 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
 tyConsOfType (AppTy a b)       = tyConsOfType a `unionUniqSets` tyConsOfType b
 tyConsOfType (FunTy a b)       = (tyConsOfType a `unionUniqSets` tyConsOfType b)
                                  `addOneToUniqSet` funTyCon