[commit: ghc] master: Vectoriser: PArray may be part of identity conversions (f940ec5)

[Manuel Chakravarty]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/f940ec5cc73a941c1c9d0df5d3cf2c920ae8adb0

>---------------------------------------------------------------

commit f940ec5cc73a941c1c9d0df5d3cf2c920ae8adb0
Author: Manuel M T Chakravarty <chak at cse.unsw.edu.au>
Date:   Mon Feb 4 12:48:30 2013 +1100

    Vectoriser: PArray may be part of identity conversions

>---------------------------------------------------------------

 compiler/vectorise/Vectorise/Builtins/Base.hs      |    3 ++-
 .../vectorise/Vectorise/Builtins/Initialise.hs     |    8 ++++++--
 compiler/vectorise/Vectorise/Convert.hs            |   12 ++++++++----
 3 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs
index ca2e750..4f07e6f 100644
--- a/compiler/vectorise/Vectorise/Builtins/Base.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Base.hs
@@ -70,7 +70,8 @@ aLL_DPH_PRIM_TYCONS = map tyConName [intPrimTyCon, {- floatPrimTyCon, -} doubleP
 --
 data Builtins 
         = Builtins 
-        { pdataTyCon           :: TyCon                     -- ^ PData
+        { parrayTyCon          :: TyCon                     -- ^ PArray
+        , pdataTyCon           :: TyCon                     -- ^ PData
         , pdatasTyCon          :: TyCon                     -- ^ PDatas
         , prClass              :: Class                     -- ^ PR
         , prTyCon              :: TyCon                     -- ^ PR
diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
index 20c9f09..6770103 100644
--- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
@@ -30,7 +30,10 @@ import Data.Array
 --
 initBuiltins :: DsM Builtins
 initBuiltins
- = do {   -- 'PData': type family mapping array element types to array representation types
+ = do {   -- 'PArray: representation type for parallel arrays
+      ; parrayTyCon <- externalTyCon (fsLit "PArray")
+      
+          -- 'PData': type family mapping array element types to array representation types
           -- Not all backends use `PDatas`.
       ; pdataTyCon  <- externalTyCon (fsLit "PData")
       ; pdatasTyCon <- externalTyCon (fsLit "PDatas")
@@ -115,7 +118,8 @@ initBuiltins
       ; liftingContext  <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy) newUnique
 
       ; return $ Builtins 
-               { pdataTyCon           = pdataTyCon
+               { parrayTyCon          = parrayTyCon
+               , pdataTyCon           = pdataTyCon
                , pdatasTyCon          = pdatasTyCon
                , preprTyCon           = preprTyCon
                , prClass              = prClass
diff --git a/compiler/vectorise/Vectorise/Convert.hs b/compiler/vectorise/Vectorise/Convert.hs
index f21f5ca..bbd0c5a 100644
--- a/compiler/vectorise/Vectorise/Convert.hs
+++ b/compiler/vectorise/Vectorise/Convert.hs
@@ -11,9 +11,12 @@ import CoreSyn
 import TyCon
 import Type
 import TypeRep
+import NameSet
 import FastString
 import Outputable
 
+import Control.Applicative
+
 
 -- |Convert a vectorised expression such that it computes the non-vectorised equivalent of its
 -- value.
@@ -90,10 +93,11 @@ identityConv (ForAllTy {}) = noV $ text "identityConv: quantified type changes u
 identityConvTyCon :: TyCon -> VM ()
 identityConvTyCon tc
   = do 
-    { tc' <- lookupTyCon tc
-    ; case tc' of 
-        Nothing -> return ()
-        Just _  -> noV idErr
+    { isParallel <- (tyConName tc `elemNameSet`) <$> globalParallelTyCons
+    ; parray     <- builtin parrayTyCon
+    ; if isParallel && not (tc == parray)
+      then noV idErr
+      else return ()
     }
   where
     idErr = text "identityConvTyCon: type constructor contains parallel arrays" <+> ppr tc