From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Wed, 5 Dec 2007 05:02:21 +0000 (+0000)
Subject: Teach vectorisation about tuple datacons
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=b87a8ec229367845f28a64a371578d2b11d19ab1;p=ghc-hetmet.git

Teach vectorisation about tuple datacons
---

diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs
index 249354a..09a0700 100644
--- a/compiler/vectorise/VectBuiltIn.hs
+++ b/compiler/vectorise/VectBuiltIn.hs
@@ -31,7 +31,8 @@ import OccName
 import TypeRep         ( funTyCon )
 import Type            ( Type )
 import TysPrim
-import TysWiredIn      ( unitTyCon, tupleTyCon,
+import TysWiredIn      ( unitTyCon, unitDataCon,
+                         tupleTyCon,
                          intTyCon, intTyConName,
                          doubleTyCon, doubleTyConName,
                          boolTyCon, boolTyConName, trueDataCon, falseDataCon,
@@ -205,7 +206,7 @@ initBuiltinVars bi
     (umods, ufs, vmods, vfs) = unzip4 preludeVars
 
 defaultDataConWorkers :: [DataCon]
-defaultDataConWorkers = [trueDataCon, falseDataCon]
+defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
 
 preludeVars :: [(Module, FastString, Module, FastString)]
 preludeVars
@@ -253,7 +254,7 @@ initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
 initBuiltinDataCons bi = [(dataConName dc, dc)| dc <- defaultDataCons]
 
 defaultDataCons :: [DataCon]
-defaultDataCons = [trueDataCon, falseDataCon]
+defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
 
 initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
 initBuiltinDicts ps
diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index 5c12bee..803914c 100644
--- a/compiler/vectorise/VectMonad.hs
+++ b/compiler/vectorise/VectMonad.hs
@@ -376,7 +376,9 @@ defTyCon tc tc' = updGEnv $ \env ->
   env { global_tycons = extendNameEnv (global_tycons env) (tyConName tc) tc' }
 
 lookupDataCon :: DataCon -> VM (Maybe DataCon)
-lookupDataCon dc = readGEnv $ \env -> lookupNameEnv (global_datacons env) (dataConName dc)
+lookupDataCon dc
+  | isTupleTyCon (dataConTyCon dc) = return (Just dc)
+  | otherwise = readGEnv $ \env -> lookupNameEnv (global_datacons env) (dataConName dc)
 
 defDataCon :: DataCon -> DataCon -> VM ()
 defDataCon dc dc' = updGEnv $ \env ->